Merge pull request #10 from 40ants/support-tables

Added support for basic tables syntax

.github/workflows/ci.yml

@@ -54,7 +54,7 @@
         },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "commondoc-markdown"
           },

.github/workflows/docs.yml

@@ -49,7 +49,7 @@
         },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "commondoc-markdown-docs"
           },

.github/workflows/linter.yml

@@ -44,7 +44,7 @@
         },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "commondoc-markdown"
           },
@@ -67,7 +67,7 @@
         },
         {
           "name": "Run Linter",
-          "run": "qlot exec 40ants-linter --system \"commondoc-markdown\"",
+          "run": "qlot exec 40ants-linter --system \"commondoc-markdown\" --imports",
           "shell": "bash"
         }
       ]

.github/workflows/release.yml

@@ -0,0 +1,39 @@
+{
+  "name": "RELEASE",
+  "on": {
+    "push": {
+      "branches": [
+        "master"
+      ]
+    }
+  },
+  "jobs": {
+    "autotag": {
+      "permissions": {
+        "contents": "write"
+      },
+      "runs-on": "ubuntu-latest",
+      "env": {
+        "OS": "ubuntu-latest"
+      },
+      "steps": [
+        {
+          "name": "Checkout Code",
+          "uses": "actions/checkout@v3"
+        },
+        {
+          "name": "Create release tag",
+          "uses": "butlerlogic/action-autotag@8bc1ad456dcdee34e8c6ffbce991cc31793578c2",
+          "with": {
+            "root": "ChangeLog.md",
+            "regex_pattern": "^## (?<version>\\d+\\.\\d+\\.\\d+.*?)( |\\n).*$",
+            "tag_prefix": "v"
+          },
+          "env": {
+            "GITHUB_TOKEN": "${{ secrets.GITHUB_TOKEN }}"
+          }
+        }
+      ]
+    }
+  }
+}

.gitignore

@@ -1,2 +1,3 @@
 /.qlot/
 /docs/build/
+*.fasl

commondoc-markdown.asd

