X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/569c754ea9ad31748c47bb4baecba86a41dfd461..85b5a0254674475e1fbd5b51c8ed8b5fa67f3c8e:/lisp/desktop.el

diff --git a/lisp/desktop.el b/lisp/desktop.el
index 19b7dbb916..979f12b3b0 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1,6 +1,6 @@
 ;;; desktop.el --- save partial status of Emacs when killed
 
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
 
 ;; Author: Morten Welinder <terra@diku.dk>
 ;; Keywords: customization
@@ -35,10 +35,9 @@
 ;;		- buffer-read-only
 ;;		- some local variables
 
-;; To use this, first put these three lines in the bottom of your .emacs
+;; To use this, first put these two lines in the bottom of your .emacs
 ;; file (the later the better):
 ;;
-;;	(load "desktop")
 ;;	(desktop-load-default)
 ;;	(desktop-read)
 ;;
@@ -104,15 +103,30 @@
 ;; ----------------------------------------------------------------------------
 ;; USER OPTIONS -- settings you might want to play with.
 ;; ----------------------------------------------------------------------------
-(defconst desktop-basefilename
-  (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-      "emacs.dsk" ; Ms-Dos does not support multiple dots in file name
-    ".emacs.desktop")
-  "File for Emacs desktop, not including the directory name.")
 
