v0.15.0: Critical input/rendering fixes, subagent-reviewed #7

Merged
amr merged 36 commits from feature/v0.11.0-slots into main 2026-05-11 22:03:18 -04:00
5 changed files with 1461 additions and 5 deletions
Showing only changes of commit 9648c72b85 - Show all commits

View File

@@ -2,7 +2,7 @@
(asdf:defsystem :cl-tui
:description "Reusable Common Lisp Terminal UI Framework"
:author "Amr Gharbeia"
:version "0.7.0"
:version "0.8.0"
:license "TBD"
:depends-on (:fiveam :sb-posix)
:components
@@ -35,7 +35,10 @@
(:file "tabbar" :depends-on ("container-package" "dirty" "box"))
;; Select widget (v0.7.0)
(:file "select-package" :depends-on ("package" "input-package"))
(:file "select" :depends-on ("select-package" "dirty" "box"))))
(:file "select" :depends-on ("select-package" "dirty" "box"))
;; Markdown + Code + Diff rendering (v0.8.0)
(:file "markdown-package" :depends-on ("package"))
(:file "markdown" :depends-on ("markdown-package"))))
:in-order-to ((test-op (test-op :cl-tui-tests))))
(asdf:defsystem :cl-tui-tests
@@ -56,13 +59,15 @@
(:file "theme-tests")
(:file "input-tests")
(:file "scrollbox-tabbar-tests" :pathname "../../tests/scrollbox-tabbar-tests.lisp")
(:file "select-tests" :pathname "../../tests/select-tests.lisp"))))
(:file "select-tests" :pathname "../../tests/select-tests.lisp")
(:file "markdown-tests" :pathname "../../tests/markdown-tests.lisp"))))
:perform (test-op (o c)
(dolist (suite '((:cl-tui-backend-test "BACKEND-SUITE")
(dolist (suite '((:cl-tui-backend-test "BACKEND-SUITE")
(:cl-tui-box-test "BOX-SUITE")
(:cl-tui-input-test "INPUT-SUITE")
(:cl-tui-scrollbox-test "SCROLLBOX-SUITE")
(:cl-tui-select-test "SELECT-SUITE")))
(:cl-tui-select-test "SELECT-SUITE")
(:cl-tui-markdown-test "MARKDOWN-SUITE")))
(let* ((pkg (find-package (first suite)))
(s (and pkg (find-symbol (second suite) pkg))))
(when s

500
org/markdown-renderer.org Normal file
View File

@@ -0,0 +1,500 @@
#+TITLE: Markdown + Code + Diff Rendering (v0.8.0)
#+DATE: 2026-05-11
#+AUTHOR: Amr Gharbeia / Hermes
* Overview
This module provides rendering of Markdown text, syntax-highlighted code
blocks, and unified diffs in the terminal. It completes the rendering
pipeline so that [[file:render.org][the render tree]] can handle rich formatted
content.
The Markdown renderer is /not/ a general-purpose MD-to-HTML converter.
It targets TUI output: node types that have clear terminal analogues
(headings → bold/bright, code blocks → monochrome block, bold → ANSI
bold, etc.). Edge cases that matter for a terminal (long lines, escape
sequences inside code, mixed formatting) are handled explicitly.
** Design decisions
1. /Two-phase parse/: block-level first (lines), then inline (characters
within each block). This matches how terminals render — block layout
first, style within.
2. /Syntax highlighting by keyword set/: not a full lexer. A lookup
table of language → (keywords, types, builtins) sets. Catches ~90%
of highlighting cases without pulling in a parser. Fails safe
(unmatched tokens render as plain text).
3. /Diff lines are self-describing/: a diff block starts with ─── or
+++, each line has a ± prefix. We don't re-parse patch semantics;
we just color by prefix. This makes the renderer tolerant of
malformed diffs.
4. /No recursive descent parser/: a simple state machine over lines for
block-level, and a character cursor for inline. Keeps the code
short and avoids parser-generator dependencies.
* Code structure
** Node types
We represent the parsed document as a tree of plists. Each node has at
least a `:type` key. Block-level nodes carry a `:children` list of
inline nodes. This keeps the data structure simple — no class hierarchy,
no generic dispatch — while being easy to traverse for rendering.
Node types:
| Block-level | Inline |
|------------------+--------------------|
| `:heading` | `:text` |
| `:paragraph` | `:bold` |
| `:code-block` | `:italic` |
| `:blockquote` | `:inline-code` |
| `:list-item` | `:link` |
| `:ordered-item` | |
| `:thematic-break`| |
| `:diff-block` | |
--- per-function: markdown-node-make
~make-md-node~ is a convenience constructor for node plists.
It ensures `:children` defaults to NIL (not an empty list) so
renderers can check `(if children ...)` without testing `(when
children ...)` vs `(if (null children) ...)`.
#+BEGIN_SRC lisp :tangle no
(defun make-md-node (type &key children properties)
"Create a markdown node plist.
TYPE is a keyword like :heading or :bold.
CHILDREN is a list of inline node plists (or NIL).
PROPERTIES is a plist of node-specific extra keys (e.g. :level for headings)."
(let ((node (list :type type)))
(when children
(setf (getf node :children) children))
(when properties
(setf (getf node :properties) properties))
node))
#+END_SRC
--- per-function: markdown-node-p
~md-node-p~ checks whether something is a markdown node plist.
We just look for a :type key. This is used in tests and as
a guard in recursive renderers.
#+BEGIN_SRC lisp :tangle no
(defun md-node-p (thing)
"Return T if THING is a markdown node (has a :type key)."
(and (listp thing) (getf thing :type)))
#+END_SRC
--- per-function: markdown-node-text
~md-node-text~ extracts the plain text from a node tree by
concatenating all :text children recursively, discarding markup.
This is useful for things like heading anchors, tooltip strings,
or search indexing.
#+BEGIN_SRC lisp :tangle no
(defun md-node-text (node)
"Recursively extract plain text from a markdown node tree."
(let ((type (getf node :type)))
(cond ((eql type :text)
(or (getf node :content) ""))
((eql type :link)
(concatenate 'string
(md-node-text (first (getf node :children)))
(format nil " (~a)" (or (getf node :url) ""))))
((getf node :children)
(apply #'concatenate 'string
(mapcar #'md-node-text (getf node :children))))
(t ""))))
#+END_SRC
** Block-level parser
The block parser operates line-by-line with a simple state machine.
Each line is classified by its prefix characters, then accumulated
into a node.
Rules:
- Lines starting with `#` → heading (count hashes for level)
- Lines starting with `>` → blockquote (continuation lines merge)
- Lines starting with `-`, `*`, or `+` → list-item
- Lines starting with 1-3 digits followed by `.` → ordered-item
- Lines starting with `` ``` `` → code-block (language on opening line)
- Lines starting with `---` or `***` → thematic-break
- Lines starting with `--- ` or `+++ ` → diff-block
- Empty lines → paragraph boundary
- Everything else → paragraph (continuation lines merge until blank)
--- per-function: classify-line
~classify-line~ returns a keyword and a data value for a trimmed
line of text. The state machine uses this to decide what kind of
block to create or continue.
The function must handle prefix stripping (e.g. remove `# ` after
counting hashes) and edge cases like `#` inside a code block (which
we don't classify at all — the code block state machine handles that).
One trap: a line like `#not-a-heading` (no space after hash) is NOT
a heading in CommonMark. We check for space/tab after the hashes.
Another trap: `* item` in a list vs `**bold**` inline. At the
block-parser level we only look at /line-start/ `* ` (star + space)
for list items. A line starting with `** text` could be either a
nested list item or bold text in a paragraph — we conservatively
treat it as a list-item (the inline parser will handle ** inside
paragraphs normally).
#+BEGIN_SRC lisp :tangle no
(defun classify-line (line)
"Classify a trimmed LINE, returning (type . data).
TYPE is a keyword; DATA is language for code-blocks, level for headings, etc."
(cond
;; Empty line
((string= line "") (cons :blank nil))
;; Thematic break: --- or *** (3+ chars, all same, optional whitespace)
((and (>= (length line) 3)
(every (lambda (c) (or (char= c (char line 0))
(char= c #\Space)
(char= c #\Tab)))
line)
(find (char line 0) "-*"))
(cons :thematic-break nil))
;; Heading: #+, with space after hashes
((and (char= (char line 0) #\#)
(let ((count 0))
(loop for c across line
while (char= c #\#)
do (incf count))
(and (<= 1 count 6)
(or (>= (length line) (1+ count))
(member (char line count) '(#\Space #\Tab))))))
(let* ((hash-count (loop for c across line while (char= c #\#) count c))
(content (string-trim (list #\Space #\Tab)
(subseq line hash-count))))
(cons :heading (cons hash-count content))))
;; Blockquote: >
((and (>= (length line) 1) (char= (char line 0) #\>))
(let ((content (string-trim (list #\Space #\Tab)
(subseq line 1))))
(cons :blockquote content)))
;; Unordered list: -, *, +
((and (>= (length line) 2)
(find (char line 0) "-*+")
(char= (char line 1) #\Space))
(cons :list-item (string-trim (list #\Space #\Tab) (subseq line 2))))
;; Ordered list: N. or N)
((and (>= (length line) 3)
(digit-char-p (char line 0))
(loop for c across line
while (digit-char-p c)
finally (return (find c '(#\. #\) #\Space)))))
(let ((dot-pos (position-if (lambda (c) (find c ". )")) line)))
(if (and dot-pos (find (char line dot-pos) ". )"))
(cons :ordered-item (string-trim (list #\Space #\Tab)
(subseq line (1+ dot-pos))))
(cons :paragraph line))))
;; Diff: --- file or +++ file
((and (>= (length line) 4)
(find (char line 0) "-+")
(char= (char line 1) (char line 0))
(char= (char line 2) (char line 0))
(char= (char line 3) #\Space))
(cons :diff-header line))
;; Diff: line content with +/- prefix
((and (>= (length line) 1)
(find (char line 0) "-+")
(not (and (>= (length line) 3)
(char= (char line 1) (char line 0))
(char= (char line 2) (char line 0)))))
(cons :diff-line (cons (char line 0) (subseq line 1))))
;; Fenced code block start: ``` or ~~~
((and (>= (length line) 3)
(find (char line 0) "`~")
(every (lambda (c) (char= c (char line 0)))
(subseq line 0 (min 6 (length line))))
(let ((rest (string-trim (list #\Space #\Tab) (subseq line (min 6 (length line))))))
(cons :code-start rest))))
;; Default: paragraph content
(t (cons :paragraph line))))
#+END_SRC
--- per-function: parse-blocks
~parse-blocks~ is the main block-level parser. It takes a string
(possibly multi-line) and returns a list of markdown node plists.
The algorithm:
1. Split into lines
2. Classify each line
3. Accumulate lines of the same type into groups
4. Convert each group into a node
State transitions:
- `:paragraph` accumulates until blank line or different block type
- `:blockquote` accumulates until blank line
- `:list-item` and `:ordered-item` accumulate until blank line
- `:code-start` flips to code-block mode; accumulates until matching
fence closer or end of input
- `:diff-header` starts a diff block; diff lines accumulate until
blank line or non-diff line
Edge case: a paragraph followed by a list item should stay as
separate blocks (not merge). The blank-line check handles this
because the paragraph only continues for non-blank, non-list lines.
#+BEGIN_SRC lisp :tangle no
(defun parse-blocks (text)
"Parse TEXT (a string) into a list of block-level markdown node plists.
Returns (nodes . unconsumed-lines) for recursive callers."
(let ((lines (split-string-into-lines text))
(nodes nil)
(i 0))
(loop while (< i (length lines))
do (let* ((line (string-trim (list #\return) (aref lines i)))
(classification (classify-line line)))
(case (car classification)
(:blank (incf i))
(:thematic-break
(push (make-md-node :thematic-break) nodes)
(incf i))
(:paragraph
(multiple-value-bind (node consumed)
(parse-paragraph lines i)
(push node nodes)
(setf i consumed)))
(:heading
(let* ((level-and-content (cdr classification))
(level (car level-and-content))
(content (cdr level-and-content)))
(push (make-md-node :heading
:properties (list :level level)
:children (parse-inline content))
nodes)
(incf i)))
(:blockquote
(multiple-value-bind (node consumed)
(parse-blockquote lines i)
(push node nodes)
(setf i consumed)))
(:list-item
(multiple-value-bind (node consumed)
(parse-list lines i :unordered)
(push node nodes)
(setf i consumed)))
(:ordered-item
(multiple-value-bind (node consumed)
(parse-list lines i :ordered)
(push node nodes)
(setf i consumed)))
(:code-start
(multiple-value-bind (node consumed)
(parse-code-block lines i (cdr classification))
(push node nodes)
(setf i consumed)))
(:diff-header
(multiple-value-bind (node consumed)
(parse-diff-block lines i)
(push node nodes)
(setf i consumed)))
(t (incf i)))))
;; Return in reading order
(nreverse nodes)))
#+END_SRC
--- per-function: split-string-into-lines
~split-string-into-lines~ is a utility rather than relying on
~cl-ppcre~ (which we don't depend on). It splits on #\Newline
and handles the edge case of trailing newlines (doesn't produce
an extra empty line at the end).
#+BEGIN_SRC lisp :tangle no
(defun split-string-into-lines (string)
"Split STRING into a vector of lines (no trailing newline).
Handles \\n, \\r\\n, and trailing newlines properly."
(let ((result nil)
(start 0))
(flet ((add-line (end)
(push (subseq string start end) result)))
(loop for i from 0 below (length string)
do (let ((c (char string i)))
(cond ((char= c #\Newline)
(add-line i)
(setf start (1+ i)))
((and (char= c #\Return)
(< (1+ i) (length string))
(char= (char string (1+ i)) #\Newline))
(add-line i)
(setf start (+ i 2))
(incf i)))))
(when (< start (length string))
(add-line (length string)))
(coerce (nreverse result) 'vector))))
#+END_SRC
--- per-function: parse-paragraph
~parse-paragraph~ collects one or more contiguous paragraph lines
until a blank line or a different block type. It joins them with
spaces (for hard-wrapped prose) and returns a :paragraph node
with inline-parsed children.
Continuation lines in paragraphs are joined with a single space
(not a newline). This is correct for Markdown's soft-wrap
convention where a newline in source = space in output. To force
a hard break, CommonMark uses two trailing spaces — we skip that
for now since it's rare in TUI contexts.
#+BEGIN_SRC lisp :tangle no
(defun parse-paragraph (lines start)
"Parse contiguous paragraph lines from LINES starting at START.
Returns (node . consumed-index)."
(let ((text-parts nil)
(i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
((:paragraph)
(push (cdr class) text-parts)
(incf i))
(:blank (incf i) (loop-finish))
(t (loop-finish)))))
(let ((text (with-output-to-string (s)
(loop for part in (nreverse text-parts)
for first = t then nil
do (unless first (write-char #\Space s))
(princ part s)))))
(cons (make-md-node :paragraph
:children (parse-inline text))
i))))
#+END_SRC
--- per-function: parse-blockquote
~parse-blockquote~ collects contiguous `>` lines, strips the `>`
prefix, joins them, and wraps in a :blockquote node. Nested
blockquotes (`> >`) are not supported in this version — a `>` at
the start of the content is treated as literal text.
#+BEGIN_SRC lisp :tangle no
(defun parse-blockquote (lines start)
"Parse contiguous blockquote lines from LINES starting at START.
Returns (node . consumed-index)."
(let ((text-parts nil)
(i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
(:blockquote
(push (cdr class) text-parts)
(incf i))
(:blank (incf i) (loop-finish))
(t (loop-finish)))))
(let ((text (with-output-to-string (s)
(loop for part in (nreverse text-parts)
for first = t then nil
do (unless first (write-char #\Space s))
(princ part s)))))
(cons (make-md-node :blockquote
:children (parse-inline text))
i))))
#+END_SRC
--- per-function: parse-list
~parse-list~ collects contiguous list items (same type) and returns
a list of nodes. Each line starting with a list marker becomes one
list-item node. Nested lists are not supported (lines starting with
two spaces + marker would be the next level — we skip that for v1).
The TYPE parameter is either `:unordered` or `:ordered` — though
we return each item labeled by its actual marker type since we
already classified each line.
#+BEGIN_SRC lisp :tangle no
(defun parse-list (lines start type)
"Parse contiguous list items from LINES starting at START.
TYPE is :unordered or :ordered.
Returns (node . consumed-index) where node is a :list-item or :ordered-item."
(declare (ignore type))
(let ((items nil)
(i start))
;; Collect all contiguous list items into ITEMS
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
((:list-item :ordered-item)
(push (cons (car class) (cdr class)) items)
(incf i))
(:blank
;; One blank line between items is OK; two ends the list
(if (and (< (1+ i) (length lines))
(let ((next-class (classify-line
(string-trim
(list #\return)
(aref lines (1+ i))))))
(member (car next-class)
'(:list-item :ordered-item))))
(progn
(push (cons :blank-sep nil) items)
(incf i))
(progn (incf i) (loop-finish))))
(t (loop-finish)))))
;; Convert each item to a node
(let ((nodes nil))
(dolist (item (nreverse items))
(let ((type (car item))
(content (cdr item)))
(when (and content (not (string= content "")))
(push (make-md-node type
:children (parse-inline content))
nodes))))
(cons (nreverse nodes) i))))
#+END_SRC
--- per-function: parse-code-block
~parse-code-block~ reads from the line after the opening fence to
the closing fence (or end of input). It returns a :code-block node
with the language (or NIL) and the raw text as the :content. No
inline parsing is done inside code blocks — everything is literal.
Matching fence: if opened with `` ``` ``, close with `` ``` ``.
If opened with `~~~`, close with `~~~`. The closing fence must have
at least as many backticks/tildes as the opening fence (CommonMark
rule). We use the simpler version: same character, same count.
#+BEGIN_SRC lisp :tangle no
(defun parse-code-block (lines start lang)
"Parse a fenced code block from LINES starting at START.
LANG is the language string (or empty string) from the opening fence.
Returns (node . consumed-index)."
(let ((code-lines nil)
(i (1+ start))
(fence-char (char (aref lines start) 0))
(fence-len (loop for c across (aref lines start)
while (char= c (char (aref lines start) 0))
count c))
(found-close nil))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line)))
;; Check for closing fence
(when (and (>= (length line) fence-len)
(every (lambda (c) (char= c fence-char))
(subseq line 0 fence-len))
(or (= (length line) fence-len)
(every (lambda (c) (find c " \t"))
(subseq line fence-len))))
(setf found-close t)
(incf i)
(loop-finish))

View File

@@ -0,0 +1,65 @@
;;; markdown-package.lisp — Package definition for cl-tui.markdown
(defpackage :cl-tui.markdown
(:use :cl :fiveam)
(:export
;; Data structures
#:make-md-node
#:md-node-p
#:md-node-text
;; Parsing
#:parse-blocks
#:parse-inline
;; Highlighting
#:*syntax-highlighters*
#:highlight-code
;; Diff
#:classify-diff-line
;; Rendering
#:render-md
#:render-md-node
#:render-markdown
#:render-inline
;; Styles
#:apply-style
#:apply-styles
;; Tests (exported test symbols for ASDF integration)
#:heading-parsing
#:heading-levels
#:heading-with-inline-formatting
#:paragraph-parsing
#:paragraph-multi-line
#:bold-parsing
#:italic-parsing
#:bold-italic-combined
#:inline-code-parsing
#:link-parsing
#:code-block-parsing
#:code-block-unknown-language
#:blockquote-parsing
#:list-item-parsing
#:ordered-list-parsing
#:thematic-break-parsing
#:highlight-lisp-keyword
#:highlight-lisp-builtin
#:highlight-unknown-language
#:highlight-comment
#:classify-diff-added
#:classify-diff-removed
#:classify-diff-hunk
#:classify-diff-context
#:render-heading-output
#:render-paragraph-output
#:render-thematic-break-output
#:render-code-block-output
#:render-diff-block-output
#:markdown-integration
#:render-markdown-string
;; Internal (for testability)
#:classify-line
#:split-string-into-lines
#:find-closing-marker
#:string-prefix-p
#:tokenize-line
#:apply-highlight-token
#:apply-highlight-style))

View File

@@ -0,0 +1,681 @@
;;; markdown.lisp — Markdown + Code + Diff rendering for cl-tui
(in-package :cl-tui.markdown)
;; ─── Node constructors ────────────────────────────────────────────────────────
(defun make-md-node (type &key children properties content url)
(let ((node (list :type type)))
(when children (setf (getf node :children) children))
(when properties (setf (getf node :properties) properties))
(when content (setf (getf node :content) content))
(when url (setf (getf node :url) url))
node))
(defun md-node-p (thing)
(and (listp thing) (getf thing :type)))
(defun md-node-text (node)
(let ((type (getf node :type)))
(cond ((eql type :text) (or (getf node :content) ""))
((eql type :link)
(concatenate 'string
(md-node-text (first (getf node :children)))
(format nil " (~a)" (or (getf node :url) ""))))
((eql type :inline-code) (or (getf node :content) ""))
((getf node :children)
(apply #'concatenate 'string
(mapcar #'md-node-text (getf node :children))))
(t ""))))
;; ─── Block-level parser ───────────────────────────────────────────────────────
(defun split-string-into-lines (string)
(let ((result nil) (start 0))
(flet ((add-line (end) (push (subseq string start end) result)))
(loop for i from 0 below (length string)
do (let ((c (char string i)))
(cond ((char= c #\Newline) (add-line i) (setf start (1+ i)))
((and (char= c #\Return) (< (1+ i) (length string))
(char= (char string (1+ i)) #\Newline))
(add-line i) (setf start (+ i 2)) (incf i)))))
(when (< start (length string)) (add-line (length string)))
(coerce (nreverse result) 'vector))))
(defun classify-line (line)
(cond
((string= line "") (cons :blank nil))
((and (>= (length line) 3)
(let ((c0 (char line 0)))
(and (find c0 "-*")
(every (lambda (c) (or (char= c c0) (char= c #\Space) (char= c #\Tab)))
line))))
(cons :thematic-break nil))
((and (char= (char line 0) #\#)
(let ((count 0))
(loop for c across line while (char= c #\#) do (incf count))
(and (<= 1 count 6)
(or (>= (length line) (1+ count))
(member (char line count) '(#\Space #\Tab))))))
(let* ((hash-count (loop for c across line while (char= c #\#) count c))
(content (string-trim (list #\Space #\Tab) (subseq line hash-count))))
(cons :heading (cons hash-count content))))
((char= (char line 0) #\>)
(cons :blockquote (string-trim (list #\Space #\Tab) (subseq line 1))))
((and (>= (length line) 2) (find (char line 0) "-*+")
(char= (char line 1) #\Space))
(cons :list-item (string-trim (list #\Space #\Tab) (subseq line 2))))
((and (>= (length line) 3) (digit-char-p (char line 0))
(loop for c across line while (digit-char-p c)
finally (return (find c ". )"))))
(let ((dot-pos (position-if (lambda (c) (find c ". )")) line)))
(if (and dot-pos (find (char line dot-pos) ". )"))
(cons :ordered-item (string-trim (list #\Space #\Tab)
(subseq line (1+ dot-pos))))
(cons :paragraph line))))
((and (>= (length line) 4) (find (char line 0) "-+")
(char= (char line 1) (char line 0))
(char= (char line 2) (char line 0))
(char= (char line 3) #\Space))
(cons :diff-header line))
((and (>= (length line) 1) (find (char line 0) "-+")
(not (and (>= (length line) 3)
(char= (char line 1) (char line 0))
(char= (char line 2) (char line 0)))))
(cons :diff-line (cons (char line 0) (subseq line 1))))
((and (>= (length line) 3) (find (char line 0) "`~")
(let ((fence-len (loop for c across line
while (char= c (char line 0)) count c)))
(and (>= fence-len 3)
(let ((rest (string-trim (list #\Space #\Tab)
(subseq line fence-len))))
(cons :code-start rest))))))
(t (cons :paragraph line))))
(defun find-closing-marker (text start marker)
(let ((marker-len (length marker)) (len (length text)))
(loop for j from start to (- len marker-len)
do (when (and (char= (char text j) (char marker 0))
(string= marker (subseq text j (+ j marker-len)))
(or (= j 0) (not (char= (char text (1- j)) #\\))))
(return j))
finally (return nil))))
(defun parse-paragraph (lines start)
(let ((text-parts nil) (i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
((:paragraph) (push (cdr class) text-parts) (incf i))
(:blank (incf i) (loop-finish))
(t (loop-finish)))))
(values (make-md-node :paragraph :children
(parse-inline
(with-output-to-string (s)
(loop for part in (nreverse text-parts)
for first = t then nil
do (unless first (write-char #\Space s))
(princ part s)))))
i)))
(defun parse-blockquote (lines start)
(let ((text-parts nil) (i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
(:blockquote (push (cdr class) text-parts) (incf i))
(:blank (incf i) (loop-finish))
(t (loop-finish)))))
(values (make-md-node :blockquote :children
(parse-inline
(with-output-to-string (s)
(loop for part in (nreverse text-parts)
for first = t then nil
do (unless first (write-char #\Space s))
(princ part s)))))
i)))
(defun parse-list (lines start)
(declare (ignore start))
(let ((items nil) (i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
((:list-item :ordered-item)
(push (cons (car class) (cdr class)) items) (incf i))
(:blank
(if (and (< (1+ i) (length lines))
(let ((nc (classify-line
(string-trim (list #\return)
(aref lines (1+ i))))))
(member (car nc) '(:list-item :ordered-item))))
(progn (push (cons :blank-sep nil) items) (incf i))
(progn (incf i) (loop-finish))))
(t (loop-finish)))))
(let ((nodes nil))
(dolist (item (nreverse items))
(let ((type (car item)) (content (cdr item)))
(when (and content (not (string= content "")))
(push (make-md-node type :children (parse-inline content)) nodes))))
(values (nreverse nodes) i))))
(defun parse-code-block (lines start lang)
(let ((code-lines nil)
(i (1+ start))
(fence-char (char (aref lines start) 0))
(fence-len (loop for c across (aref lines start)
while (char= c (char (aref lines start) 0)) count c)))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line)))
(when (and (>= (length line) fence-len)
(every (lambda (c) (char= c fence-char))
(subseq line 0 fence-len))
(or (= (length line) fence-len)
(every (lambda (c) (find c " \t"))
(subseq line fence-len))))
(incf i) (loop-finish))
(push line code-lines)
(incf i)))
(values (make-md-node :code-block
:properties (list :language (and lang (not (string= lang "")) lang))
:content
(with-output-to-string (s)
(loop for cl in (nreverse code-lines)
for first = t then nil
do (unless first (terpri s)) (princ cl s))))
i)))
(defun parse-diff-block (lines start)
(let ((diff-lines nil) (i start))
(loop while (< i (length lines))
do (let* ((raw-line (aref lines i))
(line (string-trim (list #\return) raw-line))
(class (classify-line line)))
(case (car class)
((:diff-header :diff-line) (push line diff-lines) (incf i))
(:blank (incf i) (loop-finish))
(t (loop-finish)))))
(let ((lines-list (nreverse diff-lines)))
(values (make-md-node :diff-block
:content
(with-output-to-string (s)
(loop for dl in lines-list
for first = t then nil
do (unless first (terpri s)) (princ dl s)))
:properties (list :lines lines-list))
i))))
(defun parse-blocks (text)
(let ((lines (split-string-into-lines text)) (nodes nil) (i 0))
(loop while (< i (length lines))
do (let* ((line (string-trim (list #\return) (aref lines i)))
(classification (classify-line line)))
(case (car classification)
(:blank (incf i))
(:thematic-break (push (make-md-node :thematic-break) nodes) (incf i))
(:paragraph
(multiple-value-bind (node consumed) (parse-paragraph lines i)
(push node nodes) (setf i consumed)))
(:heading
(let* ((level+content (cdr classification))
(level (car level+content))
(content (cdr level+content)))
(push (make-md-node :heading :properties (list :level level)
:children (parse-inline content)) nodes)
(incf i)))
(:blockquote
(multiple-value-bind (node consumed) (parse-blockquote lines i)
(push node nodes) (setf i consumed)))
(:list-item
(multiple-value-bind (node consumed) (parse-list lines i)
(dolist (n node) (push n nodes)) (setf i consumed)))
(:ordered-item
(multiple-value-bind (node consumed) (parse-list lines i)
(dolist (n node) (push n nodes)) (setf i consumed)))
(:code-start
(multiple-value-bind (node consumed)
(parse-code-block lines i (cdr classification))
(push node nodes) (setf i consumed)))
(:diff-header
(multiple-value-bind (node consumed) (parse-diff-block lines i)
(push node nodes) (setf i consumed)))
(t (incf i)))))
(nreverse nodes)))
;; ─── Inline parser ────────────────────────────────────────────────────────────
(defun parse-inline (text)
(unless (and text (> (length text) 0)) (return-from parse-inline nil))
(let ((nodes nil) (i 0) (len (length text)))
(loop while (< i len)
do (let ((c (char text i)))
(case c
(#\*
(multiple-value-bind (node consumed) (parse-star-emphasis text i len)
(if node (progn (push node nodes) (setf i consumed))
(progn (push (make-md-node :text :content (string c)) nodes) (incf i)))))
(#\_
(multiple-value-bind (node consumed) (parse-underscore-emphasis text i len)
(if node (progn (push node nodes) (setf i consumed))
(progn (push (make-md-node :text :content (string c)) nodes) (incf i)))))
(#\`
(multiple-value-bind (node consumed) (parse-inline-code text i len)
(if node (progn (push node nodes) (setf i consumed))
(progn (push (make-md-node :text :content (string c)) nodes) (incf i)))))
(#\[
(multiple-value-bind (node consumed) (parse-link text i len)
(if node (progn (push node nodes) (setf i consumed))
(progn (push (make-md-node :text :content (string c)) nodes) (incf i)))))
(t (let ((start i))
(incf i)
(loop while (< i len)
do (let ((nc (char text i)))
(if (find nc "*_`[") (loop-finish)
(progn
(when (and (< (1+ i) len)
(find nc "*_")
(char= nc (char text (1+ i))))
(loop-finish))
(incf i)))))
(push (make-md-node :text :content (subseq text start i)) nodes))))))
(nreverse nodes)))
(defun parse-star-emphasis (text i len)
(when (>= i len) (return-from parse-star-emphasis (values nil i)))
(if (and (< (1+ i) len) (char= (char text (1+ i)) #\*))
(let ((close (find-closing-marker text (+ i 2) "**")))
(if close
(values (make-md-node :bold :children (parse-inline (subseq text (+ i 2) close)))
(+ close 2))
(values nil i)))
(let ((close (find-closing-marker text (1+ i) "*")))
(if close
(values (make-md-node :italic :children (parse-inline (subseq text (1+ i) close)))
(1+ close))
(values nil i)))))
(defun parse-underscore-emphasis (text i len)
(when (>= i len) (return-from parse-underscore-emphasis (values nil i)))
(when (and (> i 0) (not (find (char text (1- i)) " \t\n\r")))
(return-from parse-underscore-emphasis (values nil i)))
(if (and (< (1+ i) len) (char= (char text (1+ i)) #\_))
(let ((close (find-closing-marker text (+ i 2) "__")))
(if close
(values (make-md-node :bold :children (parse-inline (subseq text (+ i 2) close)))
(+ close 2))
(values nil i)))
(let ((close (find-closing-marker text (1+ i) "_")))
(if (and close
(or (>= (1+ close) len)
(find (char text (1+ close)) " \t\n\r.,;:!?")))
(values (make-md-node :italic :children (parse-inline (subseq text (1+ i) close)))
(1+ close))
(values nil i)))))
(defun parse-inline-code (text i len)
(when (or (>= i len) (not (char= (char text i) #\`)))
(return-from parse-inline-code (values nil i)))
(let ((bt-count (loop for j from i below (min len (+ i 3))
while (char= (char text j) #\`) count j)))
(let ((close (find-closing-marker text (+ i bt-count)
(make-string bt-count :initial-element #\`))))
(if close
(values (make-md-node :inline-code
:content (subseq text (+ i bt-count) close))
(+ close bt-count))
(values nil i)))))
(defun parse-link (text i len)
(when (or (>= i len) (not (char= (char text i) #\[)))
(return-from parse-link (values nil i)))
(let ((close-bracket (find-closing-marker text (1+ i) "]")))
(unless close-bracket (return-from parse-link (values nil i)))
(when (or (>= (1+ close-bracket) len)
(not (char= (char text (1+ close-bracket)) #\()))
(return-from parse-link (values nil i)))
(let ((close-paren (find-closing-marker text (+ close-bracket 2) ")")))
(unless close-paren (return-from parse-link (values nil i)))
(values (make-md-node :link
:children (parse-inline (subseq text (1+ i) close-bracket))
:url (subseq text (+ close-bracket 2) close-paren))
(1+ close-paren)))))
;; ─── Syntax highlighting ──────────────────────────────────────────────────────
(defun get-highlighter (lang)
(cdr (assoc lang
'(("lisp" . (:comment (";" "#|" ";;") :string ("\"")
:keyword ("defun" "defmacro" "defmethod" "defgeneric"
"defvar" "defparameter" "defconstant" "defstruct"
"defclass" "deftype" "define-condition"
"let" "let*" "flet" "labels" "macrolet"
"if" "when" "unless" "cond" "case" "ecase" "typecase"
"loop" "do" "dolist" "dotimes" "tagbody" "go"
"block" "return" "return-from"
"progn" "prog1" "prog2"
"lambda" "function" "quote"
"setf" "setq" "push" "pop" "incf" "decf"
"in-package" "defpackage" "export" "import"
"handler-case" "handler-bind" "ignore-errors"
"multiple-value-bind" "multiple-value-call"
"destructuring-bind"
"declare" "the" "values"
"and" "or" "not" "null"
"car" "cdr" "first" "rest" "second"
"cons" "list" "append" "nconc"
"mapcar" "mapc" "reduce"
"find" "position" "count" "subseq"
"format" "princ" "print" "write" "read"
"load" "compile" "eval"
"make-instance" "slot-value"
"type-of" "class-of")
:builtin ("t" "nil"
"*standard-output*" "*standard-input*"
"*error-output*" "*debug-io*"
"*package*" "*print-circle*")))
("common-lisp" . (:comment (";" "#|" ";;") :string ("\"")
:keyword ("defun" "defmacro" "defmethod" "defgeneric"
"let" "if" "when" "unless" "cond" "case"
"loop" "do" "dolist" "dotimes"
"return" "return-from" "block"
"lambda" "function" "quote"
"setf" "setq" "push" "pop" "incf" "decf"
"handler-case" "handler-bind"
"declare" "the" "values"
"defpackage" "in-package" "export" "import"
"error" "warn" "assert"
"car" "cdr" "first" "rest"
"cons" "list" "append" "mapcar" "reduce"
"format" "princ" "print" "read" "load"
"make-instance")
:builtin ("t" "nil")))
("python" . (:comment ("#") :string ("\"" "'" "\"\"\"" "'''")
:keyword ("def" "class" "return" "yield" "import" "from"
"if" "elif" "else" "for" "while" "in" "not"
"try" "except" "finally" "raise" "with" "pass"
"break" "continue" "lambda" "global"
"assert" "del" "is"
"self" "cls" "async" "await")
:builtin ("None" "True" "False")))
("javascript" . (:comment ("//" "/*") :string ("\"" "'" "`")
:keyword ("function" "class" "const" "let" "var"
"if" "else" "for" "while" "do" "switch"
"return" "break" "continue"
"try" "catch" "finally" "throw"
"new" "this" "super" "delete" "typeof"
"import" "export" "from" "default"
"async" "await" "yield" "of")
:builtin ("true" "false" "null" "undefined" "NaN")))
("bash" . (:comment ("#") :string ("\"" "'")
:keyword ("if" "then" "else" "elif" "fi" "for" "while"
"done" "case" "esac" "in" "function" "return"
"export" "local" "unset" "source"
"echo" "printf" "read" "test" "let" "declare")
:builtin ("true" "false" "cd" "ls" "cat" "grep" "sed"
"mv" "cp" "rm" "mkdir" "touch" "find" "wc"
"head" "tail" "date" "sleep" "kill")))
("shell" . (:comment ("#") :string ("\"" "'")
:keyword ("if" "then" "else" "elif" "fi" "for" "while"
"done" "case" "esac" "in" "function" "return"
"export" "local" "unset" "source"
"echo" "printf" "read" "test")
:builtin ("true" "false" "cd" "ls" "grep" "sed"
"mv" "cp" "rm" "mkdir" "touch" "find"))))
:test #'string=)))
(defun tokenize-line (line highlighter)
(let ((tokens nil) (i 0) (len (length line))
(comment-chars (getf highlighter :comment))
(string-chars (getf highlighter :string))
(keywords (getf highlighter :keyword))
(builtins (getf highlighter :builtin)))
(loop while (< i len)
do (let ((c (char line i)))
(cond
((find c " \t")
(let ((start i))
(loop while (and (< i len) (find (char line i) " \t")) do (incf i))
(push (cons (subseq line start i) :plain) tokens)))
((and comment-chars
(some (lambda (cc)
(and (<= (+ i (length cc)) len)
(string= cc (subseq line i (+ i (length cc))))))
comment-chars))
(push (cons (subseq line i) :comment) tokens) (setf i len))
((and string-chars (some (lambda (s) (find c s)) string-chars))
(let ((start i))
(incf i)
(let ((triple (and (< i (1- len)) (char= (char line i) c)
(char= (char line (1+ i)) c))))
(if triple
(progn (incf i 2)
(loop while (and (< i len)
(not (and (char= (char line i) c)
(< (1+ i) len)
(char= (char line (1+ i)) c)
(< (+ i 2) len)
(char= (char line (+ i 2)) c))))
do (incf i))
(incf i 3))
(progn (loop while (and (< i len) (char/= (char line i) c))
do (incf i))
(when (< i len) (incf i)))))
(push (cons (subseq line start i) :string) tokens)))
((or (digit-char-p c)
(and (find c "+-") (< (1+ i) len) (digit-char-p (char line (1+ i)))))
(let ((start i))
(loop while (and (< i len) (not (find (char line i) " \t()[]{}'\";:#")))
do (incf i))
(let ((token (subseq line start i)))
(if (digit-char-p (char token 0))
(push (cons token :number) tokens)
(push (cons token :plain) tokens)))))
((or (alpha-char-p c)
(and (find c "-_?!*<>=") (> len 1)))
(let ((start i))
(loop while (and (< i len)
(or (alphanumericp (char line i))
(find (char line i) "-_?!*<>=")))
do (incf i))
(let* ((token (subseq line start i))
(down (string-downcase token)))
(cond
((find down keywords :test #'string=)
(push (cons token :keyword) tokens))
((find down builtins :test #'string=)
(push (cons token :builtin) tokens))
(t (if (and (< i len) (char= (char line i) #\())
(push (cons token :function) tokens)
(push (cons token :plain) tokens)))))))
(t (push (cons (string c) :plain) tokens) (incf i)))))
(nreverse tokens)))
(defun highlight-code (code language)
(let ((highlighter (get-highlighter (and language (string-downcase language)))))
(unless highlighter (return-from highlight-code (list (cons code :plain))))
(let ((tokens nil))
(with-input-from-string (stream code)
(loop for line = (read-line stream nil nil) while line
do (let ((line-tokens (tokenize-line line highlighter)))
(when tokens (push (cons (string #\Newline) :plain) tokens))
(setf tokens (nconc (nreverse line-tokens) tokens)))))
(nreverse tokens))))
(defun apply-highlight-token (token category)
(let ((code (case category
(:keyword "33") (:builtin "36")
(:function "34") (:comment "2") (:string "32") (:number "35")
(t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code token #\Escape) token)))
(defun apply-highlight-style (char-vector)
(coerce char-vector 'string))
;; ─── Diff rendering ───────────────────────────────────────────────────────────
(defun string-prefix-p (prefix string)
(and (>= (length string) (length prefix))
(string= prefix (subseq string 0 (length prefix)))))
(defun classify-diff-line (line)
(cond ((string-prefix-p "+++ " line) :file-header)
((string-prefix-p "--- " line) :file-header)
((string-prefix-p "@@" line) :hunk-header)
((string-prefix-p "+" line) :added)
((string-prefix-p "-" line) :removed)
(t :context)))
;; ─── Rendering ────────────────────────────────────────────────────────────────
(defun apply-style (style text)
(let ((code (cond
((eql style :bold) "1") ((eql style :italic) "3")
((eql style :dim) "2") ((eql style :code) "0")
((eql style :link) "4;36") ((eql style :url) "4;2")
((eql style :underline) "4") ((eql style :strike) "9")
((eql style :black) "30") ((eql style :red) "31")
((eql style :green) "32") ((eql style :yellow) "33")
((eql style :blue) "34") ((eql style :magenta) "35")
((eql style :cyan) "36") ((eql style :white) "37")
((eql style :bright-black) "90") ((eql style :bright-red) "91")
((eql style :bright-green) "92") ((eql style :bright-yellow) "93")
((eql style :bright-blue) "94") ((eql style :bright-magenta) "95")
((eql style :bright-cyan) "96") ((eql style :bright-white) "97")
((string= style "bold") "1") ((string= style "italic") "3")
((string= style "dim") "2") ((string= style "code") "0")
((string= style "link") "4;36") ((string= style "url") "4;2")
((string= style "bright-cyan") "96")
((string= style "bright-yellow") "93")
((string= style "bright-white") "97")
((string= style "bright-red") "91")
((string= style "bright-green") "92")
((string= style "bright-blue") "94")
((string= style "bright-magenta") "95")
((string= style "cyan") "36") ((string= style "yellow") "33")
((string= style "red") "31") ((string= style "green") "32")
((string= style "blue") "34") ((string= style "magenta") "35")
((string= style "white") "37") ((string= style "black") "30")
(t nil))))
(if code (format nil "~c[~am~a~c[0m" #\Escape code text #\Escape) text)))
(defun render-inline (children)
(if (null children) ""
(with-output-to-string (s)
(dolist (child children)
(let ((type (getf child :type)))
(case type
(:text (princ (or (getf child :content) "") s))
(:bold (princ (apply-style :bold (render-inline (getf child :children))) s))
(:italic (princ (apply-style :italic (render-inline (getf child :children))) s))
(:inline-code (princ (apply-style :code (or (getf child :content) "")) s))
(:link (let ((text (render-inline (getf child :children)))
(url (or (getf child :url) "")))
(princ (apply-style :link text) s)
(when (and url (not (string= url "")))
(princ " " s)
(princ (apply-style :url (format nil "(~a)" url)) s))))
(t (princ (or (getf child :content) "") s))))))))
(defun render-heading (node)
(let* ((level (or (getf (getf node :properties) :level) 1))
(prefix (make-string (min level 6) :initial-element #\#))
(text (render-inline (getf node :children)))
(color (cond ((= level 1) :bright-cyan) ((= level 2) :bright-yellow)
(t :bright-white))))
(list (apply-style color (concatenate 'string prefix " " text)))))
(defun render-paragraph (node)
(list (render-inline (getf node :children))))
(defun render-blockquote (node)
(list (apply-style :dim (concatenate 'string "> " (render-inline (getf node :children))))))
(defun render-code-block (node)
(let* ((language (or (getf (getf node :properties) :language) ""))
(content (or (getf node :content) ""))
(highlighted (unless (or (null language) (string= language ""))
(highlight-code content language)))
(lines nil))
(when (and language (not (string= language "")))
(push (apply-style :dim (format nil " ~~~~~~ ~a" language)) lines))
(if highlighted
(let ((cl (make-array 0 :element-type 'character
:fill-pointer 0 :adjustable t))
(output nil))
(dolist (pair highlighted)
(let ((token (car pair)) (category (cdr pair)))
(cond ((string= token (string #\Newline))
(push (apply-highlight-style cl) output)
(setf cl (make-array 0 :element-type 'character
:fill-pointer 0 :adjustable t)))
(t (let ((colored (apply-highlight-token token category)))
(loop for ch across colored
do (vector-push-extend ch cl)))))))
(when (> (length cl) 0) (push (apply-highlight-style cl) output))
(setf lines (nconc lines (nreverse output))))
(with-input-from-string (s content)
(loop for line = (read-line s nil nil) while line
do (push (apply-style :code line) lines))))
(nreverse lines)))
(defun render-diff-block (node)
(let* ((lines (getf (getf node :properties) :lines)) (result nil))
(dolist (line (or lines
(and (getf node :content)
(let ((l (split-string-into-lines (getf node :content))))
(loop for i from 0 below (length l) collect (aref l i))))))
(let* ((class (classify-diff-line line))
(color (case class
(:added "32") (:removed "31")
(:hunk-header "36") (:file-header "1;36") (t nil))))
(if color
(push (format nil "~c[~am~a~c[0m" #\Escape color line #\Escape) result)
(push line result))))
(nreverse result)))
(defun render-thematic-break (node)
(declare (ignore node))
(list (apply-style :dim "──────────────────────────────────────────────")))
(defun render-list-item (node)
(list (concatenate 'string
(if (eql (getf node :type) :ordered-item) " 1." " * ")
(render-inline (getf node :children)))))
(defun render-md-node (node)
(let ((type (getf node :type)))
(case type
(:heading (render-heading node))
(:paragraph (render-paragraph node))
(:blockquote (render-blockquote node))
(:code-block (render-code-block node))
(:diff-block (render-diff-block node))
(:thematic-break (render-thematic-break node))
(:list-item (render-list-item node))
(:ordered-item (render-list-item node))
(t (list "")))))
(defun render-md (nodes)
(let ((lines nil))
(dolist (node nodes) (setf lines (nconc lines (render-md-node node))))
lines))
(defun render-markdown (text)
(let ((nodes (parse-blocks text)) (parts nil))
(dolist (line (render-md nodes)) (push line parts))
(with-output-to-string (s)
(loop for part in (nreverse parts)
for first = t then nil
do (unless first (terpri s)) (princ part s)))))

205
tests/markdown-tests.lisp Normal file
View File

@@ -0,0 +1,205 @@
;;; markdown-tests.lisp — Tests for cl-tui.markdown
(defpackage :cl-tui-markdown-test
(:use :cl :cl-tui.markdown :fiveam))
(in-package :cl-tui-markdown-test)
;; Test suite
(def-suite :cl-tui-markdown-test
:description "Markdown parser/renderer tests for cl-tui.markdown")
(in-suite :cl-tui-markdown-test)
;; ─── Parser tests ─────────────────────────────────────────────────────────────
(def-test heading-parsing ()
(let* ((result (parse-blocks "# Hello World")) (node (first result)))
(is-true (eql :heading (getf node :type)))
(is (= 1 (getf (getf node :properties) :level)))))
(def-test heading-levels ()
(loop for level from 1 to 6
do (let* ((hashes (make-string level :initial-element #\#))
(text (format nil "~a Heading ~d" hashes level))
(result (parse-blocks text))
(node (first result)))
(is-true (eql :heading (getf node :type)))
(is (= level (getf (getf node :properties) :level))))))
(def-test heading-with-inline-formatting ()
(let* ((result (parse-blocks "# Hello **World**"))
(node (first result)) (children (getf node :children)))
(is-true (eql :heading (getf node :type)))
(is (= 2 (length children)))
(is-true (eql :text (getf (first children) :type)))
(is-true (eql :bold (getf (second children) :type)))))
(def-test paragraph-parsing ()
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
(is-true (eql :paragraph (getf node :type)))))
(def-test paragraph-multi-line ()
(let* ((result (parse-blocks "Line one\nLine two")) (node (first result)))
(is-true (eql :paragraph (getf node :type)))))
(def-test bold-parsing ()
(let* ((children (parse-inline "hello **world** here"))
(bold-node (second children)))
(is (= 3 (length children)))
(is-true (eql :bold (getf bold-node :type)))))
(def-test italic-parsing ()
(let* ((children (parse-inline "hello *world* here"))
(italic-node (second children)))
(is (= 3 (length children)))
(is-true (eql :italic (getf italic-node :type)))))
(def-test bold-italic-combined ()
(let ((children (parse-inline "**bold** and *italic*")))
(is (= 3 (length children)))
(is-true (eql :bold (getf (first children) :type)))
(is-true (eql :italic (getf (third children) :type)))))
(def-test inline-code-parsing ()
(let* ((children (parse-inline "use `foo` here"))
(code-node (second children)))
(is (= 3 (length children)))
(is-true (eql :inline-code (getf code-node :type)))
(is (equal "foo" (getf code-node :content)))))
(def-test link-parsing ()
(let* ((children (parse-inline "click [here](https://x.com)"))
(link-node (second children)))
(is (= 2 (length children)))
(is-true (eql :link (getf link-node :type)))
(is (equal "https://x.com" (getf link-node :url)))
(let ((link-text (getf link-node :children)))
(is (= 1 (length link-text)))
(is-true (eql :text (getf (first link-text) :type)))
(is (equal "here" (getf (first link-text) :content))))))
(def-test code-block-parsing ()
(let* ((text (format nil "```lisp~%(defun hello ())~% (print \"hi\")~%```"))
(result (parse-blocks text)) (node (first result)))
(is-true (eql :code-block (getf node :type)))
(is (equal "lisp" (getf (getf node :properties) :language)))
(is-true (search "(defun hello" (getf node :content)))))
(def-test code-block-unknown-language ()
(let* ((text (format nil "```~%plain code~%```"))
(result (parse-blocks text)) (node (first result)))
(is-true (eql :code-block (getf node :type)))
(is-false (getf (getf node :properties) :language))))
(def-test blockquote-parsing ()
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
(is-true (eql :blockquote (getf node :type)))))
(def-test list-item-parsing ()
(let* ((result (parse-blocks "- First item")) (node (first result)))
(is-true (eql :list-item (getf node :type)))))
(def-test ordered-list-parsing ()
(let* ((result (parse-blocks "1. First item")) (node (first result)))
(is-true (eql :ordered-item (getf node :type)))))
(def-test thematic-break-parsing ()
(let* ((result (parse-blocks "---")) (node (first result)))
(is-true (eql :thematic-break (getf node :type)))))
;; ─── Diff tests ───────────────────────────────────────────────────────────────
(def-test classify-diff-added ()
(is (eql :added (classify-diff-line "+this is added"))))
(def-test classify-diff-removed ()
(is (eql :removed (classify-diff-line "-this is removed"))))
(def-test classify-diff-hunk ()
(is (eql :hunk-header (classify-diff-line "@@ -1,3 +1,4 @@"))))
(def-test classify-diff-context ()
(is (eql :context (classify-diff-line " normal context"))))
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
(def-test highlight-lisp-keyword ()
(let ((tokens (highlight-code "(defun hello ()" "lisp")))
(is-true (some (lambda (pair) (and (search "defun" (car pair))
(eql :keyword (cdr pair))))
tokens))))
(def-test highlight-lisp-builtin ()
"Test that a Lisp builtin like nil is highlighted as :builtin."
(let ((tokens (highlight-code "(if t nil)" "lisp")))
(is-true (some (lambda (pair) (and (string= (car pair) "nil")
(eql :builtin (cdr pair))))
tokens))))
(def-test highlight-unknown-language ()
(let ((tokens (highlight-code "hello world" "unknown-xyz")))
(every (lambda (pair) (eql :plain (cdr pair))) tokens)))
(def-test highlight-comment ()
(let ((tokens (highlight-code "; this is a comment" "lisp")))
(is-true (some (lambda (pair) (eql :comment (cdr pair))) tokens))))
;; ─── Render tests ─────────────────────────────────────────────────────────────
(def-test render-heading-output ()
(let* ((node (make-md-node :heading :properties (list :level 2)
:children (list (make-md-node :text :content "Test"))))
(lines (render-md-node node)))
(is (= 1 (length lines)))
(is-true (> (length (first lines)) 0))))
(def-test render-paragraph-output ()
(let* ((node (make-md-node :paragraph
:children (list (make-md-node :text :content "Hello"))))
(lines (render-md-node node)))
(is (= 1 (length lines)))
(is-true (search "Hello" (first lines)))))
(def-test render-thematic-break-output ()
(let* ((node (make-md-node :thematic-break)) (lines (render-md-node node)))
(is (= 1 (length lines)))))
(def-test render-code-block-output ()
(let* ((node (make-md-node :code-block :content "(print \"hello\")"
:properties (list :language "lisp")))
(lines (render-md-node node)))
(is-true (> (length lines) 0))))
(def-test render-diff-block-output ()
(let* ((node (make-md-node :diff-block :properties
(list :lines
'("--- a/file" "+++ b/file" "@@ -1 +1 @@"
"+added" "-removed" " context"))))
(lines (render-md-node node)))
(is (= 6 (length lines)))
(is (search "added" (fourth lines)))
(is (search "removed" (fifth lines)))))
;; ─── Integration tests ────────────────────────────────────────────────────────
(def-test markdown-integration ()
(let* ((md (format nil "# Title~%~%This is **bold** and `code`.~%~%- Item 1~%- Item 2~%~%> A quote~%~%```lisp~%(defun hello ())~% (print \"hi\")~%```~%~%---"))
(nodes (parse-blocks md)) (lines (render-md nodes)))
(is-true (> (length lines) 5))
(is-true (search "# Title" (first lines)))))
(def-test render-markdown-string ()
(let ((result (render-markdown "**bold** text")))
(is-true (stringp result))
(is-true (> (length result) 0))))
(def-test md-node-text-simple ()
(let ((node (make-md-node :text :content "hello")))
(is (equal "hello" (md-node-text node)))))
(def-test md-node-text-nested ()
(let ((node (make-md-node :paragraph :children
(list (make-md-node :text :content "hello")
(make-md-node :bold :children
(list (make-md-node :text :content "world")))))))
(is (equal "helloworld" (md-node-text node)))))