(desktop-clear-preserve-buffers): New variable.

(desktop-clear): Kill all buffers except internal ones
and those listed in desktop-clear-preserve-buffers.

diff --git a/lisp/desktop.el b/lisp/desktop.el
index cd44f47467c64f49b430c3b0f9a02f94c5af738f..864d9e5bf74842794ceabc78c5477ab1733ef6d8 100644 (file)
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -227,7 +227,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
@@ -235,8 +244,14 @@ the like shorter."
        search-ring-yank-pointer nil
        regexp-search-ring nil
        regexp-search-ring-yank-pointer nil)
-;;;  What a screw!
-;;;  (mapcar (function kill-buffer) (buffer-list))
+  (let ((buffers (buffer-list)))
+    (while buffers
+      (or (member (buffer-name (car buffers)) desktop-clear-preserve-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)