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

   1 ;;; esh-opt.el --- command options processing
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: John Wiegley <johnw@gnu.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 (provide 'esh-opt)
  28
  29 (eval-when-compile (require 'esh-ext))
  30
  31 (defgroup eshell-opt nil
  32   "The options processing code handles command argument parsing for
  33 Eshell commands implemented in Lisp."
  34   :tag "Command options processing"
  35   :group 'eshell)
  36
  37 ;;; User Functions:
  38
  39 (defmacro eshell-eval-using-options (name macro-args
  40                                           options &rest body-forms)
  41   "Process NAME's MACRO-ARGS using a set of command line OPTIONS.
  42 After doing so, settings will be stored in local symbols as declared
  43 by OPTIONS; FORMS will then be evaluated -- assuming all was OK.
  44
  45 The syntax of OPTIONS is:
  46
  47   '((?C  nil         nil multi-column    \"multi-column display\")
  48     (nil \"help\"      nil nil             \"show this usage display\")
  49     (?r  \"reverse\"   nil reverse-list    \"reverse order while sorting\")
  50     :external \"ls\"
  51     :usage \"[OPTION]... [FILE]...
  52   List information about the FILEs (the current directory by default).
  53   Sort entries alphabetically across.\")
  54
  55 `eshell-eval-using-options' returns the value of the last form in
  56 BODY-FORMS.  If instead an external command is run, the tag
  57 `eshell-external' will be thrown with the new process for its value.
  58
  59 Lastly, any remaining arguments will be available in a locally
  60 interned variable `args' (created using a `let' form)."
  61   (declare (debug (form form sexp body)))
  62   `(let ((temp-args
  63           ,(if (memq ':preserve-args (cadr options))
  64                macro-args
  65              (list 'eshell-stringify-list
  66                    (list 'eshell-flatten-list macro-args)))))
  67      (let ,(append (mapcar (function
  68                             (lambda (opt)
  69                               (or (and (listp opt) (nth 3 opt))
  70                                   'eshell-option-stub)))
  71                            (cadr options))
  72                    '(usage-msg last-value ext-command args))
  73        (eshell-do-opt ,name ,options (quote ,body-forms)))))
  74
  75 ;;; Internal Functions:
  76
  77 (eval-when-compile
  78   (defvar temp-args)
  79   (defvar last-value)
  80   (defvar usage-msg)
  81   (defvar ext-command)
  82   (defvar args))
  83
  84 (defun eshell-do-opt (name options body-forms)
  85   "Helper function for `eshell-eval-using-options'.
  86 This code doesn't really need to be macro expanded everywhere."
  87   (setq args temp-args)
  88   (if (setq
  89        ext-command
  90        (catch 'eshell-ext-command
  91          (when (setq
  92                 usage-msg
  93                 (catch 'eshell-usage
  94                   (setq last-value nil)
  95                   (if (and (= (length args) 0)
  96                            (memq ':show-usage options))
  97                       (throw 'eshell-usage
  98                              (eshell-show-usage name options)))
  99                   (setq args (eshell-process-args name args options)
 100                         last-value (eval (append (list 'progn)
 101                                                  body-forms)))
 102                   nil))
 103            (error "%s" usage-msg))))
 104       (throw 'eshell-external
 105              (eshell-external-command ext-command args))
 106     last-value))
 107
 108 (defun eshell-show-usage (name options)
 109   "Display the usage message for NAME, using OPTIONS."
 110   (let ((usage (format "usage: %s %s\n\n" name
 111                        (cadr (memq ':usage options))))
 112         (extcmd (memq ':external options))
 113         (post-usage (memq ':post-usage options))
 114         had-option)
 115     (while options
 116       (when (listp (car options))
 117         (let ((opt (car options)))
 118           (setq had-option t)
 119           (cond ((and (nth 0 opt)
 120                       (nth 1 opt))
 121                  (setq usage
 122                        (concat usage
 123                                (format "    %-20s %s\n"
 124                                        (format "-%c, --%s" (nth 0 opt)
 125                                                (nth 1 opt))
 126                                        (nth 4 opt)))))
 127                 ((nth 0 opt)
 128                  (setq usage
 129                        (concat usage
 130                                (format "    %-20s %s\n"
 131                                        (format "-%c" (nth 0 opt))
 132                                        (nth 4 opt)))))
 133                 ((nth 1 opt)
 134                  (setq usage
 135                        (concat usage
 136                                (format "    %-20s %s\n"
 137                                        (format "    --%s" (nth 1 opt))
 138                                        (nth 4 opt)))))
 139                 (t (setq had-option nil)))))
 140       (setq options (cdr options)))
 141     (if post-usage
 142         (setq usage (concat usage (and had-option "\n")
 143                             (cadr post-usage))))
 144     (when extcmd
 145       (setq extcmd (eshell-search-path (cadr extcmd)))
 146       (if extcmd
 147           (setq usage
 148                 (concat usage
 149                         (format "
 150 This command is implemented in Lisp.  If an unrecognized option is
 151 passed to this command, the external version '%s'
 152 will be called instead." extcmd)))))
 153     (throw 'eshell-usage usage)))
 154
 155 (defun eshell-set-option (name ai opt options)
 156   "Using NAME's remaining args (index AI), set the OPT within OPTIONS.
 157 If the option consumes an argument for its value, the argument list
 158 will be modified."
 159   (if (not (nth 3 opt))
 160       (eshell-show-usage name options)
 161     (if (eq (nth 2 opt) t)
 162         (if (> ai (length args))
 163             (error "%s: missing option argument" name)
 164           (set (nth 3 opt) (nth ai args))
 165           (if (> ai 0)
 166               (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))
 167             (setq args (cdr args))))
 168       (set (nth 3 opt) (or (nth 2 opt) t)))))
 169
 170 (defun eshell-process-option (name switch kind ai options)
 171   "For NAME, process SWITCH (of type KIND), from args at index AI.
 172 The SWITCH will be looked up in the set of OPTIONS.
 173
 174 SWITCH should be either a string or character.  KIND should be the
 175 integer 0 if it's a character, or 1 if it's a string.
 176
 177 The SWITCH is then be matched against OPTIONS.  If no matching handler
 178 is found, and an :external command is defined (and available), it will
 179 be called; otherwise, an error will be triggered to say that the
 180 switch is unrecognized."
 181   (let* ((opts options)
 182          found)
 183     (while opts
 184       (if (and (listp (car opts))
 185                  (nth kind (car opts))
 186                  (if (= kind 0)
 187                      (eq switch (nth kind (car opts)))
 188                    (string= switch (nth kind (car opts)))))
 189           (progn
 190             (eshell-set-option name ai (car opts) options)
 191             (setq found t opts nil))
 192         (setq opts (cdr opts))))
 193     (unless found
 194       (let ((extcmd (memq ':external options)))
 195         (when extcmd
 196           (setq extcmd (eshell-search-path (cadr extcmd)))
 197           (if extcmd
 198               (throw 'eshell-ext-command extcmd)
 199             (if (characterp switch)
 200                 (error "%s: unrecognized option -%c" name switch)
 201               (error "%s: unrecognized option --%s" name switch))))))))
 202
 203 (defun eshell-process-args (name args options)
 204   "Process the given ARGS using OPTIONS.
 205 This assumes that symbols have been intern'd by `eshell-with-options'."
 206   (let ((ai 0) arg)
 207     (while (< ai (length args))
 208       (setq arg (nth ai args))
 209       (if (not (and (stringp arg)
 210                     (string-match "^-\\(-\\)?\\(.*\\)" arg)))
 211           (setq ai (1+ ai))
 212         (let* ((dash (match-string 1 arg))
 213                (switch (match-string 2 arg)))
 214           (if (= ai 0)
 215               (setq args (cdr args))
 216             (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
 217           (if dash
 218               (if (> (length switch) 0)
 219                   (eshell-process-option name switch 1 ai options)
 220                 (setq ai (length args)))
 221             (let ((len (length switch))
 222                   (index 0))
 223               (while (< index len)
 224                 (eshell-process-option name (aref switch index) 0 ai options)
 225                 (setq index (1+ index)))))))))
 226   args)
 227
 228 ;;; Code:
 229
 230 ;;; arch-tag: 45c6c2d0-8091-46a1-a205-2f4bafd8230c
 231 ;;; esh-opt.el ends here