better handle directionality of ↕↔ arrows

tests/bench15.el

@@ -20,7 +20,7 @@
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 (uniline-bench
-"<return> <down> <down> <down> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <kp-subtract> <up> <up> <right> <right> <right> <insert> a <right> <insert> a a <right> <insert> a a a <right> <insert> a a a a <right> <insert> a a a a a <right> <insert> a a a a a a <right> <right> <right> <down> <insert> A <down> <insert> A A <down> <insert> a <down> <insert> A A A A <down> <insert> a S-<right> <down> <left> <left> <left> <insert> A <left> <home> <return> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <left> <insert> A S-<up> <left> <insert> a <left> <left> <kp-subtract> <left> <left> <insert> A A A A <left> <left> <up> <insert> a a a S-<left> <up> <insert> a S-<right> <up> <insert> a a a <up> <insert> a a a a a <up> <insert> a a a a a a S-<right> <right> <right> <right> <return> <insert> a <right> <right> <right> <up> <insert> S-<down> <down> <down> <down> <right> <right> <right> <right> <right> <insert> S-<right>"
+"<return> <down> <down> <down> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <kp-subtract> <up> <up> <right> <right> <right> <insert> a <right> <insert> a a <right> <insert> a a a <right> <insert> a a a a <right> <insert> a a a a a <right> <insert> a a a a a a <right> <right> <right> <down> <insert> A <down> <insert> A A <down> <insert> a <down> <insert> A A A A <down> <insert> a S-<right> <down> <left> <left> <left> <insert> A <left> <home> <return> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <right> <left> <insert> A S-<up> <left> <insert> a <left> <left> <kp-subtract> <left> <left> <insert> A A A A <left> <left> <up> <insert> a a a S-<left> <up> <insert> a S-<right> <up> <insert> a a a <up> <insert> a a a a a <up> <insert> a a a a a a S-<right> <right> <right> <right> <return> <insert> a <right> <right> <right> <up> <insert> S-<down> <down> <down> <down> <right> <right> <right> <right> <right> <insert> S-<right> <return>"
 "\
  
           ╭──▷▶→▿▸↔──╮

tests/bench16.el

@@ -0,0 +1,28 @@
+;;; uniline.el --- Draw lines, boxes, & arrows with the keyboard  -*- coding:utf-8; lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Thierry Banel
+
+;; Author: Thierry Banel tbanelwebmin at free dot fr
+;; Version: 1.0
+;; URL: https://github.com/tbanel/uniline
+
+;; Uniline 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.
+
+;; Uniline 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/>.
+
+(uniline-bench
+"<return> <down> <right> <right> <right> <right> <right> <insert> a <right> <right> <insert> A <right> <right> <insert> a S-<up> <right> <right> <insert> A S-<up> <down> C-a <up> C-k C-y <down> <home> C-y <left> <insert> a <left> <left> <insert> a <left> <left> <insert> a <left> <left> <insert> a C-a C-k C-y <right> <down> C-a C-y C-a <right> <right> <right> <right> <right> <insert> A A <right> <right> <insert> A <right> <right> <insert> A A <right> <right> <insert> A"
+"\
+ 
+     ▷ ↔ △ ↕ 
+     ▶ ◁ ▲ ◁               
+     ↔ ↔ ↕ ↔                                        ")

tests/uniline-bench.el

@@ -104,29 +104,34 @@ Do not call it directly."
   (insert "\")\n")
   (lisp-mode))
 
-(defun uniline-bench-run ()
-  "Run all benches.
-The benches are all files with *.el suffix.
+(defun uniline-bench-run (&rest files)
+  "Run all benches, or a specified list.
+When FILES is nil, th benches are all files with *.el suffix.
 Stops on the first error, presenting two buffers,
 - one with the actual drawing,
 - the other with the expected drawing,
 with points on the first difference.
 If there are no errors, a summary buffer is presented."
   (interactive)
-  (let ((buf (current-buffer))
-        (nbpassed 0)
-        (nbfailed 0))
-    (cl-loop
-     for file in (directory-files "." nil "\\.el$")
-     unless (equal "uniline-bench.el" file)
-     do
-     (load (format "%s%s" default-directory file) nil nil t)
-     (if uniline-bench-result
-         (cl-incf nbpassed)
-       (cl-incf nbfailed)
-       (message "%s FAILED" file)))
+  (unless files
+    (setq files
+          (delete "uniline-bench.el" (directory-files "." nil "\\.el$"))))
+  (let* ((buf (current-buffer))
+         (nbpassed 0)
+         (nbfailed 0)
+         (failed
+          (cl-loop
+           for file in files
+           do
+           (load (format "%s%s" default-directory file) nil nil t)
+           (if uniline-bench-result
+               (cl-incf nbpassed)
+             (cl-incf nbfailed)
+             (message "%s FAILED" file))
+           unless uniline-bench-result
+           collect file)))
     (switch-to-buffer buf)
-    (message "%s PASSED / %s FAILED" nbpassed nbfailed)))
+    (message "%s PASSED / %s FAILED %s" nbpassed nbfailed failed)))
 
 (if t
     (uniline-bench-run)
@@ -135,5 +140,8 @@ If there are no errors, a summary buffer is presented."
   (profiler-stop)
   (profiler-report))
 
+(if nil
+    (uniline-bench-run "bench15.el" "bench16.el"))
+
 (provide 'uniline-bench)
 ;;; uniline-bench.el ends here

uniline.el

@@ -756,7 +756,7 @@ without the fall-back characters.")
       (a   ?▵ ?▹ ?▿ ?◃)      ;; white *-pointing small triangle"
       (a   ?▴ ?▸ ?▾ ?◂)      ;; black *-pointing small triangle
       (a   ?↕ ?↔ ?↕ ?↔)      ;; up down arrow, left right arrow
-      
+
       ;; Those commented-out arrows are monospaces and supported
       ;; by the 6 fonts.  But they do not have 4 directions.
       ;;(a   ?‹ ?› ?› ?‹)      ;; single *-pointing angle quotation mark
@@ -945,6 +945,17 @@ Here we selected only the fixed-size ones.
 This list is ciurcular in forward order."))
 
 (eval-when-compile                      ; not needed at runtime
+
+  (defun uniline--duplicate (list)
+    "Return not-nil if LIST is duplicate-free.
+Using `eq'."
+    (while
+        (and
+         (cdr list)
+         (not (memq (car list) (cdr list))))
+      (pop list))
+    (cdr list))
+
   (defun uniline--make-hash (list)
     "Helper function to build `uniline--glyphs-reverse-hash-*'.
 Used only at package initialization.
@@ -958,7 +969,14 @@ LIST is `uniline--glyphs-fbw'."
            (cl-loop
             for cc in (cdar ll)
             for i from 0
-            do (puthash cc (cons i ll) hh))
+            do (puthash
+                cc
+                (cons
+                 (if (uniline--duplicate (car ll))
+                     t    ; special case ↕↔↕↔ is NOT fully directional
+                   i)     ; fully directional, i gives the direction
+                 ll)
+                hh))
          ;; glyph is not directional, like ■ ● ◆
          (puthash (cadar ll) (cons nil ll) hh))
        ;; explicitly break out of circular list
@@ -1997,12 +2015,31 @@ of the same command."
   (if (and repeat (< repeat 0))
       (setq repeat (- repeat)
             back (not back)))
-  (let ((line ; something like (3 x ((a ?▲ ?▶ ?▼ ?◀) (a ?↑ ?→ ?↓ ?←) …))
+  (let ((line
+         ;; line is something like:
+         ;; (3 ((a ?↑ ?→ ?↓ ?←) (a ?▲ ?▶ ?▼ ?◀) …))
+         ;;  △      △  △  △  △  current character is
+         ;;  │      ╰──┴──┴──┴─╴one of those arrows
+         ;;  ╰─────────────────╴oriented in this direction
+         ;;
+         ;; line can also be like:
+         ;; (t ((a ?↕ ?↔ ?↕ ?↔) (a ?↑ ?→ ?↓ ?←) …))
+         ;;  △      △  △  △  △  current character is
+         ;;  │      ╰──┴──┴──┴─╴one of those arrows
+         ;;  ╰─────────────────╴with no definite orientation
+         ;;
+         ;; or line may be like:
+         ;; (nil ((s ?■) (s ?▫) …))
+         ;;   △       △         current character is
+         ;;   │       ╰────────╴this one
+         ;;   ╰────────────────╴and it has NO orientation
          (gethash (uniline--char-after)
                   (if back
                       uniline--glyphs-reverse-hash-bw
                     uniline--glyphs-reverse-hash-fw))))
-    (if (and line (car line))
+    (if (and
+         line                  ; current character is one the known glyphs
+         (fixnump (car line))) ; it has a north-south-east-west orientation
         (setq uniline--arrow-direction (car line)))
     (setq line
           (if line
@@ -2111,7 +2148,9 @@ See `uniline--insert-glyph'."
           uniline--glyphs-reverse-hash-fw)))
     (when (car ligne) ;; if (point) is on a directional arrow
       (uniline--insert-char ;; then change its direction
-       (nth (1+ dir) (cadr ligne))))))
+       (nth (1+ dir) (cadr ligne)))
+      (setq uniline--arrow-direction dir)
+      )))
 
 ;; Run the following cl-loop to automatically write a bunch
 ;; of 4 interactive functions