(desktop-buffer-mh): New function for mh mail system.

(desktop-buffer-handlers): Add desktop-buffer-mh.
(desktop-buffer): Correct setting of auto-fill-mode.
Make the compilation silent using (eval-when-compile ...)
(old-kill-emacs): New explicit variable (for Emacs 18 comp.)
(desktop-globals-to-save): Add the history rings for interactive searches.
(postv18): Remove.
(desktop-create-buffer-form): New variable.
(desktop-save): Use desktop-create-buffer-form.
(desktop-value-to-string): New function.
(desktop-outvar): Clean-up using desktop-value-to-string.
(desktop-save): clean-up Using desktop-value-to-string.
(desktop-save): Decide Emacs version at compile time.
(desktop-locals-to-save): New variable.
(desktop-truncate): New function.

1 files changed, 157 insertions, 81 deletions

diff --git a/lisp/desktop.el b/lisp/desktop.el
index 66f8417a8cb..7b17c120099 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1993 Free Software Foundation, Inc.
 
 ;; Author: Morten Welinder <terra@diku.dk>
-;; Version: 2.03
+;; Version: 2.05
 ;; Keywords: customization
 ;; Favourite-brand-of-beer: None, I hate beer.
 
@@ -33,10 +33,7 @@
 ;;              - the point
 ;;              - the mark & mark-active
 ;;              - buffer-read-only
-;;              - truncate-lines
-;;              - case-fold-search
-;;              - case-replace
-;;              - fill-column
+;;              - some local variables
 
 ;; To use this, first put these three lines in the bottom of your .emacs
 ;; file (the later the better):
@@ -45,21 +42,46 @@
 ;;      (desktop-load-default)
 ;;      (desktop-read)
 ;;
