desktop.el 12.1 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2 3 4 5
;;; desktop.el --- save partial status of Emacs when killed

;; Copyright (C) 1993 Free Software Foundation, Inc.

;; Author: Morten Welinder <terra@diku.dk>
6
;; Version: 2.02
Richard M. Stallman's avatar
Richard M. Stallman committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

;; 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:

26 27 28 29 30 31 32 33 34 35 36 37
;; 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 & mark-active
;;		- buffer-read-only
;;		- truncate-lines
;;		- case-fold-search
;;		- case-replace
;;		- fill-column
Richard M. Stallman's avatar
Richard M. Stallman committed
38

39 40 41 42 43 44 45
;; 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)
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
46

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
;; 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: 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  hetrick@phys.uva.nl (Jim Hetrick)   for useful ideas.
;;            avk@rtsg.mot.com (Andrew V. Klein)  for a dired tip.
;;            chris@tecc.co.uk (Chris Boucher)    for a mark tip.
;; ---------------------------------------------------------------------------
;; TODO:
;;
;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
;; Start-up with buffer-menu???
Richard M. Stallman's avatar
Richard M. Stallman committed
68 69 70

;;; Code:

71 72 73
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
(defconst desktop-basefilename
Richard M. Stallman's avatar
Richard M. Stallman committed
74 75 76 77 78
  (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.")

79
(defvar desktop-missing-file-warning t
Richard M. Stallman's avatar
Richard M. Stallman committed
80 81 82
  "*If non-nil then issue warning if a file no longer exists.
Otherwise simply ignore the file.")

83
(defvar desktop-globals-to-save
Richard M. Stallman's avatar
Richard M. Stallman committed
84
  (list 'desktop-missing-file-warning
85 86 87 88 89 90
	;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
	;; 'kill-ring			
	'tags-file-name
	'tags-table-list
	;; 'desktop-globals-to-save	; Itself!
	) 
Richard M. Stallman's avatar
Richard M. Stallman committed
91 92
  "List of global variables to save when killing Emacs.")

93 94 95
;; 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).
Richard M. Stallman's avatar
Richard M. Stallman committed
96
(defvar desktop-buffers-not-to-save
97
 "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
Richard M. Stallman's avatar
Richard M. Stallman committed
98 99 100
 "Regexp identifying buffers that are to be excluded from saving.")

(defvar desktop-buffer-handlers
101
  '(desktop-buffer-dired
Richard M. Stallman's avatar
Richard M. Stallman committed
102 103 104
    desktop-buffer-rmail
    desktop-buffer-info
    desktop-buffer-file)
105 106 107 108
  "*List of functions to call in order to create a buffer.  The functions are
called without explicit 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
109
If the function returns t then the buffer is considered created.")
110 111
;; ----------------------------------------------------------------------------
(defvar desktop-dirname nil
Richard M. Stallman's avatar
Richard M. Stallman committed
112 113 114
  "The directory in which the current desktop file resides.")

(defconst desktop-header
115 116 117
";; --------------------------------------------------------------------------
;; Desktop File for Emacs
;; --------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
118
" "*Header to place in Desktop file.")
119 120
;; ----------------------------------------------------------------------------
(defconst postv18
Richard M. Stallman's avatar
Richard M. Stallman committed
121
  (string-lessp "19" emacs-version)
122
  "t if Emacs version 19 or later.")
Richard M. Stallman's avatar
Richard M. Stallman committed
123 124 125 126 127 128

(defun desktop-clear () "Empty the Desktop."
  (interactive)
  (setq kill-ring nil)
  (setq kill-ring-yank-pointer nil)
  (mapcar (function kill-buffer) (buffer-list)))
129 130 131
;; ----------------------------------------------------------------------------
;; This is a bit dirty for version 18 because that version of Emacs was not
;; toilet-trained considering hooks.
Richard M. Stallman's avatar
Richard M. Stallman committed
132 133 134 135
(if (not (boundp 'desktop-kill))
    (if postv18
	(add-hook 'kill-emacs-hook 'desktop-kill)
      (setq old-kill-emacs kill-emacs-hook)
136 137 138 139 140 141 142 143
      (setq kill-emacs-hook
	    (function (lambda ()
			(progn (desktop-kill)
			       (if (or (null old-kill-emacs)
				       (symbolp old-kill-emacs))
				   (run-hooks old-kill-emacs)
				 (funcall old-kill-emacs))))))))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
144
(defun desktop-kill ()
145
  (if desktop-dirname
Richard M. Stallman's avatar
Richard M. Stallman committed
146 147
      (progn
	(desktop-save desktop-dirname))))
148
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
149 150 151 152 153 154 155 156 157
(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"))))
158
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
159 160
(defun desktop-save-buffer-p (filename bufname mode)
  "Return t if should record a particular buffer for next startup.
161
FILENAME is the visited file name, BUFNAME is the buffer name, and
Richard M. Stallman's avatar
Richard M. Stallman committed
162
MODE is the major mode."
163

Richard M. Stallman's avatar
Richard M. Stallman committed
164 165 166 167
  (or (and filename
	   (not (string-match desktop-buffers-not-to-save bufname)))
      (and (null filename)
	   (memq mode '(Info-mode dired-mode rmail-mode)))))
168
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
169 170 171 172
(defun desktop-save (dirname)
  "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
  (interactive "DDirectory to save desktop file in: ")
  (save-excursion
173
    (let ((filename (expand-file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
174
		     (concat dirname desktop-basefilename)))
175 176
	  (info (nreverse
		 (mapcar
Richard M. Stallman's avatar
Richard M. Stallman committed
177 178
		  (function (lambda (b)
			      (set-buffer b)
179
			      (list
Richard M. Stallman's avatar
Richard M. Stallman committed
180 181 182 183
			       (buffer-file-name)
			       (buffer-name)
			       (list 'quote major-mode)
			       (list 'quote
184 185
				     (list overwrite-mode
					   (not (null
Richard M. Stallman's avatar
Richard M. Stallman committed
186 187 188 189 190
						 (if postv18
						     auto-fill-function
						   auto-fill-hook)))))
			       (point)
			       (if postv18
191
				   (list 'quote (mark t) mark-active)
Richard M. Stallman's avatar
Richard M. Stallman committed
192 193 194 195 196 197
				 (mark))
			       buffer-read-only
			       truncate-lines
			       fill-column
			       case-fold-search
			       case-replace
198
			       (list
Richard M. Stallman's avatar
Richard M. Stallman committed
199 200 201 202 203
				'quote
				(cond ((equal major-mode 'Info-mode)
				       (list Info-current-file
					     Info-current-node))
				      ((equal major-mode 'dired-mode)
204 205 206 207 208 209
				       (if postv18
					   (nreverse
					    (mapcar
					     (function car)
					     dired-subdir-alist))
					 (list default-directory)))
Richard M. Stallman's avatar
Richard M. Stallman committed
210 211 212 213 214 215 216
				      ))
			       )))
		  (buffer-list))))
	  (buf (get-buffer-create "*desktop*")))
      (set-buffer buf)
      (erase-buffer)

217 218 219 220
      (insert desktop-header
	      ";; Created " (current-time-string) "\n"
	      ";; Emacs version " emacs-version "\n\n"
	      ";; Global section:\n")
Richard M. Stallman's avatar
Richard M. Stallman committed
221 222
      (mapcar (function desktop-outvar) desktop-globals-to-save)
      (if (memq 'kill-ring desktop-globals-to-save)
223 224
	  (insert "(setq kill-ring-yank-pointer (nthcdr "
		  (int-to-string
Richard M. Stallman's avatar
Richard M. Stallman committed
225 226 227
		   (- (length kill-ring) (length kill-ring-yank-pointer)))
		  " kill-ring))\n"))

228 229
      (insert "\n;; Buffer section:\n")
      (mapcar
Richard M. Stallman's avatar
Richard M. Stallman committed
230
       (function (lambda (l)
231 232
		   (if (desktop-save-buffer-p
			(car l)
Richard M. Stallman's avatar
Richard M. Stallman committed
233 234 235 236
			(nth 1 l)
			(nth 1 (nth 2 l)))
		       (progn
			 (insert "(desktop-buffer")
237
			 (mapcar
Richard M. Stallman's avatar
Richard M. Stallman committed
238 239 240 241 242 243 244 245 246 247
			  (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))
248
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
249 250 251 252 253 254 255
(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))))
256
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
257 258 259 260 261 262 263 264 265 266 267 268 269 270
(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))))
271
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
272
(defun desktop-load-default ()
273 274 275 276
  "Load the `default' start-up library manually.  Also inhibit further loading
of it.  Call this from your `.emacs' file to provide correct modes for 
autoloaded files."
  (if (not inhibit-default-init)	; safety check
Richard M. Stallman's avatar
Richard M. Stallman committed
277 278 279
      (progn
	(load "default" t t)
	(setq inhibit-default-init t))))
280 281 282 283
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;       The byte compiler may therefore complain of undeclared variables.
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
284 285 286 287 288 289
(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)))
290
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292 293
(defun desktop-buffer-rmail () "Load a RMAIL file."
  (if (equal 'rmail-mode mam)
      (progn (rmail-input fn) t)))
294
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
295 296
(defun desktop-buffer-dired () "Load a directory using dired."
  (if (equal 'dired-mode mam)
297 298 299 300 301
      (progn
	(dired (car misc))
	(mapcar (function dired-maybe-insert-subdir) (cdr misc))
	t)))
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
302 303 304 305
(defun desktop-buffer-file () "Load a file."
  (if fn
      (if (or (file-exists-p fn)
	      (and desktop-missing-file-warning
306 307
		   (y-or-n-p (format
			      "File \"%s\" no longer exists. Re-create? "
Richard M. Stallman's avatar
Richard M. Stallman committed
308 309 310
			      fn))))
	  (progn (find-file fn) t)
	'ignored)))
311 312
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332
;; 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)
333 334 335 336 337 338 339
	  (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))
Richard M. Stallman's avatar
Richard M. Stallman committed
340 341 342 343 344
	  (setq truncate-lines tl)
	  (setq fill-column fc)
	  (setq case-fold-search cfs)
	  (setq case-replace cr)
	  ))))
345
;; ----------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
346
(provide 'desktop)
Richard M. Stallman's avatar
Richard M. Stallman committed
347 348

;; desktop.el ends here.
349