lisp/files-x.el

   1 ;;; files-x.el --- extended file handling commands
   2
   3 ;; Copyright (C) 2009-2012 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 (user-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 "#!"
 260         (when (looking-at "^\\(#!\\|'\\\\\"\\)")
 261           (forward-line 1))
 262
 263         (let ((comment-style 'plain)
 264               (comment-start (or comment-start ";;; ")))
 265           (comment-region
 266            (prog1 (point)
 267              (insert "-*-")
 268              (setq beg (point-marker))
 269              (setq end (point-marker))
 270              (insert "-*-\n"))
 271            (point))))
 272
 273       (cond
 274        ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
 275         ;; Simple form: "-*- MODENAME -*-".
 276         (if (eq variable 'mode)
 277             ;; Replace or delete MODENAME
 278             (progn
 279               (when (member op '(add-or-replace delete))
 280                 (delete-region (match-beginning 1) (match-end 1)))
 281               (when (eq op 'add-or-replace)
 282                 (goto-char (match-beginning 1))
 283                 (insert (format "%S" value))))
 284           ;; Else, turn `MODENAME' into `mode:MODENAME'
 285           ;; and add `VARIABLE: VALUE;'
 286           (goto-char (match-beginning 2))
 287           (insert (format "; %S: %S; " variable value))
 288           (goto-char (match-beginning 1))
 289           (insert " mode: ")))
 290
 291        (t
 292         ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
 293         ;; Find and delete all existing variable/value pairs.
 294         (when (member op '(add-or-replace delete))
 295           (if (and (eq op 'add-or-replace) (memq variable '(mode eval)))
 296               (goto-char end)
 297             (goto-char beg)
 298             (while (< (point) end)
 299               (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
 300                   (throw 'exit (message "Malformed -*- line")))
 301               (goto-char (match-end 0))
 302               (let ((key (intern (match-string 1))))
 303                 (save-restriction
 304                   (narrow-to-region (point) end)
 305                   (let ((read-circle nil))
 306                     (read (current-buffer))))
 307                 (skip-chars-forward " \t;")
 308                 (when (eq key variable)
 309                   (delete-region (match-beginning 0) (point))
 310                   (setq replaced-pos (point)))))))
 311         ;; Add a new variable/value pair.  Add `mode' to the start, add new
 312         ;; variable to the end, and add a replaced variable to its last location.
 313         (when (eq op 'add-or-replace)
 314           (cond
 315            ((eq variable 'mode) (goto-char beg))
 316            ((null replaced-pos) (goto-char end))
 317            (replaced-pos (goto-char replaced-pos)))
 318           (if (and (not (eq (char-before) ?\;))
 319                    (not (equal (point) (marker-position beg))))
 320               (insert ";"))
 321           (unless (eq (char-before) ?\s) (insert " "))
 322           (insert (format "%S: %S;" variable value))
 323           (unless (eq (char-after) ?\s) (insert " "))))))))
 324
 325 ;;;###autoload
 326 (defun add-file-local-variable-prop-line (variable value)
 327   "Add file-local VARIABLE with its VALUE to the -*- line.
 328
 329 This command deletes all existing settings of VARIABLE (except `mode'
 330 and `eval') and adds a new file-local VARIABLE with VALUE to
 331 the -*- line.
 332
 333 If there is no -*- line at the beginning of the current file buffer
 334 then this function adds it."
 335   (interactive
 336    (let ((variable (read-file-local-variable "Add -*- file-local variable")))
 337      (list variable (read-file-local-variable-value variable))))
 338   (modify-file-local-variable-prop-line variable value 'add-or-replace))
 339
 340 ;;;###autoload
 341 (defun delete-file-local-variable-prop-line (variable)
 342   "Delete all settings of file-local VARIABLE from the -*- line."
 343   (interactive
 344    (list (read-file-local-variable "Delete -*- file-local variable")))
 345   (modify-file-local-variable-prop-line variable nil 'delete))
 346
 347 (defvar auto-insert) ; from autoinsert.el
 348
 349 (defun modify-dir-local-variable (mode variable value op)
 350   "Modify directory-local VARIABLE in .dir-locals.el depending on operation OP.
 351
 352 If OP is `add-or-replace' then delete all existing settings of
 353 VARIABLE (except `mode' and `eval') and add a new directory-local VARIABLE
 354 with VALUE to the MODE alist where MODE can be a mode name symbol or
 355 a subdirectory name.
 356
 357 If .dir-locals.el was not found and OP is not `delete' then create
 358 this file in the current directory.
 359
 360 If OP is `delete' then delete all existing settings of VARIABLE
 361 from the MODE alist ignoring the input argument VALUE."
 362   (catch 'exit
 363     (unless enable-local-variables
 364       (throw 'exit (message "Directory-local variables are disabled")))
 365     (let ((variables-file (or (and (buffer-file-name)
 366                                    (not (file-remote-p (buffer-file-name)))
 367                                    (dir-locals-find-file (buffer-file-name)))
 368                               dir-locals-file))
 369           variables)
 370       (if (consp variables-file)        ; result from cache
 371           ;; If cache element has an mtime, assume it came from a file.
 372           ;; Otherwise, assume it was set directly.
 373           (setq variables-file (if (nth 2 variables-file)
 374                                    (expand-file-name dir-locals-file
 375                                                      (car variables-file))
 376                                  (cadr variables-file))))
 377       ;; I can't be bothered to handle this case right now.
 378       ;; Dir locals were set directly from a class.  You need to
 379       ;; directly modify the class in dir-locals-class-alist.
 380       (and variables-file (not (stringp variables-file))
 381            (throw 'exit (message "Directory locals were not set from a file")))
 382       ;; Don't create ".dir-locals.el" for the deletion operation.
 383       (and (eq op 'delete)
 384            (or (not variables-file)
 385                (not (file-exists-p variables-file)))
 386            (throw 'exit (message "No .dir-locals.el file was found")))
 387       (let ((auto-insert nil))
 388         (find-file variables-file))
 389       (widen)
 390       (goto-char (point-min))
 391
 392       ;; Read alist of directory-local variables.
 393       (ignore-errors
 394         (delete-region
 395          (prog1 (point)
 396            (setq variables (let ((read-circle nil))
 397                              (read (current-buffer)))))
 398          (point)))
 399
 400       ;; Add or replace variable in alist of directory-local variables.
 401       (let ((mode-assoc (assoc mode variables)))
 402         (if mode-assoc
 403             (setq variables
 404                   (cons (cons mode
 405                               (if (eq op 'delete)
 406                                   (assq-delete-all variable (cdr mode-assoc))
 407                                 (cons
 408                                  (cons variable value)
 409                                  (if (memq variable '(mode eval))
 410                                      (cdr mode-assoc)
 411                                    (assq-delete-all variable (cdr mode-assoc))))))
 412                         (assq-delete-all mode variables)))
 413           (setq variables
 414                 (cons `(,mode . ((,variable . ,value)))
 415                       variables))))
 416
 417       ;; Insert modified alist of directory-local variables.
 418       (insert ";;; Directory Local Variables\n")
 419       (insert ";;; See Info node `(emacs) Directory Variables' for more information.\n\n")
 420       (pp (sort variables
 421                 (lambda (a b)
 422                   (cond
 423                    ((null (car a)) t)
 424                    ((null (car b)) nil)
 425                    ((and (symbolp (car a)) (stringp (car b))) t)
 426                    ((and (symbolp (car b)) (stringp (car a))) nil)
 427                    (t (string< (car a) (car b))))))
 428           (current-buffer)))))
 429
 430 ;;;###autoload
 431 (defun add-dir-local-variable (mode variable value)
 432   "Add directory-local VARIABLE with its VALUE and MODE to .dir-locals.el."
 433   (interactive
 434    (let (variable)
 435      (list
 436       (read-file-local-variable-mode)
 437       (setq variable (read-file-local-variable "Add directory-local variable"))
 438       (read-file-local-variable-value variable))))
 439   (modify-dir-local-variable mode variable value 'add-or-replace))
 440
 441 ;;;###autoload
 442 (defun delete-dir-local-variable (mode variable)
 443   "Delete all MODE settings of file-local VARIABLE from .dir-locals.el."
 444   (interactive
 445    (list
 446     (read-file-local-variable-mode)
 447     (read-file-local-variable "Delete directory-local variable")))
 448   (modify-dir-local-variable mode variable nil 'delete))
 449
 450 ;;;###autoload
 451 (defun copy-file-locals-to-dir-locals ()
 452   "Copy file-local variables to .dir-locals.el."
 453   (interactive)
 454   (dolist (elt file-local-variables-alist)
 455     (unless (assq (car elt) dir-local-variables-alist)
 456       (add-dir-local-variable major-mode (car elt) (cdr elt)))))
 457
 458 ;;;###autoload
 459 (defun copy-dir-locals-to-file-locals ()
 460   "Copy directory-local variables to the Local Variables list."
 461   (interactive)
 462   (dolist (elt dir-local-variables-alist)
 463     (add-file-local-variable (car elt) (cdr elt))))
 464
 465 ;;;###autoload
 466 (defun copy-dir-locals-to-file-locals-prop-line ()
 467   "Copy directory-local variables to the -*- line."
 468   (interactive)
 469   (dolist (elt dir-local-variables-alist)
 470     (add-file-local-variable-prop-line (car elt) (cdr elt))))
 471
 472 \f
 473
 474 (provide 'files-x)
 475
 476 ;;; files-x.el ends here