;; - the mark & mark-active
;; - buffer-read-only
;; - some local variables
+;; - frame and window configuration
;; To use this, use customize to turn on desktop-save-mode or add the
;; following line somewhere in your init file:
;; ---------------------------------------------------------------------------
;; TODO:
;;
-;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
;;; Code:
+(require 'cl-lib)
+
(defvar desktop-file-version "206"
"Version number of desktop file format.
Written into the desktop file and used at desktop read to provide
:group 'desktop
:version "22.1")
+(defcustom desktop-auto-save-timeout nil
+ "Number of seconds between auto-saves of the desktop.
+Zero or nil means disable timer-based auto-saving."
+ :type '(choice (const :tag "Off" nil)
+ (integer :tag "Seconds"))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (ignore-errors (desktop-auto-save-set-timer)))
+ :group 'desktop
+ :version "24.4")
+
(defcustom desktop-load-locked-desktop 'ask
"Specifies whether the desktop should be loaded if locked.
Possible values are:
:type '(repeat symbol)
:group 'desktop)
+(defcustom desktop-restore-frames t
+ "When non-nil, save window/frame configuration to desktop file."
+ :type 'boolean
+ :group 'desktop
+ :version "24.4")
+
+(defcustom desktop-restore-in-current-display nil
+ "If t, frames are restored in the current display.
+If nil, frames are restored, if possible, in their original displays.
+If `delete', frames on other displays are deleted instead of restored."
+ :type '(choice (const :tag "Restore in current display" t)
+ (const :tag "Restore in original display" nil)
+ (const :tag "Delete frames in other displays" 'delete))
+ :group 'desktop
+ :version "24.4")
+
+(defcustom desktop-restoring-reuses-frames t
+ "If t, restoring frames reuses existing frames.
+If nil, existing frames are deleted.
+If `keep', existing frames are kept and not reused."
+ :type '(choice (const :tag "Reuse existing frames" t)
+ (const :tag "Delete existing frames" nil)
+ (const :tag "Keep existing frames" 'keep))
+ :group 'desktop
+ :version "24.4")
+
+(defcustom desktop-before-saving-frames-functions nil
+ "Abnormal hook run before saving frames.
+Functions in this hook are called with one argument, a live frame."
+ :type 'hook
+ :group 'desktop
+ :version "24.4")
+
(defcustom desktop-file-name-format 'absolute
"Format in which desktop file names should be saved.
Possible values are:
:version "22.1")
;;;###autoload
-(defvar desktop-save-buffer nil
+(defvar-local desktop-save-buffer nil
"When non-nil, save buffer status in desktop file.
-This variable becomes buffer local when set.
If the value is a function, it is called by `desktop-save' with argument
DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop
Later, when `desktop-read' evaluates the desktop file, auxiliary information
is passed as the argument DESKTOP-BUFFER-MISC to functions in
`desktop-buffer-mode-handlers'.")
-(make-variable-buffer-local 'desktop-save-buffer)
(make-obsolete-variable 'desktop-buffer-modes-to-save
'desktop-save-buffer "22.1")
(make-obsolete-variable 'desktop-buffer-misc-functions
(defvar desktop-delay-hook nil
"Hooks run after all buffers are loaded; intended for internal use.")
+(defvar desktop-file-checksum nil
+ "Checksum of the last auto-saved contents of the desktop file.
+Used to avoid writing contents unchanged between auto-saves.")
+
+(defvar desktop-saved-frame-states nil
+ "Saved state of all frames.
+Only valid during frame saving & restoring; intended for internal use.")
+
;; ----------------------------------------------------------------------------
;; Desktop file conflict detection
(defvar desktop-file-modtime nil
"Return the PID of the Emacs process that owns the desktop file in DIRNAME.
Return nil if no desktop file found or no Emacs process is using it.
DIRNAME omitted or nil means use `desktop-dirname'."
- (let (owner)
- (and (file-exists-p (desktop-full-lock-name dirname))
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents-literally (desktop-full-lock-name dirname))
- (goto-char (point-min))
- (setq owner (read (current-buffer)))
- (integerp owner))
- (error nil))
+ (let (owner
+ (file (desktop-full-lock-name dirname)))
+ (and (file-exists-p file)
+ (ignore-errors
+ (with-temp-buffer
+ (insert-file-contents-literally file)
+ (goto-char (point-min))
+ (setq owner (read (current-buffer)))
+ (integerp owner)))
owner)))
(defun desktop-claim-lock (&optional dirname)
(if (symbolp var)
(eval `(setq-default ,var nil))
(eval `(setq-default ,(car var) ,(cdr var)))))
- (let ((buffers (buffer-list))
- (preserve-regexp (concat "^\\("
+ (let ((preserve-regexp (concat "^\\("
(mapconcat (lambda (regexp)
(concat "\\(" regexp "\\)"))
desktop-clear-preserve-buffers
"\\|")
"\\)$")))
- (while buffers
- (let ((bufname (buffer-name (car buffers))))
- (or
- (null bufname)
- (string-match preserve-regexp bufname)
- ;; Don't kill buffers made for internal purposes.
- (and (not (equal bufname "")) (eq (aref bufname 0) ?\s))
- (kill-buffer (car buffers))))
- (setq buffers (cdr buffers))))
+ (dolist (buffer (buffer-list))
+ (let ((bufname (buffer-name buffer)))
+ (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
+ (string-match-p preserve-regexp bufname))
+ (kill-buffer buffer)))))
(delete-other-windows))
;; ----------------------------------------------------------------------------
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
- (if (null (cdr args))
- (car args)
- (setq args (nreverse args))
- (let ((value (cons (nth 1 args) (car args))))
- (setq args (cdr (cdr args)))
- (while args
- (setq value (cons (car args) value))
- (setq args (cdr args)))
- value)))
+ (and args (apply #'cl-list* args)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info (buffer)
(when (functionp desktop-save-buffer)
(funcall desktop-save-buffer desktop-dirname))
;; local variables
- (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)))
+ (let ((loclist (buffer-local-variables))
+ (ll nil))
+ (dolist (local desktop-locals-to-save)
+ (let ((here (assq local loclist)))
+ (cond (here
+ (push here ll))
+ ((member local loclist)
+ (push local ll)))))
ll)))
;; ----------------------------------------------------------------------------
-(defun desktop-internal-v2s (value)
- "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
-TXT is a string that when read and evaluated yields VALUE.
+(defun desktop--v2s (value)
+ "Convert VALUE to a pair (QUOTE . SEXP); (eval SEXP) gives VALUE.
+SEXP is an sexp that when evaluated yields VALUE.
QUOTE may be `may' (value may be quoted),
`must' (value must be quoted), or nil (value must not be quoted)."
(cond
((or (numberp value) (null value) (eq t value) (keywordp value))
- (cons 'may (prin1-to-string value)))
+ (cons 'may value))
((stringp value)
(let ((copy (copy-sequence value)))
(set-text-properties 0 (length copy) nil copy)
- ;; Get rid of text properties because we cannot read them
- (cons 'may (prin1-to-string copy))))
+ ;; Get rid of text properties because we cannot read them.
+ (cons 'may copy)))
((symbolp value)
- (cons 'must (prin1-to-string value)))
+ (cons 'must value))
((vectorp value)
- (let* ((special nil)
- (pass1 (mapcar
- (lambda (el)
- (let ((res (desktop-internal-v2s el)))
- (if (null (car res))
- (setq special t))
- res))
- value)))
+ (let* ((pass1 (mapcar #'desktop--v2s value))
+ (special (assq nil pass1)))
(if special
- (cons nil (concat "(vector "
- (mapconcat (lambda (el)
- (if (eq (car el) 'must)
- (concat "'" (cdr el))
- (cdr el)))
- pass1
- " ")
- ")"))
- (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
+ (cons nil `(vector
+ ,@(mapcar (lambda (el)
+ (if (eq (car el) 'must)
+ `',(cdr el) (cdr el)))
+ pass1)))
+ (cons 'may `[,@(mapcar #'cdr pass1)]))))
((consp value)
(let ((p value)
newlist
- use-list*
- anynil)
+ use-list*)
(while (consp p)
- (let ((q.txt (desktop-internal-v2s (car p))))
- (or anynil (setq anynil (null (car q.txt))))
- (setq newlist (cons q.txt newlist)))
+ (let ((q.sexp (desktop--v2s (car p))))
+ (push q.sexp newlist))
(setq p (cdr p)))
- (if p
- (let ((last (desktop-internal-v2s p)))
- (or anynil (setq anynil (null (car last))))
- (or anynil
- (setq newlist (cons '(must . ".") newlist)))
- (setq use-list* t)
- (setq newlist (cons last newlist))))
- (setq newlist (nreverse newlist))
- (if anynil
+ (when p
+ (let ((last (desktop--v2s p)))
+ (setq use-list* t)
+ (push last newlist)))
+ (if (assq nil newlist)
(cons nil
- (concat (if use-list* "(desktop-list* " "(list ")
- (mapconcat (lambda (el)
- (if (eq (car el) 'must)
- (concat "'" (cdr el))
- (cdr el)))
- newlist
- " ")
- ")"))
+ `(,(if use-list* 'desktop-list* 'list)
+ ,@(mapcar (lambda (el)
+ (if (eq (car el) 'must)
+ `',(cdr el) (cdr el)))
+ (nreverse newlist))))
(cons 'must
- (concat "(" (mapconcat 'cdr newlist " ") ")")))))
+ `(,@(mapcar #'cdr
+ (nreverse (if use-list* (cdr newlist) newlist)))
+ ,@(if use-list* (cdar newlist)))))))
((subrp value)
- (cons nil (concat "(symbol-function '"
- (substring (prin1-to-string value) 7 -1)
- ")")))
+ (cons nil `(symbol-function
+ ',(intern-soft (substring (prin1-to-string value) 7 -1)))))
((markerp value)
- (let ((pos (prin1-to-string (marker-position value)))
- (buf (prin1-to-string (buffer-name (marker-buffer value)))))
- (cons nil (concat "(let ((mk (make-marker)))"
- " (add-hook 'desktop-delay-hook"
- " (list 'lambda '() (list 'set-marker mk "
- pos " (get-buffer " buf ")))) mk)"))))
- (t ; save as text
- (cons 'may "\"Unprintable entity\""))))
+ (let ((pos (marker-position value))
+ (buf (buffer-name (marker-buffer value))))
+ (cons nil
+ `(let ((mk (make-marker)))
+ (add-hook 'desktop-delay-hook
+ `(lambda ()
+ (set-marker ,mk ,,pos (get-buffer ,,buf))))
+ mk))))
+ (t ; Save as text.
+ (cons 'may "Unprintable entity"))))
;; ----------------------------------------------------------------------------
(defun desktop-value-to-string (value)
Not all types of values are supported."
(let* ((print-escape-newlines t)
(float-output-format nil)
- (quote.txt (desktop-internal-v2s value))
- (quote (car quote.txt))
- (txt (cdr quote.txt)))
+ (quote.sexp (desktop--v2s value))
+ (quote (car quote.sexp))
+ (txt
+ (let ((print-quoted t))
+ (prin1-to-string (cdr quote.sexp)))))
(if (eq quote 'must)
(concat "'" txt)
txt)))
dired-skip)
(and (not (and (stringp desktop-buffers-not-to-save)
(not filename)
- (string-match desktop-buffers-not-to-save bufname)))
+ (string-match-p desktop-buffers-not-to-save bufname)))
(not (memq mode desktop-modes-not-to-save))
;; FIXME this is broken if desktop-files-not-to-save is nil.
(or (and filename
(stringp desktop-files-not-to-save)
- (not (string-match desktop-files-not-to-save filename)))
+ (not (string-match-p desktop-files-not-to-save filename)))
(and (memq mode '(dired-mode vc-dir-mode))
(with-current-buffer bufname
(not (setq dired-skip
- (string-match desktop-files-not-to-save
- default-directory)))))
+ (string-match-p desktop-files-not-to-save
+ default-directory)))))
(and (null filename)
(null dired-skip) ; bug#5755
(with-current-buffer bufname desktop-save-buffer))))))
;; ----------------------------------------------------------------------------
+(defvar desktop-filter-parameters-alist
+ '((background-color . desktop--filter-*-color)
+ (buffer-list . t)
+ (buffer-predicate . t)
+ (buried-buffer-list . t)
+ (desktop--font . desktop--filter-restore-desktop-parm)
+ (desktop--fullscreen . desktop--filter-restore-desktop-parm)
+ (desktop--height . desktop--filter-restore-desktop-parm)
+ (desktop--width . desktop--filter-restore-desktop-parm)
+ (font . desktop--filter-save-desktop-parm)
+ (font-backend . t)
+ (foreground-color . desktop--filter-*-color)
+ (fullscreen . desktop--filter-save-desktop-parm)
+ (height . desktop--filter-save-desktop-parm)
+ (left . desktop--filter-iconified-position)
+ (minibuffer . desktop--filter-minibuffer)
+ (name . t)
+ (outer-window-id . t)
+ (parent-id . t)
+ (top . desktop--filter-iconified-position)
+ (tty . desktop--filter-tty*)
+ (tty-type . desktop--filter-tty*)
+ (width . desktop--filter-save-desktop-parm)
+ (window-id . t)
+ (window-system . t))
+ "Alist of frame parameters and filtering functions.
+
+Each element is a cons (PARAM . FILTER), where PARAM is a parameter
+name (a symbol identifying a frame parameter), and FILTER can be t
+\(meaning the parameter is removed from the parameter list on saving
+and restoring), or a function that will be called with three args:
+
+ CURRENT a cons (PARAM . VALUE), where PARAM is the one being
+ filtered and VALUE is its current value
+ PARAMETERS the complete alist of parameters being filtered
+ SAVING non-nil if filtering before saving state, nil otherwise
+
+The FILTER function must return:
+ nil CURRENT is removed from the list
+ t CURRENT is left as is
+ (PARAM' . VALUE') replace CURRENT with this
+
+Frame parameters not on this list are passed intact.")
+
+(defvar desktop--target-display nil
+ "Either (minibuffer . VALUE) or nil.
+This refers to the current frame config being processed inside
+`frame--restore-frames' and its auxiliary functions (like filtering).
+If nil, there is no need to change the display.
+If non-nil, display parameter to use when creating the frame.
+Internal use only.")
+
+(defun desktop-switch-to-gui-p (parameters)
+ "True when switching to a graphic display.
+Return t if PARAMETERS describes a text-only terminal and
+the target is a graphic display; otherwise return nil.
+Only meaningful when called from a filtering function in
+`desktop-filter-parameters-alist'."
+ (and desktop--target-display ; we're switching
+ (null (cdr (assq 'display parameters))) ; from a tty
+ (cdr desktop--target-display))) ; to a GUI display
+
+(defun desktop-switch-to-tty-p (parameters)
+ "True when switching to a text-only terminal.
+Return t if PARAMETERS describes a graphic display and
+the target is a text-only terminal; otherwise return nil.
+Only meaningful when called from a filtering function in
+`desktop-filter-parameters-alist'."
+ (and desktop--target-display ; we're switching
+ (cdr (assq 'display parameters)) ; from a GUI display
+ (null (cdr desktop--target-display)))) ; to a tty
+
+(defun desktop--filter-tty* (_current parameters saving)
+ ;; Remove tty and tty-type parameters when switching
+ ;; to a GUI frame.
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))))
+
+(defun desktop--filter-*-color (current parameters saving)
+ ;; Remove (foreground|background)-color parameters
+ ;; when switching to a GUI frame if they denote an
+ ;; "unspecified" color.
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))
+ (not (stringp (cdr current)))
+ (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
+
+(defun desktop--filter-minibuffer (current _parameters saving)
+ ;; When minibuffer is a window, save it as minibuffer . t
+ (or (not saving)
+ (if (windowp (cdr current))
+ '(minibuffer . t)
+ t)))
+
+(defun desktop--filter-restore-desktop-parm (current parameters saving)
+ ;; When switching to a GUI frame, convert desktop--XXX parameter to XXX
+ (or saving
+ (not (desktop-switch-to-gui-p parameters))
+ (let ((val (cdr current)))
+ (if (eq val :desktop-processed)
+ nil
+ (cons (intern (substring (symbol-name (car current))
+ 9)) ;; (length "desktop--")
+ val)))))
+
+(defun desktop--filter-save-desktop-parm (current parameters saving)
+ ;; When switching to a tty frame, save parameter XXX as desktop--XXX so it
+ ;; can be restored in a subsequent GUI session, unless it already exists.
+ (cond (saving t)
+ ((desktop-switch-to-tty-p parameters)
+ (let ((sym (intern (format "desktop--%s" (car current)))))
+ (if (assq sym parameters)
+ nil
+ (cons sym (cdr current)))))
+ ((desktop-switch-to-gui-p parameters)
+ (let* ((dtp (assq (intern (format "desktop--%s" (car current)))
+ parameters))
+ (val (cdr dtp)))
+ (if (eq val :desktop-processed)
+ nil
+ (setcdr dtp :desktop-processed)
+ (cons (car current) val))))
+ (t t)))
+
+(defun desktop--filter-iconified-position (_current parameters saving)
+ ;; When saving an iconified frame, top & left are meaningless,
+ ;; so remove them to allow restoring to a default position.
+ (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
+
+(defun desktop-restore-in-original-display-p ()
+ "True if saved frames' displays should be honored."
+ (cond ((daemonp) t)
+ ((eq system-type 'windows-nt) nil)
+ (t (null desktop-restore-in-current-display))))
+
+(defun desktop--filter-frame-parms (parameters saving)
+ "Filter frame parameters and return filtered list.
+PARAMETERS is a parameter alist as returned by `frame-parameters'.
+If SAVING is non-nil, filtering is happening before saving frame state;
+otherwise, filtering is being done before restoring frame state.
+Parameters are filtered according to the setting of
+`desktop-filter-parameters-alist' (which see).
+Internal use only."
+ (let ((filtered nil))
+ (dolist (param parameters)
+ (let ((filter (cdr (assq (car param) desktop-filter-parameters-alist)))
+ this)
+ (cond (;; no filter: pass param
+ (null filter)
+ (push param filtered))
+ (;; filter = t; skip param
+ (eq filter t))
+ (;; filter func returns nil: skip param
+ (null (setq this (funcall filter param parameters saving))))
+ (;; filter func returns t: pass param
+ (eq this t)
+ (push param filtered))
+ (;; filter func returns a new param: use it
+ t
+ (push this filtered)))))
+ ;; Set the display parameter after filtering, so that filter functions
+ ;; have access to its original value.
+ (when desktop--target-display
+ (let ((display (assq 'display filtered)))
+ (if display
+ (setcdr display (cdr desktop--target-display))
+ (push desktop--target-display filtered))))
+ filtered))
+
+(defun desktop--process-minibuffer-frames (frames)
+ ;; Adds a desktop--mini parameter to frames
+ ;; desktop--mini is a list (MINIBUFFER NUMBER DEFAULT?) where
+ ;; MINIBUFFER t if the frame (including minibuffer-only) owns a minibuffer
+ ;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of
+ ;; the frame containing the minibuffer used by this frame
+ ;; DEFAULT? if t, this frame is the value of default-minibuffer-frame
+ (let ((count 0))
+ ;; Reset desktop--mini for all frames
+ (dolist (frame (frame-list))
+ (set-frame-parameter frame 'desktop--mini nil))
+ ;; Number all frames with its own minibuffer
+ (dolist (frame (minibuffer-frame-list))
+ (set-frame-parameter frame 'desktop--mini
+ (list t
+ (cl-incf count)
+ (eq frame default-minibuffer-frame))))
+ ;; Now link minibufferless frames with their minibuffer frames
+ (dolist (frame frames)
+ (unless (frame-parameter frame 'desktop--mini)
+ (let ((mb-frame (window-frame (minibuffer-window frame))))
+ ;; Frames whose minibuffer frame has been filtered out will have
+ ;; desktop--mini = nil, so desktop-restore-frames will restore them
+ ;; according to their minibuffer parameter. Set up desktop--mini
+ ;; for the rest.
+ (when (memq mb-frame frames)
+ (set-frame-parameter frame 'desktop--mini
+ (list nil
+ (cl-second (frame-parameter mb-frame 'desktop--mini))
+ nil))))))))
+
+(defun desktop-save-frames ()
+ "Save frame state in `desktop-saved-frame-states'.
+Runs the hook `desktop-before-saving-frames-functions'.
+Frames with a non-nil `desktop-dont-save' parameter are not saved."
+ (setq desktop-saved-frame-states
+ (and desktop-restore-frames
+ (let ((frames (cl-delete-if
+ (lambda (frame)
+ (run-hook-with-args 'desktop-before-saving-frames-functions frame)
+ (frame-parameter frame 'desktop-dont-save))
+ (frame-list))))
+ ;; In case some frame was deleted by a hook function
+ (setq frames (cl-delete-if-not #'frame-live-p frames))
+ (desktop--process-minibuffer-frames frames)
+ (mapcar (lambda (frame)
+ (cons (desktop--filter-frame-parms (frame-parameters frame) t)
+ (window-state-get (frame-root-window frame) t)))
+ frames)))))
+
;;;###autoload
-(defun desktop-save (dirname &optional release)
+(defun desktop-save (dirname &optional release auto-save)
"Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
Optional parameter RELEASE says whether we're done with this desktop.
-See also `desktop-base-file-name'."
+If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
+and don't save the buffer if they are the same."
(interactive "DDirectory to save desktop file in: ")
(setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
(save-excursion (run-hooks 'desktop-save-hook))
(goto-char (point-max))
(insert "\n;; Global section:\n")
+ ;; Called here because we save the window/frame state as a global
+ ;; variable for compatibility with previous Emacsen.
+ (desktop-save-frames)
+ (unless (memq 'desktop-saved-frame-states desktop-globals-to-save)
+ (desktop-outvar 'desktop-saved-frame-states))
(mapc (function desktop-outvar) desktop-globals-to-save)
+ (setq desktop-saved-frame-states nil) ; after saving desktop-globals-to-save
(when (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(insert ")\n\n"))))
(setq default-directory desktop-dirname)
- (let ((coding-system-for-write 'emacs-mule))
- (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
- ;; We remember when it was modified (which is presumably just now).
- (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))
+ ;; If auto-saving, avoid writing if nothing has changed since the last write.
+ ;; Don't check 300 characters of the header that contains the timestamp.
+ (let ((checksum (and auto-save (md5 (current-buffer)
+ (+ (point-min) 300) (point-max)
+ 'emacs-mule))))
+ (unless (and auto-save (equal checksum desktop-file-checksum))
+ (let ((coding-system-for-write 'emacs-mule))
+ (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
+ (setq desktop-file-checksum checksum)
+ ;; We remember when it was modified (which is presumably just now).
+ (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defvar desktop-lazy-timer nil)
;; ----------------------------------------------------------------------------
+(defvar desktop--reuse-list nil
+ "Internal use only.")
+
+(defun desktop--find-frame (predicate display &rest args)
+ "Find a suitable frame in `desktop--reuse-list'.
+Look through frames whose display property matches DISPLAY and
+return the first one for which (PREDICATE frame ARGS) returns t.
+If PREDICATE is nil, it is always satisfied. Internal use only.
+This is an auxiliary function for `desktop--select-frame'."
+ (cl-find-if (lambda (frame)
+ (and (equal (frame-parameter frame 'display) display)
+ (or (null predicate)
+ (apply predicate frame args))))
+ desktop--reuse-list))
+
+(defun desktop--select-frame (display frame-cfg)
+ "Look for an existing frame to reuse.
+DISPLAY is the display where the frame will be shown, and FRAME-CFG
+is the parameter list of the frame being restored. Internal use only."
+ (if (eq desktop-restoring-reuses-frames t)
+ (let ((frame nil)
+ mini)
+ ;; There are no fancy heuristics there. We could implement some
+ ;; based on frame size and/or position, etc., but it is not clear
+ ;; that any "gain" (in the sense of reduced flickering, etc.) is
+ ;; worth the added complexity. In fact, the code below mainly
+ ;; tries to work nicely when M-x desktop-read is used after a desktop
+ ;; session has already been loaded. The other main use case, which
+ ;; is the initial desktop-read upon starting Emacs, should usually
+ ;; only have one, or very few, frame(s) to reuse.
+ (cond ((null display)
+ ;; When the target is tty, every existing frame is reusable.
+ (setq frame (desktop--find-frame nil display)))
+ ((car (setq mini (cdr (assq 'desktop--mini frame-cfg))))
+ ;; If the frame has its own minibuffer, let's see whether
+ ;; that frame has already been loaded (which can happen after
+ ;; M-x desktop-read).
+ (setq frame (desktop--find-frame
+ (lambda (f m)
+ (equal (frame-parameter f 'desktop--mini) m))
+ display mini))
+ ;; If it has not been loaded, and it is not a minibuffer-only frame,
+ ;; let's look for an existing non-minibuffer-only frame to reuse.
+ (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only))
+ (setq frame (desktop--find-frame
+ (lambda (f)
+ (let ((w (frame-parameter f 'minibuffer)))
+ (and (window-live-p w)
+ (window-minibuffer-p w)
+ (eq (window-frame w) f))))
+ display))))
+ (mini
+ ;; For minibufferless frames, check whether they already exist,
+ ;; and that they are linked to the right minibuffer frame.
+ (setq frame (desktop--find-frame
+ (lambda (f n)
+ (pcase-let (((and m `(,hasmini ,num))
+ (frame-parameter f 'desktop--mini)))
+ (and m
+ (null hasmini)
+ (= num n)
+ (equal (cl-second (frame-parameter
+ (window-frame (minibuffer-window f))
+ 'desktop--mini))
+ n))))
+ display (cl-second mini))))
+ (t
+ ;; Default to just finding a frame in the same display.
+ (setq frame (desktop--find-frame nil display))))
+ ;; If found, remove from the list.
+ (when frame
+ (setq desktop--reuse-list (delq frame desktop--reuse-list)))
+ frame)
+ nil))
+
+(defun desktop--make-frame (frame-cfg window-cfg)
+ "Set up a frame according to its saved state.
+That means either creating a new frame or reusing an existing one.
+FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is
+its window state. Internal use only."
+ (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
+ (lines (assq 'tool-bar-lines frame-cfg))
+ (filtered-cfg (desktop--filter-frame-parms frame-cfg nil))
+ (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
+ alt-cfg frame)
+
+ ;; This works around bug#14795 (or feature#14795, if not a bug :-)
+ (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
+ (push '(tool-bar-lines . 0) filtered-cfg)
+
+ (when fullscreen
+ ;; Currently Emacs has the limitation that it does not record the size
+ ;; and position of a frame before maximizing it, so we cannot save &
+ ;; restore that info. Instead, when restoring, we resort to creating
+ ;; invisible "fullscreen" frames of default size and then maximizing them
+ ;; (and making them visible) which at least is somewhat user-friendly
+ ;; when these frames are later de-maximized.
+ (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg))))
+ (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg))))
+ (visible (assq 'visibility filtered-cfg)))
+ (setq filtered-cfg (cl-delete-if (lambda (p)
+ (memq p '(visibility fullscreen width height)))
+ filtered-cfg :key #'car))
+ (when width
+ (setq filtered-cfg (append `((user-size . t) (width . ,width))
+ filtered-cfg)))
+ (when height
+ (setq filtered-cfg (append `((user-size . t) (height . ,height))
+ filtered-cfg)))
+ ;; These are parameters to apply after creating/setting the frame.
+ (push visible alt-cfg)
+ (push (cons 'fullscreen fullscreen) alt-cfg)))
+
+ ;; Time to select or create a frame an apply the big bunch of parameters
+ (if (setq frame (desktop--select-frame display filtered-cfg))
+ (modify-frame-parameters frame
+ (if (eq (frame-parameter frame 'fullscreen) fullscreen)
+ ;; Workaround for bug#14949
+ (assq-delete-all 'fullscreen filtered-cfg)
+ filtered-cfg))
+ (setq frame (make-frame-on-display display filtered-cfg)))
+
+ ;; Let's give the finishing touches (visibility, tool-bar, maximization).
+ (when lines (push lines alt-cfg))
+ (when alt-cfg (modify-frame-parameters frame alt-cfg))
+ ;; Now restore window state.
+ (window-state-put window-cfg (frame-root-window frame) 'safe)
+ frame))
+
+(defun desktop--sort-states (state1 state2)
+ ;; Order: default minibuffer frame
+ ;; other frames with minibuffer, ascending ID
+ ;; minibufferless frames, ascending ID
+ (pcase-let ((`(,_p1 ,hasmini1 ,num1 ,default1) (assq 'desktop--mini (car state1)))
+ (`(,_p2 ,hasmini2 ,num2 ,default2) (assq 'desktop--mini (car state2))))
+ (cond (default1 t)
+ (default2 nil)
+ ((eq hasmini1 hasmini2) (< num1 num2))
+ (t hasmini1))))
+
+(defun desktop-restoring-frames-p ()
+ "True if calling `desktop-restore-frames' will actually restore frames."
+ (and desktop-restore-frames desktop-saved-frame-states t))
+
+(defun desktop-restore-frames ()
+ "Restore window/frame configuration.
+This function depends on the value of `desktop-saved-frame-states'
+being set (usually, by reading it from the desktop)."
+ (when (desktop-restoring-frames-p)
+ (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer
+ (delete-saved (eq desktop-restore-in-current-display 'delete))
+ (forcing (not (desktop-restore-in-original-display-p)))
+ (target (and forcing (cons 'display (frame-parameter nil 'display)))))
+
+ ;; Sorting saved states allows us to easily restore minibuffer-owning frames
+ ;; before minibufferless ones.
+ (setq desktop-saved-frame-states (sort desktop-saved-frame-states
+ #'desktop--sort-states))
+ ;; Potentially all existing frames are reusable. Later we will decide which ones
+ ;; to reuse, and how to deal with any leftover.
+ (setq desktop--reuse-list (frame-list))
+
+ (dolist (state desktop-saved-frame-states)
+ (condition-case err
+ (pcase-let* ((`(,frame-cfg . ,window-cfg) state)
+ ((and d-mini `(,hasmini ,num ,default))
+ (cdr (assq 'desktop--mini frame-cfg)))
+ (frame nil) (to-tty nil))
+ ;; Only set target if forcing displays and the target display is different.
+ (if (or (not forcing)
+ (equal target (or (assq 'display frame-cfg) '(display . nil))))
+ (setq desktop--target-display nil)
+ (setq desktop--target-display target
+ to-tty (null (cdr target))))
+ ;; Time to restore frames and set up their minibuffers as they were.
+ ;; We only skip a frame (thus deleting it) if either:
+ ;; - we're switching displays, and the user chose the option to delete, or
+ ;; - we're switching to tty, and the frame to restore is minibuffer-only.
+ (unless (and desktop--target-display
+ (or delete-saved
+ (and to-tty
+ (eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
+
+ ;; Restore minibuffers. Some of this stuff could be done in a filter
+ ;; function, but it would be messy because restoring minibuffers affects
+ ;; global state; it's best to do it here than add a bunch of global
+ ;; variables to pass info back-and-forth to/from the filter function.
+ (cond
+ ((null d-mini)) ;; No desktop--mini. Process as normal frame.
+ (to-tty) ;; Ignore minibuffer stuff and process as normal frame.
+ (hasmini ;; Frame has minibuffer (or it is minibuffer-only).
+ (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
+ (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0))
+ frame-cfg))))
+ (t ;; Frame depends on other frame's minibuffer window.
+ (let ((mb-frame (cdr (assq num frame-mb-map))))
+ (unless (frame-live-p mb-frame)
+ (error "Minibuffer frame %s not found" num))
+ (let ((mb-param (assq 'minibuffer frame-cfg))
+ (mb-window (minibuffer-window mb-frame)))
+ (unless (and (window-live-p mb-window)
+ (window-minibuffer-p mb-window))
+ (error "Not a minibuffer window %s" mb-window))
+ (if mb-param
+ (setcdr mb-param mb-window)
+ (push (cons 'minibuffer mb-window) frame-cfg))))))
+ ;; OK, we're ready at last to create (or reuse) a frame and
+ ;; restore the window config.
+ (setq frame (desktop--make-frame frame-cfg window-cfg))
+ ;; Set default-minibuffer if required.
+ (when default (setq default-minibuffer-frame frame))
+ ;; Store NUM/frame to assign to minibufferless frames.
+ (when hasmini (push (cons num frame) frame-mb-map))))
+ (error
+ (delay-warning 'desktop (error-message-string err) :error))))
+
+ ;; In case we try to delete the initial frame, we want to make sure that
+ ;; other frames are already visible (discussed in thread for bug#14841).
+ (sit-for 0 t)
+
+ ;; Delete remaining frames, but do not fail if some resist being deleted.
+ (unless (eq desktop-restoring-reuses-frames 'keep)
+ (dolist (frame desktop--reuse-list)
+ (condition-case err
+ (delete-frame frame)
+ (error
+ (delay-warning 'desktop (error-message-string err))))))
+ (setq desktop--reuse-list nil)
+ ;; Make sure there's at least one visible frame, and select it.
+ (unless (or (daemonp)
+ (cl-find-if #'frame-visible-p (frame-list)))
+ (let ((visible (if (frame-live-p default-minibuffer-frame)
+ default-minibuffer-frame
+ (car (frame-list)))))
+ (make-frame-visible visible)
+ (select-frame-set-input-focus visible))))))
+
;;;###autoload
(defun desktop-read (&optional dirname)
"Read and process the desktop file in directory DIRNAME.
(file-error (message "Couldn't record use of desktop file")
(sit-for 1))))
- ;; `desktop-create-buffer' puts buffers at end of the buffer list.
- ;; We want buffers existing prior to evaluating the desktop (and
- ;; not reused) to be placed at the end of the buffer list, so we
- ;; move them here.
- (mapc 'bury-buffer
- (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
- (switch-to-buffer (car (buffer-list)))
+ (unless (desktop-restoring-frames-p)
+ ;; `desktop-create-buffer' puts buffers at end of the buffer list.
+ ;; We want buffers existing prior to evaluating the desktop (and
+ ;; not reused) to be placed at the end of the buffer list, so we
+ ;; move them here.
+ (mapc 'bury-buffer
+ (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
+ (switch-to-buffer (car (buffer-list))))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
+ (desktop-restore-frames)
(run-hooks 'desktop-after-read-hook)
(message "Desktop: %d buffer%s restored%s%s."
desktop-buffer-ok-count
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
- ;; Bury the *Messages* buffer to not reshow it when burying
- ;; the buffer we switched to above.
- (when (buffer-live-p (get-buffer "*Messages*"))
- (bury-buffer "*Messages*"))
- ;; Clear all windows' previous and next buffers, these have
- ;; been corrupted by the `switch-to-buffer' calls in
- ;; `desktop-restore-file-buffer' (bug#11556). This is a
- ;; brute force fix and should be replaced by a more subtle
- ;; strategy eventually.
- (walk-window-tree (lambda (window)
- (set-window-prev-buffers window nil)
- (set-window-next-buffers window nil)))
+ (unless (desktop-restoring-frames-p)
+ ;; Bury the *Messages* buffer to not reshow it when burying
+ ;; the buffer we switched to above.
+ (when (buffer-live-p (get-buffer "*Messages*"))
+ (bury-buffer "*Messages*"))
+ ;; Clear all windows' previous and next buffers, these have
+ ;; been corrupted by the `switch-to-buffer' calls in
+ ;; `desktop-restore-file-buffer' (bug#11556). This is a
+ ;; brute force fix and should be replaced by a more subtle
+ ;; strategy eventually.
+ (walk-window-tree (lambda (window)
+ (set-window-prev-buffers window nil)
+ (set-window-next-buffers window nil))))
t))
;; No desktop file found.
(desktop-clear)
(call-interactively 'desktop-save))
(message "Desktop saved in %s" (abbreviate-file-name desktop-dirname)))
+;; ----------------------------------------------------------------------------
+;; Auto-Saving.
+(defvar desktop-auto-save-timer nil)
+
+(defun desktop-auto-save ()
+ "Save the desktop periodically.
+Called by the timer created in `desktop-auto-save-set-timer'."
+ (when (and desktop-save-mode
+ (integerp desktop-auto-save-timeout)
+ (> desktop-auto-save-timeout 0)
+ ;; Avoid desktop saving during lazy loading.
+ (not desktop-lazy-timer)
+ ;; Save only to own desktop file.
+ (eq (emacs-pid) (desktop-owner))
+ desktop-dirname)
+ (desktop-save desktop-dirname nil t))
+ (desktop-auto-save-set-timer))
+
+(defun desktop-auto-save-set-timer ()
+ "Reset the auto-save timer.
+Cancel any previous timer. When `desktop-auto-save-timeout' is a positive
+integer, start a new timer to call `desktop-auto-save' in that many seconds."
+ (when desktop-auto-save-timer
+ (cancel-timer desktop-auto-save-timer)
+ (setq desktop-auto-save-timer nil))
+ (when (and (integerp desktop-auto-save-timeout)
+ (> desktop-auto-save-timeout 0))
+ (setq desktop-auto-save-timer
+ (run-with-timer desktop-auto-save-timeout nil
+ 'desktop-auto-save))))
+
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-revert ()
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
(when 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))))))))
+ (dolist (this 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))))))))
;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
(setq desktop-save-mode nil)))
(when desktop-save-mode
(desktop-read)
+ (desktop-auto-save-set-timer)
(setq inhibit-startup-screen t))))
+;; So we can restore vc-dir buffers.
+(autoload 'vc-dir-mode "vc-dir" nil t)
+
(provide 'desktop)
;;; desktop.el ends here
HCoop / bpt / emacs.git / blobdiff