Annotation of 43BSDReno/contrib/emacs-18.55/lisp/saveconf.el, revision 1.1.1.1

1.1       root        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: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.