Annotation of 43BSDReno/contrib/emacs-18.55/lisp/saveconf.el, revision 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.