aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Porter2024-02-13 12:27:38 -0800
committerJim Porter2024-02-13 12:27:38 -0800
commit160165e8a97cfa3f3ffd803be373a3b34ed87597 (patch)
tree714a72484f135fc651f709ff62efba70c42cd3cb
parent371ccf09fea26892a2fada028d27fb4b596636df (diff)
downloademacs-160165e8a97cfa3f3ffd803be373a3b34ed87597.tar.gz
emacs-160165e8a97cfa3f3ffd803be373a3b34ed87597.zip
; Compute the list of symbols for 'eshell-eval-using-options' once
* lisp/eshell/esh-opt.el (eshell--get-option-symbols): New function... (eshell-eval-using-options): ... use it. (eshell--do-opts, eshell--process-args): Take OPTION-SYMS. * test/lisp/eshell/esh-opt-tests.el (esh-opt-test/process-args): (esh-opt-test/process-args-parse-leading-options-only): (esh-opt-test/process-args-external): Pass OPTION-SYMS in.
-rw-r--r--lisp/eshell/esh-opt.el62
-rw-r--r--test/lisp/eshell/esh-opt-tests.el24
2 files changed, 50 insertions, 36 deletions
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index d01e3569d57..e6f5fc9629a 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -100,29 +100,37 @@ the new process for its value.
100Lastly, any remaining arguments will be available in the locally 100Lastly, any remaining arguments will be available in the locally
101let-bound variable `args'." 101let-bound variable `args'."
102 (declare (debug (form form sexp body))) 102 (declare (debug (form form sexp body)))
103 `(let* ((temp-args 103 (let ((option-syms (eshell--get-option-symbols
104 ,(if (memq ':preserve-args (cadr options)) 104 ;; `options' is of the form (quote OPTS).
105 (list 'copy-tree macro-args) 105 (cadr options))))
106 (list 'eshell-stringify-list 106 `(let* ((temp-args
107 (list 'flatten-tree macro-args)))) 107 ,(if (memq ':preserve-args (cadr options))
108 (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) 108 (list 'copy-tree macro-args)
109 ,@(delete-dups 109 (list 'eshell-stringify-list
110 (delq nil (mapcar (lambda (opt) 110 (list 'flatten-tree macro-args))))
111 (and (listp opt) (nth 3 opt) 111 (args (eshell--do-opts ,name temp-args ,macro-args
112 `(,(nth 3 opt) (pop processed-args)))) 112 ,options ',option-syms))
113 ;; `options' is of the form (quote OPTS). 113 ;; Bind all the option variables. When done, `args' will
114 (cadr options)))) 114 ;; contain any remaining positional arguments.
115 (args processed-args)) 115 ,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms))
116 ;; Silence unused lexical variable warning if body does not use `args'. 116 ;; Silence unused lexical variable warning if body does not use `args'.
117 (ignore args) 117 (ignore args)
118 ,@body-forms)) 118 ,@body-forms)))
119 119
120;;; Internal Functions: 120;;; Internal Functions:
121 121
122;; Documented part of the interface; see eshell-eval-using-options. 122;; Documented part of the interface; see eshell-eval-using-options.
123(defvar eshell--args) 123(defvar eshell--args)
124 124
125(defun eshell--do-opts (name options args orig-args) 125(defun eshell--get-option-symbols (options)
126 "Get a list of symbols for the specified OPTIONS.
127OPTIONS is a list of command-line options from
128`eshell-eval-using-options' (which see)."
129 (delete-dups
130 (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt)))
131 options))))
132
133(defun eshell--do-opts (name args orig-args options option-syms)
126 "Helper function for `eshell-eval-using-options'. 134 "Helper function for `eshell-eval-using-options'.
127This code doesn't really need to be macro expanded everywhere." 135This code doesn't really need to be macro expanded everywhere."
128 (require 'esh-ext) 136 (require 'esh-ext)
@@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere."
134 (if (and (= (length args) 0) 142 (if (and (= (length args) 0)
135 (memq ':show-usage options)) 143 (memq ':show-usage options))
136 (eshell-show-usage name options) 144 (eshell-show-usage name options)
137 (setq args (eshell--process-args name args options)) 145 (setq args (eshell--process-args name args options
146 option-syms))
138 nil)))) 147 nil))))
139 (when usage-msg 148 (when usage-msg
140 (user-error "%s" usage-msg)))))) 149 (user-error "%s" usage-msg))))))
@@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized."
269 "%s: unrecognized option --%s") 278 "%s: unrecognized option --%s")
270 name (car switch))))))) 279 name (car switch)))))))
271 280
272(defun eshell--process-args (name args options) 281(defun eshell--process-args (name args options option-syms)
273 "Process the given ARGS using OPTIONS." 282 "Process the given ARGS for the command NAME using OPTIONS.
274 (let* ((seen ()) 283OPTION-SYMS is a list of symbols that will hold the processed arguments.
275 (opt-vals (delq nil (mapcar (lambda (opt) 284
276 (when (listp opt) 285Return a list of values corresponding to each element in OPTION-SYMS,
277 (let ((sym (nth 3 opt))) 286followed by any additional positional arguments."
278 (when (and sym (not (memq sym seen))) 287 (let* ((opt-vals (mapcar #'list option-syms))
279 (push sym seen)
280 (list sym)))))
281 options)))
282 (ai 0) arg 288 (ai 0) arg
283 (eshell--args args) 289 (eshell--args args)
284 (pos-argument-found nil)) 290 (pos-argument-found nil))
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el
index 8d6e0c1e426..4e5373e53cd 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -29,13 +29,15 @@
29 (eshell--process-args 29 (eshell--process-args
30 "sudo" '("-a") 30 "sudo" '("-a")
31 '((?a "all" nil show-all 31 '((?a "all" nil show-all
32 "do not ignore entries starting with ."))))) 32 "do not ignore entries starting with ."))
33 '(show-all))))
33 (should 34 (should
34 (equal '("root" "world") 35 (equal '("root" "world")
35 (eshell--process-args 36 (eshell--process-args
36 "sudo" '("-u" "root" "world") 37 "sudo" '("-u" "root" "world")
37 '((?u "user" t user 38 '((?u "user" t user
38 "execute a command as another USER")))))) 39 "execute a command as another USER"))
40 '(user)))))
39 41
40(ert-deftest esh-opt-test/process-args-parse-leading-options-only () 42(ert-deftest esh-opt-test/process-args-parse-leading-options-only ()
41 "Test behavior of :parse-leading-options-only in `eshell--process-args'." 43 "Test behavior of :parse-leading-options-only in `eshell--process-args'."
@@ -45,20 +47,23 @@
45 "sudo" '("emerge" "-uDN" "world") 47 "sudo" '("emerge" "-uDN" "world")
46 '((?u "user" t user 48 '((?u "user" t user
47 "execute a command as another USER") 49 "execute a command as another USER")
48 :parse-leading-options-only)))) 50 :parse-leading-options-only)
51 '(user))))
49 (should 52 (should
50 (equal '("root" "emerge" "-uDN" "world") 53 (equal '("root" "emerge" "-uDN" "world")
51 (eshell--process-args 54 (eshell--process-args
52 "sudo" '("-u" "root" "emerge" "-uDN" "world") 55 "sudo" '("-u" "root" "emerge" "-uDN" "world")
53 '((?u "user" t user 56 '((?u "user" t user
54 "execute a command as another USER") 57 "execute a command as another USER")
55 :parse-leading-options-only)))) 58 :parse-leading-options-only)
59 '(user))))
56 (should 60 (should
57 (equal '("DN" "emerge" "world") 61 (equal '("DN" "emerge" "world")
58 (eshell--process-args 62 (eshell--process-args
59 "sudo" '("-u" "root" "emerge" "-uDN" "world") 63 "sudo" '("-u" "root" "emerge" "-uDN" "world")
60 '((?u "user" t user 64 '((?u "user" t user
61 "execute a command as another USER")))))) 65 "execute a command as another USER"))
66 '(user)))))
62 67
63(ert-deftest esh-opt-test/process-args-external () 68(ert-deftest esh-opt-test/process-args-external ()
64 "Test behavior of :external in `eshell--process-args'." 69 "Test behavior of :external in `eshell--process-args'."
@@ -69,7 +74,8 @@
69 "ls" '("/some/path") 74 "ls" '("/some/path")
70 '((?a "all" nil show-all 75 '((?a "all" nil show-all
71 "do not ignore entries starting with .") 76 "do not ignore entries starting with .")
72 :external "ls"))))) 77 :external "ls")
78 '(show-all)))))
73 (cl-letf (((symbol-function 'eshell-search-path) #'identity)) 79 (cl-letf (((symbol-function 'eshell-search-path) #'identity))
74 (should 80 (should
75 (equal '(no-catch eshell-ext-command "ls") 81 (equal '(no-catch eshell-ext-command "ls")
@@ -78,7 +84,8 @@
78 "ls" '("-u" "/some/path") 84 "ls" '("-u" "/some/path")
79 '((?a "all" nil show-all 85 '((?a "all" nil show-all
80 "do not ignore entries starting with .") 86 "do not ignore entries starting with .")
81 :external "ls")) 87 :external "ls")
88 '(show-all))
82 :type 'no-catch)))) 89 :type 'no-catch))))
83 (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) 90 (cl-letf (((symbol-function 'eshell-search-path) #'ignore))
84 (should-error 91 (should-error
@@ -86,7 +93,8 @@
86 "ls" '("-u" "/some/path") 93 "ls" '("-u" "/some/path")
87 '((?a "all" nil show-all 94 '((?a "all" nil show-all
88 "do not ignore entries starting with .") 95 "do not ignore entries starting with .")
89 :external "ls")) 96 :external "ls")
97 '(show-all))
90 :type 'error))) 98 :type 'error)))
91 99
92(ert-deftest esh-opt-test/eval-using-options-short () 100(ert-deftest esh-opt-test/eval-using-options-short ()