aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuanma Barranquero2007-06-24 20:03:06 +0000
committerJuanma Barranquero2007-06-24 20:03:06 +0000
commit3ae6b03fe61fa3a458a3bd334b367db98f0f9f7b (patch)
treeb8a71584330f429b7cb329228ff05b124ba46238
parent6ede9eeac138cd1d48f55a7e7fdeaeacb69bee9d (diff)
downloademacs-3ae6b03fe61fa3a458a3bd334b367db98f0f9f7b.tar.gz
emacs-3ae6b03fe61fa3a458a3bd334b367db98f0f9f7b.zip
(desktop-read): Run `desktop-not-loaded-hook' in the directory where the desktop
file was found, as the docstring says. (desktop-kill): Use `read-directory-name'. (desktop-load-locked-desktop): New option. (desktop-read): Use it. (desktop-truncate, desktop-outvar, desktop-restore-file-buffer): Use `when'. (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.
-rw-r--r--lisp/ChangeLog24
-rw-r--r--lisp/desktop.el570
2 files changed, 366 insertions, 228 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fbf0ba84d7d..dedce43365f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,27 @@
12007-06-24 Juanma Barranquero <lekktu@gmail.com>
2
3 * desktop.el (desktop-read): Run `desktop-not-loaded-hook' in the
4 directory where the desktop file was found, as the docstring says.
5 (desktop-kill): Use `read-directory-name'.
6
7 * desktop.el (desktop-load-locked-desktop): New option.
8 (desktop-read): Use it.
9 (desktop-truncate, desktop-outvar, desktop-restore-file-buffer):
10 Use `when'.
11
122007-06-24 Davis Herring <herring@lanl.gov>
13
14 * desktop.el (desktop-save-mode-off): New function.
15 (desktop-base-lock-name, desktop-not-loaded-hook): New variables.
16 (desktop-full-lock-name, desktop-file-modtime, desktop-owner)
17 (desktop-claim-lock, desktop-release-lock): New functions.
18 (desktop-kill): Tell `desktop-save' that this is the last save.
19 Release the lock afterwards.
20 (desktop-buffer-info): New function.
21 (desktop-save): Use it. Run `desktop-save-hook' where the doc
22 says to. Detect conflicts, and manage the lock.
23 (desktop-read): Detect conflicts. Manage the lock.
24
12007-06-23 Eli Zaretskii <eliz@gnu.org> 252007-06-23 Eli Zaretskii <eliz@gnu.org>
2 26
3 * ls-lisp.el (insert-directory): If an invalid regexp error is 27 * ls-lisp.el (insert-directory): If an invalid regexp error is
diff --git a/lisp/desktop.el b/lisp/desktop.el
index e44e943db3e..d9939ac0b85 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -162,6 +162,10 @@ and function `desktop-read' for details."
162(define-obsolete-variable-alias 'desktop-enable 162(define-obsolete-variable-alias 'desktop-enable
163 'desktop-save-mode "22.1") 163 'desktop-save-mode "22.1")
164 164
165(defun desktop-save-mode-off ()
166 "Disable `desktop-save-mode'. Provided for use in hooks."
167 (desktop-save-mode 0))
168
165(defcustom desktop-save 'ask-if-new 169(defcustom desktop-save 'ask-if-new
166 "*Specifies whether the desktop should be saved when it is killed. 170 "*Specifies whether the desktop should be saved when it is killed.
167A desktop is killed when the user changes desktop or quits Emacs. 171A desktop is killed when the user changes desktop or quits Emacs.
@@ -186,6 +190,22 @@ determine where the desktop is saved."
186 :group 'desktop 190 :group 'desktop
187 :version "22.1") 191 :version "22.1")
188 192
193(defcustom desktop-load-locked-desktop 'ask
194 "Specifies whether the desktop should be loaded if locked.
195Possible values are:
196 t -- load anyway.
197 nil -- don't load.
198 ask -- ask the user.
199If the value is nil, or `ask' and the user chooses not to load the desktop,
200the normal hook `desktop-not-loaded-hook' is run."
201 :type
202 '(choice
203 (const :tag "Load anyway" t)
204 (const :tag "Don't load" nil)
205 (const :tag "Ask the user" ask))
206 :group 'desktop
207 :version "22.2")
208
189(defcustom desktop-base-file-name 209(defcustom desktop-base-file-name
190 (convert-standard-filename ".emacs.desktop") 210 (convert-standard-filename ".emacs.desktop")
191 "Name of file for Emacs desktop, excluding the directory part." 211 "Name of file for Emacs desktop, excluding the directory part."
@@ -194,6 +214,13 @@ determine where the desktop is saved."
194(define-obsolete-variable-alias 'desktop-basefilename 214(define-obsolete-variable-alias 'desktop-basefilename
195 'desktop-base-file-name "22.1") 215 'desktop-base-file-name "22.1")
196 216
217(defcustom desktop-base-lock-name
218 (convert-standard-filename ".emacs.desktop.lock")
219 "Name of lock file for Emacs desktop, excluding the directory part."
220 :type 'file
221 :group 'desktop
222 :version "22.2")
223
197(defcustom desktop-path '("." "~") 224(defcustom desktop-path '("." "~")
198 "List of directories to search for the desktop file. 225 "List of directories to search for the desktop file.
199The base name of the file is specified in `desktop-base-file-name'." 226The base name of the file is specified in `desktop-base-file-name'."
@@ -219,6 +246,15 @@ May be used to show a dired buffer."
219 :group 'desktop 246 :group 'desktop
220 :version "22.1") 247 :version "22.1")
221 248
249(defcustom desktop-not-loaded-hook nil
250 "Normal hook run when the user declines to re-use a desktop file.
251Run in the directory in which the desktop file was found.
252May be used to deal with accidental multiple Emacs jobs."
253 :type 'hook
254 :group 'desktop
255 :options '(desktop-save-mode-off save-buffers-kill-emacs)
256 :version "22.2")
257
222(defcustom desktop-after-read-hook nil 258(defcustom desktop-after-read-hook nil
223 "Normal hook run after a successful `desktop-read'. 259 "Normal hook run after a successful `desktop-read'.
224May be used to show a buffer list." 260May be used to show a buffer list."
@@ -486,6 +522,11 @@ See also `desktop-minor-mode-table'.")
486DIRNAME omitted or nil means use `desktop-dirname'." 522DIRNAME omitted or nil means use `desktop-dirname'."
487 (expand-file-name desktop-base-file-name (or dirname desktop-dirname))) 523 (expand-file-name desktop-base-file-name (or dirname desktop-dirname)))
488 524
525(defun desktop-full-lock-name (&optional dirname)
526 "Return the full name of the desktop lock file in DIRNAME.
527DIRNAME omitted or nil means use `desktop-dirname'."
528 (expand-file-name desktop-base-lock-name (or dirname desktop-dirname)))
529
489(defconst desktop-header 530(defconst desktop-header
490";; -------------------------------------------------------------------------- 531";; --------------------------------------------------------------------------
491;; Desktop File for Emacs 532;; Desktop File for Emacs
@@ -496,11 +537,44 @@ DIRNAME omitted or nil means use `desktop-dirname'."
496 "Hooks run after all buffers are loaded; intended for internal use.") 537 "Hooks run after all buffers are loaded; intended for internal use.")
497 538
498;; ---------------------------------------------------------------------------- 539;; ----------------------------------------------------------------------------
540;; Desktop file conflict detection
541(defvar desktop-file-modtime nil
542 "When the desktop file was last modified to the knowledge of this Emacs.
543Used to detect desktop file conflicts.")
544
545(defun desktop-owner (&optional dirname)
546 "Return the PID of the Emacs process that owns the desktop file in DIRNAME.
547Return nil if no desktop file found or no Emacs process is using it.
548DIRNAME omitted or nil means use `desktop-dirname'."
549 (let (owner)
550 (and (file-exists-p (desktop-full-lock-name dirname))
551 (condition-case nil
552 (with-temp-buffer
553 (insert-file-contents-literally (desktop-full-lock-name dirname))
554 (goto-char (point-min))
555 (setq owner (read (current-buffer)))
556 (integerp owner))
557 (error nil))
558 owner)))
559
560(defun desktop-claim-lock (&optional dirname)
561 "Record this Emacs process as the owner of the desktop file in DIRNAME.
562DIRNAME omitted or nil means use `desktop-dirname'."
563 (write-region (number-to-string (emacs-pid)) nil
564 (desktop-full-lock-name dirname)))
565
566(defun desktop-release-lock (&optional dirname)
567 "Remove the lock file for the desktop in DIRNAME.
568DIRNAME omitted or nil means use `desktop-dirname'."
569 (let ((file (desktop-full-lock-name dirname)))
570 (when (file-exists-p file) (delete-file file))))
571
572;; ----------------------------------------------------------------------------
499(defun desktop-truncate (list n) 573(defun desktop-truncate (list n)
500 "Truncate LIST to at most N elements destructively." 574 "Truncate LIST to at most N elements destructively."
501 (let ((here (nthcdr (1- n) list))) 575 (let ((here (nthcdr (1- n) list)))
502 (if (consp here) 576 (when (consp here)
503 (setcdr here nil)))) 577 (setcdr here nil))))
504 578
505;; ---------------------------------------------------------------------------- 579;; ----------------------------------------------------------------------------
506;;;###autoload 580;;;###autoload
@@ -513,7 +587,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'."
513 (desktop-lazy-abort) 587 (desktop-lazy-abort)
514 (dolist (var desktop-globals-to-clear) 588 (dolist (var desktop-globals-to-clear)
515 (if (symbolp var) 589 (if (symbolp var)
516 (eval `(setq-default ,var nil)) 590 (eval `(setq-default ,var nil))
517 (eval `(setq-default ,(car var) ,(cdr var))))) 591 (eval `(setq-default ,(car var) ,(cdr var)))))
518 (let ((buffers (buffer-list)) 592 (let ((buffers (buffer-list))
519 (preserve-regexp (concat "^\\(" 593 (preserve-regexp (concat "^\\("
@@ -552,14 +626,14 @@ is nil, ask the user where to save the desktop."
552 (setq desktop-dirname 626 (setq desktop-dirname
553 (file-name-as-directory 627 (file-name-as-directory
554 (expand-file-name 628 (expand-file-name
555 (call-interactively 629 (read-directory-name "Directory for desktop file: " nil nil t)))))
556 (lambda (dir)
557 (interactive "DDirectory for desktop file: ") dir))))))
558 (condition-case err 630 (condition-case err
559 (desktop-save desktop-dirname) 631 (desktop-save desktop-dirname t)
560 (file-error 632 (file-error
561 (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") 633 (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
562 (signal (car err) (cdr err))))))) 634 (signal (car err) (cdr err))))))
635 ;; If we own it, we don't anymore.
636 (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
563 637
564;; ---------------------------------------------------------------------------- 638;; ----------------------------------------------------------------------------
565(defun desktop-list* (&rest args) 639(defun desktop-list* (&rest args)
@@ -574,83 +648,123 @@ is nil, ask the user where to save the desktop."
574 value))) 648 value)))
575 649
576;; ---------------------------------------------------------------------------- 650;; ----------------------------------------------------------------------------
651(defun desktop-buffer-info (buffer)
652 (set-buffer buffer)
653 (list
654 ;; basic information
655 (desktop-file-name (buffer-file-name) dirname)
656 (buffer-name)
657 major-mode
658 ;; minor modes
659 (let (ret)
660 (mapc
661 #'(lambda (minor-mode)
662 (and (boundp minor-mode)
663 (symbol-value minor-mode)
664 (let* ((special (assq minor-mode desktop-minor-mode-table))
665 (value (cond (special (cadr special))
666 ((functionp minor-mode) minor-mode))))
667 (when value (add-to-list 'ret value)))))
668 (mapcar #'car minor-mode-alist))
669 ret)
670 ;; point and mark, and read-only status
671 (point)
672 (list (mark t) mark-active)
673 buffer-read-only
674 ;; auxiliary information
675 (when (functionp desktop-save-buffer)
676 (funcall desktop-save-buffer dirname))
677 ;; local variables
678 (let ((locals desktop-locals-to-save)
679 (loclist (buffer-local-variables))
680 (ll))
681 (while locals
682 (let ((here (assq (car locals) loclist)))
683 (if here
684 (setq ll (cons here ll))
685 (when (member (car locals) loclist)
686 (setq ll (cons (car locals) ll)))))
687 (setq locals (cdr locals)))
688 ll)))
689
690;; ----------------------------------------------------------------------------
577(defun desktop-internal-v2s (value) 691(defun desktop-internal-v2s (value)
578 "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. 692 "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
579TXT is a string that when read and evaluated yields value. 693TXT is a string that when read and evaluated yields value.
580QUOTE may be `may' (value may be quoted), 694QUOTE may be `may' (value may be quoted),
581`must' (values must be quoted), or nil (value may not be quoted)." 695`must' (values must be quoted), or nil (value may not be quoted)."
582 (cond 696 (cond
583 ((or (numberp value) (null value) (eq t value) (keywordp value)) 697 ((or (numberp value) (null value) (eq t value) (keywordp value))
584 (cons 'may (prin1-to-string value))) 698 (cons 'may (prin1-to-string value)))
585 ((stringp value) 699 ((stringp value)
586 (let ((copy (copy-sequence value))) 700 (let ((copy (copy-sequence value)))
587 (set-text-properties 0 (length copy) nil copy) 701 (set-text-properties 0 (length copy) nil copy)
588 ;; Get rid of text properties because we cannot read them 702 ;; Get rid of text properties because we cannot read them
589 (cons 'may (prin1-to-string copy)))) 703 (cons 'may (prin1-to-string copy))))
590 ((symbolp value) 704 ((symbolp value)
591 (cons 'must (prin1-to-string value))) 705 (cons 'must (prin1-to-string value)))
592 ((vectorp value) 706 ((vectorp value)
593 (let* ((special nil) 707 (let* ((special nil)
594 (pass1 (mapcar 708 (pass1 (mapcar
595 (lambda (el) 709 (lambda (el)
596 (let ((res (desktop-internal-v2s el))) 710 (let ((res (desktop-internal-v2s el)))
597 (if (null (car res)) 711 (if (null (car res))
598 (setq special t)) 712 (setq special t))
599 res)) 713 res))
600 value))) 714 value)))
601 (if special 715 (if special
602 (cons nil (concat "(vector " 716 (cons nil (concat "(vector "
603 (mapconcat (lambda (el) 717 (mapconcat (lambda (el)
604 (if (eq (car el) 'must) 718 (if (eq (car el) 'must)
605 (concat "'" (cdr el)) 719 (concat "'" (cdr el))
606 (cdr el))) 720 (cdr el)))
607 pass1 721 pass1
608 " ") 722 " ")
609 ")")) 723 ")"))
610 (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) 724 (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
611 ((consp value) 725 ((consp value)
612 (let ((p value) 726 (let ((p value)
613 newlist 727 newlist
614 use-list* 728 use-list*
615 anynil) 729 anynil)
616 (while (consp p) 730 (while (consp p)
617 (let ((q.txt (desktop-internal-v2s (car p)))) 731 (let ((q.txt (desktop-internal-v2s (car p))))
618 (or anynil (setq anynil (null (car q.txt)))) 732 (or anynil (setq anynil (null (car q.txt))))
619 (setq newlist (cons q.txt newlist))) 733 (setq newlist (cons q.txt newlist)))
620 (setq p (cdr p))) 734 (setq p (cdr p)))
621 (if p 735 (if p
622 (let ((last (desktop-internal-v2s p))) 736 (let ((last (desktop-internal-v2s p)))
623 (or anynil (setq anynil (null (car last)))) 737 (or anynil (setq anynil (null (car last))))
624 (or anynil 738 (or anynil
625 (setq newlist (cons '(must . ".") newlist))) 739 (setq newlist (cons '(must . ".") newlist)))
626 (setq use-list* t) 740 (setq use-list* t)
627 (setq newlist (cons last newlist)))) 741 (setq newlist (cons last newlist))))
628 (setq newlist (nreverse newlist)) 742 (setq newlist (nreverse newlist))
629 (if anynil 743 (if anynil
630 (cons nil 744 (cons nil
631 (concat (if use-list* "(desktop-list* " "(list ") 745 (concat (if use-list* "(desktop-list* " "(list ")
632 (mapconcat (lambda (el) 746 (mapconcat (lambda (el)
633 (if (eq (car el) 'must) 747 (if (eq (car el) 'must)
634 (concat "'" (cdr el)) 748 (concat "'" (cdr el))
635 (cdr el))) 749 (cdr el)))
636 newlist 750 newlist
637 " ") 751 " ")
638 ")")) 752 ")"))
639 (cons 'must 753 (cons 'must
640 (concat "(" (mapconcat 'cdr newlist " ") ")"))))) 754 (concat "(" (mapconcat 'cdr newlist " ") ")")))))
641 ((subrp value) 755 ((subrp value)
642 (cons nil (concat "(symbol-function '" 756 (cons nil (concat "(symbol-function '"
643 (substring (prin1-to-string value) 7 -1) 757 (substring (prin1-to-string value) 7 -1)
644 ")"))) 758 ")")))
645 ((markerp value) 759 ((markerp value)
646 (let ((pos (prin1-to-string (marker-position value))) 760 (let ((pos (prin1-to-string (marker-position value)))
647 (buf (prin1-to-string (buffer-name (marker-buffer value))))) 761 (buf (prin1-to-string (buffer-name (marker-buffer value)))))
648 (cons nil (concat "(let ((mk (make-marker)))" 762 (cons nil (concat "(let ((mk (make-marker)))"
649 " (add-hook 'desktop-delay-hook" 763 " (add-hook 'desktop-delay-hook"
650 " (list 'lambda '() (list 'set-marker mk " 764 " (list 'lambda '() (list 'set-marker mk "
651 pos " (get-buffer " buf ")))) mk)")))) 765 pos " (get-buffer " buf ")))) mk)"))))
652 (t ; save as text 766 (t ; save as text
653 (cons 'may "\"Unprintable entity\"")))) 767 (cons 'may "\"Unprintable entity\""))))
654 768
655;; ---------------------------------------------------------------------------- 769;; ----------------------------------------------------------------------------
656(defun desktop-value-to-string (value) 770(defun desktop-value-to-string (value)
@@ -676,17 +790,16 @@ which means to truncate VAR's value to at most MAX-SIZE elements
676 (if (consp varspec) 790 (if (consp varspec)
677 (setq var (car varspec) size (cdr varspec)) 791 (setq var (car varspec) size (cdr varspec))
678 (setq var varspec)) 792 (setq var varspec))
679 (if (boundp var) 793 (when (boundp var)
680 (progn 794 (when (and (integerp size)
681 (if (and (integerp size) 795 (> size 0)
682 (> size 0) 796 (listp (eval var)))
683 (listp (eval var))) 797 (desktop-truncate (eval var) size))
684 (desktop-truncate (eval var) size)) 798 (insert "(setq "
685 (insert "(setq " 799 (symbol-name var)
686 (symbol-name var) 800 " "
687 " " 801 (desktop-value-to-string (symbol-value var))
688 (desktop-value-to-string (symbol-value var)) 802 ")\n"))))
689 ")\n")))))
690 803
691;; ---------------------------------------------------------------------------- 804;; ----------------------------------------------------------------------------
692(defun desktop-save-buffer-p (filename bufname mode &rest dummy) 805(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
@@ -724,90 +837,70 @@ DIRNAME must be the directory in which the desktop file will be saved."
724 837
725;; ---------------------------------------------------------------------------- 838;; ----------------------------------------------------------------------------
726;;;###autoload 839;;;###autoload
727(defun desktop-save (dirname) 840(defun desktop-save (dirname &optional release)
728 "Save the desktop in a desktop file. 841 "Save the desktop in a desktop file.
729Parameter DIRNAME specifies where to save the desktop file. 842Parameter DIRNAME specifies where to save the desktop file.
843Optional parameter RELEASE says whether we're done with this desktop.
730See also `desktop-base-file-name'." 844See also `desktop-base-file-name'."
731 (interactive "DDirectory to save desktop file in: ") 845 (interactive "DDirectory to save desktop file in: ")
732 (run-hooks 'desktop-save-hook) 846 (setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
733 (setq dirname (file-name-as-directory (expand-file-name dirname)))
734 (save-excursion 847 (save-excursion
735 (let ((filename (desktop-full-file-name dirname)) 848 (let ((eager desktop-restore-eager)
736 (info 849 (new-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
737 (mapcar 850 (when
738 #'(lambda (b) 851 (or (not new-modtime) ; nothing to overwrite
739 (set-buffer b) 852 (equal desktop-file-modtime new-modtime)
740 (list 853 (yes-or-no-p (if desktop-file-modtime
741 (desktop-file-name (buffer-file-name) dirname) 854 (if (> (float-time new-modtime) (float-time desktop-file-modtime))
742 (buffer-name) 855 "Desktop file is more recent than the one loaded. Save anyway? "
743 major-mode 856 "Desktop file isn't the one loaded. Overwrite it? ")
744 ;; minor modes 857 "Current desktop was not loaded from a file. Overwrite this desktop file? "))
745 (let (ret) 858 (unless release (error "Desktop file conflict")))
746 (mapc 859
747 #'(lambda (minor-mode) 860 ;; If we're done with it, release the lock.
748 (and 861 ;; Otherwise, claim it if it's unclaimed or if we created it.
749 (boundp minor-mode) 862 (if release
750 (symbol-value minor-mode) 863 (desktop-release-lock)
751 (let* ((special (assq minor-mode desktop-minor-mode-table)) 864 (unless (and new-modtime (desktop-owner)) (desktop-claim-lock)))
752 (value (cond (special (cadr special)) 865
753 ((functionp minor-mode) minor-mode)))) 866 (with-temp-buffer
754 (when value (add-to-list 'ret value))))) 867 (insert
755 (mapcar #'car minor-mode-alist)) 868 ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
756 ret) 869 desktop-header
757 (point) 870 ";; Created " (current-time-string) "\n"
758 (list (mark t) mark-active) 871 ";; Desktop file format version " desktop-file-version "\n"
759 buffer-read-only 872 ";; Emacs version " emacs-version "\n")
760 ;; Auxiliary information 873 (save-excursion (run-hooks 'desktop-save-hook))
761 (when (functionp desktop-save-buffer) 874 (goto-char (point-max))
762 (funcall desktop-save-buffer dirname)) 875 (insert "\n;; Global section:\n")
763 (let ((locals desktop-locals-to-save) 876 (mapc (function desktop-outvar) desktop-globals-to-save)
764 (loclist (buffer-local-variables)) 877 (when (memq 'kill-ring desktop-globals-to-save)
765 (ll)) 878 (insert
766 (while locals 879 "(setq kill-ring-yank-pointer (nthcdr "
767 (let ((here (assq (car locals) loclist))) 880 (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
768 (if here 881 " kill-ring))\n"))
769 (setq ll (cons here ll)) 882
770 (when (member (car locals) loclist) 883 (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
771 (setq ll (cons (car locals) ll))))) 884 (dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
772 (setq locals (cdr locals))) 885 (when (apply 'desktop-save-buffer-p l)
773 ll))) 886 (insert "("
774 (buffer-list))) 887 (if (or (not (integerp eager))
775 (eager desktop-restore-eager)) 888 (if (zerop eager)
776 (with-temp-buffer 889 nil
777 (insert 890 (setq eager (1- eager))))
778 ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" 891 "desktop-create-buffer"
779 desktop-header 892 "desktop-append-buffer-args")
780 ";; Created " (current-time-string) "\n" 893 " "
781 ";; Desktop file format version " desktop-file-version "\n" 894 desktop-file-version)
782 ";; Emacs version " emacs-version "\n\n" 895 (dolist (e l)
783 ";; Global section:\n") 896 (insert "\n " (desktop-value-to-string e)))
784 (dolist (varspec desktop-globals-to-save) 897 (insert ")\n\n")))
785 (desktop-outvar varspec)) 898
786 (if (memq 'kill-ring desktop-globals-to-save) 899 (setq default-directory dirname)
787 (insert 900 (let ((coding-system-for-write 'emacs-mule))
788 "(setq kill-ring-yank-pointer (nthcdr " 901 (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
789 (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) 902 ;; We remember when it was modified (which is presumably just now).
790 " kill-ring))\n")) 903 (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))
791
792 (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
793 (dolist (l info)
794 (when (apply 'desktop-save-buffer-p l)
795 (insert "("
796 (if (or (not (integerp eager))
797 (unless (zerop eager)
798 (setq eager (1- eager))
799 t))
800 "desktop-create-buffer"
801 "desktop-append-buffer-args")
802 " "
803 desktop-file-version)
804 (dolist (e l)
805 (insert "\n " (desktop-value-to-string e)))
806 (insert ")\n\n")))
807 (setq default-directory dirname)
808 (let ((coding-system-for-write 'emacs-mule))
809 (write-region (point-min) (point-max) filename nil 'nomessage)))))
810 (setq desktop-dirname dirname))
811 904
812;; ---------------------------------------------------------------------------- 905;; ----------------------------------------------------------------------------
813;;;###autoload 906;;;###autoload
@@ -856,35 +949,56 @@ It returns t if a desktop file was loaded, nil otherwise."
856 ;; Default: Home directory. 949 ;; Default: Home directory.
857 "~")))) 950 "~"))))
858 (if (file-exists-p (desktop-full-file-name)) 951 (if (file-exists-p (desktop-full-file-name))
859 ;; Desktop file found, process it. 952 ;; Desktop file found, but is it already in use?
860 (let ((desktop-first-buffer nil) 953 (let ((desktop-first-buffer nil)
861 (desktop-buffer-ok-count 0) 954 (desktop-buffer-ok-count 0)
862 (desktop-buffer-fail-count 0) 955 (desktop-buffer-fail-count 0)
863 ;; Avoid desktop saving during evaluation of desktop buffer. 956 (owner (desktop-owner))
864 (desktop-save nil)) 957 ;; Avoid desktop saving during evaluation of desktop buffer.
865 (desktop-lazy-abort) 958 (desktop-save nil))
866 ;; Evaluate desktop buffer. 959 (if (and owner
867 (load (desktop-full-file-name) t t t) 960 (memq desktop-load-locked-desktop '(nil ask))
868 ;; `desktop-create-buffer' puts buffers at end of the buffer list. 961 (or (null desktop-load-locked-desktop)
869 ;; We want buffers existing prior to evaluating the desktop (and not reused) 962 (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
870 ;; to be placed at the end of the buffer list, so we move them here. 963Using it may cause conflicts. Use it anyway? " owner)))))
871 (mapc 'bury-buffer 964 (progn
872 (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) 965 (let ((default-directory desktop-dirname))
873 (switch-to-buffer (car (buffer-list))) 966 (run-hooks 'desktop-not-loaded-hook))
874 (run-hooks 'desktop-delay-hook) 967 (setq desktop-dirname nil)
875 (setq desktop-delay-hook nil) 968 (message "Desktop file in use; not loaded."))
876 (run-hooks 'desktop-after-read-hook) 969 (desktop-lazy-abort)
877 (message "Desktop: %d buffer%s restored%s%s." 970 ;; Evaluate desktop buffer and remember when it was modified.
878 desktop-buffer-ok-count 971 (load (desktop-full-file-name) t t t)
879 (if (= 1 desktop-buffer-ok-count) "" "s") 972 (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
880 (if (< 0 desktop-buffer-fail-count) 973 ;; If it wasn't already, mark it as in-use, to bother other
881 (format ", %d failed to restore" desktop-buffer-fail-count) 974 ;; desktop instances.
882 "") 975 (unless owner
883 (if desktop-buffer-args-list 976 (condition-case nil
884 (format ", %d to restore lazily" 977 (desktop-claim-lock)
885 (length desktop-buffer-args-list)) 978 (file-error (message "Couldn't record use of desktop file")
886 "")) 979 (sit-for 1))))
887 t) 980
981 ;; `desktop-create-buffer' puts buffers at end of the buffer list.
982 ;; We want buffers existing prior to evaluating the desktop (and
983 ;; not reused) to be placed at the end of the buffer list, so we
984 ;; move them here.
985 (mapc 'bury-buffer
986 (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
987 (switch-to-buffer (car (buffer-list)))
988 (run-hooks 'desktop-delay-hook)
989 (setq desktop-delay-hook nil)
990 (run-hooks 'desktop-after-read-hook)
991 (message "Desktop: %d buffer%s restored%s%s."
992 desktop-buffer-ok-count
993 (if (= 1 desktop-buffer-ok-count) "" "s")
994 (if (< 0 desktop-buffer-fail-count)
995 (format ", %d failed to restore" desktop-buffer-fail-count)
996 "")
997 (if desktop-buffer-args-list
998 (format ", %d to restore lazily"
999 (length desktop-buffer-args-list))
1000 ""))
1001 t))
888 ;; No desktop file found. 1002 ;; No desktop file found.
889 (desktop-clear) 1003 (desktop-clear)
890 (let ((default-directory desktop-dirname)) 1004 (let ((default-directory desktop-dirname))
@@ -946,28 +1060,28 @@ directory DIRNAME."
946 desktop-buffer-name 1060 desktop-buffer-name
947 desktop-buffer-misc) 1061 desktop-buffer-misc)
948 "Restore a file buffer." 1062 "Restore a file buffer."
949 (if desktop-buffer-file-name 1063 (when desktop-buffer-file-name
950 (if (or (file-exists-p desktop-buffer-file-name) 1064 (if (or (file-exists-p desktop-buffer-file-name)
951 (let ((msg (format "Desktop: File \"%s\" no longer exists." 1065 (let ((msg (format "Desktop: File \"%s\" no longer exists."
952 desktop-buffer-file-name))) 1066 desktop-buffer-file-name)))
953 (if desktop-missing-file-warning 1067 (if desktop-missing-file-warning
954 (y-or-n-p (concat msg " Re-create buffer? ")) 1068 (y-or-n-p (concat msg " Re-create buffer? "))
955 (message "%s" msg) 1069 (message "%s" msg)
956 nil))) 1070 nil)))
957 (let* ((auto-insert nil) ; Disable auto insertion 1071 (let* ((auto-insert nil) ; Disable auto insertion
958 (coding-system-for-read 1072 (coding-system-for-read
959 (or coding-system-for-read 1073 (or coding-system-for-read
960 (cdr (assq 'buffer-file-coding-system 1074 (cdr (assq 'buffer-file-coding-system
961 desktop-buffer-locals)))) 1075 desktop-buffer-locals))))
962 (buf (find-file-noselect desktop-buffer-file-name))) 1076 (buf (find-file-noselect desktop-buffer-file-name)))
963 (condition-case nil 1077 (condition-case nil
964 (switch-to-buffer buf) 1078 (switch-to-buffer buf)
965 (error (pop-to-buffer buf))) 1079 (error (pop-to-buffer buf)))
966 (and (not (eq major-mode desktop-buffer-major-mode)) 1080 (and (not (eq major-mode desktop-buffer-major-mode))
967 (functionp desktop-buffer-major-mode) 1081 (functionp desktop-buffer-major-mode)
968 (funcall desktop-buffer-major-mode)) 1082 (funcall desktop-buffer-major-mode))
969 buf) 1083 buf)
970 nil))) 1084 nil)))
971 1085
972(defun desktop-load-file (function) 1086(defun desktop-load-file (function)
973 "Load the file where auto loaded FUNCTION is defined." 1087 "Load the file where auto loaded FUNCTION is defined."
@@ -1062,19 +1176,19 @@ directory DIRNAME."
1062 (error (message "%s" (error-message-string err)) 1)))) 1176 (error (message "%s" (error-message-string err)) 1))))
1063 (when desktop-buffer-mark 1177 (when desktop-buffer-mark
1064 (if (consp desktop-buffer-mark) 1178 (if (consp desktop-buffer-mark)
1065 (progn 1179 (progn
1066 (set-mark (car desktop-buffer-mark)) 1180 (set-mark (car desktop-buffer-mark))
1067 (setq mark-active (car (cdr desktop-buffer-mark)))) 1181 (setq mark-active (car (cdr desktop-buffer-mark))))
1068 (set-mark desktop-buffer-mark))) 1182 (set-mark desktop-buffer-mark)))
1069 ;; Never override file system if the file really is read-only marked. 1183 ;; Never override file system if the file really is read-only marked.
1070 (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) 1184 (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
1071 (while desktop-buffer-locals 1185 (while desktop-buffer-locals
1072 (let ((this (car desktop-buffer-locals))) 1186 (let ((this (car desktop-buffer-locals)))
1073 (if (consp this) 1187 (if (consp this)
1074 ;; an entry of this form `(symbol . value)' 1188 ;; an entry of this form `(symbol . value)'
1075 (progn 1189 (progn
1076 (make-local-variable (car this)) 1190 (make-local-variable (car this))
1077 (set (car this) (cdr this))) 1191 (set (car this) (cdr this)))
1078 ;; an entry of the form `symbol' 1192 ;; an entry of the form `symbol'
1079 (make-local-variable this) 1193 (make-local-variable this)
1080 (makunbound this))) 1194 (makunbound this)))