Initial revision

1 files changed, 344 insertions, 0 deletions

diff --git a/lisp/desktop.el b/lisp/desktop.el
new file mode 100644
index 00000000000..9441645c777
--- /dev/null
+++ b/lisp/desktop.el
@@ -0,0 +1,344 @@
+;;; desktop.el --- save partial status of Emacs when killed
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Morten Welinder <terra@diku.dk>
+;; Version: 2.01
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+; Save the Desktop, i.e.,
+;       - some global variables
+;       - the list of buffers with associated files. For each buffer also
+;               - the major mode
+;               - the default directory
+;               - the point
+;               - the mark
+;               - buffer-read-only
+;               - truncate-lines
+;               - case-fold-search
+;               - case-replace
+;               - fill-column
+
+; To use this, first put these three lines in the bottom of your .emacs 
+; file (the later the better):
+;
+;       (load "desktop")
+;       (desktop-load-default)
+;       (desktop-read)
+;
+
+; 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.
+;
+; PLEASE NOTE: When the kill ring is 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.
+; ---------------------------------------------------------------------------
+; HISTORY:
+;
+; Dec   , 1992: Version 1.0 written; never released.
+; Jan   , 1993: Minor modes now saved: auto-fill-mode, overwrite-mode.
+; Apr 26, 1993: Version 1.1 released.
+; Apr 29, 1993: Now supports RMAIL, Info, and dired modes.
+;               Will now search home directory for desktop file.
+;               desktop-save asks for directory to save in.
+; May 31, 1993: Version 1.3
+;               Now works with Emacs 19.
+; Jun  1, 1993: Minor bug fix.
+;
+; TODO:
+;
+; Save window configuration.
+; Recognize more minor modes.
+; Save mark rings.
+; Start-up with buffer-menu???
+
+;;; Code:
+
+; USER OPTIONS -- settings you might want to play with.
+; -----------------------------------------------------------------------------
+(defconst desktop-basefilename 
+  (if (equal system-type 'ms-dos)
+      "emacs.dsk" ; Ms-Dos does not support multiple dots in file name
+    ".emacs.desktop")
+  "File for Emacs desktop.  A directory name will be prepended to this name.")
+
+(defvar desktop-missing-file-warning t 
+  "*If non-nil then issue warning if a file no longer exists.
+Otherwise simply ignore the file.")
+
+(defvar desktop-globals-to-save 
+  (list 'desktop-missing-file-warning
+        ; 'kill-ring ; Feature: Also saves kill-ring-yank-pointer
+        'desktop-globals-to-save) ; Itself!
+  "List of global variables to save when killing Emacs.")
+
+(defvar desktop-buffers-not-to-save
+ "\\(\\.log\\|(ftp)\\)$"
+ "Regexp identifying buffers that are to be excluded from saving.")
+
+(defvar desktop-buffer-handlers
+  '(desktop-buffer-dired 
+    desktop-buffer-rmail
+    desktop-buffer-info
+    desktop-buffer-file)
+  "*List of functions to call in order to create a buffer.
+The functions are called without 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-dirname nil 
+  "The directory in which the current desktop file resides.")
+
+(defconst desktop-header
+"; ---------------------------------------------------------------------------
+; Desktop File for Emacs
+; ---------------------------------------------------------------------------
+" "*Header to place in Desktop file.")
+; ---------------------------------------------------------------------------
+(defconst postv18 
+  (string-lessp "19" emacs-version)
+  "t is Emacs version 19 or later.")
+
+(defun desktop-clear () "Empty the Desktop."
+  (interactive)
+  (setq kill-ring nil)
+  (setq kill-ring-yank-pointer nil)
+  (mapcar (function kill-buffer) (buffer-list)))
+; ---------------------------------------------------------------------------
+(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 
+            (function (lambda () (progn (desktop-kill)
+                                        (run-hooks old-kill-emacs)))))))
+; ---------------------------------------------------------------------------
+(defun desktop-kill ()
+  (if desktop-dirname 
+      (progn
+        (desktop-save desktop-dirname))))
+
+;(defun kill-emacs (&optional query)
+;  "End this Emacs session.
+;Prefix ARG or optional first ARG non-nil means exit with no questions asked,
+;even if there are unsaved buffers.  If Emacs is running non-interactively
+;and ARG is an integer, then Emacs exits with ARG as its exit code.
+;
+;If the variable `desktop-dirname' is non-nil,
+;the function desktop-save will be called first."
+;  (interactive "P")
+;  (if desktop-dirname (desktop-save desktop-dirname))
+;  (original-kill-emacs query))
+; ---------------------------------------------------------------------------
+(defun desktop-outvar (VAR)
+  "Output a setq statement for VAR to the desktop file."
+  (if (boundp VAR)
+      (progn
+        (insert "(setq ")
+        (prin1 VAR (current-buffer))
+        (insert " '")
+        (prin1 (symbol-value VAR) (current-buffer))
+        (insert ")\n"))))
+; ---------------------------------------------------------------------------
+(defun desktop-save-buffer-p (filename bufname mode)
+  "Return t if 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."
+  
+  (or (and filename
+           (not (string-match desktop-buffers-not-to-save bufname)))
+      (and (null filename)
+           (memq mode '(Info-mode dired-mode rmail-mode)))))
+; ---------------------------------------------------------------------------
+(defun desktop-save (dirname)
+  "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
+  (interactive "DDirectory to save desktop file in: ")
+  (save-excursion
+    (let ((filename (expand-file-name 
+                     (concat dirname desktop-basefilename)))
+          (info (nreverse 
+                 (mapcar 
+                  (function (lambda (b)
+                              (set-buffer b)
+                              (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)))))
+                               (point)
+                               (if postv18
+                                   (mark t)
+                                 (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)
+                                       (list default-directory))
+                                      ))
+                               )))
+                  (buffer-list))))
+          (buf (get-buffer-create "*desktop*")))
+      (set-buffer buf)
+      (erase-buffer)
+
+      (insert desktop-header 
+              "; Created " (current-time-string) "\n"
+              "; Emacs version " emacs-version "\n\n"
+              "; Global section:\n")
+      (mapcar (function desktop-outvar) desktop-globals-to-save)
+      (if (memq 'kill-ring desktop-globals-to-save)
+          (insert "(setq kill-ring-yank-pointer (nthcdr " 
+                  (int-to-string 
+                   (- (length kill-ring) (length kill-ring-yank-pointer)))
+                  " kill-ring))\n"))
+
+      (insert "\n; Buffer section:\n")
+      (mapcar 
+       (function (lambda (l)
+                   (if (desktop-save-buffer-p 
+                        (car l) 
+                        (nth 1 l)
+                        (nth 1 (nth 2 l)))
+                       (progn
+                         (insert "(desktop-buffer")
+                         (mapcar 
+                          (function (lambda (e)
+                                      (insert "\n  ")
+                                      (prin1 e (current-buffer))))
+                          l)
+                         (insert ")\n\n")))))
+       info)
+      (setq default-directory dirname)
+      (if (file-exists-p filename) (delete-file filename))
+      (write-region (point-min) (point-max) filename nil 'nomessage)))
+  (setq desktop-dirname dirname))
+; ---------------------------------------------------------------------------
+(defun desktop-remove ()
+  "Delete the Desktop file and inactivate the desktop system."
+  (interactive)
+  (if desktop-dirname
+      (let ((filename (concat desktop-dirname desktop-basefilename)))
+        (if (file-exists-p filename) (delete-file filename))
+        (setq desktop-dirname nil))))
+; ---------------------------------------------------------------------------
+(defun desktop-read ()
+  "Read the Desktop file and the files it specifies."
+  (interactive)
+  (let ((filename))
+    (if (file-exists-p (concat "./" desktop-basefilename))
+        (setq desktop-dirname (expand-file-name "./"))
+      (if (file-exists-p (concat "~/" desktop-basefilename))
+          (setq desktop-dirname (expand-file-name "~/"))
+        (setq desktop-dirname nil)))
+    (if desktop-dirname
+        (progn
+          (load (concat desktop-dirname desktop-basefilename) t t t)
+          (message "Desktop loaded."))
+      (desktop-clear))))
+; ---------------------------------------------------------------------------
+(defun desktop-load-default ()
+  "Load the `default' start-up library manually.
+Also inhibit further loading of it.
+Call this from your `.emacs' file
+provide correct modes for autoloaded files."
+  (if (not inhibit-default-init)
+      (progn
+        (load "default" t t)
+        (setq inhibit-default-init t))))
+; ---------------------------------------------------------------------------
+(defun desktop-buffer-info () "Load an info file."
+  (if (equal 'Info-mode mam)
+      (progn
+        (require 'info)
+        (Info-find-node (nth 0 misc) (nth 1 misc))
+        t)))
+; ---------------------------------------------------------------------------
+(defun desktop-buffer-rmail () "Load a RMAIL file."
+  (if (equal 'rmail-mode mam)
+      (progn (rmail-input fn) t)))
+; ---------------------------------------------------------------------------
+(defun desktop-buffer-dired () "Load a directory using dired."
+  (if (equal 'dired-mode mam)
+      (progn (dired (nth 0 misc)) t)))
+; ---------------------------------------------------------------------------
+(defun desktop-buffer-file () "Load a file."
+  (if fn
+      (if (or (file-exists-p fn)
+              (and desktop-missing-file-warning
+                   (y-or-n-p (format 
+                              "File \"%s\" no longer exists. Re-create? " 
+                              fn))))
+          (progn (find-file fn) t)
+        'ignored)))
+; ---------------------------------------------------------------------------
+;;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)
+  (let ((hlist desktop-buffer-handlers)
+        (result)
+        (handler))
+    (while (and (not result) hlist)
+      (setq handler (car hlist))
+      (setq result (funcall handler))
+      (setq hlist (cdr hlist)))
+    (if (equal result t)
+        (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))
+          (goto-char pt)
+          (set-mark mk)
+          (setq buffer-read-only ro)
+          (setq truncate-lines tl)
+          (setq fill-column fc)
+          (setq case-fold-search cfs)
+          (setq case-replace cr)
+          ))))
+; ---------------------------------------------------------------------------
+
+
+
+;; desktop.el ends here.