lisp/files-x.el

   1 ;;; files-x.el --- extended file handling commands
   2
   3 ;; Copyright (C) 2009 Free Software Foundation, Inc.
   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)
  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))))
  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)
  72                (string-match-p "-mode\\'" (symbol-name sym)))
  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)
  94                                        ((boundp variable)
  95                                         (symbol-value variable))))))))))
  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
 358 from the MODE alist ignoring the input argument VALUE."
 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 ()
 454   "Copy directory-local variables to the -*- line."
 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)
 462
 463 ;; arch-tag: 949d263c-30a8-4b49-af26-cda97c7c5477
 464 ;;; files-x.el ends here