;;; 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
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.")
;;; Turn off backup files on VMS since it has version numbers.
(defconst make-backup-files (not (eq system-type 'vax-vms))
- "*Create a backup of each file when it is saved for the first time.
+ "*Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.
Renaming means that Emacs renames the existing file so that it is a
The choice of renaming or copying is controlled by the variables
`backup-by-copying', `backup-by-copying-when-linked' and
-`backup-by-copying-when-mismatch'.")
+`backup-by-copying-when-mismatch'. See also `backup-inhibited'.")
;; Do this so that local variables based on the file name
;; are not overridden by the major mode.
(defvar backup-inhibited nil
- "Non-nil means don't make a backup file for this buffer.")
+ "Non-nil means don't make a backup, regardless of the other parameters.
+This variable is intended for use by making it local to a buffer.
+But it is local only if you make it local.")
(put 'backup-inhibited 'permanent-local t)
(defconst backup-by-copying nil
Loading an abbrev file sets this to t.")
(defconst find-file-run-dired t
- "*Non-nil says run dired if find-file is given the name of a directory.")
+ "*Non-nil says run dired if `find-file' is given the name of a directory.")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
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.
(defalias 'lock-buffer 'ignore))
(or (fboundp 'unlock-buffer)
(defalias 'unlock-buffer 'ignore))
+
+;; This hook function provides support for ange-ftp host name
+;; completion. It runs the usual ange-ftp hook, but only for
+;; completion operations. Having this here avoids the need
+;; to load ange-ftp when it's not really in use.
+(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)
+ (apply op args))))
\f
(defun pwd ()
"Show the current default directory."
(setq cd-path (concat cd-path ":"))
(while (setq cd-colon (string-match ":" cd-path cd-start))
(setq cd-list
- (nconc cd-list (list (substitute-in-file-name (file-name-as-directory (substring cd-path cd-start cd-colon))))))
+ (nconc cd-list
+ (list (if (= cd-start cd-colon)
+ nil
+ (substitute-in-file-name
+ (file-name-as-directory
+ (substring cd-path cd-start cd-colon)))))))
(setq cd-start (+ cd-colon 1)))
cd-list)))
(defun cd-absolute (dir)
- "Change current directory to given absolute path DIR."
- (interactive "DChange default directory: ")
- (setq dir (expand-file-name dir))
+ "Change current directory to given absolute file name DIR."
+ (setq dir (abbreviate-file-name (expand-file-name dir)))
(if (not (eq system-type 'vax-vms))
(setq dir (file-name-as-directory dir)))
(if (not (file-directory-p dir))
(error "%s is not a directory" dir)
(if (file-executable-p dir)
(setq default-directory dir)
- (error "Cannot cd to %s: Permission denied" dir)))
-)
+ (error "Cannot cd to %s: Permission denied" dir))))
(defun cd (dir)
"Make DIR become the current buffer's default directory.
-If your environment imcludes a $CDPATH variable, cd tries each one of that
-colon-separated list of directories when resolving a relative cd."
+If your environment includes a `CDPATH' variable, try each one of that
+colon-separated list of directories when resolving a relative directory name."
(interactive "FChange default directory: ")
- (let ((first (aref dir 0)))
- (if (or (= first ?/) (= first ?~))
- (cd-absolute (expand-file-name dir))
- (if (null cd-path)
- (let ((trypath (parse-colon-path (getenv "CDPATH"))))
- (setq cd-path (or trypath "./"))))
- (if (not (catch 'found
- (mapcar
- (function (lambda (x)
- (let ((f (expand-file-name (concat x dir))))
- (if (file-directory-p f)
- (progn
- (cd-absolute f)
- (throw 'found t))))))
- cd-path)
- nil))
- (error "No such directory on your cd path.")))
- ))
+ (if (file-name-absolute-p dir)
+ (cd-absolute (expand-file-name dir))
+ (if (null cd-path)
+ (let ((trypath (parse-colon-path (getenv "CDPATH"))))
+ (setq cd-path (or trypath (list "./")))))
+ (if (not (catch 'found
+ (mapcar
+ (function (lambda (x)
+ (let ((f (expand-file-name (concat x dir))))
+ (if (file-directory-p f)
+ (progn
+ (cd-absolute f)
+ (throw 'found t))))))
+ cd-path)
+ nil))
+ (error "No such directory found via CDPATH environment variable"))))
(defun load-file (file)
"Load the Lisp file named FILE."
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 "~")
+ (if (or (string= filename "~")
+ (and (string= (substring filename 0 1) "~")
+ (string-match "~[^/]*" filename)))
(progn
(setq filename (expand-file-name filename))
(if (string= filename "")
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
(setq dir (file-name-as-directory (file-truename dirfile))))
- ;; 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.
- (file-truename (expand-file-name target dir))
- ;; No, we are done!
- filename)))))
-
+ (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)))))))
+
+(defun file-chase-links (filename)
+ "Chase links in FILENAME until a name that is not a link.
+Does not examine containing directories for links,
+unlike `file-truename'."
+ (let (tem (count 100) (newname filename))
+ (while (setq tem (file-symlink-p newname))
+ (if (= count 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ ;; 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)
+ (setq tem (substring tem 3))
+ (setq newname (file-name-as-directory
+ ;; Do the .. by hand.
+ (directory-file-name
+ (file-name-directory
+ ;; Chase links in the default dir of the symlink.
+ (file-chase-links
+ (directory-file-name
+ (file-name-directory newname))))))))
+ (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq count (1- count)))
+ newname))
\f
(defun switch-to-buffer-other-window (buffer)
"Select buffer BUFFER in another window."
Use \\[toggle-read-only] to permit editing."
(interactive "fFind file read-only: ")
(find-file filename)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (current-buffer))
(defun find-file-read-only-other-window (filename)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
(interactive "fFind file read-only other window: ")
- (find-file filename)
- (setq buffer-read-only t))
+ (find-file-other-window filename)
+ (setq buffer-read-only t)
+ (current-buffer))
(defun find-file-read-only-other-frame (filename)
"Edit file FILENAME in another frame but don't allow changes.
Use \\[toggle-read-only] to permit editing."
(interactive "fFind file read-only other frame: ")
(find-file-other-frame filename)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (current-buffer))
(defun find-alternate-file (filename)
"Find file FILENAME, select its buffer, kill previous buffer.
(error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
+ (onum buffer-file-number)
+ (otrue buffer-file-truename)
(oname (buffer-name)))
(rename-buffer " **lose**")
(setq buffer-file-name nil)
+ (setq buffer-file-number nil)
+ (setq buffer-file-truename nil)
(unwind-protect
(progn
(unlock-buffer)
(find-file filename))
(cond ((eq obuf (current-buffer))
(setq buffer-file-name ofile)
+ (setq buffer-file-number onum)
+ (setq buffer-file-truename otrue)
(lock-buffer)
(rename-buffer oname))))
(or (eq (current-buffer) obuf)
"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'.
;; Compute and save the abbreviated homedir name.
;; We defer computing this until the first time it's needed, to
;; give time for directory-abbrev-alist to be set properly.
+ ;; We include a slash at the end, to avoid spurious matches
+ ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
(or abbreviated-home-dir
(setq abbreviated-home-dir
(let ((abbreviated-home-dir "$foo"))
- (concat "^" (abbreviate-file-name (expand-file-name "~"))))))
+ (concat "^" (abbreviate-file-name (expand-file-name "~"))
+ "\\(/\\|$\\)"))))
+
;; 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) ?/))))
(setq filename
- (concat "~" (substring filename (match-end 0)))))
+ (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))
(defvar find-file-not-true-dirname-list nil
;; Run find-file-not-found-hooks until one returns non-nil.
(let ((hooks find-file-not-found-hooks))
(while (and hooks
- (not (funcall (car 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))))))
;; Find the file's truename, and maybe use that as visited name.
(setq buffer-file-truename (abbreviate-file-name truename))
(not (member logical find-file-not-true-dirname-list)))
(setq buffer-file-name buffer-file-truename))
(if find-file-visit-truename
- (setq buffer-file-name (setq filename buffer-file-truename)))
+ (setq buffer-file-name
+ (setq filename
+ (expand-file-name buffer-file-truename))))
;; Set buffer's default directory to that of the file.
(setq default-directory (file-name-directory filename))
;; Turn off backup files for certain file names. Since
(msg
(cond ((and error (file-attributes buffer-file-name))
(setq buffer-read-only t)
- "File exists, but is read-protected.")
+ "File exists, but cannot be read.")
((not buffer-read-only)
(if (and warn
(file-newer-than-file-p (make-auto-save-file-name)
("\\.lisp\\'" . lisp-mode)
("\\.f\\'" . fortran-mode)
("\\.for\\'" . fortran-mode)
+ ("\\.p\\'" . pascal-mode)
+ ("\\.pas\\'" . pascal-mode)
("\\.mss\\'" . scribe-mode)
("\\.pl\\'" . prolog-mode)
("\\.cc\\'" . c++-mode)
+ ("\\.hh\\'" . c++-mode)
("\\.C\\'" . c++-mode)
- ("\\.mk\\'" . makefile-mode)
- ("[Mm]akefile" . makefile-mode)
+ ("\\.H\\'" . c++-mode)
+;;; ("\\.mk\\'" . makefile-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)
("\\.lex\\'" . c-mode)
("\\.oak\\'" . scheme-mode)
("\\.scm.[0-9]*\\'" . scheme-mode)
+ ("\\.sgm\\'" . sgml-mode)
+ ("\\.sgml\\'" . sgml-mode)
+ ("\\.dtd\\'" . sgml-mode)
;; .emacs following a directory delimiter
;; in either Unix or VMS syntax.
("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; _emacs following a directory delimiter
+ ;; in MsDos syntax
+ ("[:/]_emacs\\'" . emacs-lisp-mode)
("\\.ml\\'" . lisp-mode)))
"\
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.")
+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)
+ ("scope" . tcl-mode)
+ ("wish" . tcl-mode)
+ ("shell" . tcl-mode)
+ ("form" . tcl-mode)
+ ("tcl" . tcl-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-local-variables-regexps '("\\.tar$")
+ "List of regexps; if one matches a file name, don't look for local vars.")
+
+(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
+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'.
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
- (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")))
- (let ((alist auto-mode-alist)
- (name buffer-file-name))
- (let ((case-fold-search (eq system-type 'vax-vms)))
+ (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 (save-excursion (search-forward ":" end t))
+ ;; Find all specifications for the `mode:' variable
+ ;; and execute hem 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)
+ (case-fold-search (eq system-type 'vax-vms))
+ (keep-going t))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
- ;; 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))))
+ (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)
+ (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 "#! *")
+ (progn
+ (goto-char (match-end 0))
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))
+ "")))
+ 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)
+ (end (save-excursion (end-of-line) (point))))
;; Parse the -*- line into the `result' alist.
(cond ((not (search-forward "-*-" end t))
;; doesn't have one.
(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)))
+ (or (eq key 'mode)
+ (hack-one-local-variable key val)))
+ (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))
((memq var ignored-local-variables)
nil)
;; "Setting" eval means either eval it or do nothing.
- ((eq var 'eval)
+ ;; 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
(beginning-of-line)
(set-window-start (selected-window) (point)))
(setq enable-local-eval
- (y-or-n-p (format "Process `eval' local variable in file %s? "
+ (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
(file-name-nondirectory buffer-file-name))))))))
- (save-excursion (eval val))
+ (if (eq var 'eval)
+ (save-excursion (eval val))
+ (make-local-variable var)
+ (set var val))
(message "Ignoring `eval:' in file's local variables")))
;; Ordinary variable, really set it.
(t (make-local-variable var)
(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)))
+ (or (string= new-name (buffer-name))
+ (rename-buffer new-name t))))
(setq buffer-backed-up nil)
(clear-visited-file-modtime)
(if filename
(progn
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
- ;; If auto-save was not already on, turn it on if appropriate.
- (if (not buffer-auto-save-file-name)
- (auto-save-mode (and buffer-file-name auto-save-default))
- ;; If auto save is on, start using a new name.
- ;; We deliberately don't rename or delete the old auto save
- ;; for the old visited file name. This is because perhaps
- ;; the user wants to save the new state and then compare with the
- ;; previous state from the auto save file.
- (setq buffer-auto-save-file-name
- (make-auto-save-file-name)))
+ (let ((oauto buffer-auto-save-file-name))
+ ;; If auto-save was not already on, turn it on if appropriate.
+ (if (not buffer-auto-save-file-name)
+ (and buffer-file-name auto-save-default
+ (auto-save-mode t))
+ ;; If auto save is on, start using a new name.
+ ;; We deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because perhaps
+ ;; the user wants to save the new state and then compare with the
+ ;; previous state from the auto save file.
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name)))
+ ;; Rename the old auto save file if any.
+ (and oauto buffer-auto-save-file-name
+ (file-exists-p oauto)
+ (rename-file oauto buffer-auto-save-file-name t)))
(if buffer-file-name
(set-buffer-modified-p t)))
backup-info backupname targets setmodes)
;; If specified name is a symbolic link, chase it to the target.
;; Thus we make the backups in the directory where the real file is.
- (while (let ((tem (file-symlink-p real-file-name)))
- (if tem
- (setq real-file-name
- (expand-file-name tem
- (file-name-directory real-file-name))))
- tem))
+ (setq real-file-name (file-chase-links real-file-name))
(setq backup-info (find-backup-file-name real-file-name)
backupname (car backup-info)
targets (cdr backup-info))
(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 (if directory
- (expand-file-name directory)
- default-directory)))
- (file-relative-name-1 directory))
+ directory (file-name-as-directory (expand-file-name
+ (or directory default-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.
(rename-buffer buffer-new-name)))
;; If buffer has no file name, ask user for one.
(or buffer-file-name
- (progn
- (setq buffer-file-name
- (expand-file-name (read-file-name "File to save in: ") nil)
- default-directory (file-name-directory buffer-file-name))
- (auto-save-mode auto-save-default)))
+ (set-visited-file-name
+ (expand-file-name (read-file-name "File to save in: ") nil)))
(or (verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
;; If the auto-save file was recent before this command,
;; delete it now.
(delete-auto-save-file-if-necessary recent-save)
- (run-hooks 'after-save-hooks))
+ (run-hooks 'after-save-hook))
(message "(No changes need to be saved)")))
(defun save-some-buffers (&optional arg exiting)
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)))
(let ((tem (insert-file-contents filename)))
(push-mark (+ (point) (car (cdr tem))))))
(set-buffer-modified-p (buffer-modified-p)))) ; force mode line update
(defun make-directory (dir &optional parents)
- "Create the directory DIR and any nonexistent parent dirs."
- (interactive "FMake directory: \nP")
+ "Create the directory DIR and any nonexistent parent dirs.
+Interactively, the default choice of directory to create
+is the current default directory for file names.
+That is useful when you have visited a file in a nonexistint directory.
+
+Noninteractively, the second (optional) argument PARENTS says whether
+to create parent directories if they don't exist."
+ (interactive
+ (list (read-file-name "Make directory: " default-directory default-directory
+ nil nil)
+ t))
(let ((handler (find-file-name-handler dir)))
(if handler
(funcall handler 'make-directory dir parents)
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)
(insert-file-contents file-name (not auto-save-p))))
(goto-char (min opoint (point-max)))
(after-find-file nil nil 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))
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
(defun insert-directory (file switches &optional wildcard full-directory-p)
- "Insert directory listing for of FILE, formatted according to SWITCHES.
+ "Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
(if wildcard
- (let ((default-directory (file-name-directory file)))
+ ;; Run ls in the directory of the file pattern we asked for.
+ (let ((default-directory
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name file)))))
(call-process shell-file-name nil t nil
"-c" (concat insert-directory-program
" -d " switches " "
(file-name-nondirectory file))))
- ;; Chase links till we reach a non-link.
- ;; This used to be commented out, but Barry Margolin says:
- ;; SunOS 4.1.3 (and SV and POSIX?) lists the link
- ;; if we give a link to a directory - yuck!
- (let (symlink)
- (while (setq symlink (file-symlink-p file))
- (setq file symlink)))
- (call-process insert-directory-program nil t nil switches file))))))
+ ;; 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)))))))
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.