[bpt/emacs.git] / lisp / files-x.el

;;; files-x.el --- extended file handling commands

;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.

;; Author: Juri Linkov <juri@jurta.org>
;; Maintainer: FSF
;; Keywords: files

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file defines additional infrequently used file- and
;; directory-handling commands that should not be in files.el
;; to not make the dumped image bigger.

;;; Code:

\f
;;; Commands to add/delete file-local/directory-local variables.

(defun read-file-local-variable (prompt)
  "Read file-local variable using PROMPT and completion.
Intended to be used in the `interactive' spec of
`add-file-local-variable', `delete-file-local-variable',
`add-dir-local-variable', `delete-dir-local-variable'."
  (let (default variable)
    (setq default (variable-at-point))
    (setq default (and (symbolp default) (boundp default)
		       (symbol-name default)))
    (setq variable
	  (completing-read
	   (if default
	       (format "%s (default %s): " prompt default)
	     (format "%s: " prompt))
	   obarray
	   (lambda (sym)
	     (or (user-variable-p sym)
                 (get sym 'safe-local-variable)
		 (memq sym '(mode eval coding unibyte))))
	   nil nil nil default nil))
    (and (stringp variable) (intern variable))))

(defun read-file-local-variable-value (variable)
  "Read value of file-local VARIABLE using completion.
Intended to be used in the `interactive' spec of
`add-file-local-variable' and `add-dir-local-variable'."
  (let (default value)
    (cond
     ((eq variable 'mode)
      (setq default (and (symbolp major-mode) (symbol-name major-mode)))
      (setq value
	    (completing-read
	     (if default
		 (format "Add %s with value (default %s): " variable default)
	       (format "Add %s with value: " variable))
	     obarray
	     (lambda (sym)
	       (string-match-p "-mode\\'" (symbol-name sym)))
	     nil nil nil default nil))
      (and (stringp value)
	   (intern (replace-regexp-in-string "-mode\\'" "" value))))
     ((eq variable 'eval)
      (let ((minibuffer-completing-symbol t))
	(read-from-minibuffer (format "Add %s with expression: " variable)
			      nil read-expression-map t
			      'read-expression-history)))
     ((eq variable 'coding)
      (setq default (and (symbolp buffer-file-coding-system)
			 (symbol-name buffer-file-coding-system)))
      (read-coding-system
       (if default
	   (format "Add %s with value (default %s): " variable default)
	 (format "Add %s with value: " variable))
       default))
     (t
      (read (read-string (format "Add %s with value: " variable)
			 nil 'set-variable-value-history
			 (format "%S"
				 (cond ((eq variable 'unibyte) t)
				       ((boundp variable)
					(symbol-value variable))))))))))

(defun read-file-local-variable-mode ()
  "Read per-directory file-local variable's mode using completion.
Intended to be used in the `interactive' spec of
`add-dir-local-variable', `delete-dir-local-variable'."
  (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
	 (mode
	  (completing-read
	   (if default
	       (format "Mode or subdirectory (default %s): " default)
	     (format "Mode or subdirectory: "))
	   obarray
	   (lambda (sym)
	     (and (string-match-p "-mode\\'" (symbol-name sym))
		  (not (string-match-p "-minor-mode\\'" (symbol-name sym)))))
	   nil nil nil default nil)))
    (cond
     ((equal mode "nil") nil)
     ((and (stringp mode) (fboundp (intern mode))) (intern mode))
     (t mode))))

(defun modify-file-local-variable (variable value op)
  "Modify file-local VARIABLE in Local Variables depending on operation OP.

If OP is `add-or-replace' then delete all existing settings of
VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
with VALUE to the Local Variables list.

If there is no Local Variables list in the current file buffer and OP
is not `delete' then this function adds the first line containing the
string `Local Variables:' and the last line containing the string `End:'.

If OP is `delete' then delete all existing settings of VARIABLE
from the Local Variables list ignoring the input argument VALUE."
  (catch 'exit
    (let ((beg (point)) end replaced-pos)
      (unless enable-local-variables
	(throw 'exit (message "File-local variables are disabled")))

      ;; Look for "Local variables:" line in last page.
      (widen)
      (goto-char (point-max))
      (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)

      ;; Add "Local variables:" list if not found.
      (unless (let ((case-fold-search t))
		(search-forward "Local Variables:" nil t))

	;; Don't add "Local variables:" list for the deletion operation.
	(when (eq op 'delete)
	  (throw 'exit (progn (goto-char beg)
			      (message "Local Variables not found"))))

	(goto-char (point-max))
	(let ((comment-style 'plain)
	      (comment-start (or comment-start ";;; ")))
	  (comment-region
	   (prog1 (setq beg (point))
	     (insert "\nLocal Variables:\nEnd:\n"))
	   (point)))

	(unless (let ((case-fold-search t))
		  (goto-char beg)
		  (search-forward "Local Variables:" nil t))
	  (throw 'exit (message "Can't add file-local variables"))))

      ;; prefix is what comes before "local variables:" in its line.
      ;; suffix is what comes after "local variables:" in its line.
      (let* ((prefix (buffer-substring (line-beginning-position)
				       (match-beginning 0)))
	     (suffix (buffer-substring (point) (line-end-position)))
	     (prefix-re (concat "^" (regexp-quote prefix)))
	     (suffix-re (concat (regexp-quote suffix) "$")))

	;; Find or add missing "End:".
	(forward-line 1)
	(setq beg (point))
	(save-excursion
	  (unless (let ((case-fold-search t))
		    (re-search-forward
		     (concat prefix-re "[ \t]*End:[ \t]*" suffix-re)
		     nil t))
	    (save-excursion
	      (insert (format "%sEnd:%s\n" prefix suffix))))
	  (beginning-of-line)
	  (setq end (point-marker)))

	;; Find and delete all existing variable/value pairs.
	(when (member op '(add-or-replace delete))
	  (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
	      (goto-char end)
	    (goto-char beg)
	    (while (re-search-forward
		    (format "%s%S:.*%s" prefix-re variable suffix-re) end t)
	      (delete-region (match-beginning 0) (1+ (match-end 0)))
	      (setq replaced-pos (point)))))

	;; Add a new variable/value pair.  Add `mode' to the start, add new
	;; variable to the end, and add a replaced variable to its last location.
	(when (eq op 'add-or-replace)
	  (cond
	   ((eq variable 'mode) (goto-char beg))
	   ((null replaced-pos) (goto-char end))
	   (replaced-pos (goto-char replaced-pos)))
	  (insert (format "%s%S: %S%s\n" prefix variable value suffix)))))))

;;;###autoload
(defun add-file-local-variable (variable value)
  "Add file-local VARIABLE with its VALUE to the Local Variables list.

This command deletes all existing settings of VARIABLE (except `mode'
and `eval') and adds a new file-local VARIABLE with VALUE to the
Local Variables list.

If there is no Local Variables list in the current file buffer
then this function adds the first line containing the string
`Local Variables:' and the last line containing the string `End:'."
  (interactive
   (let ((variable (read-file-local-variable "Add file-local variable")))
     (list variable (read-file-local-variable-value variable))))
  (modify-file-local-variable variable value 'add-or-replace))

;;;###autoload
(defun delete-file-local-variable (variable)
  "Delete all settings of file-local VARIABLE from the Local Variables list."
  (interactive
   (list (read-file-local-variable "Delete file-local variable")))
  (modify-file-local-variable variable nil 'delete))

(defun modify-file-local-variable-prop-line (variable value op)
  "Modify file-local VARIABLE in the -*- line depending on operation OP.

If OP is `add-or-replace' then delete all existing settings of
VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
with VALUE to the -*- line.

If there is no -*- line at the beginning of the current file buffer
and OP is not `delete' then this function adds the -*- line.

If OP is `delete' then delete all existing settings of VARIABLE
from the -*- line ignoring the input argument VALUE."
  (catch 'exit
    (let ((beg (point)) end replaced-pos)
      (unless enable-local-variables
	(throw 'exit (message "File-local variables are disabled")))

      ;; Find the -*- line at the beginning of the current buffer.
      (widen)
      (goto-char (point-min))
      (setq end (set-auto-mode-1))

      (if end
	  (setq beg (point-marker) end (copy-marker end))

	;; Add the -*- line if not found.
	;; Don't add the -*- line for the deletion operation.
	(when (eq op 'delete)
	  (throw 'exit (progn (goto-char beg)
			      (message "The -*- line not found"))))

	(goto-char (point-min))

	;; Skip interpreter magic line "#!"
	(when (looking-at "^\\(#!\\|'\\\\\"\\)")
	  (forward-line 1))

	(let ((comment-style 'plain)
	      (comment-start (or comment-start ";;; ")))
	  (comment-region
	   (prog1 (point)
	     (insert "-*-")
	     (setq beg (point-marker))
	     (setq end (point-marker))
	     (insert "-*-\n"))
	   (point))))

      (cond
       ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
	;; Simple form: "-*- MODENAME -*-".
	(if (eq variable 'mode)
	    ;; Replace or delete MODENAME
	    (progn
	      (when (member op '(add-or-replace delete))
		(delete-region (match-beginning 1) (match-end 1)))
	      (when (eq op 'add-or-replace)
		(goto-char (match-beginning 1))
		(insert (format "%S" value))))
	  ;; Else, turn `MODENAME' into `mode:MODENAME'
	  ;; and add `VARIABLE: VALUE;'
	  (goto-char (match-beginning 2))
	  (insert (format "; %S: %S; " variable value))
	  (goto-char (match-beginning 1))
	  (insert " mode: ")))

       (t
	;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
	;; Find and delete all existing variable/value pairs.
	(when (member op '(add-or-replace delete))
	  (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
	      (goto-char end)
	    (goto-char beg)
	    (while (< (point) end)
	      (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
		  (throw 'exit (message "Malformed -*- line")))
	      (goto-char (match-end 0))
	      (let ((key (intern (match-string 1)))
		    (val (save-restriction
			   (narrow-to-region (point) end)
			   (let ((read-circle nil))
			     (read (current-buffer))))))
		(skip-chars-forward " \t;")
		(when (eq key variable)
		  (delete-region (match-beginning 0) (point))
		  (setq replaced-pos (point)))))))
	;; Add a new variable/value pair.  Add `mode' to the start, add new
	;; variable to the end, and add a replaced variable to its last location.
	(when (eq op 'add-or-replace)
	  (cond
	   ((eq variable 'mode) (goto-char beg))
	   ((null replaced-pos) (goto-char end))
	   (replaced-pos (goto-char replaced-pos)))
	  (if (and (not (eq (char-before) ?\;))
		   (not (equal (point) (marker-position beg))))
	      (insert ";"))
	  (unless (eq (char-before) ?\s) (insert " "))
	  (insert (format "%S: %S;" variable value))
	  (unless (eq (char-after) ?\s) (insert " "))))))))

;;;###autoload
(defun add-file-local-variable-prop-line (variable value)
  "Add file-local VARIABLE with its VALUE to the -*- line.

This command deletes all existing settings of VARIABLE (except `mode'
and `eval') and adds a new file-local VARIABLE with VALUE to
the -*- line.

If there is no -*- line at the beginning of the current file buffer
then this function adds it."
  (interactive
   (let ((variable (read-file-local-variable "Add -*- file-local variable")))
     (list variable (read-file-local-variable-value variable))))
  (modify-file-local-variable-prop-line variable value 'add-or-replace))

;;;###autoload
(defun delete-file-local-variable-prop-line (variable)
  "Delete all settings of file-local VARIABLE from the -*- line."
  (interactive
   (list (read-file-local-variable "Delete -*- file-local variable")))
  (modify-file-local-variable-prop-line variable nil 'delete))

(defun modify-dir-local-variable (mode variable value op)
  "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.

If OP is `add-or-replace' then delete all existing settings of
VARIABLE (except `mode' and `eval') and add a new directory-local VARIABLE
with VALUE to the MODE alist where MODE can be a mode name symbol or
a subdirectory name.

If .dir-locals.el was not found and OP is not `delete' then create
this file in the current directory.

If OP is `delete' then delete all existing settings of VARIABLE
from the MODE alist ignoring the input argument VALUE."
  (catch 'exit
    (unless enable-local-variables
      (throw 'exit (message "Directory-local variables are disabled")))

    (let ((variables-file (or (and (buffer-file-name)
				   (not (file-remote-p (buffer-file-name)))
				   (dir-locals-find-file (buffer-file-name)))
			      dir-locals-file))
	  variables)

      ;; Don't create ".dir-locals.el" for the deletion operation.
      (when (and (eq op 'delete)
		 (not (file-exists-p variables-file)))
	(throw 'exit (message "File .dir-locals.el not found")))

      (let ((auto-insert nil))
	(find-file variables-file))
      (widen)
      (goto-char (point-min))

      ;; Read alist of directory-local variables.
      (ignore-errors
	(delete-region
	 (prog1 (point)
	   (setq variables (let ((read-circle nil))
			     (read (current-buffer)))))
	 (point)))

      ;; Add or replace variable in alist of directory-local variables.
      (let ((mode-assoc (assoc mode variables)))
	(if mode-assoc
	    (setq variables
		  (cons (cons mode
			      (if (eq op 'delete)
				  (assq-delete-all variable (cdr mode-assoc))
				(cons
				 (cons variable value)
				 (if (memq variable '(mode eval))
				     (cdr mode-assoc)
				   (assq-delete-all variable (cdr mode-assoc))))))
			(assq-delete-all mode variables)))
	  (setq variables
		(cons `(,mode . ((,variable . ,value)))
		      variables))))

      ;; Insert modified alist of directory-local variables.
      (insert ";;; Directory Local Variables\n")
      (insert ";;; See Info node `(emacs) Directory Variables' for more information.\n\n")
      (pp (sort variables
		(lambda (a b)
		  (cond
		   ((null (car a)) t)
		   ((null (car b)) nil)
		   ((and (symbolp (car a)) (stringp (car b))) t)
		   ((and (symbolp (car b)) (stringp (car a))) nil)
		   (t (string< (car a) (car b))))))
	  (current-buffer)))))

;;;###autoload
(defun add-dir-local-variable (mode variable value)
  "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el."
  (interactive
   (let (variable)
     (list
      (read-file-local-variable-mode)
      (setq variable (read-file-local-variable "Add directory-local variable"))
      (read-file-local-variable-value variable))))
  (modify-dir-local-variable mode variable value 'add-or-replace))

;;;###autoload
(defun delete-dir-local-variable (mode variable)
  "Delete all MODE settings of file-local VARIABLE from .dir-locals.el."
  (interactive
   (list
    (read-file-local-variable-mode)
    (read-file-local-variable "Delete directory-local variable")))
  (modify-dir-local-variable mode variable nil 'delete))

;;;###autoload
(defun copy-file-locals-to-dir-locals ()
  "Copy file-local variables to .dir-locals.el."
  (interactive)
  (dolist (elt file-local-variables-alist)
    (unless (assq (car elt) dir-local-variables-alist)
      (add-dir-local-variable major-mode (car elt) (cdr elt)))))

;;;###autoload
(defun copy-dir-locals-to-file-locals ()
  "Copy directory-local variables to the Local Variables list."
  (interactive)
  (dolist (elt dir-local-variables-alist)
    (add-file-local-variable (car elt) (cdr elt))))

;;;###autoload
(defun copy-dir-locals-to-file-locals-prop-line ()
  "Copy directory-local variables to the -*- line."
  (interactive)
  (dolist (elt dir-local-variables-alist)
    (add-file-local-variable-prop-line (car elt) (cdr elt))))

\f

(provide 'files-x)

;; arch-tag: 949d263c-30a8-4b49-af26-cda97c7c5477
;;; files-x.el ends here
Commit	Line	Data
d7c9c715 JL	1	;;; files-x.el --- extended file handling commands
d7c9c715 JL	2
114f9c96	3	;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
d7c9c715 JL	4
	5	;; Author: Juri Linkov <juri@jurta.org>
	6	;; Maintainer: FSF
	7	;; Keywords: files
	8
	9	;; This file is part of GNU Emacs.
	10
	11	;; GNU Emacs is free software: you can redistribute it and/or modify
	12	;; it under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation, either version 3 of the License, or
	14	;; (at your option) any later version.
	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	23
	24	;;; Commentary:
	25
	26	;; This file defines additional infrequently used file- and
	27	;; directory-handling commands that should not be in files.el
	28	;; to not make the dumped image bigger.
	29
	30	;;; Code:
	31
	32	\f
	33	;;; Commands to add/delete file-local/directory-local variables.
	34
	35	(defun read-file-local-variable (prompt)
	36	"Read file-local variable using PROMPT and completion.
	37	Intended to be used in the `interactive' spec of
	38	`add-file-local-variable', `delete-file-local-variable',
	39	`add-dir-local-variable', `delete-dir-local-variable'."
	40	(let (default variable)
	41	(setq default (variable-at-point))
	42	(setq default (and (symbolp default) (boundp default)
	43	(symbol-name default)))
	44	(setq 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 (user-variable-p sym)
5c4634c1	52	(get sym 'safe-local-variable)
d7c9c715 JL	53	(memq sym '(mode eval coding unibyte))))
	54	nil nil nil default nil))
	55	(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	(let (default value)
	62	(cond
	63	((eq variable 'mode)
	64	(setq default (and (symbolp major-mode) (symbol-name major-mode)))
	65	(setq value
	66	(completing-read
	67	(if default
	68	(format "Add %s with value (default %s): " variable default)
	69	(format "Add %s with value: " variable))
	70	obarray
	71	(lambda (sym)
04e0f59b	72	(string-match-p "-mode\\'" (symbol-name sym)))
d7c9c715 JL	73	nil nil nil default nil))
	74	(and (stringp value)
	75	(intern (replace-regexp-in-string "-mode\\'" "" value))))
	76	((eq variable 'eval)
	77	(let ((minibuffer-completing-symbol t))
	78	(read-from-minibuffer (format "Add %s with expression: " variable)
	79	nil read-expression-map t
	80	'read-expression-history)))
	81	((eq variable 'coding)
	82	(setq default (and (symbolp buffer-file-coding-system)
	83	(symbol-name buffer-file-coding-system)))
	84	(read-coding-system
	85	(if default
	86	(format "Add %s with value (default %s): " variable default)
	87	(format "Add %s with value: " variable))
	88	default))
	89	(t
	90	(read (read-string (format "Add %s with value: " variable)
	91	nil 'set-variable-value-history
	92	(format "%S"
	93	(cond ((eq variable 'unibyte) t)
4d9b4323 JL	94	((boundp variable)
4d9b4323 JL	95	(symbol-value variable))))))))))
d7c9c715 JL	96
	97	(defun read-file-local-variable-mode ()
	98	"Read per-directory file-local variable's mode using completion.
	99	Intended to be used in the `interactive' spec of
	100	`add-dir-local-variable', `delete-dir-local-variable'."
	101	(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
	102	(mode
	103	(completing-read
	104	(if default
	105	(format "Mode or subdirectory (default %s): " default)
	106	(format "Mode or subdirectory: "))
	107	obarray
	108	(lambda (sym)
	109	(and (string-match-p "-mode\\'" (symbol-name sym))
	110	(not (string-match-p "-minor-mode\\'" (symbol-name sym)))))
	111	nil nil nil default nil)))
	112	(cond
	113	((equal mode "nil") nil)
	114	((and (stringp mode) (fboundp (intern mode))) (intern mode))
	115	(t mode))))
	116
	117	(defun modify-file-local-variable (variable value op)
	118	"Modify file-local VARIABLE in Local Variables depending on operation OP.
	119
	120	If OP is `add-or-replace' then delete all existing settings of
	121	VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
	122	with VALUE to the Local Variables list.
	123
	124	If there is no Local Variables list in the current file buffer and OP
	125	is not `delete' then this function adds the first line containing the
	126	string `Local Variables:' and the last line containing the string `End:'.
	127
	128	If OP is `delete' then delete all existing settings of VARIABLE
	129	from the Local Variables list ignoring the input argument VALUE."
	130	(catch 'exit
	131	(let ((beg (point)) end replaced-pos)
	132	(unless enable-local-variables
	133	(throw 'exit (message "File-local variables are disabled")))
	134
	135	;; Look for "Local variables:" line in last page.
	136	(widen)
	137	(goto-char (point-max))
	138	(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
	139
	140	;; Add "Local variables:" list if not found.
	141	(unless (let ((case-fold-search t))
	142	(search-forward "Local Variables:" nil t))
	143
	144	;; Don't add "Local variables:" list for the deletion operation.
	145	(when (eq op 'delete)
	146	(throw 'exit (progn (goto-char beg)
	147	(message "Local Variables not found"))))
	148
	149	(goto-char (point-max))
	150	(let ((comment-style 'plain)
	151	(comment-start (or comment-start ";;; ")))
	152	(comment-region
	153	(prog1 (setq beg (point))
	154	(insert "\nLocal Variables:\nEnd:\n"))
	155	(point)))
	156
	157	(unless (let ((case-fold-search t))
	158	(goto-char beg)
	159	(search-forward "Local Variables:" nil t))
160	(throw 'exit (message "Can't add file-local variables"))))
161
162	;; prefix is what comes before "local variables:" in its line.
163	;; suffix is what comes after "local variables:" in its line.
164	(let* ((prefix (buffer-substring (line-beginning-position)
165	(match-beginning 0)))
166	(suffix (buffer-substring (point) (line-end-position)))
167	(prefix-re (concat "^" (regexp-quote prefix)))
168	(suffix-re (concat (regexp-quote suffix) "$")))
169
170	;; Find or add missing "End:".
171	(forward-line 1)
172	(setq beg (point))
173	(save-excursion
174	(unless (let ((case-fold-search t))
175	(re-search-forward
176	(concat prefix-re "[ \t]End:[ \t]" suffix-re)
177	nil t))
178	(save-excursion
179	(insert (format "%sEnd:%s\n" prefix suffix))))
180	(beginning-of-line)
181	(setq end (point-marker)))
182
183	;; Find and delete all existing variable/value pairs.
184	(when (member op '(add-or-replace delete))
185	(if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
186	(goto-char end)
187	(goto-char beg)
188	(while (re-search-forward
189	(format "%s%S:.*%s" prefix-re variable suffix-re) end t)
190	(delete-region (match-beginning 0) (1+ (match-end 0)))
191	(setq replaced-pos (point)))))
192
193	;; Add a new variable/value pair. Add `mode' to the start, add new
194	;; variable to the end, and add a replaced variable to its last location.
195	(when (eq op 'add-or-replace)
196	(cond
197	((eq variable 'mode) (goto-char beg))
198	((null replaced-pos) (goto-char end))
199	(replaced-pos (goto-char replaced-pos)))
200	(insert (format "%s%S: %S%s\n" prefix variable value suffix)))))))
201
202	;;;###autoload
203	(defun add-file-local-variable (variable value)
204	"Add file-local VARIABLE with its VALUE to the Local Variables list.
205
206	This command deletes all existing settings of VARIABLE (except `mode'
207	and `eval') and adds a new file-local VARIABLE with VALUE to the
208	Local Variables list.
209
210	If there is no Local Variables list in the current file buffer
211	then this function adds the first line containing the string
212	`Local Variables:' and the last line containing the string `End:'."
213	(interactive
214	(let ((variable (read-file-local-variable "Add file-local variable")))
215	(list variable (read-file-local-variable-value variable))))
216	(modify-file-local-variable variable value 'add-or-replace))
217
218	;;;###autoload
219	(defun delete-file-local-variable (variable)
220	"Delete all settings of file-local VARIABLE from the Local Variables list."
221	(interactive
222	(list (read-file-local-variable "Delete file-local variable")))
223	(modify-file-local-variable variable nil 'delete))
224
225	(defun modify-file-local-variable-prop-line (variable value op)
226	"Modify file-local VARIABLE in the -*- line depending on operation OP.
227
228	If OP is `add-or-replace' then delete all existing settings of
229	VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
230	with VALUE to the -*- line.
231
232	If there is no -*- line at the beginning of the current file buffer
233	and OP is not `delete' then this function adds the -*- line.
234
235	If OP is `delete' then delete all existing settings of VARIABLE
236	from the -*- line ignoring the input argument VALUE."
237	(catch 'exit
238	(let ((beg (point)) end replaced-pos)
239	(unless enable-local-variables
240	(throw 'exit (message "File-local variables are disabled")))
241
242	;; Find the -*- line at the beginning of the current buffer.
243	(widen)
244	(goto-char (point-min))
245	(setq end (set-auto-mode-1))
246
247	(if end
248	(setq beg (point-marker) end (copy-marker end))
249
250	;; Add the -*- line if not found.
251	;; Don't add the -*- line for the deletion operation.
252	(when (eq op 'delete)
253	(throw 'exit (progn (goto-char beg)
254	(message "The -*- line not found"))))
255
256	(goto-char (point-min))
257
258	;; Skip interpreter magic line "#!"
259	(when (looking-at "^\\(#!\\\|'\\\\\"\\)")
260	(forward-line 1))
261
262	(let ((comment-style 'plain)
263	(comment-start (or comment-start ";;; ")))
264	(comment-region
265	(prog1 (point)
266	(insert "-*-")
267	(setq beg (point-marker))
268	(setq end (point-marker))
269	(insert "-*-\n"))
270	(point))))
271
272	(cond
273	((looking-at "[ \t]\\([^ \t\n\r:;]+\\)\\([ \t]-\\*-\\)")
274	;; Simple form: "-- MODENAME --".
275	(if (eq variable 'mode)
276	;; Replace or delete MODENAME
277	(progn
278	(when (member op '(add-or-replace delete))
279	(delete-region (match-beginning 1) (match-end 1)))
280	(when (eq op 'add-or-replace)
281	(goto-char (match-beginning 1))
282	(insert (format "%S" value))))
283	;; Else, turn `MODENAME' into `mode:MODENAME'
284	;; and add `VARIABLE: VALUE;'
285	(goto-char (match-beginning 2))
286	(insert (format "; %S: %S; " variable value))
287	(goto-char (match-beginning 1))
288	(insert " mode: ")))
289
290	(t
291	;; Hairy form: '--' [ <variable> ':' <value> ';' ] '-*-'
292	;; Find and delete all existing variable/value pairs.
293	(when (member op '(add-or-replace delete))
294	(if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
295	(goto-char end)
296	(goto-char beg)
297	(while (< (point) end)
298	(or (looking-at "[ \t]\\([^ \t\n:]+\\)[ \t]:[ \t]*")
299	(throw 'exit (message "Malformed -*- line")))
300	(goto-char (match-end 0))
301	(let ((key (intern (match-string 1)))
302	(val (save-restriction
303	(narrow-to-region (point) end)
304	(let ((read-circle nil))
305	(read (current-buffer))))))
306	(skip-chars-forward " \t;")
307	(when (eq key variable)
308	(delete-region (match-beginning 0) (point))
309	(setq replaced-pos (point)))))))
310	;; Add a new variable/value pair. Add `mode' to the start, add new
311	;; variable to the end, and add a replaced variable to its last location.
312	(when (eq op 'add-or-replace)
313	(cond
314	((eq variable 'mode) (goto-char beg))
315	((null replaced-pos) (goto-char end))
316	(replaced-pos (goto-char replaced-pos)))
317	(if (and (not (eq (char-before) ?\;))
318	(not (equal (point) (marker-position beg))))
319	(insert ";"))
320	(unless (eq (char-before) ?\s) (insert " "))
321	(insert (format "%S: %S;" variable value))
322	(unless (eq (char-after) ?\s) (insert " "))))))))
323
324	;;;###autoload
325	(defun add-file-local-variable-prop-line (variable value)
326	"Add file-local VARIABLE with its VALUE to the -*- line.
327
328	This command deletes all existing settings of VARIABLE (except `mode'
329	and `eval') and adds a new file-local VARIABLE with VALUE to
330	the -*- line.
331
332	If there is no -*- line at the beginning of the current file buffer
333	then this function adds it."
334	(interactive
335	(let ((variable (read-file-local-variable "Add -*- file-local variable")))
336	(list variable (read-file-local-variable-value variable))))
337	(modify-file-local-variable-prop-line variable value 'add-or-replace))
338
339	;;;###autoload
340	(defun delete-file-local-variable-prop-line (variable)
341	"Delete all settings of file-local VARIABLE from the -*- line."
342	(interactive
343	(list (read-file-local-variable "Delete -*- file-local variable")))
344	(modify-file-local-variable-prop-line variable nil 'delete))
345
346	(defun modify-dir-local-variable (mode variable value op)
347	"Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.
348
349	If OP is `add-or-replace' then delete all existing settings of
350	VARIABLE (except `mode' and `eval') and add a new directory-local VARIABLE
351	with VALUE to the MODE alist where MODE can be a mode name symbol or
352	a subdirectory name.
353
354	If .dir-locals.el was not found and OP is not `delete' then create
355	this file in the current directory.
356
357	If OP is `delete' then delete all existing settings of VARIABLE
a30e71ae	358	from the MODE alist ignoring the input argument VALUE."
d7c9c715 JL	359	(catch 'exit
	360	(unless enable-local-variables
	361	(throw 'exit (message "Directory-local variables are disabled")))
	362
	363	(let ((variables-file (or (and (buffer-file-name)
	364	(not (file-remote-p (buffer-file-name)))
	365	(dir-locals-find-file (buffer-file-name)))
	366	dir-locals-file))
	367	variables)
	368
	369	;; Don't create ".dir-locals.el" for the deletion operation.
	370	(when (and (eq op 'delete)
	371	(not (file-exists-p variables-file)))
	372	(throw 'exit (message "File .dir-locals.el not found")))
	373
	374	(let ((auto-insert nil))
	375	(find-file variables-file))
	376	(widen)
	377	(goto-char (point-min))
	378
	379	;; Read alist of directory-local variables.
	380	(ignore-errors
	381	(delete-region
	382	(prog1 (point)
	383	(setq variables (let ((read-circle nil))
	384	(read (current-buffer)))))
	385	(point)))
	386
	387	;; Add or replace variable in alist of directory-local variables.
	388	(let ((mode-assoc (assoc mode variables)))
	389	(if mode-assoc
	390	(setq variables
	391	(cons (cons mode
	392	(if (eq op 'delete)
	393	(assq-delete-all variable (cdr mode-assoc))
	394	(cons
	395	(cons variable value)
	396	(if (memq variable '(mode eval))
	397	(cdr mode-assoc)
	398	(assq-delete-all variable (cdr mode-assoc))))))
	399	(assq-delete-all mode variables)))
	400	(setq variables
	401	(cons `(,mode . ((,variable . ,value)))
	402	variables))))
	403
	404	;; Insert modified alist of directory-local variables.
	405	(insert ";;; Directory Local Variables\n")
	406	(insert ";;; See Info node `(emacs) Directory Variables' for more information.\n\n")
	407	(pp (sort variables
	408	(lambda (a b)
	409	(cond
	410	((null (car a)) t)
	411	((null (car b)) nil)
	412	((and (symbolp (car a)) (stringp (car b))) t)
	413	((and (symbolp (car b)) (stringp (car a))) nil)
	414	(t (string< (car a) (car b))))))
	415	(current-buffer)))))
	416
	417	;;;###autoload
	418	(defun add-dir-local-variable (mode variable value)
	419	"Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el."
	420	(interactive
	421	(let (variable)
	422	(list
423	(read-file-local-variable-mode)
424	(setq variable (read-file-local-variable "Add directory-local variable"))
425	(read-file-local-variable-value variable))))
426	(modify-dir-local-variable mode variable value 'add-or-replace))
427
428	;;;###autoload
429	(defun delete-dir-local-variable (mode variable)
430	"Delete all MODE settings of file-local VARIABLE from .dir-locals.el."
431	(interactive
432	(list
433	(read-file-local-variable-mode)
434	(read-file-local-variable "Delete directory-local variable")))
435	(modify-dir-local-variable mode variable nil 'delete))
436
437	;;;###autoload
438	(defun copy-file-locals-to-dir-locals ()
439	"Copy file-local variables to .dir-locals.el."
440	(interactive)
441	(dolist (elt file-local-variables-alist)
442	(unless (assq (car elt) dir-local-variables-alist)
443	(add-dir-local-variable major-mode (car elt) (cdr elt)))))
444
445	;;;###autoload
446	(defun copy-dir-locals-to-file-locals ()
447	"Copy directory-local variables to the Local Variables list."
448	(interactive)
449	(dolist (elt dir-local-variables-alist)
450	(add-file-local-variable (car elt) (cdr elt))))
451
452	;;;###autoload
453	(defun copy-dir-locals-to-file-locals-prop-line ()
a30e71ae	454	"Copy directory-local variables to the -*- line."
d7c9c715 JL	455	(interactive)
	456	(dolist (elt dir-local-variables-alist)
	457	(add-file-local-variable-prop-line (car elt) (cdr elt))))
	458
	459	\f
	460
	461	(provide 'files-x)
86a0ed4c MB	462
86a0ed4c MB	463	;; arch-tag: 949d263c-30a8-4b49-af26-cda97c7c5477
d7c9c715	464	;;; files-x.el ends here