1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
;;; test-pearl-glyphs.el --- Tests for heading content glyphs -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Craig Jennings
;; Author: Craig Jennings <c@cjennings.net>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for the heading-glyph overlay: a ticket glyph on issue headings
;; (LINEAR-ID) and a speech glyph on comment headings (LINEAR-COMMENT-ID),
;; laid as a `display' overlay on the space after the leading stars so the glyph
;; sits ahead of the TODO keyword without changing buffer text.
;;; Code:
(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'cl-lib)
(defmacro test-pearl-glyphs--in-org (content &rest body)
"Run BODY in an org-mode temp buffer holding CONTENT."
(declare (indent 1))
`(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE"))))
(with-temp-buffer
(insert ,content)
(org-mode)
(goto-char (point-min))
,@body)))
(defun test-pearl-glyphs--overlays ()
"Return the list of pearl-glyph overlays in the current buffer."
(cl-remove-if-not (lambda (o) (overlay-get o 'pearl-glyph))
(overlays-in (point-min) (point-max))))
;;; --heading-glyph (pure dispatch)
(ert-deftest test-pearl-heading-glyph-comment-wins ()
"A comment id selects the comment glyph even when an issue id is also present."
(should (equal (pearl--heading-glyph "c1" "i1") pearl-comment-glyph)))
(ert-deftest test-pearl-heading-glyph-issue ()
"An issue id with no comment id selects the ticket glyph."
(should (equal (pearl--heading-glyph nil "i1") pearl-ticket-glyph)))
(ert-deftest test-pearl-heading-glyph-header ()
"No id but the header flag selects the Comments-header glyph."
(should (equal (pearl--heading-glyph nil nil t) pearl-comments-header-glyph)))
(ert-deftest test-pearl-heading-glyph-id-wins-over-header ()
"A Linear id outranks the header flag."
(should (equal (pearl--heading-glyph "c1" nil t) pearl-comment-glyph))
(should (equal (pearl--heading-glyph nil "i1" t) pearl-ticket-glyph)))
(ert-deftest test-pearl-heading-glyph-none ()
"A heading with no id and no header flag gets no glyph."
(should (null (pearl--heading-glyph nil nil))))
;;; --apply-heading-glyphs (overlay placement)
(ert-deftest test-pearl-apply-glyphs-issue-heading ()
"An issue heading gets a ticket-glyph display overlay on the post-stars space."
(test-pearl-glyphs--in-org
"* TODO SE-1: title\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n"
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs)
(let ((ovs (test-pearl-glyphs--overlays)))
(should (= (length ovs) 1))
(should (string-match-p (regexp-quote pearl-ticket-glyph)
(overlay-get (car ovs) 'display)))))))
(ert-deftest test-pearl-apply-glyphs-comment-heading ()
"A comment heading gets the speech-glyph display overlay."
(test-pearl-glyphs--in-org
"**** Craig โ 2026-05-23\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\n"
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs)
(let ((ovs (test-pearl-glyphs--overlays)))
(should (= (length ovs) 1))
(should (string-match-p (regexp-quote pearl-comment-glyph)
(overlay-get (car ovs) 'display)))))))
(ert-deftest test-pearl-apply-glyphs-comments-header ()
"The Comments container heading (no Linear id) gets the header-glyph overlay."
(test-pearl-glyphs--in-org
"*** Comments 2/2\n"
(let ((pearl-show-glyphs t)
(pearl-comments-header-glyph "๐ฌ"))
(pearl--apply-heading-glyphs)
(let ((ovs (test-pearl-glyphs--overlays)))
(should (= (length ovs) 1))
(should (string-match-p (regexp-quote "๐ฌ")
(overlay-get (car ovs) 'display)))))))
(ert-deftest test-pearl-apply-glyphs-empty-comment-glyph-none ()
"An empty `pearl-comment-glyph' lays no overlay on a comment heading."
(test-pearl-glyphs--in-org
"**** Craig โ 2026-05-23\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\n"
(let ((pearl-show-glyphs t)
(pearl-comment-glyph ""))
(pearl--apply-heading-glyphs)
(should (null (test-pearl-glyphs--overlays))))))
(ert-deftest test-pearl-apply-glyphs-plain-heading-none ()
"A heading with no Linear drawer gets no glyph overlay."
(test-pearl-glyphs--in-org
"* TODO just an org heading\n* Pearl Help\n"
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs)
(should (null (test-pearl-glyphs--overlays))))))
(ert-deftest test-pearl-apply-glyphs-idempotent ()
"Re-applying does not stack duplicate glyph overlays."
(test-pearl-glyphs--in-org
"* TODO SE-1: title\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n"
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs)
(pearl--apply-heading-glyphs)
(should (= (length (test-pearl-glyphs--overlays)) 1)))))
(ert-deftest test-pearl-apply-glyphs-off-clears ()
"With `pearl-show-glyphs' nil, applying lays no overlay and clears any prior."
(test-pearl-glyphs--in-org
"* TODO SE-1: title\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n"
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs))
(let ((pearl-show-glyphs nil))
(pearl--apply-heading-glyphs)
(should (null (test-pearl-glyphs--overlays))))))
(ert-deftest test-pearl-apply-glyphs-mixed-buffer ()
"Issue, Comments container, and comment headings each get their own glyph."
(test-pearl-glyphs--in-org
(concat "* TODO SE-1: title\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n"
"** Comments 1/1\n"
"*** Craig โ 2026-05-23\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\n")
(let ((pearl-show-glyphs t))
(pearl--apply-heading-glyphs)
(let ((ovs (test-pearl-glyphs--overlays)))
;; Three glyphed headings: the issue (ticket), the Comments container
;; (header glyph, matched by regex since it carries no id), and the one
;; real comment (speech).
(should (= (length ovs) 3))))))
;;; --comments-heading-regexp (glyph-agnostic Comments-header matcher)
(ert-deftest test-pearl-comments-heading-regexp-tolerates-any-glyph ()
"The Comments-heading regexp matches bare, glyphed, counted, and legacy forms."
(dolist (h '("*** Comments"
"*** Comments 2/2"
"*** Comments 2/2+"
"*** ๐ฌ Comments"
"*** ๐ฌ Comments 2/2"
"*** ๐จ๏ธ Comments 1/1"
"**** ๐งต Comments"
"*** Comments ๐ฌ 1/1")) ; pre-2026-05 trailing-glyph layout
(should (string-match-p pearl--comments-heading-regexp h)))
;; Body prose that merely mentions Comments must not match.
(should-not (string-match-p pearl--comments-heading-regexp "Comments are nice")))
(provide 'test-pearl-glyphs)
;;; test-pearl-glyphs.el ends here
|
