lisp/calc/calccomp.el

   1 ;;; calccomp.el --- composition functions for Calc
   2
   3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: David Gillespie <daveg@synaptics.com>
   7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 ;; This file is autoloaded from calc-ext.el.
  29
  30 (require 'calc-ext)
  31 (require 'calc-macs)
  32
  33 ;;; A "composition" has one of the following forms:
  34 ;;;
  35 ;;;    "string"              A literal string
  36 ;;;
  37 ;;;    (horiz C1 C2 ...)     Horizontally abutted sub-compositions
  38 ;;;
  39 ;;;    (set LEVEL OFF)       Set left margin + offset for line-break level
  40 ;;;    (break LEVEL)         A potential line-break point
  41 ;;;
  42 ;;;    (vleft N C1 C2 ...)   Vertically stacked, left-justified sub-comps
  43 ;;;    (vcent N C1 C2 ...)   Vertically stacked, centered sub-comps
  44 ;;;    (vright N C1 C2 ...)  Vertically stacked, right-justified sub-comps
  45 ;;;                          N specifies baseline of the stack, 0=top line.
  46 ;;;
  47 ;;;    (supscr C1 C2)        Composition C1 with superscript C2
  48 ;;;    (subscr C1 C2)        Composition C1 with subscript C2
  49 ;;;    (rule X)              Horizontal line of X, full width of enclosing comp
  50 ;;;
  51 ;;;    (tag X C)             Composition C corresponds to sub-expression X
  52
  53 ;; math-comp-just and math-comp-comma-spc are local to
  54 ;; math-compose-expr, but are used by math-compose-matrix, which is
  55 ;; called by math-compose-expr
  56 (defvar math-comp-just)
  57 (defvar math-comp-comma-spc)
  58
  59 ;; math-comp-vector-prec is local to math-compose-expr, but is used by
  60 ;; math-compose-matrix and math-compose-rows, which are called by
  61 ;; math-compose-expr.
  62 (defvar math-comp-vector-prec)
  63
  64 ;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
  65 ;; local to math-compose-expr, but are used by math-compose-rows, which is
  66 ;; called by math-compose-expr.
  67 (defvar math-comp-left-bracket)
  68 (defvar math-comp-right-bracket)
  69 (defvar math-comp-comma)
  70
  71 (defun math-compose-var (a)
  72   (let (v sn)
  73     (if (and math-compose-hash-args
  74              (let ((p calc-arg-values))
  75                (setq v 1)
  76                (while (and p (not (equal (car p) a)))
  77                  (setq p (and (eq math-compose-hash-args t) (cdr p))
  78                        v (1+ v)))
  79                p))
  80         (if (eq math-compose-hash-args 1)
  81             "#"
  82           (format "#%d" v))
  83       (setq sn (symbol-name (nth 1 a)))
  84       (if (memq calc-language calc-lang-allow-percentsigns)
  85           (setq sn (math-to-percentsigns sn)))
  86       (if (memq calc-language calc-lang-allow-underscores)
  87           (setq sn (math-to-underscores sn)))
  88       sn)))
  89
  90 (defun math-compose-expr (a prec)
  91   (let ((math-compose-level (1+ math-compose-level))
  92         (math-expr-opers (math-expr-ops))
  93         spfn)
  94     (cond
  95      ((or (and (eq a math-comp-selected) a)
  96           (and math-comp-tagged
  97                (not (eq math-comp-tagged a))))
  98       (let ((math-comp-selected nil))
  99         (and math-comp-tagged (setq math-comp-tagged a))
 100         (list 'tag a (math-compose-expr a prec))))
 101      ((and (not (consp a)) (not (integerp a)))
 102       (concat "'" (prin1-to-string a)))
 103      ((setq spfn (assq (car-safe a)
 104                        (get calc-language 'math-special-function-table)))
 105       (setq spfn (cdr spfn))
 106       (if (consp spfn)
 107           (funcall (car spfn) a spfn)
 108         (funcall spfn a)))
 109      ((math-scalarp a)
 110       (if (or (eq (car-safe a) 'frac)
 111               (and (nth 1 calc-frac-format) (Math-integerp a)))
 112           (if (and
 113                calc-language
 114                (not (memq calc-language
 115                           '(flat big unform))))
 116               (let ((aa (math-adjust-fraction a))
 117                     (calc-frac-format nil))
 118                 (math-compose-expr (list '/
 119                                          (if (memq calc-language
 120                                                    calc-lang-slash-idiv)
 121                                              (math-float (nth 1 aa))
 122                                            (nth 1 aa))
 123                                          (nth 2 aa)) prec))
 124             (if (and (eq calc-language 'big)
 125                      (= (length (car calc-frac-format)) 1))
 126                 (let* ((aa (math-adjust-fraction a))
 127                        (calc-frac-format nil)
 128                        (math-radix-explicit-format nil)
 129                        (c (list 'horiz
 130                                 (if (math-negp (nth 1 aa))
 131                                     "- " "")
 132                                 (list 'vcent 1
 133                                       (math-format-number
 134                                        (math-abs (nth 1 aa)))
 135                                       '(rule ?-)
 136                                       (math-format-number (nth 2 aa))))))
 137                   (if (= calc-number-radix 10)
 138                       c
 139                     (list 'horiz "(" c
 140                           (list 'subscr ")"
 141                                 (int-to-string calc-number-radix)))))
 142               (math-format-number a)))
 143         (if (not (eq calc-language 'big))
 144             (math-format-number a prec)
 145           (if (memq (car-safe a) '(cplx polar))
 146               (if (math-zerop (nth 2 a))
 147                   (math-compose-expr (nth 1 a) prec)
 148                 (list 'horiz "("
 149                       (math-compose-expr (nth 1 a) 0)
 150                       (if (eq (car a) 'cplx) ", " "; ")
 151                       (math-compose-expr (nth 2 a) 0) ")"))
 152             (if (or (= calc-number-radix 10)
 153                     (not (Math-realp a))
 154                     (and calc-group-digits
 155                          (not (assoc calc-group-char '((",") (" "))))))
 156                 (math-format-number a prec)
 157               (let ((s (math-format-number a prec))
 158                     (c nil))
 159                 (while (string-match (if (> calc-number-radix 14)
 160                                          "\\([0-9]+\\)#\\([0-9a-zA-Z., ]+\\)"
 161                                        "\\([0-9]+\\)#\\([0-9a-dA-D., ]+\\)")
 162                                      s)
 163                   (setq c (nconc c (list (substring s 0 (match-beginning 0))
 164                                          (list 'subscr
 165                                                (math-match-substring s 2)
 166                                                (math-match-substring s 1))))
 167                         s (substring s (match-end 0))))
 168                 (if (string-match
 169                      "\\*\\([0-9.]+\\)\\^\\(-?[0-9]+\\)\\()?\\)\\'" s)
 170                     (setq s (list 'horiz
 171                                   (substring s 0 (match-beginning 0)) " "
 172                                   (list 'supscr
 173                                         (math-match-substring s 1)
 174                                         (math-match-substring s 2))
 175                                   (math-match-substring s 3))))
 176                 (if c (cons 'horiz (nconc c (list s))) s)))))))
 177      ((and (get (car a) 'math-compose-forms)
 178            (not (eq calc-language 'unform))
 179            (let ((comps (get (car a) 'math-compose-forms))
 180                  temp temp2)
 181              (or (and (setq temp (assq calc-language comps))
 182                       (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
 183                                (setq temp (apply (cdr temp2) (cdr a)))
 184                                (math-compose-expr temp prec))
 185                           (and (setq temp2 (assq nil (cdr temp)))
 186                                (funcall (cdr temp2) a))))
 187                  (and (setq temp (assq nil comps))
 188                       (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
 189                                (setq temp (apply (cdr temp2) (cdr a)))
 190                                (math-compose-expr temp prec))
 191                           (and (setq temp2 (assq nil (cdr temp)))
 192                                (funcall (cdr temp2) a))))))))
 193      ((eq (car a) 'vec)
 194       (let* ((math-comp-left-bracket (if calc-vector-brackets
 195                                (substring calc-vector-brackets 0 1) ""))
 196              (math-comp-right-bracket (if calc-vector-brackets
 197                                 (substring calc-vector-brackets 1 2) ""))
 198              (inner-brackets (memq 'R calc-matrix-brackets))
 199              (outer-brackets (memq 'O calc-matrix-brackets))
 200              (row-commas (memq 'C calc-matrix-brackets))
 201              (math-comp-comma-spc (or calc-vector-commas " "))
 202              (math-comp-comma (or calc-vector-commas ""))
 203              (math-comp-vector-prec (if (or (and calc-vector-commas
 204                                        (math-vector-no-parens a))
 205                                   (memq 'P calc-matrix-brackets)) 0 1000))
 206              (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
 207                                       ((eq calc-matrix-just 'center) 'vcent)
 208                                       (t 'vleft)))
 209              (break calc-break-vectors))
 210         (if (and (memq calc-language '(nil big))
 211                  (not calc-break-vectors)
 212                  (math-matrixp a) (not (math-matrixp (nth 1 a)))
 213                  (or calc-full-vectors
 214                      (and (< (length a) 7) (< (length (nth 1 a)) 7))
 215                      (progn (setq break t) nil)))
 216             (if (progn
 217                   (setq math-comp-vector-prec (if (or (and calc-vector-commas
 218                                                            (math-vector-no-parens
 219                                                             (nth 1 a)))
 220                                                       (memq 'P calc-matrix-brackets))
 221                                                   0 1000))
 222                   (= (length a) 2))
 223                 (list 'horiz
 224                       (concat math-comp-left-bracket math-comp-left-bracket " ")
 225                       (math-compose-vector (cdr (nth 1 a)) (concat math-comp-comma " ")
 226                                            math-comp-vector-prec)
 227                       (concat " " math-comp-right-bracket math-comp-right-bracket))
 228               (let* ((rows (1- (length a)))
 229                      (cols (1- (length (nth 1 a))))
 230                      (base (/ (1- rows) 2))
 231                      (calc-language 'flat))
 232                 (append '(horiz)
 233                         (list (append '(vleft)
 234                                       (list base)
 235                                       (list (concat (and outer-brackets
 236                                                          (concat math-comp-left-bracket
 237                                                                  " "))
 238                                                     (and inner-brackets
 239                                                          (concat math-comp-left-bracket
 240                                                                  " "))))
 241                                       (make-list (1- rows)
 242                                                  (concat (and outer-brackets
 243                                                               "  ")
 244                                                          (and inner-brackets
 245                                                               (concat
 246                                                                math-comp-left-bracket
 247                                                                " "))))))
 248                         (math-compose-matrix (cdr a) 1 cols base)
 249                         (list (append '(vleft)
 250                                       (list base)
 251                                       (make-list (1- rows)
 252                                                  (if inner-brackets
 253                                                      (concat " "
 254                                                              math-comp-right-bracket
 255                                                              (and row-commas
 256                                                                   math-comp-comma))
 257                                                    (if (and outer-brackets
 258                                                             row-commas)
 259                                                        ";" "")))
 260                                       (list (concat
 261                                              (and inner-brackets
 262                                                   (concat " "
 263                                                           math-comp-right-bracket))
 264                                              (and outer-brackets
 265                                                   (concat
 266                                                    " "
 267                                                    math-comp-right-bracket)))))))))
 268           (if (and calc-display-strings
 269                    (cdr a)
 270                    (math-vector-is-string a))
 271               (math-vector-to-string a t)
 272             (if (and break (cdr a)
 273                      (not (eq calc-language 'flat)))
 274                 (let* ((full (or calc-full-vectors (< (length a) 7)))
 275                        (rows (if full (1- (length a)) 5))
 276                        (base (/ (1- rows) 2))
 277                        (calc-break-vectors nil))
 278                   (list 'horiz
 279                         (cons 'vleft (cons base
 280                                            (math-compose-rows
 281                                             (cdr a)
 282                                             (if full rows 3) t)))))
 283               (if (or calc-full-vectors (< (length a) 7))
 284                   (if (and
 285                        (setq spfn (get calc-language 'math-matrix-formatter))
 286                        (math-matrixp a))
 287                       (funcall spfn a)
 288                     (list 'horiz
 289                           math-comp-left-bracket
 290                           (math-compose-vector (cdr a)
 291                                                (concat math-comp-comma " ")
 292                                                math-comp-vector-prec)
 293                           math-comp-right-bracket))
 294                 (list 'horiz
 295                       math-comp-left-bracket
 296                       (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
 297                                            (concat math-comp-comma " ")
 298                                            math-comp-vector-prec)
 299                       math-comp-comma
 300                       (if (setq spfn (get calc-language 'math-dots))
 301                           (concat " " spfn)
 302                         " ...")
 303                       math-comp-comma " "
 304                       (list 'break math-compose-level)
 305                       (math-compose-expr (nth (1- (length a)) a)
 306                                          (if (equal math-comp-comma "") 1000 0))
 307                       math-comp-right-bracket)))))))
 308      ((eq (car a) 'incomplete)
 309       (if (cdr (cdr a))
 310           (cond ((eq (nth 1 a) 'vec)
 311                  (list 'horiz "["
 312                        (math-compose-vector (cdr (cdr a)) ", " 0)
 313                        " ..."))
 314                 ((eq (nth 1 a) 'cplx)
 315                  (list 'horiz "("
 316                        (math-compose-vector (cdr (cdr a)) ", " 0)
 317                        ", ..."))
 318                 ((eq (nth 1 a) 'polar)
 319                  (list 'horiz "("
 320                        (math-compose-vector (cdr (cdr a)) "; " 0)
 321                        "; ..."))
 322                 ((eq (nth 1 a) 'intv)
 323                  (list 'horiz
 324                        (if (memq (nth 2 a) '(0 1)) "(" "[")
 325                        (math-compose-vector (cdr (cdr (cdr a))) " .. " 0)
 326                        " .. ..."))
 327                 (t (format "%s" a)))
 328         (cond ((eq (nth 1 a) 'vec) "[ ...")
 329               ((eq (nth 1 a) 'intv)
 330                (if (memq (nth 2 a) '(0 1)) "( ..." "[ ..."))
 331               (t "( ..."))))
 332      ((eq (car a) 'var)
 333       (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
 334         (if v
 335             (symbol-name (car v))
 336           (if (setq spfn (get calc-language 'math-var-formatter))
 337               (funcall spfn a prec)
 338             (math-compose-var a)))))
 339      ((eq (car a) 'intv)
 340       (list 'horiz
 341             (if (memq (nth 1 a) '(0 1)) "(" "[")
 342             (math-compose-expr (nth 2 a) 0)
 343             " .. "
 344             (math-compose-expr (nth 3 a) 0)
 345             (if (memq (nth 1 a) '(0 2)) ")" "]")))
 346      ((eq (car a) 'date)
 347       (if (eq (car calc-date-format) 'X)
 348           (math-format-date a)
 349         (concat "<" (math-format-date a) ">")))
 350      ((and (eq (car a) 'calcFunc-subscr)
 351            (setq spfn (get calc-language 'math-compose-subscr)))
 352       (funcall spfn a))
 353      ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3)
 354            (eq calc-language 'big))
 355       (let* ((a1 (math-compose-expr (nth 1 a) 1000))
 356              (calc-language 'flat)
 357              (a2 (math-compose-expr (nth 2 a) 0)))
 358         (if (or (eq (car-safe a1) 'subscr)
 359                 (and (eq (car-safe a1) 'tag)
 360                      (eq (car-safe (nth 2 a1)) 'subscr)
 361                      (setq a1 (nth 2 a1))))
 362             (list 'subscr
 363                   (nth 1 a1)
 364                   (list 'horiz
 365                         (nth 2 a1)
 366                         ", "
 367                         a2))
 368           (list 'subscr a1 a2))))
 369      ((and (eq (car a) '^)
 370            (eq calc-language 'big))
 371       (list 'supscr
 372             (if (or (math-looks-negp (nth 1 a))
 373                     (memq (car-safe (nth 1 a)) '(^ / frac calcFunc-sqrt))
 374                     (and (eq (car-safe (nth 1 a)) 'cplx)
 375                          (math-negp (nth 1 (nth 1 a)))
 376                          (eq (nth 2 (nth 1 a)) 0)))
 377                 (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
 378               (math-compose-expr (nth 1 a) 201))
 379             (let ((calc-language 'flat)
 380                   (calc-number-radix 10))
 381               (math-compose-expr (nth 2 a) 0))))
 382      ((and (eq (car a) '/)
 383            (eq calc-language 'big))
 384       (let ((a1 (let ((calc-language (if (memq (car-safe (nth 1 a)) '(/ frac))
 385                                          'flat 'big)))
 386                   (math-compose-expr (nth 1 a) 0)))
 387             (a2 (let ((calc-language (if (memq (car-safe (nth 2 a)) '(/ frac))
 388                                          'flat 'big)))
 389                   (math-compose-expr (nth 2 a) 0))))
 390         (list 'vcent
 391               (math-comp-height a1)
 392               a1 '(rule ?-) a2)))
 393      ((and (eq (car a) 'calcFunc-lambda)
 394            (> (length a) 2)
 395            (memq calc-language '(nil flat big)))
 396       (let ((p (cdr a))
 397             (ap calc-arg-values)
 398             (math-compose-hash-args (if (= (length a) 3) 1 t)))
 399         (while (and (cdr p) (equal (car p) (car ap)))
 400           (setq p (cdr p) ap (cdr ap)))
 401         (append '(horiz "<")
 402                 (if (cdr p)
 403                     (list (math-compose-vector
 404                            (nreverse (cdr (reverse (cdr a)))) ", " 0)
 405                           " : ")
 406                   nil)
 407                 (list (math-compose-expr (nth (1- (length a)) a) 0)
 408                       ">"))))
 409      ((and (eq (car a) 'calcFunc-string)
 410            (= (length a) 2)
 411            (math-vectorp (nth 1 a))
 412            (math-vector-is-string (nth 1 a)))
 413       (if (eq calc-language 'unform)
 414           (concat "string(" (math-vector-to-string (nth 1 a) t) ")")
 415         (math-vector-to-string (nth 1 a) nil)))
 416      ((and (eq (car a) 'calcFunc-bstring)
 417            (= (length a) 2)
 418            (math-vectorp (nth 1 a))
 419            (math-vector-is-string (nth 1 a)))
 420       (if (eq calc-language 'unform)
 421           (concat "bstring(" (math-vector-to-string (nth 1 a) t) ")")
 422         (let ((c nil)
 423               (s (math-vector-to-string (nth 1 a) nil))
 424               p)
 425           (while (string-match "[^ ] +[^ ]" s)
 426             (setq p (1- (match-end 0))
 427                   c (cons (list 'break math-compose-level)
 428                           (cons (substring s 0 p)
 429                                 c))
 430                   s (substring s p)))
 431           (setq c (nreverse (cons s c)))
 432           (or (= prec -123)
 433               (setq c (cons (list 'set math-compose-level 2) c)))
 434           (cons 'horiz c))))
 435      ((and (eq (car a) 'calcFunc-cprec)
 436            (not (eq calc-language 'unform))
 437            (= (length a) 3)
 438            (integerp (nth 2 a)))
 439       (let ((c (math-compose-expr (nth 1 a) -1)))
 440         (if (> prec (nth 2 a))
 441             (if (setq spfn (get calc-language 'math-big-parens))
 442                 (list 'horiz (car spfn) c (cdr spfn))
 443               (list 'horiz "(" c ")"))
 444           c)))
 445      ((and (eq (car a) 'calcFunc-choriz)
 446            (not (eq calc-language 'unform))
 447            (memq (length a) '(2 3 4))
 448            (math-vectorp (nth 1 a))
 449            (if (integerp (nth 2 a))
 450                (or (null (nth 3 a))
 451                    (and (math-vectorp (nth 3 a))
 452                         (math-vector-is-string (nth 3 a))))
 453              (or (null (nth 2 a))
 454                  (and (math-vectorp (nth 2 a))
 455                       (math-vector-is-string (nth 2 a))))))
 456       (let* ((cprec (and (integerp (nth 2 a)) (nth 2 a)))
 457              (sep (nth (if cprec 3 2) a))
 458              (bprec nil))
 459         (if sep
 460             (math-compose-vector (cdr (nth 1 a))
 461                                  (math-vector-to-string sep nil)
 462                                  (or cprec prec))
 463           (cons 'horiz (mapcar (function
 464                                 (lambda (x)
 465                                   (if (eq (car-safe x) 'calcFunc-bstring)
 466                                       (prog1
 467                                           (math-compose-expr
 468                                            x (or bprec cprec prec))
 469                                         (setq bprec -123))
 470                                     (math-compose-expr x (or cprec prec)))))
 471                                (cdr (nth 1 a)))))))
 472      ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
 473            (not (eq calc-language 'unform))
 474            (memq (length a) '(2 3))
 475            (math-vectorp (nth 1 a))
 476            (or (null (nth 2 a))
 477                (integerp (nth 2 a))))
 478       (let* ((base 0)
 479              (v 0)
 480              (prec (or (nth 2 a) prec))
 481              (c (mapcar (function
 482                          (lambda (x)
 483                            (let ((b nil) (cc nil) a d)
 484                              (if (and (memq (car-safe x) '(calcFunc-cbase
 485                                                            calcFunc-ctbase
 486                                                            calcFunc-cbbase))
 487                                       (memq (length x) '(1 2)))
 488                                  (setq b (car x)
 489                                        x (nth 1 x)))
 490                              (if (and (eq (car-safe x) 'calcFunc-crule)
 491                                       (memq (length x) '(1 2))
 492                                       (or (null (nth 1 x))
 493                                           (and (math-vectorp (nth 1 x))
 494                                                (= (length (nth 1 x)) 2)
 495                                                (math-vector-is-string
 496                                                 (nth 1 x)))
 497                                           (and (natnump (nth 1 x))
 498                                                (<= (nth 1 x) 255))))
 499                                  (setq cc (list
 500                                            'rule
 501                                            (if (math-vectorp (nth 1 x))
 502                                                (aref (math-vector-to-string
 503                                                       (nth 1 x) nil) 0)
 504                                              (or (nth 1 x) ?-))))
 505                                (or (and (memq (car-safe x) '(calcFunc-cvspace
 506                                                              calcFunc-ctspace
 507                                                              calcFunc-cbspace))
 508                                         (memq (length x) '(2 3))
 509                                         (eq (nth 1 x) 0))
 510                                    (null x)
 511                                    (setq cc (math-compose-expr x prec))))
 512                              (setq a (if cc (math-comp-ascent cc) 0)
 513                                    d (if cc (math-comp-descent cc) 0))
 514                              (if (eq b 'calcFunc-cbase)
 515                                  (setq base (+ v a -1))
 516                                (if (eq b 'calcFunc-ctbase)
 517                                    (setq base v)
 518                                  (if (eq b 'calcFunc-cbbase)
 519                                      (setq base (+ v a d -1)))))
 520                              (setq v (+ v a d))
 521                              cc)))
 522                         (cdr (nth 1 a)))))
 523         (setq c (delq nil c))
 524         (if c
 525             (cons (if (eq (car a) 'calcFunc-cvert) 'vcent
 526                     (if (eq (car a) 'calcFunc-clvert) 'vleft 'vright))
 527                   (cons base c))
 528           " ")))
 529      ((and (memq (car a) '(calcFunc-csup calcFunc-csub))
 530            (not (eq calc-language 'unform))
 531            (memq (length a) '(3 4))
 532            (or (null (nth 3 a))
 533                (integerp (nth 3 a))))
 534       (list (if (eq (car a) 'calcFunc-csup) 'supscr 'subscr)
 535             (math-compose-expr (nth 1 a) (or (nth 3 a) 0))
 536             (math-compose-expr (nth 2 a) 0)))
 537      ((and (eq (car a) 'calcFunc-cflat)
 538            (not (eq calc-language 'unform))
 539            (memq (length a) '(2 3))
 540            (or (null (nth 2 a))
 541                (integerp (nth 2 a))))
 542       (let ((calc-language (if (memq calc-language '(nil big))
 543                                'flat calc-language)))
 544         (math-compose-expr (nth 1 a) (or (nth 2 a) 0))))
 545      ((and (eq (car a) 'calcFunc-cspace)
 546            (memq (length a) '(2 3))
 547            (natnump (nth 1 a)))
 548       (if (nth 2 a)
 549           (cons 'horiz (make-list (nth 1 a)
 550                                   (if (and (math-vectorp (nth 2 a))
 551                                            (math-vector-is-string (nth 2 a)))
 552                                       (math-vector-to-string (nth 2 a) nil)
 553                                     (math-compose-expr (nth 2 a) 0))))
 554         (make-string (nth 1 a) ?\ )))
 555      ((and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
 556            (memq (length a) '(2 3))
 557            (natnump (nth 1 a)))
 558       (if (= (nth 1 a) 0)
 559           ""
 560         (let* ((c (if (nth 2 a)
 561                       (if (and (math-vectorp (nth 2 a))
 562                                (math-vector-is-string (nth 2 a)))
 563                           (math-vector-to-string (nth 2 a) nil)
 564                         (math-compose-expr (nth 2 a) 0))
 565                     " "))
 566                (ca (math-comp-ascent c))
 567                (cd (math-comp-descent c)))
 568           (cons 'vleft
 569                 (cons (if (eq (car a) 'calcFunc-ctspace)
 570                           (1- ca)
 571                         (if (eq (car a) 'calcFunc-cbspace)
 572                             (+ (* (1- (nth 1 a)) (+ ca cd)) (1- ca))
 573                           (/ (1- (* (nth 1 a) (+ ca cd))) 2)))
 574                       (make-list (nth 1 a) c))))))
 575      ((and (eq (car a) 'calcFunc-evalto)
 576            (setq calc-any-evaltos t)
 577            (setq spfn (get calc-language 'math-evalto))
 578            (= math-compose-level (if math-comp-tagged 2 1))
 579            (= (length a) 3))
 580       (list 'horiz
 581             (car spfn)
 582             (math-compose-expr (nth 1 a) 0)
 583             (cdr spfn)
 584             (math-compose-expr (nth 2 a) 0)))
 585      (t
 586       (let ((op (and (not (eq calc-language 'unform))
 587                      (if (and (eq (car a) 'calcFunc-if) (= (length a) 4))
 588                          (assoc "?" math-expr-opers)
 589                        (math-assq2 (car a) math-expr-opers)))))
 590         (cond ((and op
 591                     (or (= (length a) 3) (eq (car a) 'calcFunc-if))
 592                     (/= (nth 3 op) -1))
 593                (cond
 594                 ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
 595                  (if (and (memq calc-language '(tex latex))
 596                           (not (math-tex-expr-is-flat a)))
 597                      (if (eq (car-safe a) '/)
 598                          (list 'horiz "{" (math-compose-expr a -1) "}")
 599                        (list 'horiz "\\left( "
 600                              (math-compose-expr a -1)
 601                              " \\right)"))
 602                    (if (eq calc-language 'eqn)
 603                        (if (or (eq (car-safe a) '/)
 604                                (= (/ prec 100) 9))
 605                            (list 'horiz "{" (math-compose-expr a -1) "}")
 606                          (if (math-tex-expr-is-flat a)
 607                              (list 'horiz "( " (math-compose-expr a -1) " )")
 608                            (list 'horiz "{left ( "
 609                                  (math-compose-expr a -1)
 610                                  " right )}")))
 611                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 612                 ((and (memq calc-language '(tex latex))
 613                       (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
 614                       (>= prec 0))
 615                  (list 'horiz "{" (math-compose-expr a -1) "}"))
 616                 ((eq (car a) 'calcFunc-if)
 617                  (list 'horiz
 618                        (math-compose-expr (nth 1 a) (nth 2 op))
 619                        " ? "
 620                        (math-compose-expr (nth 2 a) 0)
 621                        " : "
 622                        (math-compose-expr (nth 3 a) (nth 3 op))))
 623                 (t
 624                  (let* ((math-comp-tagged (and math-comp-tagged
 625                                                (not (math-primp a))
 626                                                math-comp-tagged))
 627                         (setlev (if (= prec (min (nth 2 op) (nth 3 op)))
 628                                     (progn
 629                                       (setq math-compose-level
 630                                             (1- math-compose-level))
 631                                       nil)
 632                                   math-compose-level))
 633                         (lhs (math-compose-expr (nth 1 a) (nth 2 op)))
 634                         (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
 635                    (and (equal (car op) "^")
 636                         (eq (math-comp-first-char lhs) ?-)
 637                         (setq lhs (list 'horiz "(" lhs ")")))
 638                    (and (memq calc-language '(tex latex))
 639                         (or (equal (car op) "^") (equal (car op) "_"))
 640                         (not (and (stringp rhs) (= (length rhs) 1)))
 641                         (setq rhs (list 'horiz "{" rhs "}")))
 642                    (or (and (eq (car a) '*)
 643                             (or (null calc-language)
 644                                 (assoc "2x" math-expr-opers))
 645                             (let* ((prevt (math-prod-last-term (nth 1 a)))
 646                                    (nextt (math-prod-first-term (nth 2 a)))
 647                                    (prevc (or (math-comp-last-char lhs)
 648                                               (and (memq (car-safe prevt)
 649                                                          '(^ calcFunc-subscr
 650                                                              calcFunc-sqrt
 651                                                              frac))
 652                                                    (eq calc-language 'big)
 653                                                    ?0)))
 654                                    (nextc (or (math-comp-first-char rhs)
 655                                               (and (memq (car-safe nextt)
 656                                                          '(calcFunc-sqrt
 657                                                            calcFunc-sum
 658                                                            calcFunc-prod
 659                                                            calcFunc-integ))
 660                                                    (eq calc-language 'big)
 661                                                    ?0))))
 662                               (and prevc nextc
 663                                    (or (and (>= nextc ?a) (<= nextc ?z))
 664                                        (and (>= nextc ?A) (<= nextc ?Z))
 665                                        (and (>= nextc ?0) (<= nextc ?9))
 666                                        (memq nextc '(?. ?_ ?#
 667                                                         ?\( ?\[ ?\{))
 668                                        (and (eq nextc ?\\)
 669                                             (not (string-match
 670                                                   "\\`\\\\left("
 671                                                   (math-comp-first-string
 672                                                    rhs)))))
 673                                    (not (and (eq (car-safe prevt) 'var)
 674                                              (eq nextc ?\()))
 675                                    (list 'horiz
 676                                          (list 'set setlev 1)
 677                                          lhs
 678                                          (list 'break math-compose-level)
 679                                          " "
 680                                          rhs))))
 681                        (list 'horiz
 682                              (list 'set setlev 1)
 683                              lhs
 684                              (list 'break math-compose-level)
 685                              (if (or (equal (car op) "^")
 686                                      (equal (car op) "_")
 687                                      (equal (car op) "**")
 688                                      (and (equal (car op) "*")
 689                                           (math-comp-last-char lhs)
 690                                           (math-comp-first-char rhs))
 691                                      (and (equal (car op) "/")
 692                                           (math-num-integerp (nth 1 a))
 693                                           (math-integerp (nth 2 a))))
 694                                  (car op)
 695                                (if (and (eq calc-language 'big)
 696                                         (equal (car op) "=>"))
 697                                    "  =>  "
 698                                  (concat " " (car op) " ")))
 699                              rhs))))))
 700               ((and op (= (length a) 2) (= (nth 3 op) -1))
 701                (cond
 702                 ((or (> prec (or (nth 4 op) (nth 2 op)))
 703                      (and (not (eq (assoc (car op) math-expr-opers) op))
 704                           (> prec 0)))   ; don't write x% + y
 705                  (if (and (memq calc-language '(tex latex))
 706                           (not (math-tex-expr-is-flat a)))
 707                      (list 'horiz "\\left( "
 708                            (math-compose-expr a -1)
 709                            " \\right)")
 710                    (if (eq calc-language 'eqn)
 711                        (if (= (/ prec 100) 9)
 712                            (list 'horiz "{" (math-compose-expr a -1) "}")
 713                          (if (math-tex-expr-is-flat a)
 714                              (list 'horiz "{( " (math-compose-expr a -1) " )}")
 715                            (list 'horiz "{left ( "
 716                                  (math-compose-expr a -1)
 717                                  " right )}")))
 718                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 719                 (t
 720                  (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
 721                  (list 'horiz
 722                        lhs
 723                        (if (or (> (length (car op)) 1)
 724                                (not (math-comp-is-flat lhs)))
 725                            (concat " " (car op))
 726                          (car op)))))))
 727               ((and op (= (length a) 2) (= (nth 2 op) -1))
 728                (cond
 729                 ((eq (nth 3 op) 0)
 730                  (let ((lr (and (memq calc-language '(tex latex))
 731                                 (not (math-tex-expr-is-flat (nth 1 a))))))
 732                    (list 'horiz
 733                          (if lr "\\left" "")
 734                          (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
 735                              (substring (car op) 1)
 736                            (car op))
 737                          (if (or lr (> (length (car op)) 2)) " " "")
 738                          (math-compose-expr (nth 1 a) -1)
 739                          (if (or lr (> (length (car op)) 2)) " " "")
 740                          (if lr "\\right" "")
 741                          (car (nth 1 (memq op math-expr-opers))))))
 742                 ((> prec (or (nth 4 op) (nth 3 op)))
 743                  (if (and (memq calc-language '(tex latex))
 744                           (not (math-tex-expr-is-flat a)))
 745                      (list 'horiz "\\left( "
 746                            (math-compose-expr a -1)
 747                            " \\right)")
 748                    (if (eq calc-language 'eqn)
 749                        (if (= (/ prec 100) 9)
 750                            (list 'horiz "{" (math-compose-expr a -1) "}")
 751                          (if (math-tex-expr-is-flat a)
 752                              (list 'horiz "{( " (math-compose-expr a -1) " )}")
 753                            (list 'horiz "{left ( "
 754                                  (math-compose-expr a -1)
 755                                  " right )}")))
 756                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 757                 (t
 758                  (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
 759                    (list 'horiz
 760                          (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
 761                                                       (car op))
 762                                         (substring (car op) 1)
 763                                       (car op))))
 764                            (if (or (> (length ops) 1)
 765                                    (not (math-comp-is-flat rhs)))
 766                                (concat ops " ")
 767                              ops))
 768                          rhs)))))
 769               ((and (eq calc-language 'big)
 770                     (setq op (get (car a) 'math-compose-big))
 771                     (funcall op a prec)))
 772               ((and (setq op (assq calc-language
 773                                    '( ( nil . math-compose-normal )
 774                                       ( flat . math-compose-normal )
 775                                       ( big . math-compose-normal )
 776                                       ( c . math-compose-c )
 777                                       ( pascal . math-compose-pascal )
 778                                       ( fortran . math-compose-fortran )
 779                                       ( tex . math-compose-tex )
 780                                       ( latex . math-compose-latex )
 781                                       ( eqn . math-compose-eqn )
 782                                       ( yacas . math-compose-yacas )
 783                                       ( maxima . math-compose-maxima )
 784                                       ( giac . math-compose-giac )
 785                                       ( math . math-compose-math )
 786                                       ( maple . math-compose-maple ))))
 787                     (setq op (get (car a) (cdr op)))
 788                     (funcall op a prec)))
 789               (t
 790                (let* ((func (car a))
 791                       (func2 (assq func '(( mod . calcFunc-makemod )
 792                                           ( sdev . calcFunc-sdev )
 793                                           ( + . calcFunc-add )
 794                                           ( - . calcFunc-sub )
 795                                           ( * . calcFunc-mul )
 796                                           ( / . calcFunc-div )
 797                                           ( % . calcFunc-mod )
 798                                           ( ^ . calcFunc-pow )
 799                                           ( neg . calcFunc-neg )
 800                                           ( | . calcFunc-vconcat ))))
 801                       left right args)
 802                  (if func2
 803                      (setq func (cdr func2)))
 804                  (if (setq func2 (rassq func math-expr-function-mapping))
 805                      (setq func (car func2)))
 806                  (setq func (math-remove-dashes
 807                              (if (string-match
 808                                   "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
 809                                   (symbol-name func))
 810                                  (math-match-substring (symbol-name func) 1)
 811                                (symbol-name func))))
 812                  (if (memq calc-language calc-lang-allow-percentsigns)
 813                      (setq func (math-to-percentsigns func)))
 814                  (if (memq calc-language calc-lang-allow-underscores)
 815                      (setq func (math-to-underscores func)))
 816                  (if (setq spfn (get calc-language 'math-func-formatter))
 817                      (funcall spfn func a)
 818
 819                    (list 'horiz func calc-function-open
 820                        (math-compose-vector (cdr a) ", " 0)
 821                        calc-function-close))))))))))
 822
 823
 824 (defun math-prod-first-term (x)
 825   (while (eq (car-safe x) '*)
 826     (setq x (nth 1 x)))
 827   x)
 828
 829 (defun math-prod-last-term (x)
 830   (while (eq (car-safe x) '*)
 831     (setq x (nth 2 x)))
 832   x)
 833
 834 (defun math-compose-vector (a sep prec)
 835   (if a
 836       (cons 'horiz
 837             (cons (list 'set math-compose-level)
 838                   (let ((c (list (math-compose-expr (car a) prec))))
 839                     (while (setq a (cdr a))
 840                       (setq c (cons (if (eq (car-safe (car a))
 841                                             'calcFunc-bstring)
 842                                         (let ((math-compose-level
 843                                                (1- math-compose-level)))
 844                                           (math-compose-expr (car a) -123))
 845                                       (math-compose-expr (car a) prec))
 846                                     (cons (list 'break math-compose-level)
 847                                           (cons sep c)))))
 848                     (nreverse c))))
 849     ""))
 850
 851 (defun math-vector-no-parens (a)
 852   (or (cdr (cdr a))
 853       (not (eq (car-safe (nth 1 a)) '*))))
 854
 855 (defun math-compose-matrix (a col cols base)
 856   (let ((col 0)
 857         (res nil))
 858     (while (<= (setq col (1+ col)) cols)
 859       (setq res (cons (cons math-comp-just
 860                             (cons base
 861                                   (mapcar (function
 862                                            (lambda (r)
 863                                              (list 'horiz
 864                                                    (math-compose-expr
 865                                                     (nth col r)
 866                                                     math-comp-vector-prec)
 867                                                    (if (= col cols)
 868                                                        ""
 869                                                      (concat
 870                                                       math-comp-comma-spc " ")))))
 871                                           a)))
 872                       res)))
 873     (nreverse res)))
 874
 875 (defun math-compose-rows (a count first)
 876   (if (cdr a)
 877       (if (<= count 0)
 878           (if (< count 0)
 879               (math-compose-rows (cdr a) -1 nil)
 880             (cons (concat
 881                    (let ((mdots (get calc-language 'math-dots)))
 882                      (if mdots
 883                          (concat " " mdots)
 884                        "  ..."))
 885                    math-comp-comma)
 886                   (math-compose-rows (cdr a) -1 nil)))
 887         (cons (list 'horiz
 888                     (if first (concat math-comp-left-bracket " ") "  ")
 889                     (math-compose-expr (car a) math-comp-vector-prec)
 890                     math-comp-comma)
 891               (math-compose-rows (cdr a) (1- count) nil)))
 892     (list (list 'horiz
 893                 (if first (concat math-comp-left-bracket " ") "  ")
 894                 (math-compose-expr (car a) math-comp-vector-prec)
 895                 (concat " " math-comp-right-bracket)))))
 896
 897 (defun math-vector-is-string (a)
 898   (while (and (setq a (cdr a))
 899               (or (and (natnump (car a))
 900                        (<= (car a) 255))
 901                   (and (eq (car-safe (car a)) 'cplx)
 902                        (natnump (nth 1 (car a)))
 903                        (eq (nth 2 (car a)) 0)
 904                        (<= (nth 1 (car a)) 255)))))
 905   (null a))
 906
 907 (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
 908                                          ( ?\\ . "\\\\" )
 909                                          ( ?\a . "\\a" )
 910                                          ( ?\b . "\\b" )
 911                                          ( ?\e . "\\e" )
 912                                          ( ?\f . "\\f" )
 913                                          ( ?\n . "\\n" )
 914                                          ( ?\r . "\\r" )
 915                                          ( ?\t . "\\t" )
 916                                          ( ?\^? . "\\^?" )))
 917
 918 (defun math-vector-to-string (a &optional quoted)
 919   (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
 920                           (cdr a))))
 921   (if (string-match "[\000-\037\177\\\"]" a)
 922       (let ((p 0)
 923             (pat (if quoted "[\000-\037\177\\\"]" "[\000-\037\177]"))
 924             (codes (if quoted math-vector-to-string-chars '((?\^? . "^?"))))
 925             (fmt (if quoted "\\^%c" "^%c"))
 926             new)
 927         (while (setq p (string-match pat a p))
 928           (if (setq new (assq (aref a p) codes))
 929               (setq a (concat (substring a 0 p)
 930                               (cdr new)
 931                               (substring a (1+ p)))
 932                     p (+ p (length (cdr new))))
 933             (setq a (concat (substring a 0 p)
 934                             (format fmt (+ (aref a p) 64))
 935                             (substring a (1+ p)))
 936                   p (+ p 2))))))
 937   (if quoted
 938       (concat "\"" a "\"")
 939     a))
 940
 941
 942 (defun math-to-underscores (x)
 943   (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
 944       (math-to-underscores
 945        (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
 946     x))
 947
 948 (defun math-to-percentsigns (x)
 949   (if (string-match "\\`\\(.*\\)o'o\\(.*\\)\\'" x)
 950       (math-to-underscores
 951        (concat (math-match-substring x 1) "%" (math-match-substring x 2)))
 952     x))
 953
 954 (defun math-tex-expr-is-flat (a)
 955   (or (Math-integerp a)
 956       (memq (car a) '(float var))
 957       (and (memq (car a) '(+ - * neg))
 958            (progn
 959              (while (and (setq a (cdr a))
 960                          (math-tex-expr-is-flat (car a))))
 961              (null a)))
 962       (and (memq (car a) '(^ calcFunc-subscr))
 963            (math-tex-expr-is-flat (nth 1 a)))))
 964
 965 (put 'calcFunc-log 'math-compose-big 'math-compose-log)
 966 (defun math-compose-log (a prec)
 967   (and (= (length a) 3)
 968        (list 'horiz
 969              (list 'subscr "log"
 970                    (let ((calc-language 'flat))
 971                      (math-compose-expr (nth 2 a) 1000)))
 972              "("
 973              (math-compose-expr (nth 1 a) 1000)
 974              ")")))
 975
 976 (put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
 977 (defun math-compose-log10 (a prec)
 978   (and (= (length a) 2)
 979        (list 'horiz
 980              (list 'subscr "log" "10")
 981              "("
 982              (math-compose-expr (nth 1 a) 1000)
 983              ")")))
 984
 985 (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
 986 (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
 987 (defun math-compose-deriv (a prec)
 988   (when (= (length a) 3)
 989     (math-compose-expr (list '/
 990                              (list 'calcFunc-choriz
 991                                    (list 'vec
 992                                          '(calcFunc-string (vec ?d))
 993                                          (nth 1 a)))
 994                              (list 'calcFunc-choriz
 995                                    (list 'vec
 996                                          '(calcFunc-string (vec ?d))
 997                                          (nth 2 a))))
 998                        prec)))
 999
1000 (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
1001 (defun math-compose-sqrt (a prec)
1002   (when (= (length a) 2)
1003     (let* ((c (math-compose-expr (nth 1 a) 0))
1004            (a (math-comp-ascent c))
1005            (d (math-comp-descent c))
1006            (h (+ a d))
1007            (w (math-comp-width c)))
1008       (list 'vleft
1009             a
1010             (concat (if (= h 1) " " "  ")
1011                     (make-string (+ w 2) ?\_))
1012             (list 'horiz
1013                   (if (= h 1)
1014                       "V"
1015                     (append (list 'vleft (1- a))
1016                             (make-list (1- h) " |")
1017                             '("\\|")))
1018                   " "
1019                   c)))))
1020
1021 (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
1022 (defun math-compose-choose (a prec)
1023   (let ((a1 (math-compose-expr (nth 1 a) 0))
1024         (a2 (math-compose-expr (nth 2 a) 0)))
1025     (list 'horiz
1026           "("
1027           (list 'vcent
1028                 (math-comp-height a1)
1029                 a1 " " a2)
1030           ")")))
1031
1032 (put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
1033 (defun math-compose-integ (a prec)
1034   (and (memq (length a) '(3 5))
1035        (eq (car-safe (nth 2 a)) 'var)
1036        (let* ((parens (and (>= prec 196) (/= prec 1000)))
1037               (var (math-compose-expr (nth 2 a) 0))
1038               (over (and (eq (car-safe (nth 2 a)) 'var)
1039                          (or (and (eq (car-safe (nth 1 a)) '/)
1040                                   (math-numberp (nth 1 (nth 1 a))))
1041                              (and (eq (car-safe (nth 1 a)) '^)
1042                                   (math-looks-negp (nth 2 (nth 1 a)))))))
1043               (expr (math-compose-expr (if over
1044                                            (math-mul (nth 1 a)
1045                                                      (math-build-var-name
1046                                                       (format
1047                                                        "d%s"
1048                                                        (nth 1 (nth 2 a)))))
1049                                          (nth 1 a)) 185))
1050               (calc-language 'flat)
1051               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1052               (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
1053          (list 'horiz
1054                (if parens "(" "")
1055                (append (list 'vcent (if high 3 2))
1056                        (and high (list (list 'horiz "  " high)))
1057                        '("  /"
1058                          " | "
1059                          " | "
1060                          " | "
1061                          "/  ")
1062                        (and low (list (list 'horiz low "  "))))
1063                expr
1064                (if over
1065                    ""
1066                  (list 'horiz " d" var))
1067                (if parens ")" "")))))
1068
1069 (put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
1070 (defun math-compose-sum (a prec)
1071   (and (memq (length a) '(3 5 6))
1072        (let* ((expr (math-compose-expr (nth 1 a) 185))
1073               (calc-language 'flat)
1074               (var (math-compose-expr (nth 2 a) 0))
1075               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1076               (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1077          (list 'horiz
1078                (if (memq prec '(180 201)) "(" "")
1079                (append (list 'vcent (if high 3 2))
1080                        (and high (list high))
1081                        '("---- "
1082                          "\\    "
1083                          " >   "
1084                          "/    "
1085                          "---- ")
1086                        (if low
1087                            (list (list 'horiz var " = " low))
1088                          (list var)))
1089                (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
1090                    " " "")
1091                expr
1092                (if (memq prec '(180 201)) ")" "")))))
1093
1094 (put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
1095 (defun math-compose-prod (a prec)
1096   (and (memq (length a) '(3 5 6))
1097        (let* ((expr (math-compose-expr (nth 1 a) 198))
1098               (calc-language 'flat)
1099               (var (math-compose-expr (nth 2 a) 0))
1100               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1101               (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1102          (list 'horiz
1103                (if (memq prec '(196 201)) "(" "")
1104                (append (list 'vcent (if high 3 2))
1105                        (and high (list high))
1106                        '("----- "
1107                          " | |  "
1108                          " | |  "
1109                          " | |  ")
1110                        (if low
1111                            (list (list 'horiz var " = " low))
1112                          (list var)))
1113                (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
1114                    " " "")
1115                expr
1116                (if (memq prec '(196 201)) ")" "")))))
1117
1118 ;; The variables math-svo-c, math-svo-wid and math-svo-off are local
1119 ;; to math-stack-value-offset in calc.el, but are used by
1120 ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
1121 (defvar math-svo-c)
1122 (defvar math-svo-wid)
1123 (defvar math-svo-off)
1124
1125 (defun math-stack-value-offset-fancy ()
1126   (let ((cwid (+ (math-comp-width math-svo-c))))
1127     (cond ((eq calc-display-just 'right)
1128            (if calc-display-origin
1129                (setq math-svo-wid (max calc-display-origin 5))
1130              (if (integerp calc-line-breaking)
1131                  (setq math-svo-wid calc-line-breaking)))
1132            (setq math-svo-off (- math-svo-wid cwid
1133                         (max (- (length calc-right-label)
1134                                 (if (and (integerp calc-line-breaking)
1135                                          calc-display-origin)
1136                                     (max (- calc-line-breaking
1137                                             calc-display-origin)
1138                                          0)
1139                                   0))
1140                              0))))
1141           (t
1142            (if calc-display-origin
1143                (progn
1144                  (setq math-svo-off (- calc-display-origin (/ cwid 2)))
1145                  (if (integerp calc-line-breaking)
1146                      (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
1147                                            (length calc-right-label)))))
1148                  (if (>= math-svo-off 0)
1149                      (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
1150              (if (integerp calc-line-breaking)
1151                  (setq math-svo-wid calc-line-breaking))
1152              (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
1153     (and (integerp calc-line-breaking)
1154          (or (< math-svo-off 0)
1155              (and calc-display-origin
1156                   (> calc-line-breaking calc-display-origin)))
1157          (setq math-svo-wid calc-line-breaking))))
1158
1159
1160 ;;; Convert a composition to string form, with embedded \n's if necessary.
1161
1162 (defun math-composition-to-string (c &optional width)
1163   (or width (setq width (calc-window-width)))
1164   (if calc-display-raw
1165       (math-comp-to-string-raw c 0)
1166     (if (math-comp-is-flat c)
1167         (math-comp-to-string-flat c width)
1168       (math-vert-comp-to-string
1169        (math-comp-simplify c width)))))
1170
1171 (defvar math-comp-buf-string (make-vector 10 ""))
1172 (defvar math-comp-buf-margin (make-vector 10 0))
1173 (defvar math-comp-buf-level (make-vector 10 0))
1174 (defun math-comp-is-flat (c)     ; check if c's height is 1.
1175   (cond ((not (consp c)) t)
1176         ((memq (car c) '(set break)) t)
1177         ((eq (car c) 'horiz)
1178          (while (and (setq c (cdr c))
1179                      (math-comp-is-flat (car c))))
1180          (null c))
1181         ((memq (car c) '(vleft vcent vright))
1182          (and (= (length c) 3)
1183               (= (nth 1 c) 0)
1184               (math-comp-is-flat (nth 2 c))))
1185         ((eq (car c) 'tag)
1186          (math-comp-is-flat (nth 2 c)))
1187         (t nil)))
1188
1189
1190 ;;; Convert a one-line composition to a string.  Break into multiple
1191 ;;; lines if necessary, choosing break points according to the structure
1192 ;;; of the formula.
1193
1194 ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
1195 ;; math-comp-level, math-comp-margin and math-comp-buf are local to
1196 ;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
1197 ;; which is called by math-comp-to-string-flat.
1198 ;; math-comp-highlight and math-comp-buf are also local to
1199 ;; math-comp-simplify-term and math-comp-simplify respectively, but are used
1200 ;; by math-comp-add-string.
1201 (defvar math-comp-full-width)
1202 (defvar math-comp-highlight)
1203 (defvar math-comp-word)
1204 (defvar math-comp-level)
1205 (defvar math-comp-margin)
1206 (defvar math-comp-buf)
1207 ;; The variable math-comp-pos is local to math-comp-to-string-flat, but
1208 ;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term,
1209 ;; which are called by math-comp-to-string-flat.
1210 (defvar math-comp-pos)
1211
1212 (defun math-comp-to-string-flat (c math-comp-full-width)
1213   (if math-comp-sel-hpos
1214       (let ((math-comp-pos 0))
1215         (math-comp-sel-flat-term c))
1216     (let ((math-comp-buf "")
1217           (math-comp-word "")
1218           (math-comp-pos 0)
1219           (math-comp-margin 0)
1220           (math-comp-highlight (and math-comp-selected calc-show-selections))
1221           (math-comp-level -1))
1222       (math-comp-to-string-flat-term '(set -1 0))
1223       (math-comp-to-string-flat-term c)
1224       (math-comp-to-string-flat-term '(break -1))
1225       (let ((str (aref math-comp-buf-string 0))
1226             (prefix ""))
1227         (and (> (length str) 0) (= (aref str 0) ? )
1228              (> (length math-comp-buf) 0)
1229              (let ((k (length math-comp-buf)))
1230                (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1231                (aset math-comp-buf k ? )
1232                (if (and (< (1+ k) (length math-comp-buf))
1233                         (= (aref math-comp-buf (1+ k)) ? ))
1234                    (progn
1235                      (aset math-comp-buf (1+ k) ?\n)
1236                      (setq prefix " "))
1237                  (setq prefix "\n"))))
1238         (concat math-comp-buf prefix str)))))
1239
1240 (defun math-comp-to-string-flat-term (c)
1241   (cond ((not (consp c))
1242          (if math-comp-highlight
1243              (setq c (math-comp-highlight-string c)))
1244          (setq math-comp-word (if (= (length math-comp-word) 0) c
1245                                 (concat math-comp-word c))
1246                math-comp-pos (+ math-comp-pos (length c))))
1247
1248         ((eq (car c) 'horiz)
1249          (while (setq c (cdr c))
1250            (math-comp-to-string-flat-term (car c))))
1251
1252         ((eq (car c) 'set)
1253          (if (nth 1 c)
1254              (progn
1255                (setq math-comp-level (1+ math-comp-level))
1256                (if (>= math-comp-level (length math-comp-buf-string))
1257                    (setq math-comp-buf-string (vconcat math-comp-buf-string
1258                                                        math-comp-buf-string)
1259                          math-comp-buf-margin (vconcat math-comp-buf-margin
1260                                                        math-comp-buf-margin)
1261                          math-comp-buf-level (vconcat math-comp-buf-level
1262                                                       math-comp-buf-level)))
1263                (aset math-comp-buf-string math-comp-level "")
1264                (aset math-comp-buf-margin math-comp-level (+ math-comp-pos
1265                                                         (or (nth 2 c) 0)))
1266                (aset math-comp-buf-level math-comp-level (nth 1 c)))))
1267
1268         ((eq (car c) 'break)
1269          (if (not calc-line-breaking)
1270              (setq math-comp-buf (concat math-comp-buf math-comp-word)
1271                    math-comp-word "")
1272            (let ((i 0) str)
1273              (if (and (> math-comp-pos math-comp-full-width)
1274                       (progn
1275                         (while (progn
1276                                  (setq str (aref math-comp-buf-string i))
1277                                  (and (= (length str) 0) (< i math-comp-level)))
1278                           (setq i (1+ i)))
1279                         (or (> (length str) 0) (> (length math-comp-buf) 0))))
1280                  (let ((prefix "") mrg wid)
1281                    (setq mrg (aref math-comp-buf-margin i))
1282                    (if (> mrg 12)  ; indenting too far, go back to far left
1283                        (let ((j i) (new (if calc-line-numbering 5 1)))
1284                          '(while (<= j math-comp-level)
1285                            (aset math-comp-buf-margin j
1286                                  (+ (aref math-comp-buf-margin j) (- new mrg)))
1287                            (setq j (1+ j)))
1288                          (setq mrg new)))
1289                    (setq wid (+ (length str) math-comp-margin))
1290                    (and (> (length str) 0) (= (aref str 0) ? )
1291                         (> (length math-comp-buf) 0)
1292                         (let ((k (length math-comp-buf)))
1293                           (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1294                           (aset math-comp-buf k ? )
1295                           (if (and (< (1+ k) (length math-comp-buf))
1296                                    (= (aref math-comp-buf (1+ k)) ? ))
1297                               (progn
1298                                 (aset math-comp-buf (1+ k) ?\n)
1299                                 (setq prefix " "))
1300                             (setq prefix "\n"))))
1301                    (setq math-comp-buf (concat math-comp-buf prefix str "\n"
1302                                           (make-string mrg ? ))
1303                          math-comp-pos (+ math-comp-pos (- mrg wid))
1304                          math-comp-margin mrg)
1305                    (aset math-comp-buf-string i "")
1306                    (while (<= (setq i (1+ i)) math-comp-level)
1307                      (if (> (aref math-comp-buf-margin i) wid)
1308                          (aset math-comp-buf-margin i
1309                                (+ (aref math-comp-buf-margin i)
1310                                   (- mrg wid))))))))
1311            (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level))
1312                     (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2)))
1313                ()  ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
1314              (let ((str (aref math-comp-buf-string math-comp-level)))
1315                (setq str (if (= (length str) 0)
1316                              math-comp-word
1317                            (concat str math-comp-word))
1318                      math-comp-word "")
1319                (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level))
1320                  (setq math-comp-level (1- math-comp-level))
1321                  (or (= (length (aref math-comp-buf-string math-comp-level)) 0)
1322                      (setq str (concat (aref math-comp-buf-string math-comp-level)
1323                                        str))))
1324                (aset math-comp-buf-string math-comp-level str)))))
1325
1326         ((eq (car c) 'tag)
1327          (cond ((eq (nth 1 c) math-comp-selected)
1328                 (let ((math-comp-highlight (not calc-show-selections)))
1329                   (math-comp-to-string-flat-term (nth 2 c))))
1330                ((eq (nth 1 c) t)
1331                 (let ((math-comp-highlight nil))
1332                   (math-comp-to-string-flat-term (nth 2 c))))
1333                (t (math-comp-to-string-flat-term (nth 2 c)))))
1334
1335         (t (math-comp-to-string-flat-term (nth 2 c)))))
1336
1337 (defun math-comp-highlight-string (s)
1338   (setq s (copy-sequence s))
1339   (let ((i (length s)))
1340     (while (>= (setq i (1- i)) 0)
1341       (or (memq (aref s i) '(32 ?\n))
1342           (aset s i (if calc-show-selections ?\. ?\#)))))
1343   s)
1344
1345
1346 ;; The variable math-comp-sel-tag is local to calc-find-selected-part
1347 ;; in calc-sel.el, but is used by math-comp-sel-flat-term and
1348 ;; math-comp-add-string-sel, which are called (indirectly) by
1349 ;; calc-find-selected-part.
1350 (defvar math-comp-sel-tag)
1351
1352 (defun math-comp-sel-flat-term (c)
1353   (cond ((not (consp c))
1354          (setq math-comp-pos (+ math-comp-pos (length c))))
1355         ((memq (car c) '(set break)))
1356         ((eq (car c) 'horiz)
1357          (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
1358            (math-comp-sel-flat-term (car c))))
1359         ((eq (car c) 'tag)
1360          (if (<= math-comp-pos math-comp-sel-cpos)
1361              (progn
1362                (math-comp-sel-flat-term (nth 2 c))
1363                (if (> math-comp-pos math-comp-sel-cpos)
1364                    (setq math-comp-sel-tag c
1365                          math-comp-sel-cpos 1000000)))
1366            (math-comp-sel-flat-term (nth 2 c))))
1367         (t (math-comp-sel-flat-term (nth 2 c)))))
1368
1369
1370 ;;; Simplify a composition to a canonical form consisting of
1371 ;;;   (vleft n "string" "string" "string" ...)
1372 ;;; where 0 <= n < number-of-strings.
1373
1374 ;; The variables math-comp-base, math-comp-hgt, math-comp-tag,
1375 ;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify,
1376 ;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt),
1377 ;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term
1378 ;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by
1379 ;; math-comp-simplify.
1380 (defvar math-comp-base)
1381 (defvar math-comp-hgt)
1382 (defvar math-comp-tag)
1383 (defvar math-comp-hpos)
1384 (defvar math-comp-vpos)
1385
1386 (defun math-comp-simplify (c full-width)
1387   (let ((math-comp-buf (list ""))
1388         (math-comp-base 0)
1389         (math-comp-hgt 1)
1390         (math-comp-hpos 0)
1391         (math-comp-vpos 0)
1392         (math-comp-highlight (and math-comp-selected calc-show-selections))
1393         (math-comp-tag nil))
1394     (math-comp-simplify-term c)
1395     (cons 'vleft (cons math-comp-base math-comp-buf))))
1396
1397 (defun math-comp-add-string (s h v)
1398   (and (> (length s) 0)
1399        (let ((vv (+ v math-comp-base)))
1400          (if math-comp-sel-hpos
1401              (math-comp-add-string-sel h vv (length s) 1)
1402            (if (< vv 0)
1403                (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf)
1404                      math-comp-base (- v)
1405                      math-comp-hgt (- math-comp-hgt vv)
1406                      vv 0)
1407              (if (>= vv math-comp-hgt)
1408                  (setq math-comp-buf (nconc math-comp-buf
1409                                        (make-list (1+ (- vv math-comp-hgt)) ""))
1410                        math-comp-hgt (1+ vv))))
1411            (let ((str (nthcdr vv math-comp-buf)))
1412              (setcar str (concat (car str)
1413                                  (make-string (- h (length (car str))) 32)
1414                                  (if math-comp-highlight
1415                                      (math-comp-highlight-string s)
1416                                    s))))))))
1417
1418 (defun math-comp-add-string-sel (x y w h)
1419   (if (and (<= y math-comp-sel-vpos)
1420            (> (+ y h) math-comp-sel-vpos)
1421            (<= x math-comp-sel-hpos)
1422            (> (+ x w) math-comp-sel-hpos))
1423       (setq math-comp-sel-tag math-comp-tag
1424             math-comp-sel-vpos 10000)))
1425
1426 (defun math-comp-simplify-term (c)
1427   (cond ((stringp c)
1428          (math-comp-add-string c math-comp-hpos math-comp-vpos)
1429          (setq math-comp-hpos (+ math-comp-hpos (length c))))
1430         ((memq (car c) '(set break))
1431          nil)
1432         ((eq (car c) 'horiz)
1433          (while (setq c (cdr c))
1434            (math-comp-simplify-term (car c))))
1435         ((memq (car c) '(vleft vcent vright))
1436          (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c))
1437                               (1- (math-comp-ascent (nth 2 c)))))
1438                 (widths (mapcar 'math-comp-width (cdr (cdr c))))
1439                 (maxwid (apply 'max widths))
1440                 (bias (cond ((eq (car c) 'vleft) 0)
1441                             ((eq (car c) 'vcent) 1)
1442                             (t 2))))
1443            (setq c (cdr c))
1444            (while (setq c (cdr c))
1445              (if (eq (car-safe (car c)) 'rule)
1446                  (math-comp-add-string (make-string maxwid (nth 1 (car c)))
1447                                        math-comp-hpos math-comp-vpos)
1448                (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid
1449                                                            (car widths)))
1450                                                 2))))
1451                  (math-comp-simplify-term (car c))))
1452              (and (cdr c)
1453                   (setq math-comp-vpos (+ math-comp-vpos
1454                                      (+ (math-comp-descent (car c))
1455                                         (math-comp-ascent (nth 1 c))))
1456                         widths (cdr widths))))
1457            (setq math-comp-hpos (+ math-comp-hpos maxwid))))
1458         ((eq (car c) 'supscr)
1459          (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
1460                 (desc (math-comp-descent (nth 2 c)))
1461                 (oldh (prog1
1462                           math-comp-hpos
1463                         (math-comp-simplify-term (nth 1 c))))
1464                 (math-comp-vpos (- math-comp-vpos (+ asc desc))))
1465            (math-comp-simplify-term (nth 2 c))
1466            (if math-comp-sel-hpos
1467                (math-comp-add-string-sel oldh
1468                                          (- math-comp-vpos
1469                                             -1
1470                                             (math-comp-ascent (nth 2 c)))
1471                                          (- math-comp-hpos oldh)
1472                                          (math-comp-height c)))))
1473         ((eq (car c) 'subscr)
1474          (let* ((asc (math-comp-ascent (nth 2 c)))
1475                 (desc (math-comp-descent (nth 1 c)))
1476                 (oldv math-comp-vpos)
1477                 (oldh (prog1
1478                           math-comp-hpos
1479                         (math-comp-simplify-term (nth 1 c))))
1480                 (math-comp-vpos (+ math-comp-vpos (+ asc desc))))
1481            (math-comp-simplify-term (nth 2 c))
1482            (if math-comp-sel-hpos
1483                (math-comp-add-string-sel oldh oldv
1484                                          (- math-comp-hpos oldh)
1485                                          (math-comp-height c)))))
1486         ((eq (car c) 'tag)
1487          (cond ((eq (nth 1 c) math-comp-selected)
1488                 (let ((math-comp-highlight (not calc-show-selections)))
1489                   (math-comp-simplify-term (nth 2 c))))
1490                ((eq (nth 1 c) t)
1491                 (let ((math-comp-highlight nil))
1492                   (math-comp-simplify-term (nth 2 c))))
1493                (t (let ((math-comp-tag c))
1494                     (math-comp-simplify-term (nth 2 c))))))))
1495
1496
1497 ;;; Measuring a composition.
1498
1499 (defun math-comp-first-char (c)
1500   (cond ((stringp c)
1501          (and (> (length c) 0)
1502               (elt c 0)))
1503         ((memq (car c) '(horiz subscr supscr))
1504          (while (and (setq c (cdr c))
1505                      (math-comp-is-null (car c))))
1506          (and c (math-comp-first-char (car c))))
1507         ((eq (car c) 'tag)
1508          (math-comp-first-char (nth 2 c)))))
1509
1510 (defun math-comp-first-string (c)
1511   (cond ((stringp c)
1512          (and (> (length c) 0)
1513               c))
1514         ((eq (car c) 'horiz)
1515          (while (and (setq c (cdr c))
1516                      (math-comp-is-null (car c))))
1517          (and c (math-comp-first-string (car c))))
1518         ((eq (car c) 'tag)
1519          (math-comp-first-string (nth 2 c)))))
1520
1521 (defun math-comp-last-char (c)
1522   (cond ((stringp c)
1523          (and (> (length c) 0)
1524               (elt c (1- (length c)))))
1525         ((eq (car c) 'horiz)
1526          (let ((c (reverse (cdr c))))
1527            (while (and c (math-comp-is-null (car c)))
1528              (setq c (cdr c)))
1529            (and c (math-comp-last-char (car c)))))
1530         ((eq (car c) 'tag)
1531          (math-comp-last-char (nth 2 c)))))
1532
1533 (defun math-comp-is-null (c)
1534   (cond ((stringp c) (= (length c) 0))
1535         ((memq (car c) '(horiz subscr supscr))
1536          (while (and (setq c (cdr c))
1537                      (math-comp-is-null (car c))))
1538          (null c))
1539         ((eq (car c) 'tag)
1540          (math-comp-is-null (nth 2 c)))
1541         ((memq (car c) '(set break)) t)))
1542
1543 (defun math-comp-width (c)
1544   (cond ((not (consp c)) (length c))
1545         ((memq (car c) '(horiz subscr supscr))
1546          (let ((accum 0))
1547            (while (setq c (cdr c))
1548              (setq accum (+ accum (math-comp-width (car c)))))
1549            accum))
1550         ((memq (car c) '(vcent vleft vright))
1551          (setq c (cdr c))
1552          (let ((accum 0))
1553            (while (setq c (cdr c))
1554              (setq accum (max accum (math-comp-width (car c)))))
1555            accum))
1556         ((eq (car c) 'tag)
1557          (math-comp-width (nth 2 c)))
1558         (t 0)))
1559
1560 (defun math-comp-height (c)
1561   (if (stringp c)
1562       1
1563     (+ (math-comp-ascent c) (math-comp-descent c))))
1564
1565 (defun math-comp-ascent (c)
1566   (cond ((not (consp c)) 1)
1567         ((eq (car c) 'horiz)
1568          (let ((accum 0))
1569            (while (setq c (cdr c))
1570              (setq accum (max accum (math-comp-ascent (car c)))))
1571            accum))
1572         ((memq (car c) '(vcent vleft vright))
1573          (if (> (nth 1 c) 0) (1+ (nth 1 c)) 1))
1574         ((eq (car c) 'supscr)
1575          (max (math-comp-ascent (nth 1 c)) (1+ (math-comp-height (nth 2 c)))))
1576         ((eq (car c) 'subscr)
1577          (math-comp-ascent (nth 1 c)))
1578         ((eq (car c) 'tag)
1579          (math-comp-ascent (nth 2 c)))
1580         (t 1)))
1581
1582 (defun math-comp-descent (c)
1583   (cond ((not (consp c)) 0)
1584         ((eq (car c) 'horiz)
1585          (let ((accum 0))
1586            (while (setq c (cdr c))
1587              (setq accum (max accum (math-comp-descent (car c)))))
1588            accum))
1589         ((memq (car c) '(vcent vleft vright))
1590          (let ((accum (- (nth 1 c))))
1591            (setq c (cdr c))
1592            (while (setq c (cdr c))
1593              (setq accum (+ accum (math-comp-height (car c)))))
1594            (max (1- accum) 0)))
1595         ((eq (car c) 'supscr)
1596          (math-comp-descent (nth 1 c)))
1597         ((eq (car c) 'subscr)
1598          (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
1599         ((eq (car c) 'tag)
1600          (math-comp-descent (nth 2 c)))
1601         (t 0)))
1602
1603 (defun calcFunc-cwidth (a &optional prec)
1604   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1605   (math-comp-width (math-compose-expr a (or prec 0))))
1606
1607 (defun calcFunc-cheight (a &optional prec)
1608   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1609   (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
1610            (memq (length a) '(2 3))
1611            (eq (nth 1 a) 0))
1612       0
1613     (math-comp-height (math-compose-expr a (or prec 0)))))
1614
1615 (defun calcFunc-cascent (a &optional prec)
1616   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1617   (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
1618            (memq (length a) '(2 3))
1619            (eq (nth 1 a) 0))
1620       0
1621     (math-comp-ascent (math-compose-expr a (or prec 0)))))
1622
1623 (defun calcFunc-cdescent (a &optional prec)
1624   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1625   (math-comp-descent (math-compose-expr a (or prec 0))))
1626
1627
1628 ;;; Convert a simplified composition into string form.
1629
1630 (defun math-vert-comp-to-string (c)
1631   (if (stringp c)
1632       c
1633     (math-vert-comp-to-string-step (cdr (cdr c)))))
1634
1635 (defun math-vert-comp-to-string-step (c)
1636   (if (cdr c)
1637       (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
1638     (car c)))
1639
1640
1641 ;;; Convert a composition to a string in "raw" form (for debugging).
1642
1643 (defun math-comp-to-string-raw (c indent)
1644   (cond ((or (not (consp c)) (eq (car c) 'set))
1645          (prin1-to-string c))
1646         ((null (cdr c))
1647          (concat "(" (symbol-name (car c)) ")"))
1648         (t
1649          (let ((next-indent (+ indent 2 (length (symbol-name (car c))))))
1650            (concat "("
1651                    (symbol-name (car c))
1652                    " "
1653                    (math-comp-to-string-raw (nth 1 c) next-indent)
1654                    (math-comp-to-string-raw-step (cdr (cdr c))
1655                                                  next-indent)
1656                    ")")))))
1657
1658 (defun math-comp-to-string-raw-step (cl indent)
1659   (if cl
1660       (concat "\n"
1661               (make-string indent 32)
1662               (math-comp-to-string-raw (car cl) indent)
1663               (math-comp-to-string-raw-step (cdr cl) indent))
1664     ""))
1665
1666 (provide 'calccomp)
1667
1668 ;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
1669 ;;; calccomp.el ends here