;; 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:
;;;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.
(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))))))
+ (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")
(defun locate-dominating-file (file regexp)
"Look up the directory hierarchy from FILE for a file matching REGEXP."
(let ((prev-user user))
(setq user (nth 2 (file-attributes file)))
(or (null prev-user) (equal user prev-user))))
- (if (setq files (directory-files dir 'full regexp))
+ (if (setq files (and (file-directory-p dir)
+ (directory-files dir 'full regexp)))
(throw 'found (car files))
(if (equal dir
(setq dir (file-name-directory
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)
(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
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)
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
- (interactive "BSwitch to buffer in other frame: ")
+ (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
(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)
: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)
(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)))
(let ((enable-local-variables (or (not find-file) enable-local-variables)))
(report-errors "File mode specification error: %s"
(set-auto-mode))
+ (report-errors "Project local-variables error: %s"
+ (hack-project-variables))
(report-errors "File local-variables error: %s"
(hack-local-variables)))
;; Turn font lock off and on, to make sure it takes account of
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)
(put 'c-set-style 'safe-local-eval-function t)
-(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars)
+(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; 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-apply (result project)
+ "Apply an alist of local variable settings.
+RESULT is the alist.
+Will query the user when necessary."
+ (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 query 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 project))
+ (dolist (elt result)
+ (hack-one-local-variable (car elt) (cdr elt))))))))
+
(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
(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)))
;; 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)))))))
+ (hack-local-variables-apply result nil)
(run-hooks 'hack-local-variables-hook)))))
(defun safe-local-variable-p (sym val)
(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 list)
+ "Map the project type CLASS to a list of variable settings.
+CLASS is the project class, a symbol.
+LIST is a list that declares variable settings for the class.
+An element in LIST 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 list)
+ (push (cons class list) project-class-alist))))
+
+(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."
+ (setq file (expand-file-name file))
+ (let* ((settings (locate-dominating-file file "\\`\\.dir-settings\\.el\\'"))
+ (pda nil))
+ ;; `locate-dominating-file' may have abbreviated the name.
+ (if settings (setq settings (expand-file-name 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 ()
+ "Set local variables in a buffer based on project settings."
+ (when (and (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-apply bindings root-dir)
+ ;; Special case C and derived modes. Note that CC-based
+ ;; modes don't work with derived-mode-p. In general I
+ ;; think modes could use an auxiliary method which is
+ ;; called after local variables are hacked.
+ (and (boundp 'c-buffer-is-cc-mode)
+ c-buffer-is-cc-mode
+ (c-postprocess-file-styles))))))))
\f
(defcustom change-major-mode-with-file-name t
(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)
(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.
(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.