home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / gnu / emacs-18.59-bin.lha / lib / emacs / 18.59 / lisp / saveconf.el < prev    next >
Lisp/Scheme  |  1988-08-15  |  9KB  |  241 lines
  1. ;;; Save Emacs buffer and window configuration between editing sessions.
  2. ;;; Copyright (C) 1987, 1988 Kyle E. Jones
  3. ;;;
  4. ;;; Verbatim copies of this file may be freely redistributed.
  5. ;;;
  6. ;;; Modified versions of this file may be redistributed provided that this
  7. ;;; notice remains unchanged, the file contains prominent notice of
  8. ;;; author and time of modifications, and redistribution of the file
  9. ;;; is not further restricted in any way.
  10. ;;;
  11. ;;; This file is distributed `as is', without warranties of any kind.
  12.  
  13. (provide 'saveconf)
  14.  
  15. (defconst save-context-version "Norma Jean"
  16.   "A unique string which is placed at the beginning of every saved context
  17. file.  If the string at the beginning of the context file doesn't match the
  18. value of this variable the `recover-context' command will ignore the file's
  19. contents.")
  20.  
  21. (defvar auto-save-and-recover-context nil
  22.   "*If non-nil the `save-context' command will always be run before Emacs is
  23. exited.  Also upon Emacs startup, if this variable is non-nil and Emacs is
  24. passed no command line arguments, `recover-context' will be run.")
  25.  
  26. (defvar save-buffer-context nil
  27.   "*If non-nil the `save-context' command will save the context
  28. of buffers that are visiting files, as well as the contexts of buffers
  29. that have windows.")
  30.  
  31. (defvar save-context-predicate
  32.   (function (lambda (w)
  33.           (and (buffer-file-name (window-buffer w))
  34.            (not (string-match "^\\(/usr\\)?/tmp/"
  35.                       (buffer-file-name (window-buffer w)))))))
  36.   "*Value is a predicate function which determines which windows' contexts
  37. are saved.  When the `save-context' command is invoked, this function will
  38. be called once for each existing Emacs window.  The function should accept
  39. one argument which will be a window object, and should return non-nil if
  40. the window's context should be saved.")
  41.  
  42.  
  43. ;; kill-emacs' function definition must be saved
  44. (if (not (fboundp 'just-kill-emacs))
  45.     (fset 'just-kill-emacs (symbol-function 'kill-emacs)))
  46.  
  47. ;; Make Emacs call recover-context at startup if appropriate.
  48. (setq top-level
  49.       (list 'let '((starting-up (not command-line-processed)))
  50.         (list 'prog1
  51.           top-level
  52.           '(and starting-up auto-save-and-recover-context
  53.             (null (cdr command-line-args)) (recover-context)))))
  54.  
  55. (defun kill-emacs (&optional query)
  56.   "End this Emacs session.
  57. Prefix ARG or optional first ARG non-nil means exit with no questions asked,
  58. even if there are unsaved buffers.  If Emacs is running non-interactively
  59. and ARG is an integer, then Emacs exits with ARG as its exit code.
  60.  
  61. If the variable `auto-save-and-restore-context' is non-nil,
  62. the function save-context will be called first."
  63.   (interactive "P")
  64.   ;; check the purify flag.  try to save only if this is a dumped Emacs.
  65.   ;; saving context from a undumped Emacs caused a NULL pointer to be
  66.   ;; referenced through.  I'm not sure why.
  67.   (if (and auto-save-and-recover-context (null purify-flag))
  68.       (save-context))
  69.   (just-kill-emacs query))
  70.  
  71. (defun save-context ()
  72.   "Save context of all Emacs windows (files visited and position of point).
  73. The information goes into a file called .emacs_<username> in the directory
  74. where the Emacs session was started.  The context can be recovered with the
  75. `recover-context' command, provided you are in the same directory where
  76. the context was saved.
  77.  
  78. If the variable `save-buffer-context' is non-nil, the context of all buffers
  79. visiting files will be saved as well.
  80.  
  81. Window sizes and shapes are not saved, since these may not be recoverable
  82. on terminals with a different number of rows and columns."
  83.   (interactive)
  84.   (condition-case error-data
  85.       (let (context-buffer mark save-file-name)
  86.     (setq save-file-name (concat (original-working-directory)
  87.                      ".emacs_" (user-login-name)))
  88.     (if (not (file-writable-p save-file-name))
  89.         (if (file-writable-p (original-working-directory))
  90.         (error "context is write-protected, %s" save-file-name)
  91.           (error "can't access directory, %s"
  92.              (original-working-directory))))
  93.     ;;
  94.     ;; set up a buffer for the saved context information
  95.     ;; Note that we can't set the visited file yet, because by
  96.     ;; giving the buffer a file to visit we are making it
  97.     ;; eligible to have it's context saved.
  98.     ;;
  99.     (setq context-buffer (get-buffer-create " *Context Info*"))
  100.     (set-buffer context-buffer)
  101.     (erase-buffer)
  102.     (set-buffer-modified-p nil)
  103.     ;;
  104.     ;; record the context information
  105.     ;;
  106.     (mapcar
  107.      (function
  108.       (lambda (w)
  109.         (cond ((funcall save-context-predicate w)
  110.            (prin1 (buffer-file-name (window-buffer w)) context-buffer)
  111.            (princ " " context-buffer)
  112.            (prin1 (window-point w) context-buffer)
  113.            (princ "\n" context-buffer)))))
  114.      (window-list))
  115.     
  116.     ;;
  117.     ;; nil is the data sentinel.  We will insert it later if we
  118.     ;; need it but for now just remember where the last line of
  119.     ;; window context ended.
  120.     ;;
  121.     (setq mark (point))
  122.  
  123.     ;;
  124.     ;; If `save-buffer-context' is non-nil we save buffer contexts.
  125.     ;;
  126.     (if save-buffer-context
  127.         (mapcar
  128.          (function
  129.           (lambda (b)
  130.         (set-buffer b)
  131.         (cond (buffer-file-name
  132.                (prin1 buffer-file-name context-buffer)
  133.                (princ " " context-buffer)
  134.                (prin1 (point) context-buffer)
  135.                (princ "\n" context-buffer)))))
  136.          (buffer-list)))
  137.  
  138.     ;;
  139.     ;; If the context-buffer contains information, we add the version
  140.     ;;   string and sentinels, and write out the saved context.
  141.     ;; If the context-buffer is empty, we don't create a file at all.
  142.     ;; If there's an old saved context in this directory we attempt
  143.     ;;   to delete it.
  144.     ;;
  145.     (cond ((buffer-modified-p context-buffer)
  146.            (set-buffer context-buffer)
  147.            (setq buffer-offer-save nil)
  148.            ;; sentinel for EOF
  149.            (insert "nil\n")
  150.            ;; sentinel for end of window contexts
  151.            (goto-char mark)
  152.            (insert "nil\n")
  153.            ;; version string
  154.            (goto-char (point-min))
  155.            (prin1 save-context-version context-buffer)
  156.            (insert "\n\n")
  157.            ;; so kill-buffer won't need confirmation later
  158.            (set-buffer-modified-p nil)
  159.            ;; save it
  160.            (write-region (point-min) (point-max) save-file-name
  161.                  nil 'quiet))
  162.           (t (condition-case data
  163.              (delete-file save-file-name) (error nil))))
  164.  
  165.     (kill-buffer context-buffer))
  166.     (error nil)))
  167.  
  168. (defun recover-context ()
  169.   "Recover an Emacs context saved by `save-context' command.
  170. Files that were visible in windows when the context was saved are visited and
  171. point is set in each window to what is was when the context was saved."
  172.   (interactive)
  173.   ;;
  174.   ;; Set up some local variables.
  175.   ;;
  176.   (condition-case error-data
  177.       (let (sexpr context-buffer recover-file-name)
  178.     (setq recover-file-name (concat (original-working-directory)
  179.                     ".emacs_" (user-login-name)))
  180.     (if (not (file-readable-p recover-file-name))
  181.         (error "can't access context, %s" recover-file-name))
  182.     ;;
  183.     ;; create a temp buffer and copy the saved context into it.
  184.     ;;
  185.     (setq context-buffer (get-buffer-create " *Recovered Context*"))
  186.     (set-buffer context-buffer)
  187.     (erase-buffer)
  188.     (insert-file-contents recover-file-name nil)
  189.     ;; so kill-buffer won't need confirmation later
  190.     (set-buffer-modified-p nil)
  191.     ;;
  192.     ;; If it's empty forget it.
  193.     ;;
  194.     (if (zerop (buffer-size))
  195.         (error "context file is empty, %s" recover-file-name))
  196.     ;;
  197.     ;; check the version and make sure it matches ours
  198.     ;;
  199.     (setq sexpr (read context-buffer))
  200.     (if (not (equal sexpr save-context-version))
  201.         (error "version string incorrect, %s" sexpr))
  202.     ;;
  203.     ;; Recover the window contexts
  204.     ;;
  205.     (while (setq sexpr (read context-buffer))
  206.       (select-window (get-largest-window))
  207.       (if (buffer-file-name)
  208.           (split-window))
  209.       (other-window 1)
  210.       (find-file sexpr)
  211.       (goto-char (read context-buffer)))
  212.     ;;
  213.     ;; Recover buffer contexts, if any.
  214.     ;;
  215.     (while (setq sexpr (read context-buffer))
  216.       (set-buffer (find-file-noselect sexpr))
  217.       (goto-char (read context-buffer)))
  218.     (bury-buffer "*scratch*")
  219.     (kill-buffer context-buffer))
  220.     (error nil)))
  221.      
  222. (defun original-working-directory ()
  223.   (save-excursion
  224.     (set-buffer (get-buffer-create "*scratch*"))
  225.     default-directory))
  226.  
  227. (defun window-list (&optional mini)
  228.   "Returns a list of Lisp window objects for all Emacs windows.
  229. Optional first arg MINIBUF t means include the minibuffer window
  230. in the list, even if it is not active.  If MINIBUF is neither t
  231. nor nil it means to not count the minibuffer window even if it is active."
  232.   (let* ((first-window (next-window (previous-window (selected-window)) mini))
  233.      (windows (cons first-window nil))
  234.      (current-cons windows)
  235.      (w (next-window first-window mini)))
  236.     (while (not (eq w first-window))
  237.       (setq current-cons (setcdr current-cons (cons w nil)))
  238.       (setq w (next-window w mini)))
  239.     windows))
  240.  
  241.