Initial revision

lisp/desktop.el

+;;; 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.