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	2 May 2006 17:56:29 -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.
***************
*** 176,187 ****
  The variables `desktop-dirname' and `desktop-base-file-name'
  determine where the desktop is saved."
    :type '(choice
!     (const :tag "Always save" t)
!     (const :tag "Always ask" ask)
!     (const :tag "Ask if desktop file is new, else do save" ask-if-new)
!     (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
!     (const :tag "Save if desktop file exists, else don't" if-exists)
!     (const :tag "Never save" nil))
    :group 'desktop
    :version "22.1")
  
--- 180,191 ----
  The variables `desktop-dirname' and `desktop-base-file-name'
  determine where the desktop is saved."
    :type '(choice
! 	  (const :tag "Always save" t)
! 	  (const :tag "Always ask" ask)
! 	  (const :tag "Ask if desktop file is new, else do save" ask-if-new)
! 	  (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
! 	  (const :tag "Save if desktop file exists, else don't" if-exists)
! 	  (const :tag "Never save" nil))
    :group 'desktop
    :version "22.1")
  
***************
*** 193,198 ****
--- 197,209 ----
  (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.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'."
***************
*** 212,232 ****
  
  (defcustom desktop-no-desktop-file-hook nil
    "Normal hook run when `desktop-read' can't find a desktop file.
  May be used to show a dired buffer."
    :type 'hook
    :group 'desktop
    :version "22.1")
  
  (defcustom desktop-after-read-hook nil
    "Normal hook run after a successful `desktop-read'.
  May be used to show a buffer list."
    :type 'hook
    :group 'desktop
    :version "22.1")
  
  (defcustom desktop-save-hook nil
    "Normal hook run before the desktop is saved in a desktop file.
! This is useful for truncating history lists, for example."
    :type 'hook
    :group 'desktop)
  
--- 223,256 ----
  
  (defcustom desktop-no-desktop-file-hook nil
    "Normal hook run when `desktop-read' can't find a desktop file.
+ Run in the directory in which the desktop file was sought.
  May be used to show a dired buffer."
    :type 'hook
    :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.1")
+ 
  (defcustom desktop-after-read-hook nil
    "Normal hook run after a successful `desktop-read'.
  May be used to show a buffer list."
    :type 'hook
    :group 'desktop
+   :options '(list-buffers)
    :version "22.1")
  
  (defcustom desktop-save-hook nil
    "Normal hook run before the desktop is saved in a desktop file.
! Run with the desktop buffer current with only the header present.
! May be used to add to the desktop code or to truncate history lists,
! for example."
    :type 'hook
    :group 'desktop)
  
***************
*** 282,287 ****
--- 306,312 ----
      size-indication-mode
      buffer-file-coding-system
      indent-tabs-mode
+     tab-width
      indicate-buffer-boundaries
      indicate-empty-lines
      show-trailing-whitespace)
***************
*** 475,480 ****
--- 500,515 ----
  (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 desktop file in DIRNAME.
+ 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
***************
*** 485,490 ****
--- 520,558 ----
    "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)))
***************
*** 529,556 ****
  If the desktop should be saved and `desktop-dirname'
  is nil, ask the user where to save the desktop."
    (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)))
!           (and
!             (or
!               (memq desktop-save '(ask ask-if-new))
!               (and exists (eq desktop-save 'ask-if-exists)))
!             (y-or-n-p "Save desktop? ")))))
      (unless desktop-dirname
        (setq desktop-dirname
!         (file-name-as-directory
!           (expand-file-name
!             (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)))))))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-list* (&rest args)
--- 597,626 ----
  If the desktop should be saved and `desktop-dirname'
  is nil, ask the user where to save the desktop."
    (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)))
! 	  (and
! 	   (or
! 	    (memq desktop-save '(ask ask-if-new))
! 	    (and exists (eq desktop-save 'ask-if-exists)))
! 	   (y-or-n-p "Save desktop? ")))))
      (unless desktop-dirname
        (setq desktop-dirname
! 	    (file-name-as-directory
! 	     (expand-file-name
! 	      (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))))))
!   ;; If we own it, we don't anymore.
!   (if (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
  
  ;; ----------------------------------------------------------------------------
  (defun desktop-list* (&rest args)
***************
*** 565,570 ****
--- 635,676 ----
        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.
***************
*** 715,808 ****
      (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)
!                   (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)
!           (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 ()
--- 821,891 ----
      (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: ")
!   (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\n")
! 	  (save-excursion (run-hooks 'desktop-save-hook))
! 	  (goto-char (point-max))
! 	  (insert ";; 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")))
! 		(mapcar 'desktop-buffer-info (buffer-list)))
! 
! 	  (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)))))
--- 893,899 ----
  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))
--- 916,983 ----
    (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, but is it already in use?
! 	(let ((desktop-first-buffer nil)
! 	      (desktop-buffer-ok-count 0)
! 	      (desktop-buffer-fail-count 0)
! 	      (owner (desktop-owner)))
! 	  (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."))
! 	    (setq desktop-lazy-timer nil)
! 	    ;; 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))
