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"))