Commit ec4c6f22 authored by Richard M. Stallman's avatar Richard M. Stallman

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

(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.
parent 531b2a28
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Copyright (C) 1993 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk> ;; Author: Morten Welinder <terra@diku.dk>
;; Version: 2.03 ;; Version: 2.05
;; Keywords: customization ;; Keywords: customization
;; Favourite-brand-of-beer: None, I hate beer. ;; Favourite-brand-of-beer: None, I hate beer.
...@@ -33,10 +33,7 @@ ...@@ -33,10 +33,7 @@
;; - the point ;; - the point
;; - the mark & mark-active ;; - the mark & mark-active
;; - buffer-read-only ;; - buffer-read-only
;; - truncate-lines ;; - some local variables
;; - case-fold-search
;; - case-replace
;; - fill-column
;; To use this, first put these three lines in the bottom of your .emacs ;; To use this, first put these three lines in the bottom of your .emacs
;; file (the later the better): ;; file (the later the better):
...@@ -45,21 +42,46 @@ ...@@ -45,21 +42,46 @@
;; (desktop-load-default) ;; (desktop-load-default)
;; (desktop-read) ;; (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 ;; 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 ;; 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 ;; 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 ;; 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 ;; 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 ;; 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 ;; `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. ;; things you did not mean to keep. Use M-x desktop-clear RET.
;;
;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas. ;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas.
;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. ;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip.
;; chris@tecc.co.uk (Chris Boucher) for a mark tip. ;; chris@tecc.co.uk (Chris Boucher) for a mark tip.
;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip.
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; TODO: ;; TODO:
;; ;;
...@@ -70,6 +92,15 @@ ...@@ -70,6 +92,15 @@
;;; Code: ;;; 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. ;; USER OPTIONS -- settings you might want to play with.
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
(defconst desktop-basefilename (defconst desktop-basefilename
...@@ -85,13 +116,27 @@ Otherwise simply ignore the file.") ...@@ -85,13 +116,27 @@ Otherwise simply ignore the file.")
(defvar desktop-globals-to-save (defvar desktop-globals-to-save
(list 'desktop-missing-file-warning (list 'desktop-missing-file-warning
;; Feature: saving kill-ring implies saving kill-ring-yank-pointer ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
;; 'kill-ring ;; 'kill-ring
'tags-file-name 'tags-file-name
'tags-table-list 'tags-table-list
'search-ring
'regexp-search-ring
;; 'desktop-globals-to-save ; Itself! ;; 'desktop-globals-to-save ; Itself!
) )
"List of global variables to save when killing Emacs.") "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. ;; We skip .log files because they are normally temporary.
;; (ftp) files because they require passwords and whatsnot. ;; (ftp) files because they require passwords and whatsnot.
;; TAGS files to save time (tags-file-name is saved instead). ;; TAGS files to save time (tags-file-name is saved instead).
...@@ -102,6 +147,7 @@ Otherwise simply ignore the file.") ...@@ -102,6 +147,7 @@ Otherwise simply ignore the file.")
(defvar desktop-buffer-handlers (defvar desktop-buffer-handlers
'(desktop-buffer-dired '(desktop-buffer-dired
desktop-buffer-rmail desktop-buffer-rmail
desktop-buffer-mh
desktop-buffer-info desktop-buffer-info
desktop-buffer-file) desktop-buffer-file)
"*List of functions to call in order to create a buffer. The functions are "*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', ...@@ -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 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. `dd'. If some function returns non-nil no further functions are called.
If the function returns t then the buffer is considered created.") 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 (defvar desktop-dirname nil
"The directory in which the current desktop file resides.") "The directory in which the current desktop file resides.")
...@@ -119,10 +168,12 @@ If the function returns t then the buffer is considered created.") ...@@ -119,10 +168,12 @@ If the function returns t then the buffer is considered created.")
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
" "*Header to place in Desktop file.") " "*Header to place in Desktop file.")
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
(defconst postv18 (defun desktop-truncate (l n)
(string-lessp "19" emacs-version) "Truncate LIST to at most N elements destructively."
"t if Emacs version 19 or later.") (let ((here (nthcdr (1- n) l)))
(if (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
(defun desktop-clear () "Empty the Desktop." (defun desktop-clear () "Empty the Desktop."
(interactive) (interactive)
(setq kill-ring nil) (setq kill-ring nil)
...@@ -132,11 +183,13 @@ If the function returns t then the buffer is considered created.") ...@@ -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 ;; This is a bit dirty for version 18 because that version of Emacs was not
;; toilet-trained considering hooks. ;; toilet-trained considering hooks.
(if (not (boundp 'desktop-kill)) (defvar old-kill-emacs)
(if postv18
(add-hook 'kill-emacs-hook 'desktop-kill) (if (eval-when-compile postv18)
(setq old-kill-emacs kill-emacs-hook) (add-hook 'kill-emacs-hook 'desktop-kill)
(setq kill-emacs-hook (if (not (boundp 'desktop-kill))
(setq old-kill-emacs kill-emacs-hook
kill-emacs-hook
(function (lambda () (function (lambda ()
(progn (desktop-kill) (progn (desktop-kill)
(if (or (null old-kill-emacs) (if (or (null old-kill-emacs)
...@@ -149,23 +202,27 @@ If the function returns t then the buffer is considered created.") ...@@ -149,23 +202,27 @@ If the function returns t then the buffer is considered created.")
(progn (progn
(desktop-save desktop-dirname)))) (desktop-save desktop-dirname))))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
(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))))
"'"
"")
(prin1-to-string val))))
;; ----------------------------------------------------------------------------
(defun desktop-outvar (var) (defun desktop-outvar (var)
"Output a setq statement for VAR to the desktop file." "Output a setq statement for VAR to the desktop file."
(if (boundp var) (if (boundp var)
(let ((print-escape-newlines t) (insert "(setq "
(val (symbol-value var))) (symbol-name var)
(insert "(setq ") " "
(prin1 var (current-buffer)) (desktop-value-to-string (symbol-value var))
;; symbols are needed for cons cells and for symbols except ")\n")))
;; `t' and `nil'.
(if (or (consp val)
(and (symbolp val) val (not (eq t val))))
(insert " '")
(insert " "))
(prin1 val (current-buffer))
(insert ")\n"))))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode) (defun desktop-save-buffer-p (filename bufname mode &rest dummy)
"Return t if the desktop should record a particular buffer for next startup. "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 FILENAME is the visited file name, BUFNAME is the buffer name, and
MODE is the major mode." MODE is the major mode."
...@@ -187,35 +244,39 @@ MODE is the major mode." ...@@ -187,35 +244,39 @@ MODE is the major mode."
(list (list
(buffer-file-name) (buffer-file-name)
(buffer-name) (buffer-name)
(list 'quote major-mode) major-mode
(list 'quote (list ; list explaining minor modes
(list overwrite-mode (not (null
(not (null (if (eval-when-compile postv18)
(if postv18 auto-fill-function
auto-fill-function auto-fill-hook))))
auto-fill-hook)))))
(point) (point)
(if postv18 (if (eval-when-compile postv18)
(list 'quote (list (mark t) mark-active)) (list (mark t) mark-active)
(mark)) (mark))
buffer-read-only buffer-read-only
truncate-lines (cond ((eq major-mode 'Info-mode)
fill-column (list Info-current-file
case-fold-search Info-current-node))
case-replace ((eq major-mode 'dired-mode)
(list (if (eval-when-compile postv18)
'quote (nreverse
(cond ((equal major-mode 'Info-mode) (mapcar
(list Info-current-file (function car)
Info-current-node)) dired-subdir-alist))
((equal major-mode 'dired-mode) (list default-directory)))
(if postv18 )
(nreverse (let ((locals desktop-locals-to-save)
(mapcar (loclist (buffer-local-variables))
(function car) (ll))
dired-subdir-alist)) (while locals
(list default-directory))) (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)))) (buffer-list))))
(buf (get-buffer-create "*desktop*"))) (buf (get-buffer-create "*desktop*")))
...@@ -237,16 +298,13 @@ MODE is the major mode." ...@@ -237,16 +298,13 @@ MODE is the major mode."
(let ((print-escape-newlines t)) (let ((print-escape-newlines t))
(mapcar (mapcar
(function (lambda (l) (function (lambda (l)
(if (desktop-save-buffer-p (if (apply 'desktop-save-buffer-p l)
(car l)
(nth 1 l)
(nth 1 (nth 2 l)))
(progn (progn
(insert "(desktop-buffer") (insert desktop-create-buffer-form)
(mapcar (mapcar
(function (lambda (e) (function (lambda (e)
(insert "\n ") (insert "\n "
(prin1 e (current-buffer)))) (desktop-value-to-string e))))
l) l)
(insert ")\n\n"))))) (insert ")\n\n")))))
info)) info))
...@@ -280,7 +338,7 @@ MODE is the major mode." ...@@ -280,7 +338,7 @@ MODE is the major mode."
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
(defun desktop-load-default () (defun desktop-load-default ()
"Load the `default' start-up library manually. Also inhibit further loading "Load the `default' start-up library manually. Also inhibit further loading
of it. Call this from your `.emacs' file to provide correct modes for of it. Call this from your `.emacs' file to provide correct modes for
autoloaded files." autoloaded files."
(if (not inhibit-default-init) ; safety check (if (not inhibit-default-init) ; safety check
(progn (progn
...@@ -288,10 +346,9 @@ autoloaded files." ...@@ -288,10 +346,9 @@ autoloaded files."
(setq inhibit-default-init t)))) (setq inhibit-default-init t))))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp. ;; 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." (defun desktop-buffer-info () "Load an info file."
(if (equal 'Info-mode mam) (if (eq 'Info-mode mam)
(progn (progn
(require 'info) (require 'info)
(Info-find-node (nth 0 misc) (nth 1 misc)) (Info-find-node (nth 0 misc) (nth 1 misc))
...@@ -301,6 +358,14 @@ autoloaded files." ...@@ -301,6 +358,14 @@ autoloaded files."
(if (eq 'rmail-mode mam) (if (eq 'rmail-mode mam)
(progn (rmail-input fn) t))) (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." (defun desktop-buffer-dired () "Load a directory using dired."
(if (eq 'dired-mode mam) (if (eq 'dired-mode mam)
(progn (progn
...@@ -320,7 +385,7 @@ autoloaded files." ...@@ -320,7 +385,7 @@ autoloaded files."
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...; called from Desktop file ;; Create a buffer, load its file, set is mode, ...; called from Desktop file
;; only. ;; 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) (let ((hlist desktop-buffer-handlers)
(result) (result)
(handler)) (handler))
...@@ -332,12 +397,7 @@ autoloaded files." ...@@ -332,12 +397,7 @@ autoloaded files."
(progn (progn
(if (not (equal (buffer-name) bn)) (if (not (equal (buffer-name) bn))
(rename-buffer bn)) (rename-buffer bn))
(if (nth 0 mim) (auto-fill-mode (if (nth 0 mim) 1 0))
(overwrite-mode 1)
(overwrite-mode 0))
(if (nth 1 mim)
(auto-fill-mode 1)
(overwrite-mode 0))
(goto-char pt) (goto-char pt)
(if (consp mk) (if (consp mk)
(progn (progn
...@@ -346,11 +406,27 @@ autoloaded files." ...@@ -346,11 +406,27 @@ autoloaded files."
(set-mark mk)) (set-mark mk))
;; Never override file system if the file really is read-only marked. ;; Never override file system if the file really is read-only marked.
(if ro (setq buffer-read-only ro)) (if ro (setq buffer-read-only ro))
(setq truncate-lines tl) (while locals
(setq fill-column fc) (let ((this (car locals)))
(setq case-fold-search cfs) (if (consp this)
(setq case-replace cr) ;; 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) (provide 'desktop)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment