X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a64bfdfa5a90731b804c057f2bcc74a8ba02937c..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/eshell/esh-opt.el diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 91d3cac198..d0929db546 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -1,6 +1,6 @@ -;;; esh-opt.el --- command options processing +;;; esh-opt.el --- command options processing -*- lexical-binding:t -*- -;; Copyright (C) 1999-2011 Free Software Foundation, Inc. +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: John Wiegley @@ -25,13 +25,14 @@ (provide 'esh-opt) -(eval-when-compile (require 'esh-ext)) +(require 'esh-ext) -(defgroup eshell-opt nil - "The options processing code handles command argument parsing for -Eshell commands implemented in Lisp." - :tag "Command options processing" - :group 'eshell) +;; Unused. +;; (defgroup eshell-opt nil +;; "The options processing code handles command argument parsing for +;; Eshell commands implemented in Lisp." +;; :tag "Command options processing" +;; :group 'eshell) ;;; User Functions: @@ -81,7 +82,7 @@ and `eshell-stringify-list'. For example, OPTIONS might look like: - '((?C nil nil multi-column \"multi-column display\") + ((?C nil nil multi-column \"multi-column display\") (nil \"help\" nil nil \"show this usage display\") (?r \"reverse\" nil reverse-list \"reverse order while sorting\") :external \"ls\" @@ -97,49 +98,44 @@ the new process for its value. Lastly, any remaining arguments will be available in a locally interned variable `args' (created using a `let' form)." (declare (debug (form form sexp body))) - `(let ((temp-args - ,(if (memq ':preserve-args (cadr options)) - macro-args - (list 'eshell-stringify-list - (list 'eshell-flatten-list macro-args))))) - (let ,(append (delq nil (mapcar (lambda (opt) - (and (listp opt) (nth 3 opt))) - (cadr options))) - '(usage-msg last-value ext-command args)) - (eshell-do-opt ,name ,options (quote ,body-forms))))) + `(let* ((temp-args + ,(if (memq ':preserve-args (cadr options)) + macro-args + (list 'eshell-stringify-list + (list 'eshell-flatten-list macro-args)))) + (processed-args (eshell--do-opts ,name ,options temp-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)) + ,@body-forms)) ;;; Internal Functions: -(defvar temp-args) -(defvar last-value) -(defvar usage-msg) -(defvar ext-command) ;; Documented part of the interface; see eshell-eval-using-options. -(defvar args) +(defvar eshell--args) -(defun eshell-do-opt (name options body-forms) +(defun eshell--do-opts (name options args) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." - (setq args temp-args) - (if (setq - ext-command - (catch 'eshell-ext-command - (when (setq - usage-msg - (catch 'eshell-usage - (setq last-value nil) - (if (and (= (length args) 0) - (memq ':show-usage options)) - (throw 'eshell-usage - (eshell-show-usage name options))) - (setq args (eshell-process-args name args options) - last-value (eval (append (list 'progn) - body-forms))) - nil)) - (error "%s" usage-msg)))) - (throw 'eshell-external - (eshell-external-command ext-command args)) - last-value)) + (let ((ext-command + (catch 'eshell-ext-command + (let ((usage-msg + (catch 'eshell-usage + (if (and (= (length args) 0) + (memq ':show-usage options)) + (eshell-show-usage name options) + (setq args (eshell--process-args name args options)) + nil)))) + (when usage-msg + (error "%s" usage-msg)))))) + (if ext-command + (throw 'eshell-external + (eshell-external-command ext-command args)) + args))) (defun eshell-show-usage (name options) "Display the usage message for NAME, using OPTIONS." @@ -182,28 +178,30 @@ This code doesn't really need to be macro expanded everywhere." (if extcmd (setq usage (concat usage - (format " + (format-message " This command is implemented in Lisp. If an unrecognized option is -passed to this command, the external version '%s' +passed to this command, the external version `%s' will be called instead." extcmd))))) (throw 'eshell-usage usage))) -(defun eshell-set-option (name ai opt options) +(defun eshell--set-option (name ai opt options opt-vals) "Using NAME's remaining args (index AI), set the OPT within OPTIONS. If the option consumes an argument for its value, the argument list will be modified." (if (not (nth 3 opt)) (eshell-show-usage name options) - (if (eq (nth 2 opt) t) - (if (> ai (length args)) - (error "%s: missing option argument" name) - (set (nth 3 opt) (nth ai args)) - (if (> ai 0) - (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)) - (setq args (cdr args)))) - (set (nth 3 opt) (or (nth 2 opt) t))))) - -(defun eshell-process-option (name switch kind ai options) + (setcdr (assq (nth 3 opt) opt-vals) + (if (eq (nth 2 opt) t) + (if (> ai (length eshell--args)) + (error "%s: missing option argument" name) + (prog1 (nth ai eshell--args) + (if (> ai 0) + (setcdr (nthcdr (1- ai) eshell--args) + (nthcdr (1+ ai) eshell--args)) + (setq eshell--args (cdr eshell--args))))) + (or (nth 2 opt) t))))) + +(defun eshell--process-option (name switch kind ai options opt-vals) "For NAME, process SWITCH (of type KIND), from args at index AI. The SWITCH will be looked up in the set of OPTIONS. @@ -218,12 +216,10 @@ switch is unrecognized." found) (while opts (if (and (listp (car opts)) - (nth kind (car opts)) - (if (= kind 0) - (eq switch (nth kind (car opts))) - (string= switch (nth kind (car opts))))) + (nth kind (car opts)) + (equal switch (nth kind (car opts)))) (progn - (eshell-set-option name ai (car opts) options) + (eshell--set-option name ai (car opts) options opt-vals) (setq found t opts nil)) (setq opts (cdr opts)))) (unless found @@ -232,14 +228,22 @@ switch is unrecognized." (setq extcmd (eshell-search-path (cadr extcmd))) (if extcmd (throw 'eshell-ext-command extcmd) - (if (characterp switch) - (error "%s: unrecognized option -%c" name switch) - (error "%s: unrecognized option --%s" name switch)))))))) - -(defun eshell-process-args (name args options) - "Process the given ARGS using OPTIONS. -This assumes that symbols have been intern'd by `eshell-eval-using-options'." - (let ((ai 0) arg) + (error (if (characterp switch) "%s: unrecognized option -%c" + "%s: unrecognized option --%s") + name 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))) + (ai 0) arg + (eshell--args args)) (while (< ai (length args)) (setq arg (nth ai args)) (if (not (and (stringp arg) @@ -252,13 +256,14 @@ This assumes that symbols have been intern'd by `eshell-eval-using-options'." (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))) (if dash (if (> (length switch) 0) - (eshell-process-option name switch 1 ai options) + (eshell--process-option name switch 1 ai options opt-vals) (setq ai (length args))) (let ((len (length switch)) (index 0)) (while (< index len) - (eshell-process-option name (aref switch index) 0 ai options) - (setq index (1+ index))))))))) - args) + (eshell--process-option name (aref switch index) + 0 ai options opt-vals) + (setq index (1+ index)))))))) + (nconc (mapcar #'cdr opt-vals) args))) ;;; esh-opt.el ends here