Remove getc_unlocked configure-time check
[emacs.git] / lisp / files-x.el
blobb7c6f51e65889e231e613e414421595f45944104
1 ;;; files-x.el --- extended file handling commands
3 ;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
5 ;; Author: Juri Linkov <juri@jurta.org>
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Keywords: files
8 ;; Package: emacs
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;;; Commentary:
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.
31 ;;; Code:
34 ;;; Commands to add/delete file-local/directory-local variables.
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 (let* ((default (variable-at-point))
42 (default (and (symbolp default) (boundp default)
43 (symbol-name default)))
44 (variable
45 (completing-read
46 (if default
47 (format "%s (default %s): " prompt default)
48 (format "%s: " prompt))
49 obarray
50 (lambda (sym)
51 (or (custom-variable-p sym)
52 (get sym 'safe-local-variable)
53 (memq sym '(mode eval coding unibyte))))
54 nil nil nil default nil)))
55 (and (stringp variable) (intern variable))))
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 (cond
62 ((eq variable 'mode)
63 (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
64 (value
65 (completing-read
66 (if default
67 (format "Add %s with value (default %s): " variable default)
68 (format "Add %s with value: " variable))
69 obarray
70 (lambda (sym)
71 (string-match-p "-mode\\'" (symbol-name sym)))
72 nil nil nil default nil)))
73 (and (stringp value)
74 (intern (replace-regexp-in-string "-mode\\'" "" value)))))
75 ((eq variable 'eval)
76 (read--expression (format "Add %s with expression: " variable)))
77 ((eq variable 'coding)
78 (let ((default (and (symbolp buffer-file-coding-system)
79 (symbol-name buffer-file-coding-system))))
80 (read-coding-system
81 (if default
82 (format "Add %s with value (default %s): " variable default)
83 (format "Add %s with value: " variable))
84 default)))
86 (let ((default (format "%S"
87 (cond ((eq variable 'unibyte) t)
88 ((boundp variable)
89 (symbol-value variable)))))
90 (minibuffer-completing-symbol t))
91 (read-from-minibuffer (format "Add %s with value: " variable)
92 nil read-expression-map t
93 'set-variable-value-history
94 default)))))
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 (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
101 (mode
102 (completing-read
103 (if default
104 (format "Mode or subdirectory (default %s): " default)
105 (format "Mode or subdirectory: "))
106 obarray
107 (lambda (sym)
108 (and (string-match-p "-mode\\'" (symbol-name sym))
109 (not (or (memq sym minor-mode-list)
110 (string-match-p "-minor-mode\\'"
111 (symbol-name sym))))))
112 nil nil nil default nil)))
113 (cond
114 ((equal mode "nil") nil)
115 ((and (stringp mode) (fboundp (intern mode))) (intern mode))
116 (t mode))))
118 (defun modify-file-local-variable-message (variable value op)
119 (let* ((not-value (make-symbol ""))
120 (old-value (cond ((eq variable 'mode)
121 major-mode)
122 ((eq variable 'coding)
123 buffer-file-coding-system)
124 (t (if (and (symbolp variable)
125 (boundp variable))
126 (symbol-value variable)
127 not-value))))
128 (new-value (if (eq op 'delete)
129 (cond ((eq variable 'mode)
130 (default-value 'major-mode))
131 ((eq variable 'coding)
132 (default-value 'buffer-file-coding-system))
133 (t (if (and (symbolp variable)
134 (default-boundp variable))
135 (default-value variable)
136 not-value)))
137 (cond ((eq variable 'mode)
138 (let ((string (format "%S" value)))
139 (if (string-match-p "-mode\\'" string)
140 value
141 (intern (concat string "-mode")))))
142 (t value)))))
143 (when (or (eq old-value not-value)
144 (eq new-value not-value)
145 (not (equal old-value new-value)))
146 (message "%s" (substitute-command-keys
147 "For this change to take effect revisit file using \\[revert-buffer]")))))
149 (defun modify-file-local-variable (variable value op &optional interactive)
150 "Modify file-local VARIABLE in Local Variables depending on operation OP.
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.
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:'.
160 If OP is `delete' then delete all existing settings of VARIABLE
161 from the Local Variables list ignoring the input argument VALUE."
162 (catch 'exit
163 (let ((beg (point)) end replaced-pos)
164 (unless enable-local-variables
165 (throw 'exit (message "File-local variables are disabled")))
167 ;; Look for "Local variables:" line in last page.
168 (widen)
169 (goto-char (point-max))
170 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
172 ;; Add "Local variables:" list if not found.
173 (unless (let ((case-fold-search t))
174 (search-forward "Local Variables:" nil t))
176 ;; Don't add "Local variables:" list for the deletion operation.
177 (when (eq op 'delete)
178 (throw 'exit (progn (goto-char beg)
179 (message "Local Variables not found"))))
181 (goto-char (point-max))
182 (let ((comment-style 'plain)
183 (comment-start (or comment-start ";; ")))
184 (comment-region
185 (prog1 (setq beg (point))
186 (insert "\nLocal Variables:\nEnd:\n"))
187 (point)))
189 (unless (let ((case-fold-search t))
190 (goto-char beg)
191 (search-forward "Local Variables:" nil t))
192 (throw 'exit (message "Can't add file-local variables"))))
194 ;; prefix is what comes before "local variables:" in its line.
195 ;; suffix is what comes after "local variables:" in its line.
196 (let* ((prefix (buffer-substring (line-beginning-position)
197 (match-beginning 0)))
198 (suffix (buffer-substring (point) (line-end-position)))
199 (prefix-re (concat "^" (regexp-quote prefix)))
200 (suffix-re (concat (regexp-quote suffix) "$")))
202 ;; Find or add missing "End:".
203 (forward-line 1)
204 (setq beg (point))
205 (save-excursion
206 (unless (let ((case-fold-search t))
207 (re-search-forward
208 (concat prefix-re "[ \t]*End:[ \t]*" suffix-re)
209 nil t))
210 (save-excursion
211 (insert (format "%sEnd:%s\n" prefix suffix))))
212 (beginning-of-line)
213 (setq end (point-marker)))
215 ;; Find and delete all existing variable/value pairs.
216 (when (member op '(add-or-replace delete))
217 (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
218 (goto-char end)
219 (goto-char beg)
220 (while (re-search-forward
221 (format "%s%S:.*%s" prefix-re variable suffix-re) end t)
222 (delete-region (match-beginning 0) (1+ (match-end 0)))
223 (setq replaced-pos (point)))))
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 (when (eq op 'add-or-replace)
228 (cond
229 ((eq variable 'mode) (goto-char beg))
230 ((null replaced-pos) (goto-char end))
231 (replaced-pos (goto-char replaced-pos)))
232 (insert (format "%s%S: %S%s\n" prefix variable value suffix))))
234 (when interactive
235 (modify-file-local-variable-message variable value op)))))
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.
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.
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 (let ((variable (read-file-local-variable "Add file-local variable")))
250 ;; Error before reading value.
251 (if (equal variable 'lexical-binding)
252 (user-error "The `%s' variable must be set at the start of the file"
253 variable))
254 (list variable (read-file-local-variable-value variable) t)))
255 (if (equal variable 'lexical-binding)
256 (user-error "The `%s' variable must be set at the start of the file"
257 variable))
258 (modify-file-local-variable variable value 'add-or-replace interactive))
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 (list (read-file-local-variable "Delete file-local variable") t))
265 (modify-file-local-variable variable nil 'delete interactive))
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.
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.
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.
277 If OP is `delete' then delete all existing settings of VARIABLE
278 from the -*- line ignoring the input argument VALUE."
279 (catch 'exit
280 (let ((beg (point)) end replaced-pos)
281 (unless enable-local-variables
282 (throw 'exit (message "File-local variables are disabled")))
284 ;; Find the -*- line at the beginning of the current buffer.
285 (widen)
286 (goto-char (point-min))
287 (setq end (set-auto-mode-1))
289 (if end
290 (setq beg (point-marker) end (copy-marker end))
292 ;; Add the -*- line if not found.
293 ;; Don't add the -*- line for the deletion operation.
294 (when (eq op 'delete)
295 (throw 'exit (progn (goto-char beg)
296 (message "The -*- line not found"))))
298 (goto-char (point-min))
300 ;; Skip interpreter magic line "#!" or XML declaration.
301 (when (or (looking-at file-auto-mode-skip)
302 (looking-at "<\\?xml[^>\n]*>$"))
303 (forward-line 1))
305 (let ((comment-style 'plain)
306 (comment-start (or comment-start ";;; "))
307 (line-beg (line-beginning-position))
308 (ce nil))
309 (comment-normalize-vars)
310 ;; If the first line contains a comment.
311 (if (save-excursion
312 (and (looking-at comment-start-skip)
313 (goto-char (match-end 0))
314 (re-search-forward comment-end-skip)
315 (goto-char (match-beginning 0))
316 ;; Still on the same line?
317 (equal line-beg (line-beginning-position))
318 (setq ce (point))))
319 ;; Add local variables to the end of the existing comment.
320 (progn
321 (goto-char ce)
322 (insert " -*-")
323 (setq beg (point-marker))
324 (setq end (point-marker))
325 (insert "-*-"))
326 ;; Otherwise, add a new comment before the first line.
327 (comment-region
328 (prog1 (point)
329 (insert "-*-")
330 (setq beg (point-marker))
331 (setq end (point-marker))
332 (insert "-*-\n"))
333 (point)))))
335 (cond
336 ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
337 ;; Simple form: "-*- MODENAME -*-".
338 (if (eq variable 'mode)
339 ;; Replace or delete MODENAME
340 (progn
341 (when (member op '(add-or-replace delete))
342 (delete-region (match-beginning 1) (match-end 1)))
343 (when (eq op 'add-or-replace)
344 (goto-char (match-beginning 1))
345 (insert (format "%S" value))))
346 ;; Else, turn `MODENAME' into `mode:MODENAME'
347 ;; and add `VARIABLE: VALUE;'
348 (goto-char (match-beginning 2))
349 (insert (format "; %S: %S; " variable value))
350 (goto-char (match-beginning 1))
351 (insert " mode: ")))
354 ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
355 ;; Find and delete all existing variable/value pairs.
356 (when (member op '(add-or-replace delete))
357 (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
358 (goto-char end)
359 (goto-char beg)
360 (while (< (point) end)
361 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
362 (throw 'exit (message "Malformed -*- line")))
363 (goto-char (match-end 0))
364 (let ((key (intern (match-string 1))))
365 (save-restriction
366 (narrow-to-region (point) end)
367 (let ((read-circle nil))
368 (read (current-buffer))))
369 (skip-chars-forward " \t;")
370 (when (eq key variable)
371 (delete-region (match-beginning 0) (point))
372 (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 (when (eq op 'add-or-replace)
376 (cond
377 ((eq variable 'mode) (goto-char beg))
378 ((null replaced-pos) (goto-char end))
379 (replaced-pos (goto-char replaced-pos)))
380 (if (and (not (eq (char-before) ?\;))
381 (not (equal (point) (marker-position beg)))
382 ;; When existing `-*- -*-' is empty, beg > end.
383 (not (> (marker-position beg) (marker-position end))))
384 (insert ";"))
385 (unless (eq (char-before) ?\s) (insert " "))
386 (insert (format "%S: %S;" variable value))
387 (unless (eq (char-after) ?\s) (insert " ")))))
389 (when interactive
390 (modify-file-local-variable-message variable value op)))))
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.
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.
400 If there is no -*- line at the beginning of the current file buffer
401 then this function adds it."
402 (interactive
403 (let ((variable (read-file-local-variable "Add -*- file-local variable")))
404 (list variable (read-file-local-variable-value variable) t)))
405 (modify-file-local-variable-prop-line variable value 'add-or-replace interactive))
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 (list (read-file-local-variable "Delete -*- file-local variable") t))
412 (modify-file-local-variable-prop-line variable nil 'delete interactive))
414 (defvar auto-insert) ; from autoinsert.el
416 (defun modify-dir-local-variable (mode variable value op)
417 "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.
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.
424 If .dir-locals.el was not found and OP is not `delete' then create
425 this file in the current directory.
427 If OP is `delete' then delete all existing settings of VARIABLE
428 from the MODE alist ignoring the input argument VALUE."
429 (catch 'exit
430 (unless enable-local-variables
431 (throw 'exit (message "Directory-local variables are disabled")))
432 (let* ((dir-or-cache (and (buffer-file-name)
433 (not (file-remote-p (buffer-file-name)))
434 (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 (cond ((stringp dir-or-cache)
439 (car (last (dir-locals--all-files dir-or-cache))))
440 ((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 (if (nth 2 dir-or-cache)
445 (car (last (dir-locals--all-files (car dir-or-cache))))
446 (cadr dir-or-cache)))
447 ;; Try to make a proper file-name.
448 (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 (and variables-file (not (stringp variables-file))
454 (throw 'exit (message "Directory locals were not set from a file")))
455 ;; Don't create ".dir-locals.el" for the deletion operation.
456 (and (eq op 'delete)
457 (or (not variables-file)
458 (not (file-exists-p variables-file)))
459 (throw 'exit (message "No .dir-locals.el file was found")))
460 (let ((auto-insert nil))
461 (find-file variables-file))
462 (widen)
463 (goto-char (point-min))
465 ;; Read alist of directory-local variables.
466 (ignore-errors
467 (delete-region
468 (prog1 (point)
469 (setq variables (let ((read-circle nil))
470 (read (current-buffer)))))
471 (point)))
473 ;; Add or replace variable in alist of directory-local variables.
474 (let ((mode-assoc (assoc mode variables)))
475 (if mode-assoc
476 (setq variables
477 (cons (cons mode
478 (if (eq op 'delete)
479 (assq-delete-all variable (cdr mode-assoc))
480 (cons
481 (cons variable value)
482 (if (memq variable '(mode eval))
483 (cdr mode-assoc)
484 (assq-delete-all variable (cdr mode-assoc))))))
485 (assq-delete-all mode variables)))
486 (setq variables
487 (cons `(,mode . ((,variable . ,value)))
488 variables))))
490 ;; Insert modified alist of directory-local variables.
491 (insert ";;; Directory Local Variables\n")
492 (insert ";;; For more information see (info \"(emacs) Directory Variables\")\n\n")
493 (pp (sort variables
494 (lambda (a b)
495 (cond
496 ((null (car a)) t)
497 ((null (car b)) nil)
498 ((and (symbolp (car a)) (stringp (car b))) t)
499 ((and (symbolp (car b)) (stringp (car a))) nil)
500 (t (string< (car a) (car b))))))
501 (current-buffer)))))
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 (let (variable)
508 (list
509 (read-file-local-variable-mode)
510 (setq variable (read-file-local-variable "Add directory-local variable"))
511 (read-file-local-variable-value variable))))
512 (modify-dir-local-variable mode variable value 'add-or-replace))
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 (list
519 (read-file-local-variable-mode)
520 (read-file-local-variable "Delete directory-local variable")))
521 (modify-dir-local-variable mode variable nil 'delete))
523 ;;;###autoload
524 (defun copy-file-locals-to-dir-locals ()
525 "Copy file-local variables to .dir-locals.el."
526 (interactive)
527 (dolist (elt file-local-variables-alist)
528 (unless (assq (car elt) dir-local-variables-alist)
529 (add-dir-local-variable major-mode (car elt) (cdr elt)))))
531 ;;;###autoload
532 (defun copy-dir-locals-to-file-locals ()
533 "Copy directory-local variables to the Local Variables list."
534 (interactive)
535 (dolist (elt dir-local-variables-alist)
536 (add-file-local-variable (car elt) (cdr elt))))
538 ;;;###autoload
539 (defun copy-dir-locals-to-file-locals-prop-line ()
540 "Copy directory-local variables to the -*- line."
541 (interactive)
542 (dolist (elt dir-local-variables-alist)
543 (add-file-local-variable-prop-line (car elt) (cdr elt))))
546 ;;; connection-local variables.
548 ;;;###autoload
549 (defvar enable-connection-local-variables t
550 "Non-nil means enable use of connection-local variables.")
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))
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).")
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).")
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 (delq
586 (mapcar
587 (lambda (property)
588 (when (and (plist-member criteria property) (plist-get criteria property))
589 (list property (plist-get criteria property))))
590 properties)))
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 (or (cdr
597 (assoc
598 (connection-local-normalize-criteria
599 criteria :application :protocol :user :machine)
600 connection-local-criteria-alist))
601 ;; Try it without :application.
602 (cdr
603 (assoc
604 (connection-local-normalize-criteria criteria :protocol :user :machine)
605 connection-local-criteria-alist))))
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).
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 (unless (listp criteria)
620 (error "Wrong criteria `%s'" criteria))
621 (dolist (profile profiles)
622 (unless (assq profile connection-local-profile-alist)
623 (error "No such connection profile `%s'" (symbol-name profile))))
624 (let* ((criteria (connection-local-normalize-criteria
625 criteria :application :protocol :user :machine))
626 (slot (assoc criteria connection-local-criteria-alist)))
627 (if slot
628 (setcdr slot (delete-dups (append (cdr slot) profiles)))
629 (setq connection-local-criteria-alist
630 (cons (cons criteria (delete-dups profiles))
631 connection-local-criteria-alist)))))
633 (defsubst connection-local-get-profile-variables (profile)
634 "Return the connection-local variable list for PROFILE."
635 (cdr (assq profile connection-local-profile-alist)))
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).
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 (setf (alist-get profile connection-local-profile-alist) variables))
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'.
657 This does nothing if `enable-connection-local-variables' is nil."
658 (when enable-connection-local-variables
659 ;; Filter connection profiles.
660 (dolist (profile (connection-local-get-profiles criteria))
661 ;; Loop over variables.
662 (dolist (variable (connection-local-get-profile-variables profile))
663 (unless (assq (car variable) connection-local-variables-alist)
664 (push variable connection-local-variables-alist))))))
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 (hack-connection-local-variables criteria)
672 (let ((file-local-variables-alist
673 (copy-tree connection-local-variables-alist)))
674 (hack-local-variables-apply)))
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 `(let ((enable-connection-local-variables t)
682 (old-buffer-local-variables (buffer-local-variables))
683 connection-local-variables-alist connection-local-criteria-alist)
684 (apply 'connection-local-set-profiles nil ,profiles)
685 (hack-connection-local-variables-apply nil)
686 (unwind-protect
687 (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 (kill-local-variable (car variable))))))))
697 (provide 'files-x)
699 ;;; files-x.el ends here