LCOV - code coverage report
Current view: top level - lisp - files-x.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 37 354 10.5 %
Date: 2017-08-30 10:12:24 Functions: 8 29 27.6 %

          Line data    Source code
       1             : ;;; files-x.el --- extended file handling commands
       2             : 
       3             : ;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Juri Linkov <juri@jurta.org>
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: files
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This file defines additional infrequently used file- and
      28             : ;; directory-handling commands that should not be in files.el
      29             : ;; to not make the dumped image bigger.
      30             : 
      31             : ;;; Code:
      32             : 
      33             : 
      34             : ;;; Commands to add/delete file-local/directory-local variables.
      35             : 
      36             : (defun read-file-local-variable (prompt)
      37             :   "Read file-local variable using PROMPT and completion.
      38             : Intended to be used in the `interactive' spec of
      39             : `add-file-local-variable', `delete-file-local-variable',
      40             : `add-dir-local-variable', `delete-dir-local-variable'."
      41           0 :   (let* ((default (variable-at-point))
      42           0 :          (default (and (symbolp default) (boundp default)
      43           0 :                        (symbol-name default)))
      44             :          (variable
      45           0 :           (completing-read
      46           0 :            (if default
      47           0 :                (format "%s (default %s): " prompt default)
      48           0 :              (format "%s: " prompt))
      49           0 :            obarray
      50             :            (lambda (sym)
      51           0 :              (or (custom-variable-p sym)
      52           0 :                  (get sym 'safe-local-variable)
      53           0 :                  (memq sym '(mode eval coding unibyte))))
      54           0 :            nil nil nil default nil)))
      55           0 :     (and (stringp variable) (intern variable))))
      56             : 
      57             : (defun read-file-local-variable-value (variable)
      58             :   "Read value of file-local VARIABLE using completion.
      59             : Intended to be used in the `interactive' spec of
      60             : `add-file-local-variable' and `add-dir-local-variable'."
      61           0 :   (cond
      62           0 :    ((eq variable 'mode)
      63           0 :     (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
      64             :            (value
      65           0 :             (completing-read
      66           0 :              (if default
      67           0 :                  (format "Add %s with value (default %s): " variable default)
      68           0 :                (format "Add %s with value: " variable))
      69           0 :              obarray
      70             :              (lambda (sym)
      71           0 :                (string-match-p "-mode\\'" (symbol-name sym)))
      72           0 :              nil nil nil default nil)))
      73           0 :       (and (stringp value)
      74           0 :            (intern (replace-regexp-in-string "-mode\\'" "" value)))))
      75           0 :    ((eq variable 'eval)
      76           0 :     (read--expression (format "Add %s with expression: " variable)))
      77           0 :    ((eq variable 'coding)
      78           0 :     (let ((default (and (symbolp buffer-file-coding-system)
      79           0 :                         (symbol-name buffer-file-coding-system))))
      80           0 :       (read-coding-system
      81           0 :        (if default
      82           0 :            (format "Add %s with value (default %s): " variable default)
      83           0 :          (format "Add %s with value: " variable))
      84           0 :        default)))
      85             :    (t
      86           0 :     (let ((default (format "%S"
      87           0 :                            (cond ((eq variable 'unibyte) t)
      88           0 :                                  ((boundp variable)
      89           0 :                                   (symbol-value variable)))))
      90             :           (minibuffer-completing-symbol t))
      91           0 :       (read-from-minibuffer (format "Add %s with value: " variable)
      92           0 :                             nil read-expression-map t
      93             :                             'set-variable-value-history
      94           0 :                             default)))))
      95             : 
      96             : (defun read-file-local-variable-mode ()
      97             :   "Read per-directory file-local variable's mode using completion.
      98             : Intended to be used in the `interactive' spec of
      99             : `add-dir-local-variable', `delete-dir-local-variable'."
     100           0 :   (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
     101             :          (mode
     102           0 :           (completing-read
     103           0 :            (if default
     104           0 :                (format "Mode or subdirectory (default %s): " default)
     105           0 :              (format "Mode or subdirectory: "))
     106           0 :            obarray
     107             :            (lambda (sym)
     108           0 :              (and (string-match-p "-mode\\'" (symbol-name sym))
     109           0 :                   (not (or (memq sym minor-mode-list)
     110           0 :                            (string-match-p "-minor-mode\\'"
     111           0 :                                            (symbol-name sym))))))
     112           0 :            nil nil nil default nil)))
     113           0 :     (cond
     114           0 :      ((equal mode "nil") nil)
     115           0 :      ((and (stringp mode) (fboundp (intern mode))) (intern mode))
     116           0 :      (t mode))))
     117             : 
     118             : (defun modify-file-local-variable-message (variable value op)
     119           0 :   (let* ((not-value (make-symbol ""))
     120           0 :          (old-value (cond ((eq variable 'mode)
     121           0 :                            major-mode)
     122           0 :                           ((eq variable 'coding)
     123           0 :                            buffer-file-coding-system)
     124           0 :                           (t (if (and (symbolp variable)
     125           0 :                                       (boundp variable))
     126           0 :                                  (symbol-value variable)
     127           0 :                                not-value))))
     128           0 :          (new-value (if (eq op 'delete)
     129           0 :                         (cond ((eq variable 'mode)
     130           0 :                                (default-value 'major-mode))
     131           0 :                               ((eq variable 'coding)
     132           0 :                                (default-value 'buffer-file-coding-system))
     133           0 :                               (t (if (and (symbolp variable)
     134           0 :                                           (default-boundp variable))
     135           0 :                                      (default-value variable)
     136           0 :                                    not-value)))
     137           0 :                       (cond ((eq variable 'mode)
     138           0 :                              (let ((string (format "%S" value)))
     139           0 :                                (if (string-match-p "-mode\\'" string)
     140           0 :                                    value
     141           0 :                                  (intern (concat string "-mode")))))
     142           0 :                             (t value)))))
     143           0 :     (when (or (eq old-value not-value)
     144           0 :               (eq new-value not-value)
     145           0 :               (not (equal old-value new-value)))
     146           0 :       (message "%s" (substitute-command-keys
     147           0 :                      "For this change to take effect revisit file using \\[revert-buffer]")))))
     148             : 
     149             : (defun modify-file-local-variable (variable value op &optional interactive)
     150             :   "Modify file-local VARIABLE in Local Variables depending on operation OP.
     151             : 
     152             : If OP is `add-or-replace' then delete all existing settings of
     153             : VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
     154             : with VALUE to the Local Variables list.
     155             : 
     156             : If there is no Local Variables list in the current file buffer and OP
     157             : is not `delete' then this function adds the first line containing the
     158             : string `Local Variables:' and the last line containing the string `End:'.
     159             : 
     160             : If OP is `delete' then delete all existing settings of VARIABLE
     161             : from the Local Variables list ignoring the input argument VALUE."
     162           0 :   (catch 'exit
     163           0 :     (let ((beg (point)) end replaced-pos)
     164           0 :       (unless enable-local-variables
     165           0 :         (throw 'exit (message "File-local variables are disabled")))
     166             : 
     167             :       ;; Look for "Local variables:" line in last page.
     168           0 :       (widen)
     169           0 :       (goto-char (point-max))
     170           0 :       (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
     171             : 
     172             :       ;; Add "Local variables:" list if not found.
     173           0 :       (unless (let ((case-fold-search t))
     174           0 :                 (search-forward "Local Variables:" nil t))
     175             : 
     176             :         ;; Don't add "Local variables:" list for the deletion operation.
     177           0 :         (when (eq op 'delete)
     178           0 :           (throw 'exit (progn (goto-char beg)
     179           0 :                               (message "Local Variables not found"))))
     180             : 
     181           0 :         (goto-char (point-max))
     182           0 :         (let ((comment-style 'plain)
     183           0 :               (comment-start (or comment-start ";; ")))
     184           0 :           (comment-region
     185           0 :            (prog1 (setq beg (point))
     186           0 :              (insert "\nLocal Variables:\nEnd:\n"))
     187           0 :            (point)))
     188             : 
     189           0 :         (unless (let ((case-fold-search t))
     190           0 :                   (goto-char beg)
     191           0 :                   (search-forward "Local Variables:" nil t))
     192           0 :           (throw 'exit (message "Can't add file-local variables"))))
     193             : 
     194             :       ;; prefix is what comes before "local variables:" in its line.
     195             :       ;; suffix is what comes after "local variables:" in its line.
     196           0 :       (let* ((prefix (buffer-substring (line-beginning-position)
     197           0 :                                        (match-beginning 0)))
     198           0 :              (suffix (buffer-substring (point) (line-end-position)))
     199           0 :              (prefix-re (concat "^" (regexp-quote prefix)))
     200           0 :              (suffix-re (concat (regexp-quote suffix) "$")))
     201             : 
     202             :         ;; Find or add missing "End:".
     203           0 :         (forward-line 1)
     204           0 :         (setq beg (point))
     205           0 :         (save-excursion
     206           0 :           (unless (let ((case-fold-search t))
     207           0 :                     (re-search-forward
     208           0 :                      (concat prefix-re "[ \t]*End:[ \t]*" suffix-re)
     209           0 :                      nil t))
     210           0 :             (save-excursion
     211           0 :               (insert (format "%sEnd:%s\n" prefix suffix))))
     212           0 :           (beginning-of-line)
     213           0 :           (setq end (point-marker)))
     214             : 
     215             :         ;; Find and delete all existing variable/value pairs.
     216           0 :         (when (member op '(add-or-replace delete))
     217           0 :           (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
     218           0 :               (goto-char end)
     219           0 :             (goto-char beg)
     220           0 :             (while (re-search-forward
     221           0 :                     (format "%s%S:.*%s" prefix-re variable suffix-re) end t)
     222           0 :               (delete-region (match-beginning 0) (1+ (match-end 0)))
     223           0 :               (setq replaced-pos (point)))))
     224             : 
     225             :         ;; Add a new variable/value pair.  Add `mode' to the start, add new
     226             :         ;; variable to the end, and add a replaced variable to its last location.
     227           0 :         (when (eq op 'add-or-replace)
     228           0 :           (cond
     229           0 :            ((eq variable 'mode) (goto-char beg))
     230           0 :            ((null replaced-pos) (goto-char end))
     231           0 :            (replaced-pos (goto-char replaced-pos)))
     232           0 :           (insert (format "%s%S: %S%s\n" prefix variable value suffix))))
     233             : 
     234           0 :       (when interactive
     235           0 :         (modify-file-local-variable-message variable value op)))))
     236             : 
     237             : ;;;###autoload
     238             : (defun add-file-local-variable (variable value &optional interactive)
     239             :   "Add file-local VARIABLE with its VALUE to the Local Variables list.
     240             : 
     241             : This command deletes all existing settings of VARIABLE (except `mode'
     242             : and `eval') and adds a new file-local VARIABLE with VALUE to the
     243             : Local Variables list.
     244             : 
     245             : If there is no Local Variables list in the current file buffer
     246             : then this function adds the first line containing the string
     247             : `Local Variables:' and the last line containing the string `End:'."
     248             :   (interactive
     249           0 :    (let ((variable (read-file-local-variable "Add file-local variable")))
     250             :      ;; Error before reading value.
     251           0 :      (if (equal variable 'lexical-binding)
     252           0 :          (user-error "The `%s' variable must be set at the start of the file"
     253           0 :                      variable))
     254           0 :      (list variable (read-file-local-variable-value variable) t)))
     255           0 :   (if (equal variable 'lexical-binding)
     256           0 :       (user-error "The `%s' variable must be set at the start of the file"
     257           0 :                   variable))
     258           0 :   (modify-file-local-variable variable value 'add-or-replace interactive))
     259             : 
     260             : ;;;###autoload
     261             : (defun delete-file-local-variable (variable &optional interactive)
     262             :   "Delete all settings of file-local VARIABLE from the Local Variables list."
     263             :   (interactive
     264           0 :    (list (read-file-local-variable "Delete file-local variable") t))
     265           0 :   (modify-file-local-variable variable nil 'delete interactive))
     266             : 
     267             : (defun modify-file-local-variable-prop-line (variable value op &optional interactive)
     268             :   "Modify file-local VARIABLE in the -*- line depending on operation OP.
     269             : 
     270             : If OP is `add-or-replace' then delete all existing settings of
     271             : VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
     272             : with VALUE to the -*- line.
     273             : 
     274             : If there is no -*- line at the beginning of the current file buffer
     275             : and OP is not `delete' then this function adds the -*- line.
     276             : 
     277             : If OP is `delete' then delete all existing settings of VARIABLE
     278             : from the -*- line ignoring the input argument VALUE."
     279           0 :   (catch 'exit
     280           0 :     (let ((beg (point)) end replaced-pos)
     281           0 :       (unless enable-local-variables
     282           0 :         (throw 'exit (message "File-local variables are disabled")))
     283             : 
     284             :       ;; Find the -*- line at the beginning of the current buffer.
     285           0 :       (widen)
     286           0 :       (goto-char (point-min))
     287           0 :       (setq end (set-auto-mode-1))
     288             : 
     289           0 :       (if end
     290           0 :           (setq beg (point-marker) end (copy-marker end))
     291             : 
     292             :         ;; Add the -*- line if not found.
     293             :         ;; Don't add the -*- line for the deletion operation.
     294           0 :         (when (eq op 'delete)
     295           0 :           (throw 'exit (progn (goto-char beg)
     296           0 :                               (message "The -*- line not found"))))
     297             : 
     298           0 :         (goto-char (point-min))
     299             : 
     300             :         ;; Skip interpreter magic line "#!" or XML declaration.
     301           0 :         (when (or (looking-at file-auto-mode-skip)
     302           0 :                   (looking-at "<\\?xml[^>\n]*>$"))
     303           0 :           (forward-line 1))
     304             : 
     305           0 :         (let ((comment-style 'plain)
     306           0 :               (comment-start (or comment-start ";;; "))
     307           0 :               (line-beg (line-beginning-position))
     308             :               (ce nil))
     309           0 :           (comment-normalize-vars)
     310             :           ;; If the first line contains a comment.
     311           0 :           (if (save-excursion
     312           0 :                 (and (looking-at comment-start-skip)
     313           0 :                      (goto-char (match-end 0))
     314           0 :                      (re-search-forward comment-end-skip)
     315           0 :                      (goto-char (match-beginning 0))
     316             :                      ;; Still on the same line?
     317           0 :                      (equal line-beg (line-beginning-position))
     318           0 :                      (setq ce (point))))
     319             :               ;; Add local variables to the end of the existing comment.
     320           0 :               (progn
     321           0 :                 (goto-char ce)
     322           0 :                 (insert "  -*-")
     323           0 :                 (setq beg (point-marker))
     324           0 :                 (setq end (point-marker))
     325           0 :                 (insert "-*-"))
     326             :             ;; Otherwise, add a new comment before the first line.
     327           0 :             (comment-region
     328           0 :              (prog1 (point)
     329           0 :                (insert "-*-")
     330           0 :                (setq beg (point-marker))
     331           0 :                (setq end (point-marker))
     332           0 :                (insert "-*-\n"))
     333           0 :              (point)))))
     334             : 
     335           0 :       (cond
     336           0 :        ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
     337             :         ;; Simple form: "-*- MODENAME -*-".
     338           0 :         (if (eq variable 'mode)
     339             :             ;; Replace or delete MODENAME
     340           0 :             (progn
     341           0 :               (when (member op '(add-or-replace delete))
     342           0 :                 (delete-region (match-beginning 1) (match-end 1)))
     343           0 :               (when (eq op 'add-or-replace)
     344           0 :                 (goto-char (match-beginning 1))
     345           0 :                 (insert (format "%S" value))))
     346             :           ;; Else, turn `MODENAME' into `mode:MODENAME'
     347             :           ;; and add `VARIABLE: VALUE;'
     348           0 :           (goto-char (match-beginning 2))
     349           0 :           (insert (format "; %S: %S; " variable value))
     350           0 :           (goto-char (match-beginning 1))
     351           0 :           (insert " mode: ")))
     352             : 
     353             :        (t
     354             :         ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
     355             :         ;; Find and delete all existing variable/value pairs.
     356           0 :         (when (member op '(add-or-replace delete))
     357           0 :           (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
     358           0 :               (goto-char end)
     359           0 :             (goto-char beg)
     360           0 :             (while (< (point) end)
     361           0 :               (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
     362           0 :                   (throw 'exit (message "Malformed -*- line")))
     363           0 :               (goto-char (match-end 0))
     364           0 :               (let ((key (intern (match-string 1))))
     365           0 :                 (save-restriction
     366           0 :                   (narrow-to-region (point) end)
     367           0 :                   (let ((read-circle nil))
     368           0 :                     (read (current-buffer))))
     369           0 :                 (skip-chars-forward " \t;")
     370           0 :                 (when (eq key variable)
     371           0 :                   (delete-region (match-beginning 0) (point))
     372           0 :                   (setq replaced-pos (point)))))))
     373             :         ;; Add a new variable/value pair.  Add `mode' to the start, add new
     374             :         ;; variable to the end, and add a replaced variable to its last location.
     375           0 :         (when (eq op 'add-or-replace)
     376           0 :           (cond
     377           0 :            ((eq variable 'mode) (goto-char beg))
     378           0 :            ((null replaced-pos) (goto-char end))
     379           0 :            (replaced-pos (goto-char replaced-pos)))
     380           0 :           (if (and (not (eq (char-before) ?\;))
     381           0 :                    (not (equal (point) (marker-position beg)))
     382             :                    ;; When existing `-*- -*-' is empty, beg > end.
     383           0 :                    (not (> (marker-position beg) (marker-position end))))
     384           0 :               (insert ";"))
     385           0 :           (unless (eq (char-before) ?\s) (insert " "))
     386           0 :           (insert (format "%S: %S;" variable value))
     387           0 :           (unless (eq (char-after) ?\s) (insert " ")))))
     388             : 
     389           0 :       (when interactive
     390           0 :         (modify-file-local-variable-message variable value op)))))
     391             : 
     392             : ;;;###autoload
     393             : (defun add-file-local-variable-prop-line (variable value &optional interactive)
     394             :   "Add file-local VARIABLE with its VALUE to the -*- line.
     395             : 
     396             : This command deletes all existing settings of VARIABLE (except `mode'
     397             : and `eval') and adds a new file-local VARIABLE with VALUE to
     398             : the -*- line.
     399             : 
     400             : If there is no -*- line at the beginning of the current file buffer
     401             : then this function adds it."
     402             :   (interactive
     403           0 :    (let ((variable (read-file-local-variable "Add -*- file-local variable")))
     404           0 :      (list variable (read-file-local-variable-value variable) t)))
     405           0 :   (modify-file-local-variable-prop-line variable value 'add-or-replace interactive))
     406             : 
     407             : ;;;###autoload
     408             : (defun delete-file-local-variable-prop-line (variable &optional interactive)
     409             :   "Delete all settings of file-local VARIABLE from the -*- line."
     410             :   (interactive
     411           0 :    (list (read-file-local-variable "Delete -*- file-local variable") t))
     412           0 :   (modify-file-local-variable-prop-line variable nil 'delete interactive))
     413             : 
     414             : (defvar auto-insert) ; from autoinsert.el
     415             : 
     416             : (defun modify-dir-local-variable (mode variable value op)
     417             :   "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.
     418             : 
     419             : If OP is `add-or-replace' then delete all existing settings of
     420             : VARIABLE (except `mode' and `eval') and add a new directory-local VARIABLE
     421             : with VALUE to the MODE alist where MODE can be a mode name symbol or
     422             : a subdirectory name.
     423             : 
     424             : If .dir-locals.el was not found and OP is not `delete' then create
     425             : this file in the current directory.
     426             : 
     427             : If OP is `delete' then delete all existing settings of VARIABLE
     428             : from the MODE alist ignoring the input argument VALUE."
     429           0 :   (catch 'exit
     430           0 :     (unless enable-local-variables
     431           0 :       (throw 'exit (message "Directory-local variables are disabled")))
     432           0 :     (let* ((dir-or-cache (and (buffer-file-name)
     433           0 :                               (not (file-remote-p (buffer-file-name)))
     434           0 :                               (dir-locals-find-file (buffer-file-name))))
     435             :            (variables-file
     436             :             ;; If there are several .dir-locals, the user probably
     437             :             ;; wants to edit the last one (the highest priority).
     438           0 :             (cond ((stringp dir-or-cache)
     439           0 :                    (car (last (dir-locals--all-files dir-or-cache))))
     440           0 :                   ((consp dir-or-cache) ; result from cache
     441             :                    ;; If cache element has an mtime, assume it came
     442             :                    ;; from a file.  Otherwise, assume it was set
     443             :                    ;; directly.
     444           0 :                    (if (nth 2 dir-or-cache)
     445           0 :                        (car (last (dir-locals--all-files (car dir-or-cache))))
     446           0 :                      (cadr dir-or-cache)))
     447             :                   ;; Try to make a proper file-name.
     448           0 :                   (t (expand-file-name dir-locals-file))))
     449             :            variables)
     450             :       ;; I can't be bothered to handle this case right now.
     451             :       ;; Dir locals were set directly from a class.  You need to
     452             :       ;; directly modify the class in dir-locals-class-alist.
     453           0 :       (and variables-file (not (stringp variables-file))
     454           0 :            (throw 'exit (message "Directory locals were not set from a file")))
     455             :       ;; Don't create ".dir-locals.el" for the deletion operation.
     456           0 :       (and (eq op 'delete)
     457           0 :            (or (not variables-file)
     458           0 :                (not (file-exists-p variables-file)))
     459           0 :            (throw 'exit (message "No .dir-locals.el file was found")))
     460           0 :       (let ((auto-insert nil))
     461           0 :         (find-file variables-file))
     462           0 :       (widen)
     463           0 :       (goto-char (point-min))
     464             : 
     465             :       ;; Read alist of directory-local variables.
     466           0 :       (ignore-errors
     467           0 :         (delete-region
     468           0 :          (prog1 (point)
     469           0 :            (setq variables (let ((read-circle nil))
     470           0 :                              (read (current-buffer)))))
     471           0 :          (point)))
     472             : 
     473             :       ;; Add or replace variable in alist of directory-local variables.
     474           0 :       (let ((mode-assoc (assoc mode variables)))
     475           0 :         (if mode-assoc
     476           0 :             (setq variables
     477           0 :                   (cons (cons mode
     478           0 :                               (if (eq op 'delete)
     479           0 :                                   (assq-delete-all variable (cdr mode-assoc))
     480           0 :                                 (cons
     481           0 :                                  (cons variable value)
     482           0 :                                  (if (memq variable '(mode eval))
     483           0 :                                      (cdr mode-assoc)
     484           0 :                                    (assq-delete-all variable (cdr mode-assoc))))))
     485           0 :                         (assq-delete-all mode variables)))
     486           0 :           (setq variables
     487           0 :                 (cons `(,mode . ((,variable . ,value)))
     488           0 :                       variables))))
     489             : 
     490             :       ;; Insert modified alist of directory-local variables.
     491           0 :       (insert ";;; Directory Local Variables\n")
     492           0 :       (insert ";;; For more information see (info \"(emacs) Directory Variables\")\n\n")
     493           0 :       (pp (sort variables
     494             :                 (lambda (a b)
     495           0 :                   (cond
     496           0 :                    ((null (car a)) t)
     497           0 :                    ((null (car b)) nil)
     498           0 :                    ((and (symbolp (car a)) (stringp (car b))) t)
     499           0 :                    ((and (symbolp (car b)) (stringp (car a))) nil)
     500           0 :                    (t (string< (car a) (car b))))))
     501           0 :           (current-buffer)))))
     502             : 
     503             : ;;;###autoload
     504             : (defun add-dir-local-variable (mode variable value)
     505             :   "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el."
     506             :   (interactive
     507           0 :    (let (variable)
     508           0 :      (list
     509           0 :       (read-file-local-variable-mode)
     510           0 :       (setq variable (read-file-local-variable "Add directory-local variable"))
     511           0 :       (read-file-local-variable-value variable))))
     512           0 :   (modify-dir-local-variable mode variable value 'add-or-replace))
     513             : 
     514             : ;;;###autoload
     515             : (defun delete-dir-local-variable (mode variable)
     516             :   "Delete all MODE settings of file-local VARIABLE from .dir-locals.el."
     517             :   (interactive
     518           0 :    (list
     519           0 :     (read-file-local-variable-mode)
     520           0 :     (read-file-local-variable "Delete directory-local variable")))
     521           0 :   (modify-dir-local-variable mode variable nil 'delete))
     522             : 
     523             : ;;;###autoload
     524             : (defun copy-file-locals-to-dir-locals ()
     525             :   "Copy file-local variables to .dir-locals.el."
     526             :   (interactive)
     527           0 :   (dolist (elt file-local-variables-alist)
     528           0 :     (unless (assq (car elt) dir-local-variables-alist)
     529           0 :       (add-dir-local-variable major-mode (car elt) (cdr elt)))))
     530             : 
     531             : ;;;###autoload
     532             : (defun copy-dir-locals-to-file-locals ()
     533             :   "Copy directory-local variables to the Local Variables list."
     534             :   (interactive)
     535           0 :   (dolist (elt dir-local-variables-alist)
     536           0 :     (add-file-local-variable (car elt) (cdr elt))))
     537             : 
     538             : ;;;###autoload
     539             : (defun copy-dir-locals-to-file-locals-prop-line ()
     540             :   "Copy directory-local variables to the -*- line."
     541             :   (interactive)
     542           0 :   (dolist (elt dir-local-variables-alist)
     543           0 :     (add-file-local-variable-prop-line (car elt) (cdr elt))))
     544             : 
     545             : 
     546             : ;;; connection-local variables.
     547             : 
     548             : ;;;###autoload
     549             : (defvar enable-connection-local-variables t
     550             :   "Non-nil means enable use of connection-local variables.")
     551             : 
     552             : (defvar connection-local-variables-alist nil
     553             :   "Alist of connection-local variable settings in the current buffer.
     554             : Each element in this list has the form (VAR . VALUE), where VAR
     555             : is a connection-local variable (a symbol) and VALUE is its value.
     556             : The actual value in the buffer may differ from VALUE, if it is
     557             : changed by the user.")
     558             : (make-variable-buffer-local 'connection-local-variables-alist)
     559             : (setq ignored-local-variables
     560             :       (cons 'connection-local-variables-alist ignored-local-variables))
     561             : 
     562             : (defvar connection-local-profile-alist '()
     563             :   "Alist mapping connection profiles to variable lists.
     564             : Each element in this list has the form (PROFILE VARIABLES).
     565             : PROFILE is the name of a connection profile (a symbol).
     566             : VARIABLES is a list that declares connection-local variables for
     567             : PROFILE.  An element in VARIABLES is an alist whose elements are
     568             : of the form (VAR . VALUE).")
     569             : 
     570             : (defvar connection-local-criteria-alist '()
     571             :   "Alist mapping connection criteria to connection profiles.
     572             : Each element in this list has the form (CRITERIA PROFILES).
     573             : CRITERIA is a plist identifying a connection and the application
     574             : using this connection.  Property names might be `:application',
     575             : `:protocol', `:user' and `:machine'.  The property value of
     576             : `:application' is a symbol, all other property values are
     577             : strings.  All properties are optional; if CRITERIA is nil, it
     578             : always applies.
     579             : PROFILES is a list of connection profiles (symbols).")
     580             : 
     581             : (defsubst connection-local-normalize-criteria (criteria &rest properties)
     582             :   "Normalize plist CRITERIA according to PROPERTIES.
     583             : Return a new ordered plist list containing only property names from PROPERTIES."
     584         120 :   (delq
     585             :    nil
     586         120 :    (mapcar
     587             :     (lambda (property)
     588         433 :       (when (and (plist-member criteria property) (plist-get criteria property))
     589         433 :         (list property (plist-get criteria property))))
     590         120 :     properties)))
     591             : 
     592             : (defsubst connection-local-get-profiles (criteria)
     593             :   "Return the connection profiles list for CRITERIA.
     594             : CRITERIA is a plist identifying a connection and the application
     595             : using this connection, see `connection-local-criteria-alist'."
     596          72 :   (or (cdr
     597          72 :        (assoc
     598          72 :         (connection-local-normalize-criteria
     599          72 :          criteria :application :protocol :user :machine)
     600          72 :         connection-local-criteria-alist))
     601             :       ;; Try it without :application.
     602          47 :       (cdr
     603          47 :        (assoc
     604          47 :         (connection-local-normalize-criteria criteria :protocol :user :machine)
     605          72 :         connection-local-criteria-alist))))
     606             : 
     607             : ;;;###autoload
     608             : (defun connection-local-set-profiles (criteria &rest profiles)
     609             :   "Add PROFILES for CRITERIA.
     610             : CRITERIA is a plist identifying a connection and the application
     611             : using this connection, see `connection-local-criteria-alist'.
     612             : PROFILES are the names of connection profiles (a symbol).
     613             : 
     614             : When a connection to a remote server is opened and CRITERIA
     615             : matches to that server, the connection-local variables from
     616             : PROFILES are applied to the corresponding process buffer.  The
     617             : variables for a connection profile are defined using
     618             : `connection-local-set-profile-variables'."
     619           1 :   (unless (listp criteria)
     620           1 :     (error "Wrong criteria `%s'" criteria))
     621           1 :   (dolist (profile profiles)
     622           1 :     (unless (assq profile connection-local-profile-alist)
     623           1 :       (error "No such connection profile `%s'" (symbol-name profile))))
     624           1 :   (let* ((criteria (connection-local-normalize-criteria
     625           1 :                     criteria :application :protocol :user :machine))
     626           1 :          (slot (assoc criteria connection-local-criteria-alist)))
     627           1 :     (if slot
     628           0 :         (setcdr slot (delete-dups (append (cdr slot) profiles)))
     629           1 :       (setq connection-local-criteria-alist
     630           1 :             (cons (cons criteria (delete-dups profiles))
     631           1 :                   connection-local-criteria-alist)))))
     632             : 
     633             : (defsubst connection-local-get-profile-variables (profile)
     634             :   "Return the connection-local variable list for PROFILE."
     635          25 :   (cdr (assq profile connection-local-profile-alist)))
     636             : 
     637             : ;;;###autoload
     638             : (defun connection-local-set-profile-variables (profile variables)
     639             :   "Map the symbol PROFILE to a list of variable settings.
     640             : VARIABLES is a list that declares connection-local variables for
     641             : the connection profile.  An element in VARIABLES is an alist
     642             : whose elements are of the form (VAR . VALUE).
     643             : 
     644             : When a connection to a remote server is opened, the server's
     645             : connection profiles are found.  A server may be assigned a
     646             : connection profile using `connection-local-set-profile'.  Then
     647             : variables are set in the server's process buffer according to the
     648             : VARIABLES list of the connection profile.  The list is processed
     649             : in order."
     650           3 :   (setf (alist-get profile connection-local-profile-alist) variables))
     651             : 
     652             : (defun hack-connection-local-variables (criteria)
     653             :   "Read connection-local variables according to CRITERIA.
     654             : Store the connection-local variables in buffer local
     655             : variable`connection-local-variables-alist'.
     656             : 
     657             : This does nothing if `enable-connection-local-variables' is nil."
     658          72 :   (when enable-connection-local-variables
     659             :     ;; Filter connection profiles.
     660          72 :     (dolist (profile (connection-local-get-profiles criteria))
     661             :       ;; Loop over variables.
     662          25 :       (dolist (variable (connection-local-get-profile-variables profile))
     663          50 :         (unless (assq (car variable) connection-local-variables-alist)
     664         100 :           (push variable connection-local-variables-alist))))))
     665             : 
     666             : ;;;###autoload
     667             : (defun hack-connection-local-variables-apply (criteria)
     668             :  "Apply connection-local variables identified by CRITERIA.
     669             : Other local variables, like file-local and dir-local variables,
     670             : will not be changed."
     671          72 :  (hack-connection-local-variables criteria)
     672          72 :  (let ((file-local-variables-alist
     673          72 :         (copy-tree connection-local-variables-alist)))
     674          72 :    (hack-local-variables-apply)))
     675             : 
     676             : ;;;###autoload
     677             : (defmacro with-connection-local-profiles (profiles &rest body)
     678             :   "Apply connection-local variables according to PROFILES in current buffer.
     679             : Execute BODY, and unwind connection-local variables."
     680             :   (declare (indent 1) (debug t))
     681           0 :   `(let ((enable-connection-local-variables t)
     682             :          (old-buffer-local-variables (buffer-local-variables))
     683             :          connection-local-variables-alist connection-local-criteria-alist)
     684           0 :      (apply 'connection-local-set-profiles nil ,profiles)
     685             :      (hack-connection-local-variables-apply nil)
     686             :      (unwind-protect
     687           0 :          (progn ,@body)
     688             :        ;; Cleanup.
     689             :        (dolist (variable connection-local-variables-alist)
     690             :          (let ((elt (assq (car variable) old-buffer-local-variables)))
     691             :            (if elt
     692             :                (set (make-local-variable (car elt)) (cdr elt))
     693           0 :            (kill-local-variable (car variable))))))))
     694             : 
     695             : 
     696             : 
     697             : (provide 'files-x)
     698             : 
     699             : ;;; files-x.el ends here

Generated by: LCOV version 1.12