/[emacs]/emacs/lisp/desktop.el
ViewVC logotype

Diff of /emacs/lisp/desktop.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.50 by lektu, Mon Nov 4 08:19:59 2002 UTC revision 1.51 by rms, Wed Apr 9 01:37:56 2003 UTC
# Line 99  Line 99 
99  ;; Save window configuration.  ;; Save window configuration.
100  ;; Recognize more minor modes.  ;; Recognize more minor modes.
101  ;; Save mark rings.  ;; Save mark rings.
 ;; Start-up with buffer-menu???  
102    
103  ;;; Code:  ;;; Code:
104    
# Line 108  Line 107 
107    ;; We use functions from these modules    ;; We use functions from these modules
108    ;; We can't (require 'mh-e) since that wants to load something.    ;; We can't (require 'mh-e) since that wants to load something.
109    (mapcar 'require '(info dired reporter)))    (mapcar 'require '(info dired reporter)))
110    
111    (defvar desktop-file-version "206"
112      "Verion number of desktop file format.
113    Written into the desktop file and used at desktop read to provide
114    backward compatibility.")
115    
116  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
117  ;; USER OPTIONS -- settings you might want to play with.  ;; USER OPTIONS -- settings you might want to play with.
118  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
# Line 124  Line 129 
129    :initialize 'custom-initialize-default    :initialize 'custom-initialize-default
130    :version "20.3")    :version "20.3")
131    
132  (defcustom desktop-basefilename  (defcustom desktop-save 'ask-if-new
133      "*When the user changes desktop or quits emacs, should the desktop be saved?
134    \(in the current desktop directory)
135       t             -- always save.
136       ask           -- always ask.
137       ask-if-new    -- ask if no desktop file exists, otherwise just save.
138       ask-if-exists -- ask if desktop file exists, otherwise don't save.
139       if-exists     -- save if desktop file exists, otherwise don't save.
140       nil           -- never save.
141    The desktop is never saved when `desktop-enable' is nil."
142      :type '(choice
143        (const :tag "Always save" t)
144        (const :tag "Always ask" ask)
145        (const :tag "Ask if desktop file is new, else do save" ask-if-new)
146        (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
147        (const :tag "Save if desktop file exists, else don't" if-exists)
148        (const :tag "Never save" nil))
149      :group 'desktop)
150    
151    (defcustom desktop-base-file-name
152    (convert-standard-filename ".emacs.desktop")    (convert-standard-filename ".emacs.desktop")
153    "File for Emacs desktop, not including the directory name."    "File for Emacs desktop, not including the directory name."
154    :type 'file    :type 'file
155    :group 'desktop)    :group 'desktop)
156    
157    (defcustom desktop-path '("." "~")
158      "List of directories to search for the desktop file.
159    The base name of the file is specified in `desktop-base-file-name'."
160      :type '(repeat directory)
161      :group 'desktop)
162    
163  (defcustom desktop-missing-file-warning nil  (defcustom desktop-missing-file-warning nil
164    "*If non-nil then desktop warns when a file no longer exists.    "*If non-nil then desktop warns when a file no longer exists.
165  Otherwise it simply ignores that file."  Otherwise it simply ignores that file."
166    :type 'boolean    :type 'boolean
167    :group 'desktop)    :group 'desktop)
168    
169  (defvar desktop-globals-to-save  (defcustom desktop-no-desktop-file-hook nil
170    (list 'desktop-missing-file-warning    "Normal hook run after fail of `desktop-read' due to missing desktop file.
171          ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer  May e.g. be used to show a dired buffer."
172          ;; 'kill-ring    :type 'hook
173          'tags-file-name    :group 'desktop)
174          'tags-table-list  
175          'search-ring  (defcustom desktop-after-read-hook nil
176          'regexp-search-ring    "Normal hook run after a sucessful `desktop-read'.
177          'register-alist  May e.g. be used to show a buffer list."
178          ;; 'desktop-globals-to-save     ; Itself!    :type 'hook
179          )    :group 'desktop)
180    
181    (defcustom desktop-save-hook nil
182      "Hook run before desktop saves the state of Emacs.
183    This is useful for truncating history lists, for example."
184      :type 'hook
185      :group 'desktop)
186    
187    (defcustom desktop-globals-to-save '(
188      desktop-missing-file-warning
189      tags-file-name
190      tags-table-list
191      search-ring
192      regexp-search-ring
193      register-alist)
194    "List of global variables to save when killing Emacs.    "List of global variables to save when killing Emacs.
195  An element may be variable name (a symbol)  An element may be variable name (a symbol)
196  or a cons cell of the form  (VAR . MAX-SIZE),  or a cons cell of the form  (VAR . MAX-SIZE),
197  which means to truncate VAR's value to at most MAX-SIZE elements  which means to truncate VAR's value to at most MAX-SIZE elements
198  \(if the value is a list) before saving the value.")  \(if the value is a list) before saving the value.
199    Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
200      :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
201      :group 'desktop)
202    
203    (defcustom desktop-globals-to-clear '(
204      kill-ring
205      kill-ring-yank-pointer
206      search-ring
207      search-ring-yank-pointer
208      regexp-search-ring
209      regexp-search-ring-yank-pointer)
210      "List of global variables set to clear by `desktop-clear'.
211    An element may be variable name (a symbol) or a cons cell of the form
212    \(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
213    to the value obtained by evaluateing FORM."
214      :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
215      :group 'desktop)
216    
217    (defcustom desktop-clear-preserve-buffers-regexp
218      "^\\*tramp/.+\\*$"
219      "Regexp identifying buffers that `desktop-clear' should not delete."
220      :type 'regexp
221      :group 'desktop)
222    
223  (defvar desktop-locals-to-save  ;; Maintained for backward compatibility
224    (list 'desktop-locals-to-save         ; Itself!  Think it over.  (defcustom desktop-clear-preserve-buffers
225          'truncate-lines    '("*scratch*" "*Messages*")
226          'case-fold-search    "*List of buffer names that `desktop-clear' should not delete."
227          'case-replace    :type '(repeat string)
228          'fill-column    :group 'desktop)
229          'overwrite-mode  
230          'change-log-default-name  (defvar desktop-locals-to-save '(
231          'line-number-mode    desktop-locals-to-save  ; Itself!  Think it over.
232          )    truncate-lines
233      case-fold-search
234      case-replace
235      fill-column
236      overwrite-mode
237      change-log-default-name
238      line-number-mode)
239    "List of local variables to save for each buffer.    "List of local variables to save for each buffer.
240  The variables are saved only when they really are local.")  The variables are saved only when they really are local.")
241  (make-variable-buffer-local 'desktop-locals-to-save)  (make-variable-buffer-local 'desktop-locals-to-save)
# Line 171  The variables are saved only when they r Line 244  The variables are saved only when they r
244  ;;         (ftp) files because they require passwords and whatnot.  ;;         (ftp) files because they require passwords and whatnot.
245  ;;         TAGS files to save time (tags-file-name is saved instead).  ;;         TAGS files to save time (tags-file-name is saved instead).
246  (defcustom desktop-buffers-not-to-save  (defcustom desktop-buffers-not-to-save
247   "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"    "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
248   "Regexp identifying buffers that are to be excluded from saving."    "Regexp identifying buffers that are to be excluded from saving."
249   :type 'regexp    :type 'regexp
250   :group 'desktop)    :group 'desktop)
251    
252  ;; Skip ange-ftp files  ;; Skip ange-ftp files
253  (defcustom desktop-files-not-to-save  (defcustom desktop-files-not-to-save
# Line 196  whether the buffer should be recreated o Line 269  whether the buffer should be recreated o
269    :type '(repeat symbol)    :type '(repeat symbol)
270    :group 'desktop)    :group 'desktop)
271    
272  (defcustom desktop-buffer-major-mode nil  (defcustom desktop-file-name-format 'absolute
273    "When desktop creates a buffer, this holds the desired Major mode."    "*Format in which desktop file names should be saved.
274    :type 'symbol  Possible values are:
275    :group 'desktop)     absolute -- Absolute file name.
276       tilde    -- Relative to ~.
277  (defcustom desktop-buffer-file-name nil     local    -- Relative to directory of desktop file."
278    "When desktop creates a buffer, this holds the file name to visit."    :type '(choice (const absolute) (const tilde) (const local))
   :type '(choice file (const nil))  
279    :group 'desktop)    :group 'desktop)
280    
 (defcustom desktop-buffer-name nil  
   "When desktop creates a buffer, this holds the desired buffer name."  
   :type '(choice string (const nil))  
   :group 'desktop)  
   
 (defvar desktop-buffer-misc nil  
   "When desktop creates a buffer, this holds a list of misc info.  
 It is used by the `desktop-buffer-handlers' functions.")  
   
281  (defcustom desktop-buffer-misc-functions  (defcustom desktop-buffer-misc-functions
282    '(desktop-buffer-info-misc-data    '(desktop-buffer-info-misc-data
283      desktop-buffer-dired-misc-data)      desktop-buffer-dired-misc-data)
# Line 223  These functions are called in order, wit Line 286  These functions are called in order, wit
286  returns non-nil, its value is saved along with the desktop buffer for  returns non-nil, its value is saved along with the desktop buffer for
287  which it was called; no further functions will be called.  which it was called; no further functions will be called.
288    
289    File names should formatted using the call
290    \"(desktop-file-name FILE-NAME dirname)\".
291    
292  Later, when desktop.el restores the buffers it has saved, each of the  Later, when desktop.el restores the buffers it has saved, each of the
293  `desktop-buffer-handlers' functions will have access to a buffer local  `desktop-buffer-handlers' functions will have access to a buffer local
294  variable, named `desktop-buffer-misc', whose value is what the  variable, named `desktop-buffer-misc', whose value is what the
# Line 238  variable, named `desktop-buffer-misc', w Line 304  variable, named `desktop-buffer-misc', w
304      desktop-buffer-file)      desktop-buffer-file)
305    "*List of functions to call in order to create a buffer.    "*List of functions to call in order to create a buffer.
306  The functions are called without explicit parameters but can use the  The functions are called without explicit parameters but can use the
307  variables `desktop-buffer-major-mode', `desktop-buffer-file-name',  following variables:
308  `desktop-buffer-name'.  
309       desktop-file-version
310       desktop-buffer-file-name
311       desktop-buffer-name
312       desktop-buffer-major-mode
313       desktop-buffer-minor-modes
314       desktop-buffer-point
315       desktop-buffer-mark
316       desktop-buffer-read-only
317       desktop-buffer-misc
318       desktop-buffer-locals
319    
320  If one function returns non-nil, no further functions are called.  If one function returns non-nil, no further functions are called.
321  If the function returns a buffer, then the saved mode settings  If the function returns a buffer, then the saved mode settings
322  and variable values for that buffer are copied into it."  and variable values for that buffer are copied into it."
# Line 248  and variable values for that buffer are Line 325  and variable values for that buffer are
325    
326  (put 'desktop-buffer-handlers 'risky-local-variable t)  (put 'desktop-buffer-handlers 'risky-local-variable t)
327    
 (defvar desktop-create-buffer-form "(desktop-create-buffer 205"  
   "Opening of form for creation of new buffers.")  
   
 (defcustom desktop-save-hook nil  
   "Hook run before desktop saves the state of Emacs.  
 This is useful for truncating history lists, for example."  
   :type 'hook  
   :group 'desktop)  
   
328  (defcustom desktop-minor-mode-table  (defcustom desktop-minor-mode-table
329    '((auto-fill-function auto-fill-mode)    '((auto-fill-function auto-fill-mode)
330      (vc-mode nil))      (vc-mode nil))
# Line 290  this table." Line 358  this table."
358    (let ((here (nthcdr (1- n) l)))    (let ((here (nthcdr (1- n) l)))
359      (if (consp here)      (if (consp here)
360          (setcdr here nil))))          (setcdr here nil))))
 ;; ----------------------------------------------------------------------------  
 (defcustom desktop-clear-preserve-buffers  
   '("*scratch*" "*Messages*")  
   "*Buffer names that `desktop-clear' should not delete."  
   :type '(repeat string)  
   :group 'desktop)  
361    
362    ;; ----------------------------------------------------------------------------
363  (defun desktop-clear ()  (defun desktop-clear ()
364    "Empty the Desktop.    "Empty the Desktop.
365  This kills all buffers except for internal ones  This kills all buffers except for internal ones and those listed
366  and those listed in `desktop-clear-preserve-buffers'."  in `desktop-clear-preserve-buffers'.  Furthermore, it clears the
367    variables listed in `desktop-globals-to-clear'."
368    (interactive)    (interactive)
369    (setq kill-ring nil    (dolist (var desktop-globals-to-clear)
370          kill-ring-yank-pointer nil      (if (symbolp var)
371          search-ring nil        (eval `(setq-default ,var nil))
372          search-ring-yank-pointer nil        (eval `(setq-default ,(car var) ,(cdr var)))))
         regexp-search-ring nil  
         regexp-search-ring-yank-pointer nil)  
373    (let ((buffers (buffer-list)))    (let ((buffers (buffer-list)))
374      (while buffers      (while buffers
375        (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers)        (let ((bufname (buffer-name (car buffers))))
376            (null (buffer-name (car buffers)))           (or
377            ;; Don't kill buffers made for internal purposes.             (null bufname)
378            (and (not (equal (buffer-name (car buffers)) ""))             (string-match desktop-clear-preserve-buffers-regexp bufname)
379                 (eq (aref (buffer-name (car buffers)) 0) ?\ ))             (member bufname desktop-clear-preserve-buffers)
380            (kill-buffer (car buffers)))             ;; Don't kill buffers made for internal purposes.
381               (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
382               (kill-buffer (car buffers))))
383        (setq buffers (cdr buffers))))        (setq buffers (cdr buffers))))
384    (delete-other-windows))    (delete-other-windows))
385    
386  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
387  (add-hook 'kill-emacs-hook 'desktop-kill)  (add-hook 'kill-emacs-hook 'desktop-kill)
388    
389  (defun desktop-kill ()  (defun desktop-kill ()
390    (if desktop-dirname    "If `desktop-enable' is non-nil, do what `desktop-save' says to do.
391        (condition-case err  If the desktop should be saved and `desktop-dirname'
392            (desktop-save desktop-dirname)  is nil, ask the user where to save the desktop."
393          (file-error    (when
394           (if (yes-or-no-p "Error while saving the desktop.  Quit anyway? ")      (and
395               nil        desktop-enable
396             (signal (car err) (cdr err)))))))        (let ((exists (file-exists-p (concat desktop-dirname desktop-base-file-name))))
397            (or
398              (eq desktop-save 't)
399              (and exists (memq desktop-save '(ask-if-new if-exists)))
400              (and
401                (or
402                  (memq desktop-save '(ask ask-if-new))
403                  (and exists (eq desktop-save 'ask-if-exists)))
404                (y-or-n-p "Save desktop? ")))))
405        (unless desktop-dirname
406          (setq desktop-dirname
407            (expand-file-name
408              (call-interactively
409                (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))
410        (condition-case err
411          (desktop-save desktop-dirname)
412          (file-error
413            (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
414              (signal (car err) (cdr err)))))))
415    
416  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
417  (defun desktop-list* (&rest args)  (defun desktop-list* (&rest args)
418    (if (null (cdr args))    (if (null (cdr args))
# Line 341  and those listed in `desktop-clear-prese Line 425  and those listed in `desktop-clear-prese
425          (setq args (cdr args)))          (setq args (cdr args)))
426        value)))        value)))
427    
428    ;; ----------------------------------------------------------------------------
429  (defun desktop-internal-v2s (val)  (defun desktop-internal-v2s (val)
430    "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.    "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
431  TXT is a string that when read and evaluated yields value.  TXT is a string that when read and evaluated yields value.
# Line 420  QUOTE may be `may' (value may be quoted) Line 505  QUOTE may be `may' (value may be quoted)
505     (t                                   ; save as text     (t                                   ; save as text
506      (cons 'may "\"Unprintable entity\""))))      (cons 'may "\"Unprintable entity\""))))
507    
508    ;; ----------------------------------------------------------------------------
509  (defun desktop-value-to-string (val)  (defun desktop-value-to-string (val)
510    "Convert VALUE to a string that when read evaluates to the same value.    "Convert VALUE to a string that when read evaluates to the same value.
511  Not all types of values are supported."  Not all types of values are supported."
# Line 431  Not all types of values are supported." Line 517  Not all types of values are supported."
517      (if (eq quote 'must)      (if (eq quote 'must)
518          (concat "'" txt)          (concat "'" txt)
519        txt)))        txt)))
520    
521  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
522  (defun desktop-outvar (varspec)  (defun desktop-outvar (varspec)
523    "Output a setq statement for variable VAR to the desktop file.    "Output a setq statement for variable VAR to the desktop file.
# Line 453  which means to truncate VAR's value to a Line 540  which means to truncate VAR's value to a
540                    " "                    " "
541                    (desktop-value-to-string (symbol-value var))                    (desktop-value-to-string (symbol-value var))
542                    ")\n")))))                    ")\n")))))
543    
544  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
545  (defun desktop-save-buffer-p (filename bufname mode &rest dummy)  (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
546    "Return t if the desktop should record a particular buffer for next startup.    "Return t if the desktop should record a particular buffer for next startup.
# Line 470  MODE is the major mode." Line 558  MODE is the major mode."
558                                         default-directory))))                                         default-directory))))
559               (and (null filename)               (and (null filename)
560                    (memq mode desktop-buffer-modes-to-save))))))                    (memq mode desktop-buffer-modes-to-save))))))
561    
562  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
563  (defcustom desktop-relative-file-names nil  (defun desktop-file-name (filename dirname)
564    "*Store relative file names in the desktop file."    "Convert FILENAME to format specified in `desktop-file-name-format'.
565    :type 'boolean  DIRNAME must be the directory in which the desktop file will be saved."
566    :group 'desktop)    (cond
567        ((not filename) nil)
568        ((eq desktop-file-name-format 'tilde)
569         (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
570           (cond
571             ((file-name-absolute-p relative-name) relative-name)
572             ((string= "./" relative-name) "~/")
573             ((string= "." relative-name) "~")
574             (t (concat "~/" relative-name)))))
575        ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
576        (t (expand-file-name filename))))
577    
578    ;; ----------------------------------------------------------------------------
579  (defun desktop-save (dirname)  (defun desktop-save (dirname)
580    "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."    "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
581    (interactive "DDirectory to save desktop file in: ")    (interactive "DDirectory to save desktop file in: ")
582    (run-hooks 'desktop-save-hook)    (run-hooks 'desktop-save-hook)
583    (save-excursion    (save-excursion
584      (let ((filename (expand-file-name desktop-basefilename dirname))      (let ((filename (expand-file-name desktop-base-file-name dirname))
585            (info (nreverse        (info
586                   (mapcar          (mapcar
587                    (function            (function
588                     (lambda (b)              (lambda (b)
589                      (set-buffer b)                (set-buffer b)
590                      (list                (list
591                       (let ((bn (buffer-file-name)))                  (desktop-file-name (buffer-file-name) dirname)
592                         (if bn                  (buffer-name)
593                             (if desktop-relative-file-names                  major-mode
594                                 (file-relative-name bn dirname)                  ;; minor modes
595                               bn)))                  (let (ret)
596                       (buffer-name)                    (mapcar
597                       major-mode                      #'(lambda (mim)
598                       ;; minor modes                        (and
599                       (let (ret)                          (boundp mim)
600                         (mapcar                          (symbol-value mim)
601                          #'(lambda (mim)                          (setq
602                              (and (boundp mim)                            ret
603                                   (symbol-value mim)                            (cons
604                                   (setq ret                              (let (
605                                         (cons (let ((special (assq mim desktop-minor-mode-table)))                                (special (assq mim desktop-minor-mode-table))
606                                                 (if special                              )
607                                                     (cadr special)                                (if special (cadr special) mim))
608                                                   mim))                              ret))))
609                                               ret))))                      (mapcar #'car minor-mode-alist))
610                          (mapcar #'car minor-mode-alist))                    ret)
611                         ret)                  (point)
612                       (point)                  (list (mark t) mark-active)
613                       (list (mark t) mark-active)                  buffer-read-only
614                       buffer-read-only                  (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
615                       (run-hook-with-args-until-success                  (let (
616                        'desktop-buffer-misc-functions)                    (locals desktop-locals-to-save)
617                       (let ((locals desktop-locals-to-save)                    (loclist (buffer-local-variables))
618                             (loclist (buffer-local-variables))                    (ll)
619                             (ll))                  )
620                         (while locals                    (while locals
621                           (let ((here (assq (car locals) loclist)))                      (let ((here (assq (car locals) loclist)))
622                             (if here                        (if here
623                                 (setq ll (cons here ll))                          (setq ll (cons here ll))
624                               (if (member (car locals) loclist)                          (when (member (car locals) loclist)
625                                   (setq ll (cons (car locals) ll)))))                            (setq ll (cons (car locals) ll)))))
626                           (setq locals (cdr locals)))                      (setq locals (cdr locals)))
627                         ll)                    ll))))
628                       )))            (buffer-list)))
629                    (buffer-list))))        (buf (get-buffer-create "*desktop*")))
           (buf (get-buffer-create "*desktop*")))  
630        (set-buffer buf)        (set-buffer buf)
631        (erase-buffer)        (erase-buffer)
632    
633        (insert ";; -*- coding: emacs-mule; -*-\n"        (insert
634                desktop-header          ";; -*- coding: emacs-mule; -*-\n"
635                ";; Created " (current-time-string) "\n"          desktop-header
636                ";; Emacs version " emacs-version "\n\n"          ";; Created " (current-time-string) "\n"
637                ";; Global section:\n")          ";; Desktop file format version " desktop-file-version "\n"
638            ";; Emacs version " emacs-version "\n\n"
639            ";; Global section:\n")
640        (mapcar (function desktop-outvar) desktop-globals-to-save)        (mapcar (function desktop-outvar) desktop-globals-to-save)
641        (if (memq 'kill-ring desktop-globals-to-save)        (if (memq 'kill-ring desktop-globals-to-save)
642            (insert "(setq kill-ring-yank-pointer (nthcdr "          (insert
643                    (int-to-string            "(setq kill-ring-yank-pointer (nthcdr "
644                     (- (length kill-ring) (length kill-ring-yank-pointer)))            (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
645                    " kill-ring))\n"))            " kill-ring))\n"))
646    
647        (insert "\n;; Buffer section:\n")        (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
648        (mapcar        (mapcar
649         (function (lambda (l)          (function
650           (if (apply 'desktop-save-buffer-p l)            (lambda (l)
651               (progn              (if (apply 'desktop-save-buffer-p l)
652                 (insert desktop-create-buffer-form)                (progn
653                 (mapcar                  (insert "(desktop-create-buffer " desktop-file-version)
654                  (function (lambda (e)                  (mapcar
655                    (insert "\n  "                    (function
656                            (desktop-value-to-string e))))                      (lambda (e)
657                  l)                        (insert "\n  " (desktop-value-to-string e))))
658                 (insert ")\n\n")))))                    l)
659         info)                  (insert ")\n\n")))))
660            info)
661        (setq default-directory dirname)        (setq default-directory dirname)
662        (if (file-exists-p filename) (delete-file filename))        (when (file-exists-p filename) (delete-file filename))
663        (let ((coding-system-for-write 'emacs-mule))        (let ((coding-system-for-write 'emacs-mule))
664          (write-region (point-min) (point-max) filename nil 'nomessage))))          (write-region (point-min) (point-max) filename nil 'nomessage))))
665    (setq desktop-dirname dirname))    (setq desktop-dirname dirname))
666    
667  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
668  (defun desktop-remove ()  (defun desktop-remove ()
669    "Delete the Desktop file and inactivate the desktop system."    "Delete the Desktop file and inactivate the desktop system."
670    (interactive)    (interactive)
671    (if desktop-dirname    (if desktop-dirname
672        (let ((filename (concat desktop-dirname desktop-basefilename)))        (let ((filename (concat desktop-dirname desktop-base-file-name)))
673          (setq desktop-dirname nil)          (setq desktop-dirname nil)
674          (if (file-exists-p filename)          (if (file-exists-p filename)
675              (delete-file filename)))))              (delete-file filename)))))
676    
677  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
678  ;;;###autoload  ;;;###autoload
679  (defun desktop-read ()  (defun desktop-read ()
680    "Read the Desktop file and the files it specifies.    "Read the Desktop file and the files it specifies.
681  This is a no-op when Emacs is running in batch mode."  This is a no-op when Emacs is running in batch mode.
682    Look for the desktop file according to the variables `desktop-base-file-name'
683    and `desktop-path'.  If no desktop file is found, clear the desktop.
684    Returns t if it has read a desktop file, nil otherwise."
685    (interactive)    (interactive)
686    (if noninteractive    (unless noninteractive
687        nil      (let ((dirs desktop-path))
688      (let ((dirs '("./" "~/")))        (while
689        (while (and dirs          (and
690                    (not (file-exists-p (expand-file-name            dirs
691                                         desktop-basefilename            (not
692                                         (car dirs)))))              (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
693          (setq dirs (cdr dirs)))          (setq dirs (cdr dirs)))
694        (setq desktop-dirname (and dirs (expand-file-name (car dirs))))        (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
695        (if desktop-dirname        (if desktop-dirname
696            (let ((desktop-last-buffer nil))          (let ((desktop-first-buffer nil))
697              ;; `load-with-code-conversion' calls `eval-buffer' which            ;; `desktop-create-buffer' sets `desktop-first-buffer' to the first
698              ;; contains a `save-excursion', so we end up with the same            ;; buffer in the desktop file (the last for desktop files written
699              ;; buffer before and after the load.  This is a problem            ;; by desktop version prior to 206).
700              ;; when the desktop is read initially when Emacs starts up            (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
701              ;; because, if we still are in *scratch* after running            (when desktop-first-buffer (switch-to-buffer desktop-first-buffer))
702              ;; `after-init-hook', the splash screen will be displayed.            (run-hooks 'desktop-delay-hook)
703              (load (expand-file-name desktop-basefilename desktop-dirname)            (setq desktop-delay-hook nil)
704                    t t t)            (run-hooks 'desktop-after-read-hook)
705              (when desktop-last-buffer            (message "Desktop loaded.")
706                (switch-to-buffer desktop-last-buffer))            t)
707              (run-hooks 'desktop-delay-hook)          (desktop-clear)
708              (setq desktop-delay-hook nil)          (run-hooks 'desktop-no-desktop-file-hook)
709              (message "Desktop loaded."))          (message "No desktop file.")
710          (desktop-clear)))))          nil))))
711    
712  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
713  ;;;###autoload  ;;;###autoload
714  (defun desktop-load-default ()  (defun desktop-load-default ()
# Line 611  to provide correct modes for autoloaded Line 719  to provide correct modes for autoloaded
719        (progn        (progn
720          (load "default" t t)          (load "default" t t)
721          (setq inhibit-default-init t))))          (setq inhibit-default-init t))))
722    
723    ;; ----------------------------------------------------------------------------
724    ;;;###autoload
725    (defun desktop-change-dir (dir)
726      "Save and clear the desktop, then load the desktop from directory DIR.
727    However, if `desktop-enable' was nil at call, don't save the old desktop.
728    This function always sets `desktop-enable' to t."
729      (interactive "DNew directory: ")
730      (desktop-kill)
731      (desktop-clear)
732      (cd dir)
733      (setq desktop-enable t)
734      (let ((desktop-path '(".")))
735        (desktop-read)
736        ;; Set `desktop-dirname' even in no desktop file was found
737        (setq desktop-dirname (expand-file-name dir))))
738    
739    ;; ----------------------------------------------------------------------------
740    ;;;###autoload
741    (defun desktop-save-in-load-dir ()
742      "Save desktop in directory from which it was loaded."
743      (interactive)
744      (if desktop-dirname
745        (desktop-save desktop-dirname)
746        (call-interactively 'desktop-save))
747      (message "Desktop saved in %s" desktop-dirname))
748    
749    ;; ----------------------------------------------------------------------------
750    ;;;###autoload
751    (defun desktop-revert ()
752      "Revert to the last loaded desktop."
753      (interactive)
754      (unless desktop-dirname (error "No desktop has been loaded"))
755      (setq desktop-enable nil)
756      (desktop-change-dir desktop-dirname))
757    
758  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
759  ;; Note: the following functions use the dynamic variable binding in Lisp.  ;; Note: the following functions use the dynamic variable binding in Lisp.
760  ;;  ;;
761    
762    (eval-when-compile ; Just to silence the byte compiler
763      (defvar desktop-file-version)
764      (defvar desktop-buffer-file-name)
765      (defvar desktop-buffer-name)
766      (defvar desktop-buffer-major-mode)
767      (defvar desktop-buffer-minor-modes)
768      (defvar desktop-buffer-point)
769      (defvar desktop-buffer-mark)
770      (defvar desktop-buffer-read-only)
771      (defvar desktop-buffer-misc)
772      (defvar desktop-buffer-locals)
773    )
774    
775  (defun desktop-buffer-info-misc-data ()  (defun desktop-buffer-info-misc-data ()
776    (if (eq major-mode 'Info-mode)    (if (eq major-mode 'Info-mode)
777        (list Info-current-file        (list Info-current-file
778              Info-current-node)))              Info-current-node)))
779    
780    ;; ----------------------------------------------------------------------------
781  (defun desktop-buffer-dired-misc-data ()  (defun desktop-buffer-dired-misc-data ()
782    (if (eq major-mode 'dired-mode)    (when (eq major-mode 'dired-mode)
783        (cons      (eval-when-compile (defvar dirname))
784         (expand-file-name dired-directory)      (cons
785         (cdr        ;; dired directory in portable form
786          (nreverse        (file-name-as-directory (desktop-file-name dired-directory dirname))
787           (mapcar        (cdr (nreverse (mapcar (function car) dired-subdir-alist))))))
           (function car)  
           dired-subdir-alist))))))  
788    
789    ;; ----------------------------------------------------------------------------
790  (defun desktop-buffer-info () "Load an info file."  (defun desktop-buffer-info () "Load an info file."
791    (if (eq 'Info-mode desktop-buffer-major-mode)    (if (eq 'Info-mode desktop-buffer-major-mode)
792        (progn        (progn
# Line 638  to provide correct modes for autoloaded Line 796  to provide correct modes for autoloaded
796            (require 'info)            (require 'info)
797            (Info-find-node first second)            (Info-find-node first second)
798            (current-buffer))))))            (current-buffer))))))
799    
800  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
801    (eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
802  (defun desktop-buffer-rmail () "Load an RMAIL file."  (defun desktop-buffer-rmail () "Load an RMAIL file."
803    (if (eq 'rmail-mode desktop-buffer-major-mode)    (if (eq 'rmail-mode desktop-buffer-major-mode)
804        (condition-case error        (condition-case error
# Line 649  to provide correct modes for autoloaded Line 809  to provide correct modes for autoloaded
809          (file-locked          (file-locked
810           (kill-buffer (current-buffer))           (kill-buffer (current-buffer))
811           'ignored))))           'ignored))))
812    
813  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
814  (defun desktop-buffer-mh () "Load a folder in the mh system."  (defun desktop-buffer-mh () "Load a folder in the mh system."
815    (if (eq 'mh-folder-mode desktop-buffer-major-mode)    (if (eq 'mh-folder-mode desktop-buffer-major-mode)
816        (progn        (progn
817          (require 'mh-e)          (eval-and-compile (require 'mh-e))
818          (mh-find-path)          (mh-find-path)
819          (mh-visit-folder desktop-buffer-name)          (mh-visit-folder desktop-buffer-name)
820          (current-buffer))))          (current-buffer))))
821    
822  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
823  (defun desktop-buffer-dired () "Load a directory using dired."  (defun desktop-buffer-dired () "Load a directory using dired."
824    (if (eq 'dired-mode desktop-buffer-major-mode)    (if (eq 'dired-mode desktop-buffer-major-mode)
# Line 668  to provide correct modes for autoloaded Line 830  to provide correct modes for autoloaded
830          (message "Directory %s no longer exists." (car desktop-buffer-misc))          (message "Directory %s no longer exists." (car desktop-buffer-misc))
831          (sit-for 1)          (sit-for 1)
832          'ignored)))          'ignored)))
833    
834  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
835  (defun desktop-buffer-file () "Load a file."  (defun desktop-buffer-file () "Load a file."
836    (if desktop-buffer-file-name    (if desktop-buffer-file-name
# Line 682  to provide correct modes for autoloaded Line 845  to provide correct modes for autoloaded
845                (error (pop-to-buffer buf)))                (error (pop-to-buffer buf)))
846              buf)              buf)
847          'ignored)))          'ignored)))
848    
849  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
850  ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file  ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
851  ;; only.  ;; only.
852    
853  (defvar desktop-last-buffer nil  (eval-when-compile ; Just to silence the byte compiler
854    "Last buffer read.  Dynamically bound in `desktop-read'.")     (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
855    )
856  (defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name  
857                                    desktop-buffer-major-mode  (defun desktop-create-buffer (
858                                    mim pt mk ro desktop-buffer-misc    desktop-file-version
859                                    &optional locals)    desktop-buffer-file-name
860    (let ((hlist desktop-buffer-handlers)    desktop-buffer-name
861          (result)    desktop-buffer-major-mode
862          (handler))    desktop-buffer-minor-modes
863      (while (and (not result) hlist)    desktop-buffer-point
864        (setq handler (car hlist))    desktop-buffer-mark
865        (setq result (funcall handler))    desktop-buffer-read-only
866        (setq hlist (cdr hlist)))    desktop-buffer-misc
867      (when (bufferp result)    &optional
868        (setq desktop-last-buffer result)    desktop-buffer-locals)
869        (set-buffer result)    ;; To make desktop files with relative file names possible, we cannot
870        (if (not (equal (buffer-name) desktop-buffer-name))    ;; allow `default-directory' to change. Therefore we save current buffer.
871            (rename-buffer desktop-buffer-name))    (save-current-buffer
872        ;; minor modes      (let (
873        (cond ((equal '(t) mim)   (auto-fill-mode 1))     ; backwards compatible        (buffer-list (buffer-list))
874              ((equal '(nil) mim) (auto-fill-mode 0))        (hlist desktop-buffer-handlers)
875              (t (mapcar #'(lambda (minor-mode)        (result)
876                             (when (functionp minor-mode)        (handler)
877                               (funcall minor-mode 1)))      )
878                         mim)))        ;; Call desktop-buffer-handlers to create buffer.
879        (goto-char pt)        (while (and (not result) hlist)
880        (if (consp mk)          (setq handler (car hlist))
881            (progn          (setq result (funcall handler))
882              (set-mark (car mk))          (setq hlist (cdr hlist)))
883              (setq mark-active (car (cdr mk))))        (unless (bufferp result) (setq result nil))
884          (set-mark mk))        (unless (< desktop-file-version 206)
885        ;; Never override file system if the file really is read-only marked.          (when result (setq buffer-list (cons result buffer-list)))
886        (if ro (setq buffer-read-only ro))          (mapcar 'bury-buffer buffer-list))
887        (while locals        (when result
888          (let ((this (car locals)))          (if (< desktop-file-version 206)
889            (if (consp this)            (setq desktop-first-buffer result)
890                ;; an entry of this form `(symbol . value)'            (bury-buffer result))
891                (progn          (unless desktop-first-buffer (setq desktop-first-buffer result))
892                  (make-local-variable (car this))          (set-buffer result)
893                  (set (car this) (cdr this)))          (unless (equal (buffer-name) desktop-buffer-name)
894              ;; an entry of the form `symbol'            (rename-buffer desktop-buffer-name))
895              (make-local-variable this)          ;; minor modes
896              (makunbound this)))          (cond (
897          (setq locals (cdr locals))))))            ;; backwards compatible
898              (equal '(t) desktop-buffer-minor-modes)
899              (auto-fill-mode 1))(
900              (equal '(nil) desktop-buffer-minor-modes)
901              (auto-fill-mode 0))(
902              t
903              (mapcar
904                #'(lambda (minor-mode)
905                  (when (functionp minor-mode) (funcall minor-mode 1)))
906                desktop-buffer-minor-modes)))
907            ;; Even though point and mark are non-nil when written by `desktop-save'
908            ;; they may be modified by mandlers wanting to set point or mark themselves.
909            (when desktop-buffer-point (goto-char desktop-buffer-point))
910            (when desktop-buffer-mark
911              (if (consp desktop-buffer-mark)
912                (progn
913                  (set-mark (car desktop-buffer-mark))
914                  (setq mark-active (car (cdr desktop-buffer-mark))))
915                (set-mark desktop-buffer-mark)))
916            ;; Never override file system if the file really is read-only marked.
917            (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
918            (while desktop-buffer-locals
919              (let ((this (car desktop-buffer-locals)))
920                (if (consp this)
921                  ;; an entry of this form `(symbol . value)'
922                  (progn
923                    (make-local-variable (car this))
924                    (set (car this) (cdr this)))
925                  ;; an entry of the form `symbol'
926                  (make-local-variable this)
927                  (makunbound this)))
928              (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
929    
930    ;; ----------------------------------------------------------------------------
931  ;; Backward compatibility -- update parameters to 205 standards.  ;; Backward compatibility -- update parameters to 205 standards.
932  (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name  (defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
933                         desktop-buffer-major-mode                         desktop-buffer-major-mode
# Line 744  to provide correct modes for autoloaded Line 940  to provide correct modes for autoloaded
940                                 (cons 'case-fold-search cfs)                                 (cons 'case-fold-search cfs)
941                                 (cons 'case-replace cr)                                 (cons 'case-replace cr)
942                                 (cons 'overwrite-mode (car mim)))))                                 (cons 'overwrite-mode (car mim)))))
943                                  
944  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
945    ;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
946  ;; If the user set desktop-enable to t with Custom,  ;; command line, we do the rest of what it takes to use desktop, but do it
947  ;; do the rest of what it takes to use desktop,  ;; after finishing loading the init file.
948  ;; but do it after finishing loading the init file.  ;; We cannot use `command-switch-alist' to process "--no-desktop" because these
949  (add-hook 'after-init-hook  ;; functions are processed after `after-init-hook'.
950            '(lambda ()  (add-hook
951               (when desktop-enable    'after-init-hook
952                 (desktop-load-default)    '(lambda ()
953                 (desktop-read))))      (let ((key "--no-desktop"))
954          (if (member key command-line-args)
955            (delete key command-line-args)
956            (when desktop-enable
957              (desktop-load-default)
958              (desktop-read))))))
959    
960  (provide 'desktop)  (provide 'desktop)
961    

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.51

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26