master bfa140d: Calc: use Unicode brackets in Big mode when available (bug#45917)

[Mattias Engdeg�rd]

branch: master
commit bfa140d7cf82ed640d033391cde505ab020de0f2
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Calc: use Unicode brackets in Big mode when available (bug#45917)
    
    * lisp/calc/calccomp.el (math--big-bracket-alist)
    (math--big-bracket, math--comp-bracket, math--comp-round-bracket):
    New.
    (math-compose-expr, math-compose-log, math-compose-log10)
    (math-compose-choose, math-compose-integ, math-compose-sum)
    (math-compose-prod): Use big brackets when available.
---
 lisp/calc/calccomp.el | 247 +++++++++++++++++++++++++++++++++-----------------
 1 file changed, 162 insertions(+), 85 deletions(-)

diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 07e70ca..5f38ee7 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -138,19 +138,19 @@
                                      (math-format-number (nth 2 aa))))))
                  (if (= calc-number-radix 10)
                      c
-                   (list 'horiz "(" c
-                         (list 'subscr ")"
-                               (int-to-string calc-number-radix)))))
+                    (list 'subscr (math--comp-round-bracket c)
+                         (int-to-string calc-number-radix))))
              (math-format-number a)))
        (if (not (eq calc-language 'big))
            (math-format-number a prec)
          (if (memq (car-safe a) '(cplx polar))
              (if (math-zerop (nth 2 a))
                  (math-compose-expr (nth 1 a) prec)
-               (list 'horiz "("
-                     (math-compose-expr (nth 1 a) 0)
-                     (if (eq (car a) 'cplx) ", " "; ")
-                     (math-compose-expr (nth 2 a) 0) ")"))
+                (math--comp-round-bracket
+                (list 'horiz
+                      (math-compose-expr (nth 1 a) 0)
+                      (if (eq (car a) 'cplx) ", " "; ")
+                      (math-compose-expr (nth 2 a) 0))))
            (if (or (= calc-number-radix 10)
                    (not (Math-realp a))
                    (and calc-group-digits
@@ -340,12 +340,13 @@
               (funcall spfn a prec)
             (math-compose-var a)))))
      ((eq (car a) 'intv)
-      (list 'horiz
-            (if (memq (nth 1 a) '(0 1)) "(" "[")
-           (math-compose-expr (nth 2 a) 0)
-            " .. "
-           (math-compose-expr (nth 3 a) 0)
-            (if (memq (nth 1 a) '(0 2)) ")" "]")))
+      (math--comp-bracket
+       (if (memq (nth 1 a) '(0 1)) ?\( ?\[)
+       (if (memq (nth 1 a) '(0 2)) ?\) ?\])
+       (list 'horiz
+            (math-compose-expr (nth 2 a) 0)
+             " .. "
+            (math-compose-expr (nth 3 a) 0))))
      ((eq (car a) 'date)
       (if (eq (car calc-date-format) 'X)
          (math-format-date a)
@@ -377,7 +378,7 @@
                    (and (eq (car-safe (nth 1 a)) 'cplx)
                         (math-negp (nth 1 (nth 1 a)))
                         (eq (nth 2 (nth 1 a)) 0)))
-               (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
+                (math--comp-round-bracket (math-compose-expr (nth 1 a) 0))
              (math-compose-expr (nth 1 a) 201))
            (let ((calc-language 'flat)
                  (calc-number-radix 10)
@@ -444,7 +445,7 @@
        (if (> prec (nth 2 a))
             (if (setq spfn (get calc-language 'math-big-parens))
                 (list 'horiz (car spfn) c (cdr spfn))
-              (list 'horiz "(" c ")"))
+              (math--comp-round-bracket c))
          c)))
      ((and (eq (car a) 'calcFunc-choriz)
           (not (eq calc-language 'unform))
@@ -612,7 +613,7 @@
                           (list 'horiz "{left ( "
                                 (math-compose-expr a -1)
                                 " right )}")))
-                    (list 'horiz "(" (math-compose-expr a 0) ")"))))
+                     (math--comp-round-bracket (math-compose-expr a 0)))))
                ((and (memq calc-language '(tex latex))
                      (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
                      (>= prec 0))
@@ -638,7 +639,7 @@
                        (rhs (math-compose-expr (nth 2 a) (nth 3 op) (eq (nth 1 
op) '/))))
                   (and (equal (car op) "^")
                        (eq (math-comp-first-char lhs) ?-)
-                       (setq lhs (list 'horiz "(" lhs ")")))
+                       (setq lhs (math--comp-round-bracket lhs)))
                   (and (memq calc-language '(tex latex))
                        (or (equal (car op) "^") (equal (car op) "_"))
                        (not (and (stringp rhs) (= (length rhs) 1)))
@@ -721,7 +722,7 @@
                           (list 'horiz "{left ( "
                                 (math-compose-expr a -1)
                                 " right )}")))
-                    (list 'horiz "(" (math-compose-expr a 0) ")"))))
+                    (math--comp-round-bracket (math-compose-expr a 0)))))
                (t
                 (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
                 (list 'horiz
@@ -759,7 +760,7 @@
                           (list 'horiz "{left ( "
                                 (math-compose-expr a -1)
                                 " right )}")))
-                    (list 'horiz "(" (math-compose-expr a 0) ")"))))
+                    (math--comp-round-bracket (math-compose-expr a 0)))))
                (t
                 (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
                   (list 'horiz
@@ -966,6 +967,69 @@
       (and (memq (car a) '(^ calcFunc-subscr))
           (math-tex-expr-is-flat (nth 1 a)))))
 
+;; FIXME: maybe try box drawing chars if big bracket chars are unavailable,
+;; like  ┌     ┐n
+;;       │a + b│     ┌ a + b ┐n
+;;       │-----│  or │ ----- │    ?
+;;       │  c  │     └   c   ┘
+;;       └     ┘
+;; They are more common than the chars below, but look a bit square.
+;; Rounded corners exist but are less commonly available.
+
+(defconst math--big-bracket-alist
+  '((?\( . (?⎛ ?⎝ ?⎜))
+    (?\) . (?⎞ ?⎠ ?⎟))
+    (?\[ . (?⎡ ?⎣ ?⎢))
+    (?\] . (?⎤ ?⎦ ?⎥))
+    (?\{ . (?⎧ ?⎩ ?⎪ ?⎨))
+    (?\} . (?⎫ ?⎭ ?⎪ ?⎬)))
+  "Alist mapping bracket chars to (UPPER LOWER EXTENSION MIDPIECE).
+Not all brackets have midpieces.")
+
+(defun math--big-bracket (bracket-char height baseline)
+  "Composition for BRACKET-CHAR of HEIGHT with BASELINE."
+  (if (<= height 1)
+      (char-to-string bracket-char)
+    (let ((pieces (cdr (assq bracket-char math--big-bracket-alist))))
+      (if (memq nil (mapcar #'char-displayable-p pieces))
+          (char-to-string bracket-char)
+        (let* ((upper (nth 0 pieces))
+               (lower (nth 1 pieces))
+               (extension (nth 2 pieces))
+               (midpiece (nth 3 pieces)))
+          (cons 'vleft        ; alignment doesn't matter; width is 1 char
+                (cons baseline
+                      (mapcar
+                       #'char-to-string
+                       (append
+                        (list upper)
+                        (if midpiece
+                            (let ((lower-ext (/ (- height 3) 2)))
+                              (append
+                               (make-list (- height 3 lower-ext) extension)
+                               (list midpiece)
+                               (make-list lower-ext extension)))
+                          (make-list (- height 2) extension))
+                        (list lower))))))))))
+
+(defun math--comp-bracket (left-bracket right-bracket comp)
+  "Put the composition COMP inside LEFT-BRACKET and RIGHT-BRACKET."
+  (if (eq calc-language 'big)
+      (let ((height (math-comp-height comp))
+            (baseline (1- (math-comp-ascent comp))))
+        (list 'horiz
+              (math--big-bracket left-bracket height baseline)
+              comp
+              (math--big-bracket right-bracket height baseline)))
+    (list 'horiz
+          (char-to-string left-bracket)
+          comp
+          (char-to-string right-bracket))))
+
+(defun math--comp-round-bracket (comp)
+  "Put the composition COMP inside plain brackets."
+  (math--comp-bracket ?\( ?\) comp))
+
 (put 'calcFunc-log 'math-compose-big #'math-compose-log)
 (defun math-compose-log (a _prec)
   (and (= (length a) 3)
@@ -973,18 +1037,14 @@
             (list 'subscr "log"
                   (let ((calc-language 'flat))
                     (math-compose-expr (nth 2 a) 1000)))
-            "("
-            (math-compose-expr (nth 1 a) 1000)
-            ")")))
+             (math--comp-round-bracket (math-compose-expr (nth 1 a) 1000)))))
 
 (put 'calcFunc-log10 'math-compose-big #'math-compose-log10)
 (defun math-compose-log10 (a _prec)
   (and (= (length a) 2)
        (list 'horiz
-            (list 'subscr "log" "10")
-            "("
-            (math-compose-expr (nth 1 a) 1000)
-            ")")))
+             (list 'subscr "log" "10")
+             (math--comp-round-bracket (math-compose-expr (nth 1 a) 1000)))))
 
 (put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv)
 (put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv)
@@ -1027,12 +1087,9 @@
 (defun math-compose-choose (a _prec)
   (let ((a1 (math-compose-expr (nth 1 a) 0))
        (a2 (math-compose-expr (nth 2 a) 0)))
-    (list 'horiz
-         "("
-         (list 'vcent
-               (math-comp-height a1)
-               a1 " " a2)
-         ")")))
+    (math--comp-round-bracket (list 'vcent
+                                   (+ (math-comp-height a1))
+                                   a1 " " a2))))
 
 (put 'calcFunc-integ 'math-compose-big #'math-compose-integ)
 (defun math-compose-integ (a prec)
@@ -1052,9 +1109,12 @@
                                                       "d%s"
                                                       (nth 1 (nth 2 a)))))
                                         (nth 1 a)) 185))
-             (calc-language 'flat)
-             (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
-             (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0)))
+             (low (and (nth 3 a)
+                       (let ((calc-language 'flat))
+                          (math-compose-expr (nth 3 a) 0))))
+             (high (and (nth 4 a)
+                        (let ((calc-language 'flat))
+                           (math-compose-expr (nth 4 a) 0))))
               ;; Check if we have Unicode integral top/bottom parts.
               (fancy (and (char-displayable-p ?⌠)
                           (char-displayable-p ?⌡)))
@@ -1066,40 +1126,47 @@
                                 ((char-displayable-p ?│) "│ ")
                                 ;; U+007C VERTICAL LINE
                                 (t "| "))))
-        (list 'horiz
-              (if parens "(" "")
-              (append (list 'vcent (if fancy
-                                        (if high 2 1)
-                                      (if high 3 2)))
-                      (and high (list (if fancy
-                                           (list 'horiz high " ")
-                                         (list 'horiz "  " high))))
-                       (if fancy
-                           (list "⌠ " fancy-stem "⌡ ")
-                        '("  /"
-                          " | "
-                          " | "
-                          " | "
-                          "/  "))
-                      (and low (list (if fancy
-                                          (list 'horiz low " ")
-                                        (list 'horiz low "  ")))))
-              expr
-              (if over
-                  ""
-                (list 'horiz " d" var))
-              (if parens ")" "")))))
+         (let ((comp
+               (list 'horiz
+                     (append (list 'vcent (if fancy
+                                               (if high 2 1)
+                                             (if high 3 2)))
+                             (and high (list (if fancy
+                                                  (list 'horiz high " ")
+                                                (list 'horiz "  " high))))
+                              (if fancy
+                                  (list "⌠ " fancy-stem "⌡ ")
+                               '("  /"
+                                 " | "
+                                 " | "
+                                 " | "
+                                 "/  "))
+                             (and low (list (if fancy
+                                                 (list 'horiz low " ")
+                                               (list 'horiz low "  ")))))
+                     expr
+                     (if over
+                         ""
+                       (list 'horiz " d" var)))))
+           (if parens
+               (math--comp-round-bracket comp)
+             comp)))))
 
 (put 'calcFunc-sum 'math-compose-big #'math-compose-sum)
 (defun math-compose-sum (a prec)
   (and (memq (length a) '(3 5 6))
        (let* ((expr (math-compose-expr (nth 1 a) 185))
-             (calc-language 'flat)
-             (var (math-compose-expr (nth 2 a) 0))
-             (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
-             (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
-        (list 'horiz
-              (if (memq prec '(180 201)) "(" "")
+             (var
+              (let ((calc-language 'flat))
+                 (math-compose-expr (nth 2 a) 0)))
+             (low (and (nth 3 a)
+                       (let ((calc-language 'flat))
+                          (math-compose-expr (nth 3 a) 0))))
+             (high (and (nth 4 a)
+                        (let ((calc-language 'flat))
+                           (math-compose-vector (nthcdr 4 a) ", " 0))))
+              (comp
+              (list 'horiz
               (append (list 'vcent (if high 3 2))
                       (and high (list high))
                       '("---- "
@@ -1112,32 +1179,42 @@
                         (list var)))
               (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
                   " " "")
-              expr
-              (if (memq prec '(180 201)) ")" "")))))
+              expr)))
+        (if (memq prec '(180 201))
+             (math--comp-round-bracket comp)
+           comp))))
 
 (put 'calcFunc-prod 'math-compose-big #'math-compose-prod)
 (defun math-compose-prod (a prec)
   (and (memq (length a) '(3 5 6))
        (let* ((expr (math-compose-expr (nth 1 a) 198))
-             (calc-language 'flat)
-             (var (math-compose-expr (nth 2 a) 0))
-             (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
-             (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
-        (list 'horiz
-              (if (memq prec '(196 201)) "(" "")
-              (append (list 'vcent (if high 3 2))
-                      (and high (list high))
-                      '("----- "
-                        " | |  "
-                        " | |  "
-                        " | |  ")
-                      (if low
-                          (list (list 'horiz var " = " low))
-                        (list var)))
-              (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
-                  " " "")
-              expr
-              (if (memq prec '(196 201)) ")" "")))))
+             (var
+               (let ((calc-language 'flat))
+                 (math-compose-expr (nth 2 a) 0)))
+             (low (and (nth 3 a)
+                        (let ((calc-language 'flat))
+                          (math-compose-expr (nth 3 a) 0))))
+             (high (and (nth 4 a)
+                         (let ((calc-language 'flat))
+                           (math-compose-vector (nthcdr 4 a) ", " 0))))
+              (comp
+              (list 'horiz
+                    (append (list 'vcent (if high 3 2))
+                            (and high (list high))
+                            '("----- "
+                              " | |  "
+                              " | |  "
+                              " | |  ")
+                            (if low
+                                (list (list 'horiz var " = " low))
+                              (list var)))
+                    (if (memq (car-safe (nth 1 a))
+                               '(calcFunc-sum calcFunc-prod))
+                        " " "")
+                    expr)))
+         (if (memq prec '(196 201))
+             (math--comp-round-bracket comp)
+           comp))))
 
 ;; The variables math-svo-c, math-svo-wid and math-svo-off are local
 ;; to math-stack-value-offset in calc.el, but are used by