Re: A few questions about desktop.el

["Stuart D. Herring" <herring@lanl.gov>]

[-- Attachment #1: Type: text/plain, Size: 2219 bytes --]

Way back in July 2005, this was part of a discussion about improving
desktop.el:

> Not-totally-unrelated: running two or more Emacs instances that use
> the same desktop file is a classical race condition; the last one to
> exit overwrites the desktop file (quite funny when the desktop was
> very elaborate and the last instance to exit uses almost no buffers).
>
> It'd be very useful to try to detect it and at least stop the second
> instance from loading and using the desktop file if it's already in
> use. There's no way to do that from Emacs, is there?

Richard later suggested using the file-locking primitives along with file
timestamps to implement this.  Here's a stab at implementing the collision
detection, but without file locking because I wasn't sure how to mix that
with `load' competently.  (I suspect this matters little since Emacs
sessions are quite unlikely to be actually _accessing_ the desktop file at
the same time.)

Two things are done: first, a desktop file is modified when it is read
(without incident) to include a "in use" tag; further Emacses will
complain about this if they see it, and will leave the desktop file
unloaded unless the user accepts the collision risk.

Second, when a desktop file is read or written, its modification time
(which is typically "now", since with this patch even loading the file
modifies it) is remembered; if it's different when the desktop is to be
saved, appropriate queries are posed.  (In particular, if no desktop file
is loaded, perhaps because the user decided not to re-load a file, any
attempt to save the new desktop over an existing desktop file will be
complained about.)

I'm certainly not proposing this for installation right now; it needs lots
more testing than I've given it (possibly by people who actually use
desktop), and my papers-issues aren't yet resolved.  But I encourage
people (in particular Juanma, who raised the issue) to try it and let me
know if it's any good; if the testing and the papers go okay, it'll just
need a ChangeLog entry to be good.

Enjoy,
Davis

-- 
This product is sold by volume, not by mass.  If it appears too dense or
too sparse, it is because mass-energy conversion has occurred during
shipping.

[-- Attachment #2: desktop-conflict.patch --]
[-- Type: application/octet-stream, Size: 14483 bytes --]

Index: desktop.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/desktop.el,v
retrieving revision 1.99
diff -c -r1.99 desktop.el
*** desktop.el	10 Feb 2006 11:05:30 -0000	1.99
--- desktop.el	27 Apr 2006 23:00:03 -0000
***************
*** 475,480 ****
--- 475,484 ----
  (defvar desktop-dirname nil
    "The directory in which the desktop file should be saved.")
  
+ (defun desktop-full-file-name (&optional dirname)
+   "Return the full name of the current desktop file."
+   (expand-file-name desktop-base-file-name (or dirname desktop-dirname)))
+ 
  (defconst desktop-header
  ";; --------------------------------------------------------------------------
  ;; Desktop File for Emacs
***************
*** 484,489 ****
--- 488,503 ----
  (defvar desktop-delay-hook nil
    "Hooks run after all buffers are loaded; intended for internal use.")
  
+ (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-conflict-text ()
+   "Return a string for inclusion in the desktop file to detect conflicts.
+ The string contains a comment for humans and a `setq' for Emacs."
+   (format "\n;; This desktop file was in use as of %s\n(setq desktop-owner %s)\n"
+ 	  (format-time-string "%x %X %Z") (emacs-pid)))
+ 
  ;; ----------------------------------------------------------------------------
  (defun desktop-truncate (list n)
    "Truncate LIST to at most N elements destructively."
***************
*** 531,537 ****
    (when
      (and
        desktop-save-mode
!       (let ((exists (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))))
          (or
            (eq desktop-save t)
            (and exists (memq desktop-save '(ask-if-new if-exists)))
--- 545,551 ----
    (when
      (and
        desktop-save-mode
!       (let ((exists (file-exists-p (desktop-full-file-name))))
          (or
            (eq desktop-save t)
            (and exists (memq desktop-save '(ask-if-new if-exists)))
***************
*** 547,553 ****
              (call-interactively
                (lambda (dir) (interactive "DDirectory for desktop file: ") dir))))))
      (condition-case err
!       (desktop-save desktop-dirname)
        (file-error
          (unless (yes-or-no-p "Error while saving the desktop.  Ignore? ")
            (signal (car err) (cdr err)))))))
--- 561,567 ----
              (call-interactively
                (lambda (dir) (interactive "DDirectory for desktop file: ") dir))))))
      (condition-case err
!       (desktop-save desktop-dirname t)
        (file-error
          (unless (yes-or-no-p "Error while saving the desktop.  Ignore? ")
            (signal (car err) (cdr err)))))))
***************
*** 715,730 ****
      (t (expand-file-name filename))))
  
  ;; ----------------------------------------------------------------------------
