diff options
| author | Jim Porter | 2024-02-13 12:27:38 -0800 |
|---|---|---|
| committer | Jim Porter | 2024-02-13 12:27:38 -0800 |
| commit | 160165e8a97cfa3f3ffd803be373a3b34ed87597 (patch) | |
| tree | 714a72484f135fc651f709ff62efba70c42cd3cb | |
| parent | 371ccf09fea26892a2fada028d27fb4b596636df (diff) | |
| download | emacs-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.el | 62 | ||||
| -rw-r--r-- | test/lisp/eshell/esh-opt-tests.el | 24 |
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. | |||
| 100 | Lastly, any remaining arguments will be available in the locally | 100 | Lastly, any remaining arguments will be available in the locally |
| 101 | let-bound variable `args'." | 101 | let-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. | ||
| 127 | OPTIONS 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'. |
| 127 | This code doesn't really need to be macro expanded everywhere." | 135 | This 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 ()) | 283 | OPTION-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) | 285 | Return a list of values corresponding to each element in OPTION-SYMS, |
| 277 | (let ((sym (nth 3 opt))) | 286 | followed 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 () |