code.delx.au - gnu-emacs-elpa/blob - packages/shell-quasiquote/shell-quasiquote.el

   1 ;;; shell-quasiquote.el --- Turn s-expressions into shell command strings.
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
   6 ;; Keywords: extensions, unix
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; "Shell quasiquote" -- turn s-expressions into POSIX shell command strings.
  24 ;;
  25 ;; Shells other than POSIX sh are not supported.
  26 ;;
  27 ;; Quoting is automatic and safe against injection.
  28 ;;
  29 ;;   (let ((file1 "file one")
  30 ;;         (file2 "file two"))
  31 ;;     (shqq (cp -r ,file1 ,file2 "My Files")))
  32 ;;       => "cp -r 'file one' 'file two' 'My Files'"
  33 ;;
  34 ;; You can splice many arguments into place with ,@foo.
  35 ;;
  36 ;;   (let ((files (list "file one" "file two")))
  37 ;;     (shqq (cp -r ,@files "My Files")))
  38 ;;       => "cp -r 'file one' 'file two' 'My Files'"
  39 ;;
  40 ;; Note that the quoting disables a variety of shell expansions like ~/foo,
  41 ;; $ENV_VAR, and e.g. {x..y} in GNU Bash.
  42 ;;
  43 ;; You can use ,,foo to escape the quoting.
  44 ;;
  45 ;;   (let ((files "file1 file2"))
  46 ;;     (shqq (cp -r ,,files "My Files")))
  47 ;;       => "cp -r file1 file2 'My Files'"
  48 ;;
  49 ;; And ,,@foo to splice and escape quoting.
  50 ;;
  51 ;;   (let* ((arglist '("-x 'foo bar' -y baz"))
  52 ;;          (arglist (append arglist '("-z 'qux fux'"))))
  53 ;;     (shqq (command ,,@arglist)))
  54 ;;       => "command -x 'foo bar' -y baz -z 'qux fux'"
  55 ;;
  56 ;; Neat, eh?
  57
  58 \f
  59 ;;; Code:
  60
  61 (defun shqq--atom-to-string (atom)
  62   (cond
  63    ((symbolp atom) (symbol-name atom))
  64    ((stringp atom) atom)
  65    ((numberp atom) (number-to-string atom))
  66    (t (error "Bad shqq atom: %S" atom))))
  67
  68 (defun shqq--quote-atom (atom)
  69   (shell-quote-argument (shqq--atom-to-string atom)))
  70
  71 (defun shqq--match-comma (form)
  72   "Matches FORM against ,foo i.e. (\, foo) and returns foo.
  73 Returns nil if FORM didn't match.  You can't disambiguate between
  74 FORM matching ,nil and not matching."
  75   (if (and (consp form)
  76            (eq '\, (car form))
  77            (consp (cdr form))
  78            (null (cddr form)))
  79       (cadr form)))
  80
  81 (defun shqq--match-comma2 (form)
  82   "Matches FORM against ,,foo i.e. (\, (\, foo)) and returns foo.
  83 Returns nil if FORM didn't match.  You can't disambiguate between
  84 FORM matching ,,nil and not matching."
  85   (if (and (consp form)
  86            (eq '\, (car form))
  87            (consp (cdr form))
  88            (null (cddr form)))
  89       (shqq--match-comma (cadr form))))
  90
  91 \f
  92 (defmacro shqq (parts)
  93   "First, PARTS is turned into a list of strings.  For this,
  94 every element of PARTS must be one of:
  95
  96 - a symbol, evaluating to its name,
  97
  98 - a string, evaluating to itself,
  99
 100 - a number, evaluating to its decimal representation,
 101
 102 - \",expr\", where EXPR must evaluate to an atom that will be
 103   interpreted according to the previous rules,
 104
 105 - \",@list-expr\", where LIST-EXPR must evaluate to a list whose
 106   elements will each be interpreted like the EXPR in an \",EXPR\"
 107   form, and spliced into the list of strings,
 108
 109 - \",,expr\", where EXPR is interpreted like in \",expr\",
 110
 111 - or \",,@expr\", where EXPR is interpreted like in \",@expr\".
 112
 113 In the resulting list of strings, all elements except the ones
 114 resulting from \",,expr\" and \",,@expr\" forms are quoted for
 115 shell grammar.
 116
 117 Finally, the resulting list of strings is concatenated with
 118 separating spaces."
 119   (let ((parts
 120          (mapcar
 121           (lambda (part)
 122             (cond
 123              ((atom part) (shqq--quote-atom part))
 124              ;; We use the match-comma helpers because pcase can't match ,foo.
 125              (t (pcase part
 126                   ;; ,,foo i.e. (, (, foo))
 127                   ((pred shqq--match-comma2)
 128                    (shqq--match-comma2 part))
 129                   ;; ,,@foo i.e. (, (,@ foo))
 130                   ((and (pred shqq--match-comma)
 131                         (let `,@,form (shqq--match-comma part)))
 132                    `(mapconcat #'identity ,form " "))
 133                   ;; ,foo
 134                   ;; Insert redundant 'and x' to work around debbugs#18554.
 135                   ((and x (pred shqq--match-comma))
 136                    `(shqq--quote-atom ,(shqq--match-comma part)))
 137                   ;; ,@foo
 138                   (`,@,form
 139                    `(mapconcat #'shqq--quote-atom ,form " "))
 140                   (_
 141                    (error "Bad shqq part: %S" part))))))
 142           parts)))
 143     `(mapconcat #'identity (list ,@parts) " ")))
 144
 145 (provide 'shell-quasiquote)
 146 ;; Local Variables:
 147 ;; coding: utf-8
 148 ;; End:
 149 ;;; shell-quasiquote.el ends here