;;; test-pearl-glyphs.el --- Tests for heading content glyphs -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; 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 . ;;; 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-none () "A heading with neither id 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-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 and comment headings each get their own glyph; the count matches." (test-pearl-glyphs--in-org (concat "* TODO SE-1: title\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n" "** 💬 Comments\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))) ;; Two glyphed headings: the issue and the one real comment. The ;; "Comments" container carries no Linear id, so it gets nothing. (should (= (length ovs) 2)))))) (provide 'test-pearl-glyphs) ;;; test-pearl-glyphs.el ends here