More SRFI tool patches

srfi-tools/chart.scm

@@ -25,7 +25,7 @@
 	    ((= julian today))
 	  (write-string (date->iso-date (julian-day->date julian)))
 	  (write-string " ")
-	  (write-string (vector-ref counts i))
+	  (write-string (number->string (vector-ref counts i)))
 	  (newline))))))
 
 (define (write-srfi-data today)
@@ -43,10 +43,10 @@
   (let* ((original (read-entire-file
 		    (path-append (srfi-common-dir) "admin" "srfi.gnuplot")))
 	 (end (string-contains original "-12-31"))
-	 (start (string-cursor-back original end 4)))
-    (string-append (string-copy/cursors original 0 start)
+	 (start (- end (string-length "YYYY"))))
+    (string-append (string-copy original 0 start)
 		   (number->string (date-year today))
-		   (string-copy/cursors original end))))
+		   (string-copy original end))))
 
 (define (srfi-generate-chart today)
   (with-output-to-file "/tmp/srfi.gnuplot"

srfi-tools/chart.sld

@@ -3,14 +3,13 @@
   (import (scheme base)
 	  (scheme file)
 	  (scheme write)
-	  (srfi 1)
-	  (srfi 19)
-	  (srfi 130)
 	  (srfi-tools data)
 	  (srfi-tools path)
 	  (srfi-tools private command)
+	  (srfi-tools private list)
 	  (srfi-tools private os)
 	  (srfi-tools private path)
 	  (srfi-tools private port)
+	  (srfi-tools private string)
 	  (srfi-tools private time))
   (include "chart.scm"))

srfi-tools/data.sld

@@ -52,7 +52,6 @@
           (scheme cxr)
           (scheme file)
           (scheme read)
-          (only (srfi 1) every)
 	  (srfi-tools private error)
 	  (srfi-tools private list)
           (srfi-tools private string)

srfi-tools/private/list.sld

@@ -1,5 +1,6 @@
 (define-library (srfi-tools private list)
   (export any
+          every
           append-map
           append-reverse
           cons*
@@ -26,7 +27,7 @@
 
   (import (scheme base)
           (only (srfi 1)
-                any append-map append-reverse cons* drop drop-right
+                any every append-map append-reverse cons* drop drop-right
                 take take-right
                 first second third
                 filter filter-map find fold remove last split-at))

srfi-tools/private/string-shim.sld

@@ -0,0 +1,94 @@
+(define-library (srfi-tools private string-shim)
+
+  ;; Scheme implementations do not agree on whether they should ship
+  ;; SRFI 13 or SRFI 130. 13 is more widespread and has a simpler API,
+  ;; so let's use it. The following code emulates 13 using 130 on
+  ;; implementations where only 130 is available.
+
+  (export string-null?
+          string-every
+          string-any
+          string-join
+          string-tabulate
+          string-take
+          string-take-right
+          string-drop
+          string-drop-right
+          string-pad
+          string-pad-right
+          string-trim
+          string-trim-right
+          string-trim-both
+          string-prefix-length
+          string-suffix-length
+          string-prefix?
+          string-suffix?
+          string-index
+          string-index-right
+          string-skip
+          string-skip-right
+          string-contains
+          string-concatenate
+          string-fold
+          string-fold-right
+          string-filter)
+
+  (import (scheme base))
+
+  (cond-expand
+   ((and (library (srfi 130))
+         (not (library (srfi 13))))
+    (import (except (srfi 130)
+                    string-contains
+                    string-contains-right
+                    string-index
+                    string-index-right
+                    string-skip
+                    string-skip-right)
+            (prefix (only (srfi 130)
+                          string-contains
+                          string-contains-right
+                          string-index
+                          string-index-right
+                          string-skip
+                          string-skip-right)
+                    cursor:)))
+   (else
+    (import (srfi 13))))
+
+  (cond-expand
+   ((and (library (srfi 130))
+         (not (library (srfi 13))))
+    (begin
+
+      (define (fail-false s curs)
+        (and curs (string-cursor->index s curs)))
+
+      (define (fail-end s curs)
+        (and (not (string-cursor=? curs (string-cursor-end s)))
+             (string-cursor->index s curs)))
+
+      (define (successor s curs)
+        (and (not (string-cursor=? curs (string-cursor-start s)))
+             (- (string-cursor->index s curs) 1)))
+
+      ;;
+
+      (define (string-contains s1 s2 . opts)
+        (fail-false s1 (apply cursor:string-contains s1 s2 opts)))
+
+      (define (string-contains-right s1 s2 . opts)
+        (fail-false s1 (apply cursor:string-contains s1 s2 opts)))
+
+      (define (string-index s pred . opts)
+        (fail-end s (apply cursor:string-index s pred opts)))
+
+      (define (string-skip s pred . opts)
+        (fail-end s (apply cursor:string-skip s pred opts)))
+
+      (define (string-index-right s pred . opts)
+        (successor s (apply cursor:string-index-right s pred opts)))
+
+      (define (string-skip-right s pred . opts)
+        (successor s (apply cursor:string-skip-right s pred opts)))))
+   (else)))

srfi-tools/private/string.sld

@@ -1,26 +1,42 @@
 (define-library (srfi-tools private string)
   (export ascii-alphabetic?
           ascii-numeric?
-          ascii-alphanumeric?
-	  string-fold
-          string-index
-          string-contains
+          ascii-alphanumeric?)
+  (export string-every
+          string-any
+          string-join
+          string-tabulate
+          string-take
+          string-take-right
+          string-drop
+          string-drop-right
+          string-pad
+          string-pad-right
+          string-trim
+          string-trim-right
+          string-trim-both
+          string-prefix-length
+          string-suffix-length
           string-prefix?
           string-suffix?
-          string-split
-          string-join
+          string-index
+          string-index-right
+          string-skip
+          string-skip-right
+          string-contains
+          string-concatenate
+          string-fold
+          string-fold-right
+          string-filter)
+  (export string-split
           string-join-english
           string->slug
           unique-string-accumulator
           url-hexify-string)
-  (import (only (scheme char) string-downcase))
   (import (scheme base)
-          (srfi-tools private list))
-  (cond-expand
-   ((library (srfi 130))
-    (import (srfi 130)))
-   (else
-    (import (srfi 13))))
+          (scheme char)
+          (srfi-tools private list)
+          (srfi-tools private string-shim))
   (begin
 
     ;; Subst of SRFI 175.

srfi-tools/private/time.sld

@@ -1,13 +1,13 @@
 (define-library (srfi-tools private time)
-  (export make-date
-	  add-duration
-	  current-date
-	  julian-day->date
-	  date->string
+  (export add-duration
+          current-date
+          date->string
           date->time-utc
-          time<?
-          ;;
-	  date->iso-date
+          date-year
+          julian-day->date
+          make-date
+          time<?)
+  (export date->iso-date
           date->julian
           iso-date-year
           iso-date-month
@@ -16,13 +16,14 @@
           iso-date->date)
   (import (scheme base)
           (only (srfi 19)
-                add-duration
 		current-date
 		date->julian-day
 		julian-day->date
 		make-date
+                add-duration
                 date->string
                 date->time-utc
+                date-year
                 time<?))
   (begin