X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bfab7c6ec74dc55d640ef36f8cb1790a1420f991..5ee66afc6dd6db4a2c238dad54e9c4321dbb38c9:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index 38eb95fe9b..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: @@ -748,7 +746,8 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." (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 @@ -1124,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) @@ -1975,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 @@ -2625,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 @@ -2643,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.") @@ -2773,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 @@ -2812,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))) @@ -2864,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) @@ -3006,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 @@ -3910,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) @@ -3944,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 @@ -3964,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)