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.

1 files changed, 162 insertions, 85 deletions

diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 07e70cad0a8..5f38ee71c78 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