Mercurial > emacs
comparison lisp/desktop.el @ 5788:913f27480fad
(desktop-internal-v2s): Allow saving of markers and subrs.
(desktop-delay-hook): New variable.
(desktop-read): Run desktop-delay-hook.
(desktop-globals-to-save): Save register-alist.
Always make desktop-locals-to-save local.
(desktop-value-to-string): Make sure floating point numbers are
output with maximum accuracy.
(desktop-bug-report): New function.
(desktop-internal-v2s): New function.
(desktop-value-to-string): Use above function.
(desktop-buffers-not-to-save): Add regexp for "nn" temporary files.
(desktop-save, <top-level>): Remove support for Emacs 18, because
it's not worth the effort and didn't work anymore, anyway.
(desktop-save): Needn't bind `print-escape-newlines' anymore.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 05 Feb 1994 02:23:44 +0000 |
parents | 9fcfca1caec7 |
children | 6d7ceb4493e3 |
comparison
equal
deleted
inserted
replaced
5787:bef3a67ac893 | 5788:913f27480fad |
---|---|
1 ;;; desktop.el --- save partial status of Emacs when killed | 1 ;;; desktop.el --- save partial status of Emacs when killed |
2 | 2 |
3 ;; Copyright (C) 1993 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Morten Welinder <terra@diku.dk> | 5 ;; Author: Morten Welinder <terra@diku.dk> |
6 ;; Version: 2.05 | 6 ;; Version: 2.07 |
7 ;; Keywords: customization | 7 ;; Keywords: customization |
8 ;; Favourite-brand-of-beer: None, I hate beer. | 8 ;; Favourite-brand-of-beer: None, I hate beer. |
9 | 9 |
10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
11 | 11 |
41 ;; (load "desktop") | 41 ;; (load "desktop") |
42 ;; (desktop-load-default) | 42 ;; (desktop-load-default) |
43 ;; (desktop-read) | 43 ;; (desktop-read) |
44 ;; | 44 ;; |
45 ;; Between the second and the third line you may wish to add something that | 45 ;; Between the second and the third line you may wish to add something that |
46 ;; updates the variables `desktop-globals-to-save' and/or | 46 ;; updates the variables `desktop-globals-to-save' and/or |
47 ;; `desktop-locals-to-save'. If for instance you want to save the local | 47 ;; `desktop-locals-to-save'. If for instance you want to save the local |
48 ;; variable `foobar' for every buffer in which it is local, you could add | 48 ;; variable `foobar' for every buffer in which it is local, you could add |
49 ;; the line | 49 ;; the line |
50 ;; | 50 ;; |
51 ;; (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save)) | 51 ;; (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save)) |
52 ;; | 52 ;; |
53 ;; To avoid saving excessive amounts of data you may also with to add | 53 ;; To avoid saving excessive amounts of data you may also with to add |
54 ;; something like the following | 54 ;; something like the following |
55 ;; | 55 ;; |
56 ;; (add-hook 'kill-emacs-hook | 56 ;; (add-hook 'kill-emacs-hook |
57 ;; '(lambda () | 57 ;; '(lambda () |
58 ;; (desktop-truncate search-ring 3) | 58 ;; (desktop-truncate search-ring 3) |
59 ;; (desktop-truncate regexp-search-ring 3))) | 59 ;; (desktop-truncate regexp-search-ring 3))) |
60 ;; | 60 ;; |
61 ;; which will make sure that no more than three search items are saved. You | 61 ;; which will make sure that no more than three search items are saved. You |
62 ;; must place this line *after* the (load "desktop") line. | 62 ;; must place this line *after* the (load "desktop") line. |
65 ;; is inactive by default. You activate it by M-x desktop-save RET. When | 65 ;; is inactive by default. You activate it by M-x desktop-save RET. When |
66 ;; you exit the next time the above data will be saved. This ensures that | 66 ;; you exit the next time the above data will be saved. This ensures that |
67 ;; all the files you were editing will be reloaded the next time you start | 67 ;; all the files you were editing will be reloaded the next time you start |
68 ;; Emacs from the same directory and that points will be set where you | 68 ;; Emacs from the same directory and that points will be set where you |
69 ;; left them. If you save a desktop file in your home directory it will | 69 ;; left them. If you save a desktop file in your home directory it will |
70 ;; act as a default desktop when you start Emacs from a directory that | 70 ;; act as a default desktop when you start Emacs from a directory that |
71 ;; doesn't have its own. I never do this, but you may want to. | 71 ;; doesn't have its own. I never do this, but you may want to. |
72 | 72 |
73 ;; By the way: don't use desktop.el to customize Emacs -- the file .emacs | 73 ;; By the way: don't use desktop.el to customize Emacs -- the file .emacs |
74 ;; in your home directory is used for that. Saving global default values | 74 ;; in your home directory is used for that. Saving global default values |
75 ;; for buffers is an example of misuse. | 75 ;; for buffers is an example of misuse. |
76 | 76 |
77 ;; PLEASE NOTE: The kill ring can be saved as specified by the variable | 77 ;; PLEASE NOTE: The kill ring can be saved as specified by the variable |
78 ;; `desktop-globals-to-save' (by default it isn't). This may result in saving | 78 ;; `desktop-globals-to-save' (by default it isn't). This may result in saving |
79 ;; things you did not mean to keep. Use M-x desktop-clear RET. | 79 ;; things you did not mean to keep. Use M-x desktop-clear RET. |
80 | |
81 ;; To submit a bug report, please use the command desktop-bug-report | |
80 | 82 |
81 ;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas. | 83 ;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas. |
82 ;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. | 84 ;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. |
83 ;; chris@tecc.co.uk (Chris Boucher) for a mark tip. | 85 ;; chris@tecc.co.uk (Chris Boucher) for a mark tip. |
84 ;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. | 86 ;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. |
93 ;;; Code: | 95 ;;; Code: |
94 | 96 |
95 ;; Make the compilation more silent | 97 ;; Make the compilation more silent |
96 (eval-when-compile | 98 (eval-when-compile |
97 ;; We use functions from these modules | 99 ;; We use functions from these modules |
98 (mapcar 'require '(info mh-e dired)) | 100 (mapcar 'require '(info mh-e dired reporter))) |
99 ;; We handle auto-fill-hook in a way that is ok. | |
100 (put 'auto-fill-hook 'byte-obsolete-variable nil) | |
101 ;; Some things are different in version 18. | |
102 (setq postv18 (string-lessp "19" emacs-version))) | |
103 ;; ---------------------------------------------------------------------------- | 101 ;; ---------------------------------------------------------------------------- |
104 ;; USER OPTIONS -- settings you might want to play with. | 102 ;; USER OPTIONS -- settings you might want to play with. |
105 ;; ---------------------------------------------------------------------------- | 103 ;; ---------------------------------------------------------------------------- |
106 (defconst desktop-basefilename | 104 (defconst desktop-basefilename |
107 (if (equal system-type 'ms-dos) | 105 (if (eq system-type 'ms-dos) |
108 "emacs.dsk" ; Ms-Dos does not support multiple dots in file name | 106 "emacs.dsk" ; Ms-Dos does not support multiple dots in file name |
109 ".emacs.desktop") | 107 ".emacs.desktop") |
110 "File for Emacs desktop. A directory name will be prepended to this name.") | 108 "File for Emacs desktop. A directory name will be prepended to this name.") |
111 | 109 |
112 (defvar desktop-missing-file-warning t | 110 (defvar desktop-missing-file-warning t |
119 ;; 'kill-ring | 117 ;; 'kill-ring |
120 'tags-file-name | 118 'tags-file-name |
121 'tags-table-list | 119 'tags-table-list |
122 'search-ring | 120 'search-ring |
123 'regexp-search-ring | 121 'regexp-search-ring |
122 'register-alist | |
124 ;; 'desktop-globals-to-save ; Itself! | 123 ;; 'desktop-globals-to-save ; Itself! |
125 ) | 124 ) |
126 "List of global variables to save when killing Emacs.") | 125 "List of global variables to save when killing Emacs.") |
127 | 126 |
128 (defvar desktop-locals-to-save | 127 (defvar desktop-locals-to-save |
134 'overwrite-mode | 133 'overwrite-mode |
135 'change-log-default-name | 134 'change-log-default-name |
136 ) | 135 ) |
137 "List of local variables to save for each buffer. The variables are saved | 136 "List of local variables to save for each buffer. The variables are saved |
138 only when they really are local.") | 137 only when they really are local.") |
138 (make-variable-buffer-local 'desktop-locals-to-save) | |
139 | 139 |
140 ;; We skip .log files because they are normally temporary. | 140 ;; We skip .log files because they are normally temporary. |
141 ;; (ftp) files because they require passwords and whatsnot. | 141 ;; (ftp) files because they require passwords and whatsnot. |
142 ;; TAGS files to save time (tags-file-name is saved instead). | 142 ;; TAGS files to save time (tags-file-name is saved instead). |
143 (defvar desktop-buffers-not-to-save | 143 (defvar desktop-buffers-not-to-save |
144 "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" | 144 "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" |
145 "Regexp identifying buffers that are to be excluded from saving.") | 145 "Regexp identifying buffers that are to be excluded from saving.") |
146 | 146 |
147 (defvar desktop-buffer-handlers | 147 (defvar desktop-buffer-handlers |
148 '(desktop-buffer-dired | 148 '(desktop-buffer-dired |
149 desktop-buffer-rmail | 149 desktop-buffer-rmail |
165 (defconst desktop-header | 165 (defconst desktop-header |
166 ";; -------------------------------------------------------------------------- | 166 ";; -------------------------------------------------------------------------- |
167 ;; Desktop File for Emacs | 167 ;; Desktop File for Emacs |
168 ;; -------------------------------------------------------------------------- | 168 ;; -------------------------------------------------------------------------- |
169 " "*Header to place in Desktop file.") | 169 " "*Header to place in Desktop file.") |
170 | |
171 (defvar desktop-delay-hook nil | |
172 "Hooks run after all buffers are loaded; intended for internal use.") | |
170 ;; ---------------------------------------------------------------------------- | 173 ;; ---------------------------------------------------------------------------- |
171 (defun desktop-truncate (l n) | 174 (defun desktop-truncate (l n) |
172 "Truncate LIST to at most N elements destructively." | 175 "Truncate LIST to at most N elements destructively." |
173 (let ((here (nthcdr (1- n) l))) | 176 (let ((here (nthcdr (1- n) l))) |
174 (if (consp here) | 177 (if (consp here) |
175 (setcdr here nil)))) | 178 (setcdr here nil)))) |
176 ;; ---------------------------------------------------------------------------- | 179 ;; ---------------------------------------------------------------------------- |
177 (defun desktop-clear () "Empty the Desktop." | 180 (defun desktop-clear () "Empty the Desktop." |
178 (interactive) | 181 (interactive) |
179 (setq kill-ring nil) | 182 (setq kill-ring nil) |
180 (setq kill-ring-yank-pointer nil) | 183 (setq kill-ring-yank-pointer nil) |
181 (mapcar (function kill-buffer) (buffer-list)) | 184 (mapcar (function kill-buffer) (buffer-list)) |
182 (delete-other-windows)) | 185 (delete-other-windows)) |
183 ;; ---------------------------------------------------------------------------- | 186 ;; ---------------------------------------------------------------------------- |
184 ;; This is a bit dirty for version 18 because that version of Emacs was not | 187 (add-hook 'kill-emacs-hook 'desktop-kill) |
185 ;; toilet-trained considering hooks. | 188 |
186 (defvar old-kill-emacs) | |
187 | |
188 (if (eval-when-compile postv18) | |
189 (add-hook 'kill-emacs-hook 'desktop-kill) | |
190 (if (not (boundp 'desktop-kill)) | |
191 (setq old-kill-emacs kill-emacs-hook | |
192 kill-emacs-hook | |
193 (function (lambda () | |
194 (progn (desktop-kill) | |
195 (if (or (null old-kill-emacs) | |
196 (symbolp old-kill-emacs)) | |
197 (run-hooks old-kill-emacs) | |
198 (funcall old-kill-emacs)))))))) | |
199 ;; ---------------------------------------------------------------------------- | |
200 (defun desktop-kill () | 189 (defun desktop-kill () |
201 (if desktop-dirname | 190 (if desktop-dirname |
202 (progn | 191 (progn |
203 (desktop-save desktop-dirname)))) | 192 (desktop-save desktop-dirname)))) |
204 ;; ---------------------------------------------------------------------------- | 193 ;; ---------------------------------------------------------------------------- |
194 (defun desktop-internal-v2s (val) | |
195 "Convert VALUE to a pair (quote . txt) where txt is a string that when read | |
196 and evaluated yields value. quote may be 'may (value may be quoted), | |
197 'must (values must be quoted), or nil (value may not be quoted)." | |
198 (cond | |
199 ((or (numberp val) (stringp val) (null val) (eq t val)) | |
200 (cons 'may (prin1-to-string val))) | |
201 ((symbolp val) | |
202 (cons 'must (prin1-to-string val))) | |
203 ((vectorp val) | |
204 (let* ((special nil) | |
205 (pass1 (mapcar | |
206 (lambda (el) | |
207 (let ((res (desktop-internal-v2s el))) | |
208 (if (null (car res)) | |
209 (setq special t)) | |
210 res)) | |
211 val))) | |
212 (if special | |
213 (cons nil (concat "(vector " | |
214 (mapconcat (lambda (el) | |
215 (if (eq (car el) 'must) | |
216 (concat "'" (cdr el)) | |
217 (cdr el))) | |
218 pass1 | |
219 " ") | |
220 ")")) | |
221 (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) | |
222 ((consp val) | |
223 (let ((car-q.txt (desktop-internal-v2s (car val))) | |
224 (cdr-q.txt (desktop-internal-v2s (cdr val)))) | |
225 (cond | |
226 ((or (null (car car-q.txt)) (null (car cdr-q.txt))) | |
227 (cons nil (concat "(cons " | |
228 (if (eq (car car-q.txt) 'must) "'") | |
229 (cdr car-q.txt) " " | |
230 (if (eq (car cdr-q.txt) 'must) "'") | |
231 (cdr cdr-q.txt) ")"))) | |
232 ((consp (cdr val)) | |
233 (cons 'must (concat "(" (cdr car-q.txt) | |
234 " " (substring (cdr cdr-q.txt) 1 -1) ")"))) | |
235 ((null (cdr val)) | |
236 (cons 'must (concat "(" (cdr car-q.txt) ")"))) | |
237 (t | |
238 (cons 'must (concat "(" (cdr car-q.txt) " . " (cdr cdr-q.txt) ")")))))) | |
239 ((subrp val) | |
240 (cons nil (concat "(symbol-function '" | |
241 (substring (prin1-to-string val) 7 -1) | |
242 ")"))) | |
243 ((markerp val) | |
244 (let ((pos (prin1-to-string (marker-position val))) | |
245 (buf (prin1-to-string (buffer-name (marker-buffer val))))) | |
246 (cons nil (concat "(let ((mk (make-marker)))" | |
247 " (add-hook 'desktop-delay-hook" | |
248 " (list 'lambda '() (list 'set-marker mk " | |
249 pos " (get-buffer " buf ")))) mk)")))) | |
250 (t ; save as text | |
251 (prin1-to-string (prin1-to-string val))))) | |
252 | |
205 (defun desktop-value-to-string (val) | 253 (defun desktop-value-to-string (val) |
206 (let ((print-escape-newlines t)) | 254 "Convert VALUE to a string that when read evaluates to the same value. Not |
207 (concat | 255 all types of values are supported." |
208 ;; symbols are needed for cons cells and for symbols except | 256 (let* ((print-escape-newlines t) |
209 ;; `t' and `nil'. | 257 (float-output-format nil) |
210 (if (or (consp val) | 258 (quote.txt (desktop-internal-v2s val)) |
211 (and (symbolp val) val (not (eq t val)))) | 259 (quote (car quote.txt)) |
212 "'" | 260 (txt (cdr quote.txt))) |
213 "") | 261 (if (eq quote 'must) |
214 (prin1-to-string val)))) | 262 (concat "'" txt) |
263 txt))) | |
215 ;; ---------------------------------------------------------------------------- | 264 ;; ---------------------------------------------------------------------------- |
216 (defun desktop-outvar (var) | 265 (defun desktop-outvar (var) |
217 "Output a setq statement for VAR to the desktop file." | 266 "Output a setq statement for VAR to the desktop file." |
218 (if (boundp var) | 267 (if (boundp var) |
219 (insert "(setq " | 268 (insert "(setq " |
244 (list | 293 (list |
245 (buffer-file-name) | 294 (buffer-file-name) |
246 (buffer-name) | 295 (buffer-name) |
247 major-mode | 296 major-mode |
248 (list ; list explaining minor modes | 297 (list ; list explaining minor modes |
249 (not (null | 298 (not (null auto-fill-function))) |
250 (if (eval-when-compile postv18) | |
251 auto-fill-function | |
252 auto-fill-hook)))) | |
253 (point) | 299 (point) |
254 (if (eval-when-compile postv18) | 300 (list (mark t) mark-active) |
255 (list (mark t) mark-active) | |
256 (mark)) | |
257 buffer-read-only | 301 buffer-read-only |
258 (cond ((eq major-mode 'Info-mode) | 302 (cond ((eq major-mode 'Info-mode) |
259 (list Info-current-file | 303 (list Info-current-file |
260 Info-current-node)) | 304 Info-current-node)) |
261 ((eq major-mode 'dired-mode) | 305 ((eq major-mode 'dired-mode) |
262 (if (eval-when-compile postv18) | 306 (nreverse |
263 (nreverse | 307 (mapcar |
264 (mapcar | 308 (function car) |
265 (function car) | 309 dired-subdir-alist))) |
266 dired-subdir-alist)) | |
267 (list default-directory))) | |
268 ) | 310 ) |
269 (let ((locals desktop-locals-to-save) | 311 (let ((locals desktop-locals-to-save) |
270 (loclist (buffer-local-variables)) | 312 (loclist (buffer-local-variables)) |
271 (ll)) | 313 (ll)) |
272 (while locals | 314 (while locals |
280 ))) | 322 ))) |
281 (buffer-list)))) | 323 (buffer-list)))) |
282 (buf (get-buffer-create "*desktop*"))) | 324 (buf (get-buffer-create "*desktop*"))) |
283 (set-buffer buf) | 325 (set-buffer buf) |
284 (erase-buffer) | 326 (erase-buffer) |
285 | 327 |
286 (insert desktop-header | 328 (insert desktop-header |
287 ";; Created " (current-time-string) "\n" | 329 ";; Created " (current-time-string) "\n" |
288 ";; Emacs version " emacs-version "\n\n" | 330 ";; Emacs version " emacs-version "\n\n" |
289 ";; Global section:\n") | 331 ";; Global section:\n") |
290 (mapcar (function desktop-outvar) desktop-globals-to-save) | 332 (mapcar (function desktop-outvar) desktop-globals-to-save) |
291 (if (memq 'kill-ring desktop-globals-to-save) | 333 (if (memq 'kill-ring desktop-globals-to-save) |
292 (insert "(setq kill-ring-yank-pointer (nthcdr " | 334 (insert "(setq kill-ring-yank-pointer (nthcdr " |
293 (int-to-string | 335 (int-to-string |
294 (- (length kill-ring) (length kill-ring-yank-pointer))) | 336 (- (length kill-ring) (length kill-ring-yank-pointer))) |
295 " kill-ring))\n")) | 337 " kill-ring))\n")) |
296 | 338 |
297 (insert "\n;; Buffer section:\n") | 339 (insert "\n;; Buffer section:\n") |
298 (let ((print-escape-newlines t)) | 340 (mapcar |
299 (mapcar | 341 (function (lambda (l) |
300 (function (lambda (l) | 342 (if (apply 'desktop-save-buffer-p l) |
301 (if (apply 'desktop-save-buffer-p l) | 343 (progn |
302 (progn | 344 (insert desktop-create-buffer-form) |
303 (insert desktop-create-buffer-form) | 345 (mapcar |
304 (mapcar | 346 (function (lambda (e) |
305 (function (lambda (e) | 347 (insert "\n " |
306 (insert "\n " | 348 (desktop-value-to-string e)))) |
307 (desktop-value-to-string e)))) | 349 l) |
308 l) | 350 (insert ")\n\n"))))) |
309 (insert ")\n\n"))))) | 351 info) |
310 info)) | |
311 (setq default-directory dirname) | 352 (setq default-directory dirname) |
312 (if (file-exists-p filename) (delete-file filename)) | 353 (if (file-exists-p filename) (delete-file filename)) |
313 (write-region (point-min) (point-max) filename nil 'nomessage))) | 354 (write-region (point-min) (point-max) filename nil 'nomessage))) |
314 (setq desktop-dirname dirname)) | 355 (setq desktop-dirname dirname)) |
315 ;; ---------------------------------------------------------------------------- | 356 ;; ---------------------------------------------------------------------------- |
331 (setq desktop-dirname (expand-file-name "~/")) | 372 (setq desktop-dirname (expand-file-name "~/")) |
332 (setq desktop-dirname nil))) | 373 (setq desktop-dirname nil))) |
333 (if desktop-dirname | 374 (if desktop-dirname |
334 (progn | 375 (progn |
335 (load (concat desktop-dirname desktop-basefilename) t t t) | 376 (load (concat desktop-dirname desktop-basefilename) t t t) |
377 (run-hooks 'desktop-delay-hook) | |
336 (message "Desktop loaded.")) | 378 (message "Desktop loaded.")) |
337 (desktop-clear)))) | 379 (desktop-clear)))) |
338 ;; ---------------------------------------------------------------------------- | 380 ;; ---------------------------------------------------------------------------- |
339 (defun desktop-load-default () | 381 (defun desktop-load-default () |
340 "Load the `default' start-up library manually. Also inhibit further loading | 382 "Load the `default' start-up library manually. Also inhibit further loading |
426 (cons 'fill-column fc) | 468 (cons 'fill-column fc) |
427 (cons 'case-fold-search cfs) | 469 (cons 'case-fold-search cfs) |
428 (cons 'case-replace cr) | 470 (cons 'case-replace cr) |
429 (cons 'overwrite-mode (car mim))))) | 471 (cons 'overwrite-mode (car mim))))) |
430 ;; ---------------------------------------------------------------------------- | 472 ;; ---------------------------------------------------------------------------- |
473 (defun desktop-bug-report () | |
474 "Submit a bug report on the desktop package to the maintainer." | |
475 (interactive) | |
476 (require 'reporter) | |
477 (and (y-or-n-p "Do you really want to submit a report on desktop.el? ") | |
478 (reporter-submit-bug-report | |
479 "terra@diku.dk" | |
480 "desktop.el version 2.07" | |
481 '(desktop-basefilename | |
482 desktop-dirname | |
483 desktop-globals-to-save | |
484 desktop-buffer-handlers) | |
485 () | |
486 () | |
487 "Hi Morten!\n\nI have a problem with your desktop.el package, that\ | |
488 you might\nwant to take a look at:" | |
489 ))) | |
490 ;; ---------------------------------------------------------------------------- | |
431 (provide 'desktop) | 491 (provide 'desktop) |
432 | 492 |
433 ;; desktop.el ends here. | 493 ;; desktop.el ends here. |