Re: A few questions about desktop.el

["Davis Herring" <herring@lanl.gov>]

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

> What happened to this patch to add sort-of-file-locking to desktop.el?

As far as I know, nothing has been done with it.  I still have it in my
working copy (of course), and have, prompted by your message, just now
resolved a daunting 57/76-line conflict with the changes between 1.106 and
1.108.  My version has one of the tainted `mapc' calls, if that matters;
given Stefan's trivial (dolist (x l) (f x)) I would surely have supplied
(mapc f l) myself.  (No offense meant to Stefan; that one alone was
trivial.)

Links to the original (er, the second) discussion:
April, largely superceded:
http://lists.gnu.org/archive/html/emacs-devel/2006-04/msg01253.html
May: http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg00084.html

I've attached an updated patch vs. current CVS; in it I have
optimistically tagged my two new defcustoms as new in 22.2.  Here's a stab
at a ChangeLog:

2007-06-08  Davis Herring  <herring@lanl.gov>

	* desktop.el (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.

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-4.patch --]
[-- Type: application/octet-stream, Size: 18053 bytes --]

Index: desktop.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/desktop.el,v
retrieving revision 1.108
diff -c -r1.108 desktop.el
*** desktop.el	11 Apr 2007 02:28:26 -0000	1.108
--- desktop.el	8 Jun 2007 20:58:14 -0000
***************
*** 162,167 ****
--- 162,171 ----
  (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,199 ****
--- 198,210 ----
  (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 "22.2")
+ 
  (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,224 ****
--- 230,244 ----
    :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 "22.2")
+ 
  (defcustom desktop-after-read-hook nil
    "Normal hook run after a successful `desktop-read'.
  May be used to show a buffer list."
***************
*** 486,491 ****
--- 506,516 ----
  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,501 ****
--- 521,559 ----
    "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,565 ****
                 (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)))))))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-list* (&rest args)
--- 614,625 ----
                 (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))))))
!   ;; If we own it, we don't anymore.
!   (if (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-list* (&rest args)
***************
*** 574,579 ****
--- 634,675 ----
        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,813 ****
  
  ;; ----------------------------------------------------------------------------
  ;;;###autoload
! (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 (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"))
! 
!         (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))
  
  ;; ----------------------------------------------------------------------------
  ;;;###autoload
--- 820,888 ----
  
  ;; ----------------------------------------------------------------------------
  ;;;###autoload
! (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: ")
!   (setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
    (save-excursion
!     (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")
! 	  (save-excursion (run-hooks 'desktop-save-hook))
! 	  (goto-char (point-max))
! 	  (insert "\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")
! 	  (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))
! 			  "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,890 ****
               ;; 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)
        ;; No desktop file found.
        (desktop-clear)
        (let ((default-directory desktop-dirname))
--- 931,981 ----
               ;; Default: Home directory.
               "~"))))
      (if (file-exists-p (desktop-full-file-name))
! 	;; 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.\nUsing 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))

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

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