[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH 1/1] reader: Add Gemtext reader.
From: |
indieterminacy |
Subject: |
Re: [PATCH 1/1] reader: Add Gemtext reader. |
Date: |
Wed, 16 Mar 2022 21:23:34 +0100 |
Cool!
Out of interest how are making use of the symbol '<=' in this section?
```
+ ((let ((heading-level (heading-level line)))
+ (and heading-level
+ (<= heading-level level)))
```
Given the context, it makes a delicious inversion of GemText's symbol for
a link.
Also, can you clarify your the repeated use of the symbol '=>' in the function
read-gemtext-element port?
Jonathan
Arun Isaac <arunisaac@systemreboot.net> writes:
> * src/guile/skribilo/reader/gemtext.scm: New file.
> * src/guile/Makefile.am (readers): Register it.
> * doc/user/syntax.skb (The Gemtext Syntax): New section.
> ---
> doc/user/syntax.skb | 21 ++-
> src/guile/Makefile.am | 3 +-
> src/guile/skribilo/reader/gemtext.scm | 220 ++++++++++++++++++++++++++
> 3 files changed, 242 insertions(+), 2 deletions(-)
> create mode 100644 src/guile/skribilo/reader/gemtext.scm
>
> diff --git a/doc/user/syntax.skb b/doc/user/syntax.skb
> index 9a4070c..2de7cbd 100644
> --- a/doc/user/syntax.skb
> +++ b/doc/user/syntax.skb
> @@ -211,7 +211,26 @@ documents that can be output in variety of formats (see
> ,(numref :text
> [Chapter] :ident "engines")). The downside is that, being a very simple
> markup-less document format, there are many things that cannot be done
> using it, most notably tables, bibliographies, and cross-references.]))
> -
> +
> + (section :title [The Gemtext Syntax] :ident "gemtext-syntax"
> + (p [,(ref
> +:url "https://gemini.circumlunar.space/docs/gemtext.gmi"
> +:text "Gemtext"), the lightweight markup language used by the ,(ref
> +:url "https://gemini.circumlunar.space" :text "Gemini protocol"), is
> +supported as an input syntax. To use it, just pass ,(tt
> +[--reader=gemtext]) to the compiler. When used programmatically, the
> +Gemtext reader can be customized using the following options.])
> +
> + (doc-markup 'make-gemtext-reader
> + '((:join-lines? [If ,(code "#t"), lines which are not
> +separated by a blank line are joined into a single paragraph. This is
> +a relaxation of the Gemtext standard, and is not done by default.])
> + (:section-numbers? [If ,(code "#t"), sections are
> +numbered. Else, they are not.]))
> + :common-args '()
> + :source "skribilo/reader/gemtext.scm"
> + :idx *function-index*))
> +
> (section :title [The RSS 2.0 Syntax]
> :ident "rss2-syntax"
>
> diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am
> index 98f2873..0a66a88 100644
> --- a/src/guile/Makefile.am
> +++ b/src/guile/Makefile.am
> @@ -47,7 +47,8 @@ SOURCES =
> \
> SOURCES += $(readers) $(packages) $(engines)
>
> readers = \
> - skribilo/reader/skribe.scm skribilo/reader/outline.scm
> + skribilo/reader/skribe.scm skribilo/reader/outline.scm \
> + skribilo/reader/gemtext.scm
>
> if BUILD_RSS2_READER
>
> diff --git a/src/guile/skribilo/reader/gemtext.scm
> b/src/guile/skribilo/reader/gemtext.scm
> new file mode 100644
> index 0000000..06bfe70
> --- /dev/null
> +++ b/src/guile/skribilo/reader/gemtext.scm
> @@ -0,0 +1,220 @@
> +;;; gemtext.scm -- A reader for the Gemini protocol's Gemtext markup
> +;;;
> +;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
> +;;;
> +;;;
> +;;; This file is part of Skribilo.
> +;;;
> +;;; Skribilo is free software: you can redistribute it and/or modify
> +;;; it under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation, either version 3 of the License, or
> +;;; (at your option) any later version.
> +;;;
> +;;; Skribilo is distributed in the hope that it will be useful,
> +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with Skribilo. If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (skribilo reader gemtext)
> + #:use-module (rnrs io ports)
> + #:use-module (srfi srfi-26)
> + #:use-module (srfi srfi-71)
> + #:use-module (srfi srfi-171)
> + #:use-module (ice-9 match)
> + #:use-module ((ice-9 textual-ports) #:select (unget-char unget-string))
> + #:use-module (skribilo reader)
> + #:export (reader-specification
> + make-gemtext-reader))
> +
> +(skribilo-module-syntax)
> +
> +;;; Author: Arun Isaac
> +;;;
> +;;; Commentary:
> +;;;
> +;;; A reader for gemtext, the lightweight markup language used by the
> +;;; Gemini protocol
> +;;;
> +;;; Code:
> +
> +(define %join-lines?
> + (make-parameter #f))
> +
> +(define %section-numbers?
> + (make-parameter #f))
> +
> +(define (string-blank? str)
> + "Return #t if STR contains only whitespace characters. Else, return
> +#f."
> + (string-every char-set:whitespace str))
> +
> +(define (string-remove-prefix prefix str)
> + "Return STR with PREFIX removed. If PREFIX is not a prefix of STR,
> +return #f."
> + (and (string-prefix? prefix str)
> + (substring str (string-length prefix))))
> +
> +(define (string-partition str char-pred)
> + "Return the part of STR before and after the first occurrence of
> +CHAR-PRED as two values."
> + (let ((partition-index (string-index str char-pred)))
> + (if partition-index
> + (values (substring str 0 partition-index)
> + (substring str partition-index))
> + (values str #f))))
> +
> +(define (unget-line port line)
> + "Place the string LINE in PORT so that subsequent read operations
> +will read LINE followed by a newline character."
> + (unget-char port #\newline)
> + (unget-string port line))
> +
> +(define (read-preformatted-text in out)
> + "Read preformatted text from port IN and write it to port OUT."
> + (let ((line (get-line in)))
> + (unless (or (eof-object? line)
> + (string-prefix? "```" line))
> + (put-string out line)
> + (newline out)
> + (read-preformatted-text in out))))
> +
> +(define (heading-level line)
> + "Return the level of the heading in LINE. If LINE is not a heading,
> +return #f."
> + (cond
> + ((string-prefix? "### " line) 3)
> + ((string-prefix? "## " line) 2)
> + ((string-prefix? "# " line) 1)
> + (else #f)))
> +
> +(define (read-section-children level port)
> + "Read section elements of LEVEL from PORT. Return as a list."
> + (let ((line (get-line port)))
> + (cond
> + ;; End of file
> + ((eof-object? line) (list))
> + ;; If another heading of same or higher level begins, unget line
> + ;; and end section.
> + ((let ((heading-level (heading-level line)))
> + (and heading-level
> + (<= heading-level level)))
> + (unget-line port line)
> + (list))
> + ;; If blank line, continue.
> + ((string-blank? line)
> + (read-section-children level port))
> + ;; Else, add element and continue.
> + (else
> + (unget-line port line)
> + (cons (read-gemtext-element port)
> + (read-section-children level port))))))
> +
> +(define (paragraph-line? line)
> + "Return #t if LINE is a paragraph line. Else, return #f."
> + (not (or (string-blank? line)
> + (heading-level line)
> + (string-prefix? "* " line)
> + (string-prefix? ">" line)
> + (string-prefix? "=>" line)
> + (string-prefix? "```" line))))
> +
> +(define (read-gemtext-element port)
> + "Read next gemtext element from PORT."
> + (let ((line (get-line port)))
> + (cond
> + ;; End of file
> + ((eof-object? line) line)
> + ;; Section
> + ((heading-level line)
> + => (lambda (level)
> + `(,(case level
> + ((1) 'section)
> + ((2) 'subsection)
> + ((3) 'subsubsection))
> + #:title ,(substring line (1+ level))
> + #:number ,(%section-numbers?)
> + ,@(read-section-children level port))))
> + ;; List
> + ((string-remove-prefix "* " line)
> + => (lambda (first-item)
> + `(itemize
> + ,@(port-transduce (compose (ttake-while (cut string-prefix? "*
> " <>)
> + (lambda (result line)
> + (unget-line port line)
> + result))
> + (tmap (lambda (line)
> + `(item
> ,(string-remove-prefix "* " line)))))
> + rcons
> + (list `(item ,first-item))
> + get-line
> + port))))
> + ;; Blockquote
> + ((string-remove-prefix ">" line)
> + => (lambda (first-line)
> + (list 'blockquote
> + (if (%join-lines?)
> + (string-join
> + (port-transduce (compose (ttake-while (cut
> string-prefix? ">" <>)
> + (lambda (result
> line)
> + (unget-line
> port line)
> + result))
> + (tmap (cut
> string-remove-prefix ">" <>)))
> + rcons
> + (list first-line)
> + get-line
> + port)
> + " ")
> + line))))
> + ;; Link
> + ((string-remove-prefix "=>" line)
> + => (lambda (line)
> + (let* ((trimmed-line (string-trim line))
> + (url text (string-partition trimmed-line (char-set #\space
> #\tab))))
> + `(paragraph ,(if text
> + `(ref #:url ,url #:text ,(string-trim text))
> + `(ref #:url ,url))))))
> + ;; Preformatted text
> + ((string-remove-prefix "```" line)
> + => (lambda (alt-text)
> + ;; We don't use the alt text.
> + `(pre ,(call-with-output-string
> + (cut read-preformatted-text port <>)))))
> + ;; Ignore blank lines.
> + ((string-blank? line) (read-gemtext-element port))
> + ;; Paragraph
> + (else
> + (list 'paragraph
> + (if (%join-lines?)
> + (string-join
> + (port-transduce (ttake-while paragraph-line?
> + (lambda (result line)
> + (unget-line port line)
> + result))
> + rcons
> + (list line)
> + get-line
> + port)
> + " ")
> + line))))))
> +
> +(define* (make-gemtext-reader :key join-lines? section-numbers?)
> + "Return a gemtext reader.
> +
> +If JOIN-LINES? is #t, lines which are not separated by a blank line
> +are joined into a single paragraph.
> +
> +If SECTION-NUMBERS? is #t, sections are numbered. Else, they are not."
> + (lambda (port)
> + (parameterize ((%join-lines? join-lines?)
> + (%section-numbers? section-numbers?))
> + (match (port-transduce (tmap identity)
> + rcons
> + read-gemtext-element
> + port)
> + (() (eof-object))
> + (elements `(document ,@elements))))))
> +
> +(define-reader gemtext "0.1" make-gemtext-reader)