;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,2003
;;; Free Software Foundation, Inc.
;; Maintainer: FSF
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
- :type 'directory)
+ :type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device "/dev/null" "The system null device.")
"[\000-\031]\\|" ; control characters
"\\(/\\.\\.?[^/]\\)\\|" ; leading dots
"\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[|<>\"?*\000-\031]")) ; invalid characters
(t "[\000]"))
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
- ,(expand-file-name "\\2" temporary-file-directory)))
+ ;; Don't put "\\2" inside expand-file-name, since it will be
+ ;; transformed to "/2" on DOS/Windows.
+ ,(concat temporary-file-directory "\\2") t))
"*Transforms to apply to buffer file name before making auto-save file name.
-Each transform is a list (REGEXP REPLACEMENT):
+Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
REGEXP is a regular expression to match against the file name.
If it matches, `replace-match' is used to replace the
matching part with REPLACEMENT.
+If the optional element UNIQUIFY is non-nil, the auto-save file name is
+constructed by taking the directory part of the replaced file-name,
+concatenated with the buffer file name with all directory separators
+changed to `!' to prevent clashes. This will not work
+correctly if your filesystem truncates the resulting name.
+
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
no further transforms are tried.
The default value is set up to put the auto-save file into the
temporary directory (see the variable `temporary-file-directory') for
-editing a remote file."
+editing a remote file.
+
+On MS-DOS filesystems without long names this variable is always
+ignored."
:group 'auto-save
- :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
+ :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
:version "21.1")
(defcustom save-abbrevs t
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
-(defvar find-file-not-found-hooks nil
+(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
+(defvaralias 'find-file-not-found-hooks 'find-file-not-found-functions)
+(make-obsolete-variable
+ 'find-file-not-found-hooks 'find-file-not-found-functions "21.4")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
-(defvar find-file-hooks nil
+(defvar find-file-hook nil
"List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
functions are called.")
+(defvaralias 'find-file-hooks 'find-file-hook)
+(make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4")
-(defvar write-file-hooks nil
+(defvar write-file-functions 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
and the rest are not called.
These hooks are considered to pertain to the visited file.
-So any buffer-local binding of `write-file-hooks' is
-discarded if you change the visited file name with \\[set-visited-file-name].
-
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
-See also `write-contents-hooks'.")
-;;; However, in case someone does make it local...
-(put 'write-file-hooks 'permanent-local t)
-
-(defvar local-write-file-hooks nil
- "Just like `write-file-hooks', except intended for per-buffer use.
-The functions in this list are called before the ones in
-`write-file-hooks'.
-
-This variable is meant to be used for hooks that have to do with a
-particular visited file. Therefore, it is a permanent local, so that
-changing the major mode does not clear it. However, calling
-`set-visited-file-name' does clear it.")
+So any buffer-local binding of this variable is discarded if you change
+the visited file name with \\[set-visited-file-name], but not when you
+change the major mode.
+
+See also `write-contents-functions'.")
+(put 'write-file-functions 'permanent-local t)
+(defvaralias 'write-file-hooks 'write-file-functions)
+(make-obsolete-variable 'write-file-hooks 'write-file-functions "21.4")
+
+(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
+(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "21.4")
-(defvar write-contents-hooks nil
+(defvar write-contents-functions 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
and the rest are not called.
`set-visited-file-name' does not clear this variable; but changing the
major mode does clear it.
-This variable automatically becomes buffer-local whenever it is set.
-If you use `add-hook' to add elements to the list, use nil for the
-LOCAL argument.
-
-See also `write-file-hooks'.")
-(make-variable-buffer-local 'write-contents-hooks)
+See also `write-file-functions'.")
+(make-variable-buffer-local 'write-contents-functions)
+(defvaralias 'write-contents-hooks 'write-contents-functions)
+(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "21.4")
(defcustom enable-local-variables t
"*Control use of local variables in files you visit.
(or (fboundp 'file-locked-p)
(defalias 'file-locked-p 'ignore))
-(defvar view-read-only nil
- "*Non-nil means buffers visiting files read-only, do it in view mode.")
+(defcustom view-read-only nil
+ "*Non-nil means buffers visiting files read-only do so in view mode.
+In fact, this means that all read-only buffers normally have
+View mode enabled, including buffers that are read-only because
+you visit a file you cannot alter, and buffers you make read-only
+using \\[toggle-read-only]."
+ :type 'boolean
+ :group 'view)
+(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
"Provides support for ange-ftp host name completion.
Runs the usual ange-ftp hook, but only for completion operations."
that really does change some file names to canonicalize certain
patterns and to guarantee valid names."
filename)
+
+(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
+ "Read directory name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-DIRNAME if user enters a null string.
+ (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used,
+ except that if INITIAL is specified, that combined with DIR is used.)
+Fourth arg MUSTMATCH non-nil means require existing directory's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+DIR defaults to current buffer's directory default."
+ (unless dir
+ (setq dir default-directory))
+ (unless default-dirname
+ (setq default-dirname
+ (if initial (concat dir initial) default-directory)))
+ (read-file-name prompt dir default-dirname mustmatch initial
+ 'file-directory-p))
+
\f
(defun pwd ()
"Show the current default directory."
\(For values of `colon' equal to `path-separator'.)"
;; We could use split-string here.
(and cd-path
- (let (cd-prefix cd-list (cd-start 0) cd-colon)
+ (let (cd-list (cd-start 0) cd-colon)
(setq cd-path (concat cd-path path-separator))
(while (setq cd-colon (string-match path-separator cd-path cd-start))
(setq cd-list
If your environment includes a `CDPATH' variable, try each one of that
colon-separated list of directories when resolving a relative directory name."
(interactive
- (list (read-file-name "Change default directory: "
+ (list (read-directory-name "Change default directory: "
default-directory default-directory
(and (member cd-path '(nil ("./")))
(null (getenv "CDPATH"))))))
(read-file-name "Load file: "))))
(load (expand-file-name file) nil nil t))
+(defun locate-file (filename path &optional suffixes predicate)
+ "Search for FILENAME through PATH.
+If SUFFIXES is non-nil, it should be a list of suffixes to append to
+file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
+If non-nil, PREDICATE is used instead of `file-readable-p'.
+PREDICATE can also be an integer to pass to the `access' system call,
+in which case file-name handlers are ignored. This usage is deprecated.
+
+For compatibility, PREDICATE can also be one of the symbols
+`executable', `readable', `writable', or `exists', or a list of
+one or more of those symbols."
+ (if (and predicate (symbolp predicate) (not (functionp predicate)))
+ (setq predicate (list predicate)))
+ (when (and (consp predicate) (not (functionp predicate)))
+ (setq predicate
+ (logior (if (memq 'executable predicate) 1 0)
+ (if (memq 'writable predicate) 2 0)
+ (if (memq 'readable predicate) 4 0))))
+ (locate-file-internal filename path suffixes predicate))
+
+(defun locate-file-completion (string path-and-suffixes action)
+ "Do completion for file names passed to `locate-file'.
+PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)."
+ (if (file-name-absolute-p string)
+ (read-file-name-internal string nil action)
+ (let ((names nil)
+ (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
+ (string-dir (file-name-directory string)))
+ (dolist (dir (car path-and-suffixes))
+ (if string-dir (setq dir (expand-file-name string-dir dir)))
+ (when (file-directory-p dir)
+ (dolist (file (file-name-all-completions
+ (file-name-nondirectory string) dir))
+ (push (if string-dir (concat string-dir file) file) names)
+ (when (string-match suffix file)
+ (setq file (substring file 0 (match-beginning 0)))
+ (push (if string-dir (concat string-dir file) file) names)))))
+ (cond
+ ((eq action t) (all-completions string names))
+ ((null action) (try-completion string names))
+ (t (test-completion string names))))))
+
(defun load-library (library)
"Load the library named LIBRARY.
This is an interface to the function `load'."
- (interactive "sLoad library: ")
+ (interactive
+ (list (completing-read "Load library: "
+ 'locate-file-completion
+ (cons load-path load-suffixes))))
(load library))
+(defun file-remote-p (file)
+ "Test whether FILE specifies a location on a remote system."
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
+ (if handler
+ (get handler 'file-remote-p))))
+
(defun file-local-copy (file)
"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
;; it is stored on disk (expanding short name aliases with the full
;; name in the process).
(if (eq system-type 'windows-nt)
- (let ((handler (find-file-name-handler filename 'file-truename))
- newname)
+ (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))
;; If filename contains a wildcard, newname will be the old name.
- (if (string-match "[[*?]" filename)
- (setq newname filename)
- ;; If filename doesn't exist, newname will be nil.
- (setq newname (w32-long-file-name filename)))
- (setq filename (or newname filename)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use the long name
+ (setq filename (or (w32-long-file-name filename) filename))))
(setq done t)))
;; If this file directly leads to a link, process that iteratively
(setq done t))))))))
filename))
-(defun file-chase-links (filename)
+(defun file-chase-links (filename &optional limit)
"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))
+Unlike `file-truename', this does not check whether a parent
+directory name is a symbolic link.
+If the optional argument LIMIT is a number,
+it means chase no more than that many links and then stop."
+ (let (tem (newname filename)
+ (count 0))
+ (while (and (or (null limit) (< count limit))
+ (setq tem (file-symlink-p newname)))
(save-match-data
- (if (= count 0)
+ (if (and (null limit) (= count 100))
(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)
;; Now find the parent of that dir.
(setq newname (file-name-directory newname)))
(setq newname (expand-file-name tem (file-name-directory newname)))
- (setq count (1- count))))
+ (setq count (1+ count))))
+ newname))
+
+(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
+ "Change the encoding of FILE's name from CODING to NEW-CODING.
+The value is a new name of FILE.
+Signals a `file-already-exists' error if a file of the new name
+already exists unless optional third argument OK-IF-ALREADY-EXISTS
+is non-nil. A number as third arg means request confirmation if
+the new name already exists. This is what happens in interactive
+use with M-x."
+ (interactive
+ (let ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ (filename (read-file-name "Recode filename: " nil nil t))
+ from-coding to-coding)
+ (if (and default-coding
+ ;; We provide the default coding only when it seems that
+ ;; the filename is correctly decoded by the default
+ ;; coding.
+ (let ((charsets (find-charset-string filename)))
+ (and (not (memq 'eight-bit-control charsets))
+ (not (memq 'eight-bit-graphic charsets)))))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from (default %s): "
+ filename default-coding)
+ default-coding))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from: " filename))))
+
+ ;; We provide the default coding only when a user is going to
+ ;; change the encoding not from the default coding.
+ (if (eq from-coding default-coding)
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to: "
+ filename from-coding)))
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to (default %s): "
+ filename from-coding default-coding)
+ default-coding)))
+ (list filename from-coding to-coding)))
+
+ (let* ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ ;; FILE should have been decoded by DEFAULT-CODING.
+ (encoded (encode-coding-string file default-coding))
+ (newname (decode-coding-string encoded coding))
+ (new-encoded (encode-coding-string newname new-coding))
+ ;; Suppress further encoding.
+ (file-name-coding-system nil)
+ (default-file-name-coding-system nil)
+ (locale-coding-system nil))
+ (rename-file encoded new-encoded ok-if-already-exists)
newname))
\f
(defun switch-to-buffer-other-window (buffer &optional norecord)
(pop-to-buffer buffer t norecord)
(raise-frame (window-frame (selected-window)))))
+(defvar find-file-default nil
+ "Used within `find-file-read-args'.")
+
+(defun find-file-read-args (prompt mustmatch)
+ (list (let ((find-file-default
+ (and buffer-file-name
+ (abbreviate-file-name buffer-file-name)))
+ (munge-default-fun
+ (lambda ()
+ (setq minibuffer-default find-file-default)
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (pop minibuffer-setup-hook)))
+ (minibuffer-setup-hook
+ minibuffer-setup-hook))
+ (add-hook 'minibuffer-setup-hook munge-default-fun)
+ (read-file-name prompt nil default-directory mustmatch))
+ t))
+
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists.
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files. Wildcard expansion
can be suppressed by setting `find-file-wildcards'."
- (interactive "FFind file: \np")
+ (interactive
+ (find-file-read-args "Find file: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
"Edit file FILENAME, in another window.
May create a new window, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other window: \np")
+ (interactive (find-file-read-args "Find file in other window: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
"Edit file FILENAME, in another frame.
May create a new frame, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other frame: \np")
+ (interactive (find-file-read-args "Find file in other frame: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
-Like `find-file' but marks buffer as read-only.
+Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only: \np")
+ (interactive (find-file-read-args "Find file read-only: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file filename wildcards)
(toggle-read-only 1)
(current-buffer))
"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: \np")
+ (interactive (find-file-read-args "Find file read-only other window: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-window filename wildcards)
(toggle-read-only 1)
(current-buffer))
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only other frame: \np")
+ (interactive (find-file-read-args "Find file read-only other frame: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-frame filename wildcards)
(toggle-read-only 1)
(current-buffer))
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil nil file-name))))
- (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))))
- (error "Aborted"))
+ (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
+ (error "Aborted"))
+ (when (and (buffer-modified-p) (buffer-file-name))
+ (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
+ (buffer-name)))
+ (save-buffer)
+ (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
+ (error "Aborted"))))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
+ (odir dired-directory)
(otrue buffer-file-truename)
(oname (buffer-name)))
(if (get-buffer " **lose**")
(unwind-protect
(progn
(unlock-buffer)
+ ;; This prevents us from finding the same buffer
+ ;; if we specified the same file again.
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
+ ;; Likewise for dired buffers.
+ (setq dired-directory nil)
(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)
- (kill-buffer obuf))))
+ (when (eq obuf (current-buffer))
+ ;; This executes if find-file gets an error
+ ;; and does not really find anything.
+ ;; We put things back as they were.
+ ;; If find-file actually finds something, we kill obuf below.
+ (setq buffer-file-name ofile)
+ (setq buffer-file-number onum)
+ (setq buffer-file-truename otrue)
+ (setq dired-directory odir)
+ (lock-buffer)
+ (rename-buffer oname)))
+ (unless (eq (current-buffer) obuf)
+ (with-current-buffer obuf
+ ;; We already asked; don't ask again.
+ (let ((kill-buffer-query-functions))
+ (kill-buffer obuf))))))
\f
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
-This also substitutes \"~\" for the user's home directory.
-Type \\[describe-variable] directory-abbrev-alist RET for more information."
+This also substitutes \"~\" for the user's home directory and
+removes automounter prefixes (see the variable `automount-dir-prefix')."
;; Get rid of the prefixes added by the automounter.
(if (and automount-dir-prefix
(string-match automount-dir-prefix filename)
;; MS-DOS root directories can come with a drive letter;
;; Novell Netware allows drive letters beyond `Z:'.
(not (and (or (eq system-type 'ms-dos)
+ (eq system-type 'cygwin)
(eq system-type 'windows-nt))
(save-match-data
(string-match "^[a-zA-`]:/$" filename)))))
:type '(repeat (string :tag "Name"))
:group 'find-file)
-(defun find-buffer-visiting (filename)
+(defun find-buffer-visiting (filename &optional predicate)
"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 PREDICATE is non-nil, only a buffer satisfying it can be returned.
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* ((attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
- (list (buffer-list)) found)
- (and buffer-file-numbers-unique
- number
- (while (and (not found) list)
- (with-current-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 (file-attributes buffer-file-name)
- attributes))
- (setq found (car list))))
- (setq list (cdr list))))
- found))))
+ (let ((predicate (or predicate #'identity))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or (let ((buf (get-file-buffer filename)))
+ (when (and buf (funcall predicate buf)) 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)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let* ((attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
+ (list (buffer-list)) found)
+ (and buffer-file-numbers-unique
+ number
+ (while (and (not found) list)
+ (with-current-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 (file-attributes buffer-file-truename)
+ attributes)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
\f
(defcustom find-file-wildcards t
"*Non-nil means file-visiting commands should handle wildcards.
:version "21.1"
:type 'boolean)
+(defcustom large-file-warning-threshold 10000000
+ "Maximum size of file above which a confirmation is requested.
+When nil, never request confirmation."
+ :group 'files
+ :group 'find-file
+ :type '(choice integer (const :tag "Never request confirmation" nil)))
+
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(mapcar #'find-file-noselect files)))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes truename)))
+ (attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
;; Find any buffer for a file which has same truename.
(other (and (not buf) (find-buffer-visiting filename))))
;; Let user know if there is a buffer with the same truename.
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other))))
+ ;; Check to see if the file looks uncommonly large.
+ (when (and large-file-warning-threshold (nth 7 attributes)
+ ;; Don't ask again if we already have the file or
+ ;; if we're asked to be quiet.
+ (not (or buf nowarn))
+ (> (nth 7 attributes) large-file-warning-threshold)
+ (not (y-or-n-p
+ (format "File %s is large (%sMB), really open? "
+ (file-name-nondirectory filename)
+ (/ (nth 7 attributes) 1048576)))))
+ (error "Aborted"))
(if buf
;; We are using an existing buffer.
(progn
(unless (or (eq read-only buffer-file-read-only)
(eq read-only buffer-read-only))
(when (or nowarn
- (let ((question
+ (let ((question
(format "File %s is %s on disk. Change buffer mode? "
buffer-file-name
(if read-only "read-only" "writable"))))
;; Needed in case we are re-visiting the file with a different
;; text representation.
(kill-local-variable 'buffer-file-coding-system)
+ (kill-local-variable 'cursor-type)
(erase-buffer)
(and (default-value 'enable-multibyte-characters)
(not rawfile)
(signal 'file-error (list "File is not readable"
filename)))
;; Run find-file-not-found-hooks until one returns non-nil.
- (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ (or (run-hook-with-args-until-success 'find-file-not-found-functions)
;; If they fail too, set error.
(setq error t)))))
;; Record the file's truename, and maybe use that as visited name.
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
to Emacs features such as format decoding, character code
-conversion, `find-file-hooks', automatic uncompression, etc.
+conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
- (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
- (inhibit-file-name-operation 'insert-file-contents))
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil))
+ (inhibit-file-name-handlers
+ (append '(jka-compr-handler image-file-handler)
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (filename) t))
- (insert-file-contents filename visit beg end replace))
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
(if find-buffer-file-type-function
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
+(defun insert-file-1 (filename insert-func)
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
+ #'buffer-modified-p))
+ (tem (funcall insert-func filename)))
+ (push-mark (+ (point) (car (cdr tem))))
+ (when buffer
+ (message "File %s already visited and modified in buffer %s"
+ filename (buffer-name buffer)))))
+
(defun insert-file-literally (filename)
"Insert contents of file FILENAME into buffer after point with no conversion.
Don't call it from programs! Use `insert-file-contents-literally' instead.
\(Its calling sequence is different; see its documentation)."
(interactive "*fInsert file literally: ")
- (if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
- filename)))
- (let ((tem (insert-file-contents-literally filename)))
- (push-mark (+ (point) (car (cdr tem))))))
+ (insert-file-1 filename #'insert-file-contents-literally))
(defvar find-file-literally nil
"Non-nil if this buffer was made by `find-file-literally' or equivalent.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
Fifth arg NOMODES non-nil means don't alter the file's modes.
-Finishes by calling the functions in `find-file-hooks'
+Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
(file-newer-than-file-p (or buffer-auto-save-file-name
(make-auto-save-file-name))
buffer-file-name))
- (format "%s has auto save data; consider M-x recover-file"
+ (format "%s has auto save data; consider M-x recover-this-file"
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
(setq buffer-read-only nil))
(t
(setq buffer-read-only nil)
- (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
- "Use M-x make-directory RET RET to create the directory"
- "Use C-u M-x make-directory RET RET to create directory and its parents")))))
+ "Use M-x make-directory RET RET to create the directory and its parents"))))
(when msg
- (message msg)
- (or not-serious (sit-for 1 nil t))))
+ (message "%s" msg)
+ (or not-serious (sit-for 1 t))))
(when (and auto-save-default (not noauto))
(auto-save-mode t)))
;; Make people do a little extra work (C-x C-q)
;; before altering a backup file.
(when (backup-file-name-p buffer-file-name)
(setq buffer-read-only t))
+ ;; When a file is marked read-only,
+ ;; make the buffer read-only even if root is looking at it.
+ (when (and (file-modes (buffer-file-name))
+ (zerop (logand (file-modes (buffer-file-name)) #o222)))
+ (setq buffer-read-only t))
(unless nomodes
(when (and view-read-only view-mode)
(view-mode-disable))
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
(view-mode-enter))
- (run-hooks 'find-file-hooks)))
+ (run-hooks 'find-file-hook)))
+
+(defmacro report-errors (format &rest body)
+ "Eval BODY and turn any error into a FORMAT message.
+FORMAT can have a %s escape which will be replaced with the actual error.
+If `debug-on-error' is set, errors are not caught, so that you can
+debug them.
+Avoid using a large BODY since it is duplicated."
+ (declare (debug t) (indent 1))
+ `(if debug-on-error
+ (progn . ,body)
+ (condition-case err
+ (progn . ,body)
+ (error (message ,format (prin1-to-string err))))))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
(or find-file (funcall (or default-major-mode 'fundamental-mode)))
- (condition-case err
- (set-auto-mode)
- (error (message "File mode specification error: %s"
- (prin1-to-string err))))
- (condition-case err
- (let ((enable-local-variables (or (not find-file)
- enable-local-variables)))
- (hack-local-variables))
- (error (message "File local-variables error: %s"
- (prin1-to-string err)))))
+ (report-errors "File mode specification error: %s"
+ (set-auto-mode))
+ (report-errors "File local-variables error: %s"
+ (let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ (hack-local-variables)))
+ (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
+ (ucs-set-table-for-input)))
(defvar auto-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
+ ;; c++-mode, java-mode and more) are added through autoload
+ ;; directives in that file. That way is discouraged since it
+ ;; spreads out the definition of the initial value.
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
'(("\\.te?xt\\'" . text-mode)
- ("\\.c\\'" . c-mode)
- ("\\.h\\'" . c-mode)
("\\.tex\\'" . tex-mode)
+ ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
+ ("\\.dtx\\'" . doctex-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.scm\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
+ ("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
- ("\\.cc\\'" . c++-mode)
- ("\\.hh\\'" . c++-mode)
- ("\\.hpp\\'" . c++-mode)
- ("\\.C\\'" . c++-mode)
- ("\\.H\\'" . c++-mode)
- ("\\.cpp\\'" . c++-mode)
- ("\\.cxx\\'" . c++-mode)
- ("\\.hxx\\'" . c++-mode)
- ("\\.c\\+\\+\\'" . c++-mode)
- ("\\.h\\+\\+\\'" . c++-mode)
- ("\\.m\\'" . objc-mode)
- ("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
- ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
+ ("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
;; Less common extensions come here
;; so more common ones above are found faster.
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("\\.bash\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.me\\'" . nroff-mode)
("\\.ms\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
- ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
("\\.f90\\'" . f90-mode)
+ ("\\.f95\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-mode)
- ("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode)
+ ("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("\\.zone\\'" . zone-mode)
;; some news reader is reported to use this
("\\`/tmp/fol/" . text-mode)
- ("\\.y\\'" . c-mode)
- ("\\.lex\\'" . c-mode)
("\\.oak\\'" . scheme-mode)
("\\.sgml?\\'" . sgml-mode)
("\\.xml\\'" . sgml-mode)
+ ("\\.xsl\\'" . sgml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.idl\\'" . idl-mode)
- ;; .emacs following a directory delimiter
- ;; in Unix, MSDOG or VMS syntax.
- ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; .emacs or .gnus or .viper following a directory delimiter in
+ ;; Unix, MSDOG or VMS syntax.
+ ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\`\\..*emacs\\'" . emacs-lisp-mode)
;; _emacs following a directory delimiter
;; in MsDos syntax
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
("\\.[1-9]\\'" . nroff-mode)
- ("\\.g\\'" . antlr-mode)))
+ ("\\.g\\'" . antlr-mode)
+ ("\\.ses\\'" . ses-mode)
+ ("\\.in\\'" nil t)))
"Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
(defvar interpreter-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
+ ;; and pike-mode) are added through autoload directives in that
+ ;; file. That way is discouraged since it spreads out the
+ ;; definition of the initial value.
(mapc
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
- ("awk" . awk-mode)
- ("mawk" . awk-mode)
- ("nawk" . awk-mode)
- ("gawk" . awk-mode)
("scm" . scheme-mode)
("ash" . sh-mode)
("bash" . sh-mode)
(mode nil))
;; Find first matching alist entry.
(let ((case-fold-search
- (memq system-type '(vax-vms windows-nt))))
+ (memq system-type '(vax-vms windows-nt cygwin))))
(while (and (not mode) alist)
(if (string-match (car (car alist)) name)
(if (and (consp (cdr (car alist)))
(goto-char beg)
end))))
-(defun hack-local-variables-prop-line ()
+(defun hack-local-variables-prop-line (&optional mode-only)
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
`set-auto-mode' should already have handled `mode:',
-`set-auto-coding' should already have handled `coding:'."
+`set-auto-coding' should already have handled `coding:'.
+If MODE-ONLY is non-nil, all we do is check whether the major mode
+is specified, returning t if it is specified."
(save-excursion
(goto-char (point-min))
(let ((result nil)
(end (set-auto-mode-1))
+ mode-specified
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
- ;; Parse the -*- line into the `result' alist.
+ ;; Parse the -*- line into the RESULT alist.
+ ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
(cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-". Already handled.
+ (setq mode-specified t)
nil)
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
(or (equal (downcase (symbol-name key)) "mode")
(equal (downcase (symbol-name key)) "coding")
(setq result (cons (cons key val) result)))
+ (if (equal (downcase (symbol-name key)) "mode")
+ (setq mode-specified t))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
- (if (and result
- (or (eq enable-local-variables t)
- (and enable-local-variables
- (save-window-excursion
- (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)))))))
- (let ((enable-local-eval enable-local-eval))
- (while result
- (hack-one-local-variable (car (car result)) (cdr (car result)))
- (setq result (cdr result))))))))
+ (if mode-only mode-specified
+ (if (and result
+ (or mode-only
+ (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (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)))))))
+ (let ((enable-local-eval enable-local-eval))
+ (while result
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
+ (setq result (cdr result)))))
+ nil))))
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
"Parse and put into effect this buffer's local variables spec.
If MODE-ONLY is non-nil, all we do is check whether the major mode
is specified, returning t if it is specified."
- (unless mode-only
- (hack-local-variables-prop-line))
- ;; Look for "Local variables:" line in last page.
- (let (mode-specified
+ (let ((mode-specified
+ ;; If MODE-ONLY is t, we check here for specifying the mode
+ ;; in the -*- line. If MODE-ONLY is nil, we process
+ ;; the -*- line here.
+ (hack-local-variables-prop-line mode-only))
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
+ ;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'inhibit-quit 'risky-local-variable t)
+(put 'minor-mode-alist 'risky-local-variable t)
(put 'minor-mode-map-alist 'risky-local-variable t)
+(put 'minor-mode-overriding-map-alist 'risky-local-variable t)
+(put 'overriding-local-map 'risky-local-variable t)
+(put 'overriding-terminal-local-map 'risky-local-variable t)
+(put 'auto-mode-alist 'risky-local-variable t)
(put 'after-load-alist 'risky-local-variable t)
(put 'buffer-file-name 'risky-local-variable t)
+(put 'buffer-undo-list 'risky-local-variable t)
(put 'buffer-auto-save-file-name 'risky-local-variable t)
(put 'buffer-file-truename 'risky-local-variable t)
+(put 'default-text-properties '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 'outline-level 'risky-local-variable t)
(put 'rmail-output-file-alist 'risky-local-variable t)
(put 'font-lock-defaults '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)
+(put 'special-display-buffer-names 'risky-local-variable t)
+(put 'frame-title-format 'risky-local-variable t)
+(put 'global-mode-string 'risky-local-variable t)
+(put 'header-line-format 'risky-local-variable t)
+(put 'icon-title-format 'risky-local-variable t)
+(put 'input-method-alist 'risky-local-variable t)
+(put 'format-alist 'risky-local-variable t)
+(put 'vc-mode 'risky-local-variable t)
+(put 'imenu-generic-expression 'risky-local-variable t)
+(put 'imenu-index-alist 'risky-local-variable t)
+(put 'standard-input 'risky-local-variable t)
+(put 'standard-output 'risky-local-variable t)
+(put 'unread-command-events 'risky-local-variable t)
+(put 'max-lisp-eval-depth 'risky-local-variable t)
+(put 'max-specpdl-size 'risky-local-variable t)
+(put 'mode-line-format 'risky-local-variable t)
+(put 'mode-line-modified 'risky-local-variable t)
+(put 'mode-line-mule-info 'risky-local-variable t)
+(put 'mode-line-buffer-identification 'risky-local-variable t)
+(put 'mode-line-modes 'risky-local-variable t)
+(put 'mode-line-position 'risky-local-variable t)
+(put 'mode-line-process 'risky-local-variable t)
+(put 'mode-name 'risky-local-variable t)
+(put 'display-time-string 'risky-local-variable t)
+(put 'parse-time-rules 'risky-local-variable t)
+
+;; This case is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable 'stringp)
+
+(defun risky-local-variable-p (sym val)
+ "Non-nil if SYM could be dangerous as a file-local variable with value VAL.
+If VAL is nil, the question is whether any value might be dangerous."
+ (let ((safep (get sym 'safe-local-variable)))
+ (or (memq sym ignored-local-variables)
+ (get sym 'risky-local-variable)
+ (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
+ (symbol-name sym))
+ (not safep))
+ ;; If the safe-local-variable property isn't t or nil,
+ ;; then it must return non-nil on the proposed value to be safe.
+ (and (not (memq safep '(t nil)))
+ (or (null val)
+ (not (funcall safep val)))))))
+
+(defcustom safe-local-eval-forms nil
+ "*Expressions that are considered \"safe\" in an `eval:' local variable.
+Add expressions to this list if you want Emacs to evaluate them, when
+they appear in an `eval' local variable specification, without first
+asking you for confirmation."
+ :group 'find-file
+ :version "21.4"
+ :type '(repeat sexp))
+
+(put 'c-set-style 'safe-local-eval-function t)
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+(defun hack-one-local-variable-constantp (exp)
+ (or (and (not (symbolp exp)) (not (consp exp)))
+ (memq exp '(t nil))
+ (keywordp exp)
+ (hack-one-local-variable-quotep exp)))
+
+(defun hack-one-local-variable-eval-safep (exp)
+ "Return t if it is safe to eval EXP when it is found in a file."
+ (or (not (consp exp))
+ ;; Detect certain `put' expressions.
+ (and (eq (car exp) 'put)
+ (hack-one-local-variable-quotep (nth 1 exp))
+ (hack-one-local-variable-quotep (nth 2 exp))
+ (memq (nth 1 (nth 2 exp))
+ '(lisp-indent-hook))
+ ;; Only allow safe values of lisp-indent-hook;
+ ;; not functions.
+ (or (numberp (nth 3 exp))
+ (equal (nth 3 exp) ''defun)))
+ ;; Allow expressions that the user requested.
+ (member exp safe-local-eval-forms)
+ ;; Certain functions can be allowed with safe arguments
+ ;; or can specify verification functions to try.
+ (and (symbolp (car exp))
+ (let ((prop (get (car exp) 'safe-local-eval-function)))
+ (cond ((eq prop t)
+ (let ((ok t))
+ (dolist (arg (cdr exp))
+ (unless (hack-one-local-variable-constantp arg)
+ (setq ok nil)))
+ ok))
+ ((functionp prop)
+ (funcall prop exp))
+ ((listp prop)
+ (let ((ok nil))
+ (dolist (function prop)
+ (if (funcall function exp)
+ (setq ok t)))
+ ok)))))))
+
(defun hack-one-local-variable (var val)
"\"Set\" one variable in a local variables spec.
-A few variable names are treated specially."
+A few patterns are specified so that any name which matches one
+is considered risky."
(cond ((eq var 'mode)
(funcall (intern (concat (downcase (symbol-name val))
"-mode"))))
((eq var 'coding)
;; We have already handled coding: tag in set-auto-coding.
nil)
- ((memq var ignored-local-variables)
- nil)
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
- ((or (get var 'risky-local-variable)
- (and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$"
- (symbol-name var))
- (not (get var 'safe-local-variable))))
+ ((risky-local-variable-p var val)
;; Permit evalling 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)))
+ (hack-one-local-variable-eval-safep val))
;; Permit eval if not root and user says ok.
(and (not (zerop (user-uid)))
(or (eq enable-local-eval t)
(save-excursion (eval val))
(make-local-variable var)
(set var val))
- (message "Ignoring `eval:' in the local variables list")))
+ (message "Ignoring risky spec in the local variables list")))
;; Ordinary variable, really set it.
(t (make-local-variable var)
+ ;; Make sure the string has no text properties.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
(set var val))))
\f
(if (eq system-type 'vax-vms)
(setq new-name (downcase new-name)))
(setq default-directory (file-name-directory buffer-file-name))
+ ;; If new-name == old-name, renaming would add a spurious <2>
+ ;; and it's considered as a feature in rename-buffer.
(or (string= new-name (buffer-name))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
(progn
(setq buffer-file-truename (abbreviate-file-name truename))
(if find-file-visit-truename
- (setq buffer-file-name buffer-file-truename))))
+ (setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
(nthcdr 10 (file-attributes buffer-file-name))
nil)))
- ;; write-file-hooks is normally used for things like ftp-find-file
+ ;; write-file-functions 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 'write-file-hooks)
+ (kill-local-variable 'write-file-functions)
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
-If the value is non-nil, it is the result of `file-modes' on the original
-file; this means that the caller, after saving the buffer, should change
-the modes of the new file to agree with the old modes.
A backup may be done by renaming or by copying; see documentation of
variable `make-backup-files'. If it's done by renaming, then the file is
-no longer accessible under its old name."
+no longer accessible under its old name.
+
+The value is non-nil after a backup was made by renaming.
+It has the form (MODES . BACKUPNAME).
+MODES is the result of `file-modes' on the original
+file; this means that the caller, after saving the buffer, should change
+the modes of the new file to agree with the old modes.
+BACKUPNAME is the backup file name, which is the old file renamed."
(if (and make-backup-files (not backup-inhibited)
(not buffer-backed-up)
(file-exists-p buffer-file-name)
(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))))))
+ real-file-name)))))
+ (modes (file-modes buffer-file-name)))
;; Actually write the back up file.
(condition-case ()
(if (or file-precious-flag
; (file-symlink-p buffer-file-name)
backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (and modes (< 0 (logand modes #o6000)))
(and backup-by-copying-when-linked
(> (file-nlinks real-file-name) 1))
(and (or backup-by-copying-when-mismatch
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
(or (nth 9 attr)
(not (file-ownership-preserved-p real-file-name)))))))
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))
+ (backup-buffer-copy real-file-name backupname modes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
- (setq setmodes (file-modes backupname)))
+ (setq setmodes (cons modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
(setq backupname (expand-file-name
(message "Cannot write backup file; backing up in %s"
(file-name-nondirectory backupname))
(sleep-for 1)
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))))
+ (backup-buffer-copy real-file-name backupname modes)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil))))))
+(defun backup-buffer-copy (from-name to-name modes)
+ (condition-case ()
+ (copy-file from-name to-name t t)
+ (file-error
+ ;; If copying fails because file TO-NAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p to-name)
+ (not (file-writable-p to-name)))
+ (delete-file to-name))
+ (copy-file from-name to-name t t)))
+ (set-file-modes to-name (logand modes #o1777)))
+
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return file NAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(if (setq directory (file-name-directory filename))
- (expand-file-name (substring file 0 (match-beginning 0))
- directory)
+ ;; Don't use expand-file-name here; if DIRECTORY is relative,
+ ;; we don't want to expand it.
+ (concat directory (substring file 0 (match-beginning 0)))
(substring file 0 (match-beginning 0)))
filename))))
(defun make-backup-file-name-1 (file)
"Subroutine of `make-backup-file-name' and `find-backup-file-name'."
(let ((alist backup-directory-alist)
- elt backup-directory dir-sep-string)
+ elt backup-directory)
(while alist
(setq elt (pop alist))
(if (string-match (car elt) file)
(setq backup-directory (cdr elt)
alist nil)))
- (if (null backup-directory)
- file
- (unless (file-exists-p backup-directory)
+ (if (and backup-directory (not (file-exists-p backup-directory)))
(condition-case nil
(make-directory backup-directory 'parents)
- (file-error file)))
+ (file-error (setq backup-directory nil))))
+ (if (null backup-directory)
+ file
(if (file-name-absolute-p backup-directory)
(progn
- (when (memq system-type '(windows-nt ms-dos))
- ;; Normalize DOSish file names: convert all slashes to
- ;; directory-sep-char, downcase the drive letter, if any,
- ;; and replace the leading "x:" with "/drive_x".
+ (when (memq system-type '(windows-nt ms-dos cygwin))
+ ;; Normalize DOSish file names: downcase the drive
+ ;; letter, if any, and replace the leading "x:" with
+ ;; "/drive_x".
(or (file-name-absolute-p file)
(setq file (expand-file-name file))) ; make defaults explicit
;; Replace any invalid file-name characters (for the
;; case of backing up remote files).
(setq file (expand-file-name (convert-standard-filename file)))
- (setq dir-sep-string (char-to-string directory-sep-char))
(if (eq (aref file 1) ?:)
- (setq file (concat dir-sep-string
+ (setq file (concat "/"
"drive_"
(char-to-string (downcase (aref file 0)))
- (if (eq (aref file 2) directory-sep-char)
+ (if (eq (aref file 2) ?/)
""
- dir-sep-string)
+ "/")
(substring file 2)))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
(expand-file-name
(subst-char-in-string
- directory-sep-char ?!
+ ?/ ?!
(replace-regexp-in-string "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
+;; (defun file-relative-name (filename &optional directory)
+;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
+;; This function returns a relative file name which is equivalent to FILENAME
+;; when used with that default directory as the default.
+;; If this is impossible (which can happen on MSDOS and Windows
+;; when the file name and directory use different drive names)
+;; then it returns FILENAME."
+;; (save-match-data
+;; (let ((fname (expand-file-name filename)))
+;; (setq directory (file-name-as-directory
+;; (expand-file-name (or directory default-directory))))
+;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
+;; ;; drive names, they can't be relative, so return the absolute name.
+;; (if (and (or (eq system-type 'ms-dos)
+;; (eq system-type 'cygwin)
+;; (eq system-type 'windows-nt))
+;; (not (string-equal (substring fname 0 2)
+;; (substring directory 0 2))))
+;; filename
+;; (let ((ancestor ".")
+;; (fname-dir (file-name-as-directory fname)))
+;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
+;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
+;; (setq directory (file-name-directory (substring directory 0 -1))
+;; ancestor (if (equal ancestor ".")
+;; ".."
+;; (concat "../" ancestor))))
+;; ;; Now ancestor is empty, or .., or ../.., etc.
+;; (if (string-match (concat "^" (regexp-quote directory)) fname)
+;; ;; We matched within FNAME's directory part.
+;; ;; Add the rest of FNAME onto ANCESTOR.
+;; (let ((rest (substring fname (match-end 0))))
+;; (if (and (equal ancestor ".")
+;; (not (equal rest "")))
+;; ;; But don't bother with ANCESTOR if it would give us `./'.
+;; rest
+;; (concat (file-name-as-directory ancestor) rest)))
+;; ;; We matched FNAME's directory equivalent.
+;; ancestor))))))
+
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name which is equivalent to FILENAME
when used with that default directory as the default.
-If this is impossible (which can happen on MSDOS and Windows
-when the file name and directory use different drive names)
-then it returns FILENAME."
+If FILENAME and DIRECTORY lie on different machines or on different drives
+on a DOS/Windows machine, it returns FILENAME on expanded form."
(save-match-data
- (let ((fname (expand-file-name filename)))
- (setq directory (file-name-as-directory
- (expand-file-name (or directory default-directory))))
- ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
- ;; drive names, they can't be relative, so return the absolute name.
- (if (and (or (eq system-type 'ms-dos)
- (eq system-type 'windows-nt))
- (not (string-equal (substring fname 0 2)
- (substring directory 0 2))))
+ (setq directory
+ (file-name-as-directory (expand-file-name (or directory
+ default-directory))))
+ (setq filename (expand-file-name filename))
+ (let ((hf (find-file-name-handler filename 'file-local-copy))
+ (hd (find-file-name-handler directory 'file-local-copy)))
+ (when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
+ (when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
+ (if ;; Conditions for separate trees
+ (or
+ ;; Test for different drives on DOS/Windows
+ (and
+ (memq system-type '(ms-dos cygwin windows-nt))
+ (not (string-equal (substring filename 0 2)
+ (substring directory 0 2))))
+ ;; Test for different remote file handlers
+ (not (eq hf hd))
+ ;; Test for different remote file system identification
+ (and
+ hf
+ (let ((re (car (rassq hf file-name-handler-alist))))
+ (not
+ (equal
+ (and
+ (string-match re filename)
+ (substring filename 0 (match-end 0)))
+ (and
+ (string-match re directory)
+ (substring directory 0 (match-end 0))))))))
filename
- (let ((ancestor ".")
- (fname-dir (file-name-as-directory fname)))
- (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
- (not (string-match (concat "^" (regexp-quote directory)) fname)))
- (setq directory (file-name-directory (substring directory 0 -1))
+ (let ((ancestor ".")
+ (filename-dir (file-name-as-directory filename)))
+ (while
+ (and
+ (not (string-match (concat "\\`" (regexp-quote directory))
+ filename-dir))
+ (not (string-match (concat "\\`" (regexp-quote directory))
+ filename)))
+ (setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
- ;; Now ancestor is empty, or .., or ../.., etc.
- (if (string-match (concat "^" (regexp-quote directory)) fname)
- ;; We matched within FNAME's directory part.
- ;; Add the rest of FNAME onto ANCESTOR.
- (let ((rest (substring fname (match-end 0))))
- (if (and (equal ancestor ".")
- (not (equal rest "")))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (string-match (concat "^" (regexp-quote directory)) filename)
+ ;; We matched within FILENAME's directory part.
+ ;; Add the rest of FILENAME onto ANCESTOR.
+ (let ((rest (substring filename (match-end 0))))
+ (if (and (equal ancestor ".") (not (equal rest "")))
;; But don't bother with ANCESTOR if it would give us `./'.
rest
(concat (file-name-as-directory ancestor) rest)))
- ;; We matched FNAME's directory equivalent.
- ancestor))))))
+ ;; We matched FILENAME's directory equivalent.
+ ancestor))))))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(defun basic-save-buffer ()
"Save the current buffer in its visited file, if it has been modified.
-The hooks `write-contents-hooks', `local-write-file-hooks' and
-`write-file-hooks' get a chance to do the job of saving; if they do not,
-then the buffer is saved in the visited file file in the usual way.
+The hooks `write-contents-functions' and `write-file-functions' get a chance
+to do the job of saving; if they do not, then the buffer is saved in
+the visited file file in the usual way.
After saving the buffer, this function runs `after-save-hook'."
(interactive)
(save-current-buffer
(set-buffer (buffer-base-buffer)))
(if (buffer-modified-p)
(let ((recent-save (recent-auto-save-p))
- setmodes tempsetmodes)
+ setmodes)
;; On VMS, rename file and buffer to get rid of version number.
(if (and (eq system-type 'vax-vms)
(not (string= buffer-file-name
(save-restriction
(widen)
(save-excursion
- (and (> (point-max) 1)
+ (and (> (point-max) (point-min))
(not find-file-literally)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
- (or (run-hook-with-args-until-success 'write-contents-hooks)
+ (or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
- (run-hook-with-args-until-success 'write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(setq setmodes (basic-save-buffer-1)))
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
- (set-file-modes buffer-file-name setmodes)
+ (set-file-modes buffer-file-name (car setmodes))
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
;; 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.
+;; but inhibited if one of write-file-functions returns non-nil.
+;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-1 ()
(if save-buffer-coding-system
(let ((coding-system-for-write save-buffer-coding-system))
(basic-save-buffer-2))
(basic-save-buffer-2)))
+;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
(let (tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
;; 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
+ tempname nogood i succeed
(old-modtime (visited-file-modtime)))
(setq i 0)
(setq nogood t)
;; 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))
+ (setq setmodes (or setmodes (cons (file-modes buffer-file-name)
+ buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(rename-file tempname buffer-file-name t))
;; (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 (logior setmodes 128))))
- (write-region (point-min) (point-max)
- buffer-file-name nil t buffer-file-truename)))
+ (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name))
+ (set-file-modes buffer-file-name (logior (car setmodes) 128))))
+ (let (success)
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max)
+ buffer-file-name nil t buffer-file-truename)
+ (setq success t))
+ ;; If we get an error writing the new file, and we made
+ ;; the backup by renaming, undo the backing-up.
+ (and setmodes (not success)
+ (rename-file (cdr setmodes) buffer-file-name))))))
setmodes))
+(defun diff-buffer-with-file (&optional buffer)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive "bBuffer: ")
+ (with-current-buffer (get-buffer (or buffer (current-buffer)))
+ (if (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage)
+ (diff buffer-file-name tempfile nil t)
+ (sit-for 0))
+ (when (file-exists-p tempfile)
+ (delete-file tempfile))))
+ (message "Buffer %s has no associated file on disc" (buffer-name))
+ ;; Display that message for 1 second so that user can read it
+ ;; in the minibuffer.
+ (sit-for 1)))
+ ;; return always nil, so that save-buffers-kill-emacs will not move
+ ;; over to the next unsaved buffer when calling `d'.
+ nil)
+
+(defvar save-some-buffers-action-alist
+ '((?\C-r
+ (lambda (buf)
+ (view-buffer buf
+ (lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer")
+ (?d diff-buffer-with-file
+ "show difference to last saved version"))
+ "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
+(put 'save-some-buffers-action-alist 'risky-local-variable t)
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
+You can answer `y' to save, `n' not to save, `C-r' to look at the
+buffer in question with `view-buffer' before deciding or `d' to
+view the differences using `diff-buffer-to-file'.
+
Optional argument (the prefix) non-nil means save all with no questions.
Optional second argument PRED determines which buffers are considered:
If PRED is nil, all the file-visiting buffers are considered.
If PRED is t, then certain non-file buffers will also be considered.
If PRED is a zero-argument function, it indicates for each buffer whether
-to consider it or not when called with that buffer current."
+to consider it or not when called with that buffer current.
+
+See `save-some-buffers-action-alist' if you want to
+change the additional actions you can take on files."
(interactive "P")
(save-window-excursion
(let* ((queried nil)
(save-buffer)))
(buffer-list)
'("buffer" "buffers" "save")
- (list (list ?\C-r (lambda (buf)
- (view-buffer buf
- (function
- (lambda (ignore)
- (exit-recursive-edit))))
- (recursive-edit)
- ;; Return nil to ask about BUF again.
- nil)
- "display the current buffer"))))
+ save-some-buffers-action-alist))
(abbrevs-done
(and save-abbrevs abbrevs-changed
(progn
With arg, set read-only iff arg is positive.
If visiting file read-only and `view-read-only' is non-nil, enter view mode."
(interactive "P")
- (cond
- ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil) ; do nothing.
- ;; Toggle.
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update))))
+ (if (and arg
+ (if (> (prefix-numeric-value arg) 0) buffer-read-only
+ (not buffer-read-only))) ; If buffer-read-only is set correctly,
+ nil ; do nothing.
+ ;; Toggle.
+ (cond
+ ((and buffer-read-only view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and (not buffer-read-only) view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
+ (t (setq buffer-read-only (not buffer-read-only))
+ (force-mode-line-update)))
+ (if (vc-backend buffer-file-name)
+ (message (substitute-command-keys
+ (concat "File is under version-control; "
+ "use \\[vc-next-action] to check in/out"))))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
(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))))))
+ (insert-file-1 filename #'insert-file-contents))
(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
- (let* ((filename (make-backup-file-name filename))
+ (let* ((filename (file-name-sans-versions
+ (make-backup-file-name filename)))
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
That is useful when you have visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS says whether
-to create parent directories if they don't exist."
+to create parent directories if they don't exist. Interactively,
+this happens by default."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
+ ;; If default-directory is a remote directory,
+ ;; make sure we find its make-directory handler.
+ (setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
This command also works for special buffers that contain text which
doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and buffer-list buffers. In these cases,
+for example, Dired buffers and `buffer-list' buffers. In these cases,
it reconstructs the buffer contents from the appropriate data base.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
(funcall revert-buffer-insert-file-contents-function
file-name auto-save-p)
(if (not (file-exists-p file-name))
- (error "File %s no longer exists!" file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists!"
+ "Cannot revert nonexistent file %s")
+ file-name))
;; Bind buffer-file-name to nil
;; so that we don't try to lock the file.
(let ((buffer-file-name nil))
(let ((coding-system-for-read
;; Auto-saved file shoule be read without
;; any code conversion.
- (if auto-save-p 'utf-8-emacs-unix
- coding-system-for-read)))
+ (if auto-save-p 'utf-8-emacs
+ (or coding-system-for-read
+ buffer-file-coding-system))))
+ ;; This force after-insert-file-set-coding
+ ;; (called from insert-file-contents) to set
+ ;; buffer-file-coding-system to a proper value.
+ (kill-local-variable 'buffer-file-coding-system)
+
;; Note that this preserves point in an intelligent way.
- (insert-file-contents file-name (not auto-save-p)
- nil nil t))))
+ (if preserve-modes
+ (let ((buffer-file-format buffer-file-format))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))))
;; Recompute the truename in case changes in symlinks
;; have changed the truename.
(setq buffer-file-truename
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook-p
- (progn
- (make-local-variable 'revert-buffer-internal-hook)
- (setq revert-buffer-internal-hook local-hook))
+ (set (make-local-variable 'revert-buffer-internal-hook)
+ local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
t)))))
+(defun recover-this-file ()
+ "Recover the visited file--get contents from its last auto-save file."
+ (interactive)
+ (recover-file buffer-file-name))
+
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save file."
;; Actually putting the file name in the minibuffer should be used
(interactive "FRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
- (error "%s is an auto-save file" file))
+ (error "%s is an auto-save file" (abbreviate-file-name file)))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
(cond ((if (file-exists-p file)
(not (file-newer-than-file-p file-name file))
(not (file-exists-p file-name)))
- (error "Auto-save file %s not current" file-name))
+ (error "Auto-save file %s not current"
+ (abbreviate-file-name file-name)))
((save-window-excursion
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(let ((buffer-read-only nil)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
- ;; Auto-saved file shoule be read without any code conversion.
- (coding-system-for-read 'utf-8-emacs-unix))
+ ;; Auto-saved file shoule be read with special coding.
+ (coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(error "You set `auto-save-list-file-prefix' to disable making session files"))
(let ((dir (file-name-directory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
- (make-directory dir t)))
+ (make-directory dir t))
+ (unless (directory-files dir nil
+ (concat "\\`" (regexp-quote
+ (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
(concat dired-listing-switches "t")))
;; a "visited file name" from that.
(progn
(forward-line 1)
- (setq autofile
- (buffer-substring-no-properties
- (point)
- (save-excursion
- (end-of-line)
- (point))))
- (setq thisfile
- (expand-file-name
- (substring
- (file-name-nondirectory autofile)
- 1 -1)
- (file-name-directory autofile)))
+ ;; If there is no auto-save file name, the
+ ;; auto-save-list file is probably corrupted.
+ (unless (eolp)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (setq thisfile
+ (expand-file-name
+ (substring
+ (file-name-nondirectory autofile)
+ 1 -1)
+ (file-name-directory autofile))))
(forward-line 1))
;; This pair of lines is a file-visiting
;; buffer. Use the visited file name.
(point) (progn (end-of-line) (point))))
(forward-line 1)))
;; Ignore a file if its auto-save file does not exist now.
- (if (file-exists-p autofile)
+ (if (and autofile (file-exists-p autofile))
(setq files (cons thisfile files)))))
(setq files (nreverse files))
;; The file contains a pair of line for each auto-saved buffer.
(if buffer-file-name
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
- result)
+ result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
- filename)))
+ filename)
+ uniq (car (cddr (car list)))))
(setq list (cdr list)))
- (if result (setq filename result))
-
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits before
- ;; doing anything else, because the regexp passed to
- ;; string-match below cannot handle extensions longer than
- ;; 3 characters, multiple dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
+ (if result
+ (if uniq
+ (setq filename (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string "!" "!!"
+ filename))))
+ (setq filename result)))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits
+ ;; before doing anything else, because the regexp
+ ;; passed to string-match below cannot handle
+ ;; extensions longer than 3 characters, multiple
+ ;; dots, and other atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ "#" (match-string 1 fn)
+ "." (match-string 3 fn) "#"))
+ (concat (file-name-directory filename)
+ "#"
+ (file-name-nondirectory filename)
+ "#")))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
+ (convert-standard-filename result)
+ result))
;; 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))
+ (limit 0)
+ file-name)
;; Eliminate all slashes and backslashes by
;; replacing them with sequences that start with %.
;; Quote % also, to keep distinct names distinct.
(setq buffer-name (replace-match replacement t t buffer-name))
(setq limit (1+ (match-end 0)))))
;; Generate the file name.
- (expand-file-name
- (format "#%s#%s#" buffer-name (make-temp-name ""))
- ;; Try a few alternative directories, to get one we can write it.
- (cond
- ((file-writable-p default-directory) default-directory)
- ((file-writable-p "/var/tmp/") "/var/tmp/")
- ("~/"))))))
+ (setq file-name
+ (make-temp-file
+ (let ((fname
+ (expand-file-name
+ (format "#%s#" buffer-name)
+ ;; Try a few alternative directories, to get one we can
+ ;; write it.
+ (cond
+ ((file-writable-p default-directory) default-directory)
+ ((file-writable-p "/var/tmp/") "/var/tmp/")
+ ("~/")))))
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname)))
+ ;; The call to convert-standard-filename is in case
+ ;; buffer-name includes characters not allowed by the
+ ;; DOS/Windows filesystems. make-temp-file writes to the
+ ;; file it creates, so we must fix the file name _before_
+ ;; make-temp-file is called.
+ (convert-standard-filename fname)
+ fname))
+ nil "#"))
+ ;; make-temp-file creates the file,
+ ;; but we don't want it to exist until we do an auto-save.
+ (condition-case ()
+ (delete-file file-name)
+ (file-error nil))
+ file-name)))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
relative to the current default directory, `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
- (let* ((nondir (file-name-nondirectory pattern))
- (dirpart (file-name-directory pattern))
- ;; A list of all dirs that DIRPART specifies.
- ;; This can be more than one dir
- ;; if DIRPART contains wildcards.
- (dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
- (file-expand-wildcards (directory-file-name dirpart)))
- (list dirpart)))
- contents)
- (while dirs
- (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
- (file-directory-p (directory-file-name (car dirs))))
- (let ((this-dir-contents
- ;; Filter out "." and ".."
- (delq nil
- (mapcar #'(lambda (name)
- (unless (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory name))
- name))
- (directory-files (or (car dirs) ".") full
- (wildcard-to-regexp nondir))))))
- (setq contents
- (nconc
- (if (and (car dirs) (not full))
- (mapcar (function (lambda (name) (concat (car dirs) name)))
- this-dir-contents)
- this-dir-contents)
- contents))))
- (setq dirs (cdr dirs)))
- contents))
+ (save-match-data
+ (let* ((nondir (file-name-nondirectory pattern))
+ (dirpart (file-name-directory pattern))
+ ;; A list of all dirs that DIRPART specifies.
+ ;; This can be more than one dir
+ ;; if DIRPART contains wildcards.
+ (dirs (if (and dirpart (string-match "[[*?]" dirpart))
+ (mapcar 'file-name-as-directory
+ (file-expand-wildcards (directory-file-name dirpart)))
+ (list dirpart)))
+ contents)
+ (while dirs
+ (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
+ (file-directory-p (directory-file-name (car dirs))))
+ (let ((this-dir-contents
+ ;; Filter out "." and ".."
+ (delq nil
+ (mapcar #'(lambda (name)
+ (unless (string-match "\\`\\.\\.?\\'"
+ (file-name-nondirectory name))
+ name))
+ (directory-files (or (car dirs) ".") full
+ (wildcard-to-regexp nondir))))))
+ (setq contents
+ (nconc
+ (if (and (car dirs) (not full))
+ (mapcar (function (lambda (name) (concat (car dirs) name)))
+ this-dir-contents)
+ this-dir-contents)
+ contents))))
+ (setq dirs (cdr dirs)))
+ contents)))
(defun list-directory (dirname &optional verbose)
"Display a list of files in or matching DIRNAME, a la `ls'.
nil default-directory nil)
pfx)))
(let ((switches (if verbose list-directory-verbose-switches
- list-directory-brief-switches)))
+ list-directory-brief-switches))
+ buffer)
(or dirname (setq dirname default-directory))
(setq dirname (expand-file-name dirname))
(with-output-to-temp-buffer "*Directory*"
+ (setq buffer standard-output)
(buffer-disable-undo standard-output)
(princ "Directory ")
(princ dirname)
(terpri)
(save-excursion
(set-buffer "*Directory*")
- (setq default-directory
- (if (file-directory-p dirname)
- (file-name-as-directory dirname)
- (file-name-directory dirname)))
(let ((wildcard (not (file-directory-p dirname))))
- (insert-directory dirname switches wildcard (not wildcard)))))))
+ (insert-directory dirname switches wildcard (not wildcard)))))
+ ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
+ (with-current-buffer buffer
+ (setq default-directory
+ (if (file-directory-p dirname)
+ (file-name-as-directory dirname)
+ (file-name-directory dirname))))))
(defun shell-quote-wildcard-pattern (pattern)
"Quote characters special to the shell in PATTERN, leave wildcards alone.
PATTERN that already quotes some of the special characters."
(save-match-data
(cond
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
-(defcustom directory-free-space-args "-Pk"
+(defcustom directory-free-space-args
+ (if (eq system-type 'darwin) "-k" "-Pk")
"*Options to use when running `directory-free-space-program'."
:type 'string
:group 'dired)
;; dired-insert-headerline
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
+;; - may be passed "--dired" as the first argument in SWITCHES.
+;; Filename handlers might have to remove this switch if their
+;; "ls" command does not support it.
(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.
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (let (result available)
+ (let (result (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; RESULT gets the status code.
- (let ((coding-system-for-read
- (and enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- ;; This is to control encoding the arguments in call-process.
- (coding-system-for-write coding-system-for-read))
+ (let* (;; We at first read by no-conversion, then after
+ ;; putting text property `dired-filename, decode one
+ ;; bunch by one to preserve that property.
+ (coding-system-for-read 'no-conversion)
+ ;; This is to control encoding the arguments in call-process.
+ (coding-system-for-write
+ (and enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system))))
(setq result
(if wildcard
;; Run ls in the directory part of the file pattern
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char (point-min))
- ;; First find the line to put it on.
- (when (re-search-forward "^total" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "used", to avoid confusion.
- (replace-match "total used in directory")
- (end-of-line)
- (insert " available " available))))))))))
+ (when (string-match "--dired\\>" switches)
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
+ (let ((end (line-end-position)))
+ (forward-word 1)
+ (forward-char 3)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (= (char-after end) ?\n)
+ (put-text-property start end 'dired-filename t)
+ ;; It seems that we can't trust ls's output as to
+ ;; byte positions of filenames.
+ (put-text-property beg (point) 'dired-filename nil)
+ (end-of-line))))
+ (goto-char end)
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 2) (point)))))
+
+ ;; Now decode what read if necessary.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region beg (point) t)))
+ (if (not (eq (coding-system-base coding) 'undecided))
+ (save-restriction
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (narrow-to-region beg (point))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so
+ ;; that CR is preserved.
+ (decode-coding-region pos (point)
+ (if val coding-no-eol coding))
+ (if val
+ (put-text-property pos (point)
+ 'dired-filename t)))))))
+
+ (if full-directory-p
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char beg)
+ ;; First find the line to put it on.
+ (when (re-search-forward "^ *\\(total\\)" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "used", to avoid confusion.
+ (replace-match "total used in directory" nil nil nil 1)
+ (end-of-line)
+ (insert " available " available)))))))))))
(defun insert-directory-safely (file switches
&optional wildcard full-directory-p)
(let ((processes (process-list))
active)
(while processes
- (and (memq (process-status (car processes)) '(run stop open))
- (let ((val (process-kill-without-query (car processes))))
- (process-kill-without-query (car processes) val)
- val)
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (list-processes)
+ (list-processes t)
(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)
;; `identity' means just return the first arg
;; as stripped of its quoting.
(substitute-in-file-name . identity)
- (file-name-completion 0 1)
- (file-name-all-completions 0 1)
+ (file-name-completion 1)
+ (file-name-all-completions 1)
(rename-file 0 1)
(copy-file 0 1)
(make-symbolic-link 0 1)
(setq file-arg-indices (cdr file-arg-indices))))
(if (eq file-arg-indices 'identity)
(car arguments)
- (let ((value (apply operation arguments)))
- (cond ((memq operation '(file-name-completion))
- (and value (concat "/:" value)))
- ((memq operation '(file-name-all-completions))
- (mapcar (lambda (name) (concat "/:" name)) value))
- (t value))))))
+ (apply operation arguments))))
\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
+(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)