+;; Between the second and the third line you may wish to add something that
+;; updates the variables `desktop-globals-to-save' and/or 
+;; `desktop-locals-to-save'.  If for instance you want to save the local
+;; variable `foobar' for every buffer in which it is local, you could add
+;; the line
+;;
+;;      (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
+;;
+;; To avoid saving excessive amounts of data you may also with to add 
+;; something like the following
+;;
+;;      (add-hook 'kill-emacs-hook
+;;                '(lambda () 
+;;                   (desktop-truncate search-ring 3)
+;;                   (desktop-truncate regexp-search-ring 3)))
+;;
+;; which will make sure that no more than three search items are saved.  You
+;; must place this line *after* the (load "desktop") line.
 
 ;; Start Emacs in the root directory of your "project". The desktop saver
 ;; is inactive by default.  You activate it by M-x desktop-save RET.  When
 ;; you exit the next time the above data will be saved.  This ensures that
 ;; all the files you were editing will be reloaded the next time you start
 ;; Emacs from the same directory and that points will be set where you
-;; left them.
-;;
+;; left them.  If you save a desktop file in your home directory it will
+;; act as a default desktop when you start Emacs from a directory that 
+;; doesn't have its own.  I never do this, but you may want to.
+
+;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
+;; in your home directory is used for that.  Saving global default values
+;; for buffers is an example of misuse.
+
 ;; PLEASE NOTE: The kill ring can be saved as specified by the variable
 ;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
 ;; things you did not mean to keep.  Use M-x desktop-clear RET.
-;;
-;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)   for useful ideas.
-;;            avk@rtsg.mot.com (Andrew V. Klein)  for a dired tip.
-;;            chris@tecc.co.uk (Chris Boucher)    for a mark tip.
+
+;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)     for useful ideas.
+;;            avk@rtsg.mot.com (Andrew V. Klein)    for a dired tip.
+;;            chris@tecc.co.uk (Chris Boucher)      for a mark tip.
+;;            f89-kam@nada.kth.se (Klas Mellbourn)  for a mh-e tip.
 ;; ---------------------------------------------------------------------------
 ;; TODO:
 ;;
@@ -70,6 +92,15 @@
 
 ;;; Code:
 
+;; Make the compilation more silent
+(eval-when-compile
+  ;; We use functions from these modules
+  (mapcar 'require '(info mh-e dired))
+  ;; We handle auto-fill-hook in a way that is ok.
+  (put 'auto-fill-hook 'byte-obsolete-variable nil)
+  ;; Some things are different in version 18.
+  (setq postv18 (string-lessp "19" emacs-version)))
+;; ----------------------------------------------------------------------------
 ;; USER OPTIONS -- settings you might want to play with.
 ;; ----------------------------------------------------------------------------
 (defconst desktop-basefilename
@@ -85,13 +116,27 @@ Otherwise simply ignore the file.")
 (defvar desktop-globals-to-save
   (list 'desktop-missing-file-warning
         ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
-        ;; 'kill-ring                   
+        ;; 'kill-ring
         'tags-file-name
         'tags-table-list
+        'search-ring
+        'regexp-search-ring
         ;; 'desktop-globals-to-save     ; Itself!
         )
   "List of global variables to save when killing Emacs.")
 
+(defvar desktop-locals-to-save
+  (list 'desktop-locals-to-save         ; Itself!  Think it over.
+        'truncate-lines
+        'case-fold-search
+        'case-replace
+        'fill-column
+        'overwrite-mode
+        'change-log-default-name
+        )
+  "List of local variables to save for each buffer.  The variables are saved
+only when they really are local.")
+
 ;; We skip .log files because they are normally temporary.
 ;;         (ftp) files because they require passwords and whatsnot.
 ;;         TAGS files to save time (tags-file-name is saved instead).
@@ -102,6 +147,7 @@ Otherwise simply ignore the file.")
 (defvar desktop-buffer-handlers
   '(desktop-buffer-dired
     desktop-buffer-rmail
+    desktop-buffer-mh
     desktop-buffer-info
     desktop-buffer-file)
   "*List of functions to call in order to create a buffer.  The functions are
@@ -109,6 +155,9 @@ called without explicit parameters but may access the the major mode as `mam',
 the file name as `fn', the buffer name as `bn', the default directory as
 `dd'.  If some function returns non-nil no further functions are called.
 If the function returns t then the buffer is considered created.")
+
+(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
+  "Opening of form for creation of new buffers.")
 ;; ----------------------------------------------------------------------------
 (defvar desktop-dirname nil
   "The directory in which the current desktop file resides.")
@@ -119,10 +168,12 @@ If the function returns t then the buffer is considered created.")
 ;; --------------------------------------------------------------------------
 " "*Header to place in Desktop file.")
 ;; ----------------------------------------------------------------------------
-(defconst postv18
-  (string-lessp "19" emacs-version)
-  "t if Emacs version 19 or later.")
-
+(defun desktop-truncate (l n)
+  "Truncate LIST to at most N elements destructively."
+  (let ((here (nthcdr (1- n) l)))
+    (if (consp here)
+        (setcdr here nil))))              
+;; ----------------------------------------------------------------------------
 (defun desktop-clear () "Empty the Desktop."
   (interactive)
   (setq kill-ring nil)
@@ -132,11 +183,13 @@ If the function returns t then the buffer is considered created.")
 ;; ----------------------------------------------------------------------------
 ;; This is a bit dirty for version 18 because that version of Emacs was not
 ;; toilet-trained considering hooks.
-(if (not (boundp 'desktop-kill))
-    (if postv18
-        (add-hook 'kill-emacs-hook 'desktop-kill)
-      (setq old-kill-emacs kill-emacs-hook)
-      (setq kill-emacs-hook
+(defvar old-kill-emacs)
+
+(if (eval-when-compile postv18)
+    (add-hook 'kill-emacs-hook 'desktop-kill)
+  (if (not (boundp 'desktop-kill))
+      (setq old-kill-emacs kill-emacs-hook
+            kill-emacs-hook
             (function (lambda ()
                         (progn (desktop-kill)
                                (if (or (null old-kill-emacs)
@@ -149,23 +202,27 @@ If the function returns t then the buffer is considered created.")
       (progn
         (desktop-save desktop-dirname))))
 ;; ----------------------------------------------------------------------------
+(defun desktop-value-to-string (val)
+  (let ((print-escape-newlines t))
+    (concat
+     ;; symbols are needed for cons cells and for symbols except
+     ;; `t' and `nil'.
+     (if (or (consp val)
+             (and (symbolp val) val (not (eq t val))))
+         "'"
+       "")
+     (prin1-to-string val))))
+;; ----------------------------------------------------------------------------
 (defun desktop-outvar (var)
   "Output a setq statement for VAR to the desktop file."
   (if (boundp var)
-      (let ((print-escape-newlines t)
-            (val (symbol-value var)))
-        (insert "(setq ")
-        (prin1 var (current-buffer))
-        ;; symbols are needed for cons cells and for symbols except
-        ;; `t' and `nil'.
-        (if (or (consp val)
-                (and (symbolp val) val (not (eq t val))))
-            (insert " '")
-          (insert " "))
-        (prin1 val (current-buffer))
-        (insert ")\n"))))
+      (insert "(setq "
+              (symbol-name var)
+              " "
+              (desktop-value-to-string (symbol-value var))
+              ")\n")))
 ;; ----------------------------------------------------------------------------
