;; 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:
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device "/dev/null" "The system null device.")
+(declare-function msdos-long-file-names "msdos.c")
+(declare-function w32-long-file-name "w32proc.c")
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
+(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
;;;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-variables t
"Control use of local variables in files you visit.
-The value can be t, nil, :safe, :all or something else.
+The value can be t, nil, :safe, :all, or something else.
A value of t means file local variables specifications are obeyed
if all the specified variable values are safe; if any values are
(if (file-exists-p dir)
(error "%s is not a directory" dir)
(error "%s: no such directory" dir))
- (if (file-executable-p dir)
- (setq default-directory dir)
- (error "Cannot cd to %s: Permission denied" dir))))
+ (unless (file-executable-p dir)
+ (error "Cannot cd to %s: Permission denied" dir))
+ (setq default-directory dir)
+ (set (make-local-variable 'list-buffers-directory) dir)))
(defun cd (dir)
"Make DIR become the current buffer's default directory.
(let ((trypath (parse-colon-path (getenv "CDPATH"))))
(setq cd-path (or trypath (list "./")))))
(if (not (catch 'found
- (mapcar
+ (mapc
(function (lambda (x)
(let ((f (expand-file-name (concat x dir))))
(if (file-directory-p f)
(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."
+ (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 file)))
+ (or (null prev-user) (equal user prev-user))))
+ (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
+ (directory-file-name dir))))
+ (setq dir nil))))
+ nil)))
(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)
+(defun file-remote-p (file &optional identification connected)
"Test whether FILE specifies a location on a remote system.
-Return an identification of the system if the location is indeed
-remote. The identification of the system may comprise a method
-to access the system and its hostname, amongst other things.
-
-For example, the filename \"/user@host:/foo\" specifies a location
-on the system \"/user@host:\"."
+Returns nil or a string identifying the remote connection (ideally
+a prefix of FILE). For example, the remote identification for filename
+\"/user@host:/foo\" could be \"/user@host:\".
+A file is considered \"remote\" if accessing it is likely to be slower or
+less reliable than accessing local files.
+Furthermore, relative file names do not work across remote connections.
+
+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.
+
+If CONNECTED is non-nil, the function returns an identification only
+if FILE is located on a remote system, and a connection is established
+to that remote system.
+
+`file-remote-p' will never open a connection on its own."
(let ((handler (find-file-name-handler file 'file-remote-p)))
(if handler
- (funcall handler 'file-remote-p file)
+ (funcall handler 'file-remote-p file identification connected)
nil)))
(defun file-local-copy (file)
(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)
,@body)
(remove-hook 'minibuffer-setup-hook ,hook)))))
+(defcustom find-file-confirm-nonexistent-file nil
+ "If non-nil, `find-file' requires confirmation before visiting a new file."
+ :group 'find-file
+ :version "23.1"
+ :type 'boolean)
+
(defun find-file-read-args (prompt mustmatch)
(list (let ((find-file-default
(and buffer-file-name
To visit a file without any kind of conversion and without
automatically choosing a major mode, use \\[find-file-literally]."
- (interactive (find-file-read-args "Find file: " nil))
+ (interactive
+ (find-file-read-args "Find file: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "Find file in other window: " nil))
+ (interactive
+ (find-file-read-args "Find file in other window: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "Find file in other frame: " nil))
+ (interactive
+ (find-file-read-args "Find file in other frame: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
"Edit file FILENAME but don't allow changes.
Like \\[find-file], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only other window: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only other window: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame], but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "Find file read-only other frame: " nil))
+ (interactive
+ (find-file-read-args "Find file read-only other frame: "
+ (if find-file-confirm-nonexistent-file 'confirm-only)))
(unless (or (and wildcards find-file-wildcards
(not (string-match "\\`/:" filename))
(string-match "[[*?]" filename))
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name."
+otherwise a string <2> or <3> or ... is appended to get an unused name.
+Spaces at the start of FILENAME (sans directory) are removed."
(let ((lastname (file-name-nondirectory filename)))
(if (string= lastname "")
(setq lastname filename))
- (generate-new-buffer lastname)))
+ (save-match-data
+ (string-match "^ *\\(.*\\)" lastname)
+ (generate-new-buffer (match-string 1 lastname)))))
(defun generate-new-buffer (name)
"Create and return a buffer with a name based on NAME.
: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
("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
+ ("\\.org\\'" . org-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.tar\\'" . tar-mode)
;; The list of archive file extensions should be in sync with
;; `auto-coding-alist' with `no-conversion' coding system.
- ("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
+ ("\\.\\(\
+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
- ("\\.x[bp]m\\'" . c-mode)
("\\.d?v\\'" . verilog-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
("\\.[eE]?[pP][sS]\\'" . ps-mode)
+ ("\\.\\(?:PDF\\|DVI\\|pdf\\|dvi\\)\\'" . doc-view-mode)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("BROWSE\\'" . ebrowse-tree-mode)
("\\.ebrowse\\'" . ebrowse-tree-mode)
;; put them in the first line of
;; such a file without screwing up
;; the interpreter invocation.
- (and (looking-at "^#!") 2)) t)
+ ;; The same holds for
+ ;; '\"
+ ;; in man pages (preprocessor
+ ;; magic for the `man' program).
+ (and (looking-at "^\\(#!\\|'\\\\\"\\)") 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
minor-mode-overriding-map-alist
mode-line-buffer-identification
mode-line-format
+ mode-line-client
mode-line-modes
mode-line-modified
mode-line-mule-info
mode-line-position
mode-line-process
+ mode-line-remote
mode-name
outline-level
overriding-local-map
(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.")
(if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
done)
(while (not done)
- (message prompt)
+ (message "%s" prompt)
(setq char (read-event))
(if (numberp char)
(cond ((eq char ?\C-v)
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
(set-default-file-modes ?\700)
(when (condition-case nil
;; Try to overwrite old backup first.
- (copy-file from-name to-name t t)
+ (copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
- (copy-file from-name to-name nil t)
+ (copy-file from-name to-name nil t t)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
(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, signal an error, unless PARENTS is set.
+
Interactively, the default choice of directory to create
is the current default directory for file names.
That is useful when you have visited a file in a nonexistent directory.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-This command also works for special buffers that contain text which
-doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and `buffer-list' buffers. In these cases,
-it reconstructs the buffer contents from the appropriate data base.
+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.
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
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
+(defun kill-buffer-ask (buffer)
+ "Kill buffer if confirmed."
+ (when (yes-or-no-p
+ (format "Buffer %s %s. Kill? " (buffer-name buffer)
+ (if (buffer-modified-p buffer)
+ "HAS BEEN EDITED" "is unmodified")))
+ (kill-buffer buffer)))
+
(defun kill-some-buffers (&optional list)
"Kill some buffers. Asks the user whether to kill each one of them.
Non-interactively, if optional argument LIST is non-nil, it
; if we killed the base buffer.
(not (string-equal name ""))
(/= (aref name 0) ?\s)
- (yes-or-no-p
- (format "Buffer %s %s. Kill? "
- name
- (if (buffer-modified-p buffer)
- "HAS BEEN EDITED" "is unmodified")))
- (kill-buffer buffer)))
+ (kill-buffer-ask buffer)))
(setq list (cdr list))))
+
+(defun kill-matching-buffers (regexp &optional internal-too)
+ "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 ((name (buffer-name buffer)))
+ (when (and name (not (string-equal name ""))
+ (or internal-too (/= (aref name 0) ?\s))
+ (string-match regexp name))
+ (kill-buffer-ask buffer)))))
+
\f
(defun auto-save-mode (arg)
"Toggle auto-saving of contents of current buffer.
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is cancelled.
-`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
-but `kill-emacs', the low level primitive, does not.
-See also `kill-emacs-hook'.")
+`save-buffers-kill-emacs' calls these functions, but `kill-emacs',
+the low level primitive, does not. See also `kill-emacs-hook'.")
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
(or (null confirm-kill-emacs)
(funcall confirm-kill-emacs "Really exit Emacs? "))
(kill-emacs)))
+
+(defun save-buffers-kill-terminal (&optional arg)
+ "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.
+
+If emacsclient was started with a list of filenames to edit, then
+only these files will be asked to be saved."
+ (interactive "P")
+ (let ((proc (frame-parameter (selected-frame) 'client))
+ (frame (selected-frame)))
+ (if (null proc)
+ (save-buffers-kill-emacs)
+ (server-save-buffers-kill-terminal proc arg))))
+
\f
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
(t
(apply operation arguments)))))
\f
+;; 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."
+ (cond ((= char ?u) #o4700)
+ ((= char ?g) #o2070)
+ ((= char ?o) #o1007)
+ ((= char ?a) #o7777)
+ (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)."
+ (or from (setq from 0))
+ (cond ((= char ?r) #o0444)
+ ((= char ?w) #o0222)
+ ((= char ?x) #o0111)
+ ((= char ?s) #o1000)
+ ((= char ?t) #o6000)
+ ;; Rights relative to the previous file modes.
+ ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
+ ((= char ?u) (let ((uright (logand #o4700 from)))
+ (+ uright (/ uright #o10) (/ uright #o100))))
+ ((= char ?g) (let ((gright (logand #o2070 from)))
+ (+ gright (/ gright #o10) (* gright #o10))))
+ ((= char ?o) (let ((oright (logand #o1007 from)))
+ (+ oright (* oright #o10) (* oright #o100))))
+ (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."
+ (let* ((num-rights (or from 0))
+ (list-rights (string-to-list rights))
+ (op (pop list-rights)))
+ (while (memq op '(?+ ?- ?=))
+ (let ((num-right 0)
+ char-right)
+ (while (memq (setq char-right (pop list-rights))
+ '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
+ (setq num-right
+ (logior num-right
+ (file-modes-char-to-right char-right num-rights))))
+ (setq num-right (logand who-mask num-right)
+ num-rights
+ (cond ((= op ?+) (logior num-rights num-right))
+ ((= op ?-) (logand num-rights (lognot num-right)))
+ (t (logior (logand num-rights (lognot who-mask)) num-right)))
+ op char-right)))
+ num-rights))
+
+(defun file-modes-symbolic-to-number (modes &optional from)
+ "Convert symbolic file modes to numeric file modes.
+MODES is the string to convert, it should match
+\"[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."
+ (save-match-data
+ (let ((case-fold-search nil)
+ (num-modes (or from 0)))
+ (while (/= (string-to-char modes) 0)
+ (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" modes)
+ (let ((num-who (apply 'logior 0
+ (mapcar 'file-modes-char-to-who
+ (match-string 1 modes)))))
+ (when (= num-who 0)
+ (setq num-who (default-file-modes)))
+ (setq num-modes
+ (file-modes-rights-to-number (substring modes (match-end 1))
+ num-who num-modes)
+ modes (substring modes (match-end 3))))
+ (error "Parse error in modes near `%s'" (substring modes 0))))
+ num-modes)))
+
+(defun read-file-modes (&optional prompt orig-file)
+ "Read file modes in octal or symbolic notation.
+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."
+ (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): "))))
+ (save-match-data
+ (if (string-match "^[0-7]+" value)
+ (string-to-number value 8)
+ (file-modes-symbolic-to-number value modes)))))
+
+\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)
(define-key ctl-x-map "i" 'insert-file)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
-(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
+(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal)
(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)