Merge branch 'main' of github.com:lem-project/lem

extensions/asciidoc-mode/asciidoc-mode.lisp

@@ -64,4 +64,4 @@ link : https://asciidoctor.org/docs/asciidoc-syntax-quick-reference/
      :mode-hook *asciidoc-mode-hook*)
   (setf (variable-value 'enable-syntax-highlight) t))
 
-(define-file-type ("adoc") 'asciidoc-mode)
+(define-file-type ("adoc") asciidoc-mode)

extensions/markdown-mode/example.md

@@ -1,5 +1,54 @@
 # Hello
 
+## Test
+
+### Subheader
+
+#### Deeper header
+
+##### Even deeper
+
+###### Deepest header
+
+This is a paragraph with **bold text**, *italic text*, and __underlined text__. 
+
+Here is some `inline code` and a [link](https://example.com).
+
+> This is a blockquote.
+> More blockquote text.
+> > Nested blockquote text.
+
+Lists:
+
+- foo
+- bar
+- baz
+
+* hoge
+* piyo
+
++ hoge
++ piyo
+
+1. one
+2. two
+3. three
+
+Task list example:
+
+- [ ] Incomplete task
+- [x] Completed task
+- [ ] Another task to do
+
+Table:
+
+| Header 1 | Header 2 | Header 3 |
+|----------|----------|----------|
+| Row 1, Col 1 | Row 1, Col 2 | Row 1, Col 3 |
+| Row 2, Col 1 | Row 2, Col 2 | Row 2, Col 3 |
+
+Code:
+
 ```lisp
 (defpackage :foo
   (:use :cl))
@@ -17,20 +66,22 @@ int main(void) {
 }
 ```
 
-## Test
+```python
+def greet(name):
+    print(f"Hello, {name}!")
 
-this is test
+greet("World")
+```
 
-- foo
-- bar
-- baz
+Inline formatting combinations: 
+- **Bold and *italic* text**
+- *Italic and `inline code`*
+- [A link with **bold** text](https://example.com)
 
-* hoge
-* piyo
+---
 
-+ hoge
-+ piyo
+Metadata:
 
-1. one
-2. two
-3. three
+Title: Expanded Comprehensive Markdown Test File
+Author: AI Assistant
+Date: 2024-08-05

extensions/markdown-mode/syntax-parser.lisp

@@ -51,32 +51,89 @@
                                  :syntax-table syntax-table
                                  :recursive-check nil))
             (t
-             (put-text-property start point :attribute 'syntax-string-attribute))))))
+             (put-text-property start point :attribute 'document-code-block-attribute))))))
 
 (defun scan-region (start end)
   (clear-region-major-mode start end)
   (with-point ((point start))
     (loop :while (point< point end)
-          :do (cond ((looking-at point "^#")
-                     (put-line-attribute point 'syntax-constant-attribute))
-                    ((looking-at point "^>")
-                     (put-line-attribute point 'syntax-string-attribute))
-                    ((looking-at point "^\\s*[-*+]")
-                     (back-to-indentation point)
-                     (with-point ((start point)
-                                  (end point))
-                       (character-offset end 1)
-                       (put-text-property start end :attribute 'syntax-keyword-attribute)))
-                    ((looking-at point "^\\s*(?:\\d)+\\.\\s")
-                     (back-to-indentation point)
-                     (with-point ((start point)
-                                  (end point))
-                       (skip-chars-forward end #'digit-char-p)
-                       (character-offset end 1)
-                       (put-text-property start end :attribute 'syntax-keyword-attribute)))
-                    ((start-code-block-line-p point)
-                     (scan-code-block point end)))
-          :while (line-offset point 1))))
+          :do (let ((line (line-string point)))
+                (cond
+                  ((str:starts-with-p "#" line)
+                   (let ((level (position #\Space line)))
+                     (when level
+                       (put-line-attribute point (case level
+                                                   (1 'document-header1-attribute)
+                                                   (2 'document-header2-attribute)
+                                                   (3 'document-header3-attribute)
+                                                   (4 'document-header4-attribute)
+                                                   (5 'document-header5-attribute)
+                                                   (6 'document-header6-attribute))))))
+                  ((str:starts-with-p ">" line)
+                   (put-line-attribute point 'document-blockquote-attribute))
+                  ;; Unordered list items
+                  ((ppcre:scan "^\\s*[-*+]\\s" line)
+                   (ppcre:do-matches (start end "^(\\s*[-*+])\\s" line)
+                     (put-text-property 
+                      (character-offset (copy-point point) start)
+                      (character-offset (copy-point point) end)
+                      :attribute 'document-list-attribute)))
+                  ;; Ordered list items
+                  ((ppcre:scan "^\\s*\\d+\\.\\s" line)
+                   (ppcre:do-matches (start end "^(\\s*\\d+\\.)\\s" line)
+                     (put-text-property 
+                      (character-offset (copy-point point) start)
+                      (character-offset (copy-point point) end)
+                      :attribute 'document-list-attribute)))
+                  ((start-code-block-line-p point)
+                   (scan-code-block point end))
+                  ((or (str:starts-with-p "- [ ]" line)
+                       (str:starts-with-p "- [x]" line)
+                       (str:starts-with-p "- [X]" line))
+                   (put-line-attribute point 'document-task-list-attribute))
+                  ((str:starts-with-p "---" line)
+                   (put-line-attribute point 'document-metadata-attribute))
+                  ((str:starts-with-p "|" line)
+                   (put-line-attribute point 'document-table-attribute)))
+
+                ;; Inline matches
+                ;; Bold
+                (ppcre:do-matches (start end "\\*\\*(.*?)\\*\\*" line)
+                  (put-text-property 
+                   (character-offset (copy-point point) start)
+                   (character-offset (copy-point point) end)
+                   :attribute 'document-bold-attribute))
+                ;; Italic
+                (ppcre:do-matches (start end "\\*(.*?)\\*" line)
+                  (let ((bold-start (character-offset (copy-point point) start))
+                        (bold-end (character-offset (copy-point point) end)))
+                    (unless (text-property-at bold-start :attribute)
+                      (put-text-property 
+                       bold-start
+                       bold-end
+                       :attribute 'document-italic-attribute))))
+                ;; Underline
+                (ppcre:do-matches (start end "__(.*?)__" line)
+                  (put-text-property 
+                   (character-offset (copy-point point) start)
+                   (character-offset (copy-point point) end)
+                   :attribute 'document-underline-attribute))
+                ;; Code
+                (ppcre:do-matches (start end "`([^`]+)`" line)
+                  (put-text-property 
+                   (character-offset (copy-point point) start)
+                   (character-offset (copy-point point) end)
+                   :attribute 'document-inline-code-attribute))
+                ;; Links
+                (ppcre:do-matches (start end "\\[([^\\]]+)\\]\\(([^)]+)\\)" line)
+                  (put-text-property 
+                   (character-offset (copy-point point) start)
+                   (character-offset (copy-point point) end)
+                   :attribute 'document-link-attribute)))
+          ; Exit if we can't move forward
+          :do (unless (line-offset point 1)
+                (return)))))  
+
 
 (defun search-backward-code-block-start (point)
   (with-point ((point point))

qlfile.lock

@@ -13,7 +13,7 @@
 ("lem-base16-themes" .
  (:class qlot/source/git:source-git
   :initargs (:remote-url "https://github.com/lem-project/lem-base16-themes.git")
-  :version "git-20ab66c6b9f24e3634fb2a1d4ced1d51cefd3622"))
+  :version "git-e09618e2f3a4ba9977167d3ea90123ecabd884ab"))
 ("async-process" .
  (:class qlot/source/git:source-git
   :initargs (:remote-url "https://github.com/lem-project/async-process.git")

src/common/color.lisp

@@ -771,22 +771,38 @@
 144 238 144  LightGreen
 ")
 
-(let ((color-names
-        (flet ((parse (text)
-                 (with-input-from-string (stream text)
-                   (loop :for line := (read-line stream nil)
-                         :while line
-                         :for elt := (ppcre:register-groups-bind (r g b name)
-                                         ("^\\s*(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([a-zA-Z0-9 ]+)" line)
-                                       (cons (string-downcase name)
-                                             (list (and r (parse-integer r))
-                                                   (and g (parse-integer g))
-                                                   (and b (parse-integer b)))))
-                         :if elt
-                         :collect elt))))
-          (alexandria:alist-hash-table (parse *rgb.txt*) :test 'equal))))
-  (defun get-rgb-from-color-name (color-name)
-    (gethash (string-downcase color-name) color-names)))
+;; Size includes aliases
+(defvar *color-names* (make-hash-table :size 848 :test 'equal))
+
+(defun parse-rgb-txt ()
+  (alexandria:alist-hash-table
+   (with-input-from-string (stream *rgb.txt*)
+     (loop :for line := (read-line stream nil)
+           :while line
+           :for elt := (ppcre:register-groups-bind (r g b name)
+                           ("^\\s*(\\d+)\\s+(\\d+)\\s+(\\d+)\\s+([a-zA-Z0-9 ]+)" line)
+                         (cons (string-downcase name)
+                               (list (and r (parse-integer r))
+                                     (and g (parse-integer g))
+                                     (and b (parse-integer b)))))
+           :if elt
+           :collect elt))
+   :test 'equal))
+
+;; Lisp-style color names with a dash instead of space
+(defun add-lisp-color-alias (name value)
+  (when (> (length (ppcre:split "\\s+" name)) 1)
+    (let ((new-name (ppcre:regex-replace-all "\\s+" name "-")))
+      (setf (gethash new-name *color-names*) value))))
+
+(defun add-lisp-color-aliases ()
+  (maphash #'add-lisp-color-alias *color-names*))
+
+(defun get-rgb-from-color-name (color-name)
+  (when (equal (hash-table-count *color-names*) 0)
+    (setf *color-names* (parse-rgb-txt))
+    (add-lisp-color-aliases))
+  (gethash (string-downcase color-name) *color-names*))
 
 (defstruct (color (:constructor make-color (red green blue))) red green blue)