(import chicken.base chicken.io chicken.irregex srfi-13) ;;; ;;; Reading Gemtext into Sexps: ;;; ;;; # Headers ;;; ;;; ^(#+)\s+(.*)$ ;;; ;;; `(header ,(string-length $1) ,$2) ;;; ;;; NOTE: Accept non-strictly-confirming Gemtext (e.g. ####) ;;; ;;; # Lists ;;; ;;; * item 1 ;;; * item 2 ;;; ;;; `(list "item 1" ;;; "item 2") ;;; ;;; # Code blocks ;;; ;;; ```some optional alt text ;;; some ;;; pre-formatted ;;; text ;;; ``` ;;; ;;; `(code "some optional alt text" ;;; "some" ;;; "pre-formatted" ;;; "text") ;; Predicates return either an irregex match object, if the regex matches the ;; line; otherwise, #f ;; "Constructors" accept an (define header? (cute irregex-match (irregex "(#+)\\s+(.*)") <>)) (define link? (cute irregex-match (irregex "=>\\s*([^\\s]+)(\\s+(.*))?") <>)) (define list-item? (cute irregex-match (irregex "\\*\\s+(.*)") <>)) (define begin-code-line? (cute irregex-match (irregex "```(.*)") <>)) (define end-code-line? (cute string=? "```" <>)) (define-syntax match-let (syntax-rules () ((match-let match ((var idx) ...) body ...) (let ((%match match)) (receive (var ...) (values (irregex-match-substring %match idx) ...) body ...))))) (define (header ret match) (match-let match ((level 1) (title 2)) (let ((level (string-length level))) (cons `(header ,level ,title) ret)))) (define (link ret match) (match-let match ((url 1) (text 3)) (cons `(link ,url ,text) ret))) (define (list-item ret match) (match-let match ((text 1)) (cons text ret))) (define (end-list items ret) (cons `(list . ,(reverse items)) ret)) (define (begin-code ret match) (match-let match ((text 1)) (cons text ret))) (define (end-code code-lines ret) (cons `(code . ,(reverse code-lines)) ret)) (define (text ret txt) (cons txt ret)) (define eof? null?) (define finish-off reverse) (define ((goto st piece ret tail) match) (st (piece ret match) tail)) (define ((st:list ret) items lines) (if (eof? lines) (finish-off (end-list items ret)) (let ((head (car lines)) (tail (cdr lines))) (cond ((list-item? head) => (goto (st:list ret) list-item items tail)) (else (st:text (end-list items ret) lines)))))) (define ((st:code ret) code-lines lines) (if (eof? lines) (finish-off (end-code code-lines ret)) (let ((head (car lines)) (tail (cdr lines))) (cond ((end-code-line? head) (st:text (end-code code-lines ret) tail)) (else ((st:code ret) (cons head code-lines) tail)))))) (define (st:text ret lines) (if (eof? lines) (finish-off ret) (let ((head (car lines)) (tail (cdr lines))) (cond ((header? head) => (goto st:text header ret tail)) ; TODO: links ((link? head) => (goto st:text link ret tail)) ((list-item? head) => (goto (st:list ret) list-item '() tail)) ((begin-code-line? head) => (goto (st:code ret) begin-code '() tail)) (else ((goto st:text text ret tail) head)))))) (define (gmi:read #!optional (port (current-input-port))) (st:text '() (read-lines port)))