|
|
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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.