home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / auto-gc.el < prev    next >
Encoding:
Text File  |  1993-03-20  |  10.9 KB  |  296 lines
  1. ;; Automatic garbage collection in the background.
  2. ;; Automatic logouts after being idle a certain period of time.
  3. ;;
  4.  
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation; either version 2 of the License, or
  8. ;; (at your option) any later version.
  9.  
  10. ;; This program is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;; GNU General Public License for more details.
  14.  
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with this program; if not, write to the Free Software
  17. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. ;; LCD Archive Entry:
  20. ;; auto-gc|Radey Shouman and Ivan Vazquez|rshouman@chpc.utexas.edu|
  21. ;; Garbage collection in the background.|
  22. ;; 18-Mar-1993|1.0|~/misc/auto-gc.el.Z|
  23.  
  24.  
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26. ;; auto-gc.el     automatically garbage collect in the background when
  27. ;;                user is apparently resting.  Prevents emacs from
  28. ;;                sitting idle for hours, and then, just as you press
  29. ;;                the first key, saying "garbage collecting...".
  30. ;;
  31. ;;                This package also allows the user to have their emacs
  32. ;;                auto-logout.  I found this useful to use when dialed
  33. ;;                up from home so that my emacs will auto-logout and
  34. ;;                the terminal line will notice that it is idle and
  35. ;;                log me off, otherwise the time/load mode line
  36. ;;                changes keep the dialup line alive.
  37. ;;
  38. ;;                
  39. ;;
  40. ;; author:  Radey Shouman   (auto-gc)     rshouman@chpc.utexas.edu
  41. ;;          Ivan Vazquez   (auto-logout)  ivan@haldane.bu.edu
  42. ;;
  43. ;; filename: auto-gc.el
  44. ;; $modified: Fri Mar 19 22:15:34 1993 by rshouman $
  45. ;;
  46. ;; Installation:  byte-compile it,
  47. ;;
  48. ;; (require 'auto-gc)
  49. ;; (auto-gc 1)
  50. ;; (auto-logout 1)
  51. ;;       or
  52. ;; (autoload 'auto-gc "auto-gc"
  53. ;;    "Garbage collect when user isn't looking. " t)
  54. ;; (autoload 'auto-logout "auto-gc"
  55. ;;    "Kill emacs when user has been idle too long." t)
  56. ;;
  57. ;; Configuration:
  58. ;;  o If you don't want "gc " in your mode line, set the variable
  59. ;;    auto-gc-mode-string to ""
  60. ;;  o You can call additional functions when auto-gc-filter executes
  61. ;;    by setting the hook variables auto-gc-hooks, auto-gc-gc-hooks, 
  62. ;;    auto-gc-start-hooks, and auto-gc-dead-hooks.  Read the code to
  63. ;;    see where these are run.
  64. ;;  o Setting the variable auto-gc-display-time to t will cause
  65. ;;    functions to be added to these hooks to display the current time
  66. ;;    in the mode line.  Set this varible to nil if you don't want this.
  67. ;;  o To change how often automatic gc may be done, set the variable
  68. ;;    auto-gc-interval (default is 30 seconds).
  69. ;;  o To change the delay before automatic logout, set the variable
  70. ;;    auto-logout-time (default is 60 mins).
  71. ;;  o There is a hook variable, auto-logout-hook, for cleaning up before
  72. ;;    logout.  Read the code to see where this is run.
  73. ;;  o The variable auto-gc-quiet will be bound to executing-kbd-macro
  74. ;;    when automatic gc is done, the "garbage collecting..." message
  75. ;;    might be suppressed.  This is an undocumented feature of emacs,
  76. ;;    use at your own risk.  (Thanks to Joe Wells for posting this
  77. ;;    trick.)
  78. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  79.  
  80. (provide 'auto-gc)
  81.  
  82. ;;; auto-gc variables:
  83. ;;;
  84.  
  85. (defvar auto-gc nil
  86.   "*If non-nil, auto-gc-filter will do automatic garbage-collection, if
  87. nil, auto-gc-filter will not do garbage collection, or change the value
  88. of this-command, but its process will continue to run. ")
  89.  
  90. (defvar auto-gc-interval 30
  91.   "*How often to check to see whether any interactive commands have been
  92. executed.  Automatic garbage collection should happen sometime between
  93. auto-gc-interval and twice auto-gc-interval seconds after the last interactive
  94. command.")
  95.  
  96. (defvar auto-gc-process nil
  97.   "*Process used for automatic garbage collection. ")
  98.  
  99. (defvar auto-gc-mode-string " gc "
  100.   "*String added to global mode line when automatic garbage collection is
  101. enabled, setting this to \"\" will result in nothing being added to the 
  102. global mode line. ")
  103.  
  104. (defvar auto-gc-hooks nil
  105.   "*Function or list of functions to run every auto-gc-interval seconds. 
  106. These functions are run whether or not auto-gc is non-nil. ")
  107.  
  108. (defvar auto-gc-gc-hooks nil
  109.   "*Function or list of functions to run every time automatic garbage 
  110. collection is done.  Put long, annoying processes here. ")
  111.  
  112. (defvar auto-gc-start-hooks nil
  113.   "*Function or list of functions to run when the auto-gc is started. ")
  114.  
  115. (defvar auto-gc-dead-hooks nil
  116.   "*Function or list of functions to run when the auto-gc process dies. ")
  117.  
  118. (defvar auto-gc-display-time t
  119.   "*If non-nil, the auto-gc process will display the time, using
  120. display-time-sentinel from the time library. ")
  121.  
  122. (defvar auto-gc-quiet nil
  123.   "*This value will be bound to the variable executing-kbd-macro when
  124. doing background garbage collection.  A non-nil value will, with some
  125. versions of emacs, inhibit printing the message \"garbage collecting...\".
  126. This is an undocumented feature of emacs, which may disappear, so use at
  127. your own risk. ")
  128.  
  129. ;;; auto-logout variables:
  130. ;;;
  131.  
  132. (defvar auto-logout nil
  133.   "*If non-nil will automatically kill emacs after auto-logout-time
  134. minutes.  (default is 60 minutes.)")
  135.  
  136. (defvar auto-logout-debug nil
  137.   "*If non-nil will print debugging messages for auto-logout.")
  138.  
  139. (defvar auto-logout-time 60 ; One hour  
  140.   "*Time in minutes that will log out this emacs.")
  141.  
  142. (defvar auto-logout-hook nil
  143.   "*Function or list of functions that will be called upon the
  144. auto-logout.  i.e. right before quitting.")
  145.   
  146. (defvar auto-logout-test
  147.   '(lambda (time-idle) (>= time-idle auto-logout-time))
  148.   "*Function which will return whether or not to logout.  
  149. Gets passed one arg, time-idle in minutes.")
  150.  
  151. (defvar auto-logout-tics 0
  152.   "Number of times that auto-gc has been called since the last
  153. interactive-command.  One tic is auto-gc-interval seconds (default 30). ")
  154.  
  155. ;;; auto-gc code:
  156. ;;;
  157.  
  158. (defun auto-gc-dead-display-time-hook ()
  159.   (setq display-time-string ""))
  160.  
  161. (defun auto-gc-start-display-time-hook ()
  162.   (or (memq 'display-time-string global-mode-string)
  163.       (setq global-mode-string
  164.         (append global-mode-string '(display-time-string))))
  165.   (setq display-time-string ""))
  166.  
  167. ;;display-time-filter doesn't actually do anything with it's arguments.
  168. (defun auto-gc-display-time-hook ()
  169.   (display-time-filter proc string))
  170.  
  171. ;; Do the right thing, be HOOKS  a symbol, a lambda expression, or a list.
  172. ;; Returns new value for hooks, containing the symbol more-hook.
  173. ;; Return value is always a list.
  174. (defun auto-add-hook (hook-sym new-hook)
  175.   (or (boundp hook-sym)
  176.       (set hook-sym nil))
  177.   (setq hooks (symbol-value hook-sym))
  178.   (set hook-sym 
  179.        (cond ((listp hooks)
  180.           (if (eq (car hooks) 'lambda)
  181.           (list hooks new-hook)
  182.         (if (memq new-hook hooks)
  183.             hooks
  184.           (cons new-hook hooks))))
  185.          ((symbolp hooks)
  186.           (if (eq hooks new-hook)
  187.           hooks
  188.         (list hooks new-hook)))
  189.          (t (error "can't add hook to %s" hooks)))))
  190.  
  191. (if auto-gc-display-time
  192.     ;; Install display-time functions in auto-gc hooks.
  193.     (progn
  194.       (or (fboundp 'display-time-sentinel) ;time.el doesn't provide anything.
  195.       (load-library "time"))
  196.       (auto-add-hook 'auto-gc-start-hooks 'auto-gc-start-display-time-hook)
  197.       (auto-add-hook 'auto-gc-dead-hooks 'auto-gc-dead-display-time-hook)
  198.       (auto-add-hook 'auto-gc-hooks 'auto-gc-display-time-hook)))
  199.  
  200. (defun auto-gc (&optional arg)
  201.   "Toggle automatic background garbage collection.
  202. With arg, turn  on iff arg is positive. "
  203.   (interactive "P")
  204.   (setq auto-gc
  205.     (if (null arg) (not auto-gc)
  206.       (> (prefix-numeric-value arg) 0)))
  207.   (or global-mode-string (setq global-mode-string '("")))
  208.   (if (not auto-gc)
  209.       (setq global-mode-string (delq 'auto-gc-mode-string global-mode-string))
  210.     (if (and auto-gc-process
  211.          (eq (process-status auto-gc-process) 'run))
  212.     (setq auto-gc t)
  213.       (if auto-gc-process
  214.       (delete-process auto-gc-process))
  215.       (let ((process-connection-type nil)) ;No need for a pty here.
  216.     (setq auto-gc-process
  217.           (start-process "auto-gc" nil
  218.                  (expand-file-name "wakeup" exec-directory)
  219.                  (int-to-string auto-gc-interval))))
  220.       (process-kill-without-query auto-gc-process)
  221.       (set-process-sentinel auto-gc-process 'auto-gc-sentinel)
  222.       (set-process-filter auto-gc-process 'auto-gc-filter)
  223.       (run-hooks 'auto-gc-start-hooks))
  224.     (or (memq 'auto-gc-mode-string global-mode-string)
  225.     (setq global-mode-string
  226.           (append global-mode-string '(auto-gc-mode-string))))))
  227.   
  228. (defun auto-gc-sentinel (proc reason)
  229.   (if (eq (process-status proc) 'run)
  230.       nil
  231.     (delq 'auto-gc-mode-string global-mode-string)
  232.     (run-hooks 'auto-gc-dead-hooks)
  233.     (delete-process proc)
  234.     (setq auto-gc nil))
  235.   ;; Force mode-line updates
  236.   (save-excursion (set-buffer (other-buffer)))
  237.   (set-buffer-modified-p (buffer-modified-p))
  238.   (sit-for 0))
  239.  
  240. ;; This function works by checking the value of the variable this-command,
  241. ;; setting it to 'auto-gc if that is not its value already.  this-command is
  242. ;; set to reflect the interactive command being executed when a command is
  243. ;; called, replacing whatever value it had before.  For interactive commands,
  244. ;; the value of this-command is copied to last-command when returning to the
  245. ;; top of the command loop, since this isn't an interactive command it doesn't
  246. ;; result in last-command being changed, hence it shouldn't interfere with
  247. ;; commands like yank-pop, that check the value of last-command.
  248. (defun auto-gc-filter (proc string)
  249.   (and (boundp 'auto-gc-debug) auto-gc-debug
  250.        (message "this %s; last %s" this-command last-command))
  251.   (run-hooks 'auto-gc-hooks)
  252.   (if auto-gc
  253.       (if (eq this-command 'auto-gc)
  254.       (if (= (minibuffer-depth) 0)
  255.           (progn
  256.         (run-hooks 'auto-gc-gc-hooks)
  257.         (let ((gc-cons-threshold 10000)
  258.               (executing-kbd-macro auto-gc-quiet))
  259.           (sit-for 0))))
  260.     (setq this-command 'auto-gc))))
  261.   
  262. ;;; auto-logout code:
  263. ;;;
  264.  
  265. (defun auto-logout (&optional arg)
  266.   "Toggle doing auto-logouts.
  267. Arg positive means on."
  268.   (interactive "P")
  269.   (setq auto-logout
  270.     (if (null arg) (not auto-logout)
  271.         (> (prefix-numeric-value arg) 0)))
  272.   (auto-gc 1)
  273.   (auto-add-hook 'auto-gc-hooks 'auto-logout-hook-fn))
  274.  
  275. (defun auto-logout-hook-fn ()
  276.   (if auto-logout
  277.       (cond ((and (eq this-command 'auto-gc)
  278.           (= (minibuffer-depth) 0))
  279.          ;; Ok we're officially Idle.
  280.          (progn
  281.            (setq auto-logout-tics (1+ auto-logout-tics))
  282.            (and auto-logout-debug
  283.             (message "auto-logout-tics = %d" auto-logout-tics))
  284.            (if (funcall auto-logout-test
  285.                 (/ (* auto-logout-tics auto-gc-interval) 60))
  286.            (progn 
  287.              (do-auto-save)
  288.              (message "Timed out!")
  289.              (run-hooks 'auto-logout-hooks)
  290.              (kill-emacs t)))))
  291.          (t
  292.           (and auto-logout-debug
  293.            (message  "Resetting auto-logout-tics"))
  294.           (setq auto-logout-tics 0)))))
  295.  
  296.