More SRFI tool patches

srfi-tools/count.sld

@@ -15,11 +15,12 @@
        (pair<? < <)
        (tally
         (lambda (count)
-          (srfi-for-each
+          (for-each
            (lambda (srfi)
              (when (srfi-final? srfi)
                (let ((year (iso-date-year (srfi-done-date srfi))))
-                 (count year)))))))))
+                 (count year))))
+           (srfi-list))))))
 
     (define-command (count-by-year)
       "Display counts of SRFIs by year."
@@ -30,10 +31,11 @@
        (reverse-pair<? string<? <)
        (tally
         (lambda (count)
-          (srfi-for-each
+          (for-each
            (lambda (srfi)
              (for-each (lambda (author) (count (srfi-author-name author)))
-                       (srfi-authors srfi))))))))
+                       (srfi-authors srfi)))
+           (srfi-list))))))
 
     (define-command (count-by-author)
       "Display counts of SRFIs by year."

srfi-tools/data.scm

@@ -128,7 +128,7 @@
            (car srfis))
           (else (find (cdr srfis))))))
 
-(define all-srfis
+(define srfi-list
   (let ((srfis #f))
     (lambda ()
       (or srfis
@@ -137,7 +137,7 @@
 
 (define (srfi-by-number num)
   (or (find (lambda (srfi) (= num (srfi/number srfi)))
-            (all-srfis))
+            (srfi-list))
       (error "No such SRFI" num)))
 
 (define (resolve srfi)
@@ -164,6 +164,9 @@
 
 ;;
 
+(define (srfi-status-string srfi)
+  (symbol->string (srfi-status srfi)))
+
 (define (srfi-draft? srfi)
   (eqv? (srfi-status srfi) 'draft))
 
@@ -176,14 +179,6 @@
 
 ;;
 
-(define (srfi-for-each proc)
-  (for-each proc (all-srfis)))
-
-(define (srfi-filter predicate)
-  (filter predicate (all-srfis)))
-
-;;
-
 (define srfi-author-name first)
 
 (define (srfi-author-role author)
@@ -205,19 +200,32 @@
                  (srfi/authors
                   (srfi-by-number (parse-srfi-number num))))))
 
-(define (srfi-format-number-and-title srfi)
-  (string-append "SRFI " (number->string (srfi-number srfi)) ": "
-                 (srfi-title srfi)))
+(define (srfi-format srfi . parentheses)
+  (let ((number-title
+         (string-append "SRFI " (number->string (srfi-number srfi))
+                        ": " (srfi-title srfi))))
+    (if (null? parentheses)
+        number-title
+        (string-append
+         number-title
+         " ("
+         (string-join (map (lambda (fact)
+                             (if (string? fact)
+                                 fact
+                                 (fact srfi)))
+                           parentheses)
+                      " ")
+         ")"))))
+
+(define (write-custom-srfi-list srfis . parentheses)
+  (for-each (lambda (srfi)
+              (write-line (apply srfi-format srfi parentheses)))
+            srfis))
 
-(define (srfi-one-line-summary srfi)
-  (string-append (srfi-format-number-and-title srfi)
-                 " ("
-                 (string-append
-		  (symbol->string (srfi-status srfi))
-		  " "
-		  (or (srfi-done-date srfi)
-		      (srfi-draft-date srfi))
-		  ")")))
+(define (write-srfi-list srfis)
+  (write-custom-srfi-list srfis
+                          srfi-status-string
+                          srfi-date-of-last-update))
 
 ;;
 
@@ -229,49 +237,41 @@
   (dump-file (srfi-data-file))
   (newline))
 
-(define (write-srfi-list srfis)
-  (for-each (lambda (srfi)
-              (disp (srfi-one-line-summary srfi)))
-            srfis))
-
-(define (srfi-list)
-  (all-srfis))
-
 (define-command (list)
   "Display a list of all the SRFIs."
   (write-srfi-list (srfi-list)))
 
 (define (srfi-tail)
-  (take-right (all-srfis) 10))
+  (take-right (srfi-list) 10))
 
 (define-command (tail)
   "Display a list of the most recent ten SRFIs."
   (write-srfi-list (srfi-tail)))
 
 (define (srfi-drafts)
-  (filter srfi-draft? (all-srfis)))
+  (filter srfi-draft? (srfi-list)))
 
 (define-command (drafts)
   "Display a list of all the draft SRFIs."
-  (for-each write-line (map srfi-format-number-and-title (srfi-drafts))))
+  (write-custom-srfi-list (srfi-drafts) "since" srfi-draft-date))
 
 (define (srfi-by-author name)
   (filter (lambda (srfi)
             (any (lambda (author)
                    (string-ci=? name (srfi-author-name author)))
                  (srfi/authors srfi)))
-          (all-srfis)))
+          (srfi-list)))
 
 (define-command (by-author name)
   "Display a list of all the SRFIs by authors with <name> in their names."
   (write-srfi-list (srfi-by-author name)))
 
 (define (srfi-search query)
   (let ((query (string-downcase query)))
-    (srfi-filter
-     (lambda (srfi)
-       (string-contains (string-downcase (srfi-title srfi))
-                        query)))))
+    (filter (lambda (srfi)
+              (string-contains (string-downcase (srfi-title srfi))
+                               query))
+            (srfi-list))))
 
 (define-command (search query)
   "Display a list of all the SRFIs whose titles contain <query>."

srfi-tools/data.sld

@@ -7,6 +7,7 @@
 
           srfi-number
           srfi-status
+          srfi-status-string
           srfi-title
           srfi-authors
           srfi-based-on
@@ -24,10 +25,7 @@
           srfi-author-role
           srfi-format-author
           srfi-format-authors
-          srfi-one-line-summary
-
-          srfi-for-each
-          srfi-filter
+          srfi-format
 
           srfi-data
           srfi-list
@@ -46,7 +44,8 @@
 
 	  keyword->name
 
-	  write-srfi-list)
+	  write-custom-srfi-list
+          write-srfi-list)
   (import (scheme base)
           (scheme case-lambda)
           (scheme char)

srfi-tools/interactive.sld

@@ -15,6 +15,7 @@
           (scheme char)
 
           (srfi-tools private external)
+          (srfi-tools private format)
           (srfi-tools private list)
           (srfi-tools private string)
           (srfi-tools private os)
@@ -102,10 +103,9 @@
                (error "No luck. Try another query?"))
               (else
 	       (write-srfi-list matches)
+               (newline)
 	       (let ((srfi (car matches)))
-		 (write-string "Opening ")
-		 (write-string (srfi-one-line-summary srfi))
-		 (write-string ".\n")
+		 (write-line (format "Opening ~a." (srfi-format srfi)))
 		 (srfi-browse (srfi-number srfi)))))))
 
     (define-command (lucky query)

srfi-tools/legal.sld

@@ -17,7 +17,7 @@
         "the following conditions:"
         ""
         "The above copyright notice and this permission notice (including the"
-	" next paragraph) shall be included in all copies or substantial"
+	"next paragraph) shall be included in all copies or substantial"
 	"portions of the Software."
         ""
         "THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,"

srfi-tools/private/error.sld

@@ -4,6 +4,7 @@
           assert
           usage)
   (import (scheme base)
+          (scheme process-context)
           (scheme write)
           (srfi-tools private string)
           (srfi-tools private port))
@@ -19,4 +20,9 @@
     (define (assert test . arguments)
       (unless test (apply error arguments)))
 
-    (define usage user-error)))
+    (define (usage arg . arguments)
+      (display arg)
+      (for-each (lambda (arg) (write-string " ") (display arg))
+                arguments)
+      (newline)
+      (exit #f))))