;;; 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.
(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.2" ; 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)
"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")
(defvar abbreviated-home-dir nil
"The user's homedir abbreviated according to `directory-abbrev-alist'.")
(/= (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")))
(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.
(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))
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
(dir-elt nil))
;; `locate-dominating-file' may have abbreviated the name.
(and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file))
- ;; FIXME? is it right to silently ignore an unreadable file?
- ;; Maybe we'd want to keep searching in that case.
- ;; That is a locate-dominating-file issue.
- (or (not (file-readable-p locals-file))
- (not (file-regular-p locals-file)))
- (setq locals-file nil))
+ (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.2"
+ :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
(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
(setq f2-attr (file-attributes (file-truename file2)))
(equal f1-attr f2-attr))))))
-(defun file-subdir-of-p (dir1 dir2)
- "Return non-nil if DIR1 is a subdirectory of DIR2.
-A directory is considered to be a subdirectory of itself.
-Return nil if top directory DIR2 is not an existing directory."
- (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
- (find-file-name-handler dir2 'file-subdir-of-p))))
+(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-subdir-of-p dir1 dir2)
- (when (file-directory-p dir2) ; Top dir must exist.
- (setq dir1 (file-truename dir1)
- dir2 (file-truename dir2))
- (let ((ls1 (or (split-string dir1 "/" t) '("/")))
- (ls2 (or (split-string dir2 "/" t) '("/")))
- (root (if (string-match "\\`/" dir1) "/" ""))
+ (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 ls1 (cdr ls1)
ls2 (cdr ls2)))
(unless mismatch
- (file-equal-p root dir2)))))))
+ (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.
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
- (when (file-subdir-of-p newname directory)
+ (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
;; 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
(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.
(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
(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))
HCoop / bpt / emacs.git / blobdiff