mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity

(desktop-buffer-mh): New function for mh mail system.

Browse Source 
(desktop-buffer-handlers): Add desktop-buffer-mh.
(desktop-buffer): Correct setting of auto-fill-mode.
Make the compilation silent using (eval-when-compile ...)
(old-kill-emacs): New explicit variable (for Emacs 18 comp.)
(desktop-globals-to-save): Add the history rings for interactive searches.
(postv18): Remove.
(desktop-create-buffer-form): New variable.
(desktop-save): Use desktop-create-buffer-form.
(desktop-value-to-string): New function.
(desktop-outvar): Clean-up using desktop-value-to-string.
(desktop-save): clean-up Using desktop-value-to-string.
(desktop-save): Decide Emacs version at compile time.
(desktop-locals-to-save): New variable.
(desktop-truncate): New function.
This commit is contained in:
Richard M. Stallman 1994-01-06 11:34:51 +00:00
parent 531b2a2817
commit ec4c6f225a
1 changed files with 157 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
lisp/desktop.el
View File

@ -3,7 +3,7 @@
;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Version: 2.03
;; Version: 2.05
;; Keywords: customization
;; Favourite-brand-of-beer: None, I hate beer.
@ -33,10 +33,7 @@
;; - the point
;; - the mark & mark-active
;; - buffer-read-only
;; - truncate-lines
;; - case-fold-search
;; - case-replace
;; - fill-column
;; - some local variables
;; To use this, first put these three lines in the bottom of your .emacs
;; file (the later the better):
@ -45,21 +42,46 @@
;; (desktop-load-default)
;; (desktop-read)
;;
;; Between the second and the third line you may wish to add something that
;; updates the variables `desktop-globals-to-save' and/or
;; `desktop-locals-to-save'. If for instance you want to save the local
;; variable `foobar' for every buffer in which it is local, you could add
;; the line
;;
;; (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
;;
;; To avoid saving excessive amounts of data you may also with to add
;; something like the following
;;
;; (add-hook 'kill-emacs-hook
;; '(lambda ()
;; (desktop-truncate search-ring 3)
;; (desktop-truncate regexp-search-ring 3)))
;;
;; which will make sure that no more than three search items are saved. You
;; must place this line *after* the (load "desktop") line.
;; 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.
;;
;; left them. If you save a desktop file in your home directory it will
;; act as a default desktop when you start Emacs from a directory that
;; doesn't have its own. I never do this, but you may want to.
;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
;; in your home directory is used for that. Saving global default values
;; for buffers is an example of misuse.
;; 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.
;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip.
;; ---------------------------------------------------------------------------
;; TODO:
;;
@ -70,6 +92,15 @@
;;; Code:
;; Make the compilation more silent
(eval-when-compile
;; We use functions from these modules
(mapcar 'require '(info mh-e dired))
;; We handle auto-fill-hook in a way that is ok.
(put 'auto-fill-hook 'byte-obsolete-variable nil)
;; Some things are different in version 18.
(setq postv18 (string-lessp "19" emacs-version)))
;; ----------------------------------------------------------------------------
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
(defconst desktop-basefilename
@ -88,10 +119,24 @@ Otherwise simply ignore the file.")
;; 'kill-ring
'tags-file-name
'tags-table-list
'search-ring
'regexp-search-ring
;; 'desktop-globals-to-save ; Itself!
)
"List of global variables to save when killing Emacs.")
(defvar desktop-locals-to-save
(list 'desktop-locals-to-save ; Itself! Think it over.
'truncate-lines
'case-fold-search
'case-replace
'fill-column
'overwrite-mode
'change-log-default-name
)
"List of local variables to save for each buffer. 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 whatsnot.
;; TAGS files to save time (tags-file-name is saved instead).
@ -102,6 +147,7 @@ Otherwise simply ignore the file.")
(defvar desktop-buffer-handlers
'(desktop-buffer-dired
desktop-buffer-rmail
desktop-buffer-mh
desktop-buffer-info
desktop-buffer-file)
"*List of functions to call in order to create a buffer. The functions are
@ -109,6 +155,9 @@ 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.
If the function returns t then the buffer is considered created.")
(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
"Opening of form for creation of new buffers.")
;; ----------------------------------------------------------------------------
(defvar desktop-dirname nil
"The directory in which the current desktop file resides.")
@ -119,10 +168,12 @@ If the function returns t then the buffer is considered created.")
;; --------------------------------------------------------------------------
" "*Header to place in Desktop file.")
;; ----------------------------------------------------------------------------
(defconst postv18
(string-lessp "19" emacs-version)
"t if Emacs version 19 or later.")
(defun desktop-truncate (l n)
"Truncate LIST to at most N elements destructively."
(let ((here (nthcdr (1- n) l)))
(if (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
(defun desktop-clear () "Empty the Desktop."
(interactive)
(setq kill-ring nil)
@ -132,11 +183,13 @@ If the function returns t then the buffer is considered created.")
;; ----------------------------------------------------------------------------
;; This is a bit dirty for version 18 because that version of Emacs was not
;; toilet-trained considering hooks.
(if (not (boundp 'desktop-kill))
(if postv18
(defvar old-kill-emacs)
(if (eval-when-compile postv18)
(add-hook 'kill-emacs-hook 'desktop-kill)
(setq old-kill-emacs kill-emacs-hook)
(setq kill-emacs-hook
(if (not (boundp 'desktop-kill))
(setq old-kill-emacs kill-emacs-hook
kill-emacs-hook
(function (lambda ()
(progn (desktop-kill)
(if (or (null old-kill-emacs)
@ -149,23 +202,27 @@ If the function returns t then the buffer is considered created.")
(progn
(desktop-save desktop-dirname))))
;; ----------------------------------------------------------------------------
(defun desktop-outvar (var)
"Output a setq statement for VAR to the desktop file."
(if (boundp var)
(let ((print-escape-newlines t)
(val (symbol-value var)))
(insert "(setq ")
(prin1 var (current-buffer))
(defun desktop-value-to-string (val)
(let ((print-escape-newlines t))
(concat
;; symbols are needed for cons cells and for symbols except
;; `t' and `nil'.
(if (or (consp val)
(and (symbolp val) val (not (eq t val))))
(insert " '")
(insert " "))
(prin1 val (current-buffer))
(insert ")\n"))))
"'"
"")
(prin1-to-string val))))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode)
(defun desktop-outvar (var)
"Output a setq statement for VAR to the desktop file."
(if (boundp var)
(insert "(setq "
(symbol-name var)
" "
(desktop-value-to-string (symbol-value var))
")\n")))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
"Return t if the desktop 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."
@ -187,35 +244,39 @@ MODE is the major mode."
(list
(buffer-file-name)
(buffer-name)
(list 'quote major-mode)
(list 'quote
(list overwrite-mode
major-mode
(list ; list explaining minor modes
(not (null
(if postv18
(if (eval-when-compile postv18)
auto-fill-function
auto-fill-hook)))))
auto-fill-hook))))
(point)
(if postv18
(list 'quote (list (mark t) mark-active))
(if (eval-when-compile postv18)
(list (mark t) mark-active)
(mark))
buffer-read-only
truncate-lines
fill-column
case-fold-search
case-replace
(list
'quote
(cond ((equal major-mode 'Info-mode)
(cond ((eq major-mode 'Info-mode)
(list Info-current-file
Info-current-node))
((equal major-mode 'dired-mode)
(if postv18
((eq major-mode 'dired-mode)
(if (eval-when-compile postv18)
(nreverse
(mapcar
(function car)
dired-subdir-alist))
(list default-directory)))
))
)
(let ((locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll))
(while locals
(let ((here (assq (car locals) loclist)))
(if here
(setq ll (cons here ll))
(if (member (car locals) loclist)
(setq ll (cons (car locals) ll)))))
(setq locals (cdr locals)))
ll)
)))
(buffer-list))))
(buf (get-buffer-create "*desktop*")))
@ -237,16 +298,13 @@ MODE is the major mode."
(let ((print-escape-newlines t))
(mapcar
(function (lambda (l)
(if (desktop-save-buffer-p
(car l)
(nth 1 l)
(nth 1 (nth 2 l)))
(if (apply 'desktop-save-buffer-p l)
(progn
(insert "(desktop-buffer")
(insert desktop-create-buffer-form)
(mapcar
(function (lambda (e)
(insert "\n ")
(prin1 e (current-buffer))))
(insert "\n "
(desktop-value-to-string e))))
l)
(insert ")\n\n")))))
info))
@ -288,10 +346,9 @@ autoloaded files."
(setq inhibit-default-init t))))
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;; The byte compiler may therefore complain of undeclared variables.
;;
(defun desktop-buffer-info () "Load an info file."
(if (equal 'Info-mode mam)
(if (eq 'Info-mode mam)
(progn
(require 'info)
(Info-find-node (nth 0 misc) (nth 1 misc))
@ -301,6 +358,14 @@ autoloaded files."
(if (eq 'rmail-mode mam)
(progn (rmail-input fn) t)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-mh () "Load a folder in the mh system."
(if (eq 'mh-folder-mode mam)
(progn
(require 'mh-e)
(mh-find-path)
(mh-visit-folder bn)
t)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired () "Load a directory using dired."
(if (eq 'dired-mode mam)
(progn
@ -320,7 +385,7 @@ autoloaded files."
;; ----------------------------------------------------------------------------
;; 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)
(defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals)
(let ((hlist desktop-buffer-handlers)
(result)
(handler))
@ -332,12 +397,7 @@ autoloaded files."
(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))
(auto-fill-mode (if (nth 0 mim) 1 0))
(goto-char pt)
(if (consp mk)
(progn
@ -346,11 +406,27 @@ autoloaded files."
(set-mark mk))
;; Never override file system if the file really is read-only marked.
(if ro (setq buffer-read-only ro))
(setq truncate-lines tl)
(setq fill-column fc)
(setq case-fold-search cfs)
(setq case-replace cr)
(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)))
))))
;; Backward compatibility -- update parameters to 205 standards.
(defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
(desktop-create-buffer 205 fn bn mam (cdr mim) pt mk ro misc
(list (cons 'truncate-lines tl)
(cons 'fill-column fc)
(cons 'case-fold-search cfs)
(cons 'case-replace cr)
(cons 'overwrite-mode (car mim)))))
;; ----------------------------------------------------------------------------
(provide 'desktop)