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:
parent
e762cad053
commit
aa12f9de8c
5 changed files with 32 additions and 13 deletions
|
|
@ -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+)
|
||||||
|
|
|
||||||
|
|
@ -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 ***
|
||||||
|
|
|
||||||
|
|
@ -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},
|
||||||
|
|
|
||||||
|
|
@ -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},
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue