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, 129 insertions, 10 deletions

diff --git a/uri.scm b/uri.scm
index 0fe685f..6a02827 100644
--- a/uri.scm
+++ b/uri.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.
 ;
@@ -17,11 +17,13 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
-(require 'coerce)
+(require 'scanf)
 (require 'printf)
+(require 'coerce)
 (require 'string-case)
 (require 'string-search)
 (require 'common-list-functions)
+(require-if 'compiling 'directory)	; path->uri uses current-directory
 
 ;;@code{(require 'uri)}
 ;;@ftindex uri
@@ -67,10 +69,12 @@
      (cond ((string? path) (uric:encode path "/$,;:@&=+"))
 	   ((null? path) "")
 	   ((list? path) (uri:make-path path))
-	   (else path))
+	   (else (or path "")))
      (if query (sprintf #f "?%s" (uric:encode query "?/$,;:@&=+")) "")
      (if fragment (sprintf #f "#%s" (uric:encode fragment "?/$,;:@&=+")) ""))))
 
+;;@body
+;;Returns a URI string combining the components of list @1.
 (define (uri:make-path path)
   (apply string-append
 	 (uric:encode (car path) "$,;:@&=+")
@@ -108,12 +112,23 @@
 (define (html:isindex prompt)
   (sprintf #f "<ISINDEX PROMPT=\"%s\">" prompt))
 
-;;@body Returns a list of 5 elements corresponding to the parts
+(define (uri:scheme? str)
+  (let ((lst (scanf-read-list "%[-+.a-zA-Z0-9] %s" str)))
+    (and (list? lst)
+	 (eqv? 1 (length lst))
+	 (char-alphabetic? (string-ref str 0)))))
+
+;;@args uri-reference base-tree
+;;@args uri-reference
+;;
+;;Returns a list of 5 elements corresponding to the parts
 ;;(@var{scheme} @var{authority} @var{path} @var{query} @var{fragment})
 ;;of string @1.  Elements corresponding to absent parts are #f.
 ;;
 ;;The @var{path} is a list of strings.  If the first string is empty,
-;;then the path is absolute; otherwise relative.
+;;then the path is absolute; otherwise relative.  The optional @2 is a
+;;tree as returned by @0; and is used as the base address for relative
+;;URIs.
 ;;
 ;;If the @var{authority} component is a
 ;;@dfn{Server-based Naming Authority}, then it is a list of the
@@ -133,9 +148,11 @@
 	    (lambda (scheme authority path query fragment)
 	      (define uri-empty?
 		(and (equal? "" path) (not scheme) (not authority) (not query)))
-	      (list (if scheme
+	      (list (if (and scheme (uri:scheme? scheme))
 			(string-ci->symbol scheme)
-			b-scheme)
+			(cond ((not scheme) b-scheme)
+			      (else (slib:warn 'uri->tree 'bad 'scheme scheme)
+				    b-scheme)))
 		    (if authority
 			(uri:decode-authority authority)
 			b-authority)
@@ -150,7 +167,7 @@
 		    (or (and fragment (uric:decode fragment))
 			(and uri-empty? b-fragment))))
 	    split))
-	 (if (or (car split) (null? base-tree) (car split))
+	 (if (or (car split) (null? base-tree))
 	     '(#f #f #f #f #f)
 	     (car base-tree))))
 
@@ -197,7 +214,9 @@
     (if (or userinfo port)
 	(list userinfo host (or (string->number port) port))
 	host)))
-
+;;@args txt chr
+;;Returns a list of @1 split at each occurrence of @2.  @2 does not
+;;appear in the returned list of strings.
 (define uri:split-fields
   (let ((cr (integer->char #xd)))
     (lambda (txt chr)
@@ -212,7 +231,7 @@
 				  chr))
 	  (list txt)))))
 
-;; @body Converts a @dfn{URI} encoded @1 to a query-alist.
+;;@body Converts a @dfn{URI} encoded @1 to a query-alist.
 (define (uri:decode-query query-string)
   (set! query-string (string-subst query-string " " "" "+" " "))
   (do ((lst '())
@@ -311,9 +330,109 @@
      (else uri)))
   (sub uri-component))
 
+;;@body @1 is a path-list as returned by @code{uri:split-fields}.  @0
+;;returns a list of items returned by @code{uri:decode-path}, coerced
+;;to types @2.
 (define (uri:path->keys path-list ptypes)
   (and (not (null? path-list))
        (not (equal? '("") path-list))
        (let ((path (uri:decode-path (map uric:decode path-list) #f)))
 	 (and (= (length path) (length ptypes))
 	      (map coerce path ptypes)))))
+
+;;@subheading File-system Locators and Predicates
+
+;;@body Returns a URI-string for @1 on the local host.
+(define (path->uri path)
+  (require 'directory)
+  (if (absolute-path? path)
+      (sprintf #f "file:%s" path)
+      (sprintf #f "file:%s/%s" (current-directory) path)))
+
+;;@body Returns #t if @1 is an absolute-URI as indicated by a
+;;syntactically valid (per RFC 2396) @dfn{scheme}; otherwise returns
+;;#f.
+(define (absolute-uri? str)
+  (let ((lst (scanf-read-list "%[-+.a-zA-Z0-9]:%s" str)))
+    (and (list? lst)
+	 (eqv? 2 (length lst))
+	 (char-alphabetic? (string-ref str 0)))))
+
+;;@body Returns #t if @1 is a fully specified pathname (does not
+;;depend on the current working directory); otherwise returns #f.
+(define (absolute-path? file-name)
+  (and (string? file-name)
+       (positive? (string-length file-name))
+       (memv (string-ref file-name 0) '(#\\ #\/))))
+
+;;@body Returns #t if changing directory to @1 would leave the current
+;;directory unchanged; otherwise returns #f.
+(define (null-directory? str)
+  (member str '("" "." "./" ".\\")))
+
+;;@body Returns #t if the string @1 contains characters used for
+;;specifying glob patterns, namely @samp{*}, @samp{?}, or @samp{[}.
+(define (glob-pattern? str)
+  (let loop ((idx (+ -1 (string-length str))))
+    (if (negative? idx)
+	#f
+	(case (string-ref str idx)
+	  ((#\* #\[ #\?) #t)
+	  (else (loop (+ -1 idx)))))))
+
+;;@noindent
+;;Before RFC 2396, the @dfn{File Transfer Protocol} (FTP) served a
+;;similar purpose.
+
+;;@body
+;;Returns a list of the decoded FTP @1; or #f if indecipherable.  FTP
+;;@dfn{Uniform Resource Locator}, @dfn{ange-ftp}, and @dfn{getit}
+;;formats are handled.  The returned list has four elements which are
+;;strings or #f:
+;;
+;;@enumerate 0
+;;@item
+;;username
+;;@item
+;;password
+;;@item
+;;remote-site
+;;@item
+;;remote-directory
+;;@end enumerate
+(define (parse-ftp-address uri)
+  (let ((length? (lambda (len lst) (and (eqv? len (length lst)) lst))))
+    (cond
+     ((not uri) #f)
+     ((length? 1 (scanf-read-list " ftp://%s %s" uri))
+      => (lambda (host)
+	   (let ((login #f) (path #f) (dross #f))
+	     (sscanf (car host) "%[^/]/%[^@]%s" login path dross)
+	     (and login
+		  (append (cond
+			   ((length? 2 (scanf-read-list "%[^@]@%[^@]%s" login))
+			    => (lambda (userpass@hostport)
+				 (append
+				  (cond ((length? 2 (scanf-read-list
+						     "%[^:]:%[^@/]%s"
+						     (car userpass@hostport))))
+					(else (list (car userpass@hostport) #f)))
+				  (cdr userpass@hostport))))
+			   (else (list "anonymous" #f login)))
+			  (list path))))))
+     (else
+      (let ((user@site #f) (colon #f) (path #f) (dross #f))
+	(case (sscanf uri " %[^:]%[:]%[^@] %s" user@site colon path dross)
+	  ((2 3)
+	   (let ((user #f) (site #f))
+	     (cond ((or (eqv? 2 (sscanf user@site "/%[^@/]@%[^@]%s"
+					user site dross))
+			(eqv? 2 (sscanf user@site "%[^@/]@%[^@]%s"
+					user site dross)))
+		    (list user #f site path))
+		   ((eqv? 1 (sscanf user@site "@%[^@]%s" site dross))
+		    (list #f #f site path))
+		   (else (list #f #f user@site path)))))
+	  (else
+	   (let ((site (scanf-read-list " %[^@/] %s" uri)))
+	     (and (length? 1 site) (list #f #f (car site) #f))))))))))