initial commit

.gitignore

@@ -0,0 +1,10 @@
+*~
+*.go
+aclocal.m4
+autom4te.cache/
+Makefile
+Makefile.in
+config.log
+config.status
+configure
+pre-inst-env

Makefile.am

@@ -0,0 +1,9 @@
+include guile.am
+
+moddir=$(prefix)/share/guile/site/2.0
+godir=$(prefix)/share/guile/site/2.0
+
+SOURCES =                           \
+  commonmark.scm
+
+EXTRA_DIST += pre-inst-env.in

bootstrap

@@ -0,0 +1,3 @@
+#! /bin/sh
+
+autoreconf -vif

commonmark.scm

@@ -0,0 +1,253 @@
+(use-modules (srfi srfi-9)
+             (srfi srfi-41)
+             (ice-9 regex)
+             (ice-9 rdelim))
+
+;; Node-Type is one of:
+;; - 'document
+;; - 'hrule
+;; - 'paragraph
+;; - 'block-quote
+;; - 'code-block
+;; - 'fenced-code
+;; - 'atx-header
+;; - 'setext-header
+;; interp. The type of CommonMark block node
+
+(define-record-type <node>
+  (make-node type children data closed)
+  node?
+  (type node-type)
+  (children node-children)
+  (data node-data)
+  (closed node-closed?))
+;; Node is (make-node Node-Type (listof Node) Node-Data Boolean)
+;; interp. a node to represent a CommonMark document
+
+;; String -> String
+;; Expands tabs in the string into spaces
+(define (expand-tabs line)
+  (list->string 
+   (let loop ((l (string->list line)) (c 1))
+     (cond [(null? l) '()]
+           [(char=? #\tab (car l))
+            (if (= (remainder c 4) 0)
+                (cons #\space
+                      (loop (cdr l) (1+ c)))
+                (cons #\space
+                      (loop l (1+ c))))]
+           [else (cons (car l)
+                       (loop (cdr l) (1+ c)))]))))
+
+;; Port -> HTML
+;; parses a commonmark document and converts it to HTML
+(define (commonmark->html p)
+  (document->html (parse-inlines (parse-blocks p))))
+
+;; (listof Node) -> Boolean
+;; returns true if the n has no children
+(define (no-children? n)
+  (null? (node-children n)))
+
+;; Node -> Boolean
+(define (block-quote-node? n)
+  (equal? (node-type n) 'block-quote))
+
+(define (document-node? n)
+  (equal? (node-type n) 'document))
+
+(define (paragraph-node? n)
+  (equal? (node-type n) 'paragraph))
+
+(define (code-block-node? n)
+  (equal? (node-type n) 'code-block))
+
+(define (fenced-code-node? n)
+  (equal? (node-type n) 'fenced-code))
+
+(define re-hrule (make-regexp "^((\\* *){3,}|(_ *){3,}|(- *){3,}) *$"))
+(define re-block-quote (make-regexp "^ {0,3}>"))
+(define re-atx-header (make-regexp "^ {0,3}(#{1,6}) "))
+(define re-indented-code-block (make-regexp "^    "))
+(define re-setext-header (make-regexp "^ {0,3}(=+|-+) *$"))
+(define re-empty-line (make-regexp "^ *$"))
+(define re-fenced-code (make-regexp "^ {0,3}(```|~~~)([^`]*)$"))
+
+(define (block-quote? l)
+  (regexp-exec re-block-quote l))
+
+(define (atx-header? l)
+  (regexp-exec re-atx-header l))
+
+(define (code-block? l)
+  (regexp-exec re-indented-code-block l))
+
+(define (empty-line? l)
+  (regexp-exec re-empty-line l))
+
+(define (hrule? line)
+  (regexp-exec re-hrule line))
+
+(define (setext-header? line)
+  (regexp-exec re-setext-header line))
+
+(define (fenced-code? line)
+  (regexp-exec re-fenced-code line))
+
+(define (fenced-code-end? line)
+  (string-match "```" line))
+
+
+(define (child-closed? n)
+  (node-closed? (last-child n)))
+
+(define (last-child n)
+  (car (node-children n)))
+
+(define (rest-children n)
+  (cdr (node-children n)))
+
+;; Port -> Document
+;; parses commonmark by blocks and creates a document containing blocks
+;; !!!
+(define (parse-blocks p)
+  (let loop ((root (make-node 'document '() '() #f))
+             (line (read-tabless-line p)))
+    (if (eof-object? line)
+        root 
+        (loop (parse-open-block root line)
+              (read-tabless-line p)))))
+
+;; Node String -> Node
+(define (parse-open-block n l)
+  (cond ((node-closed? n) n)
+        ((no-children? n) (make-node (node-type n) (list (parse-line l)) (node-data n) #f))
+        ((document-node? n) (parse-new-block n l))
+        ((empty-line? l) (make-node (node-type n) (node-children n) (node-data n) #t))
+        ((block-quote-node? n) (cond ((block-quote? l) => (lambda (rest-line)
+                                                            (parse-new-block n (match:suffix rest-line))))
+                                     (else (make-node 'block-quote (node-children n) (node-data n) #t))))
+        ((code-block-node? n) (cond ((code-block? l) => (lambda (rest-line)
+                                                          (make-node 'code-block 
+                                                                     (list (string-append (last-child n)
+                                                                                          "\n"
+                                                                                          (match:suffix rest-line)))
+                                                                     (node-data n)
+                                                                     #f)))
+                                    (else (make-node 'code-block (node-children n) (node-data n) #t))))
+        ((fenced-code-node? n) (cond ((fenced-code-end? l) (make-node 'fenced-code
+                                                                      (node-children n)
+                                                                      (node-data n)
+                                                                      #t))
+                                     (else (make-node 'fenced-code
+                                                      (list (string-append (last-child n)
+                                                                           "\n"
+                                                                           l))
+                                                      (node-data n)
+                                                      #f))))
+        ((paragraph-node? n) (let ((parsed-line (parse-line l)))
+                               (cond ((and (setext-header? l) (= (length (node-children n)) 1))
+                                      (make-node 'header 
+                                                 (node-children n)
+                                                 (node-data n)
+                                                 #f))
+                                ((paragraph-node? parsed-line)
+                                      (make-node 'paragraph 
+                                                 (cons (last-child parsed-line) (node-children n))
+                                                 (node-data n)
+                                                 #f))
+                                (else (make-node 'paragraph (node-children n) (node-data n) #t)))))
+        ((child-closed? n) (make-node (node-type n) (cons (parse-line l) (node-children n)) (node-data n) #f))))
+
+;; Node String -> Node
+(define (parse-new-block n l)
+  (let ((new-child (parse-open-block (last-child n) l)))
+    (make-node (node-type n) 
+               (cond ((and (not (or (empty-line? l) (fenced-code-node? new-child))) (node-closed? new-child)) 
+                      (cons (parse-line l) (cons new-child (rest-children n))))
+                     (else (cons new-child (rest-children n))))
+               (node-data n)
+               #f)))
+
+(define (header-level s)
+  (string-length s))
+
+;; String -> Node
+(define (parse-line l)
+  (cond ((hrule? l) (make-node 'hrule '() '() #t))
+        ((block-quote? l) => (lambda (s) 
+                               (make-node 'block-quote 
+                                          (list (parse-line (match:suffix s)))
+                                          '()
+                                          #f)))
+        ((atx-header? l) => (lambda (s)
+                              (make-node 'header
+                                         (list (make-node 'text (match:suffix s) '() #t))
+                                         `((level . ,(header-level (match:substring s 1))))
+                                         #t)))
+        ((code-block? l) => (lambda (s)
+                              (make-node 'code-block
+                                         (list (match:suffix s))
+                                         '()
+                                         #f)))
+        ((fenced-code? l) => (lambda (s)
+                               (make-node 'fenced-code
+                                          (list (match:substring s 2))
+                                          '()
+                                          #f)))
+        (else (make-node 'paragraph (list (make-node 'text l '() #f)) '() #f))))
+
+;; Line is one of:
+;;  - String
+;;  - eof-object
+
+;; Port -> Line
+;; read a line from port p and expands any tabs
+(define (read-tabless-line p)
+  (let ((line (read-line p)))
+    (if (eof-object? line)
+        line 
+        (expand-tabs line))))
+
+
+;; Document -> Document
+;; parses the lines of the document
+;; !!!
+
+(define (parse-inlines d)
+  (... d))
+
+;; Document -> HTML
+;; converts the document into HTML
+;; !!!
+
+(define (document->html d)
+  (... d))
+
+
+(define (print-node n)
+  (define (inner n d)
+    (cond ((null? n) #f)
+          ((string? n)
+           (display "\"")
+           (display n)
+           (display "\""))
+          ((equal? (node-type n) 'text) 
+           (add-depth d) 
+           (display (node-children n))) 
+          (else
+           (add-depth d)
+           (display (node-type n))
+           (map (lambda (n) 
+                  (newline)
+                  (inner n (+ d 1))) (node-children n)))))
+  (inner n 0)
+  (newline))
+
+(define (add-depth d)
+  (when (> d 0)
+    (display "   ")
+    (add-depth (- d 1))))
+
+(define (parse-text s)
+  (print-node (parse-blocks (open-input-string s))))

configure.ac

@@ -0,0 +1,12 @@
+
+AC_INIT([commonmark], [0.1.dev])
+AM_INIT_AUTOMAKE([-Wall -Werror foreign])
+
+PKG_CHECK_MODULES([GUILE], [guile-2.0])
+
+GUILE_PROGS
+
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+
+AC_OUTPUT

guile.am

@@ -0,0 +1,14 @@
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_modDATA
+
+CLEANFILES = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+	$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"

pre-inst-env.in

@@ -0,0 +1,13 @@
+#!/bin/sh
+
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
+
+GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
+GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
+export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
+
+PATH="$abs_top_builddir:$PATH"
+export PATH
+
+exec "$@"