lisp/eshell/esh-arg.el

   1 ;;; esh-arg.el --- argument processing  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Parsing of arguments can be extended by adding functions to the
  25 ;; hook `eshell-parse-argument-hook'.  For a good example of this, see
  26 ;; `eshell-parse-drive-letter', defined in eshell-dirs.el.
  27
  28 (provide 'esh-arg)
  29
  30 (require 'esh-mode)
  31
  32 (defgroup eshell-arg nil
  33   "Argument parsing involves transforming the arguments passed on the
  34 command line into equivalent Lisp forms that, when evaluated, will
  35 yield the values intended."
  36   :tag "Argument parsing"
  37   :group 'eshell)
  38
  39 (defcustom eshell-parse-argument-hook
  40   (list
  41    ;; a term such as #<buffer NAME>, or #<process NAME> is a buffer
  42    ;; or process reference
  43    'eshell-parse-special-reference
  44
  45    ;; numbers convert to numbers if they stand alone
  46    (function
  47     (lambda ()
  48       (when (and (not eshell-current-argument)
  49                  (not eshell-current-quoted)
  50                  (looking-at eshell-number-regexp)
  51                  (eshell-arg-delimiter (match-end 0)))
  52         (goto-char (match-end 0))
  53         (let ((str (match-string 0)))
  54           (if (> (length str) 0)
  55               (add-text-properties 0 (length str) '(number t) str))
  56           str))))
  57
  58    ;; parse any non-special characters, based on the current context
  59    (function
  60     (lambda ()
  61       (unless eshell-inside-quote-regexp
  62         (setq eshell-inside-quote-regexp
  63               (format "[^%s]+"
  64                       (apply 'string eshell-special-chars-inside-quoting))))
  65       (unless eshell-outside-quote-regexp
  66         (setq eshell-outside-quote-regexp
  67               (format "[^%s]+"
  68                       (apply 'string eshell-special-chars-outside-quoting))))
  69       (when (looking-at (if eshell-current-quoted
  70                             eshell-inside-quote-regexp
  71                           eshell-outside-quote-regexp))
  72         (goto-char (match-end 0))
  73         (let ((str (match-string 0)))
  74           (if str
  75               (set-text-properties 0 (length str) nil str))
  76           str))))
  77
  78    ;; whitespace or a comment is an argument delimiter
  79    (function
  80     (lambda ()
  81       (let (comment-p)
  82         (when (or (looking-at "[ \t]+")
  83                   (and (not eshell-current-argument)
  84                        (looking-at "#\\([^<'].*\\|$\\)")
  85                        (setq comment-p t)))
  86           (if comment-p
  87               (add-text-properties (match-beginning 0) (match-end 0)
  88                                    '(comment t)))
  89           (goto-char (match-end 0))
  90           (eshell-finish-arg)))))
  91
  92    ;; parse backslash and the character after
  93    'eshell-parse-backslash
  94
  95    ;; text beginning with ' is a literally quoted
  96    'eshell-parse-literal-quote
  97
  98    ;; text beginning with " is interpolably quoted
  99    'eshell-parse-double-quote
 100
 101    ;; argument delimiter
 102    'eshell-parse-delimiter)
 103   "Define how to process Eshell command line arguments.
 104 When each function on this hook is called, point will be at the
 105 current position within the argument list.  The function should either
 106 return nil, meaning that it did no argument parsing, or it should
 107 return the result of the parse as a sexp.  It is also responsible for
 108 moving the point forward to reflect the amount of input text that was
 109 parsed.
 110
 111 If no function handles the current character at point, it will be
 112 treated as a literal character."
 113   :type 'hook
 114   :group 'eshell-arg)
 115
 116 ;;; Code:
 117
 118 ;;; User Variables:
 119
 120 (defcustom eshell-arg-load-hook nil
 121   "A hook that gets run when `eshell-arg' is loaded."
 122   :version "24.1"                      ; removed eshell-arg-initialize
 123   :type 'hook
 124   :group 'eshell-arg)
 125
 126 (defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n)
 127   "List of characters to recognize as argument separators."
 128   :type '(repeat character)
 129   :group 'eshell-arg)
 130
 131 (defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
 132   "Characters which are still special inside double quotes."
 133   :type '(repeat character)
 134   :group 'eshell-arg)
 135
 136 (defcustom eshell-special-chars-outside-quoting
 137   (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
 138   "Characters that require escaping outside of double quotes.
 139 Without escaping them, they will introduce a change in the argument."
 140   :type '(repeat character)
 141   :group 'eshell-arg)
 142
 143 ;;; Internal Variables:
 144
 145 (defvar eshell-current-argument nil)
 146 (defvar eshell-current-modifiers nil)
 147 (defvar eshell-arg-listified nil)
 148 (defvar eshell-nested-argument nil)
 149 (defvar eshell-current-quoted nil)
 150 (defvar eshell-inside-quote-regexp nil)
 151 (defvar eshell-outside-quote-regexp nil)
 152
 153 ;;; Functions:
 154
 155 (defun eshell-arg-initialize ()
 156   "Initialize the argument parsing code."
 157   (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
 158   (set (make-local-variable 'eshell-inside-quote-regexp) nil)
 159   (set (make-local-variable 'eshell-outside-quote-regexp) nil))
 160
 161 (defun eshell-insert-buffer-name (buffer-name)
 162   "Insert BUFFER-NAME into the current buffer at point."
 163   (interactive "BName of buffer: ")
 164   (insert-and-inherit "#<buffer " buffer-name ">"))
 165
 166 (defsubst eshell-escape-arg (string)
 167   "Return STRING with the `escaped' property on it."
 168   (if (stringp string)
 169       (add-text-properties 0 (length string) '(escaped t) string))
 170   string)
 171
 172 (defun eshell-resolve-current-argument ()
 173   "If there are pending modifications to be made, make them now."
 174   (when eshell-current-argument
 175     (when eshell-arg-listified
 176       (let ((parts eshell-current-argument))
 177         (while parts
 178           (unless (stringp (car parts))
 179             (setcar parts
 180                     (list 'eshell-to-flat-string (car parts))))
 181           (setq parts (cdr parts)))
 182         (setq eshell-current-argument
 183               (list 'eshell-convert
 184                     (append (list 'concat) eshell-current-argument))))
 185       (setq eshell-arg-listified nil))
 186     (while eshell-current-modifiers
 187       (setq eshell-current-argument
 188             (list (car eshell-current-modifiers) eshell-current-argument)
 189             eshell-current-modifiers (cdr eshell-current-modifiers))))
 190   (setq eshell-current-modifiers nil))
 191
 192 (defun eshell-finish-arg (&optional argument)
 193   "Finish the current argument being processed."
 194   (if argument
 195       (setq eshell-current-argument argument))
 196   (throw 'eshell-arg-done t))
 197
 198 (defsubst eshell-arg-delimiter (&optional pos)
 199   "Return non-nil if POS is an argument delimiter.
 200 If POS is nil, the location of point is checked."
 201   (let ((pos (or pos (point))))
 202     (or (= pos (point-max))
 203         (memq (char-after pos) eshell-delimiter-argument-list))))
 204
 205 (defun eshell-quote-argument (string)
 206   "Return STRING with magic characters quoted.
 207 Magic characters are those in `eshell-special-chars-outside-quoting'."
 208   (let ((index 0))
 209     (mapconcat (lambda (c)
 210                  (prog1
 211                      (or (eshell-quote-backslash string index)
 212                          (char-to-string c))
 213                    (setq index (1+ index))))
 214                string
 215                "")))
 216
 217 ;; Argument parsing
 218
 219 (defun eshell-parse-arguments (beg end)
 220   "Parse all of the arguments at point from BEG to END.
 221 Returns the list of arguments in their raw form.
 222 Point is left at the end of the arguments."
 223   (save-excursion
 224     (save-restriction
 225       (goto-char beg)
 226       (narrow-to-region beg end)
 227       (let ((inhibit-point-motion-hooks t)
 228             (args (list t))
 229             delim)
 230         (with-silent-modifications
 231           (remove-text-properties (point-min) (point-max)
 232                                   '(arg-begin nil arg-end nil))
 233           (if (setq
 234                delim
 235                (catch 'eshell-incomplete
 236                  (while (not (eobp))
 237                    (let* ((here (point))
 238                           (arg (eshell-parse-argument)))
 239                      (if (= (point) here)
 240                          (error "Failed to parse argument '%s'"
 241                                 (buffer-substring here (point-max))))
 242                      (and arg (nconc args (list arg)))))))
 243               (throw 'eshell-incomplete (if (listp delim)
 244                                             delim
 245                                           (list delim (point) (cdr args)))))
 246           (cdr args))))))
 247
 248 (defun eshell-parse-argument ()
 249   "Get the next argument.  Leave point after it."
 250   (let* ((outer (null eshell-nested-argument))
 251          (arg-begin (and outer (point)))
 252          (eshell-nested-argument t)
 253          eshell-current-argument
 254          eshell-current-modifiers
 255          eshell-arg-listified)
 256     (catch 'eshell-arg-done
 257       (while (not (eobp))
 258         (let ((result
 259                (or (run-hook-with-args-until-success
 260                     'eshell-parse-argument-hook)
 261                    (prog1
 262                        (char-to-string (char-after))
 263                      (forward-char)))))
 264           (if (not eshell-current-argument)
 265               (setq eshell-current-argument result)
 266             (unless eshell-arg-listified
 267               (setq eshell-current-argument
 268                     (list eshell-current-argument)
 269                     eshell-arg-listified t))
 270             (nconc eshell-current-argument (list result))))))
 271     (when (and outer eshell-current-argument)
 272       (add-text-properties arg-begin (1+ arg-begin)
 273                            '(arg-begin t rear-nonsticky
 274                                        (arg-begin arg-end)))
 275       (add-text-properties (1- (point)) (point)
 276                            '(arg-end t rear-nonsticky
 277                                      (arg-end arg-begin))))
 278     (eshell-resolve-current-argument)
 279     eshell-current-argument))
 280
 281 (defsubst eshell-operator (&rest _args)
 282   "A stub function that generates an error if a floating operator is found."
 283   (error "Unhandled operator in input text"))
 284
 285 (defsubst eshell-looking-at-backslash-return (pos)
 286   "Test whether a backslash-return sequence occurs at POS."
 287   (and (eq (char-after pos) ?\\)
 288        (or (= (1+ pos) (point-max))
 289            (and (eq (char-after (1+ pos)) ?\n)
 290                 (= (+ pos 2) (point-max))))))
 291
 292 (defun eshell-quote-backslash (string &optional index)
 293   "Intelligently backslash the character occurring in STRING at INDEX.
 294 If the character is itself a backslash, it needs no escaping."
 295   (let ((char (aref string index)))
 296     (if (and (eq char ?\\)
 297              ;; In Emacs directory-sep-char is always ?/, so this does nothing.
 298              (not (and (featurep 'xemacs)
 299                        (featurep 'mswindows)
 300                        (eq directory-sep-char ?\\)
 301                        (eq (1- (string-width string))
 302                            index))))
 303         (char-to-string char)
 304       (if (memq char eshell-special-chars-outside-quoting)
 305           (string ?\\ char)))))
 306
 307 (defun eshell-parse-backslash ()
 308   "Parse a single backslash (\\) character and the character after.
 309 If the character after the backslash is special, always ignore
 310 the backslash and return the escaped character.
 311
 312 Otherwise, if the backslash is not in quoted string, the
 313 backslash is ignored and the character after is returned.  If the
 314 backslash is in a quoted string, the backslash and the character
 315 after are both returned."
 316   (when (eq (char-after) ?\\)
 317     (when (eshell-looking-at-backslash-return (point))
 318         (throw 'eshell-incomplete ?\\))
 319     (forward-char 2) ; Move one char past the backslash.
 320     ;; If the char is in a quote, backslash only has special meaning
 321     ;; if it is escaping a special char.
 322     (if eshell-current-quoted
 323         (if (memq (char-before) eshell-special-chars-inside-quoting)
 324             (list 'eshell-escape-arg (char-to-string (char-before)))
 325           (concat "\\" (char-to-string (char-before))))
 326       (if (memq (char-before) eshell-special-chars-outside-quoting)
 327           (list 'eshell-escape-arg (char-to-string (char-before)))
 328         (char-to-string (char-before))))))
 329
 330 (defun eshell-parse-literal-quote ()
 331   "Parse a literally quoted string.  Nothing has special meaning!"
 332   (if (eq (char-after) ?\')
 333       (let ((end (eshell-find-delimiter ?\' ?\')))
 334         (if (not end)
 335             (throw 'eshell-incomplete ?\')
 336           (let ((string (buffer-substring-no-properties (1+ (point)) end)))
 337             (goto-char (1+ end))
 338             (while (string-match "''" string)
 339               (setq string (replace-match "'" t t string)))
 340             (list 'eshell-escape-arg string))))))
 341
 342 (defun eshell-parse-double-quote ()
 343   "Parse a double quoted string, which allows for variable interpolation."
 344   (when (eq (char-after) ?\")
 345     (let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
 346            (eshell-current-quoted t))
 347       (if (not end)
 348           (throw 'eshell-incomplete ?\")
 349         (prog1
 350             (save-restriction
 351               (forward-char)
 352               (narrow-to-region (point) end)
 353               (let ((arg (eshell-parse-argument)))
 354                 (if (eq arg nil)
 355                     ""
 356                   (list 'eshell-escape-arg arg))))
 357           (goto-char (1+ end)))))))
 358
 359 (defun eshell-parse-special-reference ()
 360   "Parse a special syntax reference, of the form '#<type arg>'."
 361   (if (and (not eshell-current-argument)
 362            (not eshell-current-quoted)
 363            (looking-at "#<\\(buffer\\|process\\)\\s-"))
 364       (let ((here (point)))
 365         (goto-char (match-end 0))
 366         (let* ((buffer-p (string= (match-string 1) "buffer"))
 367                (end (eshell-find-delimiter ?\< ?\>)))
 368           (if (not end)
 369               (throw 'eshell-incomplete ?\<)
 370             (if (eshell-arg-delimiter (1+ end))
 371                 (prog1
 372                     (list (if buffer-p 'get-buffer-create 'get-process)
 373                           (buffer-substring-no-properties (point) end))
 374                   (goto-char (1+ end)))
 375               (ignore (goto-char here))))))))
 376
 377 (defun eshell-parse-delimiter ()
 378   "Parse an argument delimiter, which is essentially a command operator."
 379   ;; this `eshell-operator' keyword gets parsed out by
 380   ;; `eshell-separate-commands'.  Right now the only possibility for
 381   ;; error is an incorrect output redirection specifier.
 382   (when (looking-at "[&|;\n]\\s-*")
 383     (let ((end (match-end 0)))
 384     (if eshell-current-argument
 385         (eshell-finish-arg)
 386       (eshell-finish-arg
 387        (prog1
 388            (list 'eshell-operator
 389                  (cond
 390                   ((eq (char-after end) ?\&)
 391                    (setq end (1+ end)) "&&")
 392                   ((eq (char-after end) ?\|)
 393                    (setq end (1+ end)) "||")
 394                   ((eq (char-after) ?\n) ";")
 395                   (t
 396                    (char-to-string (char-after)))))
 397          (goto-char end)))))))
 398
 399 ;;; esh-arg.el ends here