Changed the behavior of the :stop option in process-command-args and added a new global variable, ext:*unprocessed-ecl-command-args*, that groups all arguments after --

This commit is contained in:
Juan Jose Garcia Ripoll 2011-01-30 15:59:03 +01:00
parent e762cad053
commit aa12f9de8c
5 changed files with 32 additions and 13 deletions

View file

@ -23,7 +23,7 @@ ls [--help | -?] filename*
(defconstant +ls-rules+ (defconstant +ls-rules+
'(("--help" 0 (progn (princ ext:*help-message* *standard-output*) (ext:quit 0))) '(("--help" 0 (progn (princ ext:*help-message* *standard-output*) (ext:quit 0)))
("-?" 0 (progn (princ ext:*help-message* *standard-output*) (ext:quit 0))) ("-?" 0 (progn (princ ext:*help-message* *standard-output*) (ext:quit 0)))
("*DEFAULT*" 1 (print-directory 1)))) ("*DEFAULT*" 1 (print-directory 1) :stop)))
(let ((ext:*lisp-init-file-list* NIL)) ; No initialization files (let ((ext:*lisp-init-file-list* NIL)) ; No initialization files
(handler-case (ext:process-command-args :rules +ls-rules+) (handler-case (ext:process-command-args :rules +ls-rules+)

View file

@ -176,6 +176,17 @@ ECL 11.1.2
(GC, libffi) are in a similar location this will make ECL work without (GC, libffi) are in a similar location this will make ECL work without
further flags, and without modifying LD_LIBRARY_PATH or DYLD_LIBRARY_PATH. further flags, and without modifying LD_LIBRARY_PATH or DYLD_LIBRARY_PATH.
- All arguments after the '--' command line option are stored in a global
variable, ext:*unprocessed-ecl-command-args*.
- In the rules passed to ext:process-command-args, :stop now implies that all
remaining arguments including the current one are collected and passed to
the rule code. An example of use of this option
;; Collect all arguments _after_ the command line option --
("--" 1 (setf ext:*unprocessed-ecl-command-args* (rest 1)) :stop)
;; Collect all arguments including the first unknown one
("*DEFAULTS*" 1 (setf ext:*unprocessed-ecl-command-args* 1) :stop)
;;; Local Variables: *** ;;; Local Variables: ***
;;; mode:text *** ;;; mode:text ***
;;; fill-column:79 *** ;;; fill-column:79 ***

View file

@ -1980,6 +1980,7 @@ cl_symbols[] = {
{EXT_ "COMMAND-ARGS", EXT_ORDINARY, NULL, -1, OBJNULL}, {EXT_ "COMMAND-ARGS", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "*COMMAND-ARGS*", EXT_SPECIAL, NULL, -1, Cnil}, {EXT_ "*COMMAND-ARGS*", EXT_SPECIAL, NULL, -1, Cnil},
{EXT_ "PROCESS-COMMAND-ARGS", EXT_ORDINARY, NULL, -1, OBJNULL}, {EXT_ "PROCESS-COMMAND-ARGS", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "*UNPROCESSED-ECL-COMMAND-ARGS*", EXT_SPECIAL, NULL, -1, Cnil},
#ifdef ECL_UNICODE #ifdef ECL_UNICODE
{KEY_ "OCTETS", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "OCTETS", KEYWORD, NULL, -1, OBJNULL},

View file

@ -1980,6 +1980,7 @@ cl_symbols[] = {
{EXT_ "COMMAND-ARGS",NULL}, {EXT_ "COMMAND-ARGS",NULL},
{EXT_ "*COMMAND-ARGS*",NULL}, {EXT_ "*COMMAND-ARGS*",NULL},
{EXT_ "PROCESS-COMMAND-ARGS",NULL}, {EXT_ "PROCESS-COMMAND-ARGS",NULL},
{EXT_ "*UNPROCESSED-ECL-COMMAND-ARGS*",NULL},
#ifdef ECL_UNICODE #ifdef ECL_UNICODE
{KEY_ "OCTETS",NULL}, {KEY_ "OCTETS",NULL},

View file

@ -14,10 +14,6 @@
(in-package "SYSTEM") (in-package "SYSTEM")
(defparameter *command-args*
(loop for i from 0 below (argc)
collect (argv i)))
(defparameter *command-break-enable* nil) (defparameter *command-break-enable* nil)
(defparameter *lisp-init-file-list* '("~/.ecl" "~/.eclrc") (defparameter *lisp-init-file-list* '("~/.ecl" "~/.eclrc")
@ -36,8 +32,18 @@ Usage: ecl [-? | --help]
"Prints a help message about command line arguments of ECL") "Prints a help message about command line arguments of ECL")
(defun command-args () (defun command-args ()
"Returns the command line arguments as list" "Returns the original command line arguments as list. First argument is
*command-args*) the ECL program itself."
(loop for i from 0 below (argc)
collect (argv i)))
(defparameter *command-args*
(command-args))
(defparameter *unprocessed-ecl-command-args*
nil
"As part of ECL's command line rules, this variable stores all arguments which
appeared after a '--'.")
(defun command-arg-error (str &rest fmt-args) (defun command-arg-error (str &rest fmt-args)
;; Format an error message and quit ;; Format an error message and quit
@ -51,7 +57,6 @@ Usage: ecl [-? | --help]
("-?" 0 #0# :noloadrc) ("-?" 0 #0# :noloadrc)
("-h" 0 #0# :noloadrc) ("-h" 0 #0# :noloadrc)
("-norc" 0 nil :noloadrc) ("-norc" 0 nil :noloadrc)
("--" 0 nil :stop)
("--version" 0 ("--version" 0
(progn (setf quit 0) (progn (setf quit 0)
(format *standard-output* "ECL ~A~%" (lisp-implementation-version))) (format *standard-output* "ECL ~A~%" (lisp-implementation-version)))
@ -105,7 +110,8 @@ Usage: ecl [-? | --help]
("-q" 0 (setq verbose nil)) ("-q" 0 (setq verbose nil))
("-hp" 0 (setf *relative-package-names* t)) ("-hp" 0 (setf *relative-package-names* t))
("-nohp" 0 (setf *relative-package-names* nil)) ("-nohp" 0 (setf *relative-package-names* nil))
("-s" 0 (setq system-p t)))) ("-s" 0 (setq system-p t))
("--" 1 (setf ext:*unprocessed-ecl-command-args* (rest 1)) :stop)))
(defun produce-init-code (option-list rules) (defun produce-init-code (option-list rules)
(do* ((commands '()) (do* ((commands '())
@ -130,14 +136,14 @@ Usage: ecl [-? | --help]
;; If there is a default rule, group all remaining arguments ;; If there is a default rule, group all remaining arguments
;; including the unmatched one, and pass them to this rule. ;; including the unmatched one, and pass them to this rule.
(setf rule (assoc "*DEFAULT*" rules :test #'string=) (setf rule (assoc "*DEFAULT*" rules :test #'string=)
option-list `('(,option ,@option-list))
stop t) stop t)
(unless rule (unless rule
(command-arg-error "Unknown command line option ~A.~%" option))) (command-arg-error "Unknown command line option ~A.~%" option)))
(case (fourth rule) (case (fourth rule)
(:noloadrc (setf loadrc nil)) (:noloadrc (setf loadrc nil))
(:loadrc (setf loadrc t)) (:loadrc (setf loadrc t))
(:stop (setf option-list nil))) (:stop (setf option-list `('(,option ,@option-list))
stop t)))
(let ((pattern (copy-tree (third rule))) (let ((pattern (copy-tree (third rule)))
(noptions (second rule))) (noptions (second rule)))
(unless (equal noptions 0) (unless (equal noptions 0)
@ -152,7 +158,7 @@ Usage: ecl [-? | --help]
(push pattern commands))))) (push pattern commands)))))
(defun process-command-args (&key (defun process-command-args (&key
(args (rest (command-args))) (args (rest *command-args*))
(rules +default-command-arg-rules+)) (rules +default-command-arg-rules+))
"PROCESS-COMMAND-ARGS takes a list of arguments and processes according "PROCESS-COMMAND-ARGS takes a list of arguments and processes according
to a set of rules. These rules are of the format to a set of rules. These rules are of the format
@ -176,7 +182,7 @@ An excerpt of the rules used by ECL:
(\"--\" 0 nil :stop) (\"--\" 0 nil :stop)
(\"-eval\" 1 (eval (read-from-string 1)))) (\"-eval\" 1 (eval (read-from-string 1))))
" "
(multiple-value-bind (commands loadrc) (multiple-value-bind (commands loadrc unprocessed-options)
(produce-init-code args rules) (produce-init-code args rules)
(restart-case (restart-case
(handler-bind ((error (handler-bind ((error