X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/728dc3cc6093d56809c4159bb8022dbd1eb57d8a..c7510f6e94a232aae19e07b7203ac068ef00773c:/lisp/desktop.el diff --git a/lisp/desktop.el b/lisp/desktop.el index 8d84356fb2..5e43c03ade 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1,7 +1,6 @@ -;;; desktop.el --- save partial status of Emacs when killed +;;; desktop.el --- save partial status of Emacs when killed -*- lexical-binding: t -*- -;; Copyright (C) 1993-1995, 1997, 2000-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-1995, 1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Keywords: convenience @@ -124,7 +123,7 @@ ;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. ;; kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt. ;; treese@lcs.mit.edu (Win Treese) for ange-ftp tips. -;; pot@cnuce.cnr.it (Francesco Potorti`) for misc. tips. +;; pot@cnuce.cnr.it (Francesco Potortì) for misc. tips. ;; --------------------------------------------------------------------------- ;; TODO: ;; @@ -133,6 +132,9 @@ ;;; Code: +(require 'cl-lib) +(require 'frameset) + (defvar desktop-file-version "206" "Version number of desktop file format. Written into the desktop file and used at desktop read to provide @@ -151,15 +153,29 @@ backward compatibility.") ;;;###autoload (define-minor-mode desktop-save-mode "Toggle desktop saving (Desktop Save mode). -With a prefix argument ARG, enable Desktop Save mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +With a prefix argument ARG, enable Desktop Save mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode if ARG +is omitted or nil. + +When Desktop Save mode is enabled, the state of Emacs is saved from +one session to another. In particular, Emacs will save the desktop when +it exits (this may prompt you; see the option `desktop-save'). The next +time Emacs starts, if this mode is active it will restore the desktop. + +To manually save the desktop at any time, use the command `M-x desktop-save'. +To load it, use `M-x desktop-read'. + +Once a desktop file exists, Emacs will auto-save it according to the +option `desktop-auto-save-timeout'. + +To see all the options you can set, browse the `desktop' customization group. -If Desktop Save mode is enabled, the state of Emacs is saved from -one session to another. See variable `desktop-save' and function -`desktop-read' for details." +For further details, see info node `(emacs)Saving Emacs Sessions'." :global t - :group 'desktop) + :group 'desktop + (if desktop-save-mode + (desktop-auto-save-set-timer) + (desktop-auto-save-cancel-timer))) (defun desktop-save-mode-off () "Disable `desktop-save-mode'. Provided for use in hooks." @@ -189,9 +205,10 @@ determine where the desktop is saved." :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." +(defcustom desktop-auto-save-timeout auto-save-timeout + "Number of seconds idle time before auto-save of the desktop. +This applies to an existing desktop file when `desktop-save-mode' is enabled. +Zero or nil means disable auto-saving due to idleness." :type '(choice (const :tag "Off" nil) (integer :tag "Seconds")) :set (lambda (symbol value) @@ -347,11 +364,11 @@ modes are restored automatically; they should not be listed here." :type '(repeat symbol) :group 'desktop) -(defcustom desktop-buffers-not-to-save nil +(defcustom desktop-buffers-not-to-save "\\` " "Regexp identifying buffers that are to be excluded from saving." :type '(choice (const :tag "None" nil) regexp) - :version "23.2" ; set to nil + :version "24.4" ; skip invisible temporary buffers :group 'desktop) ;; Skip tramp and ange-ftp files @@ -370,28 +387,45 @@ modes are restored automatically; they should not be listed here." :group 'desktop) (defcustom desktop-restore-frames t - "When non-nil, save window/frame configuration to desktop file." + "When non-nil, save and restore the frame and window configuration. +See related options `desktop-restore-reuses-frames', +`desktop-restore-in-current-display', and `desktop-restore-forces-onscreen'." :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." + "Controls how restoring of frames treats displays. +If t, restores frames into the current display. +If nil, restores frames into their original displays (if possible). +If `delete', deletes frames on other displays instead of restoring them." :type '(choice (const :tag "Restore in current display" t) (const :tag "Restore in original display" nil) - (const :tag "Delete frames in other displays" 'delete)) + (const :tag "Delete frames in other displays" delete)) :group 'desktop :version "24.4") -(defcustom desktop-restoring-reuses-frames t +(defcustom desktop-restore-forces-onscreen t + "If t, restores frames that are fully offscreen onscreen instead. +If `all', also restores frames that are partially offscreen onscreen. + +Note that checking of frame boundaries is only approximate. +It can fail to reliably detect frames whose onscreen/offscreen state +depends on a few pixels, especially near the right / bottom borders +of the screen." + :type '(choice (const :tag "Only fully offscreen frames" t) + (const :tag "Also partially offscreen frames" all) + (const :tag "Do not force frames onscreen" nil)) + :group 'desktop + :version "24.4") + +(defcustom desktop-restore-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." +If nil, deletes existing frames. +If `keep', keeps existing frames and does not reuse them." :type '(choice (const :tag "Reuse existing frames" t) (const :tag "Delete existing frames" nil) - (const :tag "Keep existing frames" 'keep)) + (const :tag "Keep existing frames" :keep)) :group 'desktop :version "24.4") @@ -462,13 +496,13 @@ Handlers are called with argument list Furthermore, they may use the following variables: - desktop-file-version - desktop-buffer-major-mode - desktop-buffer-minor-modes - desktop-buffer-point - desktop-buffer-mark - desktop-buffer-read-only - desktop-buffer-locals + `desktop-file-version' + `desktop-buffer-major-mode' + `desktop-buffer-minor-modes' + `desktop-buffer-point' + `desktop-buffer-mark' + `desktop-buffer-read-only' + `desktop-buffer-locals' If a handler returns a buffer, then the saved mode settings and variable values for that buffer are copied into it. @@ -522,15 +556,15 @@ Handlers are called with argument list Furthermore, they may use the 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-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' When a handler is called, the buffer has been created and the major mode has been set, but local variables listed in desktop-buffer-locals has not yet been @@ -578,8 +612,9 @@ DIRNAME omitted or nil means use `desktop-dirname'." "Checksum of the last auto-saved contents of the desktop file. Used to avoid writing contents unchanged between auto-saves.") -(defvar desktop--saved-states nil - "Saved window/frame state. Internal use only.") +(defvar desktop-saved-frameset nil + "Saved state of all frames. +Only valid during frame saving & restoring; intended for internal use.") ;; ---------------------------------------------------------------------------- ;; Desktop file conflict detection @@ -627,30 +662,42 @@ DIRNAME omitted or nil means use `desktop-dirname'." "Empty the Desktop. This kills all buffers except for internal ones and those with names matched by a regular expression in the list `desktop-clear-preserve-buffers'. -Furthermore, it clears the variables listed in `desktop-globals-to-clear'." +Furthermore, it clears the variables listed in `desktop-globals-to-clear'. +When called interactively and `desktop-restore-frames' is non-nil, it also +deletes all frames except the selected one (and its minibuffer frame, +if different)." (interactive) (desktop-lazy-abort) (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)) - (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-p 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)))) - (delete-other-windows)) + (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) + (when (and desktop-restore-frames + ;; Non-interactive calls to desktop-clear happen before desktop-read + ;; which already takes care of frame restoration and deletion. + (called-interactively-p 'any)) + (let* ((this (selected-frame)) + (mini (window-frame (minibuffer-window this)))) ; in case they differ + (dolist (frame (sort (frame-list) #'frameset-minibufferless-first-p)) + (condition-case err + (unless (or (eq frame this) + (eq frame mini) + (frame-parameter frame 'desktop-dont-clear)) + (delete-frame frame)) + (error + (delay-warning 'desktop (error-message-string err)))))))) ;; ---------------------------------------------------------------------------- (unless noninteractive @@ -686,15 +733,7 @@ is nil, ask the user where to save the desktop." ;; ---------------------------------------------------------------------------- (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) @@ -726,16 +765,14 @@ is nil, ask the user where to save the desktop." (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))) ;; ---------------------------------------------------------------------------- @@ -846,23 +883,25 @@ FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode. \n\(fn FILENAME BUFNAME MODE)" (let ((case-fold-search nil) - dired-skip) - (and (not (and (stringp desktop-buffers-not-to-save) - (not filename) - (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-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-p desktop-files-not-to-save - default-directory))))) - (and (null filename) - (null dired-skip) ; bug#5755 - (with-current-buffer bufname desktop-save-buffer)))))) + (no-regexp-to-check (not (stringp desktop-files-not-to-save))) + dired-skip) + (and (or filename + (not (stringp desktop-buffers-not-to-save)) + (not (string-match-p desktop-buffers-not-to-save bufname))) + (not (memq mode desktop-modes-not-to-save)) + (or (and filename + (or no-regexp-to-check + (not (string-match-p desktop-files-not-to-save filename)))) + (and (memq mode '(dired-mode vc-dir-mode)) + (or no-regexp-to-check + (not (setq dired-skip + (with-current-buffer bufname + (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))) + t))) ;; ---------------------------------------------------------------------------- (defun desktop-file-name (filename dirname) @@ -882,215 +921,20 @@ DIRNAME must be the directory in which the desktop file will be saved." ;; ---------------------------------------------------------------------------- -(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)) - 8)) ;; (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--save-minibuffer-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 - ;; FIXME: What happens with multi-terminal sessions? - (let ((frames (frame-list)) - (count 0)) - ;; Reset desktop-mini for all frames - (dolist (frame frames) - (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 - (setq count (1+ 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))) - (this (cadr (frame-parameter mb-frame 'desktop-mini)))) - (set-frame-parameter frame 'desktop-mini (list nil this nil))))))) - -(defun desktop--save-frames () - "Save window/frame state, as a global variable. -Intended to be called from `desktop-save'. -Internal use only." - (setq desktop--saved-states +(defun desktop--check-dont-save (frame) + (not (frame-parameter frame 'desktop-dont-save))) + +(defconst desktop--app-id `(desktop . ,desktop-file-version)) + +(defun desktop-save-frameset () + "Save the state of existing frames in `desktop-saved-frameset'. +Frames with a non-nil `desktop-dont-save' parameter are not saved." + (setq desktop-saved-frameset (and desktop-restore-frames - (progn - (desktop--save-minibuffer-frames) - (mapcar (lambda (frame) - (cons (desktop--filter-frame-parms (frame-parameters frame) t) - (window-state-get (frame-root-window frame) t))) - (frame-list))))) - (unless (memq 'desktop--saved-states desktop-globals-to-save) - (desktop-outvar 'desktop--saved-states))) + (frameset-save nil + :app desktop--app-id + :name (concat user-login-name "@" system-name) + :predicate #'desktop--check-dont-save)))) ;;;###autoload (defun desktop-save (dirname &optional release auto-save) @@ -1099,7 +943,13 @@ Parameter DIRNAME specifies where to save the desktop file. Optional parameter RELEASE says whether we're done with this desktop. 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: ") + (interactive (list + ;; Or should we just use (car desktop-path)? + (let ((default (if (member "." desktop-path) + default-directory + user-emacs-directory))) + (read-directory-name "Directory to save desktop file in: " + default default t)))) (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion (let ((eager desktop-restore-eager) @@ -1132,8 +982,11 @@ and don't save the buffer if they are the same." (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) + (desktop-save-frameset) + (unless (memq 'desktop-saved-frameset desktop-globals-to-save) + (desktop-outvar 'desktop-saved-frameset)) (mapc (function desktop-outvar) desktop-globals-to-save) + (setq desktop-saved-frameset nil) ; after saving desktop-globals-to-save (when (memq 'kill-ring desktop-globals-to-save) (insert "(setq kill-ring-yank-pointer (nthcdr " @@ -1161,12 +1014,21 @@ and don't save the buffer if they are the same." (insert ")\n\n")))) (setq default-directory desktop-dirname) - ;; 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)) + ;; When auto-saving, avoid writing if nothing has changed since the last write. + (let* ((beg (and auto-save + (save-excursion + (goto-char (point-min)) + ;; Don't check the header with changing timestamp + (and (search-forward "Global section" nil t) + ;; Also skip the timestamp in desktop-saved-frameset + ;; if it's saved in the first non-header line + (search-forward "desktop-saved-frameset" + (line-beginning-position 3) t) + ;; This is saved after the timestamp + (search-forward (format "%S" desktop--app-id) nil t)) + (point)))) + (checksum (and beg (md5 (current-buffer) beg (point-max) 'emacs-mule)))) + (unless (and checksum (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) @@ -1191,221 +1053,28 @@ This function also sets `desktop-dirname' to nil." (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'." - (catch :found - (dolist (frame desktop--reuse-list) - (when (and (equal (frame-parameter frame 'display) display) - (or (null predicate) - (apply predicate frame args))) - (throw :found frame))) - nil)) - -(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 (;; When the target is tty, every existing frame is reusable. - (null display) - (setq frame (desktop--find-frame nil display))) - (;; 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). - (car (setq mini (cdr (assq 'desktop-mini frame-cfg)))) - (setq frame (or (desktop--find-frame - (lambda (f m) - (equal (frame-parameter f 'desktop-mini) m)) - display mini)))) - (;; For minibufferless frames, check whether they already exist, - ;; and that they are linked to the right minibuffer frame. - mini - (setq frame (desktop--find-frame - (lambda (f n) - (let ((m (frame-parameter f 'desktop-mini))) - (and m - (null (car m)) - (= (cadr m) n) - (equal (cadr (frame-parameter - (window-frame (minibuffer-window f)) - 'desktop-mini)) - n)))) - display (cadr mini)))) - (;; Default to just finding a frame in the same display. - t - (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))) - (dolist (parameter '(visibility fullscreen width height)) - (setq filtered-cfg (assq-delete-all parameter filtered-cfg))) - (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 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 - (let ((dm1 (cdr (assq 'desktop-mini (car state1)))) - (dm2 (cdr (assq 'desktop-mini (car state2))))) - (cond ((nth 2 dm1) t) - ((nth 2 dm2) nil) - ((null (car dm2)) t) - ((null (car dm1)) nil) - (t (< (cadr dm1) (cadr dm2)))))) - -(defun desktop--restore-frames () - "Restore window/frame configuration. -Internal use only." - (when (and desktop-restore-frames desktop--saved-states) - (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer - (visible nil) - (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-states (sort desktop--saved-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-states) - (condition-case err - (let* ((frame-cfg (car state)) - (window-cfg (cdr state)) - (d-mini (cdr (assq 'desktop-mini frame-cfg))) - num frame to-tty) - ;; 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. - ((car d-mini) ;; Frame has its own minibuffer (or it is minibuffer-only). - (setq num (cadr d-mini)) - (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 minibufer window. - (let ((mb-frame (cdr (assq (cadr d-mini) frame-mb-map)))) - (unless (frame-live-p mb-frame) - (error "Minibuffer frame %s not found" (cadr d-mini))) - (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 (nth 2 d-mini) (setq default-minibuffer-frame frame)) - ;; Store frame/NUM to assign to minibufferless frames. - (when num (push (cons num frame) frame-mb-map)) - ;; Try to locate at least one visible frame. - (when (and (not visible) (frame-visible-p frame)) - (setq visible frame)))) - (error - (delay-warning 'desktop (error-message-string err) :error)))) - - ;; Delete remaining frames, but do not fail if some resist being deleted. - (unless (eq desktop-restoring-reuses-frames 'keep) - (dolist (frame desktop--reuse-list) - (ignore-errors (delete-frame frame)))) - (setq desktop--reuse-list nil) - ;; Make sure there's at least one visible frame, and select it. - (unless (or visible (daemonp)) - (setq visible (if (frame-live-p default-minibuffer-frame) - default-minibuffer-frame - (car (frame-list)))) - (make-frame-visible visible) - (select-frame-set-input-focus visible))))) +(defun desktop-restoring-frameset-p () + "True if calling `desktop-restore-frameset' will actually restore it." + (and desktop-restore-frames desktop-saved-frameset t)) + +(defun desktop-restore-frameset () + "Restore the state of a set of frames. +This function depends on the value of `desktop-saved-frameset' +being set (usually, by reading it from the desktop)." + (when (desktop-restoring-frameset-p) + (frameset-restore desktop-saved-frameset + :reuse-frames (eq desktop-restore-reuses-frames t) + :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep)) + :force-display desktop-restore-in-current-display + :force-onscreen desktop-restore-forces-onscreen))) +;; Just to silence the byte compiler. +;; Dynamically bound in `desktop-read'. +(defvar desktop-first-buffer) +(defvar desktop-buffer-ok-count) +(defvar desktop-buffer-fail-count) + +;; FIXME Interactively, this should have the option to prompt for dirname. ;;;###autoload (defun desktop-read (&optional dirname) "Read and process the desktop file in directory DIRNAME. @@ -1459,24 +1128,30 @@ Using it may cause conflicts. Use it anyway? " owner))))) (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) ;; If it wasn't already, mark it as in-use, to bother other ;; desktop instances. - (unless owner + (unless (eq (emacs-pid) owner) (condition-case nil (desktop-claim-lock) (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-frameset-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) + (desktop-restore-frameset) (run-hooks 'desktop-after-read-hook) - (message "Desktop: %d buffer%s restored%s%s." + (message "Desktop: %s%d buffer%s restored%s%s." + (if desktop-saved-frameset + (let ((fn (length (frameset-states desktop-saved-frameset)))) + (format "%d frame%s, " + fn (if (= fn 1) "" "s"))) + "") desktop-buffer-ok-count (if (= 1 desktop-buffer-ok-count) "" "s") (if (< 0 desktop-buffer-fail-count) @@ -1486,18 +1161,20 @@ Using it may cause conflicts. Use it anyway? " owner))))) (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-frameset-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)))) + (setq desktop-saved-frameset nil) t)) ;; No desktop file found. (desktop-clear) @@ -1555,21 +1232,24 @@ Called by the timer created in `desktop-auto-save-set-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)) + (desktop-save desktop-dirname nil t))) (defun desktop-auto-save-set-timer () - "Reset the auto-save timer. + "Set 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)) +integer, start a new idle timer to call `desktop-auto-save' repeatedly +after that many seconds of idle time." + (desktop-auto-save-cancel-timer) (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)))) + (run-with-idle-timer desktop-auto-save-timeout t + 'desktop-auto-save)))) + +(defun desktop-auto-save-cancel-timer () + (when desktop-auto-save-timer + (cancel-timer desktop-auto-save-timer) + (setq desktop-auto-save-timer nil))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -1623,14 +1303,6 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds." ;; Create a buffer, load its file, set its mode, ...; ;; called from Desktop file only. -;; Just to silence the byte compiler. - -(defvar desktop-first-buffer) ; Dynamically bound in `desktop-read' - -;; Bound locally in `desktop-read'. -(defvar desktop-buffer-ok-count) -(defvar desktop-buffer-fail-count) - (defun desktop-create-buffer (file-version buffer-filename @@ -1714,24 +1386,23 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds." (eval desktop-buffer-point) (error (message "%s" (error-message-string err)) 1)))) (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))) + (if (consp desktop-buffer-mark) + (progn + (move-marker (mark-marker) (car desktop-buffer-mark)) + ;; FIXME: Should we call (de)activate-mark instead? + (setq mark-active (car (cdr desktop-buffer-mark)))) + (move-marker (mark-marker) 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. @@ -1821,10 +1492,9 @@ If there are no buffers left to create, kill the timer." (let ((key "--no-desktop")) (when (member key command-line-args) (setq command-line-args (delete key command-line-args)) - (setq desktop-save-mode nil))) + (desktop-save-mode 0))) (when desktop-save-mode (desktop-read) - (desktop-auto-save-set-timer) (setq inhibit-startup-screen t)))) ;; So we can restore vc-dir buffers. @@ -1833,3 +1503,7 @@ If there are no buffers left to create, kill the timer." (provide 'desktop) ;;; desktop.el ends here + +;; Local Variables: +;; coding: utf-8 +;; End: