;;; Commentary:
-;; Defines most of Emacs's file- and directory-handling functions,
+;; Defines most of Emacs'ss 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
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
+(define-obsolete-variable-alias 'find-file-not-found-hooks
+ 'find-file-not-found-functions "22.1")
(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.")
-(define-obsolete-variable-alias 'find-file-not-found-hooks
- 'find-file-not-found-functions "22.1")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
:options '(auto-insert)
:version "22.1")
+(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(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
node `(elisp)Saving Buffers'.) To perform various checks or
updates before the buffer is saved, use `before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
-(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(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 "22.1")
+(define-obsolete-variable-alias 'write-contents-hooks
+ 'write-contents-functions "22.1")
(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
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
(make-variable-buffer-local 'write-contents-functions)
-(define-obsolete-variable-alias 'write-contents-hooks
- 'write-contents-functions "22.1")
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
(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
;; 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."
+and return the directory. Return nil if not found.
+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)))
- (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)
(funcall handler 'file-remote-p file identification connected)
nil)))
+;; Probably this entire variable should be obsolete now, in favor of
+;; something Tramp-related (?). It is not used in many places.
+;; It's not clear what the best file for this to be in is, but given
+;; it uses custom-initialize-delay, it is easier if it is preloaded
+;; rather than autoloaded.
+(defcustom remote-shell-program
+ ;; This used to try various hard-coded places for remsh, rsh, and
+ ;; rcmd, trying to guess based on location whether "rsh" was
+ ;; "restricted shell" or "remote shell", but I don't see the point
+ ;; in this day and age. Almost everyone will use ssh, and have
+ ;; whatever command they want to use in PATH.
+ (purecopy
+ (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.3" ; ssh rather than rsh, etc
+ :initialize 'custom-initialize-delay
+ :group 'environment
+ :type 'file)
+
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
+When `nil', never expire cached values (caution)
+When `t', never use the cache (safe, but may be slow)
+A number means use cached values for that amount of seconds since caching.
-When `nil', always use the cached values.
-When `t', never use them.
-A number means use them for that amount of seconds since they were
-cached.
+The attributes of remote files are cached for better performance.
+If they are changed outside of Emacs's control, the cached values
+become invalid, and must be reread. If you are sure that nothing
+other than Emacs changes the files, you can set this variable to `nil'.
-File attributes of remote files are cached for better performance.
-If they are changed out of Emacs' control, the cached values
-become invalid, and must be invalidated.
-
-In case a remote file is checked regularly, it might be
-reasonable to let-bind this variable to a value less then the
-time period between two checks.
-Example:
+If a remote file is checked regularly, it might be a good idea to
+let-bind this variable to a value less than the interval between
+consecutive checks. For example:
(defun display-time-file-nonempty-p (file)
(let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
(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.
"Regexp to match the automounter prefix in a directory name."
:group 'files
:type 'regexp)
+(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)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
+ (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)))
(boundp 'font-lock-keywords)
(eq (car font-lock-keywords) t))
(setq font-lock-keywords (cadr font-lock-keywords))
- (font-lock-mode 1))
-
- (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
- (ucs-set-table-for-input)))
+ (font-lock-mode 1)))
(defcustom auto-mode-case-fold t
"Non-nil means to try second pass through `auto-mode-alist'.
("\\.makepp\\'" . makefile-makepp-mode)
,@(if (memq system-type '(berkeley-unix darwin))
'(("\\.mk\\'" . makefile-bsdmake-mode)
+ ("\\.make\\'" . makefile-bsdmake-mode)
("GNUmakefile\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-bsdmake-mode))
'(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
+ ("\\.make\\'" . makefile-gmake-mode)
("[Mm]akefile\\'" . makefile-gmake-mode)))
("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.js\\'" . js-mode) ; javascript-mode would be better
- ("\\.json\\'" . js-mode)
+ ("\\.js\\'" . javascript-mode)
+ ("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
(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))))))
(funcall mode)
mode)))
+(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
+ "Regexp of lines to skip when looking for file-local settings.
+If the first line matches this regular expression, then the -*-...-*- file-
+local settings will be consulted on the second line instead of the first.")
+
(defun set-auto-mode-1 ()
"Find the -*- spec in the buffer.
Call with point at the place to start searching from.
;; interpreter invocation. The same holds
;; for '\" in man pages (preprocessor
;; magic for the `man' program).
- (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
+ (and (looking-at file-auto-mode-skip) 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
;; 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.
When a file is visited, the file's class is found. A directory
may be assigned a class using `dir-locals-set-directory-class'.
Then variables are set in the file's buffer according to the
-class' LIST. The list is processed in order.
+VARIABLES list of the class. The list is processed in order.
* If the element is of the form (MAJOR-MODE . ALIST), and the
buffer's major mode is derived from MAJOR-MODE (as determined
(locals-file (locate-dominating-file file dir-locals-file-name))
(dir-elt nil))
;; `locate-dominating-file' may have abbreviated the name.
- (if locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ (and locals-file
+ (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ ;; Let dir-locals-read-from-file inform us via demoted-errors
+ ;; about unreadable files, etc.
+ ;; Maybe we'd want to keep searching though - that is
+ ;; a locate-dominating-file issue.
+;;; (or (not (file-readable-p locals-file))
+;;; (not (file-regular-p locals-file)))
+;;; (setq locals-file nil))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (eq t (compare-strings file nil (length (car elt))
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
(with-temp-buffer
- (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)))
+ ;; This is with-demoted-errors, but we want to mention dir-locals
+ ;; in any error message.
+ (let (err)
+ (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))
+ (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)))
+ (let ((variables-file (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
;; Don't change the mode if the local variable list specifies it.
;; The file name can influence whether the local variables apply.
(and old-try-locals
- ;; h-l-v also checks it, but might as well be explcit.
+ ;; h-l-v also checks it, but might as well be explicit.
(not (inhibit-local-variables-p))
(hack-local-variables t))
;; TODO consider making normal-mode handle this case.
(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
(format
"%s has changed since visited or saved. Save anyway? "
(file-name-nondirectory buffer-file-name)))
- (error "Save not confirmed"))
+ (user-error "Save not confirmed"))
(save-restriction
(widen)
(save-excursion
"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.
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
This function is useful for creating multiple shell process buffers
-or multiple mail buffers, etc."
+or multiple mail buffers, etc.
+
+Note that some commands, in particular those based on `compilation-mode'
+\(`compile', `grep', etc.) will reuse the current buffer if it has the
+appropriate mode even if it has been renamed. So as well as renaming
+the buffer, you also need to switch buffers before running another
+instance of such commands."
(interactive)
(save-match-data
(let ((base-name (buffer-name)))
directory 'full directory-files-no-dot-files-regexp)))
(delete-directory-internal directory)))))
+(defun file-equal-p (file1 file2)
+ "Return non-nil if files FILE1 and FILE2 name the same file.
+If FILE1 or FILE2 does not exist, the return value is unspecified."
+ (let ((handler (or (find-file-name-handler file1 'file-equal-p)
+ (find-file-name-handler file2 'file-equal-p))))
+ (if handler
+ (funcall handler 'file-equal-p file1 file2)
+ (let (f1-attr f2-attr)
+ (and (setq f1-attr (file-attributes (file-truename file1)))
+ (setq f2-attr (file-attributes (file-truename file2)))
+ (equal f1-attr f2-attr))))))
+
+(defun file-in-directory-p (file dir)
+ "Return non-nil if FILE is in DIR or a subdirectory of DIR.
+A directory is considered to be \"in\" itself.
+Return nil if DIR is not an existing directory."
+ (let ((handler (or (find-file-name-handler file 'file-in-directory-p)
+ (find-file-name-handler dir 'file-in-directory-p))))
+ (if handler
+ (funcall handler 'file-in-directory-p file dir)
+ (when (file-directory-p dir) ; DIR must exist.
+ (setq file (file-truename file)
+ dir (file-truename dir))
+ (let ((ls1 (split-string file "/" t))
+ (ls2 (split-string dir "/" t))
+ (root (if (string-match "\\`/" file) "/" ""))
+ (mismatch nil))
+ (while (and ls1 ls2 (not mismatch))
+ (if (string-equal (car ls1) (car ls2))
+ (setq root (concat root (car ls1) "/"))
+ (setq mismatch t))
+ (setq ls1 (cdr ls1)
+ ls2 (cdr ls2)))
+ (unless mismatch
+ (file-equal-p root dir)))))))
+
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
This function always sets the file modes of the output files to match
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
+ (when (file-in-directory-p newname directory)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ directory newname))
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
(find-file-name-handler newname 'copy-directory))))
(if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
+ (funcall handler 'copy-directory directory
+ newname keep-time parents copy-contents)
;; Compute target name.
(setq directory (directory-file-name (expand-file-name directory))
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
- (if (file-directory-p file)
- (copy-directory file newname keep-time parents)
- (let ((target (expand-file-name (file-name-nondirectory file) newname))
- (attrs (file-attributes file)))
- (if (stringp (car attrs)) ; Symbolic link
- (make-symbolic-link (car attrs) target t)
- (copy-file file target t keep-time)))))
+ (let ((target (expand-file-name (file-name-nondirectory file) newname))
+ (filetype (car (file-attributes file))))
+ (cond
+ ((eq filetype t) ; Directory but not a symlink.
+ (copy-directory file newname keep-time parents))
+ ((stringp filetype) ; Symbolic link
+ (make-symbolic-link filetype target t))
+ ((copy-file file target t keep-time)))))
;; Set directory attributes.
(let ((modes (file-modes directory))
(times (and keep-time (nth 5 (file-attributes directory)))))
(if modes (set-file-modes newname modes))
(if times (set-file-times newname times))))))
+
+\f
+;; At time of writing, only info uses this.
+(defun prune-directory-list (dirs &optional keep reject)
+ "Return a copy of DIRS with all non-existent directories removed.
+The optional argument KEEP is a list of directories to retain even if
+they don't exist, and REJECT is a list of directories to remove from
+DIRS, even if they exist; REJECT takes precedence over KEEP.
+
+Note that membership in REJECT and KEEP is checked using simple string
+comparison."
+ (apply #'nconc
+ (mapcar (lambda (dir)
+ (and (not (member dir reject))
+ (or (member dir keep) (file-directory-p dir))
+ (list dir)))
+ dirs)))
+
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
Optional third argument PRESERVE-MODES non-nil means don't alter
the files modes. Normally we reinitialize them using `normal-mode'.
+This function binds `revert-buffer-in-progress-p' non-nil while it operates.
+
If the value of `revert-buffer-function' is non-nil, it is called to
do all the work for this command. Otherwise, the hooks
`before-revert-hook' and `after-revert-hook' are run at the beginning
(unlock-buffer)))
(widen)
(let ((coding-system-for-read
- ;; Auto-saved file should be read by Emacs'
+ ;; Auto-saved file should be read by Emacs's
;; internal coding.
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
(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.
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(after-find-file nil nil t))
- (t (error "Recover-file cancelled")))))
+ (t (user-error "Recover-file cancelled")))))
(defun recover-session ()
"Recover auto save files from a previous Emacs session.
(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.
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
-With prefix ARG, silently save all file-visiting buffers, then kill."
+With prefix ARG, silently save all file-visiting buffers without asking.
+If there are active processes where `process-query-on-exit-flag'
+returns non-nil, asks whether processes should be killed.
+Runs the members of `kill-emacs-query-functions' in turn and stops
+if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
(and (or (not (memq t (mapcar (function
(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.
(new-fn (expand-file-name (file-name-nondirectory fn)
trash-dir)))
;; We can't trash a parent directory of trash-directory.
- (if (string-match fn trash-dir)
+ (if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
trash-dir filename))
(unless (file-directory-p trash-dir)
(file-name-directory fn)))
(error "Cannot move %s to trash: Permission denied" filename))
;; The trashed file cannot be the trash dir or its parent.
- (if (string-match fn trash-files-dir)
+ (if (string-prefix-p fn trash-files-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-files-dir filename))
- (if (string-match fn trash-info-dir)
+ (if (string-prefix-p fn trash-info-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-info-dir filename))