Commit | Line | Data |
---|---|---|
60370d40 | 1 | ;;; esh-opt.el --- command options processing |
affbf647 | 2 | |
1a32899d | 3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
114f9c96 | 4 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
affbf647 | 5 | |
7de5b421 GM |
6 | ;; Author: John Wiegley <johnw@gnu.org> |
7 | ||
affbf647 GM |
8 | ;; This file is part of GNU Emacs. |
9 | ||
4ee57b2a | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
affbf647 | 11 | ;; it under the terms of the GNU General Public License as published by |
4ee57b2a GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
affbf647 GM |
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 | |
4ee57b2a | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
affbf647 | 22 | |
4e6cc05c GM |
23 | ;;; Commentary: |
24 | ||
8c7309fe GM |
25 | ;;; Code: |
26 | ||
affbf647 GM |
27 | (provide 'esh-opt) |
28 | ||
4e6cc05c | 29 | (eval-when-compile (require 'esh-ext)) |
affbf647 GM |
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 | ||
affbf647 GM |
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)." | |
0d182a34 | 61 | (declare (debug (form form sexp body))) |
affbf647 GM |
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 | ||
1a32899d GM |
77 | (defvar temp-args) |
78 | (defvar last-value) | |
79 | (defvar usage-msg) | |
80 | (defvar ext-command) | |
81 | (defvar args) | |
affbf647 GM |
82 | |
83 | (defun eshell-do-opt (name options body-forms) | |
84 | "Helper function for `eshell-eval-using-options'. | |
85 | This code doesn't really need to be macro expanded everywhere." | |
86 | (setq args temp-args) | |
87 | (if (setq | |
88 | ext-command | |
89 | (catch 'eshell-ext-command | |
90 | (when (setq | |
91 | usage-msg | |
92 | (catch 'eshell-usage | |
93 | (setq last-value nil) | |
94 | (if (and (= (length args) 0) | |
95 | (memq ':show-usage options)) | |
96 | (throw 'eshell-usage | |
97 | (eshell-show-usage name options))) | |
98 | (setq args (eshell-process-args name args options) | |
99 | last-value (eval (append (list 'progn) | |
100 | body-forms))) | |
101 | nil)) | |
c009ca06 | 102 | (error "%s" usage-msg)))) |
affbf647 | 103 | (throw 'eshell-external |
0d182a34 | 104 | (eshell-external-command ext-command args)) |
affbf647 GM |
105 | last-value)) |
106 | ||
107 | (defun eshell-show-usage (name options) | |
108 | "Display the usage message for NAME, using OPTIONS." | |
109 | (let ((usage (format "usage: %s %s\n\n" name | |
110 | (cadr (memq ':usage options)))) | |
111 | (extcmd (memq ':external options)) | |
112 | (post-usage (memq ':post-usage options)) | |
113 | had-option) | |
114 | (while options | |
115 | (when (listp (car options)) | |
116 | (let ((opt (car options))) | |
117 | (setq had-option t) | |
118 | (cond ((and (nth 0 opt) | |
119 | (nth 1 opt)) | |
120 | (setq usage | |
121 | (concat usage | |
122 | (format " %-20s %s\n" | |
123 | (format "-%c, --%s" (nth 0 opt) | |
124 | (nth 1 opt)) | |
125 | (nth 4 opt))))) | |
126 | ((nth 0 opt) | |
127 | (setq usage | |
128 | (concat usage | |
129 | (format " %-20s %s\n" | |
130 | (format "-%c" (nth 0 opt)) | |
131 | (nth 4 opt))))) | |
132 | ((nth 1 opt) | |
133 | (setq usage | |
134 | (concat usage | |
135 | (format " %-20s %s\n" | |
136 | (format " --%s" (nth 1 opt)) | |
137 | (nth 4 opt))))) | |
138 | (t (setq had-option nil))))) | |
139 | (setq options (cdr options))) | |
140 | (if post-usage | |
141 | (setq usage (concat usage (and had-option "\n") | |
142 | (cadr post-usage)))) | |
143 | (when extcmd | |
144 | (setq extcmd (eshell-search-path (cadr extcmd))) | |
145 | (if extcmd | |
146 | (setq usage | |
147 | (concat usage | |
148 | (format " | |
149 | This command is implemented in Lisp. If an unrecognized option is | |
150 | passed to this command, the external version '%s' | |
151 | will be called instead." extcmd))))) | |
152 | (throw 'eshell-usage usage))) | |
153 | ||
154 | (defun eshell-set-option (name ai opt options) | |
155 | "Using NAME's remaining args (index AI), set the OPT within OPTIONS. | |
156 | If the option consumes an argument for its value, the argument list | |
157 | will be modified." | |
158 | (if (not (nth 3 opt)) | |
159 | (eshell-show-usage name options) | |
160 | (if (eq (nth 2 opt) t) | |
161 | (if (> ai (length args)) | |
162 | (error "%s: missing option argument" name) | |
163 | (set (nth 3 opt) (nth ai args)) | |
164 | (if (> ai 0) | |
165 | (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)) | |
166 | (setq args (cdr args)))) | |
167 | (set (nth 3 opt) (or (nth 2 opt) t))))) | |
168 | ||
169 | (defun eshell-process-option (name switch kind ai options) | |
170 | "For NAME, process SWITCH (of type KIND), from args at index AI. | |
171 | The SWITCH will be looked up in the set of OPTIONS. | |
172 | ||
173 | SWITCH should be either a string or character. KIND should be the | |
174 | integer 0 if it's a character, or 1 if it's a string. | |
175 | ||
176 | The SWITCH is then be matched against OPTIONS. If no matching handler | |
177 | is found, and an :external command is defined (and available), it will | |
178 | be called; otherwise, an error will be triggered to say that the | |
179 | switch is unrecognized." | |
180 | (let* ((opts options) | |
181 | found) | |
182 | (while opts | |
183 | (if (and (listp (car opts)) | |
184 | (nth kind (car opts)) | |
185 | (if (= kind 0) | |
186 | (eq switch (nth kind (car opts))) | |
187 | (string= switch (nth kind (car opts))))) | |
188 | (progn | |
189 | (eshell-set-option name ai (car opts) options) | |
190 | (setq found t opts nil)) | |
191 | (setq opts (cdr opts)))) | |
192 | (unless found | |
193 | (let ((extcmd (memq ':external options))) | |
194 | (when extcmd | |
195 | (setq extcmd (eshell-search-path (cadr extcmd))) | |
196 | (if extcmd | |
197 | (throw 'eshell-ext-command extcmd) | |
8bd3a3ad | 198 | (if (characterp switch) |
affbf647 GM |
199 | (error "%s: unrecognized option -%c" name switch) |
200 | (error "%s: unrecognized option --%s" name switch)))))))) | |
201 | ||
202 | (defun eshell-process-args (name args options) | |
203 | "Process the given ARGS using OPTIONS. | |
204 | This assumes that symbols have been intern'd by `eshell-with-options'." | |
205 | (let ((ai 0) arg) | |
206 | (while (< ai (length args)) | |
207 | (setq arg (nth ai args)) | |
208 | (if (not (and (stringp arg) | |
209 | (string-match "^-\\(-\\)?\\(.*\\)" arg))) | |
210 | (setq ai (1+ ai)) | |
211 | (let* ((dash (match-string 1 arg)) | |
212 | (switch (match-string 2 arg))) | |
213 | (if (= ai 0) | |
214 | (setq args (cdr args)) | |
215 | (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))) | |
216 | (if dash | |
217 | (if (> (length switch) 0) | |
218 | (eshell-process-option name switch 1 ai options) | |
219 | (setq ai (length args))) | |
220 | (let ((len (length switch)) | |
221 | (index 0)) | |
222 | (while (< index len) | |
223 | (eshell-process-option name (aref switch index) 0 ai options) | |
224 | (setq index (1+ index))))))))) | |
225 | args) | |
226 | ||
cbee283d | 227 | ;; arch-tag: 45c6c2d0-8091-46a1-a205-2f4bafd8230c |
affbf647 | 228 | ;;; esh-opt.el ends here |