Skip to content

More SRFI tool patches #42

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Nov 3, 2022
Merged

More SRFI tool patches #42

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ebac0dc
Add srfi-last-number, range, near
lassik Nov 1, 2022
c86876a
Add optional <command> argument to help
lassik Nov 1, 2022
3a5f1ff
Add from-markdown, refactor from-asciidoc
lassik Nov 3, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
77 changes: 0 additions & 77 deletions srfi-tools/asciidoc.sld
View file
Open in desktop

This file was deleted.

106 changes: 106 additions & 0 deletions srfi-tools/convert.sld
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,106 @@
(define-library (srfi-tools convert)
(export srfi-from-asciidoc
srfi-from-markdown)
(import (scheme base)
(scheme char)
(scheme cxr)
(scheme file)
(scheme write)
(srfi-tools private list)
(srfi-tools private string)
(srfi-tools private command)
(srfi-tools private port)
(srfi-tools private os)
(srfi-tools private sxml)
(srfi-tools private html-parser)
(srfi-tools private html-writer))
(begin

;; Convert a SRFI draft from another markup language to HTML.
;;
;; Note that HTML is the required submission format. These
;; commands are useful for the initial conversion, but afterwards
;; it's easier for all concerned to edit the HTML and throw away
;; the original source.

(define (sxml-cleanup elem)
(let-values (((name attrs body) (parse-tag elem)))
(case name
((#f)
elem)
((head)
(make-tag name #f
(map sxml-cleanup
(remove-subtags
(flatten-subtags body 'meta)
'meta 'link 'style))))
(else
(make-tag name
(and attrs
(filter (lambda (attr) (eqv? 'href (car attr)))
attrs))
(map sxml-cleanup (remove-subtags
(flatten-subtags
(remove-subtag-ids body "footer")
'div)
'div
'colgroup)))))))

(define (source-file->html-file source-file source-extension)
(unless (string-suffix? source-extension source-file)
(error "Source file name extension is not" source-extension))
(let ((html-file (string-append
(substring source-file 0
(- (string-length source-file)
(string-length source-extension)))
".html")))
(edisp "Converting " source-file " to " html-file)
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)))

(define (srfi-from-asciidoc source-file)
(let* ((html-file (source-file->html-file source-file ".adoc"))
(html (run-program/get-output-string
(list "asciidoctor"
"-b" "xhtml5"
"-o" "-"
"--" source-file)))
(sxml (html->sxml (open-input-string html)))
(sxml (sxml-cleanup (find-html-tag sxml))))
(emit html-file sxml)))

(define (srfi-from-pandoc source-file source-extension)
(let* ((html-file (source-file->html-file source-file source-extension))
(html (run-program/get-output-string
(list "pandoc"
"-t" "html5"
"--" source-file)))
(sxml (html->sxml (open-input-string html))))
(emit html-file sxml)))

(define (srfi-from-markdown source-file)
(srfi-from-pandoc source-file ".md"))

(define-command (from-asciidoc source-file)
"Convert SRFI draft written in AsciiDoc into HTML."
(srfi-from-asciidoc source-file))

(define-command (from-markdown source-file)
"Convert SRFI draft written in Markdown into HTML."
(srfi-from-markdown source-file))))
23 changes: 21 additions & 2 deletions srfi-tools/data.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -140,6 +140,9 @@
(srfi-list))
(error "No such SRFI" num)))

(define (srfi-last-number)
(srfi/number (last (srfi-list))))

(define (resolve srfi)
(cond ((srfi? srfi)
srfi)
Expand Down Expand Up @@ -248,10 +251,26 @@
"Display a list of the most recent ten SRFIs."
(write-srfi-list (srfi-tail)))

(define (srfi-range min max)
(filter (lambda (srfi) (<= min (srfi-number srfi) max))
(srfi-list)))

(define-command (range min max)
"List SRFIs with numbers <min>..<max>."
(write-srfi-list (srfi-range (parse-srfi-number min)
(parse-srfi-number max))))

(define (srfi-near num)
(srfi-range (- num 5) (+ num 5)))

(define-command (near num)
"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-string srfi)
(define (srfi-format-age srfi)
(format "~a days"
(days-between (iso-date->date (srfi-draft-date srfi))
(current-date))))
Expand All @@ -261,7 +280,7 @@
(display-two-column-table
(map (lambda (srfi)
(cons (srfi-format srfi)
(srfi-age-string srfi)))
(srfi-format-age srfi)))
(srfi-drafts))))

(define (srfi-by get-strings query)
Expand Down
3 changes: 3 additions & 0 deletions srfi-tools/data.sld
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
srfi-keyword-alist

srfi-by-number
srfi-last-number

srfi-number
srfi-status
Expand All @@ -29,6 +30,8 @@

srfi-data
srfi-list
srfi-range
srfi-near
srfi-drafts
srfi-by-author
srfi-by-keyword
Expand Down
17 changes: 12 additions & 5 deletions srfi-tools/help.sld
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
(define-library (srfi-tools help)
(import (scheme base)
(scheme case-lambda)
(scheme write)
(srfi-tools private command)
(srfi-tools private list)
Expand Down Expand Up @@ -74,12 +75,18 @@
""
"The SRFI website is at <https://srfi.schemers.org/>."))

(define (help)
(for-each write-line help-lines))
(define help
(case-lambda
(()
(for-each write-line help-lines))
((command)
(write-line (command-help (command-by-name command))))))

(define-command (help)
"Display help."
(help))
(add-command!
"help"
'(command)
"Display general help, or help for <command>."
0 1 help)

;; Emulate all the common help flags to be user friendly.

Expand Down
4 changes: 2 additions & 2 deletions srfi-tools/main.sld
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,9 @@
(srfi-tools private error)
(srfi-tools private command)
(srfi-tools private os))
(import (srfi-tools asciidoc)
(srfi-tools chart)
(import (srfi-tools chart)
(srfi-tools checklink)
(srfi-tools convert)
(srfi-tools core)
(srfi-tools count)
(srfi-tools data)
Expand Down