! (defun desktop-save (dirname)
    "Save the desktop in a desktop file.
  Parameter DIRNAME specifies where to save the desktop file.
  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)))
    (save-excursion
!     (let ((filename (expand-file-name desktop-base-file-name dirname))
!           (info
              (mapcar
                #'(lambda (b)
                    (set-buffer b)
--- 729,744 ----
      (t (expand-file-name filename))))
  
  ;; ----------------------------------------------------------------------------
! (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 desktop-dirname (file-name-as-directory (expand-file-name dirname)))
    (save-excursion
!     (let ((info
              (mapcar
                #'(lambda (b)
                    (set-buffer b)
***************
*** 765,808 ****
                (buffer-list)))
            (eager desktop-restore-eager)
            (buf (get-buffer-create "*desktop*")))
!       (set-buffer buf)
!       (erase-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")
!       (mapc (function desktop-outvar) desktop-globals-to-save)
!       (if (memq 'kill-ring desktop-globals-to-save)
!         (insert
!           "(setq kill-ring-yank-pointer (nthcdr "
!           (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
!           " kill-ring))\n"))
! 
!       (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
!       (mapc #'(lambda (l)
!                 (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)
!                   (mapc #'(lambda (e)
!                             (insert "\n  " (desktop-value-to-string e)))
!                         l)
!                   (insert ")\n\n")))
!             info)
!       (setq default-directory dirname)
!       (let ((coding-system-for-write 'emacs-mule))
!         (write-region (point-min) (point-max) filename nil 'nomessage))))
!   (setq desktop-dirname dirname))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-remove ()
--- 779,836 ----
                (buffer-list)))
            (eager desktop-restore-eager)
            (buf (get-buffer-create "*desktop*")))
!       (let ((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")))
! 
! 	  (set-buffer buf)
! 	  (erase-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"
! 	   (if release "" (desktop-conflict-text))
! 	   "\n;; Global section:\n")
! 	  (mapc (function desktop-outvar) desktop-globals-to-save)
! 	  (if (memq 'kill-ring desktop-globals-to-save)
! 	      (insert
! 	       "(setq kill-ring-yank-pointer (nthcdr "
! 	       (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
! 	       " kill-ring))\n"))
! 
! 	  (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
! 	  (mapc #'(lambda (l)
! 		    (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)
! 		      (mapc #'(lambda (e)
! 				(insert "\n  " (desktop-value-to-string e)))
! 			    l)
! 		      (insert ")\n\n")))
! 		info)
! 
! 	  (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)))))))))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-remove ()
***************
*** 810,816 ****
  This function also sets `desktop-dirname' to nil."
    (interactive)
    (when desktop-dirname
!     (let ((filename (expand-file-name desktop-base-file-name desktop-dirname)))
        (setq desktop-dirname nil)
        (when (file-exists-p filename)
          (delete-file filename)))))
--- 838,844 ----
  This function also sets `desktop-dirname' to nil."
    (interactive)
    (when desktop-dirname
!     (let ((filename (desktop-full-file-name)))
        (setq desktop-dirname nil)
        (when (file-exists-p filename)
          (delete-file filename)))))
***************
*** 833,884 ****
    (interactive)
    (unless noninteractive
      (setq desktop-dirname
!       (file-name-as-directory
!         (expand-file-name
!           (or
!             ;; If DIRNAME is specified, use it.
!             (and (< 0 (length dirname)) dirname)
!             ;; Otherwise search desktop file in desktop-path.
!             (let ((dirs desktop-path))
!               (while
!                 (and
!                   dirs
!                   (not
!                     (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
!                 (setq dirs (cdr dirs)))
!               (and dirs (car dirs)))
!             ;; If not found and `desktop-path' is non-nil, use its first element.
!             (and desktop-path (car desktop-path))
!             ;; Default: Home directory.
!             "~"))))
!     (if (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))
!       ;; Desktop file found, process it.
!       (let ((desktop-first-buffer nil)
!             (desktop-buffer-ok-count 0)
!             (desktop-buffer-fail-count 0))
!         (setq desktop-lazy-timer nil)
!         ;; Evaluate desktop buffer.
!         (load (expand-file-name desktop-base-file-name desktop-dirname) 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)
        ;; No desktop file found.
        (desktop-clear)
        (let ((default-directory desktop-dirname))
--- 861,930 ----
    (interactive)
    (unless noninteractive
      (setq desktop-dirname
! 	  (file-name-as-directory
! 	   (expand-file-name
! 	    (or
! 	     ;; If DIRNAME is specified, use it.
! 	     (and (< 0 (length dirname)) dirname)
! 	     ;; Otherwise search desktop file in desktop-path.
! 	     (let ((dirs desktop-path))
! 	       (while
! 		   (and
! 		    dirs
! 		    (not
! 		     (file-exists-p (desktop-full-file-name (car dirs)))))
! 		 (setq dirs (cdr dirs)))
! 	       (and dirs (car dirs)))
! 	     ;; If not found and `desktop-path' is non-nil, use its first element.
! 	     (and desktop-path (car desktop-path))
! 	     ;; 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)
! 	      desktop-owner)
! 	  (setq desktop-lazy-timer nil)
! 	  ;; Evaluate desktop buffer.
! 	  (load (desktop-full-file-name) t t t)
! 	  (if (and desktop-owner
! 		   (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\nUsing it may cause conflicts.  Use it anyway? " desktop-owner))))
! 	      (progn (desktop-clear)
! 		     (setq desktop-dirname nil)
! 		     (message "Desktop file in use; not loaded.")
! 		     nil)
! 	    ;; If it wasn't already, mark it as in-use, to bother other
! 	    ;; desktop instances.
! 	    (unless desktop-owner
! 	      (condition-case nil
! 		  (write-region (desktop-conflict-text) nil
! 				(desktop-full-file-name) t 'nomessage)
! 		(file-error (message "Couldn't mark desktop file as active")
! 			    (sit-for 1))))
! 	    ;; We remember when it was modified (which is presumably just now).
! 	    (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
! 	    ;; `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))

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel