99 |
;; Save window configuration. |
;; Save window configuration. |
100 |
;; Recognize more minor modes. |
;; Recognize more minor modes. |
101 |
;; Save mark rings. |
;; Save mark rings. |
|
;; Start-up with buffer-menu??? |
|
102 |
|
|
103 |
;;; Code: |
;;; Code: |
104 |
|
|
107 |
;; We use functions from these modules |
;; We use functions from these modules |
108 |
;; We can't (require 'mh-e) since that wants to load something. |
;; We can't (require 'mh-e) since that wants to load something. |
109 |
(mapcar 'require '(info dired reporter))) |
(mapcar 'require '(info dired reporter))) |
110 |
|
|
111 |
|
(defvar desktop-file-version "206" |
112 |
|
"Verion number of desktop file format. |
113 |
|
Written into the desktop file and used at desktop read to provide |
114 |
|
backward compatibility.") |
115 |
|
|
116 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
117 |
;; USER OPTIONS -- settings you might want to play with. |
;; USER OPTIONS -- settings you might want to play with. |
118 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
129 |
:initialize 'custom-initialize-default |
:initialize 'custom-initialize-default |
130 |
:version "20.3") |
:version "20.3") |
131 |
|
|
132 |
(defcustom desktop-basefilename |
(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. |
141 |
|
The 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 |
152 |
(convert-standard-filename ".emacs.desktop") |
(convert-standard-filename ".emacs.desktop") |
153 |
"File for Emacs desktop, not including the directory name." |
"File for Emacs desktop, not including the directory name." |
154 |
:type 'file |
:type 'file |
155 |
:group 'desktop) |
:group 'desktop) |
156 |
|
|
157 |
|
(defcustom desktop-path '("." "~") |
158 |
|
"List of directories to search for the desktop file. |
159 |
|
The base name of the file is specified in `desktop-base-file-name'." |
160 |
|
:type '(repeat directory) |
161 |
|
:group 'desktop) |
162 |
|
|
163 |
(defcustom desktop-missing-file-warning nil |
(defcustom desktop-missing-file-warning nil |
164 |
"*If non-nil then desktop warns when a file no longer exists. |
"*If non-nil then desktop warns when a file no longer exists. |
165 |
Otherwise it simply ignores that file." |
Otherwise it simply ignores that file." |
166 |
:type 'boolean |
:type 'boolean |
167 |
:group 'desktop) |
:group 'desktop) |
168 |
|
|
169 |
(defvar desktop-globals-to-save |
(defcustom desktop-no-desktop-file-hook nil |
170 |
(list 'desktop-missing-file-warning |
"Normal hook run after fail of `desktop-read' due to missing desktop file. |
171 |
;; Feature: saving kill-ring implies saving kill-ring-yank-pointer |
May e.g. be used to show a dired buffer." |
172 |
;; 'kill-ring |
:type 'hook |
173 |
'tags-file-name |
:group 'desktop) |
174 |
'tags-table-list |
|
175 |
'search-ring |
(defcustom desktop-after-read-hook nil |
176 |
'regexp-search-ring |
"Normal hook run after a sucessful `desktop-read'. |
177 |
'register-alist |
May e.g. be used to show a buffer list." |
178 |
;; 'desktop-globals-to-save ; Itself! |
:type 'hook |
179 |
) |
:group 'desktop) |
180 |
|
|
181 |
|
(defcustom desktop-save-hook nil |
182 |
|
"Hook run before desktop saves the state of Emacs. |
183 |
|
This 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) |
194 |
"List of global variables to save when killing Emacs. |
"List of global variables to save when killing Emacs. |
195 |
An element may be variable name (a symbol) |
An element may be variable name (a symbol) |
196 |
or a cons cell of the form (VAR . MAX-SIZE), |
or a cons cell of the form (VAR . MAX-SIZE), |
197 |
which means to truncate VAR's value to at most MAX-SIZE elements |
which means to truncate VAR's value to at most MAX-SIZE elements |
198 |
\(if the value is a list) before saving the value.") |
\(if the value is a list) before saving the value. |
199 |
|
Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'." |
200 |
|
:type '(repeat (restricted-sexp :match-alternatives (symbolp consp))) |
201 |
|
:group 'desktop) |
202 |
|
|
203 |
|
(defcustom desktop-globals-to-clear '( |
204 |
|
kill-ring |
205 |
|
kill-ring-yank-pointer |
206 |
|
search-ring |
207 |
|
search-ring-yank-pointer |
208 |
|
regexp-search-ring |
209 |
|
regexp-search-ring-yank-pointer) |
210 |
|
"List of global variables set to clear by `desktop-clear'. |
211 |
|
An 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 |
213 |
|
to 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 |
(defvar desktop-locals-to-save |
;; Maintained for backward compatibility |
224 |
(list 'desktop-locals-to-save ; Itself! Think it over. |
(defcustom desktop-clear-preserve-buffers |
225 |
'truncate-lines |
'("*scratch*" "*Messages*") |
226 |
'case-fold-search |
"*List of buffer names that `desktop-clear' should not delete." |
227 |
'case-replace |
:type '(repeat string) |
228 |
'fill-column |
:group 'desktop) |
229 |
'overwrite-mode |
|
230 |
'change-log-default-name |
(defvar desktop-locals-to-save '( |
231 |
'line-number-mode |
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) |
239 |
"List of local variables to save for each buffer. |
"List of local variables to save for each buffer. |
240 |
The variables are saved only when they really are local.") |
The variables are saved only when they really are local.") |
241 |
(make-variable-buffer-local 'desktop-locals-to-save) |
(make-variable-buffer-local 'desktop-locals-to-save) |
244 |
;; (ftp) files because they require passwords and whatnot. |
;; (ftp) files because they require passwords and whatnot. |
245 |
;; TAGS files to save time (tags-file-name is saved instead). |
;; TAGS files to save time (tags-file-name is saved instead). |
246 |
(defcustom desktop-buffers-not-to-save |
(defcustom desktop-buffers-not-to-save |
247 |
"\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" |
"\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" |
248 |
"Regexp identifying buffers that are to be excluded from saving." |
"Regexp identifying buffers that are to be excluded from saving." |
249 |
:type 'regexp |
:type 'regexp |
250 |
:group 'desktop) |
:group 'desktop) |
251 |
|
|
252 |
;; Skip ange-ftp files |
;; Skip ange-ftp files |
253 |
(defcustom desktop-files-not-to-save |
(defcustom desktop-files-not-to-save |
269 |
:type '(repeat symbol) |
:type '(repeat symbol) |
270 |
:group 'desktop) |
:group 'desktop) |
271 |
|
|
272 |
(defcustom desktop-buffer-major-mode nil |
(defcustom desktop-file-name-format 'absolute |
273 |
"When desktop creates a buffer, this holds the desired Major mode." |
"*Format in which desktop file names should be saved. |
274 |
:type 'symbol |
Possible values are: |
275 |
:group 'desktop) |
absolute -- Absolute file name. |
276 |
|
tilde -- Relative to ~. |
277 |
(defcustom desktop-buffer-file-name nil |
local -- Relative to directory of desktop file." |
278 |
"When desktop creates a buffer, this holds the file name to visit." |
:type '(choice (const absolute) (const tilde) (const local)) |
|
:type '(choice file (const nil)) |
|
279 |
:group 'desktop) |
:group 'desktop) |
280 |
|
|
|
(defcustom desktop-buffer-name nil |
|
|
"When desktop creates a buffer, this holds the desired buffer name." |
|
|
:type '(choice string (const nil)) |
|
|
:group 'desktop) |
|
|
|
|
|
(defvar desktop-buffer-misc nil |
|
|
"When desktop creates a buffer, this holds a list of misc info. |
|
|
It is used by the `desktop-buffer-handlers' functions.") |
|
|
|
|
281 |
(defcustom desktop-buffer-misc-functions |
(defcustom desktop-buffer-misc-functions |
282 |
'(desktop-buffer-info-misc-data |
'(desktop-buffer-info-misc-data |
283 |
desktop-buffer-dired-misc-data) |
desktop-buffer-dired-misc-data) |
286 |
returns non-nil, its value is saved along with the desktop buffer for |
returns non-nil, its value is saved along with the desktop buffer for |
287 |
which it was called; no further functions will be called. |
which it was called; no further functions will be called. |
288 |
|
|
289 |
|
File names should formatted using the call |
290 |
|
\"(desktop-file-name FILE-NAME dirname)\". |
291 |
|
|
292 |
Later, when desktop.el restores the buffers it has saved, each of the |
Later, when desktop.el restores the buffers it has saved, each of the |
293 |
`desktop-buffer-handlers' functions will have access to a buffer local |
`desktop-buffer-handlers' functions will have access to a buffer local |
294 |
variable, named `desktop-buffer-misc', whose value is what the |
variable, named `desktop-buffer-misc', whose value is what the |
304 |
desktop-buffer-file) |
desktop-buffer-file) |
305 |
"*List of functions to call in order to create a buffer. |
"*List of functions to call in order to create a buffer. |
306 |
The functions are called without explicit parameters but can use the |
The functions are called without explicit parameters but can use the |
307 |
variables `desktop-buffer-major-mode', `desktop-buffer-file-name', |
following variables: |
308 |
`desktop-buffer-name'. |
|
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 |
|
|
320 |
If one function returns non-nil, no further functions are called. |
If one function returns non-nil, no further functions are called. |
321 |
If the function returns a buffer, then the saved mode settings |
If the function returns a buffer, then the saved mode settings |
322 |
and variable values for that buffer are copied into it." |
and variable values for that buffer are copied into it." |
325 |
|
|
326 |
(put 'desktop-buffer-handlers 'risky-local-variable t) |
(put 'desktop-buffer-handlers 'risky-local-variable t) |
327 |
|
|
|
(defvar desktop-create-buffer-form "(desktop-create-buffer 205" |
|
|
"Opening of form for creation of new buffers.") |
|
|
|
|
|
(defcustom desktop-save-hook nil |
|
|
"Hook run before desktop saves the state of Emacs. |
|
|
This is useful for truncating history lists, for example." |
|
|
:type 'hook |
|
|
:group 'desktop) |
|
|
|
|
328 |
(defcustom desktop-minor-mode-table |
(defcustom desktop-minor-mode-table |
329 |
'((auto-fill-function auto-fill-mode) |
'((auto-fill-function auto-fill-mode) |
330 |
(vc-mode nil)) |
(vc-mode nil)) |
358 |
(let ((here (nthcdr (1- n) l))) |
(let ((here (nthcdr (1- n) l))) |
359 |
(if (consp here) |
(if (consp here) |
360 |
(setcdr here nil)))) |
(setcdr here nil)))) |
|
;; ---------------------------------------------------------------------------- |
|
|
(defcustom desktop-clear-preserve-buffers |
|
|
'("*scratch*" "*Messages*") |
|
|
"*Buffer names that `desktop-clear' should not delete." |
|
|
:type '(repeat string) |
|
|
:group 'desktop) |
|
361 |
|
|
362 |
|
;; ---------------------------------------------------------------------------- |
363 |
(defun desktop-clear () |
(defun desktop-clear () |
364 |
"Empty the Desktop. |
"Empty the Desktop. |
365 |
This kills all buffers except for internal ones |
This kills all buffers except for internal ones and those listed |
366 |
and those listed in `desktop-clear-preserve-buffers'." |
in `desktop-clear-preserve-buffers'. Furthermore, it clears the |
367 |
|
variables listed in `desktop-globals-to-clear'." |
368 |
(interactive) |
(interactive) |
369 |
(setq kill-ring nil |
(dolist (var desktop-globals-to-clear) |
370 |
kill-ring-yank-pointer nil |
(if (symbolp var) |
371 |
search-ring nil |
(eval `(setq-default ,var nil)) |
372 |
search-ring-yank-pointer nil |
(eval `(setq-default ,(car var) ,(cdr var))))) |
|
regexp-search-ring nil |
|
|
regexp-search-ring-yank-pointer nil) |
|
373 |
(let ((buffers (buffer-list))) |
(let ((buffers (buffer-list))) |
374 |
(while buffers |
(while buffers |
375 |
(or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers) |
(let ((bufname (buffer-name (car buffers)))) |
376 |
(null (buffer-name (car buffers))) |
(or |
377 |
;; Don't kill buffers made for internal purposes. |
(null bufname) |
378 |
(and (not (equal (buffer-name (car buffers)) "")) |
(string-match desktop-clear-preserve-buffers-regexp bufname) |
379 |
(eq (aref (buffer-name (car buffers)) 0) ?\ )) |
(member bufname desktop-clear-preserve-buffers) |
380 |
(kill-buffer (car buffers))) |
;; Don't kill buffers made for internal purposes. |
381 |
|
(and (not (equal bufname "")) (eq (aref bufname 0) ?\ )) |
382 |
|
(kill-buffer (car buffers)))) |
383 |
(setq buffers (cdr buffers)))) |
(setq buffers (cdr buffers)))) |
384 |
(delete-other-windows)) |
(delete-other-windows)) |
385 |
|
|
386 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
387 |
(add-hook 'kill-emacs-hook 'desktop-kill) |
(add-hook 'kill-emacs-hook 'desktop-kill) |
388 |
|
|
389 |
(defun desktop-kill () |
(defun desktop-kill () |
390 |
(if desktop-dirname |
"If `desktop-enable' is non-nil, do what `desktop-save' says to do. |
391 |
(condition-case err |
If the desktop should be saved and `desktop-dirname' |
392 |
(desktop-save desktop-dirname) |
is nil, ask the user where to save the desktop." |
393 |
(file-error |
(when |
394 |
(if (yes-or-no-p "Error while saving the desktop. Quit anyway? ") |
(and |
395 |
nil |
desktop-enable |
396 |
(signal (car err) (cdr err))))))) |
(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 |
|
|
416 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
417 |
(defun desktop-list* (&rest args) |
(defun desktop-list* (&rest args) |
418 |
(if (null (cdr args)) |
(if (null (cdr args)) |
425 |
(setq args (cdr args))) |
(setq args (cdr args))) |
426 |
value))) |
value))) |
427 |
|
|
428 |
|
;; ---------------------------------------------------------------------------- |
429 |
(defun desktop-internal-v2s (val) |
(defun desktop-internal-v2s (val) |
430 |
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. |
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. |
431 |
TXT is a string that when read and evaluated yields value. |
TXT is a string that when read and evaluated yields value. |
505 |
(t ; save as text |
(t ; save as text |
506 |
(cons 'may "\"Unprintable entity\"")))) |
(cons 'may "\"Unprintable entity\"")))) |
507 |
|
|
508 |
|
;; ---------------------------------------------------------------------------- |
509 |
(defun desktop-value-to-string (val) |
(defun desktop-value-to-string (val) |
510 |
"Convert VALUE to a string that when read evaluates to the same value. |
"Convert VALUE to a string that when read evaluates to the same value. |
511 |
Not all types of values are supported." |
Not all types of values are supported." |
517 |
(if (eq quote 'must) |
(if (eq quote 'must) |
518 |
(concat "'" txt) |
(concat "'" txt) |
519 |
txt))) |
txt))) |
520 |
|
|
521 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
522 |
(defun desktop-outvar (varspec) |
(defun desktop-outvar (varspec) |
523 |
"Output a setq statement for variable VAR to the desktop file. |
"Output a setq statement for variable VAR to the desktop file. |
540 |
" " |
" " |
541 |
(desktop-value-to-string (symbol-value var)) |
(desktop-value-to-string (symbol-value var)) |
542 |
")\n"))))) |
")\n"))))) |
543 |
|
|
544 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
545 |
(defun desktop-save-buffer-p (filename bufname mode &rest dummy) |
(defun desktop-save-buffer-p (filename bufname mode &rest dummy) |
546 |
"Return t if the desktop should record a particular buffer for next startup. |
"Return t if the desktop should record a particular buffer for next startup. |
558 |
default-directory)))) |
default-directory)))) |
559 |
(and (null filename) |
(and (null filename) |
560 |
(memq mode desktop-buffer-modes-to-save)))))) |
(memq mode desktop-buffer-modes-to-save)))))) |
561 |
|
|
562 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
563 |
(defcustom desktop-relative-file-names nil |
(defun desktop-file-name (filename dirname) |
564 |
"*Store relative file names in the desktop file." |
"Convert FILENAME to format specified in `desktop-file-name-format'. |
565 |
:type 'boolean |
DIRNAME must be the directory in which the desktop file will be saved." |
566 |
:group 'desktop) |
(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)))) |
577 |
|
|
578 |
|
;; ---------------------------------------------------------------------------- |
579 |
(defun desktop-save (dirname) |
(defun desktop-save (dirname) |
580 |
"Save the Desktop file. Parameter DIRNAME specifies where to save desktop." |
"Save the Desktop file. Parameter DIRNAME specifies where to save desktop." |
581 |
(interactive "DDirectory to save desktop file in: ") |
(interactive "DDirectory to save desktop file in: ") |
582 |
(run-hooks 'desktop-save-hook) |
(run-hooks 'desktop-save-hook) |
583 |
(save-excursion |
(save-excursion |
584 |
(let ((filename (expand-file-name desktop-basefilename dirname)) |
(let ((filename (expand-file-name desktop-base-file-name dirname)) |
585 |
(info (nreverse |
(info |
586 |
(mapcar |
(mapcar |
587 |
(function |
(function |
588 |
(lambda (b) |
(lambda (b) |
589 |
(set-buffer b) |
(set-buffer b) |
590 |
(list |
(list |
591 |
(let ((bn (buffer-file-name))) |
(desktop-file-name (buffer-file-name) dirname) |
592 |
(if bn |
(buffer-name) |
593 |
(if desktop-relative-file-names |
major-mode |
594 |
(file-relative-name bn dirname) |
;; minor modes |
595 |
bn))) |
(let (ret) |
596 |
(buffer-name) |
(mapcar |
597 |
major-mode |
#'(lambda (mim) |
598 |
;; minor modes |
(and |
599 |
(let (ret) |
(boundp mim) |
600 |
(mapcar |
(symbol-value mim) |
601 |
#'(lambda (mim) |
(setq |
602 |
(and (boundp mim) |
ret |
603 |
(symbol-value mim) |
(cons |
604 |
(setq ret |
(let ( |
605 |
(cons (let ((special (assq mim desktop-minor-mode-table))) |
(special (assq mim desktop-minor-mode-table)) |
606 |
(if special |
) |
607 |
(cadr special) |
(if special (cadr special) mim)) |
608 |
mim)) |
ret)))) |
609 |
ret)))) |
(mapcar #'car minor-mode-alist)) |
610 |
(mapcar #'car minor-mode-alist)) |
ret) |
611 |
ret) |
(point) |
612 |
(point) |
(list (mark t) mark-active) |
613 |
(list (mark t) mark-active) |
buffer-read-only |
614 |
buffer-read-only |
(run-hook-with-args-until-success 'desktop-buffer-misc-functions) |
615 |
(run-hook-with-args-until-success |
(let ( |
616 |
'desktop-buffer-misc-functions) |
(locals desktop-locals-to-save) |
617 |
(let ((locals desktop-locals-to-save) |
(loclist (buffer-local-variables)) |
618 |
(loclist (buffer-local-variables)) |
(ll) |
619 |
(ll)) |
) |
620 |
(while locals |
(while locals |
621 |
(let ((here (assq (car locals) loclist))) |
(let ((here (assq (car locals) loclist))) |
622 |
(if here |
(if here |
623 |
(setq ll (cons here ll)) |
(setq ll (cons here ll)) |
624 |
(if (member (car locals) loclist) |
(when (member (car locals) loclist) |
625 |
(setq ll (cons (car locals) ll))))) |
(setq ll (cons (car locals) ll))))) |
626 |
(setq locals (cdr locals))) |
(setq locals (cdr locals))) |
627 |
ll) |
ll)))) |
628 |
))) |
(buffer-list))) |
629 |
(buffer-list)))) |
(buf (get-buffer-create "*desktop*"))) |
|
(buf (get-buffer-create "*desktop*"))) |
|
630 |
(set-buffer buf) |
(set-buffer buf) |
631 |
(erase-buffer) |
(erase-buffer) |
632 |
|
|
633 |
(insert ";; -*- coding: emacs-mule; -*-\n" |
(insert |
634 |
desktop-header |
";; -*- coding: emacs-mule; -*-\n" |
635 |
";; Created " (current-time-string) "\n" |
desktop-header |
636 |
";; Emacs version " emacs-version "\n\n" |
";; Created " (current-time-string) "\n" |
637 |
";; Global section:\n") |
";; Desktop file format version " desktop-file-version "\n" |
638 |
|
";; Emacs version " emacs-version "\n\n" |
639 |
|
";; Global section:\n") |
640 |
(mapcar (function desktop-outvar) desktop-globals-to-save) |
(mapcar (function desktop-outvar) desktop-globals-to-save) |
641 |
(if (memq 'kill-ring desktop-globals-to-save) |
(if (memq 'kill-ring desktop-globals-to-save) |
642 |
(insert "(setq kill-ring-yank-pointer (nthcdr " |
(insert |
643 |
(int-to-string |
"(setq kill-ring-yank-pointer (nthcdr " |
644 |
(- (length kill-ring) (length kill-ring-yank-pointer))) |
(int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) |
645 |
" kill-ring))\n")) |
" kill-ring))\n")) |
646 |
|
|
647 |
(insert "\n;; Buffer section:\n") |
(insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") |
648 |
(mapcar |
(mapcar |
649 |
(function (lambda (l) |
(function |
650 |
(if (apply 'desktop-save-buffer-p l) |
(lambda (l) |
651 |
(progn |
(if (apply 'desktop-save-buffer-p l) |
652 |
(insert desktop-create-buffer-form) |
(progn |
653 |
(mapcar |
(insert "(desktop-create-buffer " desktop-file-version) |
654 |
(function (lambda (e) |
(mapcar |
655 |
(insert "\n " |
(function |
656 |
(desktop-value-to-string e)))) |
(lambda (e) |
657 |
l) |
(insert "\n " (desktop-value-to-string e)))) |
658 |
(insert ")\n\n"))))) |
l) |
659 |
info) |
(insert ")\n\n"))))) |
660 |
|
info) |
661 |
(setq default-directory dirname) |
(setq default-directory dirname) |
662 |
(if (file-exists-p filename) (delete-file filename)) |
(when (file-exists-p filename) (delete-file filename)) |
663 |
(let ((coding-system-for-write 'emacs-mule)) |
(let ((coding-system-for-write 'emacs-mule)) |
664 |
(write-region (point-min) (point-max) filename nil 'nomessage)))) |
(write-region (point-min) (point-max) filename nil 'nomessage)))) |
665 |
(setq desktop-dirname dirname)) |
(setq desktop-dirname dirname)) |
666 |
|
|
667 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
668 |
(defun desktop-remove () |
(defun desktop-remove () |
669 |
"Delete the Desktop file and inactivate the desktop system." |
"Delete the Desktop file and inactivate the desktop system." |
670 |
(interactive) |
(interactive) |
671 |
(if desktop-dirname |
(if desktop-dirname |
672 |
(let ((filename (concat desktop-dirname desktop-basefilename))) |
(let ((filename (concat desktop-dirname desktop-base-file-name))) |
673 |
(setq desktop-dirname nil) |
(setq desktop-dirname nil) |
674 |
(if (file-exists-p filename) |
(if (file-exists-p filename) |
675 |
(delete-file filename))))) |
(delete-file filename))))) |
676 |
|
|
677 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
678 |
;;;###autoload |
;;;###autoload |
679 |
(defun desktop-read () |
(defun desktop-read () |
680 |
"Read the Desktop file and the files it specifies. |
"Read the Desktop file and the files it specifies. |
681 |
This is a no-op when Emacs is running in batch mode." |
This is a no-op when Emacs is running in batch mode. |
682 |
|
Look for the desktop file according to the variables `desktop-base-file-name' |
683 |
|
and `desktop-path'. If no desktop file is found, clear the desktop. |
684 |
|
Returns t if it has read a desktop file, nil otherwise." |
685 |
(interactive) |
(interactive) |
686 |
(if noninteractive |
(unless noninteractive |
687 |
nil |
(let ((dirs desktop-path)) |
688 |
(let ((dirs '("./" "~/"))) |
(while |
689 |
(while (and dirs |
(and |
690 |
(not (file-exists-p (expand-file-name |
dirs |
691 |
desktop-basefilename |
(not |
692 |
(car dirs))))) |
(file-exists-p (expand-file-name desktop-base-file-name (car dirs))))) |
693 |
(setq dirs (cdr dirs))) |
(setq dirs (cdr dirs))) |
694 |
(setq desktop-dirname (and dirs (expand-file-name (car dirs)))) |
(setq desktop-dirname (and dirs (expand-file-name (car dirs)))) |
695 |
(if desktop-dirname |
(if desktop-dirname |
696 |
(let ((desktop-last-buffer nil)) |
(let ((desktop-first-buffer nil)) |
697 |
;; `load-with-code-conversion' calls `eval-buffer' which |
;; `desktop-create-buffer' sets `desktop-first-buffer' to the first |
698 |
;; contains a `save-excursion', so we end up with the same |
;; buffer in the desktop file (the last for desktop files written |
699 |
;; buffer before and after the load. This is a problem |
;; by desktop version prior to 206). |
700 |
;; when the desktop is read initially when Emacs starts up |
(load (expand-file-name desktop-base-file-name desktop-dirname) t t t) |
701 |
;; because, if we still are in *scratch* after running |
(when desktop-first-buffer (switch-to-buffer desktop-first-buffer)) |
702 |
;; `after-init-hook', the splash screen will be displayed. |
(run-hooks 'desktop-delay-hook) |
703 |
(load (expand-file-name desktop-basefilename desktop-dirname) |
(setq desktop-delay-hook nil) |
704 |
t t t) |
(run-hooks 'desktop-after-read-hook) |
705 |
(when desktop-last-buffer |
(message "Desktop loaded.") |
706 |
(switch-to-buffer desktop-last-buffer)) |
t) |
707 |
(run-hooks 'desktop-delay-hook) |
(desktop-clear) |
708 |
(setq desktop-delay-hook nil) |
(run-hooks 'desktop-no-desktop-file-hook) |
709 |
(message "Desktop loaded.")) |
(message "No desktop file.") |
710 |
(desktop-clear))))) |
nil)))) |
711 |
|
|
712 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
713 |
;;;###autoload |
;;;###autoload |
714 |
(defun desktop-load-default () |
(defun desktop-load-default () |
719 |
(progn |
(progn |
720 |
(load "default" t t) |
(load "default" t t) |
721 |
(setq inhibit-default-init t)))) |
(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. |
727 |
|
However, if `desktop-enable' was nil at call, don't save the old desktop. |
728 |
|
This 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 |
|
|
758 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
759 |
;; Note: the following functions use the dynamic variable binding in Lisp. |
;; Note: the following functions use the dynamic variable binding in Lisp. |
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 |
|
|
775 |
(defun desktop-buffer-info-misc-data () |
(defun desktop-buffer-info-misc-data () |
776 |
(if (eq major-mode 'Info-mode) |
(if (eq major-mode 'Info-mode) |
777 |
(list Info-current-file |
(list Info-current-file |
778 |
Info-current-node))) |
Info-current-node))) |
779 |
|
|
780 |
|
;; ---------------------------------------------------------------------------- |
781 |
(defun desktop-buffer-dired-misc-data () |
(defun desktop-buffer-dired-misc-data () |
782 |
(if (eq major-mode 'dired-mode) |
(when (eq major-mode 'dired-mode) |
783 |
(cons |
(eval-when-compile (defvar dirname)) |
784 |
(expand-file-name dired-directory) |
(cons |
785 |
(cdr |
;; dired directory in portable form |
786 |
(nreverse |
(file-name-as-directory (desktop-file-name dired-directory dirname)) |
787 |
(mapcar |
(cdr (nreverse (mapcar (function car) dired-subdir-alist)))))) |
|
(function car) |
|
|
dired-subdir-alist)))))) |
|
788 |
|
|
789 |
|
;; ---------------------------------------------------------------------------- |
790 |
(defun desktop-buffer-info () "Load an info file." |
(defun desktop-buffer-info () "Load an info file." |
791 |
(if (eq 'Info-mode desktop-buffer-major-mode) |
(if (eq 'Info-mode desktop-buffer-major-mode) |
792 |
(progn |
(progn |
796 |
(require 'info) |
(require 'info) |
797 |
(Info-find-node first second) |
(Info-find-node first second) |
798 |
(current-buffer)))))) |
(current-buffer)))))) |
799 |
|
|
800 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
801 |
|
(eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler. |
802 |
(defun desktop-buffer-rmail () "Load an RMAIL file." |
(defun desktop-buffer-rmail () "Load an RMAIL file." |
803 |
(if (eq 'rmail-mode desktop-buffer-major-mode) |
(if (eq 'rmail-mode desktop-buffer-major-mode) |
804 |
(condition-case error |
(condition-case error |
809 |
(file-locked |
(file-locked |
810 |
(kill-buffer (current-buffer)) |
(kill-buffer (current-buffer)) |
811 |
'ignored)))) |
'ignored)))) |
812 |
|
|
813 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
814 |
(defun desktop-buffer-mh () "Load a folder in the mh system." |
(defun desktop-buffer-mh () "Load a folder in the mh system." |
815 |
(if (eq 'mh-folder-mode desktop-buffer-major-mode) |
(if (eq 'mh-folder-mode desktop-buffer-major-mode) |
816 |
(progn |
(progn |
817 |
(require 'mh-e) |
(eval-and-compile (require 'mh-e)) |
818 |
(mh-find-path) |
(mh-find-path) |
819 |
(mh-visit-folder desktop-buffer-name) |
(mh-visit-folder desktop-buffer-name) |
820 |
(current-buffer)))) |
(current-buffer)))) |
821 |
|
|
822 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
823 |
(defun desktop-buffer-dired () "Load a directory using dired." |
(defun desktop-buffer-dired () "Load a directory using dired." |
824 |
(if (eq 'dired-mode desktop-buffer-major-mode) |
(if (eq 'dired-mode desktop-buffer-major-mode) |
830 |
(message "Directory %s no longer exists." (car desktop-buffer-misc)) |
(message "Directory %s no longer exists." (car desktop-buffer-misc)) |
831 |
(sit-for 1) |
(sit-for 1) |
832 |
'ignored))) |
'ignored))) |
833 |
|
|
834 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
835 |
(defun desktop-buffer-file () "Load a file." |
(defun desktop-buffer-file () "Load a file." |
836 |
(if desktop-buffer-file-name |
(if desktop-buffer-file-name |
845 |
(error (pop-to-buffer buf))) |
(error (pop-to-buffer buf))) |
846 |
buf) |
buf) |
847 |
'ignored))) |
'ignored))) |
848 |
|
|
849 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
850 |
;; Create a buffer, load its file, set is mode, ...; called from Desktop file |
;; Create a buffer, load its file, set is mode, ...; called from Desktop file |
851 |
;; only. |
;; only. |
852 |
|
|
853 |
(defvar desktop-last-buffer nil |
(eval-when-compile ; Just to silence the byte compiler |
854 |
"Last buffer read. Dynamically bound in `desktop-read'.") |
(defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read' |
855 |
|
) |
856 |
(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name |
|
857 |
desktop-buffer-major-mode |
(defun desktop-create-buffer ( |
858 |
mim pt mk ro desktop-buffer-misc |
desktop-file-version |
859 |
&optional locals) |
desktop-buffer-file-name |
860 |
(let ((hlist desktop-buffer-handlers) |
desktop-buffer-name |
861 |
(result) |
desktop-buffer-major-mode |
862 |
(handler)) |
desktop-buffer-minor-modes |
863 |
(while (and (not result) hlist) |
desktop-buffer-point |
864 |
(setq handler (car hlist)) |
desktop-buffer-mark |
865 |
(setq result (funcall handler)) |
desktop-buffer-read-only |
866 |
(setq hlist (cdr hlist))) |
desktop-buffer-misc |
867 |
(when (bufferp result) |
&optional |
868 |
(setq desktop-last-buffer result) |
desktop-buffer-locals) |
869 |
(set-buffer result) |
;; To make desktop files with relative file names possible, we cannot |
870 |
(if (not (equal (buffer-name) desktop-buffer-name)) |
;; allow `default-directory' to change. Therefore we save current buffer. |
871 |
(rename-buffer desktop-buffer-name)) |
(save-current-buffer |
872 |
;; minor modes |
(let ( |
873 |
(cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible |
(buffer-list (buffer-list)) |
874 |
((equal '(nil) mim) (auto-fill-mode 0)) |
(hlist desktop-buffer-handlers) |
875 |
(t (mapcar #'(lambda (minor-mode) |
(result) |
876 |
(when (functionp minor-mode) |
(handler) |
877 |
(funcall minor-mode 1))) |
) |
878 |
mim))) |
;; Call desktop-buffer-handlers to create buffer. |
879 |
(goto-char pt) |
(while (and (not result) hlist) |
880 |
(if (consp mk) |
(setq handler (car hlist)) |
881 |
(progn |
(setq result (funcall handler)) |
882 |
(set-mark (car mk)) |
(setq hlist (cdr hlist))) |
883 |
(setq mark-active (car (cdr mk)))) |
(unless (bufferp result) (setq result nil)) |
884 |
(set-mark mk)) |
(unless (< desktop-file-version 206) |
885 |
;; Never override file system if the file really is read-only marked. |
(when result (setq buffer-list (cons result buffer-list))) |
886 |
(if ro (setq buffer-read-only ro)) |
(mapcar 'bury-buffer buffer-list)) |
887 |
(while locals |
(when result |
888 |
(let ((this (car locals))) |
(if (< desktop-file-version 206) |
889 |
(if (consp this) |
(setq desktop-first-buffer result) |
890 |
;; an entry of this form `(symbol . value)' |
(bury-buffer result)) |
891 |
(progn |
(unless desktop-first-buffer (setq desktop-first-buffer result)) |
892 |
(make-local-variable (car this)) |
(set-buffer result) |
893 |
(set (car this) (cdr this))) |
(unless (equal (buffer-name) desktop-buffer-name) |
894 |
;; an entry of the form `symbol' |
(rename-buffer desktop-buffer-name)) |
895 |
(make-local-variable this) |
;; minor modes |
896 |
(makunbound this))) |
(cond ( |
897 |
(setq locals (cdr locals)))))) |
;; 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))))))) |
929 |
|
|
930 |
|
;; ---------------------------------------------------------------------------- |
931 |
;; Backward compatibility -- update parameters to 205 standards. |
;; Backward compatibility -- update parameters to 205 standards. |
932 |
(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name |
(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name |
933 |
desktop-buffer-major-mode |
desktop-buffer-major-mode |
940 |
(cons 'case-fold-search cfs) |
(cons 'case-fold-search cfs) |
941 |
(cons 'case-replace cr) |
(cons 'case-replace cr) |
942 |
(cons 'overwrite-mode (car mim))))) |
(cons 'overwrite-mode (car mim))))) |
943 |
|
|
944 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
945 |
|
;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the |
946 |
;; If the user set desktop-enable to t with Custom, |
;; command line, we do the rest of what it takes to use desktop, but do it |
947 |
;; do the rest of what it takes to use desktop, |
;; after finishing loading the init file. |
948 |
;; but do it after finishing loading the init file. |
;; We cannot use `command-switch-alist' to process "--no-desktop" because these |
949 |
(add-hook 'after-init-hook |
;; functions are processed after `after-init-hook'. |
950 |
'(lambda () |
(add-hook |
951 |
(when desktop-enable |
'after-init-hook |
952 |
(desktop-load-default) |
'(lambda () |
953 |
(desktop-read)))) |
(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)))))) |
959 |
|
|
960 |
(provide 'desktop) |
(provide 'desktop) |
961 |
|
|