code.delx.au - gnu-emacs/blob - lisp/eshell/esh-arg.el

   1 ;;; esh-arg.el --- argument processing
   2
   3 ;; Copyright (C) 1999-2011  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 (eval-when-compile (require 'eshell))
  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    ;; backslash before a special character means escape it
  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 '(eshell-arg-initialize)
 121   "A hook that gets run when `eshell-arg' is loaded."
 122   :type 'hook
 123   :group 'eshell-arg)
 124
 125 (defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n)
 126   "List of characters to recognize as argument separators."
 127   :type '(repeat character)
 128   :group 'eshell-arg)
 129
 130 (defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
 131   "Characters which are still special inside double quotes."
 132   :type '(repeat character)
 133   :group 'eshell-arg)
 134
 135 (defcustom eshell-special-chars-outside-quoting
 136   (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
 137   "Characters that require escaping outside of double quotes.
 138 Without escaping them, they will introduce a change in the argument."
 139   :type '(repeat character)
 140   :group 'eshell-arg)
 141
 142 ;;; Internal Variables:
 143
 144 (defvar eshell-current-argument nil)
 145 (defvar eshell-current-modifiers nil)
 146 (defvar eshell-arg-listified nil)
 147 (defvar eshell-nested-argument nil)
 148 (defvar eshell-current-quoted nil)
 149 (defvar eshell-inside-quote-regexp nil)
 150 (defvar eshell-outside-quote-regexp nil)
 151
 152 ;;; Functions:
 153
 154 (defun eshell-arg-initialize ()
 155   "Initialize the argument parsing code."
 156   (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
 157   (set (make-local-variable 'eshell-inside-quote-regexp) nil)
 158   (set (make-local-variable 'eshell-outside-quote-regexp) nil))
 159
 160 (defun eshell-insert-buffer-name (buffer-name)
 161   "Insert BUFFER-NAME into the current buffer at point."
 162   (interactive "BName of buffer: ")
 163   (insert-and-inherit "#<buffer " buffer-name ">"))
 164
 165 (defsubst eshell-escape-arg (string)
 166   "Return STRING with the `escaped' property on it."
 167   (if (stringp string)
 168       (add-text-properties 0 (length string) '(escaped t) string))
 169   string)
 170
 171 (defun eshell-resolve-current-argument ()
 172   "If there are pending modifications to be made, make them now."
 173   (when eshell-current-argument
 174     (when eshell-arg-listified
 175       (let ((parts eshell-current-argument))
 176         (while parts
 177           (unless (stringp (car parts))
 178             (setcar parts
 179                     (list 'eshell-to-flat-string (car parts))))
 180           (setq parts (cdr parts)))
 181         (setq eshell-current-argument
 182               (list 'eshell-convert
 183                     (append (list 'concat) eshell-current-argument))))
 184       (setq eshell-arg-listified nil))
 185     (while eshell-current-modifiers
 186       (setq eshell-current-argument
 187             (list (car eshell-current-modifiers) eshell-current-argument)
 188             eshell-current-modifiers (cdr eshell-current-modifiers))))
 189   (setq eshell-current-modifiers nil))
 190
 191 (defun eshell-finish-arg (&optional argument)
 192   "Finish the current argument being processed."
 193   (if argument
 194       (setq eshell-current-argument argument))
 195   (throw 'eshell-arg-done t))
 196
 197 (defsubst eshell-arg-delimiter (&optional pos)
 198   "Return non-nil if POS is an argument delimiter.
 199 If POS is nil, the location of point is checked."
 200   (let ((pos (or pos (point))))
 201     (or (= pos (point-max))
 202         (memq (char-after pos) eshell-delimiter-argument-list))))
 203
 204 ;; Argument parsing
 205
 206 (defun eshell-parse-arguments (beg end)
 207   "Parse all of the arguments at point from BEG to END.
 208 Returns the list of arguments in their raw form.
 209 Point is left at the end of the arguments."
 210   (save-excursion
 211     (save-restriction
 212       (goto-char beg)
 213       (narrow-to-region beg end)
 214       (let ((inhibit-point-motion-hooks t)
 215             (args (list t))
 216             delim)
 217         (with-silent-modifications
 218           (remove-text-properties (point-min) (point-max)
 219                                   '(arg-begin nil arg-end nil))
 220           (if (setq
 221                delim
 222                (catch 'eshell-incomplete
 223                  (while (not (eobp))
 224                    (let* ((here (point))
 225                           (arg (eshell-parse-argument)))
 226                      (if (= (point) here)
 227                          (error "Failed to parse argument '%s'"
 228                                 (buffer-substring here (point-max))))
 229                      (and arg (nconc args (list arg)))))))
 230               (throw 'eshell-incomplete (if (listp delim)
 231                                             delim
 232                                           (list delim (point) (cdr args)))))
 233           (cdr args))))))
 234
 235 (defun eshell-parse-argument ()
 236   "Get the next argument.  Leave point after it."
 237   (let* ((outer (null eshell-nested-argument))
 238          (arg-begin (and outer (point)))
 239          (eshell-nested-argument t)
 240          eshell-current-argument
 241          eshell-current-modifiers
 242          eshell-arg-listified)
 243     (catch 'eshell-arg-done
 244       (while (not (eobp))
 245         (let ((result
 246                (or (run-hook-with-args-until-success
 247                     'eshell-parse-argument-hook)
 248                    (prog1
 249                        (char-to-string (char-after))
 250                      (forward-char)))))
 251           (if (not eshell-current-argument)
 252               (setq eshell-current-argument result)
 253             (unless eshell-arg-listified
 254               (setq eshell-current-argument
 255                     (list eshell-current-argument)
 256                     eshell-arg-listified t))
 257             (nconc eshell-current-argument (list result))))))
 258     (when (and outer eshell-current-argument)
 259       (add-text-properties arg-begin (1+ arg-begin)
 260                            '(arg-begin t rear-nonsticky
 261                                        (arg-begin arg-end)))
 262       (add-text-properties (1- (point)) (point)
 263                            '(arg-end t rear-nonsticky
 264                                      (arg-end arg-begin))))
 265     (eshell-resolve-current-argument)
 266     eshell-current-argument))
 267
 268 (defsubst eshell-operator (&rest args)
 269   "A stub function that generates an error if a floating operator is found."
 270   (error "Unhandled operator in input text"))
 271
 272 (defsubst eshell-looking-at-backslash-return (pos)
 273   "Test whether a backslash-return sequence occurs at POS."
 274   (and (eq (char-after pos) ?\\)
 275        (or (= (1+ pos) (point-max))
 276            (and (eq (char-after (1+ pos)) ?\n)
 277                 (= (+ pos 2) (point-max))))))
 278
 279 (defun eshell-quote-backslash (string &optional index)
 280   "Intelligently backslash the character occurring in STRING at INDEX.
 281 If the character is itself a backslash, it needs no escaping."
 282   (let ((char (aref string index)))
 283     (if (and (eq char ?\\)
 284              ;; In Emacs directory-sep-char is always ?/, so this does nothing.
 285              (not (and (featurep 'xemacs)
 286                        (featurep 'mswindows)
 287                        (eq directory-sep-char ?\\)
 288                        (eq (1- (string-width string))
 289                            index))))
 290         (char-to-string char)
 291       (if (memq char eshell-special-chars-outside-quoting)
 292           (string ?\\ char)))))
 293
 294 (defun eshell-parse-backslash ()
 295   "Parse a single backslash (\) character, which might mean escape.
 296 It only means escape if the character immediately following is a
 297 special character that is not itself a backslash."
 298   (when (eq (char-after) ?\\)
 299     (if (eshell-looking-at-backslash-return (point))
 300         (throw 'eshell-incomplete ?\\)
 301       (if (and (not (eq (char-after (1+ (point))) ?\\))
 302                (if eshell-current-quoted
 303                    (memq (char-after (1+ (point)))
 304                          eshell-special-chars-inside-quoting)
 305                  (memq (char-after (1+ (point)))
 306                        eshell-special-chars-outside-quoting)))
 307           (progn
 308             (forward-char 2)
 309             (list 'eshell-escape-arg
 310                   (char-to-string (char-before))))
 311         ;; allow \\<RET> to mean a literal "\" character followed by a
 312         ;; normal return, rather than a backslash followed by a line
 313         ;; continuator (i.e., "\\ + \n" rather than "\ + \\n").  This
 314         ;; is necessary because backslashes in Eshell are not special
 315         ;; unless they either precede something special, or precede a
 316         ;; backslash that precedes something special.  (Mainly this is
 317         ;; done to make using backslash on Windows systems more
 318         ;; natural-feeling).
 319         (if (eshell-looking-at-backslash-return (1+ (point)))
 320             (forward-char))
 321         (forward-char)
 322         "\\"))))
 323
 324 (defun eshell-parse-literal-quote ()
 325   "Parse a literally quoted string.  Nothing has special meaning!"
 326   (if (eq (char-after) ?\')
 327       (let ((end (eshell-find-delimiter ?\' ?\')))
 328         (if (not end)
 329             (throw 'eshell-incomplete ?\')
 330           (let ((string (buffer-substring-no-properties (1+ (point)) end)))
 331             (goto-char (1+ end))
 332             (while (string-match "''" string)
 333               (setq string (replace-match "'" t t string)))
 334             (list 'eshell-escape-arg string))))))
 335
 336 (defun eshell-parse-double-quote ()
 337   "Parse a double quoted string, which allows for variable interpolation."
 338   (when (eq (char-after) ?\")
 339     (let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
 340            (eshell-current-quoted t))
 341       (if (not end)
 342           (throw 'eshell-incomplete ?\")
 343         (prog1
 344             (save-restriction
 345               (forward-char)
 346               (narrow-to-region (point) end)
 347               (let ((arg (eshell-parse-argument)))
 348                 (if (eq arg nil)
 349                     ""
 350                   (list 'eshell-escape-arg arg))))
 351           (goto-char (1+ end)))))))
 352
 353 (defun eshell-parse-special-reference ()
 354   "Parse a special syntax reference, of the form '#<type arg>'."
 355   (if (and (not eshell-current-argument)
 356            (not eshell-current-quoted)
 357            (looking-at "#<\\(buffer\\|process\\)\\s-"))
 358       (let ((here (point)))
 359         (goto-char (match-end 0))
 360         (let* ((buffer-p (string= (match-string 1) "buffer"))
 361                (end (eshell-find-delimiter ?\< ?\>)))
 362           (if (not end)
 363               (throw 'eshell-incomplete ?\<)
 364             (if (eshell-arg-delimiter (1+ end))
 365                 (prog1
 366                     (list (if buffer-p 'get-buffer-create 'get-process)
 367                           (buffer-substring-no-properties (point) end))
 368                   (goto-char (1+ end)))
 369               (ignore (goto-char here))))))))
 370
 371 (defun eshell-parse-delimiter ()
 372   "Parse an argument delimiter, which is essentially a command operator."
 373   ;; this `eshell-operator' keyword gets parsed out by
 374   ;; `eshell-separate-commands'.  Right now the only possibility for
 375   ;; error is an incorrect output redirection specifier.
 376   (when (looking-at "[&|;\n]\\s-*")
 377     (let ((end (match-end 0)))
 378     (if eshell-current-argument
 379         (eshell-finish-arg)
 380       (eshell-finish-arg
 381        (prog1
 382            (list 'eshell-operator
 383                  (cond
 384                   ((eq (char-after end) ?\&)
 385                    (setq end (1+ end)) "&&")
 386                   ((eq (char-after end) ?\|)
 387                    (setq end (1+ end)) "||")
 388                   ((eq (char-after) ?\n) ";")
 389                   (t
 390                    (char-to-string (char-after)))))
 391          (goto-char end)))))))
 392
 393 ;;; esh-arg.el ends here