;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93,
+;; 94, 95, 1996 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
The truename of a file is found by chasing all links
both at the file level and at the levels of the containing directories.")
-(defvar buffer-file-truename nil
- "The abbreviated truename of the file visited in the current buffer.
-That is, (abbreviate-file-name (file-truename buffer-file-name)).
-This variable is automatically local in all buffers, when non-nil.")
-(make-variable-buffer-local 'buffer-file-truename)
-(put 'buffer-file-truename 'permanent-local t)
-
(defvar buffer-file-number nil
"The device number and file number of the file visited in the current buffer.
The value is a list of the form (FILENUM DEVNUM).
(defconst file-precious-flag nil
"*Non-nil means protect against I/O errors while saving files.
-Some modes set this non-nil in particular buffers.")
+Some modes set this non-nil in particular buffers.
+
+This feature works by writing the new contents into a temporary file
+and then renaming the temporary file to replace the original.
+In this way, any I/O error in writing leaves the original untouched,
+and there is never any instant where the file is nonexistent.
+
+Note that this feature forces backups to be made by copying.
+Yet, at the same time, saving a precious file
+breaks any hard links between it and other files.")
(defvar version-control nil
"*Control use of version numbers for backup files.
and the rest are not called.
These hooks are considered to pertain to the visited file.
So this list is cleared if you change the visited file name.
-See also `write-contents-hooks'.
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.")
+
+Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
+See also `write-contents-hooks'.")
;;; However, in case someone does make it local...
(put 'write-file-hooks 'permanent-local t)
(defvar local-write-file-hooks nil
"Just like `write-file-hooks', except intended for per-buffer use.
The functions in this list are called before the ones in
-`write-file-hooks'.")
+`write-file-hooks'.
+
+This variable is meant to be used for hooks that have to do with a
+particular visited file. Therefore, it is a permanent local, so that
+changing the major mode does not clear it. However, calling
+`set-visited-file-name' does clear it.")
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
-These hooks are considered to pertain to the buffer's contents,
-not to the particular visited file; thus, `set-visited-file-name' does
-not clear this variable, but changing the major mode does clear it.
+
+This variable is meant to be used for hooks that pertain to the
+buffer's contents, not to the particular visited file; thus,
+`set-visited-file-name' does not clear this variable; but changing the
+major mode does clear it.
+
+This variable automatically becomes buffer-local whenever it is set.
+If you use `add-hooks' to add elements to the list, use nil for the
+LOCAL argument.
+
See also `write-file-hooks'.")
+(make-variable-buffer-local 'write-contents-hooks)
(defconst enable-local-variables t
"*Control use of local-variables lists in files you visit.
inhibit-file-name-handlers)))
(inhibit-file-name-operation op))
(apply op args))))
+
+(defun convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names."
+ filename)
\f
(defun pwd ()
"Show the current default directory."
"Value of the CDPATH environment variable, as a list.
Not actually set up until the first time you you use it.")
+(defvar path-separator ":"
+ "Character used to separate concatenated paths.")
+
(defun parse-colon-path (cd-path)
"Explode a colon-separated list of paths into a string list."
(and cd-path
(let (cd-prefix cd-list (cd-start 0) cd-colon)
- (setq cd-path (concat cd-path ":"))
- (while (setq cd-colon (string-match ":" cd-path cd-start))
+ (setq cd-path (concat cd-path path-separator))
+ (while (setq cd-colon (string-match path-separator cd-path cd-start))
(setq cd-list
(nconc cd-list
(list (if (= cd-start cd-colon)
"Make DIR become the current buffer's default directory.
If your environment includes a `CDPATH' variable, try each one of that
colon-separated list of directories when resolving a relative directory name."
- (interactive "FChange default directory: ")
+ (interactive
+ (list (read-file-name "Change default directory: "
+ default-directory default-directory
+ (and (member cd-path '(nil ("./")))
+ (null (getenv "CDPATH"))))))
(if (file-name-absolute-p dir)
(cd-absolute (expand-file-name dir))
(if (null cd-path)
;; to chase before getting an error.
;; PREV-DIRS can be a cons cell whose car is an alist
;; of truenames we've just recently computed.
- (if (or (string= filename "~")
+
+ ;; The last test looks dubious, maybe `+' is meant here? --simon.
+ (if (or (string= filename "") (string= filename "~")
(and (string= (substring filename 0 1) "~")
(string-match "~[^/]*" filename)))
(progn
(setq buffer-read-only t)
(current-buffer))
+(defun find-alternate-file-other-window (filename)
+ "Find file FILENAME as a replacement for the file in the next window.
+This command does not select that window."
+ (interactive
+ (save-selected-window
+ (other-window 1)
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
+ (list (read-file-name
+ "Find alternate file: " file-dir nil nil file-name)))))
+ (if (one-window-p)
+ (find-file-other-window filename)
+ (save-selected-window
+ (other-window 1)
+ (find-alternate-file filename))))
+
(defun find-alternate-file (filename)
"Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
(onum buffer-file-number)
(otrue buffer-file-truename)
(oname (buffer-name)))
+ (if (get-buffer " **lose**")
+ (kill-buffer " **lose**"))
(rename-buffer " **lose**")
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(let ((abbreviated-home-dir "$foo"))
(concat "^" (abbreviate-file-name (expand-file-name "~"))
"\\(/\\|$\\)"))))
-
+
;; If FILENAME starts with the abbreviated homedir,
;; make it start with `~' instead.
(if (and (string-match abbreviated-home-dir filename)
;; If the home dir is just /, don't change it.
(not (and (= (match-end 0) 1)
(= (aref filename 0) ?/)))
- (not (and (or (eq system-type 'ms-dos)
+ ;; MS-DOS root directories can come with a drive letter;
+ ;; Novell Netware allows drive letters beyond `Z:'.
+ (not (and (or (eq system-type 'ms-dos)
(eq system-type 'windows-nt))
(save-match-data
- (string-match "^[a-zA-Z]:/$" filename)))))
+ (string-match "^[a-zA-`]:/$" filename)))))
(setq filename
(concat "~"
(substring filename (match-beginning 1) (match-end 1))
(setq list (cdr list))))
found))))
-(defun find-file-noselect (filename &optional nowarn)
+(defun insert-file-contents-literally (filename &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let ((file-name-handler-alist nil)
+ (format-alist nil)
+ (after-insert-file-functions nil)
+ (find-buffer-file-type-function
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil)))
+ (unwind-protect
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
+ (if find-buffer-file-type-function
+ (fset 'find-buffer-file-type find-buffer-file-type-function)
+ (fmakunbound 'find-buffer-file-type)))))
+
+(defun find-file-noselect (filename &optional nowarn rawfile)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
(expand-file-name filename)))
(if (file-directory-p filename)
(if find-file-run-dired
- (dired-noselect filename)
- (error "%s is a directory." filename))
+ (dired-noselect (if find-file-visit-truename
+ (abbreviate-file-name (file-truename filename))
+ filename))
+ (error "%s is a directory" filename))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(number (nthcdr 10 (file-attributes truename)))
(cond ((not (file-exists-p filename))
(error "File %s no longer exists!" filename))
((yes-or-no-p
- (format
- (if (buffer-modified-p buf)
- "File %s changed on disk. Discard your edits? "
- "File %s changed on disk. Reread from disk? ")
- (file-name-nondirectory filename)))
+ (if (string= (file-name-nondirectory filename)
+ (buffer-name buf))
+ (format
+ (if (buffer-modified-p buf)
+ "File %s changed on disk. Discard your edits? "
+ "File %s changed on disk. Reread from disk? ")
+ (file-name-nondirectory filename))
+ (format
+ (if (buffer-modified-p buf)
+ "File %s changed on disk. Discard your edits in %s? "
+ "File %s changed on disk. Reread from disk into %s? ")
+ (file-name-nondirectory filename)
+ (buffer-name buf))))
(save-excursion
(set-buffer buf)
(revert-buffer t t)))))
(set-buffer-major-mode buf)
(set-buffer buf)
(erase-buffer)
- (condition-case ()
- (insert-file-contents filename t)
- (file-error
- ;; Run find-file-not-found-hooks until one returns non-nil.
- (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
- ;; If they fail too, set error.
- (setq error t))))
+ (if rawfile
+ (condition-case ()
+ (insert-file-contents-literally filename t)
+ (file-error
+ ;; Unconditionally set error
+ (setq error t)))
+ (condition-case ()
+ (insert-file-contents filename t)
+ (file-error
+ ;; Run find-file-not-found-hooks until one returns non-nil.
+ (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ ;; If they fail too, set error.
+ (setq error t)))))
;; Find the file's truename, and maybe use that as visited name.
(setq buffer-file-truename truename)
(setq buffer-file-number number)
(progn
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
- (after-find-file error (not nowarn))))
+ (if rawfile
+ nil
+ (after-find-file error (not nowarn))
+ (setq buf (current-buffer)))))
buf)))
\f
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
- after-find-file-from-revert-buffer)
+ after-find-file-from-revert-buffer
+ nomodes)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
NOAUTO means don't mess with auto-save mode.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
-Finishes by calling the functions in `find-file-hooks'."
+Fifth arg NOMODES non-nil means don't alter the file's modes.
+Finishes by calling the functions in `find-file-hooks'
+unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
nil
(if (and warn
(file-newer-than-file-p (make-auto-save-file-name)
buffer-file-name))
- "Auto save file is newer; consider M-x recover-file"
+ (format "%s has auto save data; consider M-x recover-file"
+ (file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
((not error)
(or not-serious (sit-for 1 nil t)))))
(if (and auto-save-default (not noauto))
(auto-save-mode t)))
- (normal-mode t)
- (run-hooks 'find-file-hooks))
+ (if nomodes
+ nil
+ (normal-mode t)
+ (run-hooks 'find-file-hooks)))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
(error (message "File local-variables error: %s"
(prin1-to-string err)))))
-(defvar auto-mode-alist (mapcar 'purecopy
- '(("\\.text\\'" . text-mode)
- ("\\.c\\'" . c-mode)
- ("\\.h\\'" . c-mode)
- ("\\.tex\\'" . tex-mode)
- ("\\.ltx\\'" . latex-mode)
- ("\\.el\\'" . emacs-lisp-mode)
- ("\\.mm\\'" . nroff-mode)
- ("\\.me\\'" . nroff-mode)
- ("\\.ms\\'" . nroff-mode)
- ("\\.man\\'" . nroff-mode)
- ("\\.scm\\'" . scheme-mode)
- ("\\.l\\'" . lisp-mode)
- ("\\.lisp\\'" . lisp-mode)
- ("\\.f\\'" . fortran-mode)
- ("\\.for\\'" . fortran-mode)
- ("\\.p\\'" . pascal-mode)
- ("\\.pas\\'" . pascal-mode)
- ("\\.mss\\'" . scribe-mode)
- ("\\.ada\\'" . ada-mode)
- ("\\.icn\\'" . icon-mode)
- ("\\.pl\\'" . prolog-mode)
- ("\\.cc\\'" . c++-mode)
- ("\\.hh\\'" . c++-mode)
- ("\\.C\\'" . c++-mode)
- ("\\.H\\'" . c++-mode)
- ("\\.cpp\\'" . c++-mode)
- ("\\.cxx\\'" . c++-mode)
- ("\\.hxx\\'" . c++-mode)
- ("\\.c\\+\\+\\'" . c++-mode)
- ("\\.h\\+\\+\\'" . c++-mode)
-;;; ("\\.mk\\'" . makefile-mode)
-;;; ("[Mm]akefile" . makefile-mode)
+(defvar auto-mode-alist
+ '(("\\.te?xt\\'" . text-mode)
+ ("\\.c\\'" . c-mode)
+ ("\\.h\\'" . c-mode)
+ ("\\.tex\\'" . tex-mode)
+ ("\\.ltx\\'" . latex-mode)
+ ("\\.el\\'" . emacs-lisp-mode)
+ ("\\.mm\\'" . nroff-mode)
+ ("\\.me\\'" . nroff-mode)
+ ("\\.ms\\'" . nroff-mode)
+ ("\\.man\\'" . nroff-mode)
+ ("\\.scm\\'" . scheme-mode)
+ ("\\.l\\'" . lisp-mode)
+ ("\\.lisp\\'" . lisp-mode)
+ ("\\.f\\'" . fortran-mode)
+ ("\\.F\\'" . fortran-mode)
+ ("\\.for\\'" . fortran-mode)
+ ("\\.p\\'" . pascal-mode)
+ ("\\.pas\\'" . pascal-mode)
+ ("\\.mss\\'" . scribe-mode)
+ ("\\.ad[abs]\\'" . ada-mode)
+ ("\\.icn\\'" . icon-mode)
+ ("\\.pl\\'" . perl-mode)
+ ("\\.cc\\'" . c++-mode)
+ ("\\.hh\\'" . c++-mode)
+ ("\\.C\\'" . c++-mode)
+ ("\\.H\\'" . c++-mode)
+ ("\\.cpp\\'" . c++-mode)
+ ("\\.cxx\\'" . c++-mode)
+ ("\\.hxx\\'" . c++-mode)
+ ("\\.c\\+\\+\\'" . c++-mode)
+ ("\\.h\\+\\+\\'" . c++-mode)
+ ("\\.java\\'" . java-mode)
+ ("\\.mk\\'" . makefile-mode)
+ ("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\'" . makefile-mode)
;;; Less common extensions come here
;;; so more common ones above are found faster.
- ("\\.texinfo\\'" . texinfo-mode)
- ("\\.texi\\'" . texinfo-mode)
- ("\\.s\\'" . asm-mode)
- ("ChangeLog\\'" . change-log-mode)
- ("change.log\\'" . change-log-mode)
- ("changelo\\'" . change-log-mode)
- ("ChangeLog.[0-9]+\\'" . change-log-mode)
- ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
-;; The following should come after the ChangeLog pattern
-;; for the sake of ChangeLog.1, etc.
- ("\\.[12345678]\\'" . nroff-mode)
- ("\\.TeX\\'" . tex-mode)
- ("\\.sty\\'" . latex-mode)
- ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
- ("\\.bbl\\'" . latex-mode)
- ("\\.bib\\'" . bibtex-mode)
- ("\\.article\\'" . text-mode)
- ("\\.letter\\'" . text-mode)
- ("\\.tcl\\'" . tcl-mode)
- ("\\.lsp\\'" . lisp-mode)
- ("\\.awk\\'" . awk-mode)
- ("\\.prolog\\'" . prolog-mode)
- ("\\.tar\\'" . tar-mode)
- ;; Mailer puts message to be edited in
- ;; /tmp/Re.... or Message
- ("^/tmp/Re" . text-mode)
- ("/Message[0-9]*\\'" . text-mode)
- ("/drafts/[0-9]+\\'" . mh-letter-mode)
- ;; some news reader is reported to use this
- ("^/tmp/fol/" . text-mode)
- ("\\.y\\'" . c-mode)
- ("\\.lex\\'" . c-mode)
- ("\\.oak\\'" . scheme-mode)
- ("\\.scm.[0-9]*\\'" . scheme-mode)
- ("\\.sgm\\'" . sgml-mode)
- ("\\.sgml\\'" . sgml-mode)
- ("\\.dtd\\'" . sgml-mode)
- ;; .emacs following a directory delimiter
- ;; in either Unix or VMS syntax.
- ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
- ;; _emacs following a directory delimiter
- ;; in MsDos syntax
- ("[:/]_emacs\\'" . emacs-lisp-mode)
- ("\\.ml\\'" . lisp-mode)))
+ ("\\.texinfo\\'" . texinfo-mode)
+ ("\\.te?xi\\'" . texinfo-mode)
+ ("\\.s\\'" . asm-mode)
+ ("\\.S\\'" . asm-mode)
+ ("\\.asm\\'" . asm-mode)
+ ("ChangeLog\\'" . change-log-mode)
+ ("change.log\\'" . change-log-mode)
+ ("changelo\\'" . change-log-mode)
+ ("ChangeLog.[0-9]+\\'" . change-log-mode)
+ ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
+ ("\\.scm\\.[0-9]*\\'" . scheme-mode)
+ ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("/\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
+ ("/\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
+ ("/\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
+;;; The following should come after the ChangeLog pattern
+;;; for the sake of ChangeLog.1, etc.
+;;; and after the .scm.[0-9] pattern too.
+ ("\\.[12345678]\\'" . nroff-mode)
+ ("\\.TeX\\'" . tex-mode)
+ ("\\.sty\\'" . latex-mode)
+ ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
+ ("\\.bbl\\'" . latex-mode)
+ ("\\.bib\\'" . bibtex-mode)
+ ("\\.article\\'" . text-mode)
+ ("\\.letter\\'" . text-mode)
+ ("\\.tcl\\'" . tcl-mode)
+ ("\\.exp\\'" . tcl-mode)
+ ("\\.itcl\\'" . tcl-mode)
+ ("\\.itk\\'" . tcl-mode)
+ ("\\.f90\\'" . f90-mode)
+ ("\\.lsp\\'" . lisp-mode)
+ ("\\.awk\\'" . awk-mode)
+ ("\\.prolog\\'" . prolog-mode)
+ ("\\.tar\\'" . tar-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
+ ;; Mailer puts message to be edited in
+ ;; /tmp/Re.... or Message
+ ("\\`/tmp/Re" . text-mode)
+ ("/Message[0-9]*\\'" . text-mode)
+ ("/drafts/[0-9]+\\'" . mh-letter-mode)
+ ;; some news reader is reported to use this
+ ("\\`/tmp/fol/" . text-mode)
+ ("\\.y\\'" . c-mode)
+ ("\\.lex\\'" . c-mode)
+ ("\\.oak\\'" . scheme-mode)
+ ("\\.sgml?\\'" . sgml-mode)
+ ("\\.dtd\\'" . sgml-mode)
+ ("\\.s?html?\\'" . html-mode)
+ ;; .emacs following a directory delimiter
+ ;; in either Unix or VMS syntax.
+ ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; _emacs following a directory delimiter
+ ;; in MsDos syntax
+ ("[:/]_emacs\\'" . emacs-lisp-mode)
+ ("\\.ml\\'" . lisp-mode))
"\
Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
(defconst interpreter-mode-alist
'(("perl" . perl-mode)
+ ("perl5" . perl-mode)
("wish" . tcl-mode)
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
("awk" . awk-mode)
+ ("mawk" . awk-mode)
+ ("nawk" . awk-mode)
("gawk" . awk-mode)
- ("scm" . scheme-mode))
+ ("scm" . scheme-mode)
+ ("ash" . sh-mode)
+ ("bash" . sh-mode)
+ ("csh" . sh-mode)
+ ("dtksh" . sh-mode)
+ ("es" . sh-mode)
+ ("itcsh" . sh-mode)
+ ("jsh" . sh-mode)
+ ("ksh" . sh-mode)
+ ("oash" . sh-mode)
+ ("pdksh" . sh-mode)
+ ("rc" . sh-mode)
+ ("sh" . sh-mode)
+ ("sh5" . sh-mode)
+ ("tcsh" . sh-mode)
+ ("wksh" . sh-mode)
+ ("wsh" . sh-mode)
+ ("zsh" . sh-mode)
+ ("tail" . text-mode)
+ ("more" . text-mode)
+ ("less" . text-mode)
+ ("pg" . text-mode))
"Alist mapping interpreter names to major modes.
This alist applies to files whose first line starts with `#!'.
Each element looks like (INTERPRETER . MODE).
If `enable-local-variables' is nil, this function does not check for a
-*- mode tag."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
- (let (beg end done)
+ (let (beg end done modes)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
;; Don't look for -*- if this file name matches any
;; of the regexps in inhibit-first-line-modes-regexps.
(let ((temp inhibit-first-line-modes-regexps)
- (name (file-name-sans-versions buffer-file-name)))
+ (name (if buffer-file-name
+ (file-name-sans-versions buffer-file-name)
+ (buffer-name))))
(while (let ((sufs inhibit-first-line-modes-suffixes))
(while (and sufs (not (string-match (car sufs) name)))
(setq sufs (cdr sufs)))
(forward-char -1)
(goto-char end))
(skip-chars-backward " \t")
- (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode"))))
+ (setq modes (cons (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
+ modes)))
;; Simple -*-MODE-*- case.
- (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode"))))
- (setq done t)))
- ;; If we didn't find a mode from a -*- line, try using the file name.
- (if (and (not done) buffer-file-name)
- (let ((name buffer-file-name)
- (keep-going t))
- ;; Remove backup-suffixes from file name.
- (setq name (file-name-sans-versions name))
- (while keep-going
- (setq keep-going nil)
- (let ((alist auto-mode-alist)
- (mode nil))
- ;; Find first matching alist entry.
- (let ((case-fold-search (eq system-type 'vax-vms)))
- (while (and (not mode) alist)
- (if (string-match (car (car alist)) name)
- (if (and (consp (cdr (car alist)))
- (nth 2 (car alist)))
- (progn
- (setq mode (car (cdr (car alist)))
- name (substring name 0 (match-beginning 0))
- keep-going t))
- (setq mode (cdr (car alist))
- keep-going nil)))
- (setq alist (cdr alist))))
- (if mode
- (funcall mode)
- ;; If we can't deduce a mode from the file name,
- ;; look for an interpreter specified in the first line.
- (let ((interpreter
- (save-excursion
- (goto-char (point-min))
- (if (looking-at "#! *\\([^ \t\n]+\\)")
- (buffer-substring (match-beginning 1)
- (match-end 1))
- "")))
- elt)
- ;; Map interpreter name to a mode.
- (setq elt (assoc (file-name-nondirectory interpreter)
- interpreter-mode-alist))
- (if elt
- (funcall (cdr elt))))))))))))
+ (setq modes (cons (intern (concat (downcase (buffer-substring beg end))
+ "-mode"))
+ modes))))))
+ ;; If we found modes to use, invoke them now,
+ ;; outside the save-excursion.
+ (if modes
+ (progn (mapcar 'funcall modes)
+ (setq done t)))
+ ;; If we didn't find a mode from a -*- line, try using the file name.
+ (if (and (not done) buffer-file-name)
+ (let ((name buffer-file-name)
+ (keep-going t))
+ ;; Remove backup-suffixes from file name.
+ (setq name (file-name-sans-versions name))
+ (while keep-going
+ (setq keep-going nil)
+ (let ((alist auto-mode-alist)
+ (mode nil))
+ ;; Find first matching alist entry.
+ (let ((case-fold-search
+ (memq system-type '(vax-vms windows-nt))))
+ (while (and (not mode) alist)
+ (if (string-match (car (car alist)) name)
+ (if (and (consp (cdr (car alist)))
+ (nth 2 (car alist)))
+ (progn
+ (setq mode (car (cdr (car alist)))
+ name (substring name 0 (match-beginning 0))
+ keep-going t))
+ (setq mode (cdr (car alist))
+ keep-going nil)))
+ (setq alist (cdr alist))))
+ (if mode
+ (funcall mode)
+ ;; If we can't deduce a mode from the file name,
+ ;; look for an interpreter specified in the first line.
+ ;; As a special case, allow for things like "#!/bin/env perl",
+ ;; which finds the interpreter anywhere in $PATH.
+ (let ((interpreter
+ (save-excursion
+ (goto-char (point-min))
+ (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
+ (buffer-substring (match-beginning 2)
+ (match-end 2))
+ "")))
+ elt)
+ ;; Map interpreter name to a mode.
+ (setq elt (assoc (file-name-nondirectory interpreter)
+ interpreter-mode-alist))
+ (if elt
+ (funcall (cdr elt)))))))))))
(defun hack-local-variables-prop-line ()
;; Set local variables specified in the -*- line.
(or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
(error "malformed -*- line"))
(goto-char (match-end 0))
- (let ((key (intern (downcase (buffer-substring
- (match-beginning 1)
- (match-end 1)))))
+ ;; There used to be a downcase here,
+ ;; but the manual didn't say so,
+ ;; and people want to set var names that aren't all lc.
+ (let ((key (intern (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
(val (save-restriction
(narrow-to-region (point) end)
(read (current-buffer)))))
(setq result (cons (cons key val) result)))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
-
+
(if (and result
(or (eq enable-local-variables t)
(and enable-local-variables
(set-window-start (selected-window) (point)))
(y-or-n-p (format "Set local variables as specified at end of %s? "
(if buffer-file-name
- (file-name-nondirectory
+ (file-name-nondirectory
buffer-file-name)
(concat "buffer "
(buffer-name))))))))))
(string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
(symbol-name var))
(not (get var 'safe-local-variable))))
- ;; Permit evaling a put of a harmless property
+ ;; Permit evalling a put of a harmless property.
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
(consp val)
(progn
(setq truename (file-truename filename))
(if find-file-visit-truename
- ;; Do not use the abbreviated filename, because
- ;; write-region will reset it to the expanded filename
(setq filename truename))))
+ (let ((buffer (and filename (find-buffer-visiting filename))))
+ (and buffer (not (eq buffer (current-buffer)))
+ (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
+ filename)))
+ (error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
(clear-visited-file-modtime)
+ ;; Abbreviate the file names of the buffer.
(if truename
- (setq buffer-file-truename (abbreviate-file-name truename)))
+ (progn
+ (setq buffer-file-truename (abbreviate-file-name truename))
+ (if find-file-visit-truename
+ (setq buffer-file-name buffer-file-truename))))
(setq buffer-file-number
(if filename
- (nth 10 (file-attributes buffer-file-name))
+ (nthcdr 10 (file-attributes buffer-file-name))
nil)))
;; write-file-hooks is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
(if buffer-file-name
(set-buffer-modified-p t)))
-(defun write-file (filename)
+(defun write-file (filename &optional confirm)
"Write current buffer into file FILENAME.
Makes buffer visit that file, and marks it not modified.
If the buffer is already visiting a file, you can specify
a directory name as FILENAME, to write a file of the same
-old name in that directory."
+old name in that directory.
+
+If optional second arg CONFIRM is non-nil,
+ask for confirmation for overwriting an existing file.
+Interactively, confirmation is required unless you supply a prefix argument."
;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
(read-file-name "Write file: "
(cdr (assq 'default-directory
(buffer-local-variables)))
- nil nil (buffer-name)))))
+ nil nil (buffer-name)))
+ (not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
;; If arg is just a directory,
(if (and (file-directory-p filename) buffer-file-name)
(setq filename (concat (file-name-as-directory filename)
(file-name-nondirectory buffer-file-name))))
- (if (file-exists-p filename)
- (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
- (error "Canceled")))
+ (and confirm
+ (file-exists-p filename)
+ (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
+ (error "Canceled")))
(set-visited-file-name filename)))
(set-buffer-modified-p t)
(save-buffer))
(setq setmodes (file-modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
- (setq backupname (expand-file-name "~/%backup%~"))
- (message "Cannot write backup file; backing up in ~/%%backup%%~")
+ (setq backupname (expand-file-name
+ (convert-standard-filename
+ "~/%backup%~")))
+ (message "Cannot write backup file; backing up in %s"
+ (file-name-nondirectory backupname))
(sleep-for 1)
(condition-case ()
(copy-file real-file-name backupname t t)
(length name))
(if keep-backup-version
(length name)
- (or (string-match "\\.~[0-9]+~\\'" name)
+ (or (string-match "\\.~[0-9.]+~\\'" name)
(string-match "~\\'" name)
(length name))))))))
(let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
(if handler
(funcall handler 'file-ownership-preserved-p file)
- (= (nth 2 (file-attributes file)) (user-uid)))))
+ (let ((attributes (file-attributes file)))
+ ;; Return t if the file doesn't exist, since it's true that no
+ ;; information would be lost by an (attempted) delete and create.
+ (or (null attributes)
+ (= (nth 2 attributes) (user-uid)))))))
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\".
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
This is a separate function so you can redefine it for customization."
- (if (eq system-type 'ms-dos)
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
(let ((fn (file-name-nondirectory file)))
(concat (file-name-directory file)
- (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
- (substring fn 0 (match-end 1)))
- ".bak"))
+ (or
+ (and (string-match "\\`[^.]+\\'" fn)
+ (concat (match-string 0 fn) ".~"))
+ (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
+ (concat (match-string 0 fn) "~")))))
(concat file "~")))
(defun backup-file-name-p (file)
"Return non-nil if FILE is a backup file name (numeric or not).
This is a separate function so you can redefine it for customization.
You may need to redefine `file-name-sans-versions' as well."
- (if (eq system-type 'ms-dos)
- (string-match "\\.bak$" file)
- (string-match "~$" file)))
+ (string-match "~\\'" file))
;; This is used in various files.
;; The usage of bv-length is not very clean,
"Save current buffer in visited file if modified. Versions described below.
By default, makes the previous version into a backup file
if previously requested or if this is the first save.
-With 1 or 3 \\[universal-argument]'s, marks this version
+With 1 \\[universal-argument], marks this version
to become a backup when the next save is done.
-With 2 or 3 \\[universal-argument]'s,
+With 2 \\[universal-argument]'s,
unconditionally makes the previous version into a backup file.
+With 3 \\[universal-argument]'s, marks this version
+ to become a backup when the next save is done,
+ and unconditionally makes the previous version into a backup file.
+
With argument of 0, never makes the previous version into a backup file.
If a file's name is FOO, the names of its numbered backup versions are
(file-error nil))
(set-buffer-auto-saved))))
+(defvar after-save-hook nil
+ "Normal hook that is run after a buffer is saved to its file.")
+
(defun basic-save-buffer ()
- "Save the current buffer in its visited file, if it has been modified."
+ "Save the current buffer in its visited file, if it has been modified.
+After saving the buffer, run `after-save-hook'."
(interactive)
(save-excursion
;; In an indirect buffer, save its base buffer instead.
(rename-buffer buffer-new-name)))
;; If buffer has no file name, ask user for one.
(or buffer-file-name
- (set-visited-file-name
- (expand-file-name (read-file-name "File to save in: ") nil)))
+ (let ((filename
+ (expand-file-name
+ (read-file-name "File to save in: ") nil)))
+ (and (file-exists-p filename)
+ (or (y-or-n-p (format "File `%s' exists; overwrite? "
+ filename))
+ (error "Canceled")))
+ (set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(setq setmodes (basic-save-buffer-1)))
- (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
+ (setq buffer-file-number
+ (nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(set-file-modes buffer-file-name setmodes)
;; If the auto-save file was recent before this command,
;; delete it now.
(delete-auto-save-file-if-necessary recent-save)
+ ;; Support VC `implicit' locking.
+ (vc-after-save)
(run-hooks 'after-save-hook))
(message "(No changes need to be saved)"))))
(error "Attempt to save to a file which you aren't allowed to write"))))))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
- (let ((dir (file-name-directory buffer-file-name)))
+ (let ((dir (file-name-directory buffer-file-name)))
(if (and file-precious-flag
(file-writable-p dir))
;; If file is precious, write temp name, then rename it.
(setq nogood t)
;; Find the temporary name to write under.
(while nogood
- (setq tempname (format "%s#tmp#%d" dir i))
+ (setq tempname (format
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ "%s#%d.tm#" ; MSDOS limits files to 8+3
+ "%s#tmp#%d")
+ dir i))
(setq nogood (file-exists-p tempname))
(setq i (1+ i)))
(unwind-protect
(progn (clear-visited-file-modtime)
(write-region (point-min) (point-max)
- tempname nil realname)
+ tempname nil realname
+ buffer-file-truename)
(setq succeed t))
;; If writing the temp file fails,
;; delete the temp file.
- (or succeed
+ (or succeed
(progn
(delete-file tempname)
(set-visited-file-modtime old-modtime))))
(setq setmodes (file-modes buffer-file-name))
(set-file-modes buffer-file-name 511)))
(write-region (point-min) (point-max)
- buffer-file-name nil t)))
+ buffer-file-name nil t buffer-file-truename)))
setmodes))
(defun save-some-buffers (&optional arg exiting)
as well as about file buffers."
(interactive "P")
(save-window-excursion
- (let ((files-done
- (map-y-or-n-p
- (function
- (lambda (buffer)
- (and (buffer-modified-p buffer)
- (not (buffer-base-buffer buffer))
- (or
- (buffer-file-name buffer)
- (and exiting
- (progn
- (set-buffer buffer)
- (and buffer-offer-save (> (buffer-size) 0)))))
- (if arg
- t
- (if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer)))))))
- (function
- (lambda (buffer)
- (set-buffer buffer)
- (save-buffer)))
- (buffer-list)
- '("buffer" "buffers" "save")
- (list (list ?\C-r (lambda (buf)
- (view-buffer buf)
- (setq view-exit-action
- '(lambda (ignore)
- (exit-recursive-edit)))
- (recursive-edit)
- ;; Return nil to ask about BUF again.
- nil)
- "display the current buffer"))))
- (abbrevs-done
- (and save-abbrevs abbrevs-changed
- (progn
- (if (or arg
- (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
- (write-abbrev-file nil))
- ;; Don't keep bothering user if he says no.
- (setq abbrevs-changed nil)
- t))))
- (or (> files-done 0) abbrevs-done
+ (let* ((queried nil)
+ (files-done
+ (map-y-or-n-p
+ (function
+ (lambda (buffer)
+ (and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
+ (or
+ (buffer-file-name buffer)
+ (and exiting
+ (progn
+ (set-buffer buffer)
+ (and buffer-offer-save (> (buffer-size) 0)))))
+ (if arg
+ t
+ (setq queried t)
+ (if (buffer-file-name buffer)
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ (format "Save buffer %s? "
+ (buffer-name buffer)))))))
+ (function
+ (lambda (buffer)
+ (set-buffer buffer)
+ (save-buffer)))
+ (buffer-list)
+ '("buffer" "buffers" "save")
+ (list (list ?\C-r (lambda (buf)
+ (view-buffer buf)
+ (setq view-exit-action
+ '(lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer"))))
+ (abbrevs-done
+ (and save-abbrevs abbrevs-changed
+ (progn
+ (if (or arg
+ (y-or-n-p (format "Save abbrevs in %s? "
+ abbrev-file-name)))
+ (write-abbrev-file nil))
+ ;; Don't keep bothering user if he says no.
+ (setq abbrevs-changed nil)
+ t))))
+ (or queried (> files-done 0) abbrevs-done
(message "(No files need saving)")))))
\f
(defun not-modified (&optional arg)
(if (null arg)
(not buffer-read-only)
(> (prefix-numeric-value arg) 0)))
- ;; Force mode-line redisplay
- (set-buffer-modified-p (buffer-modified-p)))
+ (force-mode-line-update))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
- newest)
+ (newest nil)
+ tem)
(while comp
- (setq file (concat dir (car comp))
+ (setq tem (car comp)
comp (cdr comp))
- (if (and (backup-file-name-p file)
- (or (null newest) (file-newer-than-file-p file newest)))
- (setq newest file)))
+ (cond ((and (backup-file-name-p tem)
+ (string= (file-name-sans-versions tem) file))
+ (setq tem (concat dir tem))
+ (if (or (null newest)
+ (file-newer-than-file-p tem newest))
+ (setq newest tem)))))
newest))
(defun rename-uniquely ()
This function is useful for creating multiple shell process buffers
or multiple mail buffers, etc."
(interactive)
- (let* ((new-buf (generate-new-buffer (buffer-name)))
- (name (buffer-name new-buf)))
- (kill-buffer new-buf)
- (rename-buffer name)
- (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update
+ (save-match-data
+ (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
+ (not (and buffer-file-name
+ (string= (buffer-name)
+ (file-name-nondirectory
+ buffer-file-name)))))
+ ;; If the existing buffer name has a <NNN>,
+ ;; which isn't part of the file name (if any),
+ ;; then get rid of that.
+ (substring (buffer-name) 0 (match-beginning 0))
+ (buffer-name)))
+ (new-buf (generate-new-buffer base-name))
+ (name (buffer-name new-buf)))
+ (kill-buffer new-buf)
+ (rename-buffer name)
+ (force-mode-line-update))))
(defun make-directory (dir &optional parents)
"Create the directory DIR and any nonexistent parent dirs.
Interactively, the default choice of directory to create
is the current default directory for file names.
-That is useful when you have visited a file in a nonexistint directory.
+That is useful when you have visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS says whether
to create parent directories if they don't exist."
(let ((dir (directory-file-name (expand-file-name dir)))
create-list)
(while (not (file-exists-p dir))
- (setq create-list (cons dir create-list)
+ (setq create-list (cons dir create-list)
dir (directory-file-name (file-name-directory dir))))
(while create-list
(make-directory-internal (car create-list))
Gets two args, first the nominal file name to use,
and second, t if reading the auto-save file.")
-(defun revert-buffer (&optional ignore-auto noconfirm)
+(defvar before-revert-hook nil
+ "Normal hook for `revert-buffer' to run before reverting.
+If `revert-buffer-function' is used to override the normal revert
+mechanism, this hook is not used.")
+
+(defvar after-revert-hook nil
+ "Normal hook for `revert-buffer' to run after reverting.
+Note that the hook value that it runs is the value that was in effect
+before reverting; that makes a difference if you have buffer-local
+hook functions.
+
+If `revert-buffer-function' is used to override the normal revert
+mechanism, this hook is not used.")
+
+(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
"Replace the buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
;; Get rid of all undo records for this buffer.
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
- (let ((buffer-read-only nil)
- ;; Don't make undo records for the reversion.
- (buffer-undo-list t))
- (if revert-buffer-insert-file-contents-function
- (funcall revert-buffer-insert-file-contents-function
- file-name auto-save-p)
- (if (not (file-exists-p file-name))
- (error "File %s no longer exists!" file-name))
- ;; Bind buffer-file-name to nil
- ;; so that we don't try to lock the file.
- (let ((buffer-file-name nil))
- (or auto-save-p
- (unlock-buffer)))
- (widen)
- (insert-file-contents file-name (not auto-save-p)
- nil nil t)))
- (goto-char (min opoint (point-max)))
- ;; Recompute the truename in case changes in symlinks
- ;; have changed the truename.
- (setq buffer-file-truename
- (abbreviate-file-name (file-truename buffer-file-name)))
- (after-find-file nil nil t t)
- (run-hooks 'after-revert-hook)
+ ;; Effectively copy the after-revert-hook status,
+ ;; since after-find-file will clobber it.
+ (let ((global-hook (default-value 'after-revert-hook))
+ (local-hook-p (local-variable-p 'after-revert-hook))
+ (local-hook (and (local-variable-p 'after-revert-hook)
+ after-revert-hook)))
+ (let (buffer-read-only
+ ;; Don't make undo records for the reversion.
+ (buffer-undo-list t))
+ (if revert-buffer-insert-file-contents-function
+ (funcall revert-buffer-insert-file-contents-function
+ file-name auto-save-p)
+ (if (not (file-exists-p file-name))
+ (error "File %s no longer exists!" file-name))
+ ;; Bind buffer-file-name to nil
+ ;; so that we don't try to lock the file.
+ (let ((buffer-file-name nil))
+ (or auto-save-p
+ (unlock-buffer)))
+ (widen)
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))
+ (goto-char (min opoint (point-max)))
+ ;; Recompute the truename in case changes in symlinks
+ ;; have changed the truename.
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
+ (after-find-file nil nil t t preserve-modes)
+ ;; Run after-revert-hook as it was before we reverted.
+ (setq-default revert-buffer-internal-hook global-hook)
+ (if local-hook-p
+ (progn
+ (make-local-variable 'revert-buffer-internal-hook)
+ (setq revert-buffer-internal-hook local-hook))
+ (kill-local-variable 'revert-buffer-internal-hook))
+ (run-hooks 'revert-buffer-internal-hook))
t)))))
(defun recover-file (file)
;; Actually putting the file name in the minibuffer should be used
;; only rarely.
;; Not just because users often use the default.
- (interactive "fRecover file: ")
+ (interactive "FRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
(error "%s is an auto-save file" file))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
- (cond ((not (file-newer-than-file-p file-name file))
+ (cond ((if (file-exists-p file)
+ (not (file-newer-than-file-p file-name file))
+ (not (file-exists-p file-name)))
(error "Auto-save file %s not current" file-name))
((save-window-excursion
(if (not (eq system-type 'vax-vms))
(after-find-file nil nil t))
(t (error "Recover-file cancelled.")))))
+(defun recover-session ()
+ "Recover auto save files from a previous Emacs session.
+This command first displays a Dired buffer showing you the
+previous sessions that you could recover from.
+To choose one, move point to the proper line and then type C-c C-c.
+Then you'll be asked about a number of files to recover."
+ (interactive)
+ (let ((ls-lisp-support-shell-wildcards t))
+ (dired (concat auto-save-list-file-prefix "*")))
+ (goto-char (point-min))
+ (or (looking-at "Move to the session you want to recover,")
+ (let ((inhibit-read-only t))
+ (insert "Move to the session you want to recover,\n"
+ "then type C-c C-c to select it.\n\n"
+ "You can also delete some of these files;\n"
+ "type d on a line to mark that file for deletion.\n\n")))
+ (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
+ (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
+
+(defun recover-session-finish ()
+ "Choose one saved session to recover auto-save files from.
+This command is used in the special Dired buffer created by
+\\[recover-session]."
+ (interactive)
+ ;; Get the name of the session file to recover from.
+ (let ((file (dired-get-filename))
+ files
+ (buffer (get-buffer-create " *recover*")))
+ (dired-do-flagged-delete t)
+ (unwind-protect
+ (save-excursion
+ ;; Read in the auto-save-list file.
+ (set-buffer buffer)
+ (erase-buffer)
+ (insert-file-contents file)
+ ;; Loop thru the text of that file
+ ;; and get out the names of the files to recover.
+ (while (not (eobp))
+ (let (thisfile autofile)
+ (if (eolp)
+ ;; This is a pair of lines for a non-file-visiting buffer.
+ ;; Get the auto-save file name and manufacture
+ ;; a "visited file name" from that.
+ (progn
+ (forward-line 1)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (setq thisfile
+ (expand-file-name
+ (substring
+ (file-name-nondirectory autofile)
+ 1 -1)
+ (file-name-directory autofile)))
+ (forward-line 1))
+ ;; This pair of lines is a file-visiting
+ ;; buffer. Use the visited file name.
+ (progn
+ (setq thisfile
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))
+ (forward-line 1)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))
+ (forward-line 1)))
+ ;; Ignore a file if its auto-save file does not exist now.
+ (if (file-exists-p autofile)
+ (setq files (cons thisfile files)))))
+ (setq files (nreverse files))
+ ;; The file contains a pair of line for each auto-saved buffer.
+ ;; The first line of the pair contains the visited file name
+ ;; or is empty if the buffer was not visiting a file.
+ ;; The second line is the auto-save file name.
+ (if files
+ (map-y-or-n-p "Recover %s? "
+ (lambda (file)
+ (condition-case nil
+ (save-excursion (recover-file file))
+ (error
+ "Failed to recover `%s'" file)))
+ files
+ '("file" "files" "recover"))
+ (message "No files can be recovered from this session now")))
+ (kill-buffer buffer))))
+
(defun kill-some-buffers ()
"For each buffer, ask whether to kill it."
(interactive)
before calling this function. You can redefine this for customization.
See also `auto-save-file-name-p'."
(if buffer-file-name
- (concat (file-name-directory buffer-file-name)
- "#"
- (file-name-nondirectory buffer-file-name)
- "#")
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ (let ((fn (file-name-nondirectory buffer-file-name)))
+ (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
+ (concat (file-name-directory buffer-file-name)
+ "#" (match-string 1 fn)
+ "." (match-string 3 fn) "#"))
+ (concat (file-name-directory buffer-file-name)
+ "#"
+ (file-name-nondirectory buffer-file-name)
+ "#"))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
FILENAME should lack slashes. You can redefine this for customization."
(string-match "^#.*#$" filename))
\f
+(defun wildcard-to-regexp (wildcard)
+ "Given a shell file name pattern WILDCARD, return an equivalent regexp.
+The generated regexp will match a filename iff the filename
+matches that wildcard according to shell rules. Only wildcards known
+by `sh' are supported."
+ (let* ((i (string-match "[[.*+\\^$?]" wildcard))
+ ;; Copy the initial run of non-special characters.
+ (result (substring wildcard 0 i))
+ (len (length wildcard)))
+ ;; If no special characters, we're almost done.
+ (if i
+ (while (< i len)
+ (let ((ch (aref wildcard i))
+ j)
+ (setq
+ result
+ (concat result
+ (cond
+ ((eq ch ?\[) ; [...] maps to regexp char class
+ (progn
+ (setq i (1+ i))
+ (concat
+ (cond
+ ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
+ (progn
+ (setq i (1+ i))
+ (if (eq (aref wildcard i) ?\])
+ (progn
+ (setq i (1+ i))
+ "[^]")
+ "[^")))
+ ((eq (aref wildcard i) ?^)
+ ;; Found "[^". Insert a `\0' character
+ ;; (which cannot happen in a filename)
+ ;; into the character class, so that `^'
+ ;; is not the first character after `[',
+ ;; and thus non-special in a regexp.
+ (progn
+ (setq i (1+ i))
+ "[\000^"))
+ ((eq (aref wildcard i) ?\])
+ ;; I don't think `]' can appear in a
+ ;; character class in a wildcard, but
+ ;; let's be general here.
+ (progn
+ (setq i (1+ i))
+ "[]"))
+ (t "["))
+ (prog1 ; copy everything upto next `]'.
+ (substring wildcard
+ i
+ (setq j (string-match
+ "]" wildcard i)))
+ (setq i (if j (1- j) (1- len)))))))
+ ((eq ch ?.) "\\.")
+ ((eq ch ?*) "[^\000]*")
+ ((eq ch ?+) "\\+")
+ ((eq ch ?^) "\\^")
+ ((eq ch ?$) "\\$")
+ ((eq ch ?\\) "\\\\") ; probably cannot happen...
+ ((eq ch ??) "[^\000]")
+ (t (char-to-string ch)))))
+ (setq i (1+ i)))))
+ ;; Shell wildcards should match the entire filename,
+ ;; not its part. Make the regexp say so.
+ (concat "\\`" result "\\'")))
+\f
(defconst list-directory-brief-switches
(if (eq system-type 'vax-vms) "" "-CF")
"*Switches for list-directory to pass to `ls' for brief listing,")
(terpri)
(save-excursion
(set-buffer "*Directory*")
+ (setq default-directory
+ (if (file-directory-p dirname)
+ (file-name-as-directory dirname)
+ (file-name-directory dirname)))
(let ((wildcard (not (file-directory-p dirname))))
(insert-directory dirname switches wildcard (not wildcard)))))))