Mercurial > emacs
annotate lisp/eshell/esh-opt.el @ 96849:d049ef97c446
* print.c (print_object): Check print_depth before searching for
circularities.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 21 Jul 2008 05:02:31 +0000 |
parents | 45dbb3c749a6 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
32526
diff
changeset
|
1 ;;; esh-opt.el --- command options processing |
29876 | 2 |
95619
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
4 ;; 2008 Free Software Foundation, Inc. |
29876 | 5 |
32526 | 6 ;; Author: John Wiegley <johnw@gnu.org> |
7 | |
29876 | 8 ;; This file is part of GNU Emacs. |
9 | |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
29876 | 11 ;; it under the terms of the GNU General Public License as published by |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; (at your option) any later version. |
29876 | 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 | |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
29876 | 22 |
87086
3e9ef52e86be
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
82850
diff
changeset
|
23 ;;; Commentary: |
3e9ef52e86be
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
82850
diff
changeset
|
24 |
29876 | 25 (provide 'esh-opt) |
26 | |
87086
3e9ef52e86be
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
82850
diff
changeset
|
27 (eval-when-compile (require 'esh-ext)) |
29876 | 28 |
29 (defgroup eshell-opt nil | |
30 "The options processing code handles command argument parsing for | |
31 Eshell commands implemented in Lisp." | |
32 :tag "Command options processing" | |
33 :group 'eshell) | |
34 | |
35 ;;; User Functions: | |
36 | |
37 (defmacro eshell-eval-using-options (name macro-args | |
38 options &rest body-forms) | |
39 "Process NAME's MACRO-ARGS using a set of command line OPTIONS. | |
40 After doing so, settings will be stored in local symbols as declared | |
41 by OPTIONS; FORMS will then be evaluated -- assuming all was OK. | |
42 | |
43 The syntax of OPTIONS is: | |
44 | |
45 '((?C nil nil multi-column \"multi-column display\") | |
46 (nil \"help\" nil nil \"show this usage display\") | |
47 (?r \"reverse\" nil reverse-list \"reverse order while sorting\") | |
48 :external \"ls\" | |
49 :usage \"[OPTION]... [FILE]... | |
50 List information about the FILEs (the current directory by default). | |
51 Sort entries alphabetically across.\") | |
52 | |
53 `eshell-eval-using-options' returns the value of the last form in | |
54 BODY-FORMS. If instead an external command is run, the tag | |
55 `eshell-external' will be thrown with the new process for its value. | |
56 | |
57 Lastly, any remaining arguments will be available in a locally | |
58 interned variable `args' (created using a `let' form)." | |
82850
4d60bd4e5610
(eshell-eval-using-options): Add debug declaration.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
78220
diff
changeset
|
59 (declare (debug (form form sexp body))) |
29876 | 60 `(let ((temp-args |
61 ,(if (memq ':preserve-args (cadr options)) | |
62 macro-args | |
63 (list 'eshell-stringify-list | |
64 (list 'eshell-flatten-list macro-args))))) | |
65 (let ,(append (mapcar (function | |
66 (lambda (opt) | |
67 (or (and (listp opt) (nth 3 opt)) | |
68 'eshell-option-stub))) | |
69 (cadr options)) | |
70 '(usage-msg last-value ext-command args)) | |
71 (eshell-do-opt ,name ,options (quote ,body-forms))))) | |
72 | |
73 ;;; Internal Functions: | |
74 | |
95619
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
75 (defvar temp-args) |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
76 (defvar last-value) |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
77 (defvar usage-msg) |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
78 (defvar ext-command) |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
79 (defvar args) |
29876 | 80 |
81 (defun eshell-do-opt (name options body-forms) | |
82 "Helper function for `eshell-eval-using-options'. | |
83 This code doesn't really need to be macro expanded everywhere." | |
84 (setq args temp-args) | |
85 (if (setq | |
86 ext-command | |
87 (catch 'eshell-ext-command | |
88 (when (setq | |
89 usage-msg | |
90 (catch 'eshell-usage | |
91 (setq last-value nil) | |
92 (if (and (= (length args) 0) | |
93 (memq ':show-usage options)) | |
94 (throw 'eshell-usage | |
95 (eshell-show-usage name options))) | |
96 (setq args (eshell-process-args name args options) | |
97 last-value (eval (append (list 'progn) | |
98 body-forms))) | |
99 nil)) | |
51642
17d4cef02d9b
(eshell-do-opt): Avoid variable as format
Andreas Schwab <schwab@suse.de>
parents:
38414
diff
changeset
|
100 (error "%s" usage-msg)))) |
29876 | 101 (throw 'eshell-external |
82850
4d60bd4e5610
(eshell-eval-using-options): Add debug declaration.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
78220
diff
changeset
|
102 (eshell-external-command ext-command args)) |
29876 | 103 last-value)) |
104 | |
105 (defun eshell-show-usage (name options) | |
106 "Display the usage message for NAME, using OPTIONS." | |
107 (let ((usage (format "usage: %s %s\n\n" name | |
108 (cadr (memq ':usage options)))) | |
109 (extcmd (memq ':external options)) | |
110 (post-usage (memq ':post-usage options)) | |
111 had-option) | |
112 (while options | |
113 (when (listp (car options)) | |
114 (let ((opt (car options))) | |
115 (setq had-option t) | |
116 (cond ((and (nth 0 opt) | |
117 (nth 1 opt)) | |
118 (setq usage | |
119 (concat usage | |
120 (format " %-20s %s\n" | |
121 (format "-%c, --%s" (nth 0 opt) | |
122 (nth 1 opt)) | |
123 (nth 4 opt))))) | |
124 ((nth 0 opt) | |
125 (setq usage | |
126 (concat usage | |
127 (format " %-20s %s\n" | |
128 (format "-%c" (nth 0 opt)) | |
129 (nth 4 opt))))) | |
130 ((nth 1 opt) | |
131 (setq usage | |
132 (concat usage | |
133 (format " %-20s %s\n" | |
134 (format " --%s" (nth 1 opt)) | |
135 (nth 4 opt))))) | |
136 (t (setq had-option nil))))) | |
137 (setq options (cdr options))) | |
138 (if post-usage | |
139 (setq usage (concat usage (and had-option "\n") | |
140 (cadr post-usage)))) | |
141 (when extcmd | |
142 (setq extcmd (eshell-search-path (cadr extcmd))) | |
143 (if extcmd | |
144 (setq usage | |
145 (concat usage | |
146 (format " | |
147 This command is implemented in Lisp. If an unrecognized option is | |
148 passed to this command, the external version '%s' | |
149 will be called instead." extcmd))))) | |
150 (throw 'eshell-usage usage))) | |
151 | |
152 (defun eshell-set-option (name ai opt options) | |
153 "Using NAME's remaining args (index AI), set the OPT within OPTIONS. | |
154 If the option consumes an argument for its value, the argument list | |
155 will be modified." | |
156 (if (not (nth 3 opt)) | |
157 (eshell-show-usage name options) | |
158 (if (eq (nth 2 opt) t) | |
159 (if (> ai (length args)) | |
160 (error "%s: missing option argument" name) | |
161 (set (nth 3 opt) (nth ai args)) | |
162 (if (> ai 0) | |
163 (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)) | |
164 (setq args (cdr args)))) | |
165 (set (nth 3 opt) (or (nth 2 opt) t))))) | |
166 | |
167 (defun eshell-process-option (name switch kind ai options) | |
168 "For NAME, process SWITCH (of type KIND), from args at index AI. | |
169 The SWITCH will be looked up in the set of OPTIONS. | |
170 | |
171 SWITCH should be either a string or character. KIND should be the | |
172 integer 0 if it's a character, or 1 if it's a string. | |
173 | |
174 The SWITCH is then be matched against OPTIONS. If no matching handler | |
175 is found, and an :external command is defined (and available), it will | |
176 be called; otherwise, an error will be triggered to say that the | |
177 switch is unrecognized." | |
178 (let* ((opts options) | |
179 found) | |
180 (while opts | |
181 (if (and (listp (car opts)) | |
182 (nth kind (car opts)) | |
183 (if (= kind 0) | |
184 (eq switch (nth kind (car opts))) | |
185 (string= switch (nth kind (car opts))))) | |
186 (progn | |
187 (eshell-set-option name ai (car opts) options) | |
188 (setq found t opts nil)) | |
189 (setq opts (cdr opts)))) | |
190 (unless found | |
191 (let ((extcmd (memq ':external options))) | |
192 (when extcmd | |
193 (setq extcmd (eshell-search-path (cadr extcmd))) | |
194 (if extcmd | |
195 (throw 'eshell-ext-command extcmd) | |
89489
6afa33e621d8
(eshell-process-option): Use characterp.
Dave Love <fx@gnu.org>
parents:
88123
diff
changeset
|
196 (if (characterp switch) |
29876 | 197 (error "%s: unrecognized option -%c" name switch) |
198 (error "%s: unrecognized option --%s" name switch)))))))) | |
199 | |
200 (defun eshell-process-args (name args options) | |
201 "Process the given ARGS using OPTIONS. | |
202 This assumes that symbols have been intern'd by `eshell-with-options'." | |
203 (let ((ai 0) arg) | |
204 (while (< ai (length args)) | |
205 (setq arg (nth ai args)) | |
206 (if (not (and (stringp arg) | |
207 (string-match "^-\\(-\\)?\\(.*\\)" arg))) | |
208 (setq ai (1+ ai)) | |
209 (let* ((dash (match-string 1 arg)) | |
210 (switch (match-string 2 arg))) | |
211 (if (= ai 0) | |
212 (setq args (cdr args)) | |
213 (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))) | |
214 (if dash | |
215 (if (> (length switch) 0) | |
216 (eshell-process-option name switch 1 ai options) | |
217 (setq ai (length args))) | |
218 (let ((len (length switch)) | |
219 (index 0)) | |
220 (while (< index len) | |
221 (eshell-process-option name (aref switch index) 0 ai options) | |
222 (setq index (1+ index))))))))) | |
223 args) | |
224 | |
225 ;;; Code: | |
226 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91327
diff
changeset
|
227 ;; arch-tag: 45c6c2d0-8091-46a1-a205-2f4bafd8230c |
29876 | 228 ;;; esh-opt.el ends here |