← Back to branch summary

~ubuntu-branches/ubuntu/karmic/emacs-snapshot/karmic

« back to all changes in this revision

Viewing changes to lisp/desktop.el

  • Committer: Bazaar Package Importer
  • Author(s): Romain Francoise
  • Date: 2007-07-01 18:41:19 UTC
  • mfrom: (1.1.21 upstream)
  • Revision ID: james.westby@ubuntu.com-20070701184119-1n27qhw9b1ee633k
Tags: 1:20070701-1
New snapshot (from the EMACS_22_BASE branch).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/desktop.el
162
162
(define-obsolete-variable-alias 'desktop-enable
163
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
169
(defcustom desktop-save 'ask-if-new
166
170
  "*Specifies whether the desktop should be saved when it is killed.
167
171
A desktop is killed when the user changes desktop or quits Emacs.
186
190
  :group 'desktop
187
191
  :version "22.1")
188
192
 
 
193
(defcustom desktop-load-locked-desktop 'ask
 
194
  "Specifies whether the desktop should be loaded if locked.
 
195
Possible values are:
 
196
   t    -- load anyway.
 
197
   nil  -- don't load.
 
198
   ask  -- ask the user.
 
199
If the value is nil, or `ask' and the user chooses not to load the desktop,
 
200
the 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
209
(defcustom desktop-base-file-name
190
210
  (convert-standard-filename ".emacs.desktop")
191
211
  "Name of file for Emacs desktop, excluding the directory part."
194
214
(define-obsolete-variable-alias 'desktop-basefilename
195
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
224
(defcustom desktop-path '("." "~")
198
225
  "List of directories to search for the desktop file.
199
226
The base name of the file is specified in `desktop-base-file-name'."
219
246
  :group 'desktop
220
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.
 
251
Run in the directory in which the desktop file was found.
 
252
May 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
258
(defcustom desktop-after-read-hook nil
223
259
  "Normal hook run after a successful `desktop-read'.
224
260
May be used to show a buffer list."
423
459
Each entry has the form (NAME RESTORE-FUNCTION).
424
460
NAME is the name of the buffer-local variable indicating that the minor
425
461
mode is active.  RESTORE-FUNCTION is the function to activate the minor mode.
426
 
called.  RESTORE-FUNCTION nil means don't try to restore the minor mode.
 
462
RESTORE-FUNCTION nil means don't try to restore the minor mode.
427
463
Only minor modes for which the name of the buffer-local variable
428
464
and the name of the minor mode function are different have to be added to
429
465
this table.  See also `desktop-minor-mode-handlers'."
486
522
DIRNAME omitted or nil means use `desktop-dirname'."
487
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.
 
527
DIRNAME omitted or nil means use `desktop-dirname'."
 
528
  (expand-file-name desktop-base-lock-name (or dirname desktop-dirname)))
 
529
 
489
530
(defconst desktop-header
490
531
";; --------------------------------------------------------------------------
491
532
;; Desktop File for Emacs
496
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.
 
543
Used 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.
 
547
Return nil if no desktop file found or no Emacs process is using it.
 
548
DIRNAME 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.
 
562
DIRNAME 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.
 
568
DIRNAME 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
573
(defun desktop-truncate (list n)
500
574
  "Truncate LIST to at most N elements destructively."
501
575
  (let ((here (nthcdr (1- n) list)))
502
 
    (if (consp here)
503
 
        (setcdr here nil))))
 
576
    (when (consp here)
 
577
      (setcdr here nil))))
504
578
 
505
579
;; ----------------------------------------------------------------------------
506
580
;;;###autoload
513
587
  (desktop-lazy-abort)
514
588
  (dolist (var desktop-globals-to-clear)
515
589
    (if (symbolp var)
516
 
      (eval `(setq-default ,var nil))
 
590
        (eval `(setq-default ,var nil))
517
591
      (eval `(setq-default ,(car var) ,(cdr var)))))
518
592
  (let ((buffers (buffer-list))
519
593
        (preserve-regexp (concat "^\\("
552
626
      (setq desktop-dirname
553
627
            (file-name-as-directory
554
628
             (expand-file-name
555
 
              (call-interactively
556
 
               (lambda (dir)
557
 
                 (interactive "DDirectory for desktop file: ") dir))))))
 
629
              (read-directory-name "Directory for desktop file: " nil nil t)))))
