Mercurial > hg > xemacs-beta
diff lisp/packages/desktop.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | 376386a54a3c |
children | 34a5b81f86ba |
line wrap: on
line diff
--- a/lisp/packages/desktop.el Mon Aug 13 08:45:53 2007 +0200 +++ b/lisp/packages/desktop.el Mon Aug 13 08:46:35 2007 +0200 @@ -22,9 +22,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 19.34. ;;; Commentary: @@ -88,6 +89,7 @@ ;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. ;; kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt. ;; treese@lcs.mit.edu (Win Treese) for ange-ftp tips. +;; pot@cnuce.cnr.it (Francesco Potorti`) for misc. tips. ;; --------------------------------------------------------------------------- ;; TODO: ;; @@ -148,7 +150,7 @@ (make-variable-buffer-local 'desktop-locals-to-save) ;; We skip .log files because they are normally temporary. -;; (ftp) files because they require passwords and whatsnot. +;; (ftp) files because they require passwords and whatnot. ;; TAGS files to save time (tags-file-name is saved instead). (defvar desktop-buffers-not-to-save "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" @@ -159,6 +161,19 @@ "^/[^/:]*:" "Regexp identifying files whose buffers are to be excluded from saving.") +(defvar desktop-buffer-major-mode nil + "When desktop creates a buffer, this holds the desired Major mode.") + +(defvar desktop-buffer-file-name nil + "When desktop creates a buffer, this holds the file name to visit.") + +(defvar desktop-buffer-name nil + "When desktop creates a buffer, this holds the desired buffer name.") + +(defvar desktop-buffer-misc nil + "When desktop creates a buffer, this holds a list of misc info. +It is used by the `desktop-buffer-handlers' functions.") + (defvar desktop-buffer-handlers '(desktop-buffer-dired desktop-buffer-rmail @@ -166,11 +181,11 @@ desktop-buffer-info desktop-buffer-file) "*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. If the function returns t then the -buffer is considered created.") +The functions are called without explicit parameters but can use the +variables `desktop-buffer-major-mode', `desktop-buffer-file-name', +`desktop-buffer-name'. +If one 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.") @@ -222,6 +237,17 @@ nil (signal (car err) (cdr err))))))) ;; ---------------------------------------------------------------------------- +(defun desktop-list* (&rest args) + (if (null (cdr args)) + (car args) + (setq args (nreverse args)) + (let ((value (cons (nth 1 args) (car args)))) + (setq args (cdr (cdr args))) + (while args + (setq value (cons (car args) value)) + (setq args (cdr args))) + value))) + (defun desktop-internal-v2s (val) "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. TXT is a string that when read and evaluated yields value. @@ -259,6 +285,7 @@ ((consp val) (let ((p val) newlist + use-list* anynil) (while (consp p) (let ((q.txt (desktop-internal-v2s (car p)))) @@ -268,22 +295,15 @@ (if p (let ((last (desktop-internal-v2s p)) (el (car newlist))) - (setcar newlist - (if (or anynil (setq anynil (null (car last)))) - (cons nil - (concat "(cons " - (if (eq (car el) 'must) "'" "") - (cdr el) - " " - (if (eq (car last) 'must) "'" "") - (cdr last) - ")")) - (cons 'must - (concat (cdr el) " . " (cdr last))))))) + (or anynil (setq anynil (null (car last)))) + (or anynil + (setq newlist (cons '(must . ".") newlist))) + (setq use-list* t) + (setq newlist (cons last newlist)))) (setq newlist (nreverse newlist)) (if anynil (cons nil - (concat "(list " + (concat (if use-list* "(desktop-list* " "(list ") (mapconcat (lambda (el) (if (eq (car el) 'must) (concat "'" (cdr el)) @@ -445,20 +465,26 @@ (delete-file filename))))) ;; ---------------------------------------------------------------------------- (defun desktop-read () - "Read the Desktop file and the files it specifies." + "Read the Desktop file and the files it specifies. +This is a no-op when Emacs is running in batch mode." (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) - (run-hooks 'desktop-delay-hook) - (message "Desktop loaded.")) - (desktop-clear)))) + (if noninteractive + nil + (let ((dirs '("./" "~/"))) + (while (and dirs + (not (file-exists-p (expand-file-name + desktop-basefilename + (car dirs))))) + (setq dirs (cdr dirs))) + (setq desktop-dirname (and dirs (expand-file-name (car dirs)))) + (if desktop-dirname + (progn + (load (expand-file-name desktop-basefilename desktop-dirname) + t t t) + (run-hooks 'desktop-delay-hook) + (setq desktop-delay-hook nil) + (message "Desktop loaded.")) + (desktop-clear))))) ;; ---------------------------------------------------------------------------- (defun desktop-load-default () "Load the `default' start-up library manually. @@ -472,52 +498,56 @@ ;; Note: the following functions use the dynamic variable binding in Lisp. ;; (defun desktop-buffer-info () "Load an info file." - (if (eq 'Info-mode mam) + (if (eq 'Info-mode desktop-buffer-major-mode) (progn (require 'info) - (Info-find-node (nth 0 misc) (nth 1 misc)) + (Info-find-node (nth 0 desktop-buffer-misc) + (nth 1 desktop-buffer-misc)) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-rmail () "Load an RMAIL file." - (if (eq 'rmail-mode mam) + (if (eq 'rmail-mode desktop-buffer-major-mode) (condition-case error - (progn (rmail-input fn) t) + (progn (rmail-input desktop-buffer-file-name) t) (file-locked (kill-buffer (current-buffer)) 'ignored)))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-mh () "Load a folder in the mh system." - (if (eq 'mh-folder-mode mam) + (if (eq 'mh-folder-mode desktop-buffer-major-mode) (progn (require 'mh-e) (mh-find-path) - (mh-visit-folder bn) + (mh-visit-folder desktop-buffer-name) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-dired () "Load a directory using dired." - (if (eq 'dired-mode mam) - (if (file-directory-p (file-name-directory (car misc))) + (if (eq 'dired-mode desktop-buffer-major-mode) + (if (file-directory-p (file-name-directory (car desktop-buffer-misc))) (progn - (dired (car misc)) - (mapcar 'dired-insert-subdir (cdr misc)) + (dired (car desktop-buffer-misc)) + (mapcar 'dired-insert-subdir (cdr desktop-buffer-misc)) t) - (message "Directory %s no longer exists." (car misc)) + (message "Directory %s no longer exists." (car desktop-buffer-misc)) (sit-for 1) 'ignored))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-file () "Load a file." - (if fn - (if (or (file-exists-p fn) + (if desktop-buffer-file-name + (if (or (file-exists-p desktop-buffer-file-name) (and desktop-missing-file-warning (y-or-n-p (format "File \"%s\" no longer exists. Re-create? " - fn)))) - (progn (find-file fn) t) + desktop-buffer-file-name)))) + (progn (find-file desktop-buffer-file-name) t) 'ignored))) ;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set is mode, ...; called from Desktop file ;; only. -(defun desktop-create-buffer (ver fn bn mam mim pt mk ro misc &optional locals) +(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name + desktop-buffer-major-mode + mim pt mk ro desktop-buffer-misc + &optional locals) (let ((hlist desktop-buffer-handlers) (result) (handler)) @@ -527,8 +557,8 @@ (setq hlist (cdr hlist))) (if (eq result t) (progn - (if (not (equal (buffer-name) bn)) - (rename-buffer bn)) + (if (not (equal (buffer-name) desktop-buffer-name)) + (rename-buffer desktop-buffer-name)) (auto-fill-mode (if (nth 0 mim) 1 0)) (goto-char pt) (if (consp mk) @@ -553,8 +583,13 @@ )))) ;; 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 +(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name + desktop-buffer-major-mode + mim pt mk ro tl fc cfs cr + desktop-buffer-misc) + (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name + desktop-buffer-major-mode (cdr mim) pt mk ro + desktop-buffer-misc (list (cons 'truncate-lines tl) (cons 'fill-column fc) (cons 'case-fold-search cfs)