[nongnu] elpa/org-superstar 22a44f14ee 026/162: overhauled testing module composure-test.el

[Stefan Kangas]

branch: elpa/org-superstar
commit 22a44f14ee040a4db5a76388814be190100b0fb3
Author: D. Williams <d.williams@posteo.net>
Commit: D. Williams <d.williams@posteo.net>

    overhauled testing module composure-test.el
    
    added hooks for useful minor modes specific to module
    added features for toggling individual function listening
    re-formatted output
---
 tests/README.org        |  5 +--
 tests/composure-test.el | 83 +++++++++++++++++++++++++++++++++++--------------
 2 files changed, 62 insertions(+), 26 deletions(-)

diff --git a/tests/README.org b/tests/README.org
index 3e218cf2e4..b07432b5ba 100644
--- a/tests/README.org
+++ b/tests/README.org
@@ -29,8 +29,9 @@ To run additional test files, it is easiest to just =-l= them 
as well.
 This file adds lots of information regarding calls to ~compose-region~
 for functions defined in =org-superstar.el=.  They are written to the
 =*Messages*= buffer.  It also makes sure all ~--prettify-~ functions
-return proper faces (or ~nil~).
-
+return proper faces (or ~nil~).  This module auto-enables
+~column-number-mode~ as well as ~linum-mode~ for org to allow for manual,
+character-wise comparison of the characters prettified.
 
 
 #  LocalWords:  README el
diff --git a/tests/composure-test.el b/tests/composure-test.el
index 618ec369de..b92c1fa7d2 100644
--- a/tests/composure-test.el
+++ b/tests/composure-test.el
@@ -17,12 +17,30 @@
 ;;; Code:
 
 (require 'cl-macs)
+(require 'subr-x)
+(require 'linum)
 
 (defvar-local org-superstar/listen nil
   "If t, activate the advice ‘org-superstar/comp-test’.
 The idea is to only let ‘org-superstar/comp-test’ listen in on
 ‘compose-region’ when another function is advised to let-bind
-this variable.")
+this variable.  You can control which functions are currently
+active listeners by calling ‘org-superstar/toggle-listener’.")
+
+
+(defconst org-superstar/comp-listeners
+  '(org-superstar--prettify-ibullets
+    org-superstar--prettify-main-hbullet
+    org-superstar--prettify-other-hbullet
+    org-superstar--prettify-leading-hbullets)
+  "List of functions ‘org-superstar/comp-test’ can be applied to.")
+
+;;; Hooks
+
+(add-hook 'org-mode-hook
+          (lambda ()
+            (linum-mode 1)
+            (column-number-mode 1)))
 
 ;;; Advice definitions
 
@@ -31,27 +49,29 @@ this variable.")
 START, END, COMPONENTS and MOD-FUNC correspond to the arguments
 of ‘compose-region’."
   (when org-superstar/listen
-    (message "compose-region called: from %d to %d" start end)
     ;; I currently *do not* want to touch more than one character at a
     ;; time.  This test will only fail when I mess up regex grouping,
     ;; but it serves as a reminder that composing a region is not as
     ;; trivial as making the region bigger.
     (cl-assert (= 1 (- end start)))
+    (let ((line (line-number-at-pos start))
+          (col (save-excursion (goto-char start) (current-column)))
+          (composed-string (buffer-substring-no-properties start end)))
     (cond
      ((stringp components)
       (message
-       "composing ‘%s’ using string ‘%s’"
-       (buffer-substring-no-properties start end)
+       "line %s, column %s: composing ‘%s’ using string ‘%s’"
+       line col composed-string
        components))
      ((characterp components)
       (message
-       "composing ‘%s’ using string ‘%s’"
-       (buffer-substring-no-properties start end)
+       "line %s, column %s: composing ‘%s’ using character ‘%c’"
+       line col composed-string
        components))
      (t
       (message
        "composing ‘%s’ using a sequence"
-       (buffer-substring-no-properties start end))))))
+       (buffer-substring-no-properties start end)))))))
 
 (defun org-superstar/wrap-prettify (face-function &rest args)
   "Wrap FACE-FUNCTION and call with ARGS.
@@ -59,29 +79,44 @@ Ensure the return value is a face or nil.  Also toggle
 ‘compose-region’ calls to log behavior."
   (let ((org-superstar/listen t)
          (returned-face nil))
-    (message "Entered function")
     (prog1 (setq returned-face (apply face-function args))
       (cl-assert (or (facep returned-face)
                      (null returned-face)))
       (when (facep returned-face)
-        (message "Applied face ‘%s’ to group."
-                 returned-face))
-      (message "Exited" face-function))))
-
-
-
-;;; Adding advice
+        (message "Applied face ‘%s’ to group (line %d)"
+                 returned-face
+                 (line-number-at-pos (match-beginning 0)))))))
+
+
+;;; Helper functions
+(defun org-superstar/read-listener ()
+  "Return an argument list for ‘org-superstar/toggle-silence’."
+  (let ((answer (completing-read
+                 "Toggle silence for: "
+                 org-superstar/comp-listeners nil t)))
+    (unless (string-empty-p answer)
+      (list (read answer)))))
+
+;;; Adding and removing advice
+
+(defun org-superstar/toggle-listener (&optional symbol)
+  "Toggle listening to ‘compose-region’ for listener SYMBOL."
+  (interactive (org-superstar/read-listener))
+  (when symbol
+    (let ((is-adviced
+           (advice-member-p #'org-superstar/wrap-prettify symbol)))
+      (cond (is-adviced
+             (message "‘%s’ listening: OFF" symbol)
+             (advice-remove symbol #'org-superstar/wrap-prettify))
+            (t
+             (message "‘%s’ listening: ON" symbol)
+             (advice-add symbol
+                         :around #'org-superstar/wrap-prettify))))))
 
 ;; listen in on compose-region
 (advice-add 'compose-region :before #'org-superstar/comp-test)
 
-;; advise prettifyers to snoop
+;; advise prettifyers
 
-(advice-add 'org-superstar--prettify-ibullets
-            :around #'org-superstar/wrap-prettify)
-(advice-add 'org-superstar--prettify-main-hbullet
-            :around #'org-superstar/wrap-prettify)
-(advice-add 'org-superstar--prettify-other-hbullet
-            :around #'org-superstar/wrap-prettify)
-(advice-add 'org-superstar--prettify-leading-hbullets
-            :around #'org-superstar/wrap-prettify)
+(dolist (symbol org-superstar/comp-listeners)
+  (org-superstar/toggle-listener symbol))