;;; 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
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.")
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 ((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 ()
"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."
(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)))
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 "")
(setq filename "/"))))
- (let ((handler (find-file-name-handler 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
;; 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
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 (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)
;; 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))
+ (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.
(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)
+ ("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
+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-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)
+ (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)
+ (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 '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)
+
+(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)
((memq var ignored-local-variables)
nil)
;; "Setting" eval means either eval it or do nothing.
- ((eq var 'eval)
- (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' local variable in file %s? "
- (file-name-nondirectory buffer-file-name))))))))
- (save-excursion (eval val))
+ ;; Likewise for setting hook variables.
+ ((or (get var 'risky-local-variable)
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$"
+ (symbol-name var)))
+ ;; 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))
+ (eq (nth 3 val) 'defun))
+ (memq (nth 1 (nth 2 val))
+ '(lisp-indent-hook)))
+ ;; Permit eval if not root and user says ok.
+ (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)))))))))
+ (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)
nil
(expand-file-name filename))))
(or (equal filename buffer-file-name)
- (null filename)
(progn
- (lock-buffer filename)
+ (and filename (lock-buffer filename))
(unlock-buffer)))
(setq buffer-file-name filename)
(if filename ; make buffer name reflect filename.
(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
(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))
(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))
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))
(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
(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
(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)))))
+ (setq setmodes (basic-save-buffer-1)))))
(setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
;; 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)")))
+;; 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)))
+ (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))
+ 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)))
(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")
- (let ((handler (find-file-name-handler dir)))
+ "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 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
(if (not 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)
;; 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)
+ (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))
(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")))
;; 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
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)))
+ (let ((handler (find-file-name-handler file 'insert-directory)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(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))))
+ (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))))
- ;; 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))))))
+ 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)))))))
+
+(defvar kill-emacs-query-functions nil
+ "Functions to call with no arguments to query about killing Emacs.")
(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.
+ (let ((functions kill-emacs-query-functions)
+ (yes t))
+ (while (and functions yes)
+ (setq yes (and yes (funcall (car functions))))
+ (setq functions (cdr functions)))
+ yes)
(kill-emacs)))
\f
(define-key ctl-x-map "\C-f" 'find-file)
HCoop / bpt / emacs.git / blobdiff