Table of Contents
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
Cookbook
Complete recipes. Each was run with ICU 78.3; outputs shown are real. They are written in a package that gives cl-icu the local nickname icu, and the first recipe also uses hb for cl-harfbuzz (see Installation).
- Laying out a paragraph
- Wrapping a paragraph
- Breaking Korean at spaces only
- Moving the caret
- Selecting a word
- Truncating text
- Caseless comparison and keys
- Terminal column widths
- Visual order for plain text
- Aligning text by its direction
- Counting words
- Validating identifiers
Laying out a paragraph
The full pipeline from a paragraph to shaped glyphs: break into lines (next recipe), then for each line, cut its bidi runs (visual order, one direction each) at the paragraph's script runs (one script each), and shape every piece.
(defun line-items (text start end &key (direction :auto) script-runs)
"Return the pieces of the line START..END of TEXT (a whole paragraph) as
lists (START END DIRECTION SCRIPT), in visual order. SCRIPT-RUNS, computed
once per paragraph with ICU:SCRIPT-RUNS, may be passed in."
(let ((script-runs (or script-runs (icu:script-runs text))))
(loop for run in (icu:bidi-runs text :direction direction :start start :end end)
for pieces = (loop for sr in script-runs
for s = (max (icu:bidi-run-start run) (icu:script-run-start sr))
for e = (min (icu:bidi-run-end run) (icu:script-run-end sr))
when (< s e)
collect (list s e (icu:bidi-run-direction run)
(icu:script-run-script sr)))
;; Script runs are in logical order; inside a right-to-left run the
;; later ones are further left.
append (if (eq (icu:bidi-run-direction run) :rtl) (reverse pieces) pieces))))
(defun shape-line (font text start end &key (direction :auto))
"Shape the line START..END of the paragraph TEXT, returning a list of
glyph vectors in visual order."
(loop for (s e dir script) in (line-items text start end :direction direction)
collect (hb:shape-text font text :start s :end e :direction dir :script script)))
(defparameter *text* "Hello שלום мир!")
(line-items *text* 0 (length *text*))
;; => ((0 6 :LTR "Latn") (6 10 :RTL "Hebr") (10 11 :LTR "Hebr") (11 15 :LTR "Cyrl"))
(hb:with-face (face "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf")
(hb:with-font (font face)
(mapcar (lambda (glyphs) (map 'list #'hb:shaped-glyph-cluster glyphs))
(shape-line font *text* 0 (length *text*)))))
;; => ((0 1 2 3 4 5) (9 8 7 6) (10) (11 12 13 14))
Draw the vectors left to right, one after the other. Points to note:
hb:shape-textgets the whole paragraph with:start/:end, so shaping at piece edges (Arabic joining, contextual forms) sees its neighbours.- The space at 10 is in the Hebrew script run but the left-to-right bidi run; it gets its own piece. HarfBuzz shapes it fine.
- Compute
script-runsonce per paragraph and pass it toline-itemsfor each line. - For different fonts or styles inside a paragraph (fallback fonts, bold spans), cut the pieces further at those boundaries, as cl-textrender does.
Wrapping a paragraph
Greedy line filling: take the last break opportunity that fits, measuring with any width function. Spaces at the end of a line hang outside the measured width.
(defun trim-end (text start end)
"Return END moved back over trailing white space, but not before START."
(loop while (and (> end start) (icu:char-property (char text (1- end)) :white-space))
do (decf end))
end)
(defun wrap (text width-fn max-width)
"Return the lines of the paragraph TEXT as (START END) pairs, breaking at
ICU's line break opportunities so that each line's WIDTH-FN (START END) fits
MAX-WIDTH. Mandatory breaks always end a line. Trailing spaces may hang
past MAX-WIDTH. A word too long for a line gets a line of its own."
(let ((lines '()) (start 0) (fit nil))
(dolist (b (icu:line-breaks text))
(let ((pos (icu:line-break-position b)))
(when (and fit (> (funcall width-fn start (trim-end text start pos)) max-width))
(push (list start fit) lines)
(setf start fit))
(if (and (eq (icu:line-break-kind b) :hard) (< pos (length text)))
(progn (push (list start pos) lines) (setf start pos fit nil))
(setf fit pos))))
(when (< start (length text)) (push (list start (length text)) lines))
(nreverse lines)))
Counting characters:
(let ((text "The quick brown fox jumps over the lazy dog."))
(mapcar (lambda (l) (subseq text (first l) (second l)))
(wrap text (lambda (s e) (- e s)) 15)))
;; => ("The quick brown " "fox jumps over " "the lazy dog.")
Measuring with cl-harfbuzz (font units of DejaVu Sans, 2048 per em):
(let ((text "The quick brown fox jumps over the lazy dog."))
(hb:with-face (face "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf")
(hb:with-font (font face)
(flet ((width (s e) (reduce #'+ (hb:shape-text font text :start s :end e)
:key #'hb:shaped-glyph-x-advance)))
(mapcar (lambda (l) (subseq text (first l) (second l)))
(wrap text #'width 20000))))))
;; => ("The quick brown " "fox jumps over the " "lazy dog.")
Then lay out each line with line-items above. A word longer than the line stays whole here; to break inside it, break at a grapheme boundary (text-boundaries).
Breaking Korean at spaces only
UAX #14 allows a break between any two Hangul syllables, but modern Korean typography breaks lines at spaces. Keep only the soft breaks that follow white space:
(defun space-breaks (text &key locale)
"Return TEXT's line breaks, keeping soft breaks only where they follow
white space, as Korean is set in the modern style."
(remove-if (lambda (b)
(let ((p (icu:line-break-position b)))
(and (eq (icu:line-break-kind b) :soft)
(< p (length text))
(not (icu:char-property (char text (1- p)) :white-space)))))
(icu:line-breaks text :locale locale)))
(mapcar #'icu:line-break-position (icu:line-breaks "안녕하세요 세계")) ; => (1 2 3 4 6 7 8)
(mapcar #'icu:line-break-position (space-breaks "안녕하세요 세계")) ; => (6 8)
Moving the caret
A caret moves by grapheme, never into the middle of one:
(defun next-grapheme (text index)
"Return the grapheme boundary after INDEX in TEXT, or its length."
(or (find-if (lambda (b) (> b index)) (icu:text-boundaries text :grapheme)) (length text)))
(defun previous-grapheme (text index)
"Return the grapheme boundary before INDEX in TEXT, or 0."
(or (find-if (lambda (b) (< b index)) (icu:text-boundaries text :grapheme) :from-end t) 0))
(let ((text (format nil "e~Cx~C~C" (code-char #x301) (code-char #x1F1F8) (code-char #x1F1EA))))
;; e + accent, x, a flag of two regional indicators
(list (next-grapheme text 0) (next-grapheme text 2) (previous-grapheme text 5)))
;; => (2 3 3)
In an editor, compute text-boundaries once per paragraph and keep it until the text changes. These move logically, in reading order.
Moving on screen in bidirectional text
An arrow key moves the cursor left or right on screen, which in bidirectional text is not the reading order. A terminal-style cursor sits on a character; bidi-visual-positions says where a character is displayed and bidi-visual-order which character is displayed at a position:
(defun visual-neighbour (text index step &key (start 0) end (direction :auto))
"Return the index of the grapheme displayed next to the one that starts at
INDEX, to its right if STEP is 1 and to its left if STEP is -1, within the
line START..END of TEXT, or NIL at the end of the line."
(let ((order (icu:bidi-visual-order text :direction direction :start start :end end))
(positions (icu:bidi-visual-positions text :direction direction :start start :end end))
(starts (icu:text-boundaries (subseq text start (or end (length text))) :grapheme)))
(loop for v = (+ (aref positions (- index start)) step) then (+ v step)
while (< -1 v (length order))
when (member (- (aref order v) start) starts)
return (aref order v))))
(let ((text "abc אבג")) ; displayed "abc גבא"
(list (visual-neighbour text 3 1) ; right of the space: ג at 6
(visual-neighbour text 6 1) ; right of ג: ב at 5
(visual-neighbour text 4 1))) ; right of א, the rightmost: none
;; => (6 5 NIL)
The loop skips characters that do not start a grapheme, such as Hebrew vowel points, so the cursor moves by whole graphemes. A GUI caret, which sits between characters, is better placed from shaped glyph positions; cl-textrender's move-caret does that.
Selecting a word
Double-click selection: the segment between word boundaries that contains a position, which is a word, or the spaces or punctuation between two words, as editors select them.
(defun word-at (text index)
"Return the start and end of the segment between word boundaries that
contains INDEX: a word, or the spaces or punctuation between two words."
(loop for (start end) on (icu:text-boundaries text :word)
while end
when (and (<= start index) (< index end))
return (values start end)
finally (return (values index index))))
(word-at "It's 42 cats." 10) ; => 8, 12 "cats"
(word-at "It's 42 cats." 4) ; => 4, 5 the space
Thai, Japanese and Chinese words are found by dictionary, so double-click works in them too.
Truncating text
Cut to a number of user-perceived characters, without splitting an emoji or an accented letter:
(defun truncate-graphemes (text n &optional (ellipsis "…"))
"Return TEXT cut to at most N graphemes, counting ELLIPSIS, which is
appended when TEXT is cut."
(let ((boundaries (icu:text-boundaries text :grapheme)))
(if (<= (1- (length boundaries)) n)
text
(concatenate 'string (subseq text 0 (nth (max 0 (- n 1)) boundaries)) ellipsis))))
(truncate-graphemes "ab👨👩👧cd" 3) ; => "ab…" never half a family
(truncate-graphemes "abc" 5) ; => "abc"
To truncate to a width, shape and measure instead, and cut at a grapheme boundary.
Caseless comparison and keys
To compare ignoring case and the different encodings of the same text, fold the case and normalize (Unicode's canonical caseless match):
(defun caseless= (a b)
"True if A and B are equal ignoring case and normalization differences."
(flet ((key (x) (icu:normalize (icu:foldcase (icu:normalize x :form :nfd)) :form :nfd)))
(string= (key a) (key b))))
(caseless= "Straße" "STRASSE") ; => T
(caseless= (format nil "E~C" (code-char #x301)) "é") ; => T
(caseless= "a" "b") ; => NIL
For keys of identifiers, user names, tags or file names, where formatting variants should also match, :nfkc-casefold does it in one step:
(defun identifier-key (name) (icu:normalize name :form :nfkc-casefold))
(identifier-key "file") ; => "file" the fi ligature
(identifier-key "FILE") ; => "file"
Use :turkic t in foldcase only for text known to be Turkish or Azerbaijani.
Terminal column widths
How many columns a string takes in a terminal. Terminals differ, so this is a heuristic, built from graphemes and the East Asian Width and emoji properties:
(defun display-width (text)
"Return the number of terminal columns TEXT takes: 2 for wide graphemes,
0 for invisible ones, else 1. A heuristic, as terminals differ."
(loop for g in (icu:graphemes text)
for c = (char g 0)
sum (cond ((member (icu:char-general-category c) '(:control :format :nonspacing-mark)) 0)
((or (member (icu:char-property c :east-asian-width) '(:wide :fullwidth))
(icu:char-property c :emoji-presentation)
(find (code-char #xFE0F) g))
2)
(t 1))))
(display-width "abc") ; => 3
(display-width "日本") ; => 4
(display-width "é") ; => 1 also as e + U+0301
(display-width "👨👩") ; => 2 one grapheme
(display-width "❤️") ; => 2 U+2764 with U+FE0F, emoji presentation
:ambiguous characters (Greek, Cyrillic and box drawing in some fonts) are 1 here; East Asian terminals may show them as 2.
Visual order for plain text
To print bidirectional text where nothing reorders it (a log, a terminal without bidi support, a debugging view), write the characters in visual order and mirror the brackets of right-to-left text (odd levels):
(defun visual-line (text &key (start 0) end (direction :auto))
"Return the line START..END of TEXT with its characters in visual order,
left to right, mirroring brackets in right-to-left runs. For terminals and
logs; with a shaper, shape the runs instead."
(let ((levels (icu:bidi-levels text :direction direction :start start :end end)))
(with-output-to-string (out)
(loop for i across (icu:bidi-visual-order text :direction direction :start start :end end)
for c = (char text i)
do (write-char (if (oddp (aref levels (- i start))) (icu:char-mirror c) c) out)))))
(map 'list #'char-code (visual-line "א(ב)"))
;; => (40 1489 41 1488) "(", bet, ")", alef: reads correctly right to left
bidi-visual-order reverses graphemes as units, so combining marks stay after their base.
Aligning text by its direction
Align a label or text field by its content, as browsers do for dir="auto":
(defun natural-alignment (text)
(if (eq (icu:bidi-base-direction text) :rtl) :right :left))
(natural-alignment "hello") ; => :LEFT
(natural-alignment "שלום world") ; => :RIGHT
(natural-alignment "123") ; => :LEFT no strong character
When a user interface is itself right to left, use :right for text without strong characters, as :auto-rtl does.
Counting words
words returns only the words, so counting them is length:
(length (icu:words "It's 42 cats.")) ; => 3
(length (icu:words "สวัสดีครับ")) ; => 2 Thai, by dictionary
(length (icu:words "日本語の文章です")) ; => 4
Validating identifiers
A Unicode identifier (UAX #31) is an XID_Start character followed by XID_Continue characters. Check after NFKC, which the XID properties are designed for:
(defun identifierp (name)
"True if NAME is a Unicode identifier (UAX #31): an XID_Start character
followed by XID_Continue characters, after NFKC."
(let ((name (icu:normalize name :form :nfkc)))
(and (plusp (length name))
(icu:char-property (char name 0) :xid-start)
(every (lambda (c) (icu:char-property c :xid-continue)) (subseq name 1)))))
(mapcar #'identifierp '("größe" "x1" "1x" "a-b" "名前")) ; => (T T NIL NIL T)
Combine it with identifier-key above to compare identifiers.