Re: [Logs-devel] cl-cli proposal -- defopt

[Vijay Lakshminarayanan]

Hi Jim,

Here are the modified cl-cli functions:

;; process all options given on the command line
(defun process-options (options-list args)
 (declare (ignorable options-list))
 (flet ((nextarg ()
          (loop with seenflag = 'nil
                as arg in args
                if (not seenflag)
                  do (setq seenflag t)
                else if (optionp arg)
                  do (loop-finish)
                collect (pop args))))
   (loop as cdr on args until (optionp (car cdr)) finally (setq args cdr))
   (loop as nextopt = (nextarg)
         while nextopt
         do (process-switch nextopt options-list))))

(defun optionp (string)
 "Is STRING a command line option?"
 (or (starts-with-p string "--") (starts-with-p string "-")))

(defun starts-with-p (string1 string2 &key (test #'string=))
 "Does STRING1 start with STRING2?"
 (and (>= (length string1) (length string2))
      (funcall test string1 string2 :end1 (length string2))))

(defun same-name-p (string name)
 "Is NAME the same as STRING in terms of command line options?"
 (or (equal name (subseq string 1)) (equal name (subseq string 2))))

;; process an individual switch
(defun process-switch (list options-list)
 (let* ((switch (pop list))
        (opt (car (member switch options-list
                          :test #'(lambda (a b) (same-name-p a (name b)))))))
   (when opt
     (let ((numargs (length list)))
       (multiple-value-bind (minargs maxargs)
           (option-lengths opt)

         (cond
           ((< numargs minargs)
            (error "too few arguments for flag: ~A expecting ~A to
~A, given ~A~%"
                   (name opt) minargs maxargs numargs))
           ((and (numberp maxargs) (> numargs maxargs))
            (error "too many arguments for flag: ~A expecting ~A to
~A, given ~A~%"
                   (name opt) minargs maxargs numargs))
           ((action opt)
            (apply (action opt) list))))))))

;; pull the next flag & its args off the args list
(defun option-lengths (option)
 (let ((min-args 0) ; minimum arguments to this flag
       (max-args 0) ; maximum arguments to this flag
       (seen-optional-arg nil) ; has an optional argument been seen?
       (multiargs nil) ; are an infinite number of arguments possible?
       )
   (flet ((specialp (arg)
            (and (symbolp arg) (char= (elt (symbol-name arg) 0) #\&)))
          (special (arg)
            (let ((arg (intern (symbol-name arg))))
              (ecase arg
                (&optional (setq seen-optional-arg t))
                (&rest (setq multiargs t))
                ((&body &key)
                 (error "Cannot support ~a for command line." arg))))))
     (loop as arg in (arguments option)
           if (specialp arg)
           do (special arg)
           else
           do (incf max-args)
           and unless (or seen-optional-arg multiargs)
               do (incf min-args)
           finally (return (if multiargs
                               (values min-args ())
                               (values min-args max-args)))))))

tell me if you'd rather have the diff file.

I tested it using SBCL on my machine (sbcl allows #! scripts)

Here are the contents of my cli.lisp file:

#!/usr/bin/sbcl --noinform

(require 'cl-cli)

(use-package :cl-cli)

(defun print-file (filename)
 (with-open-file (file filename)
   (loop as line = (read-line file nil nil)
         while line
         do (format *standard-output* "~a~%" line))))

(defvar *opts* NIL)

(defmacro defopt (&key name arguments action description)
 (let ((opt (gensym)))
  `(let ((,opt (make-instance 'cli-opt
                              :name ,name
                              :arguments ',arguments
                              :action ,action
                              :description ,description)))
    (setq *opts* (nconc *opts* (list ,opt)))
    ,opt)))

(defopt
 :name "sum"
 :arguments (&rest args)
 :action #'(lambda (&rest args)
             (loop as i in args
                   summing (parse-integer i) into sum
                   finally (format *standard-output* "~a~%"
                                   sum)))
 :description "Adds the arguments it receives")

(defopt
 :name "cat"
 :arguments (filename)
 :action #'print-file
 :description "Does the equivalent of the UNIX `cat' command.")

(eval-when (:execute)
 (let ((args (cl-cli:get-application-args)))
   (cl-cli:process-options *opts* args)))

;;;;;

And here is my bash interactions:

address@hidden foo]$ ./cli.lisp --sum 12 23 34 45
114
address@hidden foo]$ ./cli.lisp --sum 10 12 --cat ~/.sbclrc
22
;;; -*- Mode: Lisp; -*-
;;; If the first user-processable command-line argument is a filename,
;;; disable the debugger, load the file handling shebang-line and quit.
(let ((script (and (second *posix-argv*)
                  (probe-file (second *posix-argv*)))))
 (when script
   ;; Handle shebang-line
   (set-dispatch-macro-character #\# #\!
                                 (lambda (stream char arg)
                                   (declare (ignore char arg))
                                   (read-line stream)))
   ;; Disable debugger
   (setf *invoke-debugger-hook*
         (lambda (condition hook)
           (declare (ignore hook))
           ;; Uncomment to get backtraces on errors
           ;; (sb-debug:backtrace 20)
           (format *error-output* "Error: ~A~%" condition)
           (quit)))
   (load script)
   (quit)))

(require '#:asdf)
address@hidden foo]$

Thanks
Vijay

On 6/26/06, Vijay Lakshminarayanan <address@hidden> wrote:
> Hi Jim
>
> I also think that PROCESS-OPTIONS is better written as
>
> (defun process-options (options-list args)
>   (declare (ignorable options-list))
>   (macrolet ((nextarg ()
>                '(loop with seenflag = 'nil
>                       as arg in args
>                       if (not seenflag)
>                         do (setq seenflag t)
>                       else if (optionp arg)
>                         do (loop-finish)
>                       collect (pop args))))
>     (loop initially (loop as cdarg on args
>                           ;; Removes the elements that don't start
>                           ;; with an option.  So
>                           ;; ("lisp" "LoGS.lisp" "--help")
>                           ;; will become ("--help")
>                           until (optionp (car cdarg))
>                           finally (setq args cdarg))
>           as nextopt = (nextarg)
>           while nextopt
>           collect nextopt)))
>
> (defun optionp (string)
>   "Is STRING an option?"
>   (or (starts-with "-" string) (starts-with "--" string)))
>
> (defun starts-with-p (string1 string2 &key (test #'string=))
>   "Does STRING1 start with STRING2?"
>   (and (>= (length string1) (length string2))
>        (funcall test string1 string2 :end1 (length string2))))
>
> The macrolet is so simple now that maybe we could just make it a flet.
>
> I really love the LOOP macro :-)
>
> Thanks Jim
> Vijay
>
> On 6/25/06, Vijay Lakshminarayanan <address@hidden> wrote:
> > On 6/25/06, Jim Prewett <address@hidden> wrote:
> > >
> > > Hello,
> > >
> > > I'm thinking a more elegant way to specify a command line option might be
> > > a macro I'm working on called defopt.  Here is an example usage:
> > >
> > > (defopt
> > >         ;; the name of the flag is "file"
> > >         "file"
> > >         ;; the flag takes a filename parameter and optional position
> > >         ;; parameter
> > >         (filename &optional position)
> > >         ;; expression (with parameters bound)
> > >         ;; to set up things properly for that flag
> > >         ;; (this is the body of the lambda function)
> > >         (let ((ff
> > >                (make-instance
> > >                 'org.prewett.LoGS::File-Follower
> > >                 :FileName
> > >                 filename)))
> > >                 ;; if position is specified, start there
> > >                 (when position
> > >                 (when (not ff) (error "no ff~%"))
> > >                 (org.prewett.LoGS::set-file-follower-position
> > >                  ff
> > >                  (read-from-string position)))
> > >                 (push ff *file-list*))
> > >         ;; a list of (optional) aliases for this flag
> > >         :aliases '("f")
> > >         ;; the description of this flag, used in the help text
> > >         :description "file to read from")
> > >
> > > Does this look somewhat reasonable?
> > >
> > > I'm thinking that by specifying an option this way, the user only has to
> > > specify the argument list once, and in a much more lispy way IMO.
> >
> > It is better than the old scheme :-)  but I don't like many things.
> >
> > Also, why not have defopt accept the parameters as keyword arguments?
> > It makes things clearer and reduces the need for comments.
> >
> > Something like:
> > (defopt :name "file" :alias '("f" "ff")
> >         :params (filename &optional position)
> >         :action (list filename position))
> >
> > There are several problems with :action
> >
> > First, you cannot have recursive functions.  All actions must start
> > with an explicit progn or a let or block.  Take the case where an
> > action must start with a DECLARE form.
> >
> > Also we cannot reuse functions with this syntax.  I think we should
> > keep the original syntax but instead of strings use sexps.  It doesn't
> > matter that we are forced to repeat because of the benefits and
> > freedoms we get as a consequence.
> >
> > Here are a few examples:
> >
> > :parameters (one two &optional three)
> > :actions #'list
> >
> > :parameters (one two three)
> > :actions (lambda (&rest args)
> >
> > Here's an implementation of option-lengths that uses symbols:
> >
> > (defun option-lengths (option)
> >   (let ((min-args 0) ; minimum arguments to this flag
> >         (max-args 0) ; maximum arguments to this flag
> >         (seen-optional-arg nil) ; has an optional argument been seen?
> >         (multiargs nil) ; are an infinite number of arguments possible?
> >         )
> >     (flet ((specialp (arg)
> >              (and (symbolp arg) (char= (elt (symbol-name arg) 0) #\&)))
> >            (special (arg)
> >              (let ((arg (intern (symbol-name arg))))
> >                (ecase arg
> >                  (&optional (setq seen-optional-arg t))
> >                  (&rest (setq multiargs t))
> >                  ((&body &key)
> >                   (error "Cannot support ~a for command line." arg))))))
> >       (loop as arg in (arguments option)
> >             if (specialp arg)
> >             do (special arg)
> >             else
> >             do (incf max-args)
> >             and unless (or seen-optional-arg multiargs)
> >             do (incf min-args)
> >             finally (return (if (or multiargs seen-optional-arg)
> >                                 (values min-args max-args)
> >                                 (values min-args ())))))))
> >
> > While writing this, it occured to me that you could very easily parse
> > the options that took single options using:
> > (destructuring-bind (&key foo bar baz) (get-application-args)
> >   &body)
> >
> > IMHO there will be places where using a different lambda-list for the
> > action and the explicit arguments might make life easier for the
> > programmer.  At the same time, as a lisper, I do think life can be
> > made simpler with having to specify the arglist only in one place
> > since that is the majority of how anyone would like it.  Duplicating
> > the code is also error-prone, I admit.
> >
> > But I would recommend that we keep the arguments and actions
> > parameters independant of each other.
> >
> > > Jim
> > Thanks
> > Vijay
> >