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.
This commit is contained in:
Richard M. Stallman 2003-04-09 01:37:56 +00:00
parent 7dde432d4c
commit 4a2fce7a9f

View file

@ -99,7 +99,6 @@
;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
;; Start-up with buffer-menu???
;;; Code:
@ -108,6 +107,12 @@
;; We use functions from these modules
;; We can't (require 'mh-e) since that wants to load something.
(mapcar 'require '(info dired reporter)))
(defvar desktop-file-version "206"
"Verion number of desktop file format.
Written into the desktop file and used at desktop read to provide
backward compatibility.")
;; ----------------------------------------------------------------------------
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
@ -124,45 +129,113 @@
:initialize 'custom-initialize-default
:version "20.3")
(defcustom desktop-basefilename
(defcustom desktop-save 'ask-if-new
"*When the user changes desktop or quits emacs, should the desktop be saved?
\(in the current desktop directory)
t -- always save.
ask -- always ask.
ask-if-new -- ask if no desktop file exists, otherwise just save.
ask-if-exists -- ask if desktop file exists, otherwise don't save.
if-exists -- save if desktop file exists, otherwise don't save.
nil -- never save.
The desktop is never saved when `desktop-enable' is nil."
:type '(choice
(const :tag "Always save" t)
(const :tag "Always ask" ask)
(const :tag "Ask if desktop file is new, else do save" ask-if-new)
(const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
(const :tag "Save if desktop file exists, else don't" if-exists)
(const :tag "Never save" nil))
:group 'desktop)
(defcustom desktop-base-file-name
(convert-standard-filename ".emacs.desktop")
"File for Emacs desktop, not including the directory name."
:type 'file
:group 'desktop)
(defcustom desktop-path '("." "~")
"List of directories to search for the desktop file.
The base name of the file is specified in `desktop-base-file-name'."
:type '(repeat directory)
:group 'desktop)
(defcustom desktop-missing-file-warning nil
"*If non-nil then desktop warns when a file no longer exists.
Otherwise it simply ignores that file."
:type 'boolean
:group 'desktop)
(defvar desktop-globals-to-save
(list 'desktop-missing-file-warning
;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
;; 'kill-ring
'tags-file-name
'tags-table-list
'search-ring
'regexp-search-ring
'register-alist
;; 'desktop-globals-to-save ; Itself!
)
(defcustom desktop-no-desktop-file-hook nil
"Normal hook run after fail of `desktop-read' due to missing desktop file.
May e.g. be used to show a dired buffer."
:type 'hook
:group 'desktop)
(defcustom desktop-after-read-hook nil
"Normal hook run after a sucessful `desktop-read'.
May e.g. be used to show a buffer list."
:type 'hook
:group 'desktop)
(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)
(defcustom desktop-globals-to-save '(
desktop-missing-file-warning
tags-file-name
tags-table-list
search-ring
regexp-search-ring
register-alist)
"List of global variables to save when killing Emacs.
An element may be variable name (a symbol)
or a cons cell of the form (VAR . MAX-SIZE),
which means to truncate VAR's value to at most MAX-SIZE elements
\(if the value is a list) before saving the value.")
\(if the value is a list) before saving the value.
Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
:type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
:group 'desktop)
(defvar desktop-locals-to-save
(list 'desktop-locals-to-save ; Itself! Think it over.
'truncate-lines
'case-fold-search
'case-replace
'fill-column
'overwrite-mode
'change-log-default-name
'line-number-mode
)
(defcustom desktop-globals-to-clear '(
kill-ring
kill-ring-yank-pointer
search-ring
search-ring-yank-pointer
regexp-search-ring
regexp-search-ring-yank-pointer)
"List of global variables set to clear by `desktop-clear'.
An element may be variable name (a symbol) or a cons cell of the form
\(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
to the value obtained by evaluateing FORM."
:type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
:group 'desktop)
(defcustom desktop-clear-preserve-buffers-regexp
"^\\*tramp/.+\\*$"
"Regexp identifying buffers that `desktop-clear' should not delete."
:type 'regexp
:group 'desktop)
;; Maintained for backward compatibility
(defcustom desktop-clear-preserve-buffers
'("*scratch*" "*Messages*")
"*List of buffer names that `desktop-clear' should not delete."
:type '(repeat string)
:group 'desktop)
(defvar desktop-locals-to-save '(
desktop-locals-to-save ; Itself! Think it over.
truncate-lines
case-fold-search
case-replace
fill-column
overwrite-mode
change-log-default-name
line-number-mode)
"List of local variables to save for each buffer.
The variables are saved only when they really are local.")
(make-variable-buffer-local 'desktop-locals-to-save)
@ -171,10 +244,10 @@ The variables are saved only when they really are local.")
;; (ftp) files because they require passwords and whatnot.
;; TAGS files to save time (tags-file-name is saved instead).
(defcustom desktop-buffers-not-to-save
"\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
"Regexp identifying buffers that are to be excluded from saving."
:type 'regexp
:group 'desktop)
"\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
"Regexp identifying buffers that are to be excluded from saving."
:type 'regexp
:group 'desktop)
;; Skip ange-ftp files
(defcustom desktop-files-not-to-save
@ -196,25 +269,15 @@ whether the buffer should be recreated or not, and how."
:type '(repeat symbol)
:group 'desktop)
(defcustom desktop-buffer-major-mode nil
"When desktop creates a buffer, this holds the desired Major mode."
:type 'symbol
(defcustom desktop-file-name-format 'absolute
"*Format in which desktop file names should be saved.
Possible values are:
absolute -- Absolute file name.
tilde -- Relative to ~.
local -- Relative to directory of desktop file."
:type '(choice (const absolute) (const tilde) (const local))
:group 'desktop)
(defcustom desktop-buffer-file-name nil
"When desktop creates a buffer, this holds the file name to visit."
:type '(choice file (const nil))
:group 'desktop)
(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.")
(defcustom desktop-buffer-misc-functions
'(desktop-buffer-info-misc-data
desktop-buffer-dired-misc-data)
@ -223,6 +286,9 @@ These functions are called in order, with no arguments. If a function
returns non-nil, its value is saved along with the desktop buffer for
which it was called; no further functions will be called.
File names should formatted using the call
\"(desktop-file-name FILE-NAME dirname)\".
Later, when desktop.el restores the buffers it has saved, each of the
`desktop-buffer-handlers' functions will have access to a buffer local
variable, named `desktop-buffer-misc', whose value is what the
@ -238,8 +304,19 @@ variable, named `desktop-buffer-misc', whose value is what the
desktop-buffer-file)
"*List of functions to call in order to create a buffer.
The functions are called without explicit parameters but can use the
variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
`desktop-buffer-name'.
following variables:
desktop-file-version
desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-major-mode
desktop-buffer-minor-modes
desktop-buffer-point
desktop-buffer-mark
desktop-buffer-read-only
desktop-buffer-misc
desktop-buffer-locals
If one function returns non-nil, no further functions are called.
If the function returns a buffer, then the saved mode settings
and variable values for that buffer are copied into it."
@ -248,15 +325,6 @@ and variable values for that buffer are copied into it."
(put 'desktop-buffer-handlers 'risky-local-variable t)
(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)
(defcustom desktop-minor-mode-table
'((auto-fill-function auto-fill-mode)
(vc-mode nil))
@ -290,45 +358,61 @@ this table."
(let ((here (nthcdr (1- n) l)))
(if (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
(defcustom desktop-clear-preserve-buffers
'("*scratch*" "*Messages*")
"*Buffer names that `desktop-clear' should not delete."
:type '(repeat string)
:group 'desktop)
;; ----------------------------------------------------------------------------
(defun desktop-clear ()
"Empty the Desktop.
This kills all buffers except for internal ones
and those listed in `desktop-clear-preserve-buffers'."
This kills all buffers except for internal ones and those listed
in `desktop-clear-preserve-buffers'. Furthermore, it clears the
variables listed in `desktop-globals-to-clear'."
(interactive)
(setq kill-ring nil
kill-ring-yank-pointer nil
search-ring nil
search-ring-yank-pointer nil
regexp-search-ring nil
regexp-search-ring-yank-pointer nil)
(dolist (var desktop-globals-to-clear)
(if (symbolp var)
(eval `(setq-default ,var nil))
(eval `(setq-default ,(car var) ,(cdr var)))))
(let ((buffers (buffer-list)))
(while buffers
(or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers)
(null (buffer-name (car buffers)))
;; Don't kill buffers made for internal purposes.
(and (not (equal (buffer-name (car buffers)) ""))
(eq (aref (buffer-name (car buffers)) 0) ?\ ))
(kill-buffer (car buffers)))
(let ((bufname (buffer-name (car buffers))))
(or
(null bufname)
(string-match desktop-clear-preserve-buffers-regexp bufname)
(member bufname desktop-clear-preserve-buffers)
;; Don't kill buffers made for internal purposes.
(and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
(kill-buffer (car buffers))))
(setq buffers (cdr buffers))))
(delete-other-windows))
;; ----------------------------------------------------------------------------
(add-hook 'kill-emacs-hook 'desktop-kill)
(defun desktop-kill ()
(if desktop-dirname
(condition-case err
(desktop-save desktop-dirname)
(file-error
(if (yes-or-no-p "Error while saving the desktop. Quit anyway? ")
nil
(signal (car err) (cdr err)))))))
"If `desktop-enable' is non-nil, do what `desktop-save' says to do.
If the desktop should be saved and `desktop-dirname'
is nil, ask the user where to save the desktop."
(when
(and
desktop-enable
(let ((exists (file-exists-p (concat desktop-dirname desktop-base-file-name))))
(or
(eq desktop-save 't)
(and exists (memq desktop-save '(ask-if-new if-exists)))
(and
(or
(memq desktop-save '(ask ask-if-new))
(and exists (eq desktop-save 'ask-if-exists)))
(y-or-n-p "Save desktop? ")))))
(unless desktop-dirname
(setq desktop-dirname
(expand-file-name
(call-interactively
(lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))
(condition-case err
(desktop-save desktop-dirname)
(file-error
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
(signal (car err) (cdr err)))))))
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
(if (null (cdr args))
@ -341,6 +425,7 @@ and those listed in `desktop-clear-preserve-buffers'."
(setq args (cdr args)))
value)))
;; ----------------------------------------------------------------------------
(defun desktop-internal-v2s (val)
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
TXT is a string that when read and evaluated yields value.
@ -420,6 +505,7 @@ QUOTE may be `may' (value may be quoted),
(t ; save as text
(cons 'may "\"Unprintable entity\""))))
;; ----------------------------------------------------------------------------
(defun desktop-value-to-string (val)
"Convert VALUE to a string that when read evaluates to the same value.
Not all types of values are supported."
@ -431,6 +517,7 @@ Not all types of values are supported."
(if (eq quote 'must)
(concat "'" txt)
txt)))
;; ----------------------------------------------------------------------------
(defun desktop-outvar (varspec)
"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
" "
(desktop-value-to-string (symbol-value var))
")\n")))))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
"Return t if the desktop should record a particular buffer for next startup.
@ -470,137 +558,157 @@ MODE is the major mode."
default-directory))))
(and (null filename)
(memq mode desktop-buffer-modes-to-save))))))
;; ----------------------------------------------------------------------------
(defcustom desktop-relative-file-names nil
"*Store relative file names in the desktop file."
:type 'boolean
:group 'desktop)
;; ----------------------------------------------------------------------------
(defun desktop-file-name (filename dirname)
"Convert FILENAME to format specified in `desktop-file-name-format'.
DIRNAME must be the directory in which the desktop file will be saved."
(cond
((not filename) nil)
((eq desktop-file-name-format 'tilde)
(let ((relative-name (file-relative-name (expand-file-name filename) "~")))
(cond
((file-name-absolute-p relative-name) relative-name)
((string= "./" relative-name) "~/")
((string= "." relative-name) "~")
(t (concat "~/" relative-name)))))
((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
(t (expand-file-name filename))))
;; ----------------------------------------------------------------------------
(defun desktop-save (dirname)
"Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
"Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
(interactive "DDirectory to save desktop file in: ")
(run-hooks 'desktop-save-hook)
(save-excursion
(let ((filename (expand-file-name desktop-basefilename dirname))
(info (nreverse
(mapcar
(function
(lambda (b)
(set-buffer b)
(list
(let ((bn (buffer-file-name)))
(if bn
(if desktop-relative-file-names
(file-relative-name bn dirname)
bn)))
(buffer-name)
major-mode
;; minor modes
(let (ret)
(mapcar
#'(lambda (mim)
(and (boundp mim)
(symbol-value mim)
(setq ret
(cons (let ((special (assq mim desktop-minor-mode-table)))
(if special
(cadr special)
mim))
ret))))
(mapcar #'car minor-mode-alist))
ret)
(point)
(list (mark t) mark-active)
buffer-read-only
(run-hook-with-args-until-success
'desktop-buffer-misc-functions)
(let ((locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll))
(while locals
(let ((here (assq (car locals) loclist)))
(if here
(setq ll (cons here ll))
(if (member (car locals) loclist)
(setq ll (cons (car locals) ll)))))
(setq locals (cdr locals)))
ll)
)))
(buffer-list))))
(buf (get-buffer-create "*desktop*")))
(let ((filename (expand-file-name desktop-base-file-name dirname))
(info
(mapcar
(function
(lambda (b)
(set-buffer b)
(list
(desktop-file-name (buffer-file-name) dirname)
(buffer-name)
major-mode
;; minor modes
(let (ret)
(mapcar
#'(lambda (mim)
(and
(boundp mim)
(symbol-value mim)
(setq
ret
(cons
(let (
(special (assq mim desktop-minor-mode-table))
)
(if special (cadr special) mim))
ret))))
(mapcar #'car minor-mode-alist))
ret)
(point)
(list (mark t) mark-active)
buffer-read-only
(run-hook-with-args-until-success 'desktop-buffer-misc-functions)
(let (
(locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll)
)
(while locals
(let ((here (assq (car locals) loclist)))
(if here
(setq ll (cons here ll))
(when (member (car locals) loclist)
(setq ll (cons (car locals) ll)))))
(setq locals (cdr locals)))
ll))))
(buffer-list)))
(buf (get-buffer-create "*desktop*")))
(set-buffer buf)
(erase-buffer)
(insert ";; -*- coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Emacs version " emacs-version "\n\n"
";; Global section:\n")
(insert
";; -*- coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
";; Emacs version " emacs-version "\n\n"
";; Global section:\n")
(mapcar (function desktop-outvar) desktop-globals-to-save)
(if (memq 'kill-ring desktop-globals-to-save)
(insert "(setq kill-ring-yank-pointer (nthcdr "
(int-to-string
(- (length kill-ring) (length kill-ring-yank-pointer)))
" kill-ring))\n"))
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
" kill-ring))\n"))
(insert "\n;; Buffer section:\n")
(insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
(mapcar
(function (lambda (l)
(if (apply 'desktop-save-buffer-p l)
(progn
(insert desktop-create-buffer-form)
(mapcar
(function (lambda (e)
(insert "\n "
(desktop-value-to-string e))))
l)
(insert ")\n\n")))))
info)
(function
(lambda (l)
(if (apply 'desktop-save-buffer-p l)
(progn
(insert "(desktop-create-buffer " desktop-file-version)
(mapcar
(function
(lambda (e)
(insert "\n " (desktop-value-to-string e))))
l)
(insert ")\n\n")))))
info)
(setq default-directory dirname)
(if (file-exists-p filename) (delete-file filename))
(when (file-exists-p filename) (delete-file filename))
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) filename nil 'nomessage))))
(write-region (point-min) (point-max) filename nil 'nomessage))))
(setq desktop-dirname dirname))
;; ----------------------------------------------------------------------------
(defun desktop-remove ()
"Delete the Desktop file and inactivate the desktop system."
(interactive)
(if desktop-dirname
(let ((filename (concat desktop-dirname desktop-basefilename)))
(let ((filename (concat desktop-dirname desktop-base-file-name)))
(setq desktop-dirname nil)
(if (file-exists-p filename)
(delete-file filename)))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-read ()
"Read the Desktop file and the files it specifies.
This is a no-op when Emacs is running in batch mode."
This is a no-op when Emacs is running in batch mode.
Look for the desktop file according to the variables `desktop-base-file-name'
and `desktop-path'. If no desktop file is found, clear the desktop.
Returns t if it has read a desktop file, nil otherwise."
(interactive)
(if noninteractive
nil
(let ((dirs '("./" "~/")))
(while (and dirs
(not (file-exists-p (expand-file-name
desktop-basefilename
(car dirs)))))
(setq dirs (cdr dirs)))
(unless noninteractive
(let ((dirs desktop-path))
(while
(and
dirs
(not
(file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
(setq dirs (cdr dirs)))
(setq desktop-dirname (and dirs (expand-file-name (car dirs))))
(if desktop-dirname
(let ((desktop-last-buffer nil))
;; `load-with-code-conversion' calls `eval-buffer' which
;; contains a `save-excursion', so we end up with the same
;; buffer before and after the load. This is a problem
;; when the desktop is read initially when Emacs starts up
;; because, if we still are in *scratch* after running
;; `after-init-hook', the splash screen will be displayed.
(load (expand-file-name desktop-basefilename desktop-dirname)
t t t)
(when desktop-last-buffer
(switch-to-buffer desktop-last-buffer))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(message "Desktop loaded."))
(desktop-clear)))))
(let ((desktop-first-buffer nil))
;; `desktop-create-buffer' sets `desktop-first-buffer' to the first
;; buffer in the desktop file (the last for desktop files written
;; by desktop version prior to 206).
(load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
(when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(run-hooks 'desktop-after-read-hook)
(message "Desktop loaded.")
t)
(desktop-clear)
(run-hooks 'desktop-no-desktop-file-hook)
(message "No desktop file.")
nil))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-load-default ()
@ -611,24 +719,74 @@ to provide correct modes for autoloaded files."
(progn
(load "default" t t)
(setq inhibit-default-init t))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-change-dir (dir)
"Save and clear the desktop, then load the desktop from directory DIR.
However, if `desktop-enable' was nil at call, don't save the old desktop.
This function always sets `desktop-enable' to t."
(interactive "DNew directory: ")
(desktop-kill)
(desktop-clear)
(cd dir)
(setq desktop-enable t)
(let ((desktop-path '(".")))
(desktop-read)
;; Set `desktop-dirname' even in no desktop file was found
(setq desktop-dirname (expand-file-name dir))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-save-in-load-dir ()
"Save desktop in directory from which it was loaded."
(interactive)
(if desktop-dirname
(desktop-save desktop-dirname)
(call-interactively 'desktop-save))
(message "Desktop saved in %s" desktop-dirname))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-revert ()
"Revert to the last loaded desktop."
(interactive)
(unless desktop-dirname (error "No desktop has been loaded"))
(setq desktop-enable nil)
(desktop-change-dir desktop-dirname))
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;
(eval-when-compile ; Just to silence the byte compiler
(defvar desktop-file-version)
(defvar desktop-buffer-file-name)
(defvar desktop-buffer-name)
(defvar desktop-buffer-major-mode)
(defvar desktop-buffer-minor-modes)
(defvar desktop-buffer-point)
(defvar desktop-buffer-mark)
(defvar desktop-buffer-read-only)
(defvar desktop-buffer-misc)
(defvar desktop-buffer-locals)
)
(defun desktop-buffer-info-misc-data ()
(if (eq major-mode 'Info-mode)
(list Info-current-file
Info-current-node)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired-misc-data ()
(if (eq major-mode 'dired-mode)
(cons
(expand-file-name dired-directory)
(cdr
(nreverse
(mapcar
(function car)
dired-subdir-alist))))))
(when (eq major-mode 'dired-mode)
(eval-when-compile (defvar dirname))
(cons
;; dired directory in portable form
(file-name-as-directory (desktop-file-name dired-directory dirname))
(cdr (nreverse (mapcar (function car) dired-subdir-alist))))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info () "Load an info file."
(if (eq 'Info-mode desktop-buffer-major-mode)
(progn
@ -638,7 +796,9 @@ to provide correct modes for autoloaded files."
(require 'info)
(Info-find-node first second)
(current-buffer))))))
;; ----------------------------------------------------------------------------
(eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
(defun desktop-buffer-rmail () "Load an RMAIL file."
(if (eq 'rmail-mode desktop-buffer-major-mode)
(condition-case error
@ -649,14 +809,16 @@ to provide correct modes for autoloaded files."
(file-locked
(kill-buffer (current-buffer))
'ignored))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-mh () "Load a folder in the mh system."
(if (eq 'mh-folder-mode desktop-buffer-major-mode)
(progn
(require 'mh-e)
(eval-and-compile (require 'mh-e))
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired () "Load a directory using dired."
(if (eq 'dired-mode desktop-buffer-major-mode)
@ -668,6 +830,7 @@ to provide correct modes for autoloaded files."
(message "Directory %s no longer exists." (car desktop-buffer-misc))
(sit-for 1)
'ignored)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-file () "Load a file."
(if desktop-buffer-file-name
@ -682,56 +845,89 @@ to provide correct modes for autoloaded files."
(error (pop-to-buffer buf)))
buf)
'ignored)))
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...; called from Desktop file
;; only.
(defvar desktop-last-buffer nil
"Last buffer read. Dynamically bound in `desktop-read'.")
(eval-when-compile ; Just to silence the byte compiler
(defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
)
(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name
desktop-buffer-major-mode
mim pt mk ro desktop-buffer-misc
&optional locals)
(let ((hlist desktop-buffer-handlers)
(result)
(handler))
(while (and (not result) hlist)
(setq handler (car hlist))
(setq result (funcall handler))
(setq hlist (cdr hlist)))
(when (bufferp result)
(setq desktop-last-buffer result)
(set-buffer result)
(if (not (equal (buffer-name) desktop-buffer-name))
(rename-buffer desktop-buffer-name))
;; minor modes
(cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible
((equal '(nil) mim) (auto-fill-mode 0))
(t (mapcar #'(lambda (minor-mode)
(when (functionp minor-mode)
(funcall minor-mode 1)))
mim)))
(goto-char pt)
(if (consp mk)
(progn
(set-mark (car mk))
(setq mark-active (car (cdr mk))))
(set-mark mk))
;; Never override file system if the file really is read-only marked.
(if ro (setq buffer-read-only ro))
(while locals
(let ((this (car locals)))
(if (consp this)
;; an entry of this form `(symbol . value)'
(progn
(make-local-variable (car this))
(set (car this) (cdr this)))
;; an entry of the form `symbol'
(make-local-variable this)
(makunbound this)))
(setq locals (cdr locals))))))
(defun desktop-create-buffer (
desktop-file-version
desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-major-mode
desktop-buffer-minor-modes
desktop-buffer-point
desktop-buffer-mark
desktop-buffer-read-only
desktop-buffer-misc
&optional
desktop-buffer-locals)
;; To make desktop files with relative file names possible, we cannot
;; allow `default-directory' to change. Therefore we save current buffer.
(save-current-buffer
(let (
(buffer-list (buffer-list))
(hlist desktop-buffer-handlers)
(result)
(handler)
)
;; Call desktop-buffer-handlers to create buffer.
(while (and (not result) hlist)
(setq handler (car hlist))
(setq result (funcall handler))
(setq hlist (cdr hlist)))
(unless (bufferp result) (setq result nil))
(unless (< desktop-file-version 206)
(when result (setq buffer-list (cons result buffer-list)))
(mapcar 'bury-buffer buffer-list))
(when result
(if (< desktop-file-version 206)
(setq desktop-first-buffer result)
(bury-buffer result))
(unless desktop-first-buffer (setq desktop-first-buffer result))
(set-buffer result)
(unless (equal (buffer-name) desktop-buffer-name)
(rename-buffer desktop-buffer-name))
;; minor modes
(cond (
;; backwards compatible
(equal '(t) desktop-buffer-minor-modes)
(auto-fill-mode 1))(
(equal '(nil) desktop-buffer-minor-modes)
(auto-fill-mode 0))(
t
(mapcar
#'(lambda (minor-mode)
(when (functionp minor-mode) (funcall minor-mode 1)))
desktop-buffer-minor-modes)))
;; Even though point and mark are non-nil when written by `desktop-save'
;; they may be modified by mandlers wanting to set point or mark themselves.
(when desktop-buffer-point (goto-char desktop-buffer-point))
(when desktop-buffer-mark
(if (consp desktop-buffer-mark)
(progn
(set-mark (car desktop-buffer-mark))
(setq mark-active (car (cdr desktop-buffer-mark))))
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
(if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
(while desktop-buffer-locals
(let ((this (car desktop-buffer-locals)))
(if (consp this)
;; an entry of this form `(symbol . value)'
(progn
(make-local-variable (car this))
(set (car this) (cdr this)))
;; an entry of the form `symbol'
(make-local-variable this)
(makunbound this)))
(setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
desktop-buffer-major-mode
@ -744,16 +940,22 @@ to provide correct modes for autoloaded files."
(cons 'case-fold-search cfs)
(cons 'case-replace cr)
(cons 'overwrite-mode (car mim)))))
;; ----------------------------------------------------------------------------
;; If the user set desktop-enable to t with Custom,
;; do the rest of what it takes to use desktop,
;; but do it after finishing loading the init file.
(add-hook 'after-init-hook
'(lambda ()
(when desktop-enable
(desktop-load-default)
(desktop-read))))
;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
;; command line, we do the rest of what it takes to use desktop, but do it
;; after finishing loading the init file.
;; We cannot use `command-switch-alist' to process "--no-desktop" because these
;; functions are processed after `after-init-hook'.
(add-hook
'after-init-hook
'(lambda ()
(let ((key "--no-desktop"))
(if (member key command-line-args)
(delete key command-line-args)
(when desktop-enable
(desktop-load-default)
(desktop-read))))))
(provide 'desktop)