-(defvar desktop-missing-file-warning t
+(defgroup desktop nil
+  "Save status of Emacs when you exit."
+  :group 'frames)
+
+(defcustom desktop-enable nil
+  "*Non-nil enable Desktop to save the state of Emacs when you exit."
+  :group 'desktop
+  :type 'boolean
+  :require 'desktop
+  :initialize 'custom-initialize-default
+  :version "20.3")
+
+(defcustom desktop-basefilename
+  (convert-standard-filename ".emacs.desktop")
+  "File for Emacs desktop, not including the directory name."
+  :type 'file
+  :group 'desktop)
+
+(defcustom desktop-missing-file-warning nil
   "*If non-nil then desktop warns when a file no longer exists.
-Otherwise it simply ignores that file.")
+Otherwise it simply ignores that file."
+  :type 'boolean
+  :group 'desktop)
 
 (defvar desktop-globals-to-save
   (list 'desktop-missing-file-warning
@@ -148,25 +162,39 @@ 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 whatnot.
 ;;         TAGS files to save time (tags-file-name is saved instead).
-(defvar desktop-buffers-not-to-save
+(defcustom desktop-buffers-not-to-save
  "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
- "Regexp identifying buffers that are to be excluded from saving.")
+ "Regexp identifying buffers that are to be excluded from saving."
+ :type 'regexp
+ :group 'desktop)
 
 ;; Skip ange-ftp files
-(defvar desktop-files-not-to-save
+(defcustom desktop-files-not-to-save
   "^/[^/:]*:"
-  "Regexp identifying files whose buffers are to be excluded from saving.")
-
-(defvar desktop-buffer-major-mode nil
-  "When desktop creates a buffer, this holds the desired Major mode.")
-
-(defvar desktop-buffer-file-name nil
-  "When desktop creates a buffer, this holds the file name to visit.")
-
-(defvar desktop-buffer-name nil
-  "When desktop creates a buffer, this holds the desired buffer name.")
-
-(defvar desktop-buffer-handlers
+  "Regexp identifying files whose buffers are to be excluded from saving."
+  :type 'regexp
+  :group 'desktop)
+
+(defcustom desktop-buffer-major-mode nil
+  "When desktop creates a buffer, this holds the desired Major mode."
+  :type 'symbol
+  :group 'desktop)
+
+(defcustom desktop-buffer-file-name nil
+  "When desktop creates a buffer, this holds the file name to visit."
+  :type '(choice file (const nil))
+  :group 'desktop)
+
+(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.")
+
+(defcustom desktop-buffer-handlers
   '(desktop-buffer-dired
     desktop-buffer-rmail
     desktop-buffer-mh
@@ -177,14 +205,19 @@ The functions are called without explicit parameters but can use the
 variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
 `desktop-buffer-name'.
 If one function returns non-nil, no further functions are called.
-If the function returns t then the buffer is considered created.")
+If the function returns t then the buffer is considered created."
+  :type '(repeat function)
+  :group 'desktop)
 
 (defvar desktop-create-buffer-form "(desktop-create-buffer 205"
   "Opening of form for creation of new buffers.")
 
-(defvar desktop-save-hook nil
-  "Hook run before saving the desktop to allow you to cut history lists and
-the like shorter.")
+(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)
+
 ;; ----------------------------------------------------------------------------
 (defvar desktop-dirname nil
   "The directory in which the current desktop file resides.")
@@ -197,6 +230,7 @@ the like shorter.")
 
 (defvar desktop-delay-hook nil
   "Hooks run after all buffers are loaded; intended for internal use.")
+
 ;; ----------------------------------------------------------------------------
 (defun desktop-truncate (l n)
   "Truncate LIST to at most N elements destructively."
@@ -204,7 +238,16 @@ the like shorter.")
     (if (consp here)
 	(setcdr here nil))))
 ;; ----------------------------------------------------------------------------
-(defun desktop-clear () "Empty the Desktop."
+(defcustom desktop-clear-preserve-buffers
+  '("*scratch*" "*Messages*")
+  "*Buffer names that `desktop-clear' should not delete."
+  :type '(repeat string)
+  :group 'desktop)
+
+(defun desktop-clear ()
+  "Empty the Desktop.
+This kills all buffers except for internal ones
+and those listed in `desktop-clear-preserve-buffers'."
   (interactive)
   (setq kill-ring nil
 	kill-ring-yank-pointer nil
@@ -212,7 +255,15 @@ the like shorter.")
 	search-ring-yank-pointer nil
 	regexp-search-ring nil
 	regexp-search-ring-yank-pointer nil)
-  (mapcar (function kill-buffer) (buffer-list))
+  (let ((buffers (buffer-list)))
+    (while buffers
+      (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers)
+	  (null (buffer-name (car buffers)))
+	  ;; Don't kill buffers made for internal purposes.
+	  (and (not (equal (buffer-name (car buffers)) ""))
+	       (eq (aref (buffer-name (car buffers)) 0) ?\ ))
+	  (kill-buffer (car buffers)))
+      (setq buffers (cdr buffers))))
   (delete-other-windows))
 ;; ----------------------------------------------------------------------------
 (add-hook 'kill-emacs-hook 'desktop-kill)
@@ -452,6 +503,7 @@ MODE is the major mode."
 	(if (file-exists-p filename)
 	    (delete-file filename)))))
 ;; ----------------------------------------------------------------------------
+;;;###autoload
 (defun desktop-read ()
   "Read the Desktop file and the files it specifies.
 This is a no-op when Emacs is running in batch mode."
@@ -474,6 +526,7 @@ This is a no-op when Emacs is running in batch mode."
 	    (message "Desktop loaded."))
 	(desktop-clear)))))
 ;; ----------------------------------------------------------------------------
+;;;###autoload
 (defun desktop-load-default ()
   "Load the `default' start-up library manually.
 Also inhibit further loading of it.  Call this from your `.emacs' file
@@ -489,13 +542,16 @@ to provide correct modes for autoloaded files."
   (if (eq 'Info-mode desktop-buffer-major-mode)
       (progn
 	(require 'info)
-	(Info-find-node (nth 0 misc) (nth 1 misc))
-	t)))
+	(Info-find-node (nth 0 desktop-buffer-misc) (nth 1 desktop-buffer-misc))
+	(current-buffer))))
 ;; ----------------------------------------------------------------------------
 (defun desktop-buffer-rmail () "Load an RMAIL file."
   (if (eq 'rmail-mode desktop-buffer-major-mode)
       (condition-case error
-	  (progn (rmail-input desktop-buffer-file-name) t)
+	  (progn (rmail-input desktop-buffer-file-name)
+                         (if (eq major-mode 'rmail-mode)
+                             (current-buffer)
+                           rmail-buffer))
 	(file-locked
 	 (kill-buffer (current-buffer))
 	 'ignored))))
@@ -505,17 +561,17 @@ to provide correct modes for autoloaded files."
       (progn
 	(require 'mh-e)
 	(mh-find-path)
-	(mh-visit-folder desktop-buffer-name)
-	t)))
+        (mh-visit-folder desktop-buffer-name)
+	(current-buffer))))
 ;; ----------------------------------------------------------------------------
 (defun desktop-buffer-dired () "Load a directory using dired."
   (if (eq 'dired-mode desktop-buffer-major-mode)
-      (if (file-directory-p (file-name-directory (car misc)))
+      (if (file-directory-p (file-name-directory (car desktop-buffer-misc)))
 	  (progn
-	    (dired (car misc))
-	    (mapcar 'dired-insert-subdir (cdr misc))
-	    t)
-	(message "Directory %s no longer exists." (car misc))
+            (dired (car desktop-buffer-misc))
+	    (mapcar 'dired-insert-subdir (cdr desktop-buffer-misc))
+	    (current-buffer))
+	(message "Directory %s no longer exists." (car desktop-buffer-misc))
 	(sit-for 1)
 	'ignored)))
 ;; ----------------------------------------------------------------------------
@@ -526,14 +582,14 @@ to provide correct modes for autoloaded files."
 		   (y-or-n-p (format
 			      "File \"%s\" no longer exists. Re-create? "
 			      desktop-buffer-file-name))))
-	  (progn (find-file desktop-buffer-file-name) t)
+	  (progn (find-file desktop-buffer-file-name) (current-buffer))
 	'ignored)))
 ;; ----------------------------------------------------------------------------
 ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
 ;; only.
 (defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name
 				  desktop-buffer-major-mode
-				  mim pt mk ro misc &optional locals)
+				  mim pt mk ro desktop-buffer-misc &optional locals)
   (let ((hlist desktop-buffer-handlers)
 	(result)
 	(handler))
@@ -541,44 +597,54 @@ to provide correct modes for autoloaded files."
       (setq handler (car hlist))
       (setq result (funcall handler))
       (setq hlist (cdr hlist)))
-    (if (eq result t)
-	(progn
-	  (if (not (equal (buffer-name) desktop-buffer-name))
-	      (rename-buffer desktop-buffer-name))
-	  (auto-fill-mode (if (nth 0 mim) 1 0))
-	  (goto-char pt)
-	  (if (consp mk)
+    (when (bufferp result)
+      (set-buffer result)
+      (if (not (equal (buffer-name) desktop-buffer-name))
+	  (rename-buffer desktop-buffer-name))
+      (auto-fill-mode (if (nth 0 mim) 1 0))
+      (goto-char pt)
+      (if (consp mk)
+	  (progn
+	    (set-mark (car mk))
+	    (setq mark-active (car (cdr mk))))
+	(set-mark mk))
+      ;; Never override file system if the file really is read-only marked.
+      (if ro (setq buffer-read-only ro))
+      (while locals
+	(let ((this (car locals)))
+	  (if (consp this)
+	      ;; an entry of this form `(symbol . value)'
 	      (progn
-		(set-mark (car mk))
-		(setq mark-active (car (cdr mk))))
-	    (set-mark mk))
-	  ;; Never override file system if the file really is read-only marked.
-	  (if ro (setq buffer-read-only ro))
-	  (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)))
-	  ))))
+		(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 (desktop-buffer-file-name desktop-buffer-name
 		       desktop-buffer-major-mode
-		       mim pt mk ro tl fc cfs cr misc)
+		       mim pt mk ro tl fc cfs cr desktop-buffer-misc)
   (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name
-			 desktop-buffer-major-mode (cdr mim) pt mk ro misc
+			 desktop-buffer-major-mode (cdr mim) pt mk ro
+			 desktop-buffer-misc
 			 (list (cons 'truncate-lines tl)
 			       (cons 'fill-column fc)
 			       (cons 'case-fold-search cfs)
 			       (cons 'case-replace cr)
 			       (cons 'overwrite-mode (car mim)))))
 ;; ----------------------------------------------------------------------------
+
+;; If the user set desktop-enable to t with Custom,
+;; do the rest of what it takes to use desktop,
+;; but do it after finishing loading the init file.
+(add-hook 'after-init-hook
+	  '(lambda ()
+	     (when desktop-enable
+	       (desktop-load-default)
+	       (desktop-read))))
+
 (provide 'desktop)
 
 ;; desktop.el ends here.