More SRFI tool patches

srfi-tools/data.scm

@@ -278,21 +278,27 @@
   "List a few SRFIs with numbers around <num>."
   (write-srfi-list (srfi-near (parse-srfi-number num))))
 
-(define (srfi-drafts)
-  (filter srfi-draft? (srfi-list)))
+(define (srfi-age-in-days srfi)
+  (days-between (iso-date->date (srfi-draft-date srfi))
+                (current-date)))
 
 (define (srfi-format-age srfi)
-  (format "~a days"
-          (days-between (iso-date->date (srfi-draft-date srfi))
-                        (current-date))))
+  (format "~a days" (srfi-age-in-days srfi)))
+
+(define (srfi-drafts)
+  (filter srfi-draft? (srfi-list)))
 
 (define-command (drafts)
   "Display a list of all the draft SRFIs."
-  (display-two-column-table
-   (map (lambda (srfi)
-          (cons (srfi-format srfi)
-                (srfi-format-age srfi)))
-        (srfi-drafts))))
+  (let-values (((older newer)
+                (partition (lambda (srfi) (>= (srfi-age-in-days srfi) 60))
+                           (srfi-drafts))))
+    (define (entry srfi)
+      (cons (srfi-format srfi) (srfi-format-age srfi)))
+    (define gap-entry
+      (cons "----" "--"))
+    (display-two-column-table
+     (append (map entry older) (list gap-entry) (map entry newer)))))
 
 (define (srfi-by get-strings query)
   (let ((query (string-downcase query)))

srfi-tools/data.sld

@@ -34,6 +34,7 @@
           srfi-list
           srfi-range
           srfi-near
+          srfi-age-in-days
           srfi-drafts
           srfi-by-author
           srfi-by-keyword

srfi-tools/private/list.sld

@@ -15,6 +15,7 @@
           fold
           remove
           last
+          partition
           split-at
 
           list-sort
@@ -31,7 +32,7 @@
                 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))
+                filter filter-map find fold remove last partition split-at))
 
   (cond-expand
    ((or chibi cyclone gauche sagittarius)

srfi-tools/tar.sld

@@ -33,27 +33,32 @@
         (with-input-from-binary-file
          tar
          (lambda ()
-           (let loop ()
+           (let loop ((match-count 0))
              (let ((entry (tar-read-entry)))
-               (unless (eof-object? entry)
-                 (let* ((raw-path (tar-entry-path entry))
-                        (path-parts (drop (string-split #\/ raw-path) 1))
-                        (path (apply path-append path-parts)))
-                   (cond ((and (tar-entry-file? entry)
-                               (not (null? path-parts))
-                               (match? path-parts))
-                          (disp "Unpacking " path)
-                          (ensure-directories-exist
-                           (apply path-append
-                                  (srfi-home-dir)
-                                  (drop-right path-parts 1)))
-                          (with-output-to-binary-file
-                           (path-append (srfi-home-dir) path)
-                           (lambda ()
-                             (write-bytevector (tar-read-data entry)))))
-                         (else
-                          (tar-skip-data entry))))
-                 (loop))))))))
+               (cond ((eof-object? entry)
+                      (when (zero? match-count)
+                        (disp "No files matched."))
+                      match-count)
+                     (else
+                      (let* ((raw-path (tar-entry-path entry))
+                             (path-parts (drop (string-split #\/ raw-path) 1))
+                             (path (apply path-append path-parts)))
+                        (cond ((and (tar-entry-file? entry)
+                                    (not (null? path-parts))
+                                    (match? path-parts))
+                               (disp "Unpacking " path)
+                               (ensure-directories-exist
+                                (apply path-append
+                                       (srfi-home-dir)
+                                       (drop-right path-parts 1)))
+                               (with-output-to-binary-file
+                                (path-append (srfi-home-dir) path)
+                                (lambda ()
+                                  (write-bytevector (tar-read-data entry))))
+                               (loop (+ match-count 1)))
+                              (else
+                               (tar-skip-data entry)
+                               (loop match-count))))))))))))
 
     (define (srfi-unpack-tar . numbers)
       (let ((stems (map srfi-num-stem numbers)))