aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2003-04-09 01:37:56 +0000
committerRichard M. Stallman2003-04-09 01:37:56 +0000
commit4a2fce7a9fdff3ede6f945e19e13154042dcb471 (patch)
treef426664bb48168086f3a27e3ede70b2c7558d0be
parent7dde432d4c75d8f76220182c2daa639e13d69297 (diff)
downloademacs-4a2fce7a9fdff3ede6f945e19e13154042dcb471.tar.gz
emacs-4a2fce7a9fdff3ede6f945e19e13154042dcb471.zip
Handle multiple desktop files in different dirs.
Other cleanups. Command line option --no-desktop introduced. (desktop-read): Record buffers in the desktop file in the same order as that in the buffer list, (desktop-save): Put buffers in the order given in desktop file, regardless of what handlers do. (desktop-file-version): New variable. Version number of desktop file format. (desktop-create-buffer-form): Variable deleted. (desktop-save): New customizable variable. (desktop-kill): Changed to use `desktop-save'. (desktop-file-name-format): New option: format in which desktop file names should be saved. (desktop-file-name): New function to convert a filename to the format specified in `desktop-file-name-format'. (desktop-create-buffer): Parameters renamed to descriptive systematic names. These parameters are visible to handlers. Renames: ver -> desktop-file-version mim -> desktop-buffer-minor-modes pt -> desktop-buffer-point mk -> desktop-buffer-mark ro -> desktop-buffer-read-only locals -> desktop-buffer-locals (desktop-buffer-major-mode, desktop-buffer-file-name) (desktop-buffer-name): Unused customizable variables deleted. (desktop-buffer-misc): Unused variable deleted. (desktop-save, desktop-buffer-dired-misc-data): Use `desktop-file-name'. (desktop-path): New customizable variable. List of directories in which to lookup the desktop file. Replaces hardcoded list. (desktop-globals-to-clear): New variable replaces hardcoded list. (desktop-clear-preserve-buffers-regexp): New customizable variable. (desktop-after-read-hook): New hook run after a desktop is read. (desktop-no-desktop-file-hook): New hook when no desktop file found. (desktop-change-dir): New function. (desktop-save-in-load-dir): New function. Save desktop in directory from witch it was loaded. (desktop-revert): New function. Revert to the last loaded desktop.
-rw-r--r--lisp/desktop.el696
1 files changed, 449 insertions, 247 deletions
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 11665272f88..197680470ee 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -99,7 +99,6 @@
99;; Save window configuration. 99;; Save window configuration.
100;; Recognize more minor modes. 100;; Recognize more minor modes.
101;; Save mark rings. 101;; Save mark rings.
102;; Start-up with buffer-menu???
103 102
104;;; Code: 103;;; Code:
105 104
@@ -108,6 +107,12 @@
108 ;; We use functions from these modules 107 ;; We use functions from these modules
109 ;; We can't (require 'mh-e) since that wants to load something. 108 ;; We can't (require 'mh-e) since that wants to load something.
110 (mapcar 'require '(info dired reporter))) 109 (mapcar 'require '(info dired reporter)))
110
111(defvar desktop-file-version "206"
112 "Verion number of desktop file format.
113Written into the desktop file and used at desktop read to provide
114backward compatibility.")
115
111;; ---------------------------------------------------------------------------- 116;; ----------------------------------------------------------------------------
112;; USER OPTIONS -- settings you might want to play with. 117;; USER OPTIONS -- settings you might want to play with.
113;; ---------------------------------------------------------------------------- 118;; ----------------------------------------------------------------------------
@@ -124,45 +129,113 @@
124 :initialize 'custom-initialize-default 129 :initialize 'custom-initialize-default
125 :version "20.3") 130 :version "20.3")
126 131
127(defcustom desktop-basefilename 132(defcustom desktop-save 'ask-if-new
133 "*When the user changes desktop or quits emacs, should the desktop be saved?
134\(in the current desktop directory)
135 t -- always save.
136 ask -- always ask.
137 ask-if-new -- ask if no desktop file exists, otherwise just save.
138 ask-if-exists -- ask if desktop file exists, otherwise don't save.
139 if-exists -- save if desktop file exists, otherwise don't save.
140 nil -- never save.
141The desktop is never saved when `desktop-enable' is nil."
142 :type '(choice
143 (const :tag "Always save" t)
144 (const :tag "Always ask" ask)
145 (const :tag "Ask if desktop file is new, else do save" ask-if-new)
146 (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
147 (const :tag "Save if desktop file exists, else don't" if-exists)
148 (const :tag "Never save" nil))
149 :group 'desktop)
150
151(defcustom desktop-base-file-name
128 (convert-standard-filename ".emacs.desktop") 152 (convert-standard-filename ".emacs.desktop")
129 "File for Emacs desktop, not including the directory name." 153 "File for Emacs desktop, not including the directory name."
130 :type 'file 154 :type 'file
131 :group 'desktop) 155 :group 'desktop)
132 156
157(defcustom desktop-path '("." "~")
158 "List of directories to search for the desktop file.
159The base name of the file is specified in `desktop-base-file-name'."
160 :type '(repeat directory)
161 :group 'desktop)
162
133(defcustom desktop-missing-file-warning nil 163(defcustom desktop-missing-file-warning nil
134 "*If non-nil then desktop warns when a file no longer exists. 164 "*If non-nil then desktop warns when a file no longer exists.
135Otherwise it simply ignores that file." 165Otherwise it simply ignores that file."
136 :type 'boolean 166 :type 'boolean
137 :group 'desktop) 167 :group 'desktop)
138 168
139(defvar desktop-globals-to-save 169(defcustom desktop-no-desktop-file-hook nil
140 (list 'desktop-missing-file-warning 170 "Normal hook run after fail of `desktop-read' due to missing desktop file.
141 ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer 171May e.g. be used to show a dired buffer."
142 ;; 'kill-ring 172 :type 'hook
143 'tags-file-name 173 :group 'desktop)
144 'tags-table-list 174
145 'search-ring 175(defcustom desktop-after-read-hook nil
146 'regexp-search-ring 176 "Normal hook run after a sucessful `desktop-read'.
147 'register-alist 177May e.g. be used to show a buffer list."
148 ;; 'desktop-globals-to-save ; Itself! 178 :type 'hook
149 ) 179 :group 'desktop)
180
181(defcustom desktop-save-hook nil
182 "Hook run before desktop saves the state of Emacs.
183This is useful for truncating history lists, for example."
184 :type 'hook
185 :group 'desktop)
186
187(defcustom desktop-globals-to-save '(
188 desktop-missing-file-warning
189 tags-file-name
190 tags-table-list
191 search-ring
192 regexp-search-ring
193 register-alist)
150 "List of global variables to save when killing Emacs. 194 "List of global variables to save when killing Emacs.
151An element may be variable name (a symbol) 195An element may be variable name (a symbol)
152or a cons cell of the form (VAR . MAX-SIZE), 196or a cons cell of the form (VAR . MAX-SIZE),
153which means to truncate VAR's value to at most MAX-SIZE elements 197which means to truncate VAR's value to at most MAX-SIZE elements
154\(if the value is a list) before saving the value.") 198\(if the value is a list) before saving the value.
155 199Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
156(defvar desktop-locals-to-save 200 :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
157 (list 'desktop-locals-to-save ; Itself! Think it over. 201 :group 'desktop)
158 'truncate-lines 202
159 'case-fold-search 203(defcustom desktop-globals-to-clear '(
160 'case-replace 204 kill-ring
161 'fill-column 205 kill-ring-yank-pointer
162 'overwrite-mode 206 search-ring
163 'change-log-default-name 207 search-ring-yank-pointer
164 'line-number-mode 208 regexp-search-ring
165 ) 209 regexp-search-ring-yank-pointer)
210 "List of global variables set to clear by `desktop-clear'.
211An element may be variable name (a symbol) or a cons cell of the form
212\(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
213to the value obtained by evaluateing FORM."
214 :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
215 :group 'desktop)
216
217(defcustom desktop-clear-preserve-buffers-regexp
218 "^\\*tramp/.+\\*$"
219 "Regexp identifying buffers that `desktop-clear' should not delete."
220 :type 'regexp
221 :group 'desktop)
222
223;; Maintained for backward compatibility
224(defcustom desktop-clear-preserve-buffers
225 '("*scratch*" "*Messages*")
226 "*List of buffer names that `desktop-clear' should not delete."
227 :type '(repeat string)
228 :group 'desktop)
229
230(defvar desktop-locals-to-save '(
231 desktop-locals-to-save ; Itself! Think it over.
232 truncate-lines
233 case-fold-search
234 case-replace
235 fill-column
236 overwrite-mode
237 change-log-default-name
238 line-number-mode)
166 "List of local variables to save for each buffer. 239 "List of local variables to save for each buffer.
167The variables are saved only when they really are local.") 240The variables are saved only when they really are local.")
168(make-variable-buffer-local 'desktop-locals-to-save) 241(make-variable-buffer-local 'desktop-locals-to-save)
@@ -171,10 +244,10 @@ The variables are saved only when they really are local.")
171;; (ftp) files because they require passwords and whatnot. 244;; (ftp) files because they require passwords and whatnot.
172;; TAGS files to save time (tags-file-name is saved instead). 245;; TAGS files to save time (tags-file-name is saved instead).
173(defcustom desktop-buffers-not-to-save 246(defcustom desktop-buffers-not-to-save
174 "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" 247 "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
175 "Regexp identifying buffers that are to be excluded from saving." 248 "Regexp identifying buffers that are to be excluded from saving."
176 :type 'regexp 249 :type 'regexp
177 :group 'desktop) 250 :group 'desktop)
178 251
179;; Skip ange-ftp files 252;; Skip ange-ftp files
180(defcustom desktop-files-not-to-save 253(defcustom desktop-files-not-to-save
@@ -196,25 +269,15 @@ whether the buffer should be recreated or not, and how."
196 :type '(repeat symbol) 269 :type '(repeat symbol)
197 :group 'desktop) 270 :group 'desktop)
198 271
199(defcustom desktop-buffer-major-mode nil 272(defcustom desktop-file-name-format 'absolute
200 "When desktop creates a buffer, this holds the desired Major mode." 273 "*Format in which desktop file names should be saved.
201 :type 'symbol 274Possible values are:
275 absolute -- Absolute file name.
276 tilde -- Relative to ~.
277 local -- Relative to directory of desktop file."
278 :type '(choice (const absolute) (const tilde) (const local))
202 :group 'desktop) 279 :group 'desktop)
203 280
204(defcustom desktop-buffer-file-name nil
205 "When desktop creates a buffer, this holds the file name to visit."
206 :type '(choice file (const nil))
207 :group 'desktop)
208
209(defcustom desktop-buffer-name nil
210 "When desktop creates a buffer, this holds the desired buffer name."
211 :type '(choice string (const nil))
212 :group 'desktop)
213
214(defvar desktop-buffer-misc nil
215 "When desktop creates a buffer, this holds a list of misc info.
216It is used by the `desktop-buffer-handlers' functions.")
217
218(defcustom desktop-buffer-misc-functions 281(defcustom desktop-buffer-misc-functions
219 '(desktop-buffer-info-misc-data 282 '(desktop-buffer-info-misc-data
220 desktop-buffer-dired-misc-data) 283 desktop-buffer-dired-misc-data)
@@ -223,6 +286,9 @@ These functions are called in order, with no arguments. If a function
223returns non-nil, its value is saved along with the desktop buffer for 286returns non-nil, its value is saved along with the desktop buffer for
224which it was called; no further functions will be called. 287which it was called; no further functions will be called.
225 288
289File names should formatted using the call
290\"(desktop-file-name FILE-NAME dirname)\".
291
226Later, when desktop.el restores the buffers it has saved, each of the 292Later, when desktop.el restores the buffers it has saved, each of the
227`desktop-buffer-handlers' functions will have access to a buffer local 293`desktop-buffer-handlers' functions will have access to a buffer local
228variable, named `desktop-buffer-misc', whose value is what the 294variable, named `desktop-buffer-misc', whose value is what the
@@ -238,8 +304,19 @@ variable, named `desktop-buffer-misc', whose value is what the
238 desktop-buffer-file) 304 desktop-buffer-file)
239 "*List of functions to call in order to create a buffer. 305 "*List of functions to call in order to create a buffer.
240The functions are called without explicit parameters but can use the 306The functions are called without explicit parameters but can use the
241variables `desktop-buffer-major-mode', `desktop-buffer-file-name', 307following variables:
242`desktop-buffer-name'. 308
309 desktop-file-version
310 desktop-buffer-file-name
311 desktop-buffer-name
312 desktop-buffer-major-mode
313 desktop-buffer-minor-modes
314 desktop-buffer-point
315 desktop-buffer-mark
316 desktop-buffer-read-only
317 desktop-buffer-misc
318 desktop-buffer-locals
319
243If one function returns non-nil, no further functions are called. 320If one function returns non-nil, no further functions are called.
244If the function returns a buffer, then the saved mode settings 321If the function returns a buffer, then the saved mode settings
245and variable values for that buffer are copied into it." 322and variable values for that buffer are copied into it."
@@ -248,15 +325,6 @@ and variable values for that buffer are copied into it."
248 325
249(put 'desktop-buffer-handlers 'risky-local-variable t) 326(put 'desktop-buffer-handlers 'risky-local-variable t)
250 327
251(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
252 "Opening of form for creation of new buffers.")
253
254(defcustom desktop-save-hook nil
255 "Hook run before desktop saves the state of Emacs.
256This is useful for truncating history lists, for example."
257 :type 'hook
258 :group 'desktop)
259
260(defcustom desktop-minor-mode-table 328(defcustom desktop-minor-mode-table
261 '((auto-fill-function auto-fill-mode) 329 '((auto-fill-function auto-fill-mode)
262 (vc-mode nil)) 330 (vc-mode nil))
@@ -290,45 +358,61 @@ this table."
290 (let ((here (nthcdr (1- n) l))) 358 (let ((here (nthcdr (1- n) l)))
291 (if (consp here) 359 (if (consp here)
292 (setcdr here nil)))) 360 (setcdr here nil))))
293;; ----------------------------------------------------------------------------
294(defcustom desktop-clear-preserve-buffers
295 '("*scratch*" "*Messages*")
296 "*Buffer names that `desktop-clear' should not delete."
297 :type '(repeat string)
298 :group 'desktop)
299 361
362;; ----------------------------------------------------------------------------
300(defun desktop-clear () 363(defun desktop-clear ()
301 "Empty the Desktop. 364 "Empty the Desktop.
302This kills all buffers except for internal ones 365This kills all buffers except for internal ones and those listed
303and those listed in `desktop-clear-preserve-buffers'." 366in `desktop-clear-preserve-buffers'. Furthermore, it clears the
367variables listed in `desktop-globals-to-clear'."
304 (interactive) 368 (interactive)
305 (setq kill-ring nil 369 (dolist (var desktop-globals-to-clear)
306 kill-ring-yank-pointer nil 370 (if (symbolp var)
307 search-ring nil 371 (eval `(setq-default ,var nil))
308 search-ring-yank-pointer nil 372 (eval `(setq-default ,(car var) ,(cdr var)))))
309 regexp-search-ring nil
310 regexp-search-ring-yank-pointer nil)
311 (let ((buffers (buffer-list))) 373 (let ((buffers (buffer-list)))
312 (while buffers 374 (while buffers
313 (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers) 375 (let ((bufname (buffer-name (car buffers))))
314 (null (buffer-name (car buffers))) 376 (or
315 ;; Don't kill buffers made for internal purposes. 377 (null bufname)
316 (and (not (equal (buffer-name (car buffers)) "")) 378 (string-match desktop-clear-preserve-buffers-regexp bufname)
317 (eq (aref (buffer-name (car buffers)) 0) ?\ )) 379 (member bufname desktop-clear-preserve-buffers)
318 (kill-buffer (car buffers))) 380 ;; Don't kill buffers made for internal purposes.
381 (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
382 (kill-buffer (car buffers))))
319 (setq buffers (cdr buffers)))) 383 (setq buffers (cdr buffers))))
320 (delete-other-windows)) 384 (delete-other-windows))
385
321;; ---------------------------------------------------------------------------- 386;; ----------------------------------------------------------------------------
322(add-hook 'kill-emacs-hook 'desktop-kill) 387(add-hook 'kill-emacs-hook 'desktop-kill)
323 388
324(defun desktop-kill () 389(defun desktop-kill ()
325 (if desktop-dirname 390 "If `desktop-enable' is non-nil, do what `desktop-save' says to do.
326 (condition-case err 391If the desktop should be saved and `desktop-dirname'
327 (desktop-save desktop-dirname) 392is nil, ask the user where to save the desktop."
328 (file-error 393 (when
329 (if (yes-or-no-p "Error while saving the desktop. Quit anyway? ") 394 (and
330 nil 395 desktop-enable
331 (signal (car err) (cdr err))))))) 396 (let ((exists (file-exists-p (concat desktop-dirname desktop-base-file-name))))
397 (or
398 (eq desktop-save 't)
399 (and exists (memq desktop-save '(ask-if-new if-exists)))
400 (and
401 (or
402 (memq desktop-save '(ask ask-if-new))
403 (and exists (eq desktop-save 'ask-if-exists)))
404 (y-or-n-p "Save desktop? ")))))
405 (unless desktop-dirname
406 (setq desktop-dirname
407 (expand-file-name
408 (call-interactively
409 (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))
410 (condition-case err
411 (desktop-save desktop-dirname)
412 (file-error
413 (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
414 (signal (car err) (cdr err)))))))
415
332;; ---------------------------------------------------------------------------- 416;; ----------------------------------------------------------------------------
333(defun desktop-list* (&rest args) 417(defun desktop-list* (&rest args)
334 (if (null (cdr args)) 418 (if (null (cdr args))
@@ -341,6 +425,7 @@ and those listed in `desktop-clear-preserve-buffers'."
341 (setq args (cdr args))) 425 (setq args (cdr args)))
342 value))) 426 value)))
343 427
428;; ----------------------------------------------------------------------------
344(defun desktop-internal-v2s (val) 429(defun desktop-internal-v2s (val)
345 "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. 430 "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
346TXT is a string that when read and evaluated yields value. 431TXT is a string that when read and evaluated yields value.
@@ -420,6 +505,7 @@ QUOTE may be `may' (value may be quoted),
420 (t ; save as text 505 (t ; save as text
421 (cons 'may "\"Unprintable entity\"")))) 506 (cons 'may "\"Unprintable entity\""))))
422 507
508;; ----------------------------------------------------------------------------
423(defun desktop-value-to-string (val) 509(defun desktop-value-to-string (val)
424 "Convert VALUE to a string that when read evaluates to the same value. 510 "Convert VALUE to a string that when read evaluates to the same value.
425Not all types of values are supported." 511Not all types of values are supported."
@@ -431,6 +517,7 @@ Not all types of values are supported."
431 (if (eq quote 'must) 517 (if (eq quote 'must)
432 (concat "'" txt) 518 (concat "'" txt)
433 txt))) 519 txt)))
520
434;; ---------------------------------------------------------------------------- 521;; ----------------------------------------------------------------------------
435(defun desktop-outvar (varspec) 522(defun desktop-outvar (varspec)
436 "Output a setq statement for variable VAR to the desktop file. 523 "Output a setq statement for variable VAR to the desktop file.
@@ -453,6 +540,7 @@ which means to truncate VAR's value to at most MAX-SIZE elements
453 " " 540 " "
454 (desktop-value-to-string (symbol-value var)) 541 (desktop-value-to-string (symbol-value var))
455 ")\n"))))) 542 ")\n")))))
543
456;; ---------------------------------------------------------------------------- 544;; ----------------------------------------------------------------------------
457(defun desktop-save-buffer-p (filename bufname mode &rest dummy) 545(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
458 "Return t if the desktop should record a particular buffer for next startup. 546 "Return t if the desktop should record a particular buffer for next startup.
@@ -470,137 +558,157 @@ MODE is the major mode."
470 default-directory)))) 558 default-directory))))
471 (and (null filename) 559 (and (null filename)
472 (memq mode desktop-buffer-modes-to-save)))))) 560 (memq mode desktop-buffer-modes-to-save))))))
561
473;; ---------------------------------------------------------------------------- 562;; ----------------------------------------------------------------------------
474(defcustom desktop-relative-file-names nil 563(defun desktop-file-name (filename dirname)
475 "*Store relative file names in the desktop file." 564 "Convert FILENAME to format specified in `desktop-file-name-format'.
476 :type 'boolean 565DIRNAME must be the directory in which the desktop file will be saved."
477 :group 'desktop) 566 (cond
567 ((not filename) nil)
568 ((eq desktop-file-name-format 'tilde)
569 (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
570 (cond
571 ((file-name-absolute-p relative-name) relative-name)
572 ((string= "./" relative-name) "~/")
573 ((string= "." relative-name) "~")
574 (t (concat "~/" relative-name)))))
575 ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
576 (t (expand-file-name filename))))
478 577
578;; ----------------------------------------------------------------------------
479(defun desktop-save (dirname) 579(defun desktop-save (dirname)
480 "Save the Desktop file. Parameter DIRNAME specifies where to save desktop." 580 "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
481 (interactive "DDirectory to save desktop file in: ") 581 (interactive "DDirectory to save desktop file in: ")
482 (run-hooks 'desktop-save-hook) 582 (run-hooks 'desktop-save-hook)
483 (save-excursion 583 (save-excursion
484 (let ((filename (expand-file-name desktop-basefilename dirname)) 584 (let ((filename (expand-file-name desktop-base-file-name dirname))
485 (info (nreverse 585 (info
486 (mapcar 586 (mapcar
487 (function 587 (function
488 (lambda (b) 588 (lambda (b)
489 (set-buffer b) 589 (set-buffer b)
490 (list 590 (list
491 (let ((bn (buffer-file-name))) 591 (desktop-file-name (buffer-file-name) dirname)
492 (if bn 592 (buffer-name)
493 (if desktop-relative-file-names 593 major-mode
494 (file-relative-name bn dirname) 594 ;; minor modes
495 bn))) 595 (let (ret)
496 (buffer-name) 596 (mapcar
497 major-mode 597 #'(lambda (mim)
498 ;; minor modes 598 (and
499 (let (ret) 599 (boundp mim)
500 (mapcar 600 (symbol-value mim)
501 #'(lambda (mim) 601 (setq
502 (and (boundp mim) 602 ret
503 (symbol-value mim) 603 (cons
504 (setq ret 604 (let (
505 (cons (let ((special (assq mim desktop-minor-mode-table))) 605 (special (assq mim desktop-minor-mode-table))
506 (if special 606 )
507 (cadr special) 607 (if special (cadr special) mim))
508 mim)) 608 ret))))
509 ret)))) 609 (mapcar #'car minor-mode-alist))
510 (mapcar #'car minor-mode-alist)) 610 ret)
511 ret) 611 (point)
512 (point) 612 (list (mark t) mark-active)
513 (list (mark t) mark-active) 613 buffer-read-only
514 buffer-read-only 614 (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
515 (run-hook-with-args-until-success 615 (let (
516 'desktop-buffer-misc-functions) 616 (locals desktop-locals-to-save)
517 (let ((locals desktop-locals-to-save) 617 (loclist (buffer-local-variables))
518 (loclist (buffer-local-variables)) 618 (ll)
519 (ll)) 619 )
520 (while locals 620 (while locals
521 (let ((here (assq (car locals) loclist))) 621 (let ((here (assq (car locals) loclist)))
522 (if here 622 (if here
523 (setq ll (cons here ll)) 623 (setq ll (cons here ll))
524 (if (member (car locals) loclist) 624 (when (member (car locals) loclist)
525 (setq ll (cons (car locals) ll))))) 625 (setq ll (cons (car locals) ll)))))
526 (setq locals (cdr locals))) 626 (setq locals (cdr locals)))
527 ll) 627 ll))))
528 ))) 628 (buffer-list)))
529 (buffer-list)))) 629 (buf (get-buffer-create "*desktop*")))
530 (buf (get-buffer-create "*desktop*")))
531 (set-buffer buf) 630 (set-buffer buf)
532 (erase-buffer) 631 (erase-buffer)
533 632
534 (insert ";; -*- coding: emacs-mule; -*-\n" 633 (insert
535 desktop-header 634 ";; -*- coding: emacs-mule; -*-\n"
536 ";; Created " (current-time-string) "\n" 635 desktop-header
537 ";; Emacs version " emacs-version "\n\n" 636 ";; Created " (current-time-string) "\n"
538 ";; Global section:\n") 637 ";; Desktop file format version " desktop-file-version "\n"
638 ";; Emacs version " emacs-version "\n\n"
639 ";; Global section:\n")
539 (mapcar (function desktop-outvar) desktop-globals-to-save) 640 (mapcar (function desktop-outvar) desktop-globals-to-save)
540 (if (memq 'kill-ring desktop-globals-to-save) 641 (if (memq 'kill-ring desktop-globals-to-save)
541 (insert "(setq kill-ring-yank-pointer (nthcdr " 642 (insert
542 (int-to-string 643 "(setq kill-ring-yank-pointer (nthcdr "
543 (- (length kill-ring) (length kill-ring-yank-pointer))) 644 (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
544 " kill-ring))\n")) 645 " kill-ring))\n"))
545 646
546 (insert "\n;; Buffer section:\n") 647 (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
547 (mapcar 648 (mapcar
548 (function (lambda (l) 649 (function
549 (if (apply 'desktop-save-buffer-p l) 650 (lambda (l)
550 (progn 651 (if (apply 'desktop-save-buffer-p l)
551 (insert desktop-create-buffer-form) 652 (progn
552 (mapcar 653 (insert "(desktop-create-buffer " desktop-file-version)
553 (function (lambda (e) 654 (mapcar
554 (insert "\n " 655 (function
555 (desktop-value-to-string e)))) 656 (lambda (e)
556 l) 657 (insert "\n " (desktop-value-to-string e))))
557 (insert ")\n\n"))))) 658 l)
558 info) 659 (insert ")\n\n")))))
660 info)
559 (setq default-directory dirname) 661 (setq default-directory dirname)
560 (if (file-exists-p filename) (delete-file filename)) 662 (when (file-exists-p filename) (delete-file filename))
561 (let ((coding-system-for-write 'emacs-mule)) 663 (let ((coding-system-for-write 'emacs-mule))
562 (write-region (point-min) (point-max) filename nil 'nomessage)))) 664 (write-region (point-min) (point-max) filename nil 'nomessage))))
563 (setq desktop-dirname dirname)) 665 (setq desktop-dirname dirname))
666
564;; ---------------------------------------------------------------------------- 667;; ----------------------------------------------------------------------------
565(defun desktop-remove () 668(defun desktop-remove ()
566 "Delete the Desktop file and inactivate the desktop system." 669 "Delete the Desktop file and inactivate the desktop system."
567 (interactive) 670 (interactive)
568 (if desktop-dirname 671 (if desktop-dirname
569 (let ((filename (concat desktop-dirname desktop-basefilename))) 672 (let ((filename (concat desktop-dirname desktop-base-file-name)))
570 (setq desktop-dirname nil) 673 (setq desktop-dirname nil)
571 (if (file-exists-p filename) 674 (if (file-exists-p filename)
572 (delete-file filename))))) 675 (delete-file filename)))))
676
573;; ---------------------------------------------------------------------------- 677;; ----------------------------------------------------------------------------
574;;;###autoload 678;;;###autoload
575(defun desktop-read () 679(defun desktop-read ()
576 "Read the Desktop file and the files it specifies. 680 "Read the Desktop file and the files it specifies.
577This is a no-op when Emacs is running in batch mode." 681This is a no-op when Emacs is running in batch mode.
682Look for the desktop file according to the variables `desktop-base-file-name'
683and `desktop-path'. If no desktop file is found, clear the desktop.
684Returns t if it has read a desktop file, nil otherwise."
578 (interactive) 685 (interactive)
579 (if noninteractive 686 (unless noninteractive
580 nil 687 (let ((dirs desktop-path))
581 (let ((dirs '("./" "~/"))) 688 (while
582 (while (and dirs 689 (and
583 (not (file-exists-p (expand-file-name 690 dirs
584 desktop-basefilename 691 (not
585 (car dirs))))) 692 (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
586 (setq dirs (cdr dirs))) 693 (setq dirs (cdr dirs)))
587 (setq desktop-dirname (and dirs (expand-file-name (car dirs)))) 694 (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
588 (if desktop-dirname 695 (if desktop-dirname
589 (let ((desktop-last-buffer nil)) 696 (let ((desktop-first-buffer nil))
590 ;; `load-with-code-conversion' calls `eval-buffer' which 697 ;; `desktop-create-buffer' sets `desktop-first-buffer' to the first
591 ;; contains a `save-excursion', so we end up with the same 698 ;; buffer in the desktop file (the last for desktop files written
592 ;; buffer before and after the load. This is a problem 699 ;; by desktop version prior to 206).
593 ;; when the desktop is read initially when Emacs starts up 700 (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
594 ;; because, if we still are in *scratch* after running 701 (when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
595 ;; `after-init-hook', the splash screen will be displayed. 702 (run-hooks 'desktop-delay-hook)
596 (load (expand-file-name desktop-basefilename desktop-dirname) 703 (setq desktop-delay-hook nil)
597 t t t) 704 (run-hooks 'desktop-after-read-hook)
598 (when desktop-last-buffer 705 (message "Desktop loaded.")
599 (switch-to-buffer desktop-last-buffer)) 706 t)
600 (run-hooks 'desktop-delay-hook) 707 (desktop-clear)
601 (setq desktop-delay-hook nil) 708 (run-hooks 'desktop-no-desktop-file-hook)
602 (message "Desktop loaded.")) 709 (message "No desktop file.")
603 (desktop-clear))))) 710 nil))))
711
604;; ---------------------------------------------------------------------------- 712;; ----------------------------------------------------------------------------
605;;;###autoload 713;;;###autoload
606(defun desktop-load-default () 714(defun desktop-load-default ()
@@ -611,24 +719,74 @@ to provide correct modes for autoloaded files."
611 (progn 719 (progn
612 (load "default" t t) 720 (load "default" t t)
613 (setq inhibit-default-init t)))) 721 (setq inhibit-default-init t))))
722
723;; ----------------------------------------------------------------------------
724;;;###autoload
725(defun desktop-change-dir (dir)
726 "Save and clear the desktop, then load the desktop from directory DIR.
727However, if `desktop-enable' was nil at call, don't save the old desktop.
728This function always sets `desktop-enable' to t."
729 (interactive "DNew directory: ")
730 (desktop-kill)
731 (desktop-clear)
732 (cd dir)
733 (setq desktop-enable t)
734 (let ((desktop-path '(".")))
735 (desktop-read)
736 ;; Set `desktop-dirname' even in no desktop file was found
737 (setq desktop-dirname (expand-file-name dir))))
738
739;; ----------------------------------------------------------------------------
740;;;###autoload
741(defun desktop-save-in-load-dir ()
742 "Save desktop in directory from which it was loaded."
743 (interactive)
744 (if desktop-dirname
745 (desktop-save desktop-dirname)
746 (call-interactively 'desktop-save))
747 (message "Desktop saved in %s" desktop-dirname))
748
749;; ----------------------------------------------------------------------------
750;;;###autoload
751(defun desktop-revert ()
752 "Revert to the last loaded desktop."
753 (interactive)
754 (unless desktop-dirname (error "No desktop has been loaded"))
755 (setq desktop-enable nil)
756 (desktop-change-dir desktop-dirname))
757
614;; ---------------------------------------------------------------------------- 758;; ----------------------------------------------------------------------------
615;; Note: the following functions use the dynamic variable binding in Lisp. 759;; Note: the following functions use the dynamic variable binding in Lisp.
616;; 760;;
761
762(eval-when-compile ; Just to silence the byte compiler
763 (defvar desktop-file-version)
764 (defvar desktop-buffer-file-name)
765 (defvar desktop-buffer-name)
766 (defvar desktop-buffer-major-mode)
767 (defvar desktop-buffer-minor-modes)
768 (defvar desktop-buffer-point)
769 (defvar desktop-buffer-mark)
770 (defvar desktop-buffer-read-only)
771 (defvar desktop-buffer-misc)
772 (defvar desktop-buffer-locals)
773)
774
617(defun desktop-buffer-info-misc-data () 775(defun desktop-buffer-info-misc-data ()
618 (if (eq major-mode 'Info-mode) 776 (if (eq major-mode 'Info-mode)
619 (list Info-current-file 777 (list Info-current-file
620 Info-current-node))) 778 Info-current-node)))
621 779
780;; ----------------------------------------------------------------------------
622(defun desktop-buffer-dired-misc-data () 781(defun desktop-buffer-dired-misc-data ()
623 (if (eq major-mode 'dired-mode) 782 (when (eq major-mode 'dired-mode)
624 (cons 783 (eval-when-compile (defvar dirname))
625 (expand-file-name dired-directory) 784 (cons
626 (cdr 785 ;; dired directory in portable form
627 (nreverse 786 (file-name-as-directory (desktop-file-name dired-directory dirname))
628 (mapcar 787 (cdr (nreverse (mapcar (function car) dired-subdir-alist))))))
629 (function car)
630 dired-subdir-alist))))))
631 788
789;; ----------------------------------------------------------------------------
632(defun desktop-buffer-info () "Load an info file." 790(defun desktop-buffer-info () "Load an info file."
633 (if (eq 'Info-mode desktop-buffer-major-mode) 791 (if (eq 'Info-mode desktop-buffer-major-mode)
634 (progn 792 (progn
@@ -638,7 +796,9 @@ to provide correct modes for autoloaded files."
638 (require 'info) 796 (require 'info)
639 (Info-find-node first second) 797 (Info-find-node first second)
640 (current-buffer)))))) 798 (current-buffer))))))
799
641;; ---------------------------------------------------------------------------- 800;; ----------------------------------------------------------------------------
801(eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
642(defun desktop-buffer-rmail () "Load an RMAIL file." 802(defun desktop-buffer-rmail () "Load an RMAIL file."
643 (if (eq 'rmail-mode desktop-buffer-major-mode) 803 (if (eq 'rmail-mode desktop-buffer-major-mode)
644 (condition-case error 804 (condition-case error
@@ -649,14 +809,16 @@ to provide correct modes for autoloaded files."
649 (file-locked 809 (file-locked
650 (kill-buffer (current-buffer)) 810 (kill-buffer (current-buffer))
651 'ignored)))) 811 'ignored))))
812
652;; ---------------------------------------------------------------------------- 813;; ----------------------------------------------------------------------------
653(defun desktop-buffer-mh () "Load a folder in the mh system." 814(defun desktop-buffer-mh () "Load a folder in the mh system."
654 (if (eq 'mh-folder-mode desktop-buffer-major-mode) 815 (if (eq 'mh-folder-mode desktop-buffer-major-mode)
655 (progn 816 (progn
656 (require 'mh-e) 817 (eval-and-compile (require 'mh-e))
657 (mh-find-path) 818 (mh-find-path)
658 (mh-visit-folder desktop-buffer-name) 819 (mh-visit-folder desktop-buffer-name)
659 (current-buffer)))) 820 (current-buffer))))
821
660;; ---------------------------------------------------------------------------- 822;; ----------------------------------------------------------------------------
661(defun desktop-buffer-dired () "Load a directory using dired." 823(defun desktop-buffer-dired () "Load a directory using dired."
662 (if (eq 'dired-mode desktop-buffer-major-mode) 824 (if (eq 'dired-mode desktop-buffer-major-mode)
@@ -668,6 +830,7 @@ to provide correct modes for autoloaded files."
668 (message "Directory %s no longer exists." (car desktop-buffer-misc)) 830 (message "Directory %s no longer exists." (car desktop-buffer-misc))
669 (sit-for 1) 831 (sit-for 1)
670 'ignored))) 832 'ignored)))
833
671;; ---------------------------------------------------------------------------- 834;; ----------------------------------------------------------------------------
672(defun desktop-buffer-file () "Load a file." 835(defun desktop-buffer-file () "Load a file."
673 (if desktop-buffer-file-name 836 (if desktop-buffer-file-name
@@ -682,56 +845,89 @@ to provide correct modes for autoloaded files."
682 (error (pop-to-buffer buf))) 845 (error (pop-to-buffer buf)))
683 buf) 846 buf)
684 'ignored))) 847 'ignored)))
848
685;; ---------------------------------------------------------------------------- 849;; ----------------------------------------------------------------------------
686;; Create a buffer, load its file, set is mode, ...; called from Desktop file 850;; Create a buffer, load its file, set is mode, ...; called from Desktop file
687;; only. 851;; only.
688 852
689(defvar desktop-last-buffer nil 853(eval-when-compile ; Just to silence the byte compiler
690 "Last buffer read. Dynamically bound in `desktop-read'.") 854 (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
691 855)
692(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name 856
693 desktop-buffer-major-mode 857(defun desktop-create-buffer (
694 mim pt mk ro desktop-buffer-misc 858 desktop-file-version
695 &optional locals) 859 desktop-buffer-file-name
696 (let ((hlist desktop-buffer-handlers) 860 desktop-buffer-name
697 (result) 861 desktop-buffer-major-mode
698 (handler)) 862 desktop-buffer-minor-modes
699 (while (and (not result) hlist) 863 desktop-buffer-point
700 (setq handler (car hlist)) 864 desktop-buffer-mark
701 (setq result (funcall handler)) 865 desktop-buffer-read-only
702 (setq hlist (cdr hlist))) 866 desktop-buffer-misc
703 (when (bufferp result) 867 &optional
704 (setq desktop-last-buffer result) 868 desktop-buffer-locals)
705 (set-buffer result) 869 ;; To make desktop files with relative file names possible, we cannot
706 (if (not (equal (buffer-name) desktop-buffer-name)) 870 ;; allow `default-directory' to change. Therefore we save current buffer.
707 (rename-buffer desktop-buffer-name)) 871 (save-current-buffer
708 ;; minor modes 872 (let (
709 (cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible 873 (buffer-list (buffer-list))
710 ((equal '(nil) mim) (auto-fill-mode 0)) 874 (hlist desktop-buffer-handlers)
711 (t (mapcar #'(lambda (minor-mode) 875 (result)
712 (when (functionp minor-mode) 876 (handler)
713 (funcall minor-mode 1))) 877 )
714 mim))) 878 ;; Call desktop-buffer-handlers to create buffer.
715 (goto-char pt) 879 (while (and (not result) hlist)
716 (if (consp mk) 880 (setq handler (car hlist))
717 (progn 881 (setq result (funcall handler))
718 (set-mark (car mk)) 882 (setq hlist (cdr hlist)))
719 (setq mark-active (car (cdr mk)))) 883 (unless (bufferp result) (setq result nil))
720 (set-mark mk)) 884 (unless (< desktop-file-version 206)
721 ;; Never override file system if the file really is read-only marked. 885 (when result (setq buffer-list (cons result buffer-list)))
722 (if ro (setq buffer-read-only ro)) 886 (mapcar 'bury-buffer buffer-list))
723 (while locals 887 (when result
724 (let ((this (car locals))) 888 (if (< desktop-file-version 206)
725 (if (consp this) 889 (setq desktop-first-buffer result)
726 ;; an entry of this form `(symbol . value)' 890 (bury-buffer result))
727 (progn 891 (unless desktop-first-buffer (setq desktop-first-buffer result))
728 (make-local-variable (car this)) 892 (set-buffer result)
729 (set (car this) (cdr this))) 893 (unless (equal (buffer-name) desktop-buffer-name)
730 ;; an entry of the form `symbol' 894 (rename-buffer desktop-buffer-name))
731 (make-local-variable this) 895 ;; minor modes
732 (makunbound this))) 896 (cond (
733 (setq locals (cdr locals)))))) 897 ;; backwards compatible
898 (equal '(t) desktop-buffer-minor-modes)
899 (auto-fill-mode 1))(
900 (equal '(nil) desktop-buffer-minor-modes)
901 (auto-fill-mode 0))(
902 t
903 (mapcar
904 #'(lambda (minor-mode)
905 (when (functionp minor-mode) (funcall minor-mode 1)))
906 desktop-buffer-minor-modes)))
907 ;; Even though point and mark are non-nil when written by `desktop-save'
908 ;; they may be modified by mandlers wanting to set point or mark themselves.
909 (when desktop-buffer-point (goto-char desktop-buffer-point))
910 (when desktop-buffer-mark
911 (if (consp desktop-buffer-mark)
912 (progn
913 (set-mark (car desktop-buffer-mark))
914 (setq mark-active (car (cdr desktop-buffer-mark))))
915 (set-mark desktop-buffer-mark)))
916 ;; Never override file system if the file really is read-only marked.
917 (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
918 (while desktop-buffer-locals
919 (let ((this (car desktop-buffer-locals)))
920 (if (consp this)
921 ;; an entry of this form `(symbol . value)'
922 (progn
923 (make-local-variable (car this))
924 (set (car this) (cdr this)))
925 ;; an entry of the form `symbol'
926 (make-local-variable this)
927 (makunbound this)))
928 (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
734 929
930;; ----------------------------------------------------------------------------
735;; Backward compatibility -- update parameters to 205 standards. 931;; Backward compatibility -- update parameters to 205 standards.
736(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name 932(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
737 desktop-buffer-major-mode 933 desktop-buffer-major-mode
@@ -744,16 +940,22 @@ to provide correct modes for autoloaded files."
744 (cons 'case-fold-search cfs) 940 (cons 'case-fold-search cfs)
745 (cons 'case-replace cr) 941 (cons 'case-replace cr)
746 (cons 'overwrite-mode (car mim))))) 942 (cons 'overwrite-mode (car mim)))))
943
747;; ---------------------------------------------------------------------------- 944;; ----------------------------------------------------------------------------
748 945;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
749;; If the user set desktop-enable to t with Custom, 946;; command line, we do the rest of what it takes to use desktop, but do it
750;; do the rest of what it takes to use desktop, 947;; after finishing loading the init file.
751;; but do it after finishing loading the init file. 948;; We cannot use `command-switch-alist' to process "--no-desktop" because these
752(add-hook 'after-init-hook 949;; functions are processed after `after-init-hook'.
753 '(lambda () 950(add-hook
754 (when desktop-enable 951 'after-init-hook
755 (desktop-load-default) 952 '(lambda ()
756 (desktop-read)))) 953 (let ((key "--no-desktop"))
954 (if (member key command-line-args)
955 (delete key command-line-args)
956 (when desktop-enable
957 (desktop-load-default)
958 (desktop-read))))))
757 959
758(provide 'desktop) 960(provide 'desktop)
759 961