;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985-1987, 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2013 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs
;;; Commentary:
-;; Defines most of Emacs'ss file- and directory-handling functions,
+;; Defines most of Emacs's file- and directory-handling functions,
;; including basic file visiting, backup generation, link handling,
;; ITS-id version control, load- and write-hook handling, and the like.
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar font-lock-keywords)
(defgroup backup nil
(defun parse-colon-path (search-path)
"Explode a search path into a list of directory names.
-Directories are separated by occurrences of `path-separator'
-\(which is colon in GNU and GNU-like systems)."
- ;; We could use split-string here.
- (and search-path
- (let (cd-list (cd-start 0) cd-colon)
- (setq search-path (concat search-path path-separator))
- (while (setq cd-colon (string-match path-separator search-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring search-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
+Directories are separated by `path-separator' (which is colon in
+GNU and Unix systems). Substitute environment variables into the
+resulting list of directory names. For an empty path element (i.e.,
+a leading or trailing separator, or two adjacent separators), return
+nil (meaning `default-directory') as the associated list element."
+ (when (stringp search-path)
+ (mapcar (lambda (f)
+ (if (equal "" f) nil
+ (substitute-in-file-name (file-name-as-directory f))))
+ (split-string search-path path-separator))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
(read-file-name-internal string pred action))
((eq (car-safe action) 'boundaries)
(let ((suffix (cdr action)))
- (list* 'boundaries
- (length (file-name-directory string))
- (let ((x (file-name-directory suffix)))
- (if x (1- (length x)) (length suffix))))))
+ `(boundaries
+ ,(length (file-name-directory string))
+ ,@(let ((x (file-name-directory suffix)))
+ (if x (1- (length x)) (length suffix))))))
(t
(let ((names '())
;; If we have files like "foo.el" and "foo.elc", we could load one of
(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)."
+ (declare (obsolete locate-file-completion-table "23.1"))
(locate-file-completion-table (car path-and-suffixes)
(cdr path-and-suffixes)
string nil action))
-(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
;; nil)))
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a file named NAME.
+ "Look up the directory hierarchy from FILE for a directory containing NAME.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
-
-This function only tests if FILE exists. If you care about whether
-it is readable, regular, etc., you should test the result."
+Instead of a string, NAME can also be a predicate taking one argument
+\(a directory) and returning a non-nil value if that directory is the one for
+which we're looking."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
- ;; FIXME? maybe this function should (optionally?)
- ;; use file-readable-p instead. In many cases, an unreadable
- ;; FILE is no better than a non-existent one.
- ;; See eg dir-locals-find-file.
- (setq try (file-exists-p (expand-file-name name file)))
+ (setq try (if (stringp name)
+ (file-exists-p (expand-file-name name file))
+ (funcall name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
(directory-file-name file))))
(setq file nil))))
- root))
+ (if root (file-name-as-directory root))))
(defun executable-find (command)
;; in this day and age. Almost everyone will use ssh, and have
;; whatever command they want to use in PATH.
(purecopy
- (let ((list '("ssh" "slogin" "rlogin" "remsh" "rcmd" "rsh")))
+ (let ((list '("ssh" "remsh" "rcmd" "rsh")))
(while (and list
(not (executable-find (car list)))
(setq list (cdr list))))
(or (car list) "ssh")))
"Program to use to execute commands on a remote host (e.g. ssh or rsh)."
- :version "24.2" ; ssh rather than rsh, etc
+ :version "24.3" ; ssh rather than rsh, etc
:initialize 'custom-initialize-delay
:group 'environment
:type 'file)
(delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
(or prev-dirs (setq prev-dirs (list nil)))
- ;; andrewi@harlequin.co.uk - none of the following code (except for
- ;; invoking the file-name handler) currently applies on Windows
- ;; (ie. there are no native symlinks), but there is an issue with
+ ;; andrewi@harlequin.co.uk - on Windows, there is an issue with
;; case differences being ignored by the OS, and short "8.3 DOS"
;; name aliases existing for all files. (The short names are not
;; reported by directory-files, but can be used to refer to files.)
;; 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)))
- ;; 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.
- (unless (string-match "[[*?]" filename)
- ;; If filename exists, use the long name. If it doesn't exist,
- ;; drill down until we find a directory that exists, and use
- ;; the long name of that, with the extra non-existent path
- ;; components concatenated.
- (let ((longname (w32-long-file-name filename))
- missing rest)
- (if longname
- (setq filename longname)
- ;; Include the preceding directory separator in the missing
- ;; part so subsequent recursion on the rest works.
- (setq missing (concat "/" (file-name-nondirectory filename)))
- (let ((length (length missing)))
- (setq rest
- (if (> length (length filename))
- ""
- (substring filename 0 (- length)))))
- (setq filename (concat (file-truename rest) missing))))))
- (setq done t)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use its long name. If it doesn't
+ ;; exist, the recursion below on the directory of filename
+ ;; will drill down until we find a directory that exists,
+ ;; and use the long name of that, with the extra
+ ;; non-existent path components concatenated.
+ (let ((longname (w32-long-file-name filename)))
+ (if longname
+ (setq filename longname)))))
;; If this file directly leads to a link, process that iteratively
;; so that we don't use lots of stack.
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
+ (and (memq system-type '(windows-nt ms-dos cygwin))
+ (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
(if (assoc dir (car prev-dirs))
(find-file filename)
(current-buffer)))
-(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.
-Use \\[toggle-read-only] to permit editing."
- (interactive
- (find-file-read-args "Find file read-only: "
- (confirm-nonexistent-file-or-buffer)))
+(defun find-file--read-only (fun filename wildcards)
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(file-exists-p filename))
(error "%s does not exist" filename))
- (let ((value (find-file filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
+ (let ((value (funcall fun filename wildcards)))
+ (mapc (lambda (b) (with-current-buffer b (read-only-mode 1)))
(if (listp value) value (list value)))
value))
+(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.
+Use \\[toggle-read-only] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only #'find-file filename wildcards))
+
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-window filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-window filename wildcards))
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
- (unless (or (and wildcards find-file-wildcards
- (not (string-match "\\`/:" filename))
- (string-match "[[*?]" filename))
- (file-exists-p filename))
- (error "%s does not exist" filename))
- (let ((value (find-file-other-frame filename wildcards)))
- (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
- (if (listp value) value (list value)))
- value))
+ (find-file--read-only #'find-file-other-frame filename wildcards))
(defun find-alternate-file-other-window (filename &optional wildcards)
"Find file FILENAME as a replacement for the file in the next window.
(other-window 1)
(find-alternate-file filename wildcards))))
-(defvar kill-buffer-hook) ; from buffer.c
+;; Defined and used in buffer.c, but not as a DEFVAR_LISP.
+(defvar kill-buffer-hook nil
+ "Hook run when a buffer is killed.
+The buffer being killed is current while the hook is running.
+See `kill-buffer'.")
(defun find-alternate-file (filename &optional wildcards)
"Find file FILENAME, select its buffer, kill previous buffer.
t)))
(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"))))
+ (and (buffer-modified-p) buffer-file-name
+ (not (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)
"Regexp to match the automounter prefix in a directory name."
:group 'files
:type 'regexp)
-(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.2")
+(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3")
(defvar abbreviated-home-dir nil
"The user's homedir abbreviated according to `directory-abbrev-alist'.")
OP-TYPE specifies the file operation being performed (for message to user)."
(when (and large-file-warning-threshold size
(> size large-file-warning-threshold)
- (not (y-or-n-p (format "File %s is large (%dMB), really %s? "
+ (not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
- (/ size 1048576) op-type))))
+ (file-size-human-readable size) op-type))))
(error "Aborted")))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
(after-find-file error (not nowarn)))
(current-buffer))))
\f
+(defvar file-name-buffer-file-type-alist) ;From dos-w32.el.
+
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
(after-insert-file-functions 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))
+ (file-name-buffer-file-type-alist '(("" . t)))
(inhibit-file-name-handlers
+ ;; FIXME: Yuck!! We should turn insert-file-contents-literally
+ ;; into a file operation instead!
(append '(jka-compr-handler image-file-handler epa-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))
- (if find-buffer-file-type-function
- (fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
+ (insert-file-contents filename visit beg end replace)))
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
(not buffer-read-only)
(save-excursion
(goto-char (point-max))
- (insert "\n")))
+ (ignore-errors (insert "\n"))))
(when (and buffer-read-only
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
("\\.js\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
+ ("\\.by\\'" . bovine-grammar-mode)
+ ("\\.wy\\'" . wisent-grammar-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
- (setq name))
+ (setq name nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
(setq done t))))))
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
(add-hook 'write-file-functions 'time-stamp)
- (add-hook 'before-save-hook 'time-stamp))
+ (add-hook 'before-save-hook 'time-stamp nil t)
+ (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))
"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
RISKY-VARS is the list of those that are marked as risky.
If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
- (if noninteractive
- nil
- (save-window-excursion
- (let* ((name (or dir-name
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (concat "buffer " (buffer-name)))))
- (offer-save (and (eq enable-local-variables t)
- unsafe-vars))
- (exit-chars
- (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
- (buf (pop-to-buffer "*Local Variables*"))
- prompt char)
- (set (make-local-variable 'cursor-type) nil)
+ (unless noninteractive
+ (let ((name (cond (dir-name)
+ (buffer-file-name
+ (file-name-nondirectory buffer-file-name))
+ ((concat "buffer " (buffer-name)))))
+ (offer-save (and (eq enable-local-variables t)
+ unsafe-vars))
+ (buf (get-buffer-create "*Local Variables*")))
+ ;; Set up the contents of the *Local Variables* buffer.
+ (with-current-buffer buf
(erase-buffer)
(cond
(unsafe-vars
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (setq prompt
- (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
- (if (< (line-number-at-pos) (window-body-height))
- ""
- (push ?\C-v exit-chars)
- ", or C-v to scroll")))
- (goto-char (point-min))
- (while (null char)
- (setq char (read-char-choice prompt exit-chars t))
- (when (eq char ?\C-v)
- (condition-case nil
- (scroll-up)
- (error (goto-char (point-min))))
- (setq char nil)))
- (kill-buffer buf)
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
- (memq char '(?! ?\s ?y))))))
+ (set (make-local-variable 'cursor-type) nil)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))
+
+ ;; Display the buffer and read a choice.
+ (save-window-excursion
+ (pop-to-buffer buf)
+ (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+ (prompt (format "Please type %s%s: "
+ (if offer-save "y, n, or !" "y or n")
+ (if (< (line-number-at-pos (point-max))
+ (window-body-height))
+ ""
+ (push ?\C-v exit-chars)
+ ", or C-v to scroll")))
+ char)
+ (if offer-save (push ?! exit-chars))
+ (while (null char)
+ (setq char (read-char-choice prompt exit-chars t))
+ (when (eq char ?\C-v)
+ (condition-case nil
+ (scroll-up)
+ (error (goto-char (point-min))
+ (recenter 1)))
+ (setq char nil)))
+ (when (and offer-save (= char ?!) unsafe-vars)
+ (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (prog1 (memq char '(?! ?\s ?y))
+ (quit-window t)))))))
(defun hack-local-variables-prop-line (&optional mode-only)
"Return local variables specified in the -*- line.
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
- (push elt all-vars)
- (or (eq enable-local-eval t)
- (hack-one-local-variable-eval-safep (eval (quote val)))
- (safe-local-variable-p var val)
- (push elt unsafe-vars))))
+ (let ((safe (or (hack-one-local-variable-eval-safep val)
+ ;; In case previously marked safe (bug#5636).
+ (safe-local-variable-p var val))))
+ ;; If not safe and e-l-v = :safe, ignore totally.
+ (when (or safe (not (eq enable-local-variables :safe)))
+ (push elt all-vars)
+ (or (eq enable-local-eval t)
+ safe
+ (push elt unsafe-vars))))))
;; Ignore duplicates (except `mode') in the present list.
((and (assq var all-vars) (not (eq var 'mode))) nil)
;; Accept known-safe variables.
CLASS is the name of a variable class (a symbol).
MTIME is the recorded modification time of the directory-local
variables file associated with this entry. This time is a list
-of two integers (the same format as `file-attributes'), and is
+of integers (the same format as `file-attributes'), and is
used to test whether the cache entry is still valid.
Alternatively, MTIME can be nil, which means the entry is always
considered valid.")
(condition-case err
(progn
(insert-file-contents file)
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name))
+ (unless (zerop (buffer-size))
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (variables (let ((read-circle nil))
+ (read (current-buffer)))))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class dir-name class-name
+ (nth 5 (file-attributes file)))
+ class-name)))
(error (message "Error reading dir-locals: %S" err) nil)))))
+(defcustom enable-remote-dir-locals nil
+ "Non-nil means dir-local variables will be applied to remote files."
+ :version "24.3"
+ :type 'boolean
+ :group 'find-file)
+
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them."
(when (and enable-local-variables
- (not (file-remote-p (or (buffer-file-name) default-directory))))
+ (or enable-remote-dir-locals
+ (not (file-remote-p (or (buffer-file-name)
+ default-directory)))))
;; Find the variables file.
(let ((variables-file (dir-locals-find-file
(or (buffer-file-name) default-directory)))
(if period
"")))))
+(defun file-name-base (&optional filename)
+ "Return the base name of the FILENAME: no directory, no extension.
+FILENAME defaults to `buffer-file-name'."
+ (file-name-sans-extension
+ (file-name-nondirectory (or filename (buffer-file-name)))))
+
(defcustom make-backup-file-name-function nil
"A function to use instead of the default `make-backup-file-name'.
A value of nil gives the default `make-backup-file-name' behavior.
default-directory))))
(setq filename (expand-file-name filename))
(let ((fremote (file-remote-p filename))
- (dremote (file-remote-p directory)))
+ (dremote (file-remote-p directory))
+ (fold-case (or (memq system-type '(ms-dos cygwin windows-nt))
+ read-file-name-completion-ignore-case)))
(if ;; Conditions for separate trees
(or
;; Test for different filesystems on DOS/Windows
(memq system-type '(ms-dos cygwin windows-nt))
(or
;; Test for different drive letters
- (not (eq t (compare-strings filename 0 2 directory 0 2)))
+ (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
;; Test for UNCs on different servers
(not (eq t (compare-strings
(progn
(while (not
(or
(eq t (compare-strings filename-dir nil (length directory)
- directory nil nil case-fold-search))
+ directory nil nil fold-case))
(eq t (compare-strings filename nil (length directory)
- directory nil nil case-fold-search))))
+ directory nil nil fold-case))))
(setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
(if (eq t (compare-strings filename nil (length directory)
- directory nil nil case-fold-search))
+ directory nil nil fold-case))
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (length directory))))
(or buffer-file-name
(let ((filename
(expand-file-name
- (read-file-name "File to save in: ") nil)))
+ (read-file-name "File to save in: "
+ nil (expand-file-name (buffer-name))))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name of an
"Modification-flag cleared"))
(set-buffer-modified-p arg))
-(defun toggle-read-only (&optional arg)
- "Change whether this buffer is read-only.
-With prefix argument ARG, make the buffer read-only if ARG is
-positive, otherwise make it writable. If buffer is read-only
-and `view-read-only' is non-nil, enter view mode.
-
-This function is usually the wrong thing to use in a Lisp program.
-It can have side-effects beyond changing the read-only status of a buffer
-\(e.g., enabling view mode), and does not affect read-only regions that
-are caused by text properties. To make a buffer read-only in Lisp code,
-set `buffer-read-only'. To ignore read-only status (whether due to text
-properties or buffer state) and make changes, temporarily bind
-`inhibit-read-only'."
- (interactive "P")
- (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)))))
+(defun toggle-read-only (&optional arg interactive)
+ (declare (obsolete read-only-mode "24.3"))
+ (interactive (list current-prefix-arg t))
+ (if interactive
+ (call-interactively 'read-only-mode)
+ (read-only-mode (or arg 'toggle))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
(not (file-exists-p 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)
- (save-excursion
- (let ((switches dired-listing-switches))
- (if (file-symlink-p file)
- (setq switches (concat switches " -L")))
- (set-buffer standard-output)
- ;; Use insert-directory-safely, not insert-directory,
- ;; because these files might not exist. In particular,
- ;; FILE might not exist if the auto-save file was for
- ;; a buffer that didn't visit a file, such as "*mail*".
- ;; The code in v20.x called `ls' directly, so we need
- ;; to emulate what `ls' did in that case.
- (insert-directory-safely file switches)
- (insert-directory-safely file-name switches))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+ ((with-temp-buffer-window
+ "*Directory*" nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p (format "Recover auto save file %s? " file-name))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (with-current-buffer standard-output
+ (let ((switches dired-listing-switches))
+ (if (file-symlink-p file)
+ (setq switches (concat switches " -L")))
+ ;; Use insert-directory-safely, not insert-directory,
+ ;; because these files might not exist. In particular,
+ ;; FILE might not exist if the auto-save file was for
+ ;; a buffer that didn't visit a file, such as "*mail*".
+ ;; The code in v20.x called `ls' directly, so we need
+ ;; to emulate what `ls' did in that case.
+ (insert-directory-safely file switches)
+ (insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
(when (and directory-free-space-program
;; Avoid failure if the default directory does
;; not exist (Bug#2631, Bug#3911).
- (let ((default-directory "/"))
- (eq (call-process directory-free-space-program
+ (let ((default-directory
+ (locate-dominating-file dir 'file-directory-p)))
+ (eq (process-file directory-free-space-program
nil t nil
directory-free-space-args
- dir)
+ (file-relative-name dir))
0)))
;; Assume that the "available" column is before the
;; "capacity" column. Find the "%" and scan backward.
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (progn (list-processes t)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
+ (with-temp-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)
"/"
(substring (car pair) 2)))))
(setq file-arg-indices (cdr file-arg-indices))))
- (case method
- (identity (car arguments))
- (add (concat "/:" (apply operation arguments)))
- (insert-file-contents
+ (pcase method
+ (`identity (car arguments))
+ (`add (concat "/:" (apply operation arguments)))
+ (`insert-file-contents
(let ((visit (nth 1 arguments)))
(prog1
- (apply operation arguments)
+ (apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (concat "/:" buffer-file-name))))))
- (unquote-then-quote
+ (`unquote-then-quote
(let ((buffer-file-name (substring buffer-file-name 2)))
(apply operation arguments)))
- (t
- (apply operation arguments)))))
+ (_
+ (apply operation arguments)))))
\f
;; Symbolic modes and read-file-modes.
(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-terminal)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
+(define-key ctl-x-map "\C-q" 'read-only-mode)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)