mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00
Code Issues Releases Activity

; Compute the list of symbols for 'eshell-eval-using-options' once

Browse Source 
* 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.
This commit is contained in:
Jim Porter 2024-02-13 12:27:38 -08:00
parent 371ccf09fe
commit 160165e8a9
2 changed files with 50 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lisp/eshell/esh-opt.el
View File

@ -100,29 +100,37 @@ the new process for its value.
Lastly, any remaining arguments will be available in the locally
let-bound variable `args'."
(declare (debug (form form sexp body)))
`(let* ((temp-args
,(if (memq ':preserve-args (cadr options))
(list 'copy-tree macro-args)
(list 'eshell-stringify-list
(list 'flatten-tree macro-args))))
(processed-args (eshell--do-opts ,name ,options temp-args ,macro-args))
,@(delete-dups
(delq nil (mapcar (lambda (opt)
(and (listp opt) (nth 3 opt)
`(,(nth 3 opt) (pop processed-args))))
;; `options' is of the form (quote OPTS).
(cadr options))))
(args processed-args))
;; Silence unused lexical variable warning if body does not use `args'.
(ignore args)
,@body-forms))
(let ((option-syms (eshell--get-option-symbols
;; `options' is of the form (quote OPTS).
(cadr options))))
`(let* ((temp-args
,(if (memq ':preserve-args (cadr options))
(list 'copy-tree macro-args)
(list 'eshell-stringify-list
(list 'flatten-tree macro-args))))
(args (eshell--do-opts ,name temp-args ,macro-args
,options ',option-syms))
;; Bind all the option variables. When done, `args' will
;; contain any remaining positional arguments.
,@(mapcar (lambda (sym) `(,sym (pop args))) option-syms))
;; Silence unused lexical variable warning if body does not use `args'.
(ignore args)
,@body-forms)))
;;; Internal Functions:
;; Documented part of the interface; see eshell-eval-using-options.
(defvar eshell--args)
(defun eshell--do-opts (name options args orig-args)
(defun eshell--get-option-symbols (options)
"Get a list of symbols for the specified OPTIONS.
OPTIONS is a list of command-line options from
`eshell-eval-using-options' (which see)."
(delete-dups
(delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt)))
options))))
(defun eshell--do-opts (name args orig-args options option-syms)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(require 'esh-ext)
@ -134,7 +142,8 @@ This code doesn't really need to be macro expanded everywhere."
(if (and (= (length args) 0)
(memq ':show-usage options))
(eshell-show-usage name options)
(setq args (eshell--process-args name args options))
(setq args (eshell--process-args name args options
option-syms))
nil))))
(when usage-msg
(user-error "%s" usage-msg))))))
@ -269,16 +278,13 @@ triggered to say that the switch is unrecognized."
"%s: unrecognized option --%s")
name (car switch)))))))
(defun eshell--process-args (name args options)
"Process the given ARGS using OPTIONS."
(let* ((seen ())
(opt-vals (delq nil (mapcar (lambda (opt)
(when (listp opt)
(let ((sym (nth 3 opt)))
(when (and sym (not (memq sym seen)))
(push sym seen)
(list sym)))))
options)))
(defun eshell--process-args (name args options option-syms)
"Process the given ARGS for the command NAME using OPTIONS.
OPTION-SYMS is a list of symbols that will hold the processed arguments.
Return a list of values corresponding to each element in OPTION-SYMS,
followed by any additional positional arguments."
(let* ((opt-vals (mapcar #'list option-syms))
(ai 0) arg
(eshell--args args)
(pos-argument-found nil))

24
test/lisp/eshell/esh-opt-tests.el
View File

@ -29,13 +29,15 @@
(eshell--process-args
"sudo" '("-a")
'((?a "all" nil show-all
"do not ignore entries starting with .")))))
"do not ignore entries starting with ."))
'(show-all))))
(should
(equal '("root" "world")
(eshell--process-args
"sudo" '("-u" "root" "world")
'((?u "user" t user
"execute a command as another USER"))))))
"execute a command as another USER"))
'(user)))))
(ert-deftest esh-opt-test/process-args-parse-leading-options-only ()
"Test behavior of :parse-leading-options-only in `eshell--process-args'."
@ -45,20 +47,23 @@
"sudo" '("emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
:parse-leading-options-only))))
:parse-leading-options-only)
'(user))))
(should
(equal '("root" "emerge" "-uDN" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER")
:parse-leading-options-only))))
:parse-leading-options-only)
'(user))))
(should
(equal '("DN" "emerge" "world")
(eshell--process-args
"sudo" '("-u" "root" "emerge" "-uDN" "world")
'((?u "user" t user
"execute a command as another USER"))))))
"execute a command as another USER"))
'(user)))))
(ert-deftest esh-opt-test/process-args-external ()
"Test behavior of :external in `eshell--process-args'."
@ -69,7 +74,8 @@
"ls" '("/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
:external "ls")))))
:external "ls")
'(show-all)))))
(cl-letf (((symbol-function 'eshell-search-path) #'identity))
(should
(equal '(no-catch eshell-ext-command "ls")
@ -78,7 +84,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
:external "ls"))
:external "ls")
'(show-all))
:type 'no-catch))))
(cl-letf (((symbol-function 'eshell-search-path) #'ignore))
(should-error
@ -86,7 +93,8 @@
"ls" '("-u" "/some/path")
'((?a "all" nil show-all
"do not ignore entries starting with .")
:external "ls"))
:external "ls")
'(show-all))
:type 'error)))
(ert-deftest esh-opt-test/eval-using-options-short ()