v0.8.0: revert to stable e04b12c (undo typecase guard, navigation refactor, cursor calc changes)

The typecase guard, explicit navigation keyword dispatch, and word-wrap
cursor calculation changes introduced two regressions:
1. Cursor shows letter before instead of on (off-by-one)
2. Right arrow sometimes moves backward

Reverting to e04b12c which had working arrow keys and single-line cursor.
The unconditional position-cursor fix will be re-applied separately.

org/channel-tui-main.org

@@ -34,9 +34,7 @@ Event handlers + daemon I/O + main loop.
 #+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-main.lisp
 (in-package :passepartout.channel-tui)
 
-(defun on-key (key &key ctrl alt shift code)
+(defun on-key (ch)
-  (let ((ch key))
-    (declare (ignore alt shift))
   (cond
       ;; v0.7.1: Esc — interrupt streaming
       ((and (or (eq ch :escape) (eql ch 27)) (st :streaming-text))
@@ -563,16 +561,16 @@ Event handlers + daemon I/O + main loop.
             (when (and chr (graphic-char-p chr))
               (input-insert-char chr)
               (setf (st :dirty) (list nil nil t))
-              (when (and (char= chr #\/) (null cl-tty.dialog:*dialog-stack*)
+              (when (and (char= chr #\/) (null (st :dialog-stack))
                          (= (length (st :input-buffer)) 1))
-                (unified-menu-show "/"))))))))
+                (unified-menu-show "/")))))))
 
 ;; v0.9.0 — unified command minibuffer (replaces separate palette and slash menus)
 (defun unified-menu-show (&optional initial-filter)
   "Open the command minibuffer with ALL commands. If INITIAL-FILTER is
 supplied (e.g. \"/\"), pre-fill the select filter with it."
   (let* ((on-select (lambda (opt)
-                       (cl-tty.dialog:pop-dialog)
+                      (pop (st :dialog-stack))
                       (let ((val (getf opt :value)))
                         (cond ((stringp val)
                                ;; Slash command — fill input buffer
@@ -588,7 +586,7 @@ supplied (e.g. \"/\"), pre-fill the select filter with it."
     (when initial-filter
       (setf (cl-tty.select:select-filter sel) initial-filter))
     (let ((dlg (make-instance 'cl-tty.dialog:dialog :title "Commands" :content sel)))
-      (cl-tty.dialog:push-dialog dlg))))
+      (push dlg (st :dialog-stack)))))
 
 ;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
 (defun resolve-hitl-panel (decision)
@@ -880,8 +878,6 @@ Returns T on success, nil on failure. Does NOT wait or retry."
 (defvar *tty-in* nil "Stream from cat subprocess stdout (unused — direct stdin reads)")
 
 (defun tui-main ()
-  (format t "~&;; Passepartout TUI starting...~%")
-  (finish-output)
   (init-state)
   (load-history)
   (theme-load)
@@ -924,8 +920,6 @@ Returns T on success, nil on failure. Does NOT wait or retry."
                          do (connect-daemon)
                          (unless (st :connected) (sleep 5))))
                  :name "daemon-auto-connect"))
-            ;; Force initial render before entering input loop
-            (redraw be w h)
            (loop while (st :running) do
                (dolist (ev (drain-queue))
                  (cond
@@ -948,21 +942,18 @@ Returns T on success, nil on failure. Does NOT wait or retry."
                                            (:hidden :auto)))
                                    (setf (st :dirty) (list t t t)))
                          (:CTRL-L (setf (st :dirty) (list t t t)))
-                           ;; v0.8.0: dispatch known navigation keywords
+                         (t (if (st :dialog-stack)
-                           ((:up :down :left :right :enter :backspace :tab :escape
+                                (let* ((dlg (car (st :dialog-stack)))
-                             :home :end :ppage :npage)
-                            (if cl-tty.dialog:*dialog-stack*
-                                (let* ((dlg (car cl-tty.dialog:*dialog-stack*))
                                        (sel (cl-tty.dialog:dialog-content dlg)))
                                   (cond
                                      ((eql ch :escape)
-                                     (cl-tty.dialog:pop-dialog)
+                                      (pop (st :dialog-stack))
                                       (setf (st :dirty) (list t t nil)))
                                     ((member ch '(:up :down))
                                      (if (eql ch :up)
                                          (cl-tty.select:select-prev sel)
                                          (cl-tty.select:select-next sel)))
-                                    ((member ch '(:enter))
+                                    ((member ch '(:enter 13 10))
                                      (let* ((filtered (cl-tty.select:select-filtered-options sel))
                                             (idx (cl-tty.select:select-selected-index sel))
                                             (item (when (< idx (length filtered))
@@ -970,29 +961,20 @@ Returns T on success, nil on failure. Does NOT wait or retry."
                                        (when item
                                          (let ((cb (cl-tty.select:select-on-select sel)))
                                            (when cb (funcall cb item))))))
-                                    ((member ch '(:backspace))
+                                     ((let ((chr (if (characterp ch) ch
-                                     (let ((f (cl-tty.select:select-filter sel)))
+                                                      (and (integerp ch) (<= 32 ch 126)
-                                       (when (> (length f) 0)
+                                                           (code-char ch)))))
-                                         (setf (cl-tty.select:select-filter sel)
+                                         (and chr (graphic-char-p chr))
-                                               (subseq f 0 (1- f))))))
-                                    (t nil)))
-                                (on-key ch)))
-                           ;; v0.8.0: typecase converts integers to characters
-                           ;; so ctrl-byte keywords (:CTRL-A) are rejected
-                           (t (let ((chr (typecase ch
-                                           (character ch)
-                                           ((integer 32 126) (code-char ch))
-                                           (t nil))))
-                                (when chr
-                                  (if cl-tty.dialog:*dialog-stack*
-                                      (let* ((dlg (car cl-tty.dialog:*dialog-stack*))
-                                             (sel (cl-tty.dialog:dialog-content dlg)))
-                                        (when (graphic-char-p chr)
                                         (setf (cl-tty.select:select-filter sel)
                                               (concatenate 'string
                                                 (or (cl-tty.select:select-filter sel) "")
                                                 (string chr)))))
-                                      (on-key chr :code (when (integerp ch) ch)))))))))))
+                                    ((member ch '(:backspace 127 8))
+                                     (let ((f (cl-tty.select:select-filter sel)))
+                                       (when (> (length f) 0)
+                                         (setf (cl-tty.select:select-filter sel)
+                                               (subseq f 0 (1- f))))))))
+                                 (on-key ch))))))))
                 ;; Keyboard reader via read-raw-byte (proven CSI detection)
                 (handler-case
                     (let* ((b (cl-tty.input::read-raw-byte :timeout 0.1))
@@ -1036,9 +1018,9 @@ Returns T on success, nil on failure. Does NOT wait or retry."
                 ;; Guard w and h before render (resize or other code may have set them to nil)
                (setq w (or (and (numberp w) (> w 0) w) 80)
                      h (or (and (numberp h) (> h 0) h) 24))
-                                 (unless cl-tty.dialog:*dialog-stack*
+                                (unless (st :dialog-stack)
                   (redraw be w h))
-                (let ((ds cl-tty.dialog:*dialog-stack*))
+               (let ((ds (st :dialog-stack)))
                   (when ds
                      (cl-tty.backend:begin-sync be)
                      (let* ((chat-w (- w (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0)))
@@ -1093,8 +1075,10 @@ Returns T on success, nil on failure. Does NOT wait or retry."
                                                   (format nil "> ~a" (or filter ""))
                                                   (theme-color :input-prompt) bg-p))
                      (cl-tty.backend:end-sync be))
-                   (sleep 0.1))
+                  (sleep 0.1)
-                 (position-cursor be w h))
+                  ;; Show terminal cursor at input position every frame
+                  (unless (st :dialog-stack)
+                    (passepartout.channel-tui:position-cursor be w h))))
                (progn (disconnect-daemon)))))
 #+END_SRC
 
@@ -1593,7 +1577,7 @@ Returns T on success, nil on failure. Does NOT wait or retry."
 (fiveam:test test-minibuffer-state
   "Contract v0.8.0: init-state has :dialog-stack and :minibuffer-active fields."
   (init-state)
-  (fiveam:is (null cl-tty.dialog:*dialog-stack*))
+  (fiveam:is (null (st :dialog-stack)))
   (fiveam:is (null (st :minibuffer-active))))
 
 (fiveam:test test-command-palette-state

org/channel-tui-view.org

@@ -51,6 +51,19 @@ and current sidebar mode (:auto/:visible/:hidden)."
     (or (eq mode :visible)
         (and (eq mode :auto) (> w 120)))))
 
+(defun word-wrap (text width)
+  "Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
+Returns a list of strings, one per line."
+  (let ((lines nil))
+    (loop while (> (length text) width)
+          do (let ((break (or (position #\Space text :end width :from-end t)
+                              width)))
+               (push (subseq text 0 break) lines)
+               (setf text (string-left-trim '(#\Space)
+                            (subseq text break)))))
+    (push text lines)
+    (nreverse lines)))
+
 (defun view-status (fb w h)
   (declare (ignore fb w h))
   ;; Status bar is now a clean black line — blends with global :bg.
@@ -63,7 +76,7 @@ and current sidebar mode (:auto/:visible/:hidden)."
          (inner-w (- chat-w (* 2 hpad)))
          (prompt-w (- inner-w 2))
          (text (input-string))
-         (lines (cl-tty.box:word-wrap text prompt-w))
+         (lines (word-wrap text prompt-w))
          (n-lines (max 1 (length lines)))
          (panel-rows (max 4 (+ n-lines 2))))
     (- h 4 panel-rows -1)))
@@ -206,7 +219,7 @@ and current sidebar mode (:auto/:visible/:hidden)."
          (prompt-w (- inner-w 2))
          (text (input-string))
          (pos (or (st :cursor-pos) 0))
-         (lines (cl-tty.box:word-wrap text prompt-w))
+         (lines (word-wrap text prompt-w))
          (n-lines (max 1 (length lines)))
           (panel-rows (max 4 (+ n-lines 2)))
           (panel-top (input-panel-top chat-w h))
@@ -218,18 +231,18 @@ and current sidebar mode (:auto/:visible/:hidden)."
     ;; Speaker lines for all input rows
     (dotimes (r panel-rows)
       (cl-tty.backend:draw-text fb hpad (+ panel-top r) "│" (theme-color :input-prompt) nil))
-    ;; Draw each wrapped input line, tracking display position of cursor
+    ;; Draw each wrapped input line
-    (let ((accum 0) (cl 0) (cc 0))
+    (let ((accum 0) (cursor-line 0) (cursor-col 0))
       (dotimes (i n-lines)
         (let* ((line (nth i lines))
                (row (+ panel-top 1 i))
                (len (length line)))
           (when (>= row (- h 4)) (return))
           (cl-tty.backend:draw-text fb (+ hpad 2) row line input-fg nil)
-          (when (and (>= pos accum) (or (< pos (+ accum len)) (= i (1- n-lines))))
+          (when (and (>= pos accum) (<= pos (+ accum len)))
-            (setf cl i cc (- pos accum)))
+            (setf cursor-line i
-          (incf accum len)))
+                  cursor-col (- pos accum)))
-      (setf (st :cursor-line) cl (st :cursor-col) cc))
+          (incf accum (1+ len))))
     ;; Hint bar at h-2: F:/MCP: on left, token gauge + keybindings on right
     (let* ((focal (or (st :foveal-id) "-"))
            (focal-str (format nil "F:~a" focal))
@@ -251,7 +264,7 @@ and current sidebar mode (:auto/:visible/:hidden)."
            (ctx-x (- hint-x 1 (length ctx-str))))
       (cl-tty.backend:draw-text fb hpad (- h 2) left-str hint-fg (theme-color :bg))
       (cl-tty.backend:draw-text fb ctx-x (- h 2) ctx-str ctx-fg (theme-color :bg))
-      (cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg)))))
+      (cl-tty.backend:draw-text fb hint-x (- h 2) hint-str hint-fg (theme-color :bg))))))
 #+end_src
 
 ** Sidebar
