changeset 5465:9fcfca1caec7

(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.

--- a/lisp/desktop.el	Thu Jan 06 09:59:12 1994 +0000
+++ b/lisp/desktop.el	Thu Jan 06 11:34:51 1994 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1993 Free Software Foundation, Inc.
 
 ;; Author: Morten Welinder <[e-mail]>
-;; 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  [e-mail] (Jim Hetrick)   for useful ideas.
-;;            [e-mail] (Andrew V. Klein)  for a dired tip.
-;;            [e-mail] (Chris Boucher)    for a mark tip.
+
+;; Thanks to  [e-mail] (Jim Hetrick)     for useful ideas.
+;;            [e-mail] (Andrew V. Klein)    for a dired tip.
+;;            [e-mail] (Chris Boucher)      for a mark tip.
+;;            [e-mail] (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 @@
 (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 @@
 (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 @@
 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 @@
 ;; --------------------------------------------------------------------------
 " "*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 @@
 ;; ----------------------------------------------------------------------------
 ;; 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 @@
       (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 @@
 			      (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 @@
       (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 @@
 ;; ----------------------------------------------------------------------------
 (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 @@
 	(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 @@
   (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 @@
 ;; ----------------------------------------------------------------------------
 ;; 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 @@
 	(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 @@
 	    (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)