Import Debian changes 2c0-3debian/2c0-3

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

  * New maintainer.
  * slibconfig script to automatically configure guile.
  * Fix type in description, closes: Bug#18996

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

  * Minor fix for debian/rules targets

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

  * New upstream source
  * New maintainer

1 files changed, 61 insertions, 13 deletions

diff --git a/paramlst.scm b/paramlst.scm
index f01788b..706c91c 100644
--- a/paramlst.scm
+++ b/paramlst.scm
@@ -1,5 +1,5 @@
 ;;; "paramlst.scm" passing parameters by name.
-; Copyright 1995 Aubrey Jaffer
+; Copyright 1995, 1996, 1997 Aubrey Jaffer
 ;
 ;Permission to copy this software, to redistribute it, and to use it
 ;for any purpose is granted, subject to the following restrictions and
@@ -43,13 +43,13 @@
     (lambda (arity)
       (assq arity table))))
 
-(define (fill-empty-parameters defaults parameter-list)
-  (map (lambda (default parameter)
+(define (fill-empty-parameters defaulters parameter-list)
+  (map (lambda (defaulter parameter)
 	 (cond ((null? (cdr parameter))
 		(cons (car parameter)
-		      (if default (default parameter-list) '())))
+		      (if defaulter (defaulter parameter-list) '())))
 	       (else parameter)))
-       defaults parameter-list))
+       defaulters parameter-list))
 
 (define (check-parameters checks parameter-list)
   (for-each (lambda (check parameter)
@@ -139,7 +139,8 @@
       ((expression) val)
       (else (coerce val ntyp))))
   (require 'getopt)
-  (let ((optlist '())
+  (let ((starting-optind *optind*)
+	(optlist '())
 	(long-opt-list '())
 	(optstring #f)
 	(parameter-list (make-parameter-list optnames))
@@ -168,9 +169,55 @@
       (let ((opt (getopt-- argc argv optstring)))
 	(case opt
 	  ((#\: #\?)
-	   (slib:error
-	    'getopt->parameter-list "unrecognized option"
-	    getopt:opt))
+	   (let ((aliast (map list optnames))
+		 (strlen=1? (lambda (s) (= 1 (string-length s))))
+		 (cep (current-error-port)))
+	     (require 'printf)
+	     (require 'common-list-functions)
+	     (for-each (lambda (alias)
+			 (let ((apr (assq (cadr alias) aliast)))
+			   (set-cdr! apr (cons (car alias) (cdr apr)))))
+		       aliases)
+	     (fprintf cep "Usage: %s [OPTION ARGUMENT ...] ..."
+		      (list-ref argv (+ -1 starting-optind)))
+	     (newline cep) (newline cep)
+	     (for-each
+	      (lambda (optname arity aliat)
+		(let loop ((initials (remove-if-not strlen=1? (cdr aliat)))
+			   (longname (remove-if strlen=1? (cdr aliat))))
+		  (cond ((and (null? initials) (null? longname)))
+			(else
+			 (fprintf cep
+				  (case arity
+				    ((boolean) "  %3s %s")
+				    (else "  %3s %s<%s> %s"))
+				  (if (null? initials)
+				      ""
+				      (string-append
+				       "-" (car initials)
+				       (if (null? longname) " " ",")))
+				  (if (null? longname)
+				      "      "
+				      (string-append
+				       "--" (car longname)
+				       (case arity
+					 ((boolean) " ")
+					 (else "="))))
+				  (case arity
+				    ((boolean) "")
+				    (else optname))
+				  (case arity
+				    ((nary nary1) "...")
+				    (else "")))
+			 (newline cep)
+			 (loop (if (null? initials) '() (cdr initials))
+			       (if (null? longname) '() (cdr longname)))))))
+	      optnames arities aliast))
+	   (slib:error 'getopt->parameter-list
+		       (case opt
+			 ((#\:) "argument missing after")
+			 ((#\?) "unrecognized option"))
+		       (string #\- getopt:opt)))
 	  ((#f)
 	   (cond ((and (< *optind* argc)
 		       (string=? "-" (list-ref argv *optind*)))
@@ -201,15 +248,16 @@
 				   (list topt (coerce-val *optarg* curopt))))
 	      (else
 	       (set! curopt topt)
-	       (rdms:warn
-		'getopt->parameter-list "argument missing for option--" opt))))
+;;;	       (slib:warn 'getopt->parameter-list
+;;;			  "= missing for option--" opt)
+	       )))
 	   (loop)))))
     parameter-list))
 
 (define (getopt->arglist argc argv optnames positions
-			 arities types defaults checks aliases)
+			 arities types defaulters checks aliases)
   (let* ((params (getopt->parameter-list
 		  argc argv optnames arities types aliases))
-	 (fparams (fill-empty-parameters defaults params)))
+	 (fparams (fill-empty-parameters defaulters params)))
     (and (list? params) (check-parameters checks fparams))
     (and (list? params) (parameter-list->arglist positions arities fparams))))