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