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, 115 insertions, 21 deletions

diff --git a/glob.scm b/glob.scm
index d6e993b..382bbf3 100644
--- a/glob.scm
+++ b/glob.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,6 +17,10 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
+;;@code{(require 'filename)} or @code{(require 'glob)}
+;;@ftindex filename
+;;@ftindex glob
+
 (define (glob:pattern->tokens pat)
   (cond
    ((string? pat)
@@ -187,31 +191,87 @@
 		(else
 		 (loop (cdr inds) (cdr wild?) lits res)))))))))
 
+;;@body
+;;Returns a predicate which returns a non-false value if its string argument
+;;matches (the string) @var{pattern}, false otherwise.  Filename matching
+;;is like
+;;@cindex glob
+;;@dfn{glob} expansion described the bash manpage, except that names
+;;beginning with @samp{.} are matched and @samp{/} characters are not
+;;treated specially.
+;;
+;;These functions interpret the following characters specially in
+;;@var{pattern} strings:
+;;@table @samp
+;;@item *
+;;Matches any string, including the null string.
+;;@item ?
+;;Matches any single character.
+;;@item [@dots{}]
+;;Matches any one of the enclosed characters.  A pair of characters
+;;separated by a minus sign (-) denotes a range; any character lexically
+;;between those two characters, inclusive, is matched.  If the first
+;;character following the @samp{[} is a @samp{!} or a @samp{^} then any
+;;character not enclosed is matched.  A @samp{-} or @samp{]} may be
+;;matched by including it as the first or last character in the set.
+;;@end table
+(define (filename:match?? pattern)
+  (glob:make-matcher pattern char=? char<=?))
+(define (filename:match-ci?? pattern)
+  (glob:make-matcher pattern char-ci=? char-ci<=?))
 
-(define (glob:match?? pat)
-  (glob:make-matcher pat char=? char<=?))
-(define (glob:match-ci?? pat)
-  (glob:make-matcher pat char-ci=? char-ci<=?))
-(define filename:match?? glob:match??)
-(define filename:match-ci?? glob:match-ci??)
 
-(define (glob:substitute?? pat templ)
-  (cond ((procedure? templ)
-	 (glob:caller-with-matches pat templ char=? char<=?))
-	((string? templ)
-	 (glob:make-substituter pat templ char=? char<=?))
+;;@args pattern template
+;;Returns a function transforming a single string argument according to
+;;glob patterns @var{pattern} and @var{template}.  @var{pattern} and
+;;@var{template} must have the same number of wildcard specifications,
+;;which need not be identical.  @var{pattern} and @var{template} may have
+;;a different number of literal sections. If an argument to the function
+;;matches @var{pattern} in the sense of @code{filename:match??} then it
+;;returns a copy of @var{template} in which each wildcard specification is
+;;replaced by the part of the argument matched by the corresponding
+;;wildcard specification in @var{pattern}.  A @code{*} wildcard matches
+;;the longest leftmost string possible.  If the argument does not match
+;;@var{pattern} then false is returned.
+;;
+;;@var{template} may be a function accepting the same number of string
+;;arguments as there are wildcard specifications in @var{pattern}.  In
+;;the case of a match the result of applying @var{template} to a list
+;;of the substrings matched by wildcard specifications will be returned,
+;;otherwise @var{template} will not be called and @code{#f} will be returned.
+(define (filename:substitute?? pattern template)
+  (cond ((procedure? template)
+	 (glob:caller-with-matches pattern template char=? char<=?))
+	((string? template)
+	 (glob:make-substituter pattern template char=? char<=?))
 	(else
-	 (slib:error 'glob:substitute "bad second argument" templ))))
-(define (glob:substitute-ci?? pat templ)
-  (cond ((procedure? templ)
-	 (glob:caller-with-matches pat templ char-ci=? char-ci<=?))
-	((string? templ)
-	 (glob:make-substituter pat templ char-ci=? char-ci<=?))
+	 (slib:error 'filename:substitute?? "bad second argument" template))))
+(define (filename:substitute-ci?? pattern template)
+  (cond ((procedure? template)
+	 (glob:caller-with-matches pattern template char-ci=? char-ci<=?))
+	((string? template)
+	 (glob:make-substituter pattern template char-ci=? char-ci<=?))
 	(else
-	 (slib:error 'glob:substitute "bad second argument" templ))))
-(define filename:substitute?? glob:substitute??)
-(define filename:substitute-ci?? glob:substitute-ci??)
+	 (slib:error 'filename:substitute-ci?? "bad second argument" template))))
+
+;;@example
+;;((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm")
+;; "scm_10.html")
+;;@result{} "scm5c4_10.htm"
+;;((filename:substitute?? "??" "beg?mid?end") "AZ")
+;;@result{} "begAmidZend"
+;;((filename:substitute?? "*na*" "?NA?") "banana")
+;;@result{} "banaNA"
+;;((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1)))
+;; "ABZ")
+;;@result{} "ZA"
+;;@end example
 
+;;@body
+;;@var{str} can be a string or a list of strings.  Returns a new string
+;;(or strings) similar to @code{str} but with the suffix string @var{old}
+;;removed and the suffix string @var{new} appended.  If the end of
+;;@var{str} does not match @var{old}, an error is signaled.
 (define (replace-suffix str old new)
   (let* ((f (glob:make-substituter (list "*" old) (list "*" new)
 				   char=? char<=?))
@@ -222,3 +282,37 @@
     (if (pair? str)
 	(map g str)
 	(g str))))
+
+;;@example
+;;(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c")
+;;@result{} "/usr/local/lib/slib/batch.c"
+;;@end example
+
+;;@args proc k
+;;@args proc
+;;Calls @1 with @2 arguments, strings returned by successive calls to
+;;@code{tmpnam}.
+;;If @1 returns, then any files named by the arguments to @1 are
+;;deleted automatically and the value(s) yielded by the @1 is(are)
+;;returned.  @2 may be ommited, in which case it defaults to @code{1}.
+;;
+;;@args proc suffix1 ...
+;;Calls @1 with strings returned by successive calls to @code{tmpnam},
+;;each with the corresponding @var{suffix} string appended.
+;;If @1 returns, then any files named by the arguments to @1 are
+;;deleted automatically and the value(s) yielded by the @1 is(are)
+;;returned.
+(define (call-with-tmpnam proc . suffi)
+  (define (do-call paths)
+    (let ((ans (apply proc paths)))
+      (for-each (lambda (path) (if (file-exists? path) (delete-file path)))
+		paths)
+      ans))
+  (cond ((null? suffi) (do-call (list (tmpnam))))
+	((and (= 1 (length suffi)) (number? (car suffi)))
+	 (do ((cnt (if (null? suffi) 0 (+ -1 (car suffi))) (+ -1 cnt))
+	      (paths '() (cons (tmpnam) paths)))
+	     ((negative? cnt)
+	      (do-call paths))))
+	(else (do-call (map (lambda (suffix) (string-append (tmpnam) suffix))
+			    suffi)))))