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:
parent
7dde432d4c
commit
4a2fce7a9f
1 changed files with 448 additions and 246 deletions
694
lisp/desktop.el
694
lisp/desktop.el
|
@ -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)
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue