Import Debian changes 3a1-4.2debian/3a1-4.2

slib (3a1-4.2) unstable; urgency=low

  * Non-maintainer upload.
  * Add guile.init.local for use within the build dir, since otherwise we
    have an (earlier unnoticed) circular build-dep due to a difference
    between scm and guile.

slib (3a1-4.1) unstable; urgency=low

  * Non-maintainer upload.
  * Build-depend on guile-1.6 instead of scm, since the new version of
    scm is wedged in unstable (closes: #281809).

slib (3a1-4) unstable; urgency=low

  * Also check for expected creation on slibcat. (Closes: #240096)

slib (3a1-3) unstable; urgency=low

  * Also check for /usr/share/guile/1.6/slib before installing for guile
    1.6. (Closes: #239267)

slib (3a1-2) unstable; urgency=low

  * Add format.scm back into slib until gnucash stops using it.
  * Call guile-1.6 new-catalog (Closes: #238231)

slib (3a1-1) unstable; urgency=low

  * New upstream release
  * Remove Info section from doc-base file (Closes: #186950)
  * Remove period from end of description (linda, lintian)
  * html gen fixed upstream (Closes: #111778)

slib (2d4-2) unstable; urgency=low

  * Fix url for upstream source (Closes: #144981)
  * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
  * Add build depends.

slib (2d4-1) unstable; urgency=low

  * New upstream.

slib (2d3-1) unstable; urgency=low

  * New upstream.
  * Remove texi2html call in debian/rules.  Now done upstream.  Add make
    html instead.
  * Changes to rules and doc-base to conform to upstream html gen
  * Clean up upstream makefile to make sure it cleans up after itself.

1 files changed, 110 insertions, 22 deletions

diff --git a/getparam.scm b/getparam.scm
index 3e2d7f1..1e7b7c0 100644
--- a/getparam.scm
+++ b/getparam.scm
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -19,12 +19,41 @@
 
 (require 'getopt)
 (require 'coerce)
+(require 'parameters)
+(require-if 'compiling 'printf)
+(require-if 'compiling 'common-list-functions)
 
-(define (getopt->parameter-list argc argv optnames arities types aliases
-				. description)
+;;@code{(require 'getopt-parameters)}
+;;@ftindex getopt-parameters
+
+;;@args optnames arities types aliases desc @dots{}
+;;Returns @var{*argv*} converted to a parameter-list.  @var{optnames} are
+;;the parameter-names.  @var{arities} and @var{types} are lists of symbols
+;;corresponding to @var{optnames}.
+;;
+;;@var{aliases} is a list of lists of strings or integers paired with
+;;elements of @var{optnames}.  Each one-character string will be treated
+;;as a single @samp{-} option by @code{getopt}.  Longer strings will be
+;;treated as long-named options (@pxref{Getopt, getopt--}).
+;;
+;;If the @var{aliases} association list has only strings as its
+;;@code{car}s, then all the option-arguments after an option (and before
+;;the next option) are adjoined to that option.
+;;
+;;If the @var{aliases} association list has integers, then each (string)
+;;option will take at most one option-argument.  Unoptioned arguments are
+;;collected in a list.  A @samp{-1} alias will take the last argument in
+;;this list; @samp{+1} will take the first argument in the list.  The
+;;aliases -2 then +2; -3 then +3; @dots{} are tried so long as a positive
+;;or negative consecutive alias is found and arguments remain in the list.
+;;Finally a @samp{0} alias, if found, absorbs any remaining arguments.
+;;
+;;In all cases, if unclaimed arguments remain after processing, a warning
+;;is signaled and #f is returned.
+(define (getopt->parameter-list optnames arities types aliases . description)
   (define (can-take-arg? opt)
     (not (eq? 'boolean (list-ref arities (position opt optnames)))))
-  (let ((progname (list-ref argv (+ -1 *optind*)))
+  (let ((progname (list-ref *argv* (+ -1 *optind*)))
 	(optlist '())
 	(long-opt-list '())
 	(optstring #f)
@@ -63,7 +92,8 @@
 		 (for-each (lambda (unc) (adjoin-val unc curopt)) unclaimeds)
 		 (set! unclaimeds '()))))))
       (cond ((not (null? unclaimeds))
-	     (slib:warn 'getopt->parameter-list 'arguments 'unclaimed unclaimeds)
+	     (getopt-barf "%s: Unclaimed argument '%s'"
+			  progname (car unclaimeds))
 	     (apply parameter-list->getopt-usage
 		    progname optnames arities types aliases description))
 	    (else parameter-list)))
@@ -94,34 +124,34 @@
      aliases)
     (set! optstring (list->string (cons #\: optlist)))
     (let loop ()
-      (let ((opt (getopt-- argc argv optstring)))
+      (let ((opt (getopt-- optstring)))
 	(case opt
 	  ((#\: #\?)
-	   (slib:warn 'getopt->parameter-list
-		      (case opt
-			((#\:) "argument missing after")
-			((#\?) "unrecognized option"))
-		      (string #\- getopt:opt))
+	   (getopt-barf (case opt
+			  ((#\:) "%s: argument missing after '-%c'")
+			  ((#\?) "%s: unrecognized option '-%c'"))
+			progname
+			getopt:opt)
 	   (apply parameter-list->getopt-usage
 		  progname optnames arities types aliases description))
 	  ((#f)
-	   (cond ((and (< *optind* argc)
-		       (string=? "-" (list-ref argv *optind*)))
+	   (cond ((and (< *optind* (length *argv*))
+		       (string=? "-" (list-ref *argv* *optind*)))
 		  (set! *optind* (+ 1 *optind*))
 		  (finish))
-		 ((< *optind* argc)
+		 ((< *optind* (length *argv*))
 		  (let ((topt (assoc curopt aliases)))
 		    (if topt (set! curopt (cadr topt)))
 		    (cond
 		     ((and positional? (not topt))
 		      (set! unclaimeds
-			    (cons (list-ref argv *optind*) unclaimeds))
+			    (cons (list-ref *argv* *optind*) unclaimeds))
 		      (set! *optind* (+ 1 *optind*)) (loop))
 		     ((and (member curopt optnames)
-			   (adjoin-val (list-ref argv *optind*) curopt))
+			   (adjoin-val (list-ref *argv* *optind*) curopt))
 		      (set! *optind* (+ 1 *optind*)) (loop))
 		     (else (slib:error 'getopt->parameter-list curopt
-				       (list-ref argv *optind*)
+				       (list-ref *argv* *optind*)
 				       'not 'supported)))))
 		 (else (finish))))
 	  (else
@@ -130,7 +160,7 @@
 	     (if topt (set! topt (cadr topt)))
 	     (cond
 	      ((not topt)
-	       (slib:warn "Option not recognized -" opt)
+	       (getopt-barf "%s: '--%s' option not recognized" progname opt)
 	       (apply parameter-list->getopt-usage
 		      progname optnames arities types aliases description))
 	      ((not (can-take-arg? topt))
@@ -138,9 +168,15 @@
 	       (loop))
 	      (*optarg* (set! curopt topt) (adjoin-val *optarg* curopt) (loop))
 	      (else
-;;;	       (slib:warn 'getopt->parameter-list "= missing for option--" opt)
+	       ;;(getopt-barf "%s: '--%s' option expects '='" progname opt)
+	       ;;(apply parameter-list->getopt-usage progname optnames arities types aliases description)
 	       (set! curopt topt) (loop))))))))))
 
+(define (getopt-barf . args)
+  (require 'printf)
+  (apply fprintf (current-error-port) args)
+  (newline (current-error-port)))
+
 (define (parameter-list->getopt-usage comname optnames arities types aliases
 				      . description)
   (require 'printf)
@@ -198,11 +234,17 @@
     (for-each (lambda (desc) (fprintf cep "  %s\\n" desc)) description))
   #f)
 
-(define (getopt->arglist argc argv optnames positions
+;;@args optnames positions arities types defaulters checks aliases desc @dots{}
+;;Like @code{getopt->parameter-list}, but converts @var{*argv*} to an
+;;argument-list as specified by @var{optnames}, @var{positions},
+;;@var{arities}, @var{types}, @var{defaulters}, @var{checks}, and
+;;@var{aliases}.  If the options supplied violate the @var{arities} or
+;;@var{checks} constraints, then a warning is signaled and #f is returned.
+(define (getopt->arglist optnames positions
 			 arities types defaulters checks aliases . description)
-  (define progname (list-ref argv (+ -1 *optind*)))
+  (define progname (list-ref *argv* (+ -1 *optind*)))
   (let* ((params (apply getopt->parameter-list
-			argc argv optnames arities types aliases description))
+			optnames arities types aliases description))
 	 (fparams (and params (fill-empty-parameters defaulters params))))
     (cond ((and (list? params)
 		(check-parameters checks fparams)
@@ -211,3 +253,49 @@
 			 progname optnames arities types aliases description))
 	  (else #f))))
 
+;;@noindent
+;;These @code{getopt} functions can be used with SLIB relational
+;;databases.  For an example, @xref{Using Databases, make-command-server}.
+;;
+;;@noindent
+;;If errors are encountered while processing options, directions for using
+;;the options (and argument strings @var{desc} @dots{}) are printed to
+;;@code{current-error-port}.
+;;
+;;@example
+;;(begin
+;;  (set! *optind* 1)
+;;  (set! *argv* '("cmd" "-?")
+;;  (getopt->parameter-list
+;;   '(flag number symbols symbols string flag2 flag3 num2 num3)
+;;   '(boolean optional nary1 nary single boolean boolean nary nary)
+;;   '(boolean integer symbol symbol string boolean boolean integer integer)
+;;   '(("flag" flag)
+;;     ("f" flag)
+;;     ("Flag" flag2)
+;;     ("B" flag3)
+;;     ("optional" number)
+;;     ("o" number)
+;;     ("nary1" symbols)
+;;     ("N" symbols)
+;;     ("nary" symbols)
+;;     ("n" symbols)
+;;     ("single" string)
+;;     ("s" string)
+;;     ("a" num2)
+;;     ("Abs" num3))))
+;;@print{}
+;;Usage: cmd [OPTION ARGUMENT ...] ...
+;;
+;;  -f, --flag
+;;  -o, --optional=<number>
+;;  -n, --nary=<symbols> ...
+;;  -N, --nary1=<symbols> ...
+;;  -s, --single=<string>
+;;      --Flag
+;;  -B
+;;  -a        <num2> ...
+;;      --Abs=<num3> ...
+;;
+;;ERROR: getopt->parameter-list "unrecognized option" "-?"
+;;@end example