;;; 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
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.")
(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."
+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)))
(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))))
(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) ?/))))
+ (= (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)
("\\.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)
FUNCTION, we delete the suffix that matched REGEXP and search the list
again for another match.")
-(defconst inhibit-local-variables-regexps '("\\.tar$")
- "List of regexps; if one matches a file name, don't look for local vars.")
+(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
(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."
(skip-chars-forward " \t\n")
(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))
+ ;; 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)))
(goto-char beg)
(if (save-excursion (search-forward ":" end t))
;; Find all specifications for the `mode:' variable
- ;; and execute hem left to right.
+ ;; and execute them left to right.
(while (let ((case-fold-search t))
(search-forward "mode:" end t))
(skip-chars-forward " \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)
- (case-fold-search (eq system-type 'vax-vms))
(keep-going t))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(let ((alist auto-mode-alist)
(mode nil))
;; Find first matching alist entry.
- (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)))))))))
+ (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.
;; 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))))
+ (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))))
(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))))
- (or (eq key 'mode)
- (hack-one-local-variable key val)))
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
(setq result (cdr result)))))))
(defun hack-local-variables ()
'(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 (memq var '(eval file-name-handler-alist after-load-alist))
- (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))
- (or (string= new-name (buffer-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."
"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.
(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
If the value of `revert-buffer-function' is non-nil, it is called to
do the work.
-The normal hook `after-revert-hook' is run at the end of `revert-buffer'."
+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)
- t))))
- (run-hooks 'after-revert-hook))
+ (after-find-file nil nil t t)
+ (run-hooks 'after-revert-hook)
+ t)))))
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save 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)