Update of /project/cl-cli-parser/cvsroot/cl-cli-parser
In directory common-lisp.net:/tmp/cvs-serv18141
Modified Files:
unit-test.lisp cli-parser.lisp cli-parser-test.lisp
Log Message:
- cli-parser.lisp: pretty-printing for CLI-OPTION, various code cleanups.
- cli-parser-test.lisp: Example option configuration.
- unit-test.lisp: (get-tests): New function.
Date: Fri Jul 29 23:27:04 2005
Author: dbueno
Index: cl-cli-parser/unit-test.lisp
diff -u cl-cli-parser/unit-test.lisp:1.3 cl-cli-parser/unit-test.lisp:1.4
--- cl-cli-parser/unit-test.lisp:1.3 Sun Mar 20 00:08:37 2005
+++ cl-cli-parser/unit-test.lisp Fri Jul 29 23:27:03 2005
@@ -2,7 +2,7 @@
(defpackage :lunit
(:use :cl)
- (:export #:deftest #:check))
+ (:export #:deftest #:check #:get-tests))
(in-package :lunit)
;;; from peter seibel's book, practical common lisp
@@ -35,4 +35,11 @@
(defun report-result (result form)
"Report the results of a single test case. Called by `check'."
(format t "~:[FAIL~;pass~] ... ~a: ~w~%" result *test-name* form)
- result)
\ No newline at end of file
+ result)
+
+(defun get-tests (&optional (p *package*))
+ "Get a list of the symbols corresponding to unit test functions
+from the package P."
+ (loop for x being the symbols of p
+ if (eql 0 (search "test-" (symbol-name x) :test #'string-equal))
+ collect x))
\ No newline at end of file
Index: cl-cli-parser/cli-parser.lisp
diff -u cl-cli-parser/cli-parser.lisp:1.3 cl-cli-parser/cli-parser.lisp:1.4
--- cl-cli-parser/cli-parser.lisp:1.3 Sun Mar 20 00:08:37 2005
+++ cl-cli-parser/cli-parser.lisp Fri Jul 29 23:27:03 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cli-parser.lisp,v 1.3 2005/03/19 23:08:37 dbueno Exp $
+;;;; $Id: cli-parser.lisp,v 1.4 2005/07/29 21:27:03 dbueno Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Denis Bueno
;;;;
@@ -23,9 +23,9 @@
;;;; disclaimer in the documentation and/or other materials
;;;; provided with the distribution.
;;;;
-;;;; The name of the Denis Bueno may not be used to endorse or
-;;;; promote products derived from this software without specific
-;;;; prior written permission.
+;;;; The name of Denis Bueno may not be used to endorse or promote
+;;;; products derived from this software without specific prior written
+;;;; permission.
;;;;
;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
@@ -51,7 +51,7 @@
#:cli-parse-hash
#:cli-parse-assoc
- ;; The cli-option struct
+ ;; The CLI-OPTION class
#:cli-option
#:cli-option-abbr
#:cli-option-full
@@ -70,7 +70,7 @@
* CLI-PARSE-ASSOC
CLI-PARSE actually just calls CLI-PARSE-HASH, which will parse a
-list of command-line arguments against a list of cli-option
+list of command-line arguments against a list of CLI-OPTION
objects. CLI-PARSE-ASSOC, instead of returning a hash table of
results like CLI-PARSE-HASH does, returns an assoc list of
results.
@@ -81,33 +81,105 @@
in (as a list of strings, one for each option) along with the
list of valid options are passed to cli-parse, which will give
you a table of mappings, from the option to the setting specified
-by the user.
-
-See the cli-option struct for some details."))
+by the user."))
(in-package :cli-parser)
+(declaim (optimize (debug 3) (safety 3) (speed 0) (compilation-speed 0)))
-;;; TODO: decide what to do if see an option like -cookycrisp: continuable
-;;; error/condition restart, ignore?
+;;; TODO
+;;;
+;;; * decide what to do if see an option like -cookycrisp: continuable
+;;; error/condition restart, ignore?
+;;;
+;;; * depend on SPLIT-SEQUENCE rather than own STRING-TOKENIZE
(defclass cli-option ()
- ((abbreviation :initarg :abbr :accessor cli-option-abbr)
- (longname :initarg :full :accessor cli-option-full)
+ ((abbreviation :initarg :abbr :accessor cli-option-abbr
+ :type (or null string))
+ (longname :initarg :full :accessor cli-option-full
+ :type string)
(argumentsp :initform nil
:initarg :requires-arguments
- :accessor cli-option-requires-arguments)
+ :accessor cli-option-requires-arguments
+ :type (member nil t :optional))
(description :initform "Default description."
- :initarg :description :accessor cli-option-description)
- (example :initarg :example :accessor cli-option-example)))
-
-(defun make-cli-option (&rest initargs)
- (apply #'make-instance 'cli-option initargs))
+ :initarg :description :accessor cli-option-description
+ :type string)
+ (example :initarg :example :accessor cli-option-example
+ :type string)))
+
+(defmacro pprint-clos-class (instance slots stream
+ &key
+ (inter-slot-newline-style :linear)
+ (intra-slot-newline-style :fill)
+ (unbound-msg "<unbound>")
+ (slot-value-callback '(lambda (a1 a2)
+ (declare (ignore a1))
+ a2)))
+ "Pretty print the SLOTS of a CLOS class INSTANCE, to
+ STREAM.
+
+ INTER-SLOT-NEWLINE-STYLE and INTRA-SLOT-NEWLINE-STYLE may be any
+ value appropriate appropriate as the first argument to
+ PPRINT-NEWLINE. A newline of INTER-SLOT-NEWLINE-STYLE will be
+ printed between each of the slot-name/slot-value pairs of each
+ slot in SLOTS. A newline of INTRA-SLOT-NEWLINE-STYLE will be
+ printed between the slot-name and the slot-value of each slot
+ in SLOTS.
+
+ UNBOUND-MSG should be a string which will be printed as the
+ slot-value for any slot in INSTANCE which is unbound.
+
+ SLOT-VALUE-CALLBACK should be a function of two arguments, the
+ slot-name and the slot-value, which should return an object
+ which will be printed in place of the slot-value for
+ slot-name.
+
+ Example:
+
+ > (defclass foo () (a b))
+ #<STANDARD-CLASS FOO>
+ > (defmethod cl:print-object ((f foo) stream)
+ (pprint-clos-class f (a b) stream))
+ #<STANDARD-METHOD PRINT-OBJECT (FOO T) {4865E569}>
+ > (make-instance 'foo)
+ #<FOO :A <unbound> :B <unbound>>
+ > (setf (slot-value * 'a) 'bar)
+ BAR
+ > **
+ #<FOO :A BAR :B <unbound>>"
+ (macrolet ((with-gensyms ((&rest syms) &body body)
+ `(let ,(loop for sym in syms
+ collect `(,sym (gensym ,(symbol-name sym))))
+ ,@body)))
+ (with-gensyms (ginstance gslots gstream)
+ `(let ((,ginstance ,instance)
+ (,gslots ',slots)
+ (,gstream ,stream))
+ (print-unreadable-object (,ginstance ,gstream
+ :type (class-name (class-of ,ginstance)))
+ (loop for slot in ,gslots
+ for first-time-p = t then nil do
+ (unless first-time-p (write-char #\space ,gstream))
+ (pprint-newline ,inter-slot-newline-style ,gstream)
+ (write-string (format nil ":~a" (symbol-name slot)) ,gstream)
+ (write-char #\space ,gstream)
+ (pprint-newline ,intra-slot-newline-style ,gstream)
+ (if (slot-boundp ,ginstance slot)
+ (write (funcall ,slot-value-callback
+ slot
+ (slot-value ,ginstance slot))
+ :stream ,gstream)
+ (write-string ,unbound-msg ,gstream))))))))
+(defmethod cl:print-object ((o cli-option) stream)
+ (pprint-clos-class o (abbreviation longname argumentsp description example)
+ stream))
-(defvar *single-dash* #\-
+(defparameter *single-dash* "-"
"Short option prefix.")
-(defvar *double-dash* "--"
+(defparameter *double-dash* "--"
"Long option prefix.")
-(defvar *option-value-sep* " "
+(defparameter *option-value-sep* " "
"String used to separate option values.")
@@ -120,15 +192,15 @@
;; allowable command-line interface options.
(defun cli-parse (args cli-opts)
- "See cli-parse-hash."
+ "See CLI-PARSE-HASH."
(cli-parse-hash args cli-opts))
(defun cli-parse-assoc (args cli-opts)
- "Parses command-line arguments (as generated by clisp), much
-in the same format as the cl-args that getopt() parses. That is,
-if you call any program with: './prgm --opt1=value1 value2 -n',
-and you give \"--opt1=value1\" and \"-n\" to cli-parse-assoc, it
+ "Parses command-line arguments much in the same format as the
+cl-args that getopt() parses. That is, if you call any program
+with: './prgm --opt1=value1 value2 -n', and you give
+\"--opt1=value1\", \"value2\" and \"-n\" to cli-parse-assoc, it
returns and assoc-list of the form ((\"opt1\" (\"value1\"
\"value2\")) (\"n\" nil))."
(to-full-opt-names (cli-parse-assoc-aux (coalesce-options args) nil)
@@ -142,9 +214,9 @@
results)))))
(defun cli-parse-hash (args cli-opts)
- "Parses command-line arguments in the same form as specified for
-cli-parse-assoc, but returns a hash-table of the results, instead of an
-assoc list."
+ "Parses command-line arguments in the same form as specified
+for CLI-PARSE-ASSOC, but returns a hash-table of the results,
+instead of an assoc list."
(cli-parse-hash-aux (coalesce-options args) cli-opts))
(defun cli-parse-hash-aux (args cli-opts)
(let ((ret (make-hash-table :test #'equal)))
@@ -251,7 +323,7 @@
"Test whether opt is a short option of the form \"-o[=val]\""
(and (stringp opt)
(>= (length opt) 2)
- (equal (elt opt 0) *single-dash*)
+ (equal (subseq opt 0 (length *single-dash*)) *single-dash*)
(<= (end-opt-name opt) 2)))
(defun full-opt-p (opt)
@@ -329,5 +401,3 @@
(pushnew :cli-parser *features*)
-
-;;;; EOF
\ No newline at end of file
Index: cl-cli-parser/cli-parser-test.lisp
diff -u cl-cli-parser/cli-parser-test.lisp:1.4 cl-cli-parser/cli-parser-test.lisp:1.5
--- cl-cli-parser/cli-parser-test.lisp:1.4 Sun Mar 20 00:08:23 2005
+++ cl-cli-parser/cli-parser-test.lisp Fri Jul 29 23:27:03 2005
@@ -1,14 +1,33 @@
-;;; $Id: cli-parser-test.lisp,v 1.4 2005/03/19 23:08:23 dbueno Exp $
+;;;; $Id: cli-parser-test.lisp,v 1.5 2005/07/29 21:27:03 dbueno Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; AGNS - Automatic (G-something) N-gram Spelling Corrector
-;;; Denis Bueno
+;;;; Denis Bueno
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Thorough test of cli-parser.lisp
+;;;; Thorough test of cli-parser.lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :cli-parser)
-#.(use-package :lunit)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (use-package :lunit))
+(defparameter *option-conf*
+ (list (make-instance 'cli-option
+ :abbr "t"
+ :full "use-threads"
+ :requires-arguments :optional
+ :description "Whether the application should using threads"
+ :example "--use-threads[=5]")
+ (make-instance 'cli-option
+ :abbr nil
+ :full "root-dir"
+ :requires-arguments t
+ :description "The location of the root directory"
+ :example "--root-dir=/tmp")
+ (make-instance 'cli-option
+ :abbr "e"
+ :full "extension-list"
+ :requires-arguments t
+ :description "The list of extensions to include from the root directory (see option root-dir)"
+ :example "--extension-list=txt[,jpg,jpeg,pdf]")))
(deftest test-opt-p ()
(check (opt-p "-o"))
