view lisp/=timer.el @ 1786:5179baee010b

* xfns.c (Fx_create_frame): After mapping the frame, call SET_FRAME_GARBAGED, not just plain FRAME_GARBAGED. * xfns.c (Qvertical_scrollbars): New symbol. Use it as the name of the parameter which decides whether or not the frame has scrollbars, instead of Qvertical_scrollbar. (Fx_create_frame): Adjusted accordingly. (syms_of_xfns): Initialize and staticpro Qvertical_scrollbars. (x_set_vertical_scrollbar): Renamed to x_set_vertical_scrollbars. (x_frame_parms): Adjusted accordingly. * xterm.h (CHAR_TO_PIXEL_WIDTH, CHAR_TO_PIXEL_HEIGHT, PIXEL_TO_CHAR_WIDTH, PIXEL_TO_CHAR_HEIGHT): Rewritten, using: (CHAR_TO_PIXEL_ROW, CHAR_TO_PIXEL_COL, PIXEL_TO_CHAR_ROW, PIXEL_TO_CHAR_COL): New macros. * xfns.c [not HAVE_X11] (Fx_create_frame): Use the PIXEL_TO_CHAR_{HEIGHT,WIDTH} macros to figure the frame's character size, and the CHAR_TO_PIXEL* macros for vice versa. * xterm.c (XTwrite_glyphs, XTclear_end_of_line, stufflines, scraplines, dumprectangle, pixel_to_glyph_coords, x_draw_box, clear_cursor, x_display_bar_cursor, x_draw_single_glyph, x_set_mouse_position): Use the CHAR_TO_PIXEL_* macros. * xfns.c (x_set_name): To request that the modelines be redrawn, execute the statement "update_mode_lines = 1;" instead of the silly statement "update_mode_lines;". * xfns.c (x_set_vertical_scrollbars): Don't try to set the X window's size if the frame's X window hasn't been created yet. * xfns.c (x_figure_window_size): Set the frame's vertical_scrollbar_extra field before trying to calculate its pixel dimensions. * xfns.c (x_window): When calling x_implicitly_set_name for the sake of drawing the name for the first time, remember to clear and set the frame's explicit_name member as well as its name member. (Fx_create_frame): Set the frame's explicit_name member if the user specified the name explicitly. * xfns.c (Fx_get_resource): Add CLASS argument, to give class of ATTRIBUTE. [not HAVE_X11]: Change definition of Fx_get_resource macro accordingly. (x_get_arg): Add CLASS argument, to give the class of ATTRIBUTE. Pass it along to Fx_get_resource. (x_figure_window_size, x_icon): Pass new argument to x_get_arg. (x_default_parameter): Add XCLASS argument, to give the class of XPROP. Pass it along to x_get_arg. (Fx_create_frame): Pass new args to x_get_arg and x_default_parameter. * xfns.c (Fx_create_frame): Use the same resource names and classes as xterm and Emacs 18.

;;; timer.el --- run a function with args at some time in future

;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.

;; Maintainer: FSF

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Code:

(defvar timer-process nil)
(defvar timer-alist ())
(defvar timer-out "")
(defvar timer-dont-exit nil
  ;; this is useful for functions which will be doing their own erratic
  ;; rescheduling or people who otherwise expect to use the process frequently
  "If non-nil, don't exit the timer process when no more events are pending.")

;;;###autoload
(defun run-at-time (time repeat function &rest args)
  "Run a function at a time, and optionally on a regular interval.
Arguments are TIME, REPEAT, FUNCTION &rest ARGS.
TIME, a string,  can be specified absolutely or relative to now.
REPEAT, an integer number of seconds, is the interval on which to repeat
the call to the function.  If REPEAT is nil, call it just once."
  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
  (cond ((or (not timer-process) 
             (memq (process-status timer-process) '(exit signal nil)))
         (if timer-process (delete-process timer-process))
         (setq timer-process (let ((process-connection-type nil))
			       (start-process "timer" nil "timer"))
               timer-alist nil)
         (set-process-filter   timer-process 'timer-process-filter)
         (set-process-sentinel timer-process 'timer-process-sentinel)
         (process-kill-without-query timer-process))
        ((eq (process-status timer-process) 'stop)
         (continue-process timer-process)))
  ;; There should be a living, breathing timer process now
  (let ((token (concat (current-time-string) "-" (length timer-alist))))
    (process-send-string timer-process (concat time "@" token "\n"))
    (setq timer-alist (cons (list token repeat function args) timer-alist))))

(defun timer-process-filter (proc str)
  (setq timer-out (concat timer-out str))
  (let (do token error)
    (while (string-match "\n" timer-out)
      (setq token (substring timer-out 0 (match-beginning 0))
            do (assoc token timer-alist)
            timer-out (substring timer-out (match-end 0)))
      (cond
       (do (apply (nth 2 do) (nth 3 do))   ; do it
           (if (natnump (nth 1 do))        ; reschedule it
               (send-string proc (concat (nth 1 do) " sec@" (car do) "\n"))
             (setq timer-alist (delq do timer-alist))))
       ((string-match "timer: \\([^:]+\\): \\([^@]*\\)@\\(.*\\)$" token)
        (setq error (substring token (match-beginning 1) (match-end 1))
              do    (substring token (match-beginning 2) (match-end 2))
              token (assoc (substring token (match-beginning 3) (match-end 3))
                           timer-alist)
              timer-alist (delq token timer-alist))
        (ding 'no-terminate) ; using error function in process filters is rude
        (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do))))
    (or timer-alist timer-dont-exit (process-send-eof proc))))

(defun timer-process-sentinel (proc str)
  (let ((stat (process-status proc)))
    (if (eq stat 'stop) (continue-process proc)
      ;; if it exited normally, presumably it was intentional.
      ;; if there were no pending events, who cares that it exited?
      (if (or (not timer-alist) (eq stat 'exit)) ()
        (ding 'no-terminate)
        (message "Timer exited abnormally.  All events cancelled."))
      ;; Used to set timer-scratch to "", but nothing uses that var.
      (setq timer-process nil timer-alist nil))))

(defun cancel-timer (function)
  "Cancel all events scheduled by `run-at-time' which would run FUNCTION."
  (interactive "aCancel function: ")
  (let ((alist timer-alist))
    (while alist
      (if (eq (nth 2 (car alist)) function)
          (setq timer-alist (delq (car alist) timer-alist)))
      (setq alist (cdr alist))))
  (or timer-alist timer-dont-exit (process-send-eof timer-process)))

(provide 'timer)

;;; timer.el ends here