;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar font-lock-keywords)
-
(defgroup backup nil
"Backups of edited data files."
:group 'files)
:group 'abbrev
:group 'find-file)
-;; Turn off backup files on VMS since it has version numbers.
-(defcustom make-backup-files (not (eq system-type 'vax-vms))
+(defcustom make-backup-files t
"Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.
(defcustom backup-by-copying nil
"Non-nil means always use copying to create backup files.
See documentation of variable `make-backup-files'."
- :type 'boolean
- :group 'backup)
+ :type 'boolean
+ :group 'backup)
(defcustom backup-by-copying-when-linked nil
"Non-nil means use copying to create backups for files with multiple names.
This causes the alternate names to refer to the latest version as edited.
This variable is relevant only if `backup-by-copying' is nil."
- :type 'boolean
- :group 'backup)
+ :type 'boolean
+ :group 'backup)
(defcustom backup-by-copying-when-mismatch nil
"Non-nil means create backups by copying if this preserves owner or group.
:group 'find-file)
(defcustom find-file-visit-truename nil
- "*Non-nil means visit a file under its truename.
+ "Non-nil means visit a file under its truename.
The truename of a file is found by chasing all links
both at the file level and at the levels of the containing directories."
:type 'boolean
(file-name-as-directory
(cond ((memq system-type '(ms-dos windows-nt))
(or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
- ((memq system-type '(vax-vms axp-vms))
- (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
(t
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
"The directory for writing temporary files."
(declare-function dired-unmark "dired" (arg))
(declare-function dired-do-flagged-delete "dired" (&optional nomessage))
(declare-function dos-8+3-filename "dos-fns" (filename))
-(declare-function vms-read-directory "vms-patch" (dirname switches buffer))
(declare-function view-mode-disable "view" ())
(defvar file-name-invalid-regexp
(cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters
- "[\000-\031]\\|" ; control characters
+ "[\000-\037]\\|" ; control characters
"\\(/\\.\\.?[^/]\\)\\|" ; leading dots
"\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
((memq system-type '(ms-dos windows-nt cygwin))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
- "[|<>\"?*\000-\031]")) ; invalid characters
+ "[|<>\"?*\000-\037]")) ; invalid characters
(t "[\000]"))
"Regexp recognizing file names which aren't allowed by the filesystem.")
:type 'boolean
:group 'auto-save)
-(defcustom auto-save-visited-file-name nil
- "Non-nil says auto-save a buffer in the file it is visiting, when practical.
-Normally auto-save files are written under other names."
- :type 'boolean
- :group 'auto-save)
-
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'"
;; Don't put "\\2" inside expand-file-name, since it will be
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
+(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
(defcustom 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
:type 'hook
:options '(auto-insert)
:version "22.1")
-(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
(defcustom enable-local-eval 'maybe
"Control processing of the \"variable\" `eval' in a file's local variables.
The value can be t, nil or something else.
-A value of t means obey `eval' variables;
+A value of t means obey `eval' variables.
A value of nil means ignore them; anything else means query."
:type '(choice (const :tag "Obey" t)
(const :tag "Ignore" nil)
"Change current directory to given absolute file name DIR."
;; Put the name into directory syntax now,
;; because otherwise expand-file-name may give some bad results.
- (if (not (eq system-type 'vax-vms))
- (setq dir (file-name-as-directory dir)))
+ (setq dir (file-name-as-directory dir))
(setq dir (abbreviate-file-name (expand-file-name dir)))
(if (not (file-directory-p dir))
(if (file-exists-p dir)
(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)."
+(defun locate-file-completion-table (dirs suffixes string pred action)
+ "Do completion for file names passed to `locate-file'."
(if (file-name-absolute-p string)
- (read-file-name-internal string nil action)
+ (let ((read-file-name-predicate pred))
+ (read-file-name-internal string nil action))
(let ((names nil)
- (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
+ (suffix (concat (regexp-opt suffixes t) "\\'"))
(string-dir (file-name-directory string)))
- (dolist (dir (car path-and-suffixes))
+ (dolist (dir dirs)
(unless dir
(setq dir default-directory))
(if string-dir (setq dir (expand-file-name string-dir dir)))
(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 locate-dominating-file (file regexp)
- "Look up the directory hierarchy from FILE for a file matching REGEXP."
- (while (and file (not (file-directory-p file)))
- (setq file (file-name-directory (directory-file-name file))))
- (catch 'found
- (let ((user (nth 2 (file-attributes file)))
- ;; Abbreviate, so as to stop when we cross ~/.
- (dir (abbreviate-file-name (file-name-as-directory file)))
- files)
- ;; As a heuristic, we stop looking up the hierarchy of directories as
- ;; soon as we find a directory belonging to another user. This should
- ;; save us from looking in things like /net and /afs. This assumes
- ;; that all the files inside a project belong to the same user.
- (while (and dir (equal user (nth 2 (file-attributes dir))))
- (if (setq files (directory-files dir 'full regexp))
- (throw 'found (car files))
- (if (equal dir
- (setq dir (file-name-directory
- (directory-file-name dir))))
- (setq dir nil))))
- nil)))
+ (complete-with-action action names string pred))))
+
+(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)."
+ (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
+ "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'"
+ "Regexp of directory names which stop the search in `locate-dominating-file'.
+Any directory whose name matches this regexp will be treated like
+a kind of root directory by `locate-dominating-file' which will stop its search
+when it bumps into it.
+The default regexp prevents fruitless and time-consuming attempts to find
+special files in directories in which filenames are interpreted as hostnames.")
+
+;; (defun locate-dominating-files (file regexp)
+;; "Look up the directory hierarchy from FILE for a file matching REGEXP.
+;; Stop at the first parent where a matching file is found and return the list
+;; of files that that match in this directory."
+;; (catch 'found
+;; ;; `user' is not initialized yet because `file' may not exist, so we may
+;; ;; have to walk up part of the hierarchy before we find the "initial UID".
+;; (let ((user nil)
+;; ;; Abbreviate, so as to stop when we cross ~/.
+;; (dir (abbreviate-file-name (file-name-as-directory file)))
+;; files)
+;; (while (and dir
+;; ;; As a heuristic, we stop looking up the hierarchy of
+;; ;; directories as soon as we find a directory belonging to
+;; ;; another user. This should save us from looking in
+;; ;; things like /net and /afs. This assumes that all the
+;; ;; files inside a project belong to the same user.
+;; (let ((prev-user user))
+;; (setq user (nth 2 (file-attributes dir)))
+;; (or (null prev-user) (equal user prev-user))))
+;; (if (setq files (condition-case nil
+;; (directory-files dir 'full regexp 'nosort)
+;; (error nil)))
+;; (throw 'found files)
+;; (if (equal dir
+;; (setq dir (file-name-directory
+;; (directory-file-name dir))))
+;; (setq dir nil))))
+;; nil)))
+
+(defun locate-dominating-file (file name)
+ "Look up the directory hierarchy from FILE for a file named NAME.
+Stop at the first parent directory containing a file NAME,
+and return the directory. Return nil if not found."
+ ;; 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.
+ ;;
+ ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
+ ;; `name' in /home or in /.
+ (setq file (abbreviate-file-name file))
+ (let ((root nil)
+ (prev-file file)
+ ;; `user' is not initialized outside the loop because
+ ;; `file' may not exist, so we may have to walk up part of the
+ ;; hierarchy before we find the "initial UID".
+ (user nil)
+ try)
+ (while (not (or root
+ (null file)
+ ;; FIXME: Disabled this heuristic because it is sometimes
+ ;; inappropriate.
+ ;; As a heuristic, we stop looking up the hierarchy of
+ ;; directories as soon as we find a directory belonging
+ ;; to another user. This should save us from looking in
+ ;; things like /net and /afs. This assumes that all the
+ ;; files inside a project belong to the same user.
+ ;; (let ((prev-user user))
+ ;; (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)))
+ (cond (try (setq root file))
+ ((equal file (setq prev-file file
+ file (file-name-directory
+ (directory-file-name file))))
+ (setq file nil))))
+ root))
+
(defun executable-find (command)
"Search for COMMAND in `exec-path' and return the absolute file name.
This is an interface to the function `load'."
(interactive
(list (completing-read "Load library: "
- 'locate-file-completion
- (cons load-path (get-load-suffixes)))))
+ (apply-partially 'locate-file-completion-table
+ load-path
+ (get-load-suffixes)))))
(load library))
(defun file-remote-p (file &optional identification connected)
IDENTIFICATION specifies which part of the identification shall
be returned as string. IDENTIFICATION can be the symbol
-`method', `user' or `host'; any other value is handled like nil
-and means to return the complete identification string.
+`method', `user', `host' or `localname'; any other value is
+handled like nil and means to return the complete identification
+string.
If CONNECTED is non-nil, the function returns an identification only
if FILE is located on a remote system, and a connection is established
(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
- (setq filename (or (w32-long-file-name filename) 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)))
;; If this file directly leads to a link, process that iteratively
(progn
(setq file
(make-temp-name
- (expand-file-name prefix temporary-file-directory)))
+ (if (zerop (length prefix))
+ (file-name-as-directory
+ temporary-file-directory)
+ (expand-file-name prefix
+ temporary-file-directory))))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(rename-file encoded new-encoded ok-if-already-exists)
newname))
\f
+(defun read-buffer-to-switch (prompt)
+ "Read the name of a buffer to switch to and return as a string.
+It is intended for `switch-to-buffer' family of commands since they
+need to omit the name of current buffer from the list of completions
+and default values."
+ (let ((rbts-completion-table (internal-complete-buffer-except)))
+ (minibuffer-with-setup-hook
+ (lambda () (setq minibuffer-completion-table rbts-completion-table))
+ (read-buffer prompt (other-buffer (current-buffer))))))
+
(defun switch-to-buffer-other-window (buffer &optional norecord)
"Select buffer BUFFER in another window.
If BUFFER does not identify an existing buffer, then this function
When called from Lisp, BUFFER can be a buffer, a string \(a buffer name),
or nil. If BUFFER is nil, then this function chooses a buffer
using `other-buffer'.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones.
+Optional second arg NORECORD non-nil means do not put this
+buffer at the front of the list of recently selected ones.
This function returns the buffer it switched to.
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
- (interactive "BSwitch to buffer in other window: ")
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other window: ")))
(let ((pop-up-windows t)
;; Don't let these interfere.
same-window-buffer-names same-window-regexps)
(defun switch-to-buffer-other-frame (buffer &optional norecord)
"Switch to buffer BUFFER in another frame.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones.
+Optional second arg NORECORD non-nil means do not put this
+buffer at the front of the list of recently selected ones.
This function returns the buffer it switched to.
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
- (interactive "BSwitch to buffer in other frame: ")
+This uses the function `display-buffer' as a subroutine; see
+its documentation for additional customization information."
+ (interactive
+ (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps)
- (prog1
- (pop-to-buffer buffer t norecord)
- (raise-frame (window-frame (selected-window))))))
+ (pop-to-buffer buffer t norecord)))
(defun display-buffer-other-frame (buffer)
- "Switch to buffer BUFFER in another frame.
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
+ "Display buffer BUFFER in another frame.
+This uses the function `display-buffer' as a subroutine; see
+its documentation for additional customization information."
(interactive "BDisplay buffer in other frame: ")
(let ((pop-up-frames t)
same-window-buffer-names same-window-regexps
(old-window (selected-window))
new-window)
(setq new-window (display-buffer buffer t))
- (lower-frame (window-frame new-window))
- (make-frame-invisible (window-frame old-window))
- (make-frame-visible (window-frame old-window))))
+ ;; This may have been here in order to prevent the new frame from hiding
+ ;; the old frame. But it does more harm than good.
+ ;; Maybe we should call `raise-window' on the old-frame instead? --Stef
+ ;;(lower-frame (window-frame new-window))
+
+ ;; This may have been here in order to make sure the old-frame gets the
+ ;; focus. But not only can it cause an annoying flicker, with some
+ ;; window-managers it just makes the window invisible, with no easy
+ ;; way to recover it. --Stef
+ ;;(make-frame-invisible (window-frame old-window))
+ ;;(make-frame-visible (window-frame old-window))
+ ))
(defvar find-file-default nil
"Used within `find-file-read-args'.")
;; Clear out this hook so it does not interfere
;; with any recursive minibuffer usage.
(remove-hook 'minibuffer-setup-hook ,hook)
- (,fun)))
+ (funcall ,fun)))
(unwind-protect
(progn
(add-hook 'minibuffer-setup-hook ,hook)
(file-exists-p (file-name-directory
(substring filename (1- (match-end 0))))))
(setq filename (substring filename (1- (match-end 0)))))
- (let ((tail directory-abbrev-alist))
+ ;; Avoid treating /home/foo as /home/Foo during `~' substitution.
+ ;; To fix this right, we need a `file-name-case-sensitive-p'
+ ;; function, but we don't have that yet, so just guess.
+ (let ((case-fold-search
+ (memq system-type '(ms-dos windows-nt darwin cygwin))))
;; If any elt of directory-abbrev-alist matches this name,
;; abbreviate accordingly.
- (while tail
- (if (string-match (car (car tail)) filename)
+ (dolist (dir-abbrev directory-abbrev-alist)
+ (if (string-match (car dir-abbrev) filename)
(setq filename
- (concat (cdr (car tail)) (substring filename (match-end 0)))))
- (setq tail (cdr tail)))
+ (concat (cdr dir-abbrev)
+ (substring filename (match-end 0))))))
;; Compute and save the abbreviated homedir name.
;; We defer computing this until the first time it's needed, to
;; give time for directory-abbrev-alist to be set properly.
filename)))
(defcustom find-file-not-true-dirname-list nil
- "List of logical names for which visiting shouldn't save the true dirname.
-On VMS, when you visit a file using a logical name that searches a path,
-you may or may not want the visited file name to record the specific
-directory where the file was found. If you *do not* want that, add the logical
-name to this list as a string."
+ "List of logical names for which visiting shouldn't save the true dirname."
:type '(repeat (string :tag "Name"))
:group 'find-file)
:version "22.1"
:type '(choice integer (const :tag "Never request confirmation" nil)))
+(defun abort-if-file-too-large (size op-type)
+ "If file SIZE larger than `large-file-warning-threshold', allow user to abort.
+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? "
+ (file-name-nondirectory filename)
+ (/ size 1048576) op-type))))
+ (error "Aborted")))
+
(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
(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 (%dMB), really open? "
- (file-name-nondirectory filename)
- (/ (nth 7 attributes) 1048576)))))
- (error "Aborted"))
+ (when (not (or buf nowarn))
+ (abort-if-file-too-large (nth 7 attributes) "open"))
(if buf
;; We are using an existing buffer.
(let (nonexistent)
(setq buffer-file-truename
(abbreviate-file-name (file-truename buffer-file-name))))
(setq buffer-file-number number)
- ;; On VMS, we may want to remember which directory in a search list
- ;; the file was found in.
- (and (eq system-type 'vax-vms)
- (let (logical)
- (if (string-match ":" (file-name-directory filename))
- (setq logical (substring (file-name-directory filename)
- 0 (match-beginning 0))))
- (not (member logical find-file-not-true-dirname-list)))
- (setq buffer-file-name buffer-file-truename))
(if find-file-visit-truename
(setq buffer-file-name (expand-file-name buffer-file-truename)))
;; Set buffer's default directory to that of the file.
(symbol-function 'find-buffer-file-type)
nil))
(inhibit-file-name-handlers
- (append '(jka-compr-handler image-file-handler)
+ (append '(jka-compr-handler image-file-handler epa-file-handler)
inhibit-file-name-handlers))
(inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
(if (file-directory-p filename)
(signal 'file-error (list "Opening input file" "file is a directory"
filename)))
+ ;; Check whether the file is uncommonly large
+ (abort-if-file-too-large (nth 7 (file-attributes filename)) "insert")
(let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
#'buffer-modified-p))
(tem (funcall insert-func filename)))
("\\.mss\\'" . scribe-mode)
("\\.f9[05]\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
- ("\\.pro\\'" . idlwave-mode)
+ ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
;; The list of archive file extensions should be in sync with
arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode) ; OpenOffice.org
+ ("\\.\\(deb\\)\\'" . archive-mode) ; Debian packages.
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js\\'" . java-mode) ; javascript-mode would be better
- ("\\.d?v\\'" . verilog-mode)
+ ("\\.[ds]?v\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\.[eE]?[pP][sS]\\'" . ps-mode)
("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
+ ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
("#\\*mail\\*" . mail-mode)
(while name
;; Find first matching alist entry.
(setq mode
- (if (memq system-type '(vax-vms windows-nt cygwin))
+ (if (memq system-type '(windows-nt cygwin))
;; System is case-insensitive.
(let ((case-fold-search t))
(assoc-default name auto-mode-alist
;;; Handling file local variables
(defvar ignored-local-variables
- '(ignored-local-variables safe-local-variable-values)
+ '(ignored-local-variables safe-local-variable-values
+ file-local-variables-alist)
"Variables to be ignored in a file's local variable spec.")
(defvar hack-local-variables-hook nil
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is a value that is considered safe."
:group 'find-file
- :type 'alist)
+ :type 'alist)
(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp))
"Expressions that are considered safe in an `eval:' local variable.
(put 'c-set-style 'safe-local-eval-function t)
-(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars)
+(defvar file-local-variables-alist nil
+ "Alist of file-local variable settings in the current buffer.
+Each element in this list has the form (VAR . VALUE), where VAR
+is a file-local variable (a symbol) and VALUE is the value
+specified. The actual value in the buffer may differ from VALUE,
+if it is changed by the major or minor modes, or by the user.")
+(make-variable-buffer-local 'file-local-variables-alist)
+
+(defvar before-hack-local-variables-hook nil
+ "Normal hook run before setting file-local variables.
+It is called after checking for unsafe/risky variables and
+setting `file-local-variables-alist', and before applying the
+variables stored in `file-local-variables-alist'. A hook
+function is allowed to change the contents of this alist.
+
+This hook is called only if there is at least one file-local
+variable to set.")
+
+(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars project)
"Get confirmation before setting up local variable values.
ALL-VARS is the list of all variables to be set up.
UNSAFE-VARS is the list of those that aren't marked as safe or risky.
-RISKY-VARS is the list of those that are marked as risky."
+RISKY-VARS is the list of those that are marked as risky.
+PROJECT is a directory name if these settings come from directory-local
+settings, or nil otherwise."
(if noninteractive
nil
(let ((name (if buffer-file-name
(set (make-local-variable 'cursor-type) nil)
(erase-buffer)
(if unsafe-vars
- (insert "The local variables list in " name
+ (insert "The local variables list in " (or project name)
"\ncontains values that may not be safe (*)"
(if risky-vars
", and variables that are risky (**)."
"."))
(if risky-vars
- (insert "The local variables list in " name
+ (insert "The local variables list in " (or project name)
"\ncontains variables that are risky (**).")
- (insert "A local variables list is specified in " name ".")))
+ (insert "A local variables list is specified in "
+ (or project name) ".")))
(insert "\n\nDo you want to apply it? You can type
y -- to apply the local variables list.
n -- to ignore the local variables list.")
mode-specified
result))))
+(defun hack-local-variables-filter (variables project)
+ "Filter local variable settings, querying the user if necessary.
+VARIABLES is the alist of variable-value settings. This alist is
+ filtered based on the values of `ignored-local-variables',
+ `enable-local-eval', `enable-local-variables', and (if necessary)
+ user interaction. The results are added to
+ `file-local-variables-alist', without applying them.
+PROJECT is a directory name if these settings come from
+ directory-local settings, or nil otherwise."
+ ;; Strip any variables that are in `ignored-local-variables'.
+ (dolist (ignored ignored-local-variables)
+ (setq variables (assq-delete-all ignored variables)))
+ ;; If `enable-local-eval' is nil, strip eval "variables".
+ (if (null enable-local-eval)
+ (setq variables (assq-delete-all 'eval variables)))
+ (setq variables (nreverse variables))
+ (when variables
+ ;; Find those variables that we may want to save to
+ ;; `safe-local-variable-values'.
+ (let (risky-vars unsafe-vars)
+ (dolist (elt variables)
+ (let ((var (car elt))
+ (val (cdr elt)))
+ ;; Don't query about the fake variables.
+ (or (memq var '(mode unibyte coding))
+ (and (eq var 'eval)
+ (or (eq enable-local-eval t)
+ (hack-one-local-variable-eval-safep
+ (eval (quote val)))))
+ (safe-local-variable-p var val)
+ (and (risky-local-variable-p var val)
+ (push elt risky-vars))
+ (push elt unsafe-vars))))
+ (if (eq enable-local-variables :safe)
+ ;; If caller wants only safe variables, store only these.
+ (dolist (elt variables)
+ (unless (or (member elt unsafe-vars)
+ (member elt risky-vars))
+ (push elt file-local-variables-alist)))
+ ;; Query, unless all are known safe or the user wants no
+ ;; querying.
+ (if (or (and (eq enable-local-variables t)
+ (null unsafe-vars)
+ (null risky-vars))
+ (eq enable-local-variables :all)
+ (hack-local-variables-confirm
+ variables unsafe-vars risky-vars project))
+ (dolist (elt variables)
+ (push elt file-local-variables-alist)))))))
+
(defun hack-local-variables (&optional mode-only)
"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
(let ((enable-local-variables
(and local-enable-local-variables enable-local-variables))
result)
+ (unless mode-only
+ (setq file-local-variables-alist nil)
+ (report-errors "Project local-variables error: %s"
+ (hack-project-variables)))
(when (or mode-only enable-local-variables)
(setq result (hack-local-variables-prop-line mode-only))
;; Look for "Local variables:" line in last page.
(re-search-forward
(concat prefix "[ \t]*End:[ \t]*" suffix)
nil t))
- (error "Local variables list is not properly terminated"))
+ ;; This used to be an error, but really all it means is
+ ;; that this may simply not be a local-variables section,
+ ;; so just ignore it.
+ (message "Local variables list is not properly terminated"))
(beginning-of-line)
(setq endpos (point)))
(indirect-variable var))
val) result)
(error nil)))))
- (forward-line 1)))))))
-
- ;; We've read all the local variables. Now, return whether the
- ;; mode is specified (if MODE-ONLY is non-nil), or set the
- ;; variables (if MODE-ONLY is nil.)
- (if mode-only
- result
- (dolist (ignored ignored-local-variables)
- (setq result (assq-delete-all ignored result)))
- (if (null enable-local-eval)
- (setq result (assq-delete-all 'eval result)))
- (when result
- (setq result (nreverse result))
- ;; Find those variables that we may want to save to
- ;; `safe-local-variable-values'.
- (let (risky-vars unsafe-vars)
- (dolist (elt result)
- (let ((var (car elt))
- (val (cdr elt)))
- ;; Don't query about the fake variables.
- (or (memq var '(mode unibyte coding))
- (and (eq var 'eval)
- (or (eq enable-local-eval t)
- (hack-one-local-variable-eval-safep
- (eval (quote val)))))
- (safe-local-variable-p var val)
- (and (risky-local-variable-p var val)
- (push elt risky-vars))
- (push elt unsafe-vars))))
- (if (eq enable-local-variables :safe)
- ;; If caller wants only the safe variables,
- ;; install only them.
- (dolist (elt result)
- (unless (or (member elt unsafe-vars)
- (member elt risky-vars))
- (hack-one-local-variable (car elt) (cdr elt))))
- ;; Query, except in the case where all are known safe
- ;; if the user wants no quuery in that case.
- (if (or (and (eq enable-local-variables t)
- (null unsafe-vars)
- (null risky-vars))
- (eq enable-local-variables :all)
- (hack-local-variables-confirm
- result unsafe-vars risky-vars))
- (dolist (elt result)
- (hack-one-local-variable (car elt) (cdr elt)))))))
- (run-hooks 'hack-local-variables-hook)))))
+ (forward-line 1))))))))
+ ;; Now we've read all the local variables.
+ ;; If MODE-ONLY is non-nil, return whether the mode was specified.
+ (cond (mode-only result)
+ ;; Otherwise, set the variables.
+ (enable-local-variables
+ (hack-local-variables-filter result nil)
+ (when file-local-variables-alist
+ (setq file-local-variables-alist
+ (nreverse file-local-variables-alist))
+ (run-hooks 'before-hack-local-variables-hook)
+ (dolist (elt file-local-variables-alist)
+ (hack-one-local-variable (car elt) (cdr elt))))
+ (run-hooks 'hack-local-variables-hook)))))
(defun safe-local-variable-p (sym val)
"Non-nil if SYM is safe as a file-local variable with value VAL.
(and (eq (car exp) 'put)
(hack-one-local-variable-quotep (nth 1 exp))
(hack-one-local-variable-quotep (nth 2 exp))
- (let ((prop (nth 1 (nth 2 exp))) (val (nth 3 exp)))
- (cond ((eq prop 'lisp-indent-hook)
- ;; Only allow safe values of lisp-indent-hook;
- ;; not functions.
- (or (numberp val) (equal val ''defun)))
+ (let ((prop (nth 1 (nth 2 exp)))
+ (val (nth 3 exp)))
+ (cond ((memq prop '(lisp-indent-hook
+ lisp-indent-function
+ scheme-indent-function))
+ ;; Only allow safe values (not functions).
+ (or (numberp val)
+ (and (hack-one-local-variable-quotep val)
+ (eq (nth 1 val) 'defun))))
((eq prop 'edebug-form-spec)
;; Only allow indirect form specs.
;; During bootstrapping, edebug-basic-spec might not be
(if (stringp val)
(set-text-properties 0 (length val) nil val))
(set (make-local-variable var) val))))
+\f
+;;; Handling directory local variables, aka project settings.
+
+(defvar project-class-alist '()
+ "Alist mapping project class names (symbols) to project variable lists.")
+
+(defvar project-directory-alist '()
+ "Alist mapping project directory roots to project classes.")
+
+(defsubst project-get-alist (class)
+ "Return the project variable list for project CLASS."
+ (cdr (assq class project-class-alist)))
+
+(defun project-collect-bindings-from-alist (mode-alist settings)
+ "Collect local variable settings from MODE-ALIST.
+SETTINGS is the initial list of bindings.
+Returns the new list."
+ (dolist (pair mode-alist settings)
+ (let* ((variable (car pair))
+ (value (cdr pair))
+ (slot (assq variable settings)))
+ (if slot
+ (setcdr slot value)
+ ;; Need a new cons in case we setcdr later.
+ (push (cons variable value) settings)))))
+
+(defun project-collect-binding-list (binding-list root settings)
+ "Collect entries from BINDING-LIST into SETTINGS.
+ROOT is the root directory of the project.
+Return the new settings list."
+ (let* ((file-name (buffer-file-name))
+ (sub-file-name (if file-name
+ (substring file-name (length root)))))
+ (dolist (entry binding-list settings)
+ (let ((key (car entry)))
+ (cond
+ ((stringp key)
+ ;; Don't include this in the previous condition, because we
+ ;; want to filter all strings before the next condition.
+ (when (and sub-file-name
+ (>= (length sub-file-name) (length key))
+ (string= key (substring sub-file-name 0 (length key))))
+ (setq settings (project-collect-binding-list (cdr entry)
+ root settings))))
+ ((or (not key)
+ (derived-mode-p key))
+ (setq settings (project-collect-bindings-from-alist (cdr entry)
+ settings))))))))
+
+(defun set-directory-project (directory class)
+ "Declare that the project rooted at DIRECTORY is an instance of CLASS.
+DIRECTORY is the name of a directory, a string.
+CLASS is the name of a project class, a symbol.
+
+When a file beneath DIRECTORY is visited, the mode-specific
+settings from CLASS will be applied to the buffer. The settings
+for a class are defined using `define-project-bindings'."
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (unless (assq class project-class-alist)
+ (error "No such project class `%s'" (symbol-name class)))
+ (push (cons directory class) project-directory-alist))
+
+(defun define-project-bindings (class settings)
+ "Map the project type CLASS to a list of variable settings.
+CLASS is the project class, a symbol.
+SETTINGS is a list that declares variable settings for the class.
+An element in SETTINGS is either of the form:
+ (MAJOR-MODE . ALIST)
+or
+ (DIRECTORY . LIST)
+
+In the first form, MAJOR-MODE is a symbol, and ALIST is an alist
+whose elements are of the form (VARIABLE . VALUE).
+
+In the second form, DIRECTORY is a directory name (a string), and
+LIST is a list of the form accepted by the function.
+
+When a file is visited, the file's class is found. A directory
+may be assigned a class using `set-directory-project'. Then
+variables are set in the file's buffer according to the class'
+LIST. 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
+ by `derived-mode-p'), then all the settings in ALIST are
+ applied. A MAJOR-MODE of nil may be used to match any buffer.
+ `make-local-variable' is called for each variable before it is
+ set.
+
+* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
+ is an initial substring of the file's directory, then LIST is
+ applied by recursively following these rules."
+ (let ((elt (assq class project-class-alist)))
+ (if elt
+ (setcdr elt settings)
+ (push (cons class settings) project-class-alist))))
+
+(defcustom project-settings-file ".dir-settings.el"
+ "Settings file for per-project settings.
+Set this to nil if you don't want to load project-specific settings."
+ :type '(choice
+ (const :tag "Ignore" nil)
+ (file :tag "File"))
+ :group 'files)
+
+(defun project-find-settings-file (file)
+ "Find the settings file for FILE.
+This searches upward in the directory tree.
+If a settings file is found, the file name is returned.
+If the file is in a registered project, a cons from
+`project-directory-alist' is returned.
+Otherwise this returns nil."
+ (when project-settings-file
+ (setq file (expand-file-name file))
+ (let ((settings (locate-dominating-file file project-settings-file))
+ (pda nil))
+ ;; `locate-dominating-file' may have abbreviated the name.
+ (when settings
+ (setq settings (expand-file-name project-settings-file settings)))
+ (dolist (x project-directory-alist)
+ (when (and (eq t (compare-strings file nil (length (car x))
+ (car x) nil nil))
+ (> (length (car x)) (length (car pda))))
+ (setq pda x)))
+ (if (and settings pda)
+ (if (> (length (file-name-directory settings))
+ (length (car pda)))
+ settings pda)
+ (or settings pda)))))
+
+(defun project-define-from-project-file (settings-file)
+ "Load a settings file and register a new project class and instance.
+SETTINGS-FILE is the name of the file holding the settings to apply.
+The new class name is the same as the directory in which SETTINGS-FILE
+is found. Returns the new class name."
+ (with-temp-buffer
+ ;; We should probably store the modtime of SETTINGS-FILE and then
+ ;; reload it whenever it changes.
+ (insert-file-contents settings-file)
+ (let* ((dir-name (file-name-directory settings-file))
+ (class-name (intern dir-name))
+ (list (read (current-buffer))))
+ (define-project-bindings class-name list)
+ (set-directory-project dir-name class-name)
+ class-name)))
+
+(declare-function c-postprocess-file-styles "cc-mode" ())
+
+(defun hack-project-variables ()
+ "Read local variables for the current buffer based on project settings.
+Store the project variables in `file-local-variables-alist',
+without applying them."
+ (when (and enable-local-variables
+ (buffer-file-name)
+ (not (file-remote-p (buffer-file-name))))
+ ;; Find the settings file.
+ (let ((settings (project-find-settings-file (buffer-file-name)))
+ (class nil)
+ (root-dir nil))
+ (cond
+ ((stringp settings)
+ (setq root-dir (file-name-directory (buffer-file-name)))
+ (setq class (project-define-from-project-file settings)))
+ ((consp settings)
+ (setq root-dir (car settings))
+ (setq class (cdr settings))))
+ (when class
+ (let ((bindings
+ (project-collect-binding-list (project-get-alist class)
+ root-dir nil)))
+ (when bindings
+ (hack-local-variables-filter bindings root-dir)))))))
\f
(defcustom change-major-mode-with-file-name t
(setq buffer-file-name filename)
(if filename ; make buffer name reflect filename.
(let ((new-name (file-name-nondirectory buffer-file-name)))
- (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.
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
(substring name 0
- (if (eq system-type 'vax-vms)
- ;; VMS version number is (a) semicolon, optional
- ;; sign, zero or more digits or (b) period, option
- ;; sign, zero or more digits, provided this is the
- ;; second period encountered outside of the
- ;; device/directory part of the file name.
- (or (string-match ";[-+]?[0-9]*\\'" name)
- (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
- name)
- (match-beginning 1))
- (length name))
- (if keep-backup-version
- (length name)
- (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name)
- (string-match "~\\'" name)
- (length name))))))))
+ (if keep-backup-version
+ (length name)
+ (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name)
+ (string-match "~\\'" name)
+ (length name)))))))
(defun file-ownership-preserved-p (file)
"Return t if deleting FILE and rewriting it would preserve the owner."
"Given the name of a numeric backup file, FN, return the backup number.
Uses the free variable `backup-extract-version-start', whose value should be
the index in the name where the version number begins."
- (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
+ (if (and (string-match "[0-9]+~/?$" fn backup-extract-version-start)
(= (match-beginning 0) backup-extract-version-start))
(string-to-number (substring fn backup-extract-version-start -1))
0))
-;; I believe there is no need to alter this behavior for VMS;
-;; since backup files are not made on VMS, it should not get called.
(defun find-backup-file-name (fn)
"Find a file name for a backup file FN, and suggestions for deletions.
Value is a list whose car is the name for the backup file
(if (buffer-modified-p)
(let ((recent-save (recent-auto-save-p))
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
- (file-name-sans-versions buffer-file-name))))
- (let (buffer-new-name)
- ;; Strip VMS version number before save.
- (setq buffer-file-name
- (file-name-sans-versions buffer-file-name))
- ;; Construct a (unique) buffer name to correspond.
- (let ((buf (create-file-buffer (downcase buffer-file-name))))
- (setq buffer-new-name (buffer-name buf))
- (kill-buffer buf))
- (rename-buffer buffer-new-name)))
;; If buffer has no file name, ask user for one.
(or buffer-file-name
(let ((filename
(setq tempname
(make-temp-name
(expand-file-name "tmp" dir)))
- (write-region (point-min) (point-max)
+ ;; Pass in nil&nil rather than point-min&max
+ ;; cause we're saving the whole buffer.
+ ;; write-region-annotate-functions may use it.
+ (write-region nil nil
tempname nil realname
buffer-file-truename 'excl)
nil)
(let (success)
(unwind-protect
(progn
- (write-region (point-min) (point-max)
+ ;; Pass in nil&nil rather than point-min&max to indicate
+ ;; we're saving the buffer rather than just a region.
+ ;; write-region-annotate-functions may make us of it.
+ (write-region nil nil
buffer-file-name nil t buffer-file-truename)
(setq success t))
;; If we get an error writing the new file, and we made
(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)
+ (progn
+ (write-region nil nil tempfile nil 'nomessage)
(diff buffer-file-name tempfile nil t)
(sit-for 0))
(when (file-exists-p tempfile)
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)
+ `((?\C-r
+ ,(lambda (buf)
+ (if (not enable-recursive-minibuffers)
+ (progn (display-buffer buf)
+ (setq other-window-scroll-buffer buf))
+ (view-buffer buf (lambda (_) (exit-recursive-edit)))
+ (recursive-edit))
+ ;; Return nil to ask about BUF again.
+ nil)
"view this buffer")
- (?d (lambda (buf)
- (save-window-excursion
- (diff-buffer-with-file buf))
- (view-buffer (get-buffer-create "*Diff*")
- (lambda (ignore) (exit-recursive-edit)))
- (recursive-edit)
- nil)
+ (?d ,(lambda (buf)
+ (if (null buffer-file-name)
+ (message "Not applicable: no file")
+ (save-window-excursion (diff-buffer-with-file buf))
+ (if (not enable-recursive-minibuffers)
+ (progn (display-buffer (get-buffer-create "*Diff*"))
+ (setq other-window-scroll-buffer "*Diff*"))
+ (view-buffer (get-buffer-create "*Diff*")
+ (lambda (_) (exit-recursive-edit)))
+ (recursive-edit)))
+ ;; Return nil to ask about BUF again.
+ nil)
"view changes in this buffer"))
"ACTION-ALIST argument used in call to `map-y-or-n-p'.")
;; and record the number thus saved.
(setq files-done
(map-y-or-n-p
- (function
- (lambda (buffer)
- (and (buffer-modified-p buffer)
- (not (buffer-base-buffer buffer))
- (or
- (buffer-file-name buffer)
- (and pred
- (progn
- (set-buffer buffer)
- (and buffer-offer-save (> (buffer-size) 0)))))
- (or (not (functionp pred))
- (with-current-buffer buffer (funcall pred)))
- (if arg
- t
- (setq queried t)
- (if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer)))))))
- (function
- (lambda (buffer)
- (set-buffer buffer)
- (save-buffer)))
- (buffer-list)
+ (lambda (buffer)
+ (and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
+ (or
+ (buffer-file-name buffer)
+ (and pred
+ (progn
+ (set-buffer buffer)
+ (and buffer-offer-save (> (buffer-size) 0)))))
+ (or (not (functionp pred))
+ (with-current-buffer buffer (funcall pred)))
+ (if arg
+ t
+ (setq queried t)
+ (if (buffer-file-name buffer)
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ (format "Save buffer %s? "
+ (buffer-name buffer))))))
+ (lambda (buffer)
+ (with-current-buffer buffer
+ (save-buffer)))
+ (buffer-list)
'("buffer" "buffers" "save")
save-some-buffers-action-alist))
;; Maybe to save abbrevs, and record whether
\f
(defun not-modified (&optional arg)
"Mark current buffer as unmodified, not needing to be saved.
-With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
+With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
It is not a good idea to use this function in Lisp programs, because it
prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(defun make-directory (dir &optional parents)
"Create the directory DIR and any nonexistent parent dirs.
-If DIR already exists as a directory, do nothing.
+If DIR already exists as a directory, signal an error, unless PARENTS is set.
Interactively, the default choice of directory to create
is the current default directory for file names.
This command also implements an interface for special buffers
that contain text which doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
-buffers). This is done via the variable
-`revert-buffer-function'. In these cases, it should reconstruct
-the buffer contents from the appropriate data.
+buffers). This is done via the variable `revert-buffer-function'.
+In these cases, it should reconstruct the buffer contents from the
+appropriate data.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
to revert from the auto-save file when this is nil. Note that the
sake of backward compatibility. IGNORE-AUTO is optional, defaulting
to nil.
-Optional second argument NOCONFIRM means don't ask for confirmation at
-all. \(The variable `revert-without-query' offers another way to
+Optional second argument NOCONFIRM means don't ask for confirmation
+at all. \(The variable `revert-without-query' offers another way to
revert buffers without querying for confirmation.)
Optional third argument PRESERVE-MODES non-nil means don't alter
(kill-buffer buffer))))
(defun kill-buffer-ask (buffer)
- "Kill buffer if confirmed."
+ "Kill BUFFER if confirmed."
(when (yes-or-no-p
(format "Buffer %s %s. Kill? " (buffer-name buffer)
(if (buffer-modified-p buffer)
(setq list (cdr list))))
(defun kill-matching-buffers (regexp &optional internal-too)
- "Kill buffers whose name matches the specified regexp.
+ "Kill buffers whose name matches the specified REGEXP.
The optional second argument indicates whether to kill internal buffers too."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
- ;; Eliminate all slashes and backslashes by
- ;; replacing them with sequences that start with %.
- ;; Quote % also, to keep distinct names distinct.
- (while (string-match "[/\\%]" buffer-name limit)
+ ;; Restrict the characters used in the file name to those which
+ ;; are known to be safe on all filesystems, url-encoding the
+ ;; rest.
+ ;; We do this on all platforms, because even if we are not
+ ;; running on DOS/Windows, the current directory may be on a
+ ;; mounted VFAT filesystem, such as a USB memory stick.
+ (while (string-match "[^A-Za-z0-9-_.~#+]" buffer-name limit)
(let* ((character (aref buffer-name (match-beginning 0)))
(replacement
- (cond ((eq character ?%) "%%")
- ((eq character ?/) "%+")
- ((eq character ?\\) "%-"))))
+ ;; For multibyte characters, this will produce more than
+ ;; 2 hex digits, so is not true URL encoding.
+ (format "%%%02X" character)))
(setq buffer-name (replace-match replacement t t buffer-name))
(setq limit (1+ (match-end 0)))))
;; Generate the file name.
(concat "\\`" result "\\'")))
\f
(defcustom list-directory-brief-switches
- (if (eq system-type 'vax-vms) "" "-CF")
+ "-CF"
"Switches for `list-directory' to pass to `ls' for brief listing."
:type 'string
:group 'dired)
(defcustom list-directory-verbose-switches
- (if (eq system-type 'vax-vms)
- "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
- "-l")
+ "-l"
"Switches for `list-directory' to pass to `ls' for verbose listing."
:type 'string
:group 'dired)
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, the characters from the
-set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
+set [ \\t\\n;<>&|()'\"#$] are quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
Existing quote characters in PATTERN are left alone, so you can pass
(concat result (substring pattern beg) "\""))))
(t
(let ((beg 0))
- (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+ (while (string-match "[ \t\n;<>&|()'\"#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
- (if (eq system-type 'vax-vms)
- (vms-read-directory file switches (current-buffer))
(let (result (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; Replace "total" with "used", to avoid confusion.
(replace-match "total used in directory" nil nil nil 1)
(end-of-line)
- (insert " available " available)))))))))))
+ (insert " available " available))))))))))
(defun insert-directory-adj-pos (pos error-lines)
"Convert `ls --dired' file name position value POS to a buffer position.
(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, then kill."
(interactive "P")
(save-some-buffers arg t)
(and (or (not (memq t (mapcar (function
(buffer-list))))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
- ;; process-list is not defined on VMS.
+ ;; process-list is not defined on MSDOS.
(let ((processes (process-list))
active)
(while processes
"Offer to save each buffer, then kill the current connection.
If the current frame has no client, kill Emacs itself.
-With prefix arg, silently save all file-visiting buffers, then kill.
+With prefix ARG, silently save all file-visiting buffers, then kill.
If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
;; Symbolic modes and read-file-modes.
(defun file-modes-char-to-who (char)
- "Convert CHAR to a who-mask from a symbolic mode notation.
-CHAR is in [ugoa] and represents the users on which rights are applied."
+ "Convert CHAR to a numeric bit-mask for extracting mode bits.
+CHAR is in [ugoa] and represents the category of users (Owner, Group,
+Others, or All) for whom to produce the mask.
+The bit-mask that is returned extracts from mode bits the access rights
+for the specified category of users."
(cond ((= char ?u) #o4700)
((= char ?g) #o2070)
((= char ?o) #o1007)
(t (error "%c: bad `who' character" char))))
(defun file-modes-char-to-right (char &optional from)
- "Convert CHAR to a right-mask from a symbolic mode notation.
-CHAR is in [rwxXstugo] and represents a right.
-If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
+ "Convert CHAR to a numeric value of mode bits.
+CHAR is in [rwxXstugo] and represents symbolic access permissions.
+If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
(or from (setq from 0))
(cond ((= char ?r) #o0444)
((= char ?w) #o0222)
(t (error "%c: bad right character" char))))
(defun file-modes-rights-to-number (rights who-mask &optional from)
- "Convert a right string to a right-mask from a symbolic modes notation.
-RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
-WHO-MASK is the mask number of the users on which the rights are to be applied.
-FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+ "Convert a symbolic mode string specification to an equivalent number.
+RIGHTS is the symbolic mode spec, it should match \"([+=-][rwxXstugo]+)+\".
+WHO-MASK is the bit-mask specifying the category of users to which to
+apply the access permissions. See `file-modes-char-to-who'.
+FROM (or 0 if nil) gives the mode bits on which to base permissions if
+RIGHTS request to add, remove, or set permissions based on existing ones,
+as in \"og+rX-w\"."
(let* ((num-rights (or from 0))
(list-rights (string-to-list rights))
(op (pop list-rights)))
\"[ugoa]*([+-=][rwxXstugo]+)+,...\".
See (info \"(coreutils)File permissions\") for more information on this
notation.
-FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+FROM (or 0 if nil) gives the mode bits on which to base permissions if
+MODES request to add, remove, or set permissions based on existing ones,
+as in \"og+rX-w\"."
(save-match-data
(let ((case-fold-search nil)
(num-modes (or from 0)))
num-modes)))
(defun read-file-modes (&optional prompt orig-file)
- "Read file modes in octal or symbolic notation.
+ "Read file modes in octal or symbolic notation and return its numeric value.
PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
-ORIG-FILE is the original file of which modes will be change."
+ORIG-FILE is the name of a file on whose mode bits to base returned
+permissions if what user types requests to add, remove, or set permissions
+based on existing mode bits, as in \"og+rX-w\"."
(let* ((modes (or (if orig-file (file-modes orig-file) 0)
(error "File not found")))
- (value (read-string (or prompt "File modes (octal or symbolic): "))))
+ (modestr (and (stringp orig-file)
+ (nth 8 (file-attributes orig-file))))
+ (default
+ (and (stringp modestr)
+ (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
+ (replace-regexp-in-string
+ "-" ""
+ (format "u=%s,g=%s,o=%s"
+ (match-string 1 modestr)
+ (match-string 2 modestr)
+ (match-string 3 modestr)))))
+ (value (read-string (or prompt "File modes (octal or symbolic): ")
+ nil nil default)))
(save-match-data
(if (string-match "^[0-7]+" value)
(string-to-number value 8)
(file-modes-symbolic-to-number value modes)))))
\f
+;; Trashcan handling.
+(defcustom trash-directory (convert-standard-filename "~/.Trash")
+ "Directory for `move-file-to-trash' to move files and directories to.
+This directory is only used when the function `system-move-file-to-trash' is
+not defined. Relative paths are interpreted relative to `default-directory'.
+See also `delete-by-moving-to-trash'."
+ :type 'directory
+ :group 'auto-save
+ :version "23.1")
+
+(declare-function system-move-file-to-trash "w32fns.c" (filename))
+
+(defun move-file-to-trash (filename)
+ "Move file (or directory) name FILENAME to the trash.
+This function is called by `delete-file' and `delete-directory' when
+`delete-by-moving-to-trash' is non-nil. On platforms that define
+`system-move-file-to-trash', that function is used to move FILENAME to the
+system trash, otherwise FILENAME is moved to `trash-directory'.
+Returns nil on success."
+ (interactive "fMove file to trash: ")
+ (cond
+ ((fboundp 'system-move-file-to-trash)
+ (system-move-file-to-trash filename))
+ (t
+ (let* ((trash-dir (expand-file-name trash-directory))
+ (fn (directory-file-name (expand-file-name filename)))
+ (fn-nondir (file-name-nondirectory fn))
+ (new-fn (expand-file-name fn-nondir trash-dir)))
+ (or (file-directory-p trash-dir)
+ (make-directory trash-dir t))
+ (and (file-exists-p new-fn)
+ ;; make new-fn unique.
+ ;; example: "~/.Trash/abc.txt" -> "~/.Trash/abc.txt.~1~"
+ (let ((version-control t))
+ (setq new-fn (car (find-backup-file-name new-fn)))))
+ ;; stop processing if fn is same or parent directory of trash-dir.
+ (and (string-match fn trash-dir)
+ (error "Filename `%s' is same or parent directory of trash-directory"
+ filename))
+ (let ((delete-by-moving-to-trash nil))
+ (rename-file fn new-fn))))))
+
+\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key ctl-x-map "\C-v" 'find-alternate-file)
HCoop / bpt / emacs.git / blobdiff