@@ -339,34 +352,194 @@ and current sidebar mode (:auto/:visible/:hidden)."
     (when (sidebar-visible-p w)
       (view-sidebar fb w h))
     (cl-tty.backend:end-sync fb)
+    (position-cursor fb w h)
     (setf (st :dirty) (list nil nil nil))))
 
 (defun position-cursor (fb w h)
   "Draw cursor at the input insertion point using reverse video (Emacs-style).
-Uses cursor-line/cursor-col stored by view-input to stay aligned with rendering."
+
-  (let* ((text (input-string))
+  The character under the cursor is redrawn with foreground and background
+  swapped. If the cursor is past the end of the input string, a reversed
+  space is drawn."
+  (let* ((sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
+         (cw (- w sw))
+         (hpad 2)
+         (text (input-string))
          (text-len (length text))
          (pos (or (st :cursor-pos) 0))
-         (cl (or (st :cursor-line) 0))
+         (prompt-w (- cw (* 2 hpad) 2))
-         (cc (or (st :cursor-col) 0))
+         (display-start (max 0 (- pos (1- prompt-w))))
-         (hpad 2)
+         (cx (+ hpad 2 (- pos display-start)))
-         (sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
+         (cy (- h 6))
-         (cw (- w sw))
-         (inner-w (- cw (* 2 hpad)))
-         (prompt-w (- inner-w 2))
-         (lines (cl-tty.box:word-wrap text prompt-w))
-         (n-lines (max 1 (length lines)))
-         (panel-rows (max 4 (+ n-lines 2)))
-         (panel-top (- h 4 panel-rows -1))
          (bg-i (theme-color :bg-input))
          (input-fg (theme-color :input-fg)))
-    (let ((cx (+ hpad 2 cc))
-          (cy (+ panel-top 1 cl)))
     (if (< pos text-len)
         (let ((ch (char text pos)))
           (cl-tty.backend:draw-text fb cx cy (string ch) bg-i input-fg))
         (cl-tty.backend:draw-text fb cx cy " " bg-i input-fg))
-      (finish-output (cl-tty.backend::backend-output-stream fb)))))
+    (finish-output (cl-tty.backend::backend-output-stream fb))))
+#+END_SRC
+
+* Implementation — v0.7.0 additions
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
+(in-package :passepartout)
+
+(defun char-width (ch)
+  "Returns the terminal column width of character CH.
+ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
+  (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
+
+* v0.7.1 — Markdown Rendering
+
+~render-styled~ accepts a ~(text . plist)~ segment list from the span
+parser and emits ~draw-text~ calls. The ~w~ parameter is ignored (layout
+is line-at-a-time, not fixed-width); ~theme-color~ is fully qualified
+as ~passepartout.channel-tui:theme-color~ since this function lives in
+the ~passepartout~ package but the theme API is in ~passepartout.channel-tui~.
+
+The inline span parser (~parse-markdown-spans~) delegates punctuation
+delimiters (**bold**, `code`, *italic*) to a local ~pick~ helper.
+URLs are handled directly via ~url-end~ rather than through ~pick~,
+so the ~:url~ clause was removed from ~pick~'s ~case~ form to avoid
+dead code.
+
+#+BEGIN_SRC lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui-view.lisp
+(in-package :passepartout)
+
+(defun parse-markdown-spans (text)
+  "Parse inline markdown. Returns list of (text . (:bold/:underline/:code/:url ...))."
+  (let ((results nil) (pos 0) (len (length text)))
+    (labels ((earliest (a b) (cond ((and a (or (null b) (< a b))) a) (b b))))
+      (loop
+        (when (>= pos len) (return))
+        (let* ((bold (search "**" text :start2 pos))
+               (code (search "`" text :start2 pos))
+               (italic (search "*" text :start2 pos))
+               (http (search "http://" text :start2 pos))
+               (https (search "https://" text :start2 pos))
+               (url-s (or https http)))
+          (flet ((pick (tag delim)
+                   (let ((end (search delim text :start2 (+ pos (length delim)))))
+              (when end
+                        (push (cons (subseq text (+ pos (length delim)) end)
+                                    (case tag (:bold '(:bold t))
+                                         (:code '(:code t :bgcolor :dim))
+                                         (:underline '(:underline t))))
+                              results)
+                       (setf pos (+ end (length delim)))
+                       t)))
+                 (url-end (start)
+                   (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
+                                    text :start start)
+                       len)))
+            (let ((next (earliest (earliest (earliest bold code) italic) url-s)))
+              (cond ((and bold (eql bold next)) (unless (pick :bold "**") (incf pos 2)))
+                    ((and code (eql code next)) (unless (pick :code "`") (incf pos)))
+                    ((and italic (eql italic next)) (unless (pick :underline "*") (incf pos)))
+                    ((and url-s (eql url-s next))
+                     (let ((ue (url-end url-s)))
+                       (push (cons (subseq text url-s ue) '(:url t)) results)
+                       (setf pos ue)))
+                    (t (push (cons (subseq text pos) nil) results) (return))))))))
+    (nreverse results)))
+
+(defun render-styled (fb segments y x w)
+  "Render markdown segments to cl-tty backend. Returns next y."
+  (declare (ignore w))
+  (dolist (seg segments)
+    (let* ((text (or (car seg) ""))
+           (attrs (cdr seg))
+           (bold (getf attrs :bold))
+           (code (getf attrs :code))
+           (url (getf attrs :url)))
+      (declare (ignore code))
+      (cl-tty.backend:draw-text fb x y text
+                                (cond (url (passepartout.channel-tui:theme-color :accent))
+                                      (t (passepartout.channel-tui:theme-color (or (getf attrs :role) :agent-fg))))
+                               (passepartout.channel-tui:theme-color :bg)
+                               :bold bold)
+      (incf x (length text))))
+  y)
+
+(defun parse-markdown-blocks (text)
+  "Split text at ``` code block boundaries."
+  (let ((r nil) (p 0) (l (length text)))
+    (loop
+     (when (>= p l) (return))
+     (let ((bs (search "```" text :start2 p)))
+       (unless bs
+         (push (cons (subseq text p) nil) r)
+         (return))
+       (when (> bs p)
+         (push (cons (subseq text p bs) nil) r))
+       (let* ((ao (+ bs 3))
+              (le (or (position #\Newline text :start ao) l))
+              (lang (string-trim " \r\n\t" (if (< le l) (subseq text ao le) "")))
+              (cs (if (< le l) (1+ le) l))
+              (cp (search "```" text :start2 cs))
+              (ce (or cp l))
+              (content (string-trim "\r\n" (subseq text cs ce))))
+         (push (list :code-block t :lang lang :content content) r)
+         (setf p (if cp (+ cp 3) l)))))
+    (nreverse r)))
+
+(defun syntax-highlight (code lang)
+  "Highlight Lisp code: strings, comments, keywords, function calls."
+  (declare (ignore lang))
+  (let* ((r nil) (p 0) (l (length code))
+         (kw '("defun" "defvar" "defparameter" "let" "let*" "lambda" "if" "when" "unless"
+               "cond" "loop" "dolist" "dotimes" "progn" "prog1" "return"
+               "setf" "setq" "format" "and" "or" "not" "list" "cons"
+               "quote" "function" "declare" "ignore" "t" "nil")))
+    (flet ((wordp (c) (or (alphanumericp c) (find c "-*+/?!_=<>"))))
+      (loop
+       (when (>= p l) (return))
+       (let* ((ss (position #\" code :start p))
+              (sc (position #\; code :start p))
+              (sp (position #\( code :start p))
+              (next (min (or ss l) (or sc l) (or sp l))))
+         (when (> next p)
+           (push (cons (subseq code p next) nil) r)
+           (setf p next))
+         (when (>= p l) (return))
+         (cond
+          ((eql p ss)
+           (let ((e (or (position #\" code :start (1+ p)) l)))
+             (push (cons (subseq code p (min (1+ e) l)) '(:fgcolor :string)) r)
+             (setf p (min (1+ e) l))))
+          ((eql p sc)
+           (let ((e (or (position #\Newline code :start p) l)))
+             (push (cons (subseq code p e) '(:fgcolor :comment)) r)
+             (setf p e)))
+          ((eql p sp)
+           (push (cons "(" nil) r)
+           (incf p)
+           (let ((fe (loop for i from p below l for c = (char code i)
+                           while (wordp c) finally (return i))))
+             (when (> fe p)
+               (let ((fs (subseq code p fe)))
+                 (push (cons fs (list :fgcolor (if (member fs kw :test #'string=)
+                                                   :keyword :function))) r)
+                 (setf p fe)))))))))
+    (nreverse r)))
 #+END_SRC
 
 * v0.7.2 — Gate Trace
@@ -413,6 +586,75 @@ Uses cursor-line/cursor-col stored by view-input to stay aligned with rendering.
 (def-suite tui-view-suite :description "TUI view rendering helpers")
 (in-suite tui-view-suite)
 
+(test test-char-width-ascii
+  "Contract 5: ASCII characters (< 128) have width 1."
+  (is (= 1 (passepartout::char-width #\a)))
+  (is (= 1 (passepartout::char-width #\Space)))
+  (is (= 1 (passepartout::char-width #\@))))
+
+(test test-char-width-tab
+  "Contract 5: tab character has width 8."
+  (is (= 8 (passepartout::char-width #\Tab))))
+
+(test test-char-width-cjk
+  "Contract 5: CJK characters have width 2."
+  (is (= 2 (passepartout::char-width #\日))))
+
+(test test-char-width-null
+  "Contract 5: null has width 0."
+  (is (= 0 (passepartout::char-width #\Nul))))
+
+(test test-markdown-bold
+  "Contract 7: parse-markdown-spans detects **bold**."
+  (let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
+    (is (= 3 (length segments)))))
+
+(test test-markdown-plain
+  "Contract 7: plain text returns single segment."
+  (let ((segments (passepartout::parse-markdown-spans "plain")))
+    (is (= 1 (length segments)))
+    (is (string= "plain" (caar segments)))))
+
+(test test-markdown-url
+  "Contract 7: parse-markdown-spans detects URLs."
+  (let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
+    (is (>= (length segments) 2))
+    (is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
+
+(test test-markdown-blocks
+  "Contract 8: parse-markdown-blocks detects code blocks."
+  (let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 3 (length segs)))
+    (let ((code (second segs)))
+      (is (eq t (getf code :code-block)))
+      (is (string= "lisp" (getf code :lang)))
+      (is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
+
+(test test-markdown-blocks-no-close
+  "Contract 8: unclosed code block returns content."
+  (let* ((text (format nil "```~%unclosed code"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 1 (length segs)))
+    (is (eq t (getf (first segs) :code-block)))))
+
+(test test-syntax-highlight
+  "Contract 9: syntax-highlight colors Lisp code."
+  (let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
+    (is (>= (length segs) 3))))
+
+(test test-syntax-highlight-keyword
+  "Contract 9: syntax-highlight colors keywords."
+  (let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
+(test test-syntax-highlight-function
+  "Contract 9: syntax-highlight colors function calls."
+  (let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
 (test test-gate-trace-lines-passed
   "Contract 9: gate-trace-lines for passed gate."
   (let ((lines (passepartout::gate-trace-lines