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