[Emacs-diffs] Changes to emacs/lisp/desktop.el,v

[Juanma Barranquero]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Juanma Barranquero <lektu>      07/06/12 09:10:05

Index: desktop.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/desktop.el,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -b -r1.109 -r1.110
--- desktop.el  9 Jun 2007 00:09:03 -0000       1.109
+++ desktop.el  12 Jun 2007 09:10:05 -0000      1.110
@@ -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,79 +824,57 @@
 
 ;; ----------------------------------------------------------------------------
 ;;;###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))
+    (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)))
+
       (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)
+          ";; 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 info)
+         (dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
           (when (apply 'desktop-save-buffer-p l)
             (insert "("
                     (if (or (not (integerp eager))
-                            (unless (zerop eager)
-                              (setq eager (1- eager))
-                              t))
+                             (if (zerop eager)
+                                 nil
+                               (setq eager (1- eager))))
                         "desktop-create-buffer"
                       "desktop-append-buffer-args")
                     " "
@@ -804,10 +882,12 @@
             (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))
+           (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,18 +936,36 @@
              ;; Default: Home directory.
              "~"))))
     (if (file-exists-p (desktop-full-file-name))
-      ;; Desktop file found, process it.
+       ;; 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.
+           ;; 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.
+           ;; 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)))
@@ -884,7 +982,7 @@
                      (format ", %d to restore lazily"
                              (length desktop-buffer-args-list))
                    ""))
-        t)
+           t))
       ;; No desktop file found.
       (desktop-clear)
       (let ((default-directory desktop-dirname))