scheme-requests-for-implementation · arthurgleckler · Nov 8, 2022 · Nov 7, 2022 · Nov 8, 2022 · Nov 8, 2022
diff --git a/srfi-tools/chart.scm b/srfi-tools/chart.scm
@@ -18,7 +18,7 @@
 			       i
 			       (+ 1 (vector-ref counts i)))))
 	      dates)
-    (with-output-to-file pathname
+    (with-output-to-text-file pathname
       (lambda ()
 	(do ((julian start (+ 1 julian))
 	     (i 0 (+ 1 i)))
@@ -40,7 +40,7 @@
     (write-srfi-counts withdrawn-dates "/tmp/srfi-withdrawn-counts.txt" now)))
 
 (define (gnuplot-commands today)
-  (let* ((original (read-entire-file
+  (let* ((original (read-text-file
 		    (path-append (srfi-common-dir) "admin" "srfi.gnuplot")))
 	 (end (string-contains original "-12-31"))
 	 (start (- end (string-length "YYYY"))))
@@ -49,8 +49,7 @@
 		   (string-copy original end))))
 
 (define (srfi-generate-chart today)
-  (with-output-to-file "/tmp/srfi.gnuplot"
-    (lambda () (write-string (gnuplot-commands today))))
+  (write-text-file "/tmp/srfi.gnuplot" (gnuplot-commands today))
   (write-srfi-data today)
   (run-program '("gnuplot" "/tmp/srfi.gnuplot"))
   (run-program `("cp" "-p" "/tmp/srfi.svg" ,(srfi-common-dir))))

diff --git a/srfi-tools/chart.sld b/srfi-tools/chart.sld
@@ -1,11 +1,11 @@
 (define-library (srfi-tools chart)
   (export srfi-generate-chart)
   (import (scheme base)
-	  (scheme file)
 	  (scheme write)
 	  (srfi-tools data)
 	  (srfi-tools path)
 	  (srfi-tools private command)
+	  (srfi-tools private file)
 	  (srfi-tools private list)
 	  (srfi-tools private os)
 	  (srfi-tools private path)

diff --git a/srfi-tools/checklink.sld b/srfi-tools/checklink.sld
@@ -1,8 +1,6 @@
 (define-library (srfi-tools checklink)
   (import (scheme base)
-	  (scheme file)
 	  (scheme write)
-	  (srfi-tools path)
 	  (srfi-tools private command)
 	  (srfi-tools private os))
   (include "checklink.scm"))
diff --git a/srfi-tools/convert.sld b/srfi-tools/convert.sld
@@ -4,8 +4,8 @@
   (import (scheme base)
           (scheme char)
           (scheme cxr)
-          (scheme file)
           (scheme write)
+
           (srfi-tools private list)
           (srfi-tools private string)
           (srfi-tools private command)
@@ -58,21 +58,19 @@
         html-file))
 
     (define (emit html-file sxml)
-      (let ((html (with-output-to-string
-                    (lambda ()
-                      (write-string "<!doctype html>")
-                      (sxml-display-as-html sxml)))))
-        (call-with-output-file html-file
-          (lambda (out) (write-string html out)))
-        (edisp "Running HTML Tidy on " html-file)
-        (run-program/get-boolean
-         (list "tidy"
-               "-q"
-               "-indent"
-               "-modify"
-               "--tidy-mark" "no"
-               "--" html-file))
-        (values)))
+      (write-html-file html-file sxml)
+      (edisp "Running HTML Tidy on " html-file)
+      ;; `run-program/get-boolean` avoids raising an exception when
+      ;; the exit code is 1. HTML Tidy uses that exit code when there
+      ;; are warnings. The warnings are harmless in this case.
+      (run-program/get-boolean
+       (list "tidy"
+             "-q"
+             "-indent"
+             "-modify"
+             "--tidy-mark" "no"
+             "--" html-file))
+      (values))
 
     (define (srfi-from-asciidoc source-file)
       (let* ((html-file (source-file->html-file source-file ".adoc"))
@@ -81,7 +79,7 @@
                           "-b" "xhtml5"
                           "-o" "-"
                           "--" source-file)))
-             (sxml (html->sxml (open-input-string html)))
+             (sxml (call-with-port (open-input-string html) html->sxml))
              (sxml (sxml-cleanup (find-html-tag sxml))))
         (emit html-file sxml)))
 
@@ -91,7 +89,7 @@
                     (list "pandoc"
                           "-t" "html5"
                           "--" source-file)))
-             (sxml (html->sxml (open-input-string html))))
+             (sxml (call-with-port (open-input-string html) html->sxml)))
         (emit html-file sxml)))
 
     (define (srfi-from-markdown source-file)

diff --git a/srfi-tools/data.scm b/srfi-tools/data.scm
@@ -115,8 +115,13 @@
    (srfi-attribute alist 'done-date #f 'optional)
    (srfi-attribute alist 'draft-date)))
 
-(define (read-srfi-data pathname)
-  (map alist->srfi (with-input-from-file pathname read-all)))
+(define (srfi-data)
+  (with-input-from-text-file (srfi-data-file) read-all))
+
+(define-command (data)
+  "Display the SRFI database, which is an S-expression."
+  (dump-file (srfi-data-file))
+  (newline))
 
 ;; (define srfi-assoc
 ;;   (association-procedure = srfi/number))
@@ -132,7 +137,7 @@
   (let ((srfis #f))
     (lambda ()
       (or srfis
-          (begin (set! srfis (read-srfi-data (srfi-data-file)))
+          (begin (set! srfis (map alist->srfi (srfi-data)))
                  srfis)))))
 
 (define (srfi-by-number num)
@@ -246,14 +251,6 @@
 
 ;;
 
-(define (srfi-data)
-  (with-input-from-file (srfi-data-file) read-all))
-
-(define-command (data)
-  "Display the SRFI database, which is an S-expression."
-  (dump-file (srfi-data-file))
-  (newline))
-
 (define-command (list)
   "Display a list of all the SRFIs."
   (write-srfi-list (srfi-list)))

diff --git a/srfi-tools/data.sld b/srfi-tools/data.sld
@@ -53,7 +53,6 @@
           (scheme case-lambda)
           (scheme char)
           (scheme cxr)
-          (scheme file)
           (scheme read)
 	  (srfi-tools private error)
 	  (srfi-tools private list)

diff --git a/srfi-tools/generate.scm b/srfi-tools/generate.scm
@@ -490,7 +490,7 @@
 	 (status (srfi-status srfi))
 	 (title (srfi-title srfi))
 	 (authors (srfi-authors srfi)))
-    (write-html (path-append (srfi-dir number) "index.html")
+    (write-html-file (path-append (srfi-dir number) "index.html")
       (index-template
        abstract
        (srfi-format-authors authors)
@@ -515,7 +515,7 @@
 	 (status (srfi-status srfi))
 	 (title (srfi-title srfi))
 	 (authors (srfi-authors srfi)))
-    (write-org (path-append (srfi-dir number) "README.org")
+    (write-org-file (path-append (srfi-dir number) "README.org")
       (readme-template
        (srfi-format-authors authors)
        based-on
@@ -599,7 +599,7 @@
 
 ;; This generates the "index.html" that is used as the SRFI home page.
 (define (write-srfi-home-page)
-  (write-html (path-append (srfi-common-dir) "index.html")
+  (write-html-file (path-append (srfi-common-dir) "index.html")
     (home-template (keyword-options)
 		   (map srfi-card-template (reverse (srfi-list))))))
 
@@ -691,7 +691,7 @@
      ".")))
 
 (define (write-srfi-list-subscribe-page)
-  (write-html (path-append (srfi-common-dir) "srfi-list-subscribe.html")
+  (write-html-file (path-append (srfi-common-dir) "srfi-list-subscribe.html")
     (srfi-list-subscribe-template
      schemecomm
      schemedoc

diff --git a/srfi-tools/generate.sld b/srfi-tools/generate.sld
@@ -6,7 +6,6 @@
 	  write-srfi-list-subscribe-page
 	  write-srfi-readmes)
   (import (scheme base)
-	  (scheme file)
 
 	  (srfi-tools private command)
 	  (srfi-tools private html-writer)

diff --git a/srfi-tools/git.sld b/srfi-tools/git.sld
@@ -4,7 +4,6 @@
           srfi-clone
           srfi-pull)
   (import (scheme base)
-          (scheme file)
           (srfi-tools private command)
           (srfi-tools private format)
           (srfi-tools private list)

diff --git a/srfi-tools/html.sld b/srfi-tools/html.sld
@@ -11,7 +11,7 @@
           srfi-link-html
           srfi-link-md)
   (import (scheme base)
-          (scheme file)
+
           (srfi-tools private list)
           (srfi-tools private string)
           (srfi-tools private hash-table)
@@ -29,20 +29,20 @@
   (begin
 
     (define (srfi-landing-sxml num)
-      (call-with-input-file (srfi-landing-html-file num) html->sxml))
+      (read-html-file (srfi-landing-html-file num)))
 
     (define (srfi-landing-html num)
-      (file-contents-as-string (srfi-landing-html-file num)))
+      (read-text-file (srfi-landing-html-file num)))
 
     (define-command (landing-html num)
       "Display SRFI landing page for SRFI <num>."
       (write-string-about-srfi srfi-landing-html num))
 
     (define (srfi-sxml num)
-      (call-with-input-file (srfi-html-file num) html->sxml))
+      (read-html-file (srfi-html-file num)))
 
     (define (srfi-html num)
-      (file-contents-as-string (srfi-html-file num)))
+      (read-text-file (srfi-html-file num)))
 
     (define-command (html num)
       "Display HTML of SRFI document for SRFI <num>."
@@ -56,15 +56,14 @@
       (write-string-about-srfi srfi-text num))
 
     (define (srfi-abstract-raw num)
-      `(@raw ,(read-entire-file (srfi-abstract-html-file num))))
+      `(@raw ,(read-text-file (srfi-abstract-html-file num))))
 
     (define (srfi-abstract-sxml num)
       (define skip-top cdr)
-      (skip-top
-       (call-with-input-file (srfi-abstract-html-file num) html->sxml)))
+      (skip-top (read-html-file (srfi-abstract-html-file num))))
 
     (define (srfi-abstract-html num)
-      (file-contents-as-string (srfi-abstract-html-file num)))
+      (read-text-file (srfi-abstract-html-file num)))
 
     (define-command (abstract-html num)
       "Display abstract for SRFI <num> as HTML."

diff --git a/srfi-tools/legal.sld b/srfi-tools/legal.sld
@@ -29,12 +29,11 @@
         "WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE."))
 
     (define (srfi-license-lines who)
-      (append (list (string-append "Copyright (C) " who "."))
-              mit-license-boilerplate))
+      (cons (string-append "Copyright (C) " who ".")
+            mit-license-boilerplate))
 
     (define (srfi-license-string who)
-      (string-join (append (srfi-license-lines who) (list ""))
-                   "\n"))
+      (string-join-lines (srfi-license-lines who)))
 
     (define-command (generate-license who)
       "Generate the standard MIT License and copyright message."

diff --git a/srfi-tools/library.sld b/srfi-tools/library.sld
@@ -2,7 +2,7 @@
   (export srfi-library-names-sxml
           srfi-generate-library-names)
   (import (scheme base)
-          (scheme file)
+
           (srfi-tools private list)
           (srfi-tools private format)
           (srfi-tools private path)
@@ -49,8 +49,7 @@
       (let ((file (path-append (srfi-common-dir) "library-names.html"))
             (sxml (srfi-library-names-sxml)))
         (disp "Writing " file)
-        (with-output-to-file file
-          (lambda () (sxml-display-as-html sxml)))))
+        (write-html-file file sxml)))
 
     (define-command (generate-library-names)
       "Display the SRFI 97 library names."

diff --git a/srfi-tools/missing.sld b/srfi-tools/missing.sld
@@ -1,8 +1,8 @@
 (define-library (srfi-tools missing)
   (import (scheme base)
           (scheme char)
-          (scheme file)
           (scheme write)
+
           (srfi-tools private list)
           (srfi-tools private string)
           (srfi-tools private hash-table)
@@ -34,7 +34,7 @@
                  (when (and href (string-prefix? "#" href))
                    (let ((anchor (substring href 1 (string-length href))))
                      (hash-table-set! hrefs anchor #t)))))))
-         (call-with-input-file html-file html->sxml))
+         (read-html-file html-file))
         (let loop ((hrefs (hash-table-keys hrefs)) (missing-names '()))
           (if (null? hrefs)
               (list-sort (lambda (a b) (string<? (string-downcase a)

diff --git a/srfi-tools/pre.sld b/srfi-tools/pre.sld
@@ -4,11 +4,12 @@
           pre-srfi-list
           pre-srfi-new)
   (import (scheme base)
-          (scheme file)
+          (srfi-tools private file)
           (srfi-tools private list)
           (srfi-tools private path)
           (srfi-tools private port)
           (srfi-tools private format)
+          (srfi-tools private string)
           (srfi-tools private os)
           (srfi-tools private command)
           (srfi-tools data)
@@ -71,8 +72,7 @@
 
     (define (prepare-file filename lines)
       (unless (file-exists? filename)
-        (with-output-to-file filename
-          (lambda () (for-each write-line lines)))))
+        (write-text-file filename (string-join-lines lines))))
 
     (define (pre-srfi-new name)
       (let ((dir (pre-srfi-dir name)))

diff --git a/srfi-tools/private/external.sld b/srfi-tools/private/external.sld
@@ -11,6 +11,7 @@
           (scheme file)
           (scheme process-context)
           (srfi-tools private string)
+          (srfi-tools private file)
           (srfi-tools private port)
           (srfi-tools private error)
           (srfi-tools private os))
@@ -63,9 +64,7 @@
           (user-error "PAGER environment variable not set."))
         (let ((rendered (render-web-page-as-plain-text url))
               (temp-file (make-temp-file-name)))
-          (with-output-to-file temp-file
-            (lambda ()
-              (write-string rendered)))
+          (write-text-file temp-file rendered)
           (run-program (list pager temp-file)))))
 
     (define (download-url-into-file url filename)