X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8299c8a5ce1394b8d173eb453710600a3529fc1d..5ee66afc6dd6db4a2c238dad54e9c4321dbb38c9:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index ffa8e0a328..0dc8ba20b2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8,10 +8,10 @@ ;; 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 @@ -19,9 +19,7 @@ ;; 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 . ;;; Commentary: @@ -226,12 +224,12 @@ have fast storage with limited space, such as a RAM disk." (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.") @@ -404,6 +402,7 @@ The functions are called in the order given until one of them returns non-nil.") ;;;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 @@ -412,7 +411,6 @@ functions are called." :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. @@ -701,15 +699,15 @@ one or more of those symbols." (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))) @@ -720,26 +718,36 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." (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." - (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))) + ;; `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) - ;; 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)) + (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 @@ -759,8 +767,9 @@ Return nil if COMMAND is not found anywhere in `exec-path'." 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) @@ -1029,6 +1038,16 @@ use with M-x." (rename-file encoded new-encoded ok-if-already-exists) newname)) +(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 @@ -1043,7 +1062,8 @@ 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) @@ -1057,7 +1077,8 @@ 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: ") + (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 @@ -1074,9 +1095,18 @@ documentation for additional customization information." (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'.") @@ -1093,7 +1123,7 @@ Recursive uses of the minibuffer will not be affected." ;; 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) @@ -1494,6 +1524,17 @@ When nil, never request confirmation." :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 @@ -1545,16 +1586,8 @@ the various files." (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) @@ -1768,7 +1801,7 @@ This function ensures that none of these modifications will take place." (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 @@ -1783,6 +1816,8 @@ This function ensures that none of these modifications will take place." (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))) @@ -1939,6 +1974,8 @@ in that case, this function acts as if `enable-local-variables' were t." (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 @@ -2047,6 +2084,7 @@ since only a single case-insensitive search through the alist is made." 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) @@ -2588,11 +2626,13 @@ asking you for confirmation." (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 @@ -2606,15 +2646,16 @@ RISKY-VARS is the list of those that are marked as risky." (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.") @@ -2736,6 +2777,50 @@ and VAL is the specified value." 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 @@ -2775,7 +2860,10 @@ is specified, returning t if it is specified." (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))) @@ -2827,45 +2915,7 @@ is specified, returning t if it is specified." ;; 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) @@ -2969,6 +3019,171 @@ already the major mode." (if (stringp val) (set-text-properties 0 (length val) nil val)) (set (make-local-variable var) val)))) + +;;; 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)))))))) (defcustom change-major-mode-with-file-name t @@ -3873,7 +4088,10 @@ Before and after saving the buffer, this function runs (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) @@ -3907,7 +4125,10 @@ Before and after saving the buffer, this function runs (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 @@ -3927,9 +4148,8 @@ This requires the external program `diff' to be in your `exec-path'." (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) @@ -4139,7 +4359,7 @@ or multiple mail buffers, etc." (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. @@ -4652,15 +4872,18 @@ See also `auto-save-file-name-p'." (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. @@ -4865,7 +5088,7 @@ and `list-directory-verbose-switches'." 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 @@ -4897,7 +5120,7 @@ PATTERN that already quotes some of the special characters." (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)) "\\"