]> git.eshelyaron.com Git - emacs.git/commitdiff
(desktop-buffer-mh): New function for mh mail system.
authorRichard M. Stallman <rms@gnu.org>
Thu, 6 Jan 1994 11:34:51 +0000 (11:34 +0000)
committerRichard M. Stallman <rms@gnu.org>
Thu, 6 Jan 1994 11:34:51 +0000 (11:34 +0000)
(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.

lisp/desktop.el

index 66f8417a8cba4dcb827446e1b281051070c5408f..7b17c1200994493552aea160a1b8e6d43f82203d 100644 (file)
@@ -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.
 
 ;;             - 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):
 ;;     (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:
 ;;
 
 ;;; 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)