Mercurial > hg > xemacs-beta
diff lisp/prim/itimer.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 0293115a14e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/prim/itimer.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,736 @@ +;;; Interval timers for XEmacs +;;; Copyright (C) 1988, 1991, 1993 Kyle E. Jones +;;; Modified 5 Feb 91 by Jamie Zawinski <jwz@lucid.com> for Lucid Emacs +;;; And again, 15 Dec 93. +;;; +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Synched up with: Not in FSF. + +;;; +;;; Send bug reports to kyle@uunet.uu.net. + +;; The original v18 version of this file worked by having an external program +;; wake up once a second to generate an interrupt for emacs; then an emacs +;; process filter was used to schedule timers. +;; +;; This version works by associating with each timer a "timeout" object, +;; since the XEmacs/Lucid Emacs event loop has the concept of timers built +;; in to it. There is no single scheduler function; instead, each timer +;; re-sets itself as it is invoked. + +;; `itimer' feature means Emacs-Lisp programers get: +;; itimerp, itimer-value, itimer-restart, itimer-function, +;; set-itimer-value, set-itimer-restart, set-itimer-function +;; get-itimer, start-itimer, read-itimer, delete-itimer +;; +;; Interactive users get these commands: +;; edit-itimers, list-itimers, start-itimer +;; +;; See the doc strings of these functions for more information. + +(defvar itimer-version "1.00" + "Version number of the itimer package.") + +(defvar itimer-list nil + "List of all active itimers.") + +;; not needed in XEmacs +;(defvar itimer-process nil +; "Process that drives all itimers.") + +;; This value is maintained internally; it does not determine itimer +;; granularity. Itimer granularity is 1 second, plus delays due to +;; system and Emacs internal activity that delay dealing with process +;; output. +;; not needed in XEmacs +;(defvar itimer-process-next-wakeup 1 +; "Itimer process will wakeup to service running itimers within this +;many seconds.") + +(defvar itimer-edit-map nil + "Keymap used when in Itimer Edit mode.") + +(if itimer-edit-map + () + (setq itimer-edit-map (make-sparse-keymap)) + (define-key itimer-edit-map "s" 'itimer-edit-set-field) + (define-key itimer-edit-map "d" 'itimer-edit-delete-itimer) + (define-key itimer-edit-map "q" 'itimer-edit-quit) + (define-key itimer-edit-map "\t" 'itimer-edit-next-field) + (define-key itimer-edit-map " " 'next-line) + (define-key itimer-edit-map "n" 'next-line) + (define-key itimer-edit-map "p" 'previous-line) + (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field) + (define-key itimer-edit-map "x" 'start-itimer) + (define-key itimer-edit-map "?" 'itimer-edit-help)) + +(defvar itimer-edit-start-marker nil) + +;; macros must come first... or byte-compile'd code will throw back its +;; head and scream. + +(defmacro itimer-decf (variable) + (list 'setq variable (list '1- variable))) + +(defmacro itimer-incf (variable) + (list 'setq variable (list '1+ variable))) + +(defmacro itimer-signum (n) + (list 'if (list '> n 0) 1 + (list 'if (list 'zerop n) 0 -1))) + +;; Itimer access functions should behave as if they were subrs. These +;; macros are used to check the arguments to the itimer functions and +;; signal errors appropriately if the arguments are not valid. + +(defmacro check-itimer (var) + "If VAR is not bound to an itimer, signal wrong-type-argument. +This is a macro." + (list 'setq var + (list 'if (list 'itimerp var) var + (list 'signal ''wrong-type-argument + (list 'list ''itimerp var))))) + +(defmacro check-itimer-coerce-string (var) + "If VAR is not bound to a string, look up the itimer that it names and +bind VAR to it. Otherwise if VAR is not bound to an itimer, signal +wrong-type-argument. This is a macro." + (list 'setq var + (list 'cond + (list (list 'itimerp var) var) + (list (list 'stringp var) (list 'get-itimer var)) + (list t (list 'signal ''wrong-type-argument + (list 'list ''string-or-itimer-p var)))))) + +(defmacro itimer-check-natnum (var) + "If VAR is not bound to a non-negative number, signal wrong-type-argument. +This is a macro." + (list 'setq var + (list 'if (list 'natnump var) var + (list 'signal ''wrong-type-argument + (list 'list ''natnump var))))) + +(defmacro itimer-check-string (var) + "If VAR is not bound to a string, signal wrong-type-argument. +This is a macro." + (list 'setq var + (list 'if (list 'stringp var) var + (list 'signal ''wrong-type-argument + (list 'list ''stringp var))))) + +;; Functions to access and modify itimer attributes. + +(defun itimerp (obj) + "Returns non-nil iff OBJ is an itimer." + (and (consp obj) (stringp (car obj)) (eq (length obj) + 5 ; for XEmacs + ;4 ; original version + ))) + +(defun itimer-name (itimer) + "Returns the name of ITIMER." + (check-itimer itimer) + (car itimer)) + +(defun itimer-value (itimer) + "Returns the number of seconds until ITIMER expires." + (check-itimer itimer) + (nth 1 itimer)) + +(defun itimer-restart (itimer) + "Returns the value to which ITIMER will be set at restart. +nil is returned if this itimer doesn't restart." + (check-itimer itimer) + (nth 2 itimer)) + +(defun itimer-function (itimer) + "Returns the function of ITIMER. +This function is called each time ITIMER expires." + (check-itimer itimer) + (nth 3 itimer)) + +;; XEmacs-specific +(defun itimer-id (itimer) + "Returns the timeout-id of ITIMER." + (check-itimer itimer) + (nth 4 itimer)) + +(defun set-itimer-value (itimer value + ;; XEmacs doesn't need this + ;; &optional nowakeup + ) + "Set the timeout value of ITIMER to be VALUE. +Itimer will expire is this many seconds. +Returns VALUE." +;; Optional third arg NOWAKEUP non-nil means do not wakeup the itimer +;; process to recompute a correct wakeup time, even if it means this +;; itimer will expire late. itimer-process-filter uses this option. +;; This is not meant for ordinary usage, which is why it is not +;; mentioned in the doc string. + (check-itimer itimer) + (itimer-check-natnum value) + (let ((inhibit-quit t)) + +; ;; If we're allowed to wakeup the itimer process, +; ;; and the itimer process's next wakeup needs to be recomputed, +; ;; and the itimer is running, then we wakeup the itimer process. +; (or (and (not nowakeup) (< value itimer-process-next-wakeup) +; (get-itimer (itimer-name itimer)) +; (progn (itimer-process-wakeup) +; (setcar (cdr itimer) value) +; (itimer-process-wakeup))) +; (setcar (cdr itimer) value)) + + ;; the XEmacs way: + (if (itimer-id itimer) + (deactivate-itimer itimer)) + (setcar (cdr itimer) value) + (activate-itimer itimer) + + value)) + +(defun set-itimer-restart (itimer restart) + "Set the restart value of ITIMER to be RESTART. +If RESTART is nil, ITIMER will not restart when it expires. +Returns RESTART." + (check-itimer itimer) + (if restart (itimer-check-natnum restart)) + (and restart (< restart 1) (signal 'args-out-of-range (list restart))) +;; (setcar (cdr (cdr itimer)) restart) + ;; the XEmacs way + (let ((was-active (itimer-id itimer)) + (inhibit-quit t)) + (if was-active + (deactivate-itimer itimer)) + (setcar (cdr (cdr itimer)) restart) + (if was-active + (progn + (setcar (cdr itimer) restart) + (if restart + (activate-itimer itimer))))) + restart) + +(defun set-itimer-function (itimer function) + "Set the function of ITIMER to be FUNCTION. +FUNCTION will be called when itimer expires. +Returns FUNCTION." + (check-itimer itimer) + (setcar (cdr (cdr (cdr itimer))) function)) + +;; XEmacs-specific +(defun set-itimer-id (itimer id) + (check-itimer itimer) + (setcar (cdr (cdr (cdr (cdr itimer)))) id)) + +(defun get-itimer (name) + "Return itimer named NAME, or nil if there is none." + (itimer-check-string name) + (assoc name itimer-list)) + +(defun read-itimer (prompt &optional initial-input) + "Read the name of an itimer from the minibuffer and return the itimer +associated with that name. The user is prompted with PROMPT. +Optional second arg INITIAL-INPUT non-nil is inserted into the + minibuffer as initial user input." + (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) + +(defun delete-itimer (itimer) + "Deletes ITIMER. ITIMER may be an itimer or the name of one." + (check-itimer-coerce-string itimer) + (deactivate-itimer itimer) ;; for XEmacs + (setq itimer-list (delq itimer itimer-list))) + +;jwz: this is preloaded so don't ;;;###autoload +(defun start-itimer (name function value &optional restart) + "Start an itimer. +Args are NAME, FUNCTION, VALUE &optional RESTART. +NAME is an identifier for the itimer. It must be a string. If an itimer + already exists with this name, NAME will be modified slightly to until + it is unique. +FUNCTION should be a function (or symbol naming one) of no arguments. It + will be called each time the itimer expires. The function can access + itimer that invoked it through the variable `current-itimer'. +VALUE is the number of seconds until this itimer expires. +Optional fourth arg RESTART non-nil means that this itimer should be + restarted automatically after its function is called. Normally an itimer + is deleted at expiration after its function has returned. + If non-nil RESTART should be a number indicating the value at which the + itimer should be set at restart time. +Returns the newly created itimer." + (interactive + (list (completing-read "Start itimer: " itimer-list) + (read (completing-read "Itimer function: " obarray 'fboundp)) + (let (value) + (while (not (natnump value)) + (setq value (read-from-minibuffer "Itimer value: " nil nil t))) + value) + (let ((restart t)) + (while (and restart (not (natnump restart))) + (setq restart (read-from-minibuffer "Itimer restart: " nil nil t))) + restart))) + (itimer-check-string name) + (itimer-check-natnum value) + (if restart (itimer-check-natnum restart)) + ;; Make proposed itimer name unique if it's not already. + (let ((oname name) + (num 2)) + (while (get-itimer name) + (setq name (concat oname "<" num ">")) + (itimer-incf num))) +; ;; If there's no itimer process, start one now. +; ;; Otherwise wake up the itimer process so that seconds slept before +; ;; the new itimer is created won't be counted against it. +; (if itimer-process +; (itimer-process-wakeup) +; (itimer-process-start)) + (let ((inhibit-quit t)) + ;; add the itimer to the global list + (setq itimer-list + (cons (list name value restart function nil) ; extra slot for XEmacs + itimer-list)) +; ;; If the itimer process is scheduled to wake up too late for the itimer +; ;; we wake it up to calculate a correct wakeup value giving consideration +; ;; to the newly added itimer. +; (if (< value itimer-process-next-wakeup) +; (itimer-process-wakeup))) + ;; for XEmacs + (activate-itimer (car itimer-list)) + ) + (car itimer-list)) + +;; User level functions to list and modify existing itimers. +;; Itimer Edit major mode, and the editing commands thereof. + +(defun list-itimers () + "Pop up a buffer containing a list of all itimers. +The major mode of the buffer is Itimer Edit mode. This major mode provides +commands to manipulate itimers; see the documentation for +`itimer-edit-mode' for more information." + (interactive) + (let* ((buf (get-buffer-create "*Itimer List*")) + (opoint (point)) + (standard-output buf) + (itimers (reverse itimer-list))) + (set-buffer buf) + (itimer-edit-mode) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Name Value Restart Function\n" + "---- ----- ------- --------") + (if (null itimer-edit-start-marker) + (setq itimer-edit-start-marker (point))) + (while itimers + (newline 1) + (prin1 (itimer-name (car itimers))) + (tab-to-tab-stop) + (prin1 (itimer-value (car itimers))) + (tab-to-tab-stop) + (prin1 (itimer-restart (car itimers))) + (tab-to-tab-stop) + (prin1 (itimer-function (car itimers))) + (setq itimers (cdr itimers))) + ;; restore point + (goto-char opoint) + (if (< (point) itimer-edit-start-marker) + (goto-char itimer-edit-start-marker)) + (setq buffer-read-only t) + (display-buffer buf))) + +(defun edit-itimers () + "Display a list of all itimers and select it for editing. +The major mode of the buffer containing the listing is Itimer Edit mode. +This major mode provides commands to manipulate itimers; see the documentation +for `itimer-edit-mode' for more information." + (interactive) + ;; since user is editing, make sure displayed data is reasonably up-to-date +; (if itimer-process +; (itimer-process-wakeup)) + (list-itimers) + (select-window (get-buffer-window "*Itimer List*")) + (goto-char itimer-edit-start-marker) + (if itimer-list + (progn + (forward-sexp 2) + (backward-sexp))) + (message "type q to quit, ? for help")) + +;; no point in making this interactive. +(defun itimer-edit-mode () + "Major mode for manipulating itimers. +Atrributes of running itimers are changed by moving the cursor to the +desired field and typing `s' to set that field. The field will then be +set to the value read from the minibuffer. + +Commands: +TAB move forward a field +DEL move backward a field +s set a field +d delete the selected itimer +x start a new itimer +? help" + (kill-all-local-variables) + (make-local-variable 'tab-stop-list) + (setq major-mode 'itimer-edit-mode + mode-name "Itimer Edit" + truncate-lines t + tab-stop-list '(22 32 42)) + (abbrev-mode 0) + (auto-fill-mode 0) + (buffer-disable-undo (current-buffer)) + (use-local-map itimer-edit-map) + (and lisp-mode-syntax-table (set-syntax-table lisp-mode-syntax-table))) + +(put 'itimer-edit-mode 'mode-class 'special) + +(defun itimer-edit-help () + "Help function for Itimer Edit." + (interactive) + (if (eq last-command 'itimer-edit-help) + (describe-mode) + (message "TAB, DEL select fields, (s)et field, (d)elete itimer (type ? for more help)"))) + +(defun itimer-edit-quit () + "End Itimer Edit." + (interactive) + (bury-buffer (current-buffer)) + (if (one-window-p t) + (switch-to-buffer (other-buffer (current-buffer))) + (delete-window))) + +(defun itimer-edit-set-field () + (interactive) + ;; First two lines in list buffer are headers. + ;; Cry out against the luser who attempts to change a field there. + (if (<= (point) itimer-edit-start-marker) + (error "")) + ;; field-value must be initialized to be something other than a + ;; number, symbol, or list. + (let (itimer field (field-value "")) + (setq itimer (save-excursion + ;; read the name of the itimer from the beginning of + ;; the current line. + (beginning-of-line) + (get-itimer (read (current-buffer)))) + field (save-excursion + (itimer-edit-beginning-of-field) + (let ((opoint (point)) + (n 0)) + ;; count the number of sexprs until we reach the cursor + ;; and use this info to determine which field the user + ;; wants to modify. + (beginning-of-line) + (while (and (>= opoint (point)) (< n 4)) + (forward-sexp 2) + (backward-sexp) + (itimer-incf n)) + (cond ((eq n 1) (error "Cannot change itimer name.")) + ((eq n 2) 'value) + ((eq n 3) 'restart) + ((eq n 4) 'function))))) + (cond ((eq field 'value) + ;; XEmacs: rewritten for I18N3 snarfing + (while (not (natnump field-value)) + (setq field-value (read-from-minibuffer "Set itimer value: " + nil nil t)))) + ((eq field 'restart) + (while (and field-value (not (natnump field-value))) + (setq field-value (read-from-minibuffer "Set itimer restart: " + nil nil t)))) + ((eq field 'function) + (while (not (or (and (symbolp field-value) (fboundp field-value)) + (and (consp field-value) + (memq (car field-value) '(lambda macro))))) + (setq field-value + (read (completing-read "Set itimer function: " + obarray 'fboundp nil)))))) + ;; set the itimer field + (funcall (intern (concat "set-itimer-" (symbol-name field))) + itimer field-value) + ;; move to beginning of field to be changed + (itimer-edit-beginning-of-field) + ;; modify the list buffer to reflect the change. + (let (buffer-read-only kill-ring) + (kill-sexp 1) + (kill-region (point) (progn (skip-chars-forward " \t") (point))) + (prin1 field-value (current-buffer)) + (if (not (eolp)) + (tab-to-tab-stop)) + (backward-sexp)))) + +(defun itimer-edit-delete-itimer () + (interactive) + ;; First two lines in list buffer are headers. + ;; Cry out against the luser who attempts to change a field there. + (if (<= (point) itimer-edit-start-marker) + (error "")) + (delete-itimer + (read-itimer "Delete itimer: " + (save-excursion (beginning-of-line) (read (current-buffer))))) + ;; update list information + (list-itimers)) + +(defun itimer-edit-next-field (count) + (interactive "p") + (itimer-edit-beginning-of-field) + (cond ((> (itimer-signum count) 0) + (while (not (zerop count)) + (forward-sexp) + ;; wrap from eob to itimer-edit-start-marker + (if (eobp) + (progn + (goto-char itimer-edit-start-marker) + (forward-sexp))) + (forward-sexp) + (backward-sexp) + ;; treat fields at beginning of line as if they weren't there. + (if (bolp) + (progn + (forward-sexp 2) + (backward-sexp))) + (itimer-decf count))) + ((< (itimer-signum count) 0) + (while (not (zerop count)) + (backward-sexp) + ;; treat fields at beginning of line as if they weren't there. + (if (bolp) + (backward-sexp)) + ;; wrap from itimer-edit-start-marker to field at eob. + (if (<= (point) itimer-edit-start-marker) + (progn + (goto-char (point-max)) + (backward-sexp))) + (itimer-incf count))))) + +(defun itimer-edit-previous-field (count) + (interactive "p") + (itimer-edit-next-field (- count))) + +(defun itimer-edit-beginning-of-field () + (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point))) + (back (save-excursion (backward-sexp) (point)))) + (cond ((eq forw-back back) (backward-sexp)) + ((eq forw-back (point)) t) + (t (backward-sexp))))) + + +;; internals of the itimer implementation. + +(defun itimer-process-filter (process string) + (error "itimer-process-filter is not used in XEmacs") +; ;; If the itimer process dies and generates output while doing +; ;; so, we may be called before the process-sentinel. Sanity +; ;; check the output just in case... +; (if (not (string-match "^[0-9]" string)) +; (progn (message "itimer process gave odd output: %s" string) +; ;; it may be still alive and waiting for input +; (process-send-string itimer-process "3\n")) +; ;; if there are no active itimers, return quickly. +; (if itimer-list +; (let ((time-elapsed (string-to-int string)) +; (itimers itimer-list) +; (itimer) +; ;; process filters can be hit by stray C-g's from the user, +; ;; so we must protect this stuff appropriately. +; ;; Quit's are allowed from within itimer functions, but we +; ;; catch them. +; (inhibit-quit t)) +; (setq itimer-process-next-wakeup 600) +; (while itimers +; (setq itimer (car itimers)) +; (set-itimer-value itimer (max 0 (- (itimer-value itimer) time-elapsed)) t) +; (if (> (itimer-value itimer) 0) +; (setq itimer-process-next-wakeup +; (min itimer-process-next-wakeup (itimer-value itimer))) +; ;; itimer has expired, we must call its function. +; ;; protect our local vars from the itimer function. +; ;; allow keyboard quit to occur, but catch and report it. +; ;; provide the variable `current-itimer' in case the function +; ;; is interested. +; (condition-case condition-data +; (let* ((current-itimer itimer) +; itimer itimers time-elapsed +; quit-flag inhibit-quit) +; (funcall (itimer-function current-itimer))) +; (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) +; (prin1-to-string condition-data))) +; (quit (message "itimer \"%s\" quit" (itimer-name itimer)))) +; ;; restart the itimer if we should, otherwise delete it. +; (if (null (itimer-restart itimer)) +; (delete-itimer itimer) +; (set-itimer-value itimer (itimer-restart itimer) t) +; (setq itimer-process-next-wakeup +; (min itimer-process-next-wakeup (itimer-value itimer))))) +; (setq itimers (cdr itimers))) +; ;; if user is editing itimers, update displayed info +; (if (eq major-mode 'itimer-edit-mode) +; (list-itimers))) +; (setq itimer-process-next-wakeup 600)) +; ;; tell itimer-process when to wakeup again +; (process-send-string itimer-process +; (concat (int-to-string itimer-process-next-wakeup) +; "\n"))) + ) + +(defun itimer-process-sentinel (process message) + (error "itimer-process-sentinel is not used in XEmacs") +; (let ((inhibit-quit t)) +; (if (eq (process-status process) 'stop) +; (continue-process process) +; ;; not stopped, so it must have died. +; ;; cleanup first... +; (delete-process process) +; (setq itimer-process nil) +; ;; now, if there are any active itimers then we need to immediately +; ;; start another itimer process, otherwise we can wait until the next +; ;; start-itimer call, which will start one automatically. +; (if (null itimer-list) +; () +; ;; there may have been an error message in the echo area; +; ;; give the user at least a little time to read it. +; (sit-for 2) +; (message "itimer process %s... respawning." (substring message 0 -1)) +; (itimer-process-start)))) + ) + +(defun itimer-process-start () + (error "itimer-process-start is not used in XEmacs") +; (let ((inhibit-quit t) +; (process-connection-type nil)) +; (setq itimer-process (start-process "itimer" nil "itimer")) +; (process-kill-without-query itimer-process) +; (set-process-filter itimer-process 'itimer-process-filter) +; (set-process-sentinel itimer-process 'itimer-process-sentinel) +; ;; Tell itimer process to wake up quickly, so that a correct wakeup +; ;; time can be computed. Zero instead of one here loses because of +; ;; underlying itimer implementations that use 0 to mean `disable the +; ;; itimer'. +; (setq itimer-process-next-wakeup 1) +; (process-send-string itimer-process "1\n")) + ) + +(defun itimer-process-wakeup () + (error "itimer-process-wakeup is not used in XEmacs") +; (interrupt-process itimer-process) +; (accept-process-output) + ) + + +;; XEmacs-specific code + +(defun activate-itimer (itimer) + (let ((inhibit-quit t)) + (set-itimer-id itimer + (add-timeout (itimer-value itimer) + 'itimer-callback + itimer + (itimer-restart itimer)))) + itimer) + +(defun deactivate-itimer (itimer) + (let ((inhibit-quit t) + (id (itimer-id itimer))) + (and id (disable-timeout id)) + (set-itimer-id itimer nil)) + itimer) + +(defun itimer-callback (current-itimer) + (funcall (itimer-function current-itimer))) + + +;;; itimer-driven auto-saves + +;jwz: this is preloaded so don't ;;;###autoload +(defvar auto-save-timeout 30 + "*Number of seconds idle time before auto-save. +Zero or nil means disable auto-saving due to idleness. + +The actual amount of idle time between auto-saves is logarithmically related +to the size of the current buffer. This variable is the number of seconds +after which an auto-save will happen when the current buffer is 50k or less; +the timeout will be 2 1/4 times this in a 200k buffer, 3 3/4 times this in a +1000k buffer, and 4 1/2 times this in a 2000k buffer. + +See also the variable `auto-save-interval', which controls auto-saving based +on the number of characters typed.") + +;jwz: this is preloaded so don't ;;;###autoload +(defvar auto-gc-threshold (/ gc-cons-threshold 3) + "*GC when this many bytes have been consed since the last GC, +and the user has been idle for `auto-save-timeout' seconds.") + +(defun auto-save-itimer () + "For use as a itimer callback function. +Auto-saves and garbage-collects based on the size of the current buffer +and the value of `auto-save-timeout', `auto-gc-threshold', and the current +keyboard idle-time." + (if (or (null auto-save-timeout) + (<= auto-save-timeout 0) + (eq (minibuffer-window) (selected-window))) + nil + (let ((buf-size (1+ (ash (buffer-size) -8))) + (delay-level 0) + (now (current-time)) + delay) + (while (> buf-size 64) + (setq delay-level (1+ delay-level) + buf-size (- buf-size (ash buf-size -2)))) + (if (< delay-level 4) + (setq delay-level 4)) + ;; delay_level is 4 for files under around 50k, 7 at 100k, 9 at 200k, + ;; 11 at 300k, and 12 at 500k, 15 at 1 meg, and 17 at 2 meg. + (setq delay (/ (* delay-level auto-save-timeout) 4)) + (let ((idle-time (if (or (not (consp last-input-time)) + (/= (car now) (car last-input-time))) + (1+ delay) + (- (car (cdr now)) (cdr last-input-time))))) + (and (> idle-time delay) + (do-auto-save)) + (and (> idle-time auto-save-timeout) + (> (consing-since-gc) auto-gc-threshold) + (garbage-collect))))) + ;; Look at the itimer that's currently running; if the user has changed + ;; the value of auto-save-timeout, modify this itimer to have the correct + ;; restart time. There will be some latency between when the user changes + ;; this variable and when it takes effect, but it will happen eventually. + (let ((self (get-itimer "auto-save"))) + (or self (error "auto-save-itimer can't find itself")) + (if (and auto-save-timeout (> auto-save-timeout 4)) + (or (= (itimer-restart self) (/ auto-save-timeout 4)) + (set-itimer-restart self (/ auto-save-timeout 4))))) + nil) + +(defun itimer-init-auto-gc () + (or noninteractive ; may be being run from after-init-hook in -batch mode. + (get-itimer "auto-save") + ;; the time here is just the first interval; if the user changes it + ;; later, it will adjust. + (let ((time (max 2 (/ (or auto-save-timeout 30) 4)))) + (start-itimer "auto-save" 'auto-save-itimer time time)))) + +(cond (purify-flag + ;; This file is being preloaded into an emacs about to be dumped. + ;; So arrange for the auto-save itimer to be started once emacs + ;; is launched. + (add-hook 'after-init-hook 'itimer-init-auto-gc)) + (t + ;; Otherwise, this file is being loaded into a normal, interactive + ;; emacs. Start the auto-save timer now. + (itimer-init-auto-gc))) + + +(provide 'itimer)