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
|