lisp/files-x.el

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