Mercurial > emacs
changeset 81322:71d53e1b86d0
(desktop-save-mode-off): New function.
(desktop-base-lock-name, desktop-not-loaded-hook): New variables.
(desktop-full-lock-name, desktop-file-modtime, desktop-owner,
desktop-claim-lock, desktop-release-lock): New functions.
(desktop-kill): Tell `desktop-save' that this is the last save.
Release the lock afterwards.
(desktop-buffer-info): New function.
(desktop-save): Use it. Run `desktop-save-hook' where the doc says to.
Detect conflicts, and manage the lock.
(desktop-read): Detect conflicts. Manage the lock.
| author | Juanma Barranquero <lekktu@gmail.com> |
|---|---|
| date | Tue, 12 Jun 2007 09:10:05 +0000 |
| parents | efd70d9613c7 |
| children | 9afe4aab01d1 |
| files | lisp/desktop.el |
| diffstat | 1 files changed, 207 insertions(+), 109 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/desktop.el Tue Jun 12 08:16:23 2007 +0000 +++ b/lisp/desktop.el Tue Jun 12 09:10:05 2007 +0000 @@ -162,6 +162,10 @@ (define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1") +(defun desktop-save-mode-off () + "Disable `desktop-save-mode'. Provided for use in hooks." + (desktop-save-mode 0)) + (defcustom desktop-save 'ask-if-new "*Specifies whether the desktop should be saved when it is killed. A desktop is killed when the user changes desktop or quits Emacs. @@ -194,6 +198,13 @@ (define-obsolete-variable-alias 'desktop-basefilename 'desktop-base-file-name "22.1") +(defcustom desktop-base-lock-name + (convert-standard-filename ".emacs.desktop.lock") + "Name of lock file for Emacs desktop, excluding the directory part." + :type 'file + :group 'desktop + :version "23.1") + (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'." @@ -219,6 +230,15 @@ :group 'desktop :version "22.1") +(defcustom desktop-not-loaded-hook nil + "Normal hook run when the user declines to re-use a desktop file. +Run in the directory in which the desktop file was found. +May be used to deal with accidental multiple Emacs jobs." + :type 'hook + :group 'desktop + :options '(desktop-save-mode-off save-buffers-kill-emacs) + :version "23.1") + (defcustom desktop-after-read-hook nil "Normal hook run after a successful `desktop-read'. May be used to show a buffer list." @@ -486,6 +506,11 @@ DIRNAME omitted or nil means use `desktop-dirname'." (expand-file-name desktop-base-file-name (or dirname desktop-dirname))) +(defun desktop-full-lock-name (&optional dirname) + "Return the full name of the desktop lock file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (expand-file-name desktop-base-lock-name (or dirname desktop-dirname))) + (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs @@ -496,6 +521,39 @@ "Hooks run after all buffers are loaded; intended for internal use.") ;; ---------------------------------------------------------------------------- +;; Desktop file conflict detection +(defvar desktop-file-modtime nil + "When the desktop file was last modified to the knowledge of this Emacs. +Used to detect desktop file conflicts.") + +(defun desktop-owner (&optional dirname) + "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)) + owner))) + +(defun desktop-claim-lock (&optional dirname) + "Record this Emacs process as the owner of the desktop file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (write-region (number-to-string (emacs-pid)) nil + (desktop-full-lock-name dirname))) + +(defun desktop-release-lock (&optional dirname) + "Remove the lock file for the desktop in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (let ((file (desktop-full-lock-name dirname))) + (when (file-exists-p file) (delete-file file)))) + +;; ---------------------------------------------------------------------------- (defun desktop-truncate (list n) "Truncate LIST to at most N elements destructively." (let ((here (nthcdr (1- n) list))) @@ -556,10 +614,12 @@ (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))) (condition-case err - (desktop-save desktop-dirname) + (desktop-save desktop-dirname t) (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err))))))) + (signal (car err) (cdr err)))))) + ;; If we own it, we don't anymore. + (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) @@ -574,6 +634,46 @@ value))) ;; ---------------------------------------------------------------------------- +(defun desktop-buffer-info (buffer) + (set-buffer buffer) + (list + ;; basic information + (desktop-file-name (buffer-file-name) dirname) + (buffer-name) + major-mode + ;; minor modes + (let (ret) + (mapc + #'(lambda (minor-mode) + (and (boundp minor-mode) + (symbol-value minor-mode) + (let* ((special (assq minor-mode desktop-minor-mode-table)) + (value (cond (special (cadr special)) + ((functionp minor-mode) minor-mode)))) + (when value (add-to-list 'ret value))))) + (mapcar #'car minor-mode-alist)) + ret) + ;; point and mark, and read-only status + (point) + (list (mark t) mark-active) + buffer-read-only + ;; auxiliary information + (when (functionp desktop-save-buffer) + (funcall desktop-save-buffer 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))) + 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. @@ -724,90 +824,70 @@ ;; ---------------------------------------------------------------------------- ;;;###autoload -(defun desktop-save (dirname) +(defun desktop-save (dirname &optional release) "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'." (interactive "DDirectory to save desktop file in: ") - (run-hooks 'desktop-save-hook) - (setq dirname (file-name-as-directory (expand-file-name dirname))) + (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion - (let ((filename (desktop-full-file-name dirname)) - (info - (mapcar - #'(lambda (b) - (set-buffer b) - (list - (desktop-file-name (buffer-file-name) dirname) - (buffer-name) - major-mode - ;; minor modes - (let (ret) - (mapc - #'(lambda (minor-mode) - (and - (boundp minor-mode) - (symbol-value minor-mode) - (let* ((special (assq minor-mode desktop-minor-mode-table)) - (value (cond (special (cadr special)) - ((functionp minor-mode) minor-mode)))) - (when value (add-to-list 'ret value))))) - (mapcar #'car minor-mode-alist)) - ret) - (point) - (list (mark t) mark-active) - buffer-read-only - ;; Auxiliary information - (when (functionp desktop-save-buffer) - (funcall desktop-save-buffer dirname)) - (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))) - (eager desktop-restore-eager)) - (with-temp-buffer - (insert - ";; -*- mode: emacs-lisp; 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") - (dolist (varspec desktop-globals-to-save) - (desktop-outvar varspec)) - (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")) + (let ((eager desktop-restore-eager) + (new-modtime (nth 5 (file-attributes (desktop-full-file-name))))) + (when + (or (not new-modtime) ; nothing to overwrite + (equal desktop-file-modtime new-modtime) + (yes-or-no-p (if desktop-file-modtime + (if (> (float-time new-modtime) (float-time desktop-file-modtime)) + "Desktop file is more recent than the one loaded. Save anyway? " + "Desktop file isn't the one loaded. Overwrite it? ") + "Current desktop was not loaded from a file. Overwrite this desktop file? ")) + (unless release (error "Desktop file conflict"))) + + ;; If we're done with it, release the lock. + ;; Otherwise, claim it if it's unclaimed or if we created it. + (if release + (desktop-release-lock) + (unless (and new-modtime (desktop-owner)) (desktop-claim-lock))) - (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") - (dolist (l info) - (when (apply 'desktop-save-buffer-p l) - (insert "(" - (if (or (not (integerp eager)) - (unless (zerop eager) - (setq eager (1- eager)) - t)) - "desktop-create-buffer" - "desktop-append-buffer-args") - " " - desktop-file-version) - (dolist (e l) - (insert "\n " (desktop-value-to-string e))) - (insert ")\n\n"))) - (setq default-directory dirname) - (let ((coding-system-for-write 'emacs-mule)) - (write-region (point-min) (point-max) filename nil 'nomessage))))) - (setq desktop-dirname dirname)) + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" + desktop-header + ";; Created " (current-time-string) "\n" + ";; Desktop file format version " desktop-file-version "\n" + ";; Emacs version " emacs-version "\n") + (save-excursion (run-hooks 'desktop-save-hook)) + (goto-char (point-max)) + (insert "\n;; Global section:\n") + (mapc (function desktop-outvar) desktop-globals-to-save) + (when (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 "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") + (dolist (l (mapcar 'desktop-buffer-info (buffer-list))) + (when (apply 'desktop-save-buffer-p l) + (insert "(" + (if (or (not (integerp eager)) + (if (zerop eager) + nil + (setq eager (1- eager)))) + "desktop-create-buffer" + "desktop-append-buffer-args") + " " + desktop-file-version) + (dolist (e l) + (insert "\n " (desktop-value-to-string e))) + (insert ")\n\n"))) + + (setq default-directory 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))))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -856,35 +936,53 @@ ;; Default: Home directory. "~")))) (if (file-exists-p (desktop-full-file-name)) - ;; Desktop file found, process it. - (let ((desktop-first-buffer nil) - (desktop-buffer-ok-count 0) - (desktop-buffer-fail-count 0) - ;; Avoid desktop saving during evaluation of desktop buffer. - (desktop-save nil)) - (desktop-lazy-abort) - ;; Evaluate desktop buffer. - (load (desktop-full-file-name) t t t) - ;; `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) - (run-hooks 'desktop-after-read-hook) - (message "Desktop: %d buffer%s restored%s%s." - desktop-buffer-ok-count - (if (= 1 desktop-buffer-ok-count) "" "s") - (if (< 0 desktop-buffer-fail-count) - (format ", %d failed to restore" desktop-buffer-fail-count) - "") - (if desktop-buffer-args-list - (format ", %d to restore lazily" - (length desktop-buffer-args-list)) - "")) - t) + ;; Desktop file found, but is it already in use? + (let ((desktop-first-buffer nil) + (desktop-buffer-ok-count 0) + (desktop-buffer-fail-count 0) + (owner (desktop-owner)) + ;; Avoid desktop saving during evaluation of desktop buffer. + (desktop-save nil)) + (if (and owner + (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ +Using it may cause conflicts. Use it anyway? " owner)))) + (progn (setq desktop-dirname nil) + (let ((default-directory desktop-dirname)) + (run-hooks 'desktop-not-loaded-hook)) + (message "Desktop file in use; not loaded.")) + (desktop-lazy-abort) + ;; Evaluate desktop buffer and remember when it was modified. + (load (desktop-full-file-name) t t t) + (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 + (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))) + (run-hooks 'desktop-delay-hook) + (setq desktop-delay-hook nil) + (run-hooks 'desktop-after-read-hook) + (message "Desktop: %d buffer%s restored%s%s." + desktop-buffer-ok-count + (if (= 1 desktop-buffer-ok-count) "" "s") + (if (< 0 desktop-buffer-fail-count) + (format ", %d failed to restore" desktop-buffer-fail-count) + "") + (if desktop-buffer-args-list + (format ", %d to restore lazily" + (length desktop-buffer-args-list)) + "")) + t)) ;; No desktop file found. (desktop-clear) (let ((default-directory desktop-dirname))