More SRFI tool patches

srfi-tools/data.scm

@@ -260,17 +260,30 @@
   "Display a list of all the draft SRFIs."
   (write-custom-srfi-list (srfi-drafts) srfi-age-string))
 
+(define (srfi-by get-strings query)
+  (let ((query (string-downcase query)))
+    (filter (lambda (srfi)
+              (any (lambda (string)
+                     (string-contains (string-downcase string) query))
+                   (get-strings srfi)))
+            (srfi-list))))
+
 (define (srfi-by-author name)
-  (filter (lambda (srfi)
-            (any (lambda (author)
-                   (string-ci=? name (srfi-author-name author)))
-                 (srfi/authors srfi)))
-          (srfi-list)))
+  (srfi-by (lambda (srfi) (map srfi-author-name (srfi-authors srfi)))
+           name))
 
 (define-command (by-author name)
-  "Display a list of all the SRFIs by authors with <name> in their names."
+  "List all SRFIs with <name> as an author."
   (write-srfi-list (srfi-by-author name)))
 
+(define (srfi-by-keyword keyword)
+  (srfi-by (lambda (srfi) (map srfi-format-keyword (srfi-keywords srfi)))
+           keyword))
+
+(define-command (by-keyword keyword)
+  "List all SRFIs filed under <keyword>."
+  (write-srfi-list (srfi-by-keyword keyword)))
+
 (define (srfi-search words)
   (let ((words (map string-downcase words)))
     (filter (lambda (srfi)

srfi-tools/data.sld

@@ -31,6 +31,7 @@
           srfi-list
           srfi-drafts
           srfi-by-author
+          srfi-by-keyword
           srfi-search
 
           try-parse-srfi-number

srfi-tools/git.sld

@@ -1,7 +1,8 @@
 (define-library (srfi-tools git)
   (export srfi-git-https-url
           srfi-git-ssh-url
-          srfi-clone)
+          srfi-clone
+          srfi-pull)
   (import (scheme base)
           (scheme file)
           (srfi-tools private command)
@@ -26,13 +27,16 @@
       "Display the Git SSH URL for SRFI <num>."
       (write-line-about-srfi srfi-git-ssh-url num))
 
+    (define (in-git-dir?)
+      (run-program/get-boolean '("git" "rev-parse" "--git-dir")))
+
     (define (srfi-clone num)
       (let ((dir (srfi-dir num)))
         (ensure-directory dir)
         (with-current-directory
          dir
          (lambda ()
-           (when (run-program/get-boolean '("git" "rev-parse" "--git-dir"))
+           (when (in-git-dir?)
              (error "That SRFI is already under git version control."))
            (run-program '("git" "init"))
            (run-program `("git" "remote" "add" "origin"
@@ -46,4 +50,27 @@
 
     (define-command (clone num)
       "Pull SRFI <num> from its git version control repository."
-      (srfi-clone (parse-srfi-number num)))))
+      (srfi-clone (parse-srfi-number num)))
+
+    (define (srfi-pull . numbers)
+      (for-each
+       (lambda (num)
+         (let ((dir (srfi-dir num)))
+           (disp dir)
+           (with-current-directory
+            dir
+            (lambda ()
+              (unless (in-git-dir?)
+                (error "SRFI is not under git version control." num))
+              (run-program '("git" "pull"))))
+           (disp)))
+       numbers))
+
+    (add-command!
+     "pull"
+     '(number ...)
+     "Run `git pull` for the given SRFI <number>s."
+     1
+     #f
+     (lambda numbers
+       (apply srfi-pull (map parse-srfi-number numbers))))))