;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93, 94 Free Software Foundation, Inc.
;; Maintainer: FSF
;;; Code:
(defconst delete-auto-save-files t
- "*Non-nil means delete a buffer's auto-save file when the buffer is saved.")
+ "*Non-nil means delete auto-save file when a buffer is saved or killed.")
(defconst directory-abbrev-alist
nil
done when setting up the default directory of a newly visited file.
*Every* FROM string should start with `^'.
+Do not use `~' in the TO strings.
+They should be ordinary absolute directory names.
+
Use this feature when you have directories which you normally refer to
via absolute symbolic links. Make TO the name of the link, and FROM
the name it is linked to.")
both at the file level and at the levels of the containing directories.")
(defvar buffer-file-truename nil
- "The truename of the file visited in the current buffer.
+ "The abbreviated truename of the file visited in the current buffer.
+That is, (abbreviated-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)
"*Control use of version numbers for backup files.
t means make numeric backup versions unconditionally.
nil means make them for files that have some already.
-never means do not make them.")
+`never' means do not make them.")
(defvar dired-kept-versions 2
"*When cleaning directory, number of versions to keep.")
-(defvar trim-versions-without-asking nil
- "*If t, deletes excess backup versions silently.
-If nil, asks confirmation. Any other value prevents any trimming.")
+(defvar delete-old-versions nil
+ "*If t, delete excess backup versions silently.
+If nil, ask confirmation. Any other value prevents any trimming.")
(defvar kept-old-versions 2
"*Number of oldest versions to keep when a new numbered backup is made.")
The buffer's local variables (if any) will have been processed before the
functions are called.")
-;;; In case someone does make it local.
-(put 'write-file-hooks 'permanent-local t)
(defvar write-file-hooks nil
"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
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'.")
+;;; However, in case someone does make it local...
+(put 'write-file-hooks 'permanent-local t)
-(put 'local-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'.")
+(make-variable-buffer-local 'local-write-file-hooks)
+(put 'local-write-file-hooks 'permanent-local t)
(defvar write-contents-hooks nil
"List of functions to be called before writing out a buffer to a file.
(defun ange-ftp-completion-hook-function (op &rest args)
(if (memq op '(file-name-completion file-name-all-completions))
(apply 'ange-ftp-hook-function op args)
- (let (file-name-handler-alist)
+ (let ((inhibit-file-name-handlers
+ (cons 'ange-ftp-completion-hook-function
+ (and (eq inhibit-file-name-operation op)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation op))
(apply op args))))
\f
(defun pwd ()
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
- (setq dir (abbreviate-file-name (expand-file-name dir)))
+ ;; Put the name into directory syntax now,
+ ;; because otherwise expand-file-name may give some bad results.
(if (not (eq system-type 'vax-vms))
(setq dir (file-name-as-directory dir)))
+ (setq dir (abbreviate-file-name (expand-file-name dir)))
(if (not (file-directory-p dir))
(error "%s is not a directory" dir)
(if (file-executable-p dir)
(interactive "sLoad library: ")
(load library))
-;; OTHER is the other file to be compared.
-(defun file-local-copy (file)
+(defun file-local-copy (file &optional buffer)
"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible."
- (let ((handler (find-file-name-handler file)))
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
(if handler
(funcall handler 'file-local-copy file)
nil)))
-(defun file-truename (filename)
+(defun file-truename (filename &optional counter prev-dirs)
"Return the truename of FILENAME, which should be absolute.
The truename of a file name is found by chasing symbolic links
both at the level of the file and at the level of the directories
-containing it, until no links are left at any level."
- (if (string= filename "~")
+containing it, until no links are left at any level.
+
+The arguments COUNTER and PREV-DIRS are used only in recursive calls.
+Do not specify them in other calls."
+ ;; COUNTER can be a cons cell whose car is the count of how many more links
+ ;; 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 "~")
+ (and (string= (substring filename 0 1) "~")
+ (string-match "~[^/]*" filename)))
(progn
(setq filename (expand-file-name filename))
(if (string= filename "")
(setq filename "/"))))
- (let ((handler (find-file-name-handler filename)))
- ;; For file name that has a special handler, call handler.
- ;; This is so that ange-ftp can save time by doing a no-op.
- (if handler
- (funcall handler 'file-truename filename)
- (let ((dir (file-name-directory filename))
- target dirfile)
- ;; Get the truename of the directory.
- (setq dirfile (directory-file-name dir))
- ;; If these are equal, we have the (or a) root directory.
- (or (string= dir dirfile)
- (setq dir (file-name-as-directory (file-truename dirfile))))
- (if (equal ".." (file-name-nondirectory filename))
- (directory-file-name (file-name-directory (directory-file-name dir)))
- (if (equal "." (file-name-nondirectory filename))
- (directory-file-name dir)
- ;; Put it back on the file name.
- (setq filename (concat dir (file-name-nondirectory filename)))
- ;; Is the file name the name of a link?
- (setq target (file-symlink-p filename))
- (if target
- ;; Yes => chase that link, then start all over
- ;; since the link may point to a directory name that uses links.
- ;; We can't safely use expand-file-name here
- ;; since target might look like foo/../bar where foo
- ;; is itself a link. Instead, we handle . and .. above.
- (if (file-name-absolute-p target)
- (file-truename target)
- (file-truename (concat dir target)))
- ;; No, we are done!
- filename)))))))
+ (or counter (setq counter (list 100)))
+ (let (done
+ ;; For speed, remove the ange-ftp completion handler from the list.
+ ;; We know it's not needed here.
+ ;; For even more speed, do this only on the outermost call.
+ (file-name-handler-alist
+ (if prev-dirs file-name-handler-alist
+ (let ((tem (copy-sequence file-name-handler-alist)))
+ (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
+ (or prev-dirs (setq prev-dirs (list nil)))
+ ;; If this file directly leads to a link, process that iteratively
+ ;; so that we don't use lots of stack.
+ (while (not done)
+ (setcar counter (1- (car counter)))
+ (if (< (car counter) 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ (let ((handler (find-file-name-handler filename 'file-truename)))
+ ;; For file name that has a special handler, call handler.
+ ;; This is so that ange-ftp can save time by doing a no-op.
+ (if handler
+ (setq filename (funcall handler 'file-truename filename)
+ done t)
+ (let ((dir (file-name-directory filename))
+ target dirfile)
+ ;; Get the truename of the directory.
+ (setq dirfile (directory-file-name dir))
+ ;; If these are equal, we have the (or a) root directory.
+ (or (string= dir dirfile)
+ ;; If this is the same dir we last got the truename for,
+ ;; save time--don't recalculate.
+ (if (assoc dir (car prev-dirs))
+ (setq dir (cdr (assoc dir (car prev-dirs))))
+ (let ((old dir)
+ (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
+ (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
+ (setq dir new))))
+ (if (equal ".." (file-name-nondirectory filename))
+ (setq filename
+ (directory-file-name (file-name-directory (directory-file-name dir)))
+ done t)
+ (if (equal "." (file-name-nondirectory filename))
+ (setq filename (directory-file-name dir)
+ done t)
+ ;; Put it back on the file name.
+ (setq filename (concat dir (file-name-nondirectory filename)))
+ ;; Is the file name the name of a link?
+ (setq target (file-symlink-p filename))
+ (if target
+ ;; Yes => chase that link, then start all over
+ ;; since the link may point to a directory name that uses links.
+ ;; We can't safely use expand-file-name here
+ ;; since target might look like foo/../bar where foo
+ ;; is itself a link. Instead, we handle . and .. above.
+ (setq filename
+ (if (file-name-absolute-p target)
+ target
+ (concat dir target))
+ done nil)
+ ;; No, we are done!
+ (setq done t))))))))
+ filename))
(defun file-chase-links (filename)
"Chase links in FILENAME until a name that is not a link.
(while (setq tem (file-symlink-p newname))
(if (= count 0)
(error "Apparent cycle of symbolic links for %s" filename))
+ ;; In the context of a link, `//' doesn't mean what Emacs thinks.
+ (while (string-match "//+" tem)
+ (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
+ (substring tem (match-end 0)))))
;; Handle `..' by hand, since it needs to work in the
;; target of any directory symlink.
;; This code is not quite complete; it does not handle
;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
- (while (string-match "\\.\\./" tem)
+ (while (string-match "\\`\\.\\./" tem)
(setq tem (substring tem 3))
(setq newname (file-name-as-directory
;; Do the .. by hand.
"Switch to buffer BUFFER in another frame."
(interactive "BSwitch to buffer in other frame: ")
(let ((pop-up-frames t))
- (pop-to-buffer buffer t)))
+ (pop-to-buffer buffer t)
+ (raise-frame (window-frame (selected-window)))))
(defun find-file (filename)
"Edit file FILENAME.
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil nil file-name))))
- (and (buffer-modified-p)
+ (and (buffer-modified-p) (buffer-file-name)
;; (not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(buffer-name))))
"Regexp to match the automounter prefix in a directory name.")
(defvar abbreviated-home-dir nil
- "The the user's homedir abbreviated according to `directory-abbrev-list'.")
+ "The user's homedir abbreviated according to `directory-abbrev-list'.")
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
;; If FILENAME starts with the abbreviated homedir,
;; make it start with `~' instead.
- (if (string-match abbreviated-home-dir filename)
+ (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 (eq system-type 'ms-dos)
+ (save-match-data
+ (string-match "^[a-zA-Z]:/$" filename)))))
(setq filename
(concat "~"
- ;; If abbreviated-home-dir ends with a slash,
- ;; don't remove the corresponding slash from
- ;; filename. On MS-DOS and OS/2, you can have
- ;; home directories like "g:/", in which it is
- ;; important not to remove the slash. And what
- ;; about poor root on Unix systems?
- (if (eq ?/ (aref abbreviated-home-dir
- (1- (length abbreviated-home-dir))))
- "/"
- "")
(substring filename (match-beginning 1) (match-end 1))
(substring filename (match-end 0)))))
filename))
directory where the file was found. If you *do not* want that, add the logical
name to this list as a string.")
+(defun find-buffer-visiting (filename)
+ "Return the buffer visiting file FILENAME (a string).
+This is like `get-file-buffer', except that it checks for any buffer
+visiting the same file, possibly under a different name.
+If there is no such live buffer, return nil."
+ (let ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or buf
+ (let ((list (buffer-list)) found)
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (string= buffer-file-truename truename))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let ((number (nthcdr 10 (file-attributes truename)))
+ (list (buffer-list)) found)
+ (and number
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (equal buffer-file-number number)
+ ;; Verify this buffer's file number
+ ;; still belongs to its file.
+ (file-exists-p buffer-file-name)
+ (equal (nthcdr 10 (file-attributes buffer-file-name))
+ number))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
+
(defun find-file-noselect (filename &optional nowarn)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(truename (abbreviate-file-name (file-truename filename)))
(number (nthcdr 10 (file-attributes truename)))
;; Find any buffer for a file which has same truename.
- (same-truename
- (or buf ; Shortcut
- (let (found
- (list (buffer-list)))
- (while (and (not found) list)
- (save-excursion
- (set-buffer (car list))
- (if (and buffer-file-name
- (string= buffer-file-truename truename))
- (setq found (car list))))
- (setq list (cdr list)))
- found)))
- (same-number
- (or buf ; Shortcut
- (and number
- (let (found
- (list (buffer-list)))
- (while (and (not found) list)
- (save-excursion
- (set-buffer (car list))
- (if (and (equal buffer-file-number number)
- ;; Verify this buffer's file number
- ;; still belongs to its file.
- (file-exists-p buffer-file-name)
- (equal (nthcdr 10 (file-attributes buffer-file-name)) number))
- (setq found (car list))))
- (setq list (cdr list)))
- found))))
+ (other (and (not buf) (find-buffer-visiting filename)))
error)
;; Let user know if there is a buffer with the same truename.
- (if (and (not buf) same-truename (not nowarn))
- (message "%s and %s are the same file (%s)"
- filename (buffer-file-name same-truename)
- truename)
- (if (and (not buf) same-number (not nowarn))
- (message "%s and %s are the same file"
- filename (buffer-file-name same-number))))
-
- ;; Optionally also find that buffer.
- (if (or find-file-existing-other-name find-file-visit-truename)
- (setq buf (or same-truename same-number)))
+ (if other
+ (progn
+ (or nowarn
+ (string-equal filename (buffer-file-name other))
+ (message "%s and %s are the same file"
+ filename (buffer-file-name other)))
+ ;; Optionally also find that buffer.
+ (if (or find-file-existing-other-name find-file-visit-truename)
+ (setq buf other))))
(if buf
(or nowarn
(verify-visited-file-modtime buf)
(format
(if (buffer-modified-p buf)
"File %s changed on disk. Discard your edits? "
- "File %s changed on disk. Read the new version? ")
+ "File %s changed on disk. Reread from disk? ")
(file-name-nondirectory filename)))
(save-excursion
(set-buffer buf)
(condition-case ()
(insert-file-contents filename t)
(file-error
- (setq error t)
;; Run find-file-not-found-hooks until one returns non-nil.
- (let ((hooks find-file-not-found-hooks))
- (while (and hooks
- (not (and (funcall (car hooks))
- ;; If a hook succeeded, clear error.
- (progn (setq error nil)
- ;; Also exit the loop.
- t))))
- (setq hooks (cdr hooks))))))
+ (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 (abbreviate-file-name truename))
+ (setq buffer-file-truename truename)
(setq buffer-file-number number)
;; On VMS, we may want to remember which directory in a search list
;; the file was found in.
(after-find-file error (not nowarn))))
buf)))
\f
-(defun after-find-file (&optional error warn noauto)
+(defvar after-find-file-from-revert-buffer nil)
+
+(defun after-find-file (&optional error warn noauto
+ after-find-file-from-revert-buffer)
"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
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
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'."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
(if (and auto-save-default (not noauto))
(auto-save-mode t)))
(normal-mode t)
- (mapcar 'funcall find-file-hooks))
+ (run-hooks 'find-file-hooks))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
("\\.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)
;;; ("[Mm]akefile" . 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
("\\.bib\\'" . bibtex-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
- ("\\.texinfo\\'" . texinfo-mode)
- ("\\.texi\\'" . texinfo-mode)
+ ("\\.tcl\\'" . tcl-mode)
("\\.lsp\\'" . lisp-mode)
("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-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).
-Visiting a file whose name matches REGEXP causes FUNCTION to be called.")
-
-(defconst inhibit-local-variables-regexps '("\\.tar$")
- "List of regexps; if one matches a file name, don't look for local vars.")
+Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION).
+Visiting a file whose name matches REGEXP causes FUNCTION to be called.
+If the element has the form (REGEXP FUNCTION), then after calling
+FUNCTION, we delete the suffix that matched REGEXP and search the list
+again for another match.")
+
+(defconst interpreter-mode-alist
+ '(("perl" . perl-mode)
+ ("wish" . tcl-mode)
+ ("wishx" . tcl-mode)
+ ("tcl" . tcl-mode)
+ ("tclsh" . tcl-mode)
+ ("awk" . awk-mode)
+ ("gawk" . awk-mode)
+ ("scm" . scheme-mode))
+ "Alist mapping interpreter names to major modes.
+This alist applies to files whose first line starts with `#!'.
+Each element looks like (INTERPRETER . MODE).
+The car of each element is compared with
+the name of the interpreter specified in the first line.
+If it matches, mode MODE is selected.")
+
+(defconst inhibit-first-line-modes-regexps '("\\.tar$")
+ "List of regexps; if one matches a file name, don't look for `-*-'.")
+
+(defvar user-init-file
+ "" ; set by command-line
+ "File name including directory of user's initialization file.")
(defun set-auto-mode ()
"Select major mode appropriate for current buffer.
-This checks for a -*- mode tag in the buffer's text, or
-compares the filename against the entries in auto-mode-alist. It does
-not check for the \"mode:\" local variable in the Local Variables
-section of the file; for that, use `hack-local-variables'.
+This checks for a -*- mode tag in the buffer's text,
+compares the filename against the entries in `auto-mode-alist',
+or checks the interpreter that runs this file against
+`interpreter-mode-alist'.
+
+It does not check for the `mode:' local variable in the
+Local Variables section of the file; for that, use `hack-local-variables'.
If `enable-local-variables' is nil, this function does not check for a
-*- mode tag."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
- (let (beg end mode)
+ (let (beg end done)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
- (if (and enable-local-variables
- ;; Don't look for -*- if this file name matches any
- ;; of the regexps in inhibit-local-variables-regexps.
- (let ((temp inhibit-local-variables-regexps))
- (while (and temp
- (not (string-match (car temp)
- buffer-file-name)))
- (setq temp (cdr temp)))
- (not temp))
- (search-forward "-*-" (save-excursion
- ;; If the file begins with "#!"
- ;; (exec interpreter magic), look
- ;; for mode frobs in the first two
- ;; lines. You cannot necessarily
- ;; put them in the first line of
- ;; such a file without screwing up
- ;; the interpreter invocation.
- (end-of-line (and (looking-at "^#!") 2))
- (point)) t)
- (progn
- (skip-chars-forward " \t")
- (setq beg (point))
- (search-forward "-*-"
- (save-excursion (end-of-line) (point))
- t))
- (progn
- (forward-char -3)
- (skip-chars-backward " \t")
- (setq end (point))
- (goto-char beg)
- (if (search-forward ":" end t)
- (progn
- (goto-char beg)
- (if (let ((case-fold-search t))
- (search-forward "mode:" end t))
- (progn
- (skip-chars-forward " \t")
- (setq beg (point))
- (if (search-forward ";" end t)
- (forward-char -1)
- (goto-char end))
- (skip-chars-backward " \t")
- (setq mode (buffer-substring beg (point))))))
- (setq mode (buffer-substring beg end)))))
- (setq mode (intern (concat (downcase mode) "-mode")))
- (if buffer-file-name
- (let ((alist auto-mode-alist)
- (name buffer-file-name))
- (let ((case-fold-search (eq system-type 'vax-vms)))
- ;; Remove backup-suffixes from file name.
- (setq name (file-name-sans-versions name))
+ (and enable-local-variables
+ ;; 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))
+ (while (and temp
+ (not (string-match (car temp)
+ buffer-file-name)))
+ (setq temp (cdr temp)))
+ (not temp))
+ (search-forward "-*-" (save-excursion
+ ;; If the file begins with "#!"
+ ;; (exec interpreter magic), look
+ ;; for mode frobs in the first two
+ ;; lines. You cannot necessarily
+ ;; put them in the first line of
+ ;; such a file without screwing up
+ ;; the interpreter invocation.
+ (end-of-line (and (looking-at "^#!") 2))
+ (point)) t)
+ (progn
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (search-forward "-*-"
+ (save-excursion (end-of-line) (point))
+ t))
+ (progn
+ (forward-char -3)
+ (skip-chars-backward " \t")
+ (setq end (point))
+ (goto-char beg)
+ (if (save-excursion (search-forward ":" end t))
+ ;; Find all specifications for the `mode:' variable
+ ;; and execute them left to right.
+ (while (let ((case-fold-search t))
+ (search-forward "mode:" end t))
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (if (search-forward ";" end t)
+ (forward-char -1)
+ (goto-char end))
+ (skip-chars-backward " \t")
+ (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode"))))
+ ;; 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.
- (while (and (not mode) alist)
- (if (string-match (car (car alist)) name)
- (setq mode (cdr (car alist))))
- (setq alist (cdr alist))))))))
- (if mode (funcall mode))))
+ (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))))))))))))
(defun hack-local-variables-prop-line ()
;; Set local variables specified in the -*- line.
- ;; Returns t if mode was set.
+ ;; Ignore any specification for `mode:';
+ ;; set-auto-mode should already have handled that.
(save-excursion
(goto-char (point-min))
- (skip-chars-forward " \t\n\r")
- (let ((result '())
- (end (save-excursion (end-of-line) (point)))
- mode-p)
+ (let ((result nil)
+ (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point))))
;; Parse the -*- line into the `result' alist.
(cond ((not (search-forward "-*-" end t))
;; doesn't have one.
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
- ;; Simple form: "-*- MODENAME -*-".
- (setq result
- (list (cons 'mode
- (intern (buffer-substring
- (match-beginning 1)
- (match-end 1)))))))
+ ;; Simple form: "-*- MODENAME -*-". Already handled.
+ nil)
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
(val (save-restriction
(narrow-to-region (point) end)
(read (current-buffer)))))
- (setq result (cons (cons key val) result))
+ (or (eq key 'mode)
+ (setq result (cons (cons key val) result)))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
-
- ;; Mode is magic.
- (let (mode)
- (while (setq mode (assq 'mode result))
- (setq mode-p t result (delq mode result))
- (funcall (intern (concat (downcase (symbol-name (cdr mode)))
- "-mode")))))
(if (and result
(or (eq enable-local-variables t)
(and enable-local-variables
(save-window-excursion
- (switch-to-buffer (current-buffer))
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer.
+ ;; So try another window.
+ (condition-case nil
+ (switch-to-buffer-other-window (current-buffer))
+ (error
+ (switch-to-buffer-other-frame (current-buffer))))))
(y-or-n-p (format "Set local variables as specified in -*- line of %s? "
(file-name-nondirectory buffer-file-name)))))))
(while result
- (let ((key (car (car result)))
- (val (cdr (car result))))
- ;; 'mode has already been removed from this list.
- (hack-one-local-variable key val))
- (setq result (cdr result))))
- mode-p)))
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
+ (setq result (cdr result)))))))
(defun hack-local-variables ()
"Parse and put into effect this buffer's local variables spec."
(beginning-of-line)
(set-window-start (selected-window) (point)))
(y-or-n-p (format "Set local variables as specified at end of %s? "
- (file-name-nondirectory buffer-file-name))))))))
+ (if buffer-file-name
+ (file-name-nondirectory
+ buffer-file-name)
+ (concat "buffer "
+ (buffer-name))))))))))
(let ((continue t)
prefix prefixlen suffix beg
(enable-local-eval enable-local-eval))
'(enable-local-eval)
"Variables to be ignored in a file's local variable spec.")
+;; Get confirmation before setting these variables as locals in a file.
+(put 'debugger 'risky-local-variable t)
+(put 'enable-local-eval 'risky-local-variable t)
+(put 'eval 'risky-local-variable t)
+(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'minor-mode-map-alist 'risky-local-variable t)
+(put 'after-load-alist 'risky-local-variable t)
+(put 'buffer-file-name 'risky-local-variable t)
+(put 'buffer-auto-save-file-name 'risky-local-variable t)
+(put 'buffer-file-truename 'risky-local-variable t)
+(put 'exec-path 'risky-local-variable t)
+(put 'load-path 'risky-local-variable t)
+(put 'exec-directory 'risky-local-variable t)
+(put 'process-environment 'risky-local-variable t)
+;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
+(put 'outline-level 'risky-local-variable t)
+(put 'rmail-output-file-alist 'risky-local-variable t)
+
+;; This one is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable t)
+
+(defun hack-one-local-variable-quotep (exp)
+ (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+
;; "Set" one variable in a local variables spec.
;; A few variable names are treated specially.
(defun hack-one-local-variable (var val)
nil)
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
- ((or (eq var 'eval)
- (string-match "-hooks?$\\|-functions?$" (symbol-name var)))
- (if (and (not (string= (user-login-name) "root"))
- (or (eq enable-local-eval t)
- (and enable-local-eval
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (save-excursion
- (beginning-of-line)
- (set-window-start (selected-window) (point)))
- (setq enable-local-eval
- (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
- (file-name-nondirectory buffer-file-name))))))))
+ ((or (get var 'risky-local-variable)
+ (and
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
+ (symbol-name var))
+ (not (get var 'safe-local-variable))))
+ ;; Permit evaling a put of a harmless property
+ ;; if the args do nothing tricky.
+ (if (or (and (eq var 'eval)
+ (consp val)
+ (eq (car val) 'put)
+ (hack-one-local-variable-quotep (nth 1 val))
+ (hack-one-local-variable-quotep (nth 2 val))
+ ;; Only allow safe values of lisp-indent-hook;
+ ;; not functions.
+ (or (numberp (nth 3 val))
+ (equal (nth 3 val) ''defun))
+ (memq (nth 1 (nth 2 val))
+ '(lisp-indent-hook)))
+ ;; Permit eval if not root and user says ok.
+ (and (not (zerop (user-uid)))
+ (or (eq enable-local-eval t)
+ (and enable-local-eval
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point)))
+ (setq enable-local-eval
+ (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
+ (file-name-nondirectory buffer-file-name)))))))))
(if (eq var 'eval)
(save-excursion (eval val))
(make-local-variable var)
Remember to delete the initial contents of the minibuffer
if you wish to pass an empty string as the argument."
(interactive "FSet visited file name: ")
- (if filename
- (setq filename
- (if (string-equal filename "")
- nil
- (expand-file-name filename))))
- (or (equal filename buffer-file-name)
- (null filename)
- (progn
- (lock-buffer filename)
- (unlock-buffer)))
- (setq buffer-file-name filename)
- (if filename ; make buffer name reflect filename.
- (let ((new-name (file-name-nondirectory buffer-file-name)))
- (if (string= new-name "")
- (error "Empty file name"))
- (if (eq system-type 'vax-vms)
- (setq new-name (downcase new-name)))
- (setq default-directory (file-name-directory buffer-file-name))
- (rename-buffer new-name t)))
- (setq buffer-backed-up nil)
- (clear-visited-file-modtime)
- (if filename
- (progn
- (setq buffer-file-truename
- (abbreviate-file-name (file-truename buffer-file-name)))
- (if find-file-visit-truename
- (setq buffer-file-name buffer-file-truename))
- (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))))
- (setq buffer-file-truename nil buffer-file-number nil))
+ (let (truename)
+ (if filename
+ (setq filename
+ (if (string-equal filename "")
+ nil
+ (expand-file-name filename))))
+ (if filename
+ (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))))
+ (or (equal filename buffer-file-name)
+ (progn
+ (and filename (lock-buffer filename))
+ (unlock-buffer)))
+ (setq buffer-file-name filename)
+ (if filename ; make buffer name reflect filename.
+ (let ((new-name (file-name-nondirectory buffer-file-name)))
+ (if (string= new-name "")
+ (error "Empty file name"))
+ (if (eq system-type 'vax-vms)
+ (setq new-name (downcase new-name)))
+ (setq default-directory (file-name-directory buffer-file-name))
+ (or (string= new-name (buffer-name))
+ (rename-buffer new-name t))))
+ (setq buffer-backed-up nil)
+ (clear-visited-file-modtime)
+ (if truename
+ (setq buffer-file-truename (abbreviate-file-name truename)))
+ (setq buffer-file-number
+ (if filename
+ (nth 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.
;; Changing to visit an ordinary local file instead should flush the hook.
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
+ ;; If buffer was read-only because of version control,
+ ;; that reason is gone now, so make it writable.
+ (if vc-mode
+ (setq buffer-read-only nil))
+ (kill-local-variable 'vc-mode)
;; Turn off backup files for certain file names.
;; Since this is a permanent local, the major mode won't eliminate it.
(and (not (funcall backup-enable-predicate buffer-file-name))
;; ask the user to confirm now, before doing anything.
;; But don't actually delete til later.
(and targets
- (or (eq trim-versions-without-asking t) (eq trim-versions-without-asking nil))
- (or trim-versions-without-asking
+ (or (eq delete-old-versions t) (eq delete-old-versions nil))
+ (or delete-old-versions
(y-or-n-p (format "Delete excess backup versions of %s? "
real-file-name))))))
;; Actually write the back up file.
redefine it.
If the optional argument KEEP-BACKUP-VERSION is non-nil,
we do not remove backup version numbers, only true file version numbers."
- (let ((handler (find-file-name-handler name)))
+ (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
(substring name 0
;; sign, zero or more digits, provided this is the
;; second period encountered outside of the
;; device/directory part of the file name.
- (or (string-match ";[---+]?[0-9]*\\'" name)
- (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
+ (or (string-match ";[-+]?[0-9]*\\'" name)
+ (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
name)
(match-beginning 1))
(length name))
(string-match "~\\'" name)
(length name))))))))
+(defun file-ownership-preserved-p (file)
+ "Returns t if deleting FILE and rewriting it would preserve the owner."
+ (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)))))
+
+(defun file-name-sans-extension (filename)
+ "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+ directory)
+ (if (string-match "\\.[^.]*\\'" file)
+ (if (setq directory (file-name-directory filename))
+ (expand-file-name (substring file 0 (match-beginning 0))
+ directory)
+ (substring file 0 (match-beginning 0)))
+ filename))))
+
(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."
- (concat file "~"))
+ (if (eq system-type 'ms-dos)
+ (let ((fn (file-name-nondirectory file)))
+ (concat (file-name-directory file)
+ (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
+ (substring fn 0 (match-end 1)))
+ ".bak"))
+ (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."
- (string-match "~$" file))
+ (if (eq system-type 'ms-dos)
+ (string-match "\\.bak$" file)
+ (string-match "~$" file)))
;; This is used in various files.
;; The usage of bv-length is not very clean,
(list (make-backup-file-name fn))
(let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
(bv-length (length base-versions))
- (possibilities (file-name-all-completions
- base-versions
- (file-name-directory fn)))
- (versions (sort (mapcar
- (function backup-extract-version)
- possibilities)
- '<))
- (high-water-mark (apply 'max 0 versions))
- (deserve-versions-p
- (or version-control
- (> high-water-mark 0)))
- (number-to-delete (- (length versions)
- kept-old-versions kept-new-versions -1)))
+ possibilities
+ (versions nil)
+ (high-water-mark 0)
+ (deserve-versions-p nil)
+ (number-to-delete 0))
+ (condition-case ()
+ (setq possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn))
+ versions (sort (mapcar
+ (function backup-extract-version)
+ possibilities)
+ '<)
+ high-water-mark (apply 'max 0 versions)
+ deserve-versions-p (or version-control
+ (> high-water-mark 0))
+ number-to-delete (- (length versions)
+ kept-old-versions kept-new-versions -1))
+ (file-error
+ (setq possibilities nil)))
(if (not deserve-versions-p)
(list (make-backup-file-name fn))
(cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
-(defun file-relative-name-1 (directory)
- (cond ((string= directory "/")
- filename)
- ((string-match (concat "^" (regexp-quote directory))
- filename)
- (substring filename (match-end 0)))
- (t
- (file-relative-name-1
- (file-name-directory (substring directory 0 -1))))))
-
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
(setq filename (expand-file-name filename)
directory (file-name-as-directory (expand-file-name
(or directory default-directory))))
- (file-relative-name-1 directory))
+ (let ((ancestor ""))
+ (while (not (string-match (concat "^" (regexp-quote directory)) filename))
+ (setq directory (file-name-directory (substring directory 0 -1))
+ ancestor (concat "../" ancestor)))
+ (concat ancestor (substring filename (match-end 0)))))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
and `kept-new-versions', which tells how many newest versions to keep.
Defaults are 2 old versions and 2 new.
`dired-kept-versions' controls dired's clean-directory (.) command.
-If `trim-versions-without-asking' is nil, system will query user
+If `delete-old-versions' is nil, system will query user
before trimming versions. Otherwise it does it silently."
(interactive "p")
(let ((modp (buffer-modified-p))
(large (> (buffer-size) 50000))
- (make-backup-files (and make-backup-files (not (eq args 0)))))
+ (make-backup-files (or (and make-backup-files (not (eq args 0)))
+ (memq args '(16 64)))))
(and modp (memq args '(16 64)) (setq buffer-backed-up nil))
(if (and modp large) (message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(widen)
(and (> (point-max) 1)
(/= (char-after (1- (point-max))) ?\n)
+ (not (and (eq selective-display t)
+ (= (char-after (1- (point-max))) ?\r)))
(or (eq require-final-newline t)
(and require-final-newline
(y-or-n-p
(save-excursion
(goto-char (point-max))
(insert ?\n)))
- (let ((hooks (append write-contents-hooks local-write-file-hooks
- write-file-hooks))
- (done nil))
- (while (and hooks
- (not (setq done (funcall (car hooks)))))
- (setq hooks (cdr hooks)))
- ;; If a hook returned t, file is already "written".
- (cond ((not done)
- (if (not (file-writable-p buffer-file-name))
- (let ((dir (file-name-directory buffer-file-name)))
- (if (not (file-directory-p dir))
- (error "%s is not a directory" dir)
- (if (not (file-exists-p buffer-file-name))
- (error "Directory %s write-protected" dir)
- (if (yes-or-no-p
- (format "File %s is write-protected; try to save anyway? "
- (file-name-nondirectory
- buffer-file-name)))
- (setq tempsetmodes t)
- (error "Attempt to save to a file which you aren't allowed to write"))))))
- (or buffer-backed-up
- (setq setmodes (backup-buffer)))
- (if file-precious-flag
- ;; If file is precious, write temp name, then rename it.
- (let ((dir (file-name-directory buffer-file-name))
- (realname buffer-file-name)
- tempname temp nogood i succeed)
- (setq i 0)
- (setq nogood t)
- ;; Find the temporary name to write under.
- (while nogood
- (setq tempname (format "%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)
- (setq succeed t))
- ;; If writing the temp file fails,
- ;; delete the temp file.
- (or succeed (delete-file tempname)))
- ;; Since we have created an entirely new file
- ;; and renamed it, make sure it gets the
- ;; right permission bits set.
- (setq setmodes (file-modes buffer-file-name))
- ;; We succeeded in writing the temp file,
- ;; so rename it.
- (rename-file tempname buffer-file-name t))
- ;; If file not writable, see if we can make it writable
- ;; temporarily while we write it.
- ;; But no need to do so if we have just backed it up
- ;; (setmodes is set) because that says we're superseding.
- (cond ((and tempsetmodes (not setmodes))
- ;; Change the mode back, after writing.
- (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)))))
+ (or (run-hook-with-args-until-success 'write-contents-hooks)
+ (run-hook-with-args-until-success 'local-write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-hooks)
+ ;; 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)))
(if setmodes
(condition-case ()
(run-hooks 'after-save-hook))
(message "(No changes need to be saved)")))
+;; This does the "real job" of writing a buffer into its visited file
+;; and making a backup file. This is what is normally done
+;; but inhibited if one of write-file-hooks returns non-nil.
+;; It returns a value to store in setmodes.
+(defun basic-save-buffer-1 ()
+ (let (tempsetmodes setmodes)
+ (if (not (file-writable-p buffer-file-name))
+ (let ((dir (file-name-directory buffer-file-name)))
+ (if (not (file-directory-p dir))
+ (error "%s is not a directory" dir)
+ (if (not (file-exists-p buffer-file-name))
+ (error "Directory %s write-protected" dir)
+ (if (yes-or-no-p
+ (format "File %s is write-protected; try to save anyway? "
+ (file-name-nondirectory
+ buffer-file-name)))
+ (setq tempsetmodes t)
+ (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)))
+ (if (and file-precious-flag
+ (file-writable-p dir))
+ ;; If file is precious, write temp name, then rename it.
+ ;; This requires write access to the containing dir,
+ ;; which is why we don't try it if we don't have that access.
+ (let ((realname buffer-file-name)
+ tempname temp nogood i succeed
+ (old-modtime (visited-file-modtime)))
+ (setq i 0)
+ (setq nogood t)
+ ;; Find the temporary name to write under.
+ (while nogood
+ (setq tempname (format "%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)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed
+ (progn
+ (delete-file tempname)
+ (set-visited-file-modtime old-modtime))))
+ ;; Since we have created an entirely new file
+ ;; and renamed it, make sure it gets the
+ ;; right permission bits set.
+ (setq setmodes (file-modes buffer-file-name))
+ ;; We succeeded in writing the temp file,
+ ;; so rename it.
+ (rename-file tempname buffer-file-name t))
+ ;; If file not writable, see if we can make it writable
+ ;; temporarily while we write it.
+ ;; But no need to do so if we have just backed it up
+ ;; (setmodes is set) because that says we're superseding.
+ (cond ((and tempsetmodes (not setmodes))
+ ;; Change the mode back, after writing.
+ (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)))
+ setmodes))
+
(defun save-some-buffers (&optional arg exiting)
"Save some modified file-visiting buffers. Asks user about each one.
Optional argument (the prefix) non-nil means save all with no questions.
as well as about file buffers."
(interactive "P")
(save-window-excursion
- (if (zerop (map-y-or-n-p
- (function
- (lambda (buffer)
- (and (buffer-modified-p 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"))
- ))
- (message "(No files need saving)"))))
+ (let ((files-done
+ (map-y-or-n-p
+ (function
+ (lambda (buffer)
+ (and (buffer-modified-p 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
+ (message "(No files need saving)")))))
\f
(defun not-modified (&optional arg)
"Mark current buffer as unmodified, not needing to be saved.
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
- (interactive "fInsert file: ")
+ (interactive "*fInsert file: ")
(if (file-directory-p filename)
(signal 'file-error (list "Opening input file" "file is a directory"
filename)))
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
- (let ((handler (find-file-name-handler dir)))
+ (let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
(if (not parents)
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
- "Function to use to revert this buffer, or nil to do the default.")
+ "Function to use to revert this buffer, or nil to do the default.
+The function receives two arguments IGNORE-AUTO and NOCONFIRM,
+which are the arguments that `revert-buffer' received.")
(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
(defvar revert-buffer-insert-file-contents-function nil
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-When called from lisp, the first argument is IGNORE-AUTO; only offer
+When called from lisp, The first argument is IGNORE-AUTO; only offer
to revert from the auto-save file when this is nil. Note that the
sense of this argument is the reverse of the prefix argument, for the
sake of backward compatibility. IGNORE-AUTO is optional, defaulting
all.
If the value of `revert-buffer-function' is non-nil, it is called to
-do the work."
+do the work.
+
+The default revert function runs the hook `before-revert-hook' at the
+beginning and `after-revert-hook' at the end."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there which assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
((or noconfirm
(yes-or-no-p (format "Revert buffer from file %s? "
file-name)))
+ (run-hooks 'before-revert-hook)
;; If file was backed up but has changed since,
;; we shd make another backup.
(and (not auto-save-p)
;; so that we don't try to lock the file.
(let ((buffer-file-name nil))
(or auto-save-p
- (unlock-buffer))
- (erase-buffer))
- (insert-file-contents file-name (not auto-save-p))))
+ (unlock-buffer)))
+ (widen)
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))
(goto-char (min opoint (point-max)))
- (after-find-file nil nil t)
+ (after-find-file nil nil t t)
+ (run-hooks 'after-revert-hook)
t)))))
(defun recover-file (file)
(list (read-file-name "Recover file: "
file-dir nil nil file-name))))
(setq file (expand-file-name file))
- (if (auto-save-file-name-p file) (error "%s is an auto-save file" 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))
(interactive "P")
(setq buffer-auto-save-file-name
(and (if (null arg)
- (not buffer-auto-save-file-name)
+ (or (not buffer-auto-save-file-name)
+ ;; If autosave is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (< buffer-saved-size 0))
(or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
(if (and buffer-file-name auto-save-visited-file-name
(not buffer-read-only))
buffer-file-name
(make-auto-save-file-name))))
+ ;; If -1 was stored here, to temporarily turn off saving,
+ ;; turn it back on.
+ (and (< buffer-saved-size 0)
+ (setq buffer-saved-size 0))
(if (interactive-p)
(message "Auto-save %s (in this buffer)"
(if buffer-auto-save-file-name "on" "off")))
"#"
(file-name-nondirectory buffer-file-name)
"#")
- ;; For non-file bfr, use bfr name and Emacs pid.
- (expand-file-name (format "#%s#%s#" (buffer-name) (make-temp-name "")))))
+
+ ;; Deal with buffers that don't have any associated files. (Mail
+ ;; mode tends to create a good number of these.)
+
+ (let ((buffer-name (buffer-name))
+ (limit 0))
+ ;; Use technique from Sebastian Kremer's auto-save
+ ;; package to turn slashes into \\!. This ensures that
+ ;; the auto-save buffer name is unique.
+
+ (while (string-match "[/\\]" buffer-name limit)
+ (setq buffer-name (concat (substring buffer-name 0 (match-beginning 0))
+ (if (string= (substring buffer-name
+ (match-beginning 0)
+ (match-end 0))
+ "/")
+ "\\!"
+ "\\\\")
+ (substring buffer-name (match-end 0))))
+ (setq limit (1+ (match-end 0))))
+
+ (expand-file-name (format "#%s#%s#" buffer-name (make-temp-name ""))))))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
(defun insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
+SWITCHES may be a string of options, or a list of strings.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
This works by running a directory listing program
whose name is in the variable `insert-directory-program'.
If WILDCARD, it also runs the shell specified by `shell-file-name'."
- (let ((handler (find-file-name-handler file)))
+ ;; We need the directory in order to find the right handler.
+ (let ((handler (find-file-name-handler (expand-file-name file)
+ 'insert-directory)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(let ((default-directory
(if (file-name-absolute-p file)
(file-name-directory file)
- (file-name-directory (expand-file-name file)))))
+ (file-name-directory (expand-file-name file))))
+ (pattern (file-name-nondirectory file))
+ (beg 0))
+ ;; Quote some characters that have special meanings in shells;
+ ;; but don't quote the wildcards--we want them to be special.
+ ;; We also currently don't quote the quoting characters
+ ;; in case people want to use them explicitly to quote
+ ;; wildcard characters.
+ (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+ (setq pattern
+ (concat (substring pattern 0 (match-beginning 0))
+ "\\"
+ (substring pattern (match-beginning 0)))
+ beg (1+ (match-end 0))))
(call-process shell-file-name nil t nil
"-c" (concat insert-directory-program
- " -d " switches " "
- (file-name-nondirectory file))))
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " "
+ pattern)))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
- (call-process insert-directory-program nil t nil switches
- (if full-directory-p
- (concat (file-name-as-directory file) ".")
- file)))))))
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (let (list)
+ (if (listp switches)
+ (setq list switches)
+ (if (not (equal switches ""))
+ (progn
+ ;; Split the switches at any spaces
+ ;; so we can pass separate options as separate args.
+ (while (string-match " " switches)
+ (setq list (cons (substring switches 0 (match-beginning 0))
+ list)
+ switches (substring switches (match-end 0))))
+ (setq list (cons switches list)))))
+ (append list
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file) ".")
+ file))))))))))
+
+(defvar kill-emacs-query-functions nil
+ "Functions to call with no arguments to query about killing Emacs.
+If any of these functions returns nil, killing Emacs is cancelled.")
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
(setq processes (cdr processes)))
(or (not active)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
+ ;; Query the user for other things, perhaps.
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
(kill-emacs)))
\f
(define-key ctl-x-map "\C-f" 'find-file)