@@ -16,5 +16,7 @@
 
 
 (asdf:register-system-packages "common-html" '("COMMON-HTML.EMITTER"))
-(asdf:register-system-packages "common-doc" '("COMMON-DOC.OPS"))
+(asdf:register-system-packages "common-doc" '("COMMON-DOC.OPS" "COMMON-DOC.FORMAT"))
 (asdf:register-system-packages "3bmd-ext-code-blocks" '("3BMD-CODE-BLOCKS"))
+(asdf:register-system-packages "3bmd-ext-tables" '("3BMD-TABLES"))
+(asdf:register-system-packages "3bmd" '("3BMD-GRAMMAR"))

docs/changelog.lisp

@@ -13,6 +13,8 @@
 
 (defchangelog (:ignore-words ("HASH-LINK"
                               "COMMON-DOC:STRIKETHROUGH"))
+  (0.5.0 2024-01-27
+         "* Added support for basic tables syntax. Table headers aren't supported yet, because common-doc system does not support them :(")
   (0.4.0 2023-10-30
          "* Fixed work with latest 3bmd Markdown parser.
           * Fixed the way how bullet lists are rendered into Markdown. Now there is no blank lines between list items.")

qlfile.lock

@@ -1,8 +1,8 @@
 ("quicklisp" .
  (:class qlot/source/dist:source-dist
   :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
-  :version "2023-02-15"))
+  :version "2023-10-21"))
 ("ultralisp" .
  (:class qlot/source/dist:source-dist
   :initargs (:distribution "http://dist.ultralisp.org" :%version :latest)
-  :version "20230503192000"))
+  :version "20240127105500"))

src/addons.lisp

@@ -1,6 +1,6 @@
 (uiop:define-package #:commondoc-markdown/addons
   (:use #:cl)
-  (:import-from #:3bmd)
+  (:import-from #:3bmd-grammar)
   (:import-from #:esrap
                 #:defrule
                 #:!))

src/ci.lisp

@@ -4,14 +4,21 @@
                 #:defworkflow)
   (:import-from #:40ants-ci/jobs/linter)
   (:import-from #:40ants-ci/jobs/run-tests)
-  (:import-from #:40ants-ci/jobs/docs))
+  (:import-from #:40ants-ci/jobs/docs)
+  (:import-from #:40ants-ci/jobs/autotag
+                #:autotag))
 (in-package #:commondoc-markdown/ci)
 
 
+(defworkflow release
+  :on-push-to "master"
+  :jobs ((autotag)))
+
 (defworkflow linter
   :on-pull-request t
   :cache t
-  :jobs ((40ants-ci/jobs/linter:linter)))
+  :jobs ((40ants-ci/jobs/linter:linter
+          :check-imports t)))
 
 (defworkflow ci
   :on-push-to "master"

src/core.lisp

@@ -3,10 +3,15 @@
   (:nicknames #:commondoc-markdown/core)
   (:import-from #:commondoc-markdown/addons)
   (:import-from #:3bmd)
+  (:import-from #:3bmd-grammar)
   (:import-from #:3bmd-code-blocks)
+  (:import-from #:3bmd-tables)
   (:import-from #:common-doc
                 #:get-meta
                 #:make-meta)
+  (:import-from #:common-doc.format)
+  (:import-from #:common-doc.ops)
+  (:import-from #:plump)
   (:import-from #:commondoc-markdown/format
                 #:markdown)
   (:import-from #:commondoc-markdown/raw-html
@@ -19,7 +24,7 @@
    #:make-markdown-link
    #:markdown-link
    #:markdown-link-definition))
-(in-package commondoc-markdown)
+(in-package #:commondoc-markdown)
 
 
 (common-doc:define-node markdown-link (common-doc:link)
@@ -211,6 +216,34 @@
                      (code (getf content :content)))
                 (common-doc:make-code-block lang
                                             (common-doc:make-text code))))
+             ;; Start tables support
+             (3bmd::table
+              (common-doc:make-table
+               (go-deeper
+                 (append (loop for row in (getf content :head)
+                               collect (common-doc:make-row
+                                        (mapcar #'create-node
+                                                row
+                                                ;; (remove-if #'null row)
+                                                )))
+                         (loop for row in (getf content :body)
+                               collect (common-doc:make-row
+                                        (mapcar #'create-node
+                                                row
+                                                ;; (remove-if #'null row)
+                                                )))))))
+             (3bmd-grammar::th
+              (common-doc:make-cell
+               (mapcar #'create-node
+                       (remove-if #'null content))))
+             (3bmd-grammar::td
+              (common-doc:make-cell
+               (mapcar #'create-node
+                       (remove-if #'null content))))
+
+             (:horizontal-rule
+              (make-raw-inline-html "<hr/>"))
+             ;; End tables support
              (:bullet-list
               (common-doc:make-unordered-list
                (go-deeper
@@ -313,6 +346,7 @@
 (defun parse-markdown (string)
   "This is just a helper to reuse in tests"
   (let ((3bmd-code-blocks:*code-blocks* t)
+        (3bmd-tables:*tables* t)
         (commondoc-markdown/addons::*strikethrough* t))
     (3bmd-grammar:parse-doc string)))
 

src/emitter.lisp

@@ -6,6 +6,7 @@
   (:import-from #:alexandria
                 #:hash-table-alist)
   (:import-from #:common-html.emitter)
+  (:import-from #:common-doc.format)
   (:import-from #:str)
   (:import-from #:ironclad)
   (:import-from #:babel)
@@ -345,3 +346,49 @@
           do (format stream "> ~A~%"
                      line))
     (format stream "~%")))
+
+
+(defmethod common-doc.format:emit-document ((format markdown)
+                                            (node common-doc:cell)
+                                            stream)
+
+  (let ((content (common-doc:children node)))
+    (flet ((emit-only-children (node)
+             (loop for child in (common-doc:children node)
+                   do (common-doc.format:emit-document format child stream))))
+
+      (loop for item in content
+            do (typecase item
+                 (common-doc:paragraph
+                  ;; When rendering a cell content, we need to avoid
+                  ;; paragraphs rendering, because they will insert newlines
+                  ;; and break our Markdown markup :(
+                  (emit-only-children item))
+                 (t
+                  (common-doc.format:emit-document format item stream)))))))
+
+
+(defmethod common-doc.format:emit-document ((format markdown)
+                                            (node common-doc:table)
+                                            stream)
+  (let* ((rows (common-doc:rows node))
+         (header (first rows))
+         (content (rest rows)))
+    (flet ((write-row (row)
+             (loop for cell in (common-doc:cells row)
+                   do (format stream "| ")
+                      (common-doc.format:emit-document format cell stream)
+                      (format stream " "))
+             (format stream "|~%")))
+
+      (when header
+        (write-row header)
+        (format stream "| ~{~A~^ | ~} |~%"
+                (loop repeat (length (common-doc:cells header))
+                      collect "---")))
+
+      (when content
+        (loop for row in content
+              do (write-row row)))))
+
+  (format stream "~%"))

src/format.lisp

@@ -1,8 +1,8 @@
 (defpackage #:commondoc-markdown/format
   (:use #:cl)
-  (:export
-   #:markdown))
-(in-package commondoc-markdown/format)
+  (:import-from #:common-doc.format)
+  (:export #:markdown))
+(in-package #:commondoc-markdown/format)
 
 
 (defclass markdown (common-doc.format:document-format)

src/raw-html.lisp

@@ -1,6 +1,7 @@
 (uiop:define-package #:commondoc-markdown/raw-html
   (:use #:cl)
   (:import-from #:common-doc)
+  (:import-from #:common-doc.format)
   (:import-from #:commondoc-markdown/format
                 #:markdown)
   (:import-from #:common-html.emitter)
@@ -11,7 +12,7 @@
    #:make-raw-html-block
    #:html
    #:make-raw-inline-html))
-(in-package commondoc-markdown/raw-html)
+(in-package #:commondoc-markdown/raw-html)
 
 
 (defclass raw-html (common-doc:document-node)

t/core.lisp

@@ -5,6 +5,7 @@
                 #:testing
                 #:deftest)
   (:import-from #:common-doc
+                #:make-unordered-list
                 #:make-web-link
                 #:make-code-block
                 #:make-code
@@ -20,7 +21,7 @@
                 #:make-markdown-link)
   (:import-from #:common-doc.ops
                 #:collect-all-text))
-(in-package commondoc-markdown-test/core)
+(in-package #:commondoc-markdown-test/core)
 
 
 (defun p (text)
@@ -206,7 +207,8 @@ World"))
     (compare (p "A text with [a link][].")
              (make-paragraph (list
                               (make-text "A text with ")
-                              (make-markdown-link (make-text "a link"))
+                              (make-markdown-link (make-text "a link")
+                                                  :definition "")
                               (make-text ".")))))
 
   (testing "Link with not defined definition"