lisp/files-x.el

   1 ;;; files-x.el --- extended file handling commands
   2
   3 ;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Juri Linkov <juri@jurta.org>
   6 ;; Maintainer: FSF
   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 \f
  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   (let (default variable)
  42     (setq default (variable-at-point))
  43     (setq default (and (symbolp default) (boundp default)
  44                        (symbol-name default)))
  45     (setq variable
  46           (completing-read
  47            (if default
  48                (format "%s (default %s): " prompt default)
  49              (format "%s: " prompt))
  50            obarray
  51            (lambda (sym)
  52              (or (custom-variable-p sym)
  53                  (get sym 'safe-local-variable)
  54                  (memq sym '(mode eval coding unibyte))))
  55            nil nil nil default nil))
  56     (and (stringp variable) (intern variable))))
  57
  58 (defun read-file-local-variable-value (variable)
  59   "Read value of file-local VARIABLE using completion.
  60 Intended to be used in the `interactive' spec of
  61 `add-file-local-variable' and `add-dir-local-variable'."
  62   (let (default value)
  63     (cond
  64      ((eq variable 'mode)
  65       (setq default (and (symbolp major-mode) (symbol-name major-mode)))
  66       (setq value
  67             (completing-read
  68              (if default
  69                  (format "Add %s with value (default %s): " variable default)
  70                (format "Add %s with value: " variable))
  71              obarray
  72              (lambda (sym)
  73                (string-match-p "-mode\\'" (symbol-name sym)))
  74              nil nil nil default nil))
  75       (and (stringp value)
  76            (intern (replace-regexp-in-string "-mode\\'" "" value))))
  77      ((eq variable 'eval)
  78       (let ((minibuffer-completing-symbol t))
  79         (read-from-minibuffer (format "Add %s with expression: " variable)
  80                               nil read-expression-map t
  81                               'read-expression-history)))
  82      ((eq variable 'coding)
  83       (setq default (and (symbolp buffer-file-coding-system)
  84                          (symbol-name buffer-file-coding-system)))
  85       (read-coding-system
  86        (if default
  87            (format "Add %s with value (default %s): " variable default)
  88          (format "Add %s with value: " variable))
  89        default))
  90      (t
  91       (read (read-string (format "Add %s with value: " variable)
  92                          nil 'set-variable-value-history
  93                          (format "%S"
  94                                  (cond ((eq variable 'unibyte) t)
  95                                        ((boundp variable)
  96                                         (symbol-value variable))))))))))
  97
  98 (defun read-file-local-variable-mode ()
  99   "Read per-directory file-local variable's mode using completion.
 100 Intended to be used in the `interactive' spec of
 101 `add-dir-local-variable', `delete-dir-local-variable'."
 102   (let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
 103          (mode
 104           (completing-read
 105            (if default
 106                (format "Mode or subdirectory (default %s): " default)
 107              (format "Mode or subdirectory: "))
 108            obarray
 109            (lambda (sym)
 110              (and (string-match-p "-mode\\'" (symbol-name sym))
 111                   (not (string-match-p "-minor-mode\\'" (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))))
 117
 118 (defun modify-file-local-variable (variable value op)
 119   "Modify file-local VARIABLE in Local Variables depending on operation OP.
 120
 121 If OP is `add-or-replace' then delete all existing settings of
 122 VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
 123 with VALUE to the Local Variables list.
 124
 125 If there is no Local Variables list in the current file buffer and OP
 126 is not `delete' then this function adds the first line containing the
 127 string `Local Variables:' and the last line containing the string `End:'.
 128
 129 If OP is `delete' then delete all existing settings of VARIABLE
 130 from the Local Variables list ignoring the input argument VALUE."
 131   (catch 'exit
 132     (let ((beg (point)) end replaced-pos)
 133       (unless enable-local-variables
 134         (throw 'exit (message "File-local variables are disabled")))
 135
 136       ;; Look for "Local variables:" line in last page.
 137       (widen)
 138       (goto-char (point-max))
 139       (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
 140
 141       ;; Add "Local variables:" list if not found.
 142       (unless (let ((case-fold-search t))
 143                 (search-forward "Local Variables:" nil t))
 144
 145         ;; Don't add "Local variables:" list for the deletion operation.
 146         (when (eq op 'delete)
 147           (throw 'exit (progn (goto-char beg)
 148                               (message "Local Variables not found"))))
 149
 150         (goto-char (point-max))
 151         (let ((comment-style 'plain)
 152               (comment-start (or comment-start ";; ")))
 153           (comment-region
 154            (prog1 (setq beg (point))
 155              (insert "\nLocal Variables:\nEnd:\n"))
 156            (point)))
 157
 158         (unless (let ((case-fold-search t))
 159                   (goto-char beg)
 160                   (search-forward "Local Variables:" nil t))
 161           (throw 'exit (message "Can't add file-local variables"))))
 162
 163       ;; prefix is what comes before "local variables:" in its line.
 164       ;; suffix is what comes after "local variables:" in its line.
 165       (let* ((prefix (buffer-substring (line-beginning-position)
 166                                        (match-beginning 0)))
 167              (suffix (buffer-substring (point) (line-end-position)))
 168              (prefix-re (concat "^" (regexp-quote prefix)))
 169              (suffix-re (concat (regexp-quote suffix) "$")))
 170
 171         ;; Find or add missing "End:".
 172         (forward-line 1)
 173         (setq beg (point))
 174         (save-excursion
 175           (unless (let ((case-fold-search t))
 176                     (re-search-forward
 177                      (concat prefix-re "[ \t]*End:[ \t]*" suffix-re)
 178                      nil t))
 179             (save-excursion
 180               (insert (format "%sEnd:%s\n" prefix suffix))))
 181           (beginning-of-line)
 182           (setq end (point-marker)))
 183
 184         ;; Find and delete all existing variable/value pairs.
 185         (when (member op '(add-or-replace delete))
 186           (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
 187               (goto-char end)
 188             (goto-char beg)
 189             (while (re-search-forward
 190                     (format "%s%S:.*%s" prefix-re variable suffix-re) end t)
 191               (delete-region (match-beginning 0) (1+ (match-end 0)))
 192               (setq replaced-pos (point)))))
 193
 194         ;; Add a new variable/value pair.  Add `mode' to the start, add new
 195         ;; variable to the end, and add a replaced variable to its last location.
 196         (when (eq op 'add-or-replace)
 197           (cond
 198            ((eq variable 'mode) (goto-char beg))
 199            ((null replaced-pos) (goto-char end))
 200            (replaced-pos (goto-char replaced-pos)))
 201           (insert (format "%s%S: %S%s\n" prefix variable value suffix)))))))
 202
 203 ;;;###autoload
 204 (defun add-file-local-variable (variable value)
 205   "Add file-local VARIABLE with its VALUE to the Local Variables list.
 206
 207 This command deletes all existing settings of VARIABLE (except `mode'
 208 and `eval') and adds a new file-local VARIABLE with VALUE to the
 209 Local Variables list.
 210
 211 If there is no Local Variables list in the current file buffer
 212 then this function adds the first line containing the string
 213 `Local Variables:' and the last line containing the string `End:'."
 214   (interactive
 215    (let ((variable (read-file-local-variable "Add file-local variable")))
 216      (list variable (read-file-local-variable-value variable))))
 217   (modify-file-local-variable variable value 'add-or-replace))
 218
 219 ;;;###autoload
 220 (defun delete-file-local-variable (variable)
 221   "Delete all settings of file-local VARIABLE from the Local Variables list."
 222   (interactive
 223    (list (read-file-local-variable "Delete file-local variable")))
 224   (modify-file-local-variable variable nil 'delete))
 225
 226 (defun modify-file-local-variable-prop-line (variable value op)
 227   "Modify file-local VARIABLE in the -*- line depending on operation OP.
 228
 229 If OP is `add-or-replace' then delete all existing settings of
 230 VARIABLE (except `mode' and `eval') and add a new file-local VARIABLE
 231 with VALUE to the -*- line.
 232
 233 If there is no -*- line at the beginning of the current file buffer
 234 and OP is not `delete' then this function adds the -*- line.
 235
 236 If OP is `delete' then delete all existing settings of VARIABLE
 237 from the -*- line ignoring the input argument VALUE."
 238   (catch 'exit
 239     (let ((beg (point)) end replaced-pos)
 240       (unless enable-local-variables
 241         (throw 'exit (message "File-local variables are disabled")))
 242
 243       ;; Find the -*- line at the beginning of the current buffer.
 244       (widen)
 245       (goto-char (point-min))
 246       (setq end (set-auto-mode-1))
 247
 248       (if end
 249           (setq beg (point-marker) end (copy-marker end))
 250
 251         ;; Add the -*- line if not found.
 252         ;; Don't add the -*- line for the deletion operation.
 253         (when (eq op 'delete)
 254           (throw 'exit (progn (goto-char beg)
 255                               (message "The -*- line not found"))))
 256
 257         (goto-char (point-min))
 258
 259         ;; Skip interpreter magic line "#!" or XML declaration.
 260         (when (or (looking-at file-auto-mode-skip)
 261                   (looking-at "<\\?xml[^>\n]*>$"))
 262           (forward-line 1))
 263
 264         (comment-normalize-vars)
 265         (let ((comment-style 'plain)
 266               (comment-start (or comment-start ";;; "))
 267               (line-beg (line-beginning-position))
 268               (ce nil))
 269           ;; If the first line contains a comment.
 270           (if (save-excursion
 271                 (and (looking-at comment-start-skip)
 272                      (goto-char (match-end 0))
 273                      (re-search-forward comment-end-skip)
 274                      (goto-char (match-beginning 0))
 275                      ;; Still on the same line?
 276                      (equal line-beg (line-beginning-position))
 277                      (setq ce (point))))
 278               ;; Add local variables to the end of the existing comment.
 279               (progn
 280                 (goto-char ce)
 281                 (insert "  -*-")
 282                 (setq beg (point-marker))
 283                 (setq end (point-marker))
 284                 (insert "-*-"))
 285             ;; Otherwise, add a new comment before the first line.
 286             (comment-region
 287              (prog1 (point)
 288                (insert "-*-")
 289                (setq beg (point-marker))
 290                (setq end (point-marker))
 291                (insert "-*-\n"))
 292              (point)))))
 293
 294       (cond
 295        ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
 296         ;; Simple form: "-*- MODENAME -*-".
 297         (if (eq variable 'mode)
 298             ;; Replace or delete MODENAME
 299             (progn
 300               (when (member op '(add-or-replace delete))
 301                 (delete-region (match-beginning 1) (match-end 1)))
 302               (when (eq op 'add-or-replace)
 303                 (goto-char (match-beginning 1))
 304                 (insert (format "%S" value))))
 305           ;; Else, turn `MODENAME' into `mode:MODENAME'
 306           ;; and add `VARIABLE: VALUE;'
 307           (goto-char (match-beginning 2))
 308           (insert (format "; %S: %S; " variable value))
 309           (goto-char (match-beginning 1))
 310           (insert " mode: ")))
 311
 312        (t
 313         ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
 314         ;; Find and delete all existing variable/value pairs.
 315         (when (member op '(add-or-replace delete))
 316           (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
 317               (goto-char end)
 318             (goto-char beg)
 319             (while (< (point) end)
 320               (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
 321                   (throw 'exit (message "Malformed -*- line")))
 322               (goto-char (match-end 0))
 323               (let ((key (intern (match-string 1))))
 324                 (save-restriction
 325                   (narrow-to-region (point) end)
 326                   (let ((read-circle nil))
 327                     (read (current-buffer))))
 328                 (skip-chars-forward " \t;")
 329                 (when (eq key variable)
 330                   (delete-region (match-beginning 0) (point))
 331                   (setq replaced-pos (point)))))))
 332         ;; Add a new variable/value pair.  Add `mode' to the start, add new
 333         ;; variable to the end, and add a replaced variable to its last location.
 334         (when (eq op 'add-or-replace)
 335           (cond
 336            ((eq variable 'mode) (goto-char beg))
 337            ((null replaced-pos) (goto-char end))
 338            (replaced-pos (goto-char replaced-pos)))
 339           (if (and (not (eq (char-before) ?\;))
 340                    (not (equal (point) (marker-position beg))))
 341               (insert ";"))
 342           (unless (eq (char-before) ?\s) (insert " "))
 343           (insert (format "%S: %S;" variable value))
 344           (unless (eq (char-after) ?\s) (insert " "))))))))
 345
 346 ;;;###autoload
 347 (defun add-file-local-variable-prop-line (variable value)
 348   "Add file-local VARIABLE with its VALUE to the -*- line.
 349
 350 This command deletes all existing settings of VARIABLE (except `mode'
 351 and `eval') and adds a new file-local VARIABLE with VALUE to
 352 the -*- line.
 353
 354 If there is no -*- line at the beginning of the current file buffer
 355 then this function adds it."
 356   (interactive
 357    (let ((variable (read-file-local-variable "Add -*- file-local variable")))
 358      (list variable (read-file-local-variable-value variable))))
 359   (modify-file-local-variable-prop-line variable value 'add-or-replace))
 360
 361 ;;;###autoload
 362 (defun delete-file-local-variable-prop-line (variable)
 363   "Delete all settings of file-local VARIABLE from the -*- line."
 364   (interactive
 365    (list (read-file-local-variable "Delete -*- file-local variable")))
 366   (modify-file-local-variable-prop-line variable nil 'delete))
 367
 368 (defvar auto-insert) ; from autoinsert.el
 369
 370 (defun modify-dir-local-variable (mode variable value op)
 371   "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.
 372
 373 If OP is `add-or-replace' then delete all existing settings of
 374 VARIABLE (except `mode' and `eval') and add a new directory-local VARIABLE
 375 with VALUE to the MODE alist where MODE can be a mode name symbol or
 376 a subdirectory name.
 377
 378 If .dir-locals.el was not found and OP is not `delete' then create
 379 this file in the current directory.
 380
 381 If OP is `delete' then delete all existing settings of VARIABLE
 382 from the MODE alist ignoring the input argument VALUE."
 383   (catch 'exit
 384     (unless enable-local-variables
 385       (throw 'exit (message "Directory-local variables are disabled")))
 386     (let ((variables-file (or (and (buffer-file-name)
 387                                    (not (file-remote-p (buffer-file-name)))
 388                                    (dir-locals-find-file (buffer-file-name)))
 389                               dir-locals-file))
 390           variables)
 391       (if (consp variables-file)        ; result from cache
 392           ;; If cache element has an mtime, assume it came from a file.
 393           ;; Otherwise, assume it was set directly.
 394           (setq variables-file (if (nth 2 variables-file)
 395                                    (expand-file-name dir-locals-file
 396                                                      (car variables-file))
 397                                  (cadr variables-file))))
 398       ;; I can't be bothered to handle this case right now.
 399       ;; Dir locals were set directly from a class.  You need to
 400       ;; directly modify the class in dir-locals-class-alist.
 401       (and variables-file (not (stringp variables-file))
 402            (throw 'exit (message "Directory locals were not set from a file")))
 403       ;; Don't create ".dir-locals.el" for the deletion operation.
 404       (and (eq op 'delete)
 405            (or (not variables-file)
 406                (not (file-exists-p variables-file)))
 407            (throw 'exit (message "No .dir-locals.el file was found")))
 408       (let ((auto-insert nil))
 409         (find-file variables-file))
 410       (widen)
 411       (goto-char (point-min))
 412
 413       ;; Read alist of directory-local variables.
 414       (ignore-errors
 415         (delete-region
 416          (prog1 (point)
 417            (setq variables (let ((read-circle nil))
 418                              (read (current-buffer)))))
 419          (point)))
 420
 421       ;; Add or replace variable in alist of directory-local variables.
 422       (let ((mode-assoc (assoc mode variables)))
 423         (if mode-assoc
 424             (setq variables
 425                   (cons (cons mode
 426                               (if (eq op 'delete)
 427                                   (assq-delete-all variable (cdr mode-assoc))
 428                                 (cons
 429                                  (cons variable value)
 430                                  (if (memq variable '(mode eval))
 431                                      (cdr mode-assoc)
 432                                    (assq-delete-all variable (cdr mode-assoc))))))
 433                         (assq-delete-all mode variables)))
 434           (setq variables
 435                 (cons `(,mode . ((,variable . ,value)))
 436                       variables))))
 437
 438       ;; Insert modified alist of directory-local variables.
 439       (insert ";;; Directory Local Variables\n")
 440       (insert ";;; See Info node `(emacs) Directory Variables' for more information.\n\n")
 441       (pp (sort variables
 442                 (lambda (a b)
 443                   (cond
 444                    ((null (car a)) t)
 445                    ((null (car b)) nil)
 446                    ((and (symbolp (car a)) (stringp (car b))) t)
 447                    ((and (symbolp (car b)) (stringp (car a))) nil)
 448                    (t (string< (car a) (car b))))))
 449           (current-buffer)))))
 450
 451 ;;;###autoload
 452 (defun add-dir-local-variable (mode variable value)
 453   "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el."
 454   (interactive
 455    (let (variable)
 456      (list
 457       (read-file-local-variable-mode)
 458       (setq variable (read-file-local-variable "Add directory-local variable"))
 459       (read-file-local-variable-value variable))))
 460   (modify-dir-local-variable mode variable value 'add-or-replace))
 461
 462 ;;;###autoload
 463 (defun delete-dir-local-variable (mode variable)
 464   "Delete all MODE settings of file-local VARIABLE from .dir-locals.el."
 465   (interactive
 466    (list
 467     (read-file-local-variable-mode)
 468     (read-file-local-variable "Delete directory-local variable")))
 469   (modify-dir-local-variable mode variable nil 'delete))
 470
 471 ;;;###autoload
 472 (defun copy-file-locals-to-dir-locals ()
 473   "Copy file-local variables to .dir-locals.el."
 474   (interactive)
 475   (dolist (elt file-local-variables-alist)
 476     (unless (assq (car elt) dir-local-variables-alist)
 477       (add-dir-local-variable major-mode (car elt) (cdr elt)))))
 478
 479 ;;;###autoload
 480 (defun copy-dir-locals-to-file-locals ()
 481   "Copy directory-local variables to the Local Variables list."
 482   (interactive)
 483   (dolist (elt dir-local-variables-alist)
 484     (add-file-local-variable (car elt) (cdr elt))))
 485
 486 ;;;###autoload
 487 (defun copy-dir-locals-to-file-locals-prop-line ()
 488   "Copy directory-local variables to the -*- line."
 489   (interactive)
 490   (dolist (elt dir-local-variables-alist)
 491     (add-file-local-variable-prop-line (car elt) (cdr elt))))
 492
 493 \f
 494
 495 (provide 'files-x)
 496
 497 ;;; files-x.el ends here