cgit.sxemacs.org Git - sxemacs/blob - lisp/itimer-autosave.el

   1 ;;; itimer-autosave.el --- Autosave functions with itimers
   2
   3 ;; Copyright status unknown
   4
   5 ;; Maintainer: SXEmacs Development Team
   6 ;; Keywords: internal, dumped
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;; This file is dumped with SXEmacs.
  28
  29 ;; itimer-driven auto-saves
  30
  31 ;;; Code:
  32
  33 ;jwz: this is preloaded so don't ;;;###autoload
  34 (defvar auto-save-timeout 960
  35   "*Number of seconds idle time before auto-save.
  36 Zero or nil means disable auto-saving due to idleness.
  37
  38 The actual amount of idle time between auto-saves is logarithmically related
  39 to the size of the current buffer.  This variable is the number of seconds
  40 after which an auto-save will happen when the current buffer is 50k or less;
  41 the timeout will be 2 1/4 times this in a 200k buffer, 3 3/4 times this in a
  42 1000k buffer, and 4 1/2 times this in a 2000k buffer.
  43
  44 See also the variable `auto-save-interval', which controls auto-saving based
  45 on the number of characters typed.")
  46
  47 ;jwz: this is preloaded so don't ;;;###autoload
  48 (defvar auto-gc-threshold (/ gc-cons-threshold 3)
  49   "*GC when this many bytes have been consed since the last GC,
  50 and the user has been idle for `auto-save-timeout' seconds.")
  51
  52 (defun auto-save-itimer ()
  53   "For use as a itimer callback function.
  54 Auto-saves and garbage-collects based on the size of the current buffer
  55 and the value of `auto-save-timeout', `auto-gc-threshold', and the current
  56 keyboard idle-time."
  57   (if (or (null auto-save-timeout)
  58           (<= auto-save-timeout 0)
  59           (eq (minibuffer-window) (selected-window)))
  60       nil
  61     (let ((buf-size (1+ (ash (buffer-size) -8)))
  62           (delay-level 0)
  63           (now (current-time))
  64           delay)
  65       (while (> buf-size 64)
  66         (setq delay-level (1+ delay-level)
  67               buf-size (- buf-size (ash buf-size -2))))
  68       (if (< delay-level 4)
  69           (setq delay-level 4))
  70       ;; delay_level is 4 for files under around 50k, 7 at 100k, 9 at 200k,
  71       ;; 11 at 300k, and 12 at 500k, 15 at 1 meg, and 17 at 2 meg.
  72       (setq delay (/ (* delay-level auto-save-timeout) 4))
  73       (let ((idle-time (if (or (not (consp last-input-time))
  74                                (/= (car now) (car last-input-time)))
  75                            (1+ delay)
  76                          (- (car (cdr now)) (cdr last-input-time)))))
  77         (and (> idle-time delay)
  78              (do-auto-save))
  79         (and (> idle-time auto-save-timeout)
  80              (> (consing-since-gc) auto-gc-threshold)
  81              (garbage-collect)))))
  82   ;; Look at the itimer that's currently running; if the user has changed
  83   ;; the value of auto-save-timeout, modify this itimer to have the correct
  84   ;; restart time.  There will be some latency between when the user changes
  85   ;; this variable and when it takes effect, but it will happen eventually.
  86   (let ((self (get-itimer "auto-save")))
  87     (or self (error "auto-save-itimer can't find itself"))
  88     (if (and auto-save-timeout (> auto-save-timeout 4))
  89         (or (= (itimer-restart self) (/ auto-save-timeout 4))
  90             (set-itimer-restart self (/ auto-save-timeout 4)))))
  91   nil)
  92
  93 (defun itimer-init-auto-gc ()
  94   (or noninteractive ; may be being run from after-init-hook in -batch mode.
  95       (get-itimer "auto-save")
  96       ;; the time here is just the first interval; if the user changes it
  97       ;; later, it will adjust.
  98       (let ((time (max 2 (/ (or auto-save-timeout 30) 4))))
  99         (start-itimer "auto-save" 'auto-save-itimer time time))))
 100
 101 (cond (purify-flag
 102        ;; This file is being preloaded into an emacs about to be dumped.
 103        ;; So arrange for the auto-save itimer to be started once emacs
 104        ;; is launched.
 105        (add-hook 'after-init-hook 'itimer-init-auto-gc))
 106       (t
 107        ;; Otherwise, this file is being loaded into a normal, interactive
 108        ;; emacs.  Start the auto-save timer now.
 109        (itimer-init-auto-gc)))
 110
 111
 112 ;;; itimer-autosave.el ends here