-(defun desktop-save-buffer-p (filename bufname mode)
+(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
   "Return t if the desktop should record a particular buffer for next startup.
 FILENAME is the visited file name, BUFNAME is the buffer name, and
 MODE is the major mode."
@@ -187,35 +244,39 @@ MODE is the major mode."
                               (list
                                (buffer-file-name)
                                (buffer-name)
-                               (list 'quote major-mode)
-                               (list 'quote
-                                     (list overwrite-mode
-                                           (not (null
-                                                 (if postv18
-                                                     auto-fill-function
-                                                   auto-fill-hook)))))
+                               major-mode
+                               (list    ; list explaining minor modes
+                                     (not (null
+                                           (if (eval-when-compile postv18)
+                                               auto-fill-function
+                                             auto-fill-hook))))
                                (point)
-                               (if postv18
-                                   (list 'quote (list (mark t) mark-active))
+                               (if (eval-when-compile postv18)
+                                   (list (mark t) mark-active)
                                  (mark))
                                buffer-read-only
-                               truncate-lines
-                               fill-column
-                               case-fold-search
-                               case-replace
-                               (list
-                                'quote
-                                (cond ((equal major-mode 'Info-mode)
-                                       (list Info-current-file
-                                             Info-current-node))
-                                      ((equal major-mode 'dired-mode)
-                                       (if postv18
-                                           (nreverse
-                                            (mapcar
-                                             (function car)
-                                             dired-subdir-alist))
-                                         (list default-directory)))
-                                      ))
+                               (cond ((eq major-mode 'Info-mode)
+                                      (list Info-current-file
+                                            Info-current-node))
+                                     ((eq major-mode 'dired-mode)
+                                      (if (eval-when-compile postv18)
+                                          (nreverse
+                                           (mapcar
+                                            (function car)
+                                            dired-subdir-alist))
+                                        (list default-directory)))
+                                     )
+                               (let ((locals desktop-locals-to-save)
+                                     (loclist (buffer-local-variables))
+                                     (ll))
+                                 (while locals
+                                   (let ((here (assq (car locals) loclist)))
+                                     (if here
+                                         (setq ll (cons here ll))
+                                       (if (member (car locals) loclist)
+                                           (setq ll (cons (car locals) ll)))))
+                                   (setq locals (cdr locals)))
+                                 ll)
                                )))
                   (buffer-list))))
           (buf (get-buffer-create "*desktop*")))
@@ -237,16 +298,13 @@ MODE is the major mode."
       (let ((print-escape-newlines t))
         (mapcar
          (function (lambda (l)
-                     (if (desktop-save-buffer-p
-                          (car l)
-                          (nth 1 l)
-                          (nth 1 (nth 2 l)))
+                     (if (apply 'desktop-save-buffer-p l)
                          (progn
-                           (insert "(desktop-buffer")
+                           (insert desktop-create-buffer-form)
                            (mapcar
                             (function (lambda (e)
-                                        (insert "\n  ")
-                                        (prin1 e (current-buffer))))
+                                        (insert "\n  "
+                                                (desktop-value-to-string e))))
                             l)
                            (insert ")\n\n")))))
          info))
@@ -280,7 +338,7 @@ MODE is the major mode."
 ;; ----------------------------------------------------------------------------
 (defun desktop-load-default ()
   "Load the `default' start-up library manually.  Also inhibit further loading
-of it.  Call this from your `.emacs' file to provide correct modes for 
+of it.  Call this from your `.emacs' file to provide correct modes for
 autoloaded files."
   (if (not inhibit-default-init)        ; safety check
       (progn
@@ -288,10 +346,9 @@ autoloaded files."
         (setq inhibit-default-init t))))
 ;; ----------------------------------------------------------------------------
 ;; Note: the following functions use the dynamic variable binding in Lisp.
-;;       The byte compiler may therefore complain of undeclared variables.
 ;;
 (defun desktop-buffer-info () "Load an info file."
-  (if (equal 'Info-mode mam)
+  (if (eq 'Info-mode mam)
       (progn
         (require 'info)
         (Info-find-node (nth 0 misc) (nth 1 misc))
@@ -301,6 +358,14 @@ autoloaded files."
   (if (eq 'rmail-mode mam)
       (progn (rmail-input fn) t)))
 ;; ----------------------------------------------------------------------------
+(defun desktop-buffer-mh () "Load a folder in the mh system."
+  (if (eq 'mh-folder-mode mam)
+      (progn
+        (require 'mh-e)
+        (mh-find-path)
+        (mh-visit-folder bn)
+        t)))
+;; ----------------------------------------------------------------------------
 (defun desktop-buffer-dired () "Load a directory using dired."
   (if (eq 'dired-mode mam)
       (progn
@@ -320,7 +385,7 @@ autoloaded files."
 ;; ----------------------------------------------------------------------------
 ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
 ;; only.
-(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
+(defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals)
   (let ((hlist desktop-buffer-handlers)
         (result)
         (handler))
@@ -332,12 +397,7 @@ autoloaded files."
         (progn
           (if (not (equal (buffer-name) bn))
               (rename-buffer bn))
-          (if (nth 0 mim)
-              (overwrite-mode 1)
-            (overwrite-mode 0))
-          (if (nth 1 mim)
-              (auto-fill-mode 1)
-            (overwrite-mode 0))
+          (auto-fill-mode (if (nth 0 mim) 1 0))
           (goto-char pt)
           (if (consp mk)
               (progn
@@ -346,11 +406,27 @@ autoloaded files."
             (set-mark mk))
           ;; Never override file system if the file really is read-only marked.
           (if ro (setq buffer-read-only ro))
-          (setq truncate-lines tl)
-          (setq fill-column fc)
-          (setq case-fold-search cfs)
-          (setq case-replace cr)
+          (while locals
+            (let ((this (car locals)))
+              (if (consp this)
+                  ;; an entry of this form `(symbol . value)'
+                  (progn
+                    (make-local-variable (car this))
+                    (set (car this) (cdr this)))
+                ;; an entry of the form `symbol'
+                (make-local-variable this)
+                (makunbound this)))
+            (setq locals (cdr locals)))
           ))))
+
+;; Backward compatibility -- update parameters to 205 standards.
+(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
+  (desktop-create-buffer 205 fn bn mam (cdr mim) pt mk ro misc
+                         (list (cons 'truncate-lines tl)
+                               (cons 'fill-column fc)
+                               (cons 'case-fold-search cfs)
+                               (cons 'case-replace cr)
+                               (cons 'overwrite-mode (car mim)))))
 ;; ----------------------------------------------------------------------------
 (provide 'desktop)