558
630
    (condition-case err
559
 
        (desktop-save desktop-dirname)
 
631
        (desktop-save desktop-dirname t)
560
632
      (file-error
561
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
639
(defun desktop-list* (&rest args)
574
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
691
(defun desktop-internal-v2s (value)
578
692
  "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
579
693
TXT is a string that when read and evaluated yields value.
580
694
QUOTE may be `may' (value may be quoted),
581
695
`must' (values must be quoted), or nil (value may not be quoted)."
582
696
  (cond
583
 
   ((or (numberp value) (null value) (eq t value) (keywordp value))
584
 
    (cons 'may (prin1-to-string value)))
585
 
   ((stringp value)
586
 
    (let ((copy (copy-sequence value)))
587
 
      (set-text-properties 0 (length copy) nil copy)
588
 
      ;; Get rid of text properties because we cannot read them
589
 
      (cons 'may (prin1-to-string copy))))
590
 
   ((symbolp value)
591
 
    (cons 'must (prin1-to-string value)))
592
 
   ((vectorp value)
593
 
    (let* ((special nil)
594
 
           (pass1 (mapcar
595
 
                   (lambda (el)
596
 
                     (let ((res (desktop-internal-v2s el)))
597
 
                       (if (null (car res))
598
 
                           (setq special t))
599
 
                       res))
600
 
                   value)))
601
 
      (if special
602
 
          (cons nil (concat "(vector "
603
 
                            (mapconcat (lambda (el)
604
 
                                         (if (eq (car el) 'must)
605
 
                                             (concat "'" (cdr el))
606
 
                                           (cdr el)))
607
 
                                       pass1
608
 
                                       " ")
609
 
                            ")"))
610
 
        (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
611
 
   ((consp value)
612
 
    (let ((p value)
613
 
          newlist
614
 
          use-list*
615
 
          anynil)
616
 
      (while (consp p)
617
 
        (let ((q.txt (desktop-internal-v2s (car p))))
618
 
          (or anynil (setq anynil (null (car q.txt))))
619
 
          (setq newlist (cons q.txt newlist)))
620
 
        (setq p (cdr p)))
621
 
      (if p
622
 
          (let ((last (desktop-internal-v2s p)))
623
 
            (or anynil (setq anynil (null (car last))))
624
 
            (or anynil
625
 
                (setq newlist (cons '(must . ".") newlist)))
626
 
            (setq use-list* t)
627
 
            (setq newlist (cons last newlist))))
628
 
      (setq newlist (nreverse newlist))
629
 
      (if anynil
630
 
          (cons nil
631
 
                (concat (if use-list* "(desktop-list* "  "(list ")
632
 
                        (mapconcat (lambda (el)
633
 
                                     (if (eq (car el) 'must)
634
 
                                         (concat "'" (cdr el))
635
 
                                       (cdr el)))
636
 
                                   newlist
637
 
                                   " ")
638
 
                        ")"))
639
 
        (cons 'must
640
 
              (concat "(" (mapconcat 'cdr newlist " ") ")")))))
641
 
   ((subrp value)
642
 
    (cons nil (concat "(symbol-function '"
643
 
                      (substring (prin1-to-string value) 7 -1)
644
 
                      ")")))
645
 
   ((markerp value)
646
 
    (let ((pos (prin1-to-string (marker-position value)))
647
 
          (buf (prin1-to-string (buffer-name (marker-buffer value)))))
648
 
      (cons nil (concat "(let ((mk (make-marker)))"
649
 
                        " (add-hook 'desktop-delay-hook"
650
 
                        " (list 'lambda '() (list 'set-marker mk "
651
 
                        pos " (get-buffer " buf ")))) mk)"))))
652
 
   (t                                   ; save as text
653
 
    (cons 'may "\"Unprintable entity\""))))
 
697
    ((or (numberp value) (null value) (eq t value) (keywordp value))
 
698
     (cons 'may (prin1-to-string value)))
 
699
    ((stringp value)
 
700
     (let ((copy (copy-sequence value)))
 
701
       (set-text-properties 0 (length copy) nil copy)
 
702
       ;; Get rid of text properties because we cannot read them
 
703
       (cons 'may (prin1-to-string copy))))
 
704
    ((symbolp value)
 
705
     (cons 'must (prin1-to-string value)))
 
706
    ((vectorp value)
 
707
     (let* ((special nil)
 
708
            (pass1 (mapcar
 
709
                    (lambda (el)
 
710
                      (let ((res (desktop-internal-v2s el)))
 
711
                        (if (null (car res))
 
712
                            (setq special t))
 
713
                        res))
 
714
                    value)))
 
715
       (if special
 
716
           (cons nil (concat "(vector "
 
717
                             (mapconcat (lambda (el)
 
718
                                          (if (eq (car el) 'must)
 
719
                                              (concat "'" (cdr el))
 
720
                                            (cdr el)))
 
721
                                        pass1
 
722
                                        " ")
 
723
                             ")"))
 
724
         (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
 
725
    ((consp value)
 
726
     (let ((p value)
 
727
           newlist
 
728
           use-list*
 
729
           anynil)
 
730
       (while (consp p)
 
731
         (let ((q.txt (desktop-internal-v2s (car p))))
 
732
           (or anynil (setq anynil (null (car q.txt))))
 
733
           (setq newlist (cons q.txt newlist)))
 
734
         (setq p (cdr p)))
 
735
       (if p
 
736
           (let ((last (desktop-internal-v2s p)))
 
737
             (or anynil (setq anynil (null (car last))))
 
738
             (or anynil
 
739
                 (setq newlist (cons '(must . ".") newlist)))
 
740
             (setq use-list* t)
 
741
             (setq newlist (cons last newlist))))
 
742
       (setq newlist (nreverse newlist))
 
743
       (if anynil
 
744
           (cons nil
 
745
                 (concat (if use-list* "(desktop-list* "  "(list ")
 
746
                         (mapconcat (lambda (el)
 
747
                                      (if (eq (car el) 'must)
 
748
                                          (concat "'" (cdr el))
 
749
                                        (cdr el)))
 
750
                                    newlist
 
751
                                    " ")
 
752
                         ")"))
 
753
         (cons 'must
 
754
               (concat "(" (mapconcat 'cdr newlist " ") ")")))))
 
755
    ((subrp value)
 
756
     (cons nil (concat "(symbol-function '"
 
757
                       (substring (prin1-to-string value) 7 -1)
 
758
                       ")")))
 
759
    ((markerp value)
 
760
     (let ((pos (prin1-to-string (marker-position value)))
 
761
           (buf (prin1-to-string (buffer-name (marker-buffer value)))))
 
762
       (cons nil (concat "(let ((mk (make-marker)))"
 
763
                         " (add-hook 'desktop-delay-hook"
 
764
                         " (list 'lambda '() (list 'set-marker mk "
 
765
                         pos " (get-buffer " buf ")))) mk)"))))
 
766
    (t                                   ; save as text
 
767
     (cons 'may "\"Unprintable entity\""))))
654
768
 
655
769
;; ----------------------------------------------------------------------------
656
770
(defun desktop-value-to-string (value)
676
790
    (if (consp varspec)
677
791
        (setq var (car varspec) size (cdr varspec))
678
792
      (setq var varspec))
679
 
    (if (boundp var)
680
 
        (progn
681
 
          (if (and (integerp size)
682
 
                   (> size 0)
683
 
                   (listp (eval var)))
684
 
              (desktop-truncate (eval var) size))
685
 
          (insert "(setq "
686
 
                  (symbol-name var)
687
 
                  " "
688
 
                  (desktop-value-to-string (symbol-value var))
689
 
                  ")\n")))))
 
793
    (when (boundp var)
 
794
      (when (and (integerp size)
 
795
                 (> size 0)
 
796
                 (listp (eval var)))
 
797
        (desktop-truncate (eval var) size))
 
798
      (insert "(setq "
 
799
              (symbol-name var)
 
800
              " "
 
801
              (desktop-value-to-string (symbol-value var))
 
802
              ")\n"))))
690
803
 
691
804
;; ----------------------------------------------------------------------------
692
805
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
724
837
 
725
838
;; ----------------------------------------------------------------------------
726
839
;;;###autoload
727
 
(defun desktop-save (dirname)
 
840
(defun desktop-save (dirname &optional release)
728
841
  "Save the desktop in a desktop file.
729
842
Parameter DIRNAME specifies where to save the desktop file.
 
843
Optional parameter RELEASE says whether we're done with this desktop.
730
844
See also `desktop-base-file-name'."
731
845
  (interactive "DDirectory to save desktop file in: ")
732
 
  (run-hooks 'desktop-save-hook)
733
 
  (setq dirname (file-name-as-directory (expand-file-name dirname)))
 
846
  (setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
734
847
  (save-excursion
735
 
    (let ((filename (desktop-full-file-name dirname))
736
 
          (info
737
 
            (mapcar
738
 
              #'(lambda (b)
739
 
                  (set-buffer b)
740
 
                  (list
741
 
                    (desktop-file-name (buffer-file-name) dirname)
742
 
                    (buffer-name)
743
 
                    major-mode
744
 
                    ;; minor modes
745
 
                    (let (ret)
746
 
                      (mapc
747
 
                        #'(lambda (minor-mode)
748
 
                          (and
749
 
                            (boundp minor-mode)
750
 
                            (symbol-value minor-mode)
751
 
                            (let* ((special (assq minor-mode desktop-minor-mode-table))
752
 
                                   (value (cond (special (cadr special))
753
 
                                                ((functionp minor-mode) minor-mode))))
754
 
                              (when value (add-to-list 'ret value)))))
755
 
                        (mapcar #'car minor-mode-alist))
756
 
                      ret)
757
 
                    (point)
758
 
                    (list (mark t) mark-active)
759
 
                    buffer-read-only
760
 
                    ;; Auxiliary information
761
 
                    (when (functionp desktop-save-buffer)
762
 
                      (funcall desktop-save-buffer dirname))
763
 
                    (let ((locals desktop-locals-to-save)
764
 
                          (loclist (buffer-local-variables))
765
 
                          (ll))
766
 
                      (while locals
767
 
                        (let ((here (assq (car locals) loclist)))
768
 
                          (if here
769
 
                            (setq ll (cons here ll))
770
 
                            (when (member (car locals) loclist)
771
 
                              (setq ll (cons (car locals) ll)))))
772
 
                        (setq locals (cdr locals)))
773
 
                      ll)))
774
 
              (buffer-list)))
775
 
          (eager desktop-restore-eager))
776
 
      (with-temp-buffer
777
 
        (insert
778
 
         ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
779
 
         desktop-header
780
 
         ";; Created " (current-time-string) "\n"
781
 
         ";; Desktop file format version " desktop-file-version "\n"
782
 
         ";; Emacs version " emacs-version "\n\n"
783
 
         ";; Global section:\n")
784
 
        (dolist (varspec desktop-globals-to-save)
785
 
          (desktop-outvar varspec))
786
 
        (if (memq 'kill-ring desktop-globals-to-save)
787
 
            (insert
788
 
             "(setq kill-ring-yank-pointer (nthcdr "
789
 
             (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
790
 
             " kill-ring))\n"))
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))
 
848
    (let ((eager desktop-restore-eager)
 
849
          (new-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
 
850
      (when
 
851
          (or (not new-modtime)         ; nothing to overwrite
 
852
              (equal desktop-file-modtime new-modtime)
 
853
              (yes-or-no-p (if desktop-file-modtime
 
854
                               (if (> (float-time new-modtime) (float-time desktop-file-modtime))
 
855
                                   "Desktop file is more recent than the one loaded.  Save anyway? "
 
856
                                 "Desktop file isn't the one loaded.  Overwrite it? ")
 
857
                             "Current desktop was not loaded from a file.  Overwrite this desktop file? "))
 
858
              (unless release (error "Desktop file conflict")))
 
859
 
 
860
        ;; If we're done with it, release the lock.
 
861
        ;; Otherwise, claim it if it's unclaimed or if we created it.
 
862
        (if release
 
863
            (desktop-release-lock)
 
864
          (unless (and new-modtime (desktop-owner)) (desktop-claim-lock)))
 
865
 
 
866
        (with-temp-buffer
 
867
          (insert
 
868
           ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
 
869
           desktop-header
 
870
           ";; Created " (current-time-string) "\n"
 
871
           ";; Desktop file format version " desktop-file-version "\n"
 
872
           ";; Emacs version " emacs-version "\n")
 
873
          (save-excursion (run-hooks 'desktop-save-hook))
 
874
          (goto-char (point-max))
 
875
          (insert "\n;; Global section:\n")
 
876
          (mapc (function desktop-outvar) desktop-globals-to-save)
 
877
          (when (memq 'kill-ring desktop-globals-to-save)
 
878
            (insert
 
879
             "(setq kill-ring-yank-pointer (nthcdr "
 
880
             (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
 
881
             " kill-ring))\n"))
 
882
 
 
883
          (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
 
884
          (dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
 
885
            (when (apply 'desktop-save-buffer-p l)
 
886
              (insert "("
 
887
                      (if (or (not (integerp eager))
 
888
                              (if (zerop eager)
 
889
                                  nil
 
890
                                (setq eager (1- eager))))
 
891
                          "desktop-create-buffer"
 
892
                        "desktop-append-buffer-args")
 
893
                      " "
 
894
                      desktop-file-version)
 
895
              (dolist (e l)
 
896
                (insert "\n  " (desktop-value-to-string e)))
 
897
              (insert ")\n\n")))
 
898
 
 
899
          (setq default-directory dirname)
 
900
          (let ((coding-system-for-write 'emacs-mule))
 
901
            (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
 
902
          ;; We remember when it was modified (which is presumably just now).
 
903
          (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))
811
904
 
812
905
;; ----------------------------------------------------------------------------
813
906
;;;###autoload
856
949
             ;; Default: Home directory.
857
950
             "~"))))
858
951
    (if (file-exists-p (desktop-full-file-name))
859
 
      ;; Desktop file found, process it.
860
 
      (let ((desktop-first-buffer nil)
861
 
            (desktop-buffer-ok-count 0)
862
 
            (desktop-buffer-fail-count 0)
863
 
            ;; Avoid desktop saving during evaluation of desktop buffer.
864
 
            (desktop-save nil))
865
 
        (desktop-lazy-abort)
866
 
        ;; Evaluate desktop buffer.
867
 
        (load (desktop-full-file-name) t t t)
868
 
        ;; `desktop-create-buffer' puts buffers at end of the buffer list.
869
 
        ;; We want buffers existing prior to evaluating the desktop (and not reused)
870
 
        ;; to be placed at the end of the buffer list, so we move them here.
871
 
        (mapc 'bury-buffer
872
 
              (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
873
 
        (switch-to-buffer (car (buffer-list)))
874
 
        (run-hooks 'desktop-delay-hook)
875
 
        (setq desktop-delay-hook nil)
876
 
        (run-hooks 'desktop-after-read-hook)
877
 
        (message "Desktop: %d buffer%s restored%s%s."
878
 
                 desktop-buffer-ok-count
879
 
                 (if (= 1 desktop-buffer-ok-count) "" "s")
880
 
                 (if (< 0 desktop-buffer-fail-count)
881
 
                     (format ", %d failed to restore" desktop-buffer-fail-count)
882
 
                   "")
883
 
                 (if desktop-buffer-args-list
884
 
                     (format ", %d to restore lazily"
885
 
                             (length desktop-buffer-args-list))
886
 
                   ""))
887
 
        t)
 
952
        ;; Desktop file found, but is it already in use?
 
953
        (let ((desktop-first-buffer nil)
 
954
              (desktop-buffer-ok-count 0)
 
955
              (desktop-buffer-fail-count 0)
 
956
              (owner (desktop-owner))
 
957
              ;; Avoid desktop saving during evaluation of desktop buffer.
 
958
              (desktop-save nil))
 
959
          (if (and owner
 
960
                   (memq desktop-load-locked-desktop '(nil ask))
 
961
                   (or (null desktop-load-locked-desktop)
 
962
                       (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
 
963
Using it may cause conflicts.  Use it anyway? " owner)))))
 
964
              (progn
 
965
                (let ((default-directory desktop-dirname))
 
966
                  (run-hooks 'desktop-not-loaded-hook))
 
967
                (setq desktop-dirname nil)
 
968
                (message "Desktop file in use; not loaded."))
 
969
            (desktop-lazy-abort)
 
970
            ;; Evaluate desktop buffer and remember when it was modified.
 
971
            (load (desktop-full-file-name) t t t)
 
972
            (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
 
973
            ;; If it wasn't already, mark it as in-use, to bother other
 
974
            ;; desktop instances.
 
975
            (unless owner
 
976
              (condition-case nil
 
977
                  (desktop-claim-lock)
 
978
                (file-error (message "Couldn't record use of desktop file")
 
979
                            (sit-for 1))))
 
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
1002
      ;; No desktop file found.
889
1003
      (desktop-clear)
890
1004
      (let ((default-directory desktop-dirname))
946
1060
                                    desktop-buffer-name
947
1061
                                    desktop-buffer-misc)
948
1062
  "Restore a file buffer."
949
 
  (if desktop-buffer-file-name
950
 
      (if (or (file-exists-p desktop-buffer-file-name)
951
 
              (let ((msg (format "Desktop: File \"%s\" no longer exists."
952
 
                                 desktop-buffer-file-name)))
953
 
                 (if desktop-missing-file-warning
954
 
                     (y-or-n-p (concat msg " Re-create buffer? "))
955
 
                   (message "%s" msg)
956
 
                   nil)))
957
 
          (let* ((auto-insert nil) ; Disable auto insertion
958
 
                 (coding-system-for-read
959
 
                  (or coding-system-for-read
960
 
                      (cdr (assq 'buffer-file-coding-system
961
 
                                 desktop-buffer-locals))))
962
 
                 (buf (find-file-noselect desktop-buffer-file-name)))
963
 
            (condition-case nil
964
 
                (switch-to-buffer buf)
965
 
              (error (pop-to-buffer buf)))
966
 
            (and (not (eq major-mode desktop-buffer-major-mode))
967
 
                 (functionp desktop-buffer-major-mode)
968
 
                 (funcall desktop-buffer-major-mode))
969
 
            buf)
970
 
        nil)))
 
1063
  (when desktop-buffer-file-name
 
1064
    (if (or (file-exists-p desktop-buffer-file-name)
 
1065
            (let ((msg (format "Desktop: File \"%s\" no longer exists."
 
1066
                               desktop-buffer-file-name)))
 
1067
              (if desktop-missing-file-warning
 
1068
                  (y-or-n-p (concat msg " Re-create buffer? "))
 
1069
                (message "%s" msg)
 
1070
                nil)))
 
1071
        (let* ((auto-insert nil) ; Disable auto insertion
 
1072
               (coding-system-for-read
 
1073
                (or coding-system-for-read
 
1074
                    (cdr (assq 'buffer-file-coding-system
 
1075
                               desktop-buffer-locals))))
 
1076
               (buf (find-file-noselect desktop-buffer-file-name)))
 
1077
          (condition-case nil
 
1078
              (switch-to-buffer buf)
 
1079
            (error (pop-to-buffer buf)))
 
1080
          (and (not (eq major-mode desktop-buffer-major-mode))
 
1081
               (functionp desktop-buffer-major-mode)
 
1082
               (funcall desktop-buffer-major-mode))
 
1083
          buf)
 
1084
      nil)))
971
1085
 
972
1086
(defun desktop-load-file (function)
973
1087
  "Load the file where auto loaded FUNCTION is defined."
1062
1176
              (error (message "%s" (error-message-string err)) 1))))
1063
1177
        (when desktop-buffer-mark
1064
1178
          (if (consp desktop-buffer-mark)
1065
 
            (progn
1066
 
              (set-mark (car desktop-buffer-mark))
1067
 
              (setq mark-active (car (cdr desktop-buffer-mark))))
 
1179
              (progn
 
1180
                (set-mark (car desktop-buffer-mark))
 
1181
                (setq mark-active (car (cdr desktop-buffer-mark))))
1068
1182
            (set-mark desktop-buffer-mark)))
1069
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
1185
        (while desktop-buffer-locals
1072
1186
          (let ((this (car desktop-buffer-locals)))
1073
1187
            (if (consp this)
1074
 
              ;; an entry of this form `(symbol . value)'
1075
 
              (progn
1076
 
                (make-local-variable (car this))
1077
 
                (set (car this) (cdr this)))
 
1188
                ;; an entry of this form `(symbol . value)'
 
1189
                (progn
 
1190
                  (make-local-variable (car this))
 
1191
                  (set (car this) (cdr this)))
1078
1192
              ;; an entry of the form `symbol'
1079
1193
              (make-local-variable this)
1080
1194
              (makunbound this)))