v1.0.0: add char-width and search-highlight to cl-tty library

char-width → cl-tty.box (text.lisp): terminal column width for Unicode
  characters including CJK, emoji, combining marks, and tab.

search-highlight → cl-tty.markdown: wraps query matches in **bold**
  markers for search result emphasis. Pure function, zero dependencies.
This commit is contained in:
2026-05-18 15:48:15 -04:00
parent af572d5a8c
commit 0b076c8def
3 changed files with 56 additions and 1 deletions

View File

@@ -591,3 +591,33 @@ word list iteratively. Consecutive delimiters are collapsed
(setf start len))))
finally (return (nreverse words))))
#+END_SRC
** char-width utility
~char-width~ returns the terminal column width of a character.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0.
Tab = 8. Used by layout calculations that need to handle
variable-width characters.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/text.lisp
(defun char-width (ch)
"Returns the terminal column width of character CH."
(let ((code (char-code ch)))
(cond
((= code 9) 8)
((< code 32) 0)
((<= code 127) 1)
((<= #x4E00 code #x9FFF) 2)
((<= #x3400 code #x4DBF) 2)
((<= #x3040 code #x309F) 2)
((<= #x30A0 code #x30FF) 2)
((<= #xAC00 code #xD7AF) 2)
((<= #xFF01 code #xFF60) 2)
((<= #xFFE0 code #xFFE6) 2)
((<= #x1F300 code #x1F9FF) 2)
((<= #x2600 code #x27BF) 2)
((<= #x0300 code #x036F) 0)
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))
#+END_SRC

View File

@@ -18,6 +18,7 @@ and diff rendering. Self-contained in ~cl-tty.markdown~ package.
#:make-md-node #:md-node-p #:md-node-text
#:parse-blocks #:parse-inline
#:highlight-code
#:search-highlight
#:classify-diff-line #:render-md #:render-md-node
#:render-markdown #:render-inline
#:apply-style #:apply-styles))
@@ -1062,6 +1063,30 @@ Returns an empty string for ~nil~ input.
do (unless first (terpri s)) (princ part s)))))
#+END_SRC
*** search-highlight
~search-highlight~ wraps occurrences of a query string in a text with
**bold** markers for emphasis display. Case-insensitive matching.
Returns the original text if query is nil or empty.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/markdown.lisp
(defun search-highlight (content query)
"Wrap occurrences of QUERY in CONTENT with **bold** markers."
(let ((lower-content (string-downcase content))
(lower-query (string-downcase query))
(result "") (pos 0))
(when (and query (> (length query) 0))
(loop
(let ((found (search lower-query lower-content :start2 pos)))
(unless found (return))
(setf result (concatenate 'string result
(subseq content pos found)
"**" (subseq content found (+ found (length query))) "**"))
(setf pos (+ found (length query)))))
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
#+END_SRC
* Tests
The test suite covers parser edge cases, heading/paragraph parsing, inline

View File

@@ -115,7 +115,7 @@ not be relied upon by application code outside of tests.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/package.lisp
;; Utilities (for tests)
#:word-wrap #:split-string
#:word-wrap #:split-string #:char-width
#+END_SRC
** Dirty tracking