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, 2009, 2010, 2011 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                   (calc-twos-complement-mode nil))
 382               (math-compose-expr (nth 2 a) 0))))
 383      ((and (eq (car a) '/)
 384            (eq calc-language 'big))
 385       (let ((a1 (let ((calc-language (if (memq (car-safe (nth 1 a)) '(/ frac))
 386                                          'flat 'big)))
 387                   (math-compose-expr (nth 1 a) 0)))
 388             (a2 (let ((calc-language (if (memq (car-safe (nth 2 a)) '(/ frac))
 389                                          'flat 'big)))
 390                   (math-compose-expr (nth 2 a) 0))))
 391         (list 'vcent
 392               (math-comp-height a1)
 393               a1 '(rule ?-) a2)))
 394      ((and (eq (car a) 'calcFunc-lambda)
 395            (> (length a) 2)
 396            (memq calc-language '(nil flat big)))
 397       (let ((p (cdr a))
 398             (ap calc-arg-values)
 399             (math-compose-hash-args (if (= (length a) 3) 1 t)))
 400         (while (and (cdr p) (equal (car p) (car ap)))
 401           (setq p (cdr p) ap (cdr ap)))
 402         (append '(horiz "<")
 403                 (if (cdr p)
 404                     (list (math-compose-vector
 405                            (nreverse (cdr (reverse (cdr a)))) ", " 0)
 406                           " : ")
 407                   nil)
 408                 (list (math-compose-expr (nth (1- (length a)) a) 0)
 409                       ">"))))
 410      ((and (eq (car a) 'calcFunc-string)
 411            (= (length a) 2)
 412            (math-vectorp (nth 1 a))
 413            (math-vector-is-string (nth 1 a)))
 414       (if (eq calc-language 'unform)
 415           (concat "string(" (math-vector-to-string (nth 1 a) t) ")")
 416         (math-vector-to-string (nth 1 a) nil)))
 417      ((and (eq (car a) 'calcFunc-bstring)
 418            (= (length a) 2)
 419            (math-vectorp (nth 1 a))
 420            (math-vector-is-string (nth 1 a)))
 421       (if (eq calc-language 'unform)
 422           (concat "bstring(" (math-vector-to-string (nth 1 a) t) ")")
 423         (let ((c nil)
 424               (s (math-vector-to-string (nth 1 a) nil))
 425               p)
 426           (while (string-match "[^ ] +[^ ]" s)
 427             (setq p (1- (match-end 0))
 428                   c (cons (list 'break math-compose-level)
 429                           (cons (substring s 0 p)
 430                                 c))
 431                   s (substring s p)))
 432           (setq c (nreverse (cons s c)))
 433           (or (= prec -123)
 434               (setq c (cons (list 'set math-compose-level 2) c)))
 435           (cons 'horiz c))))
 436      ((and (eq (car a) 'calcFunc-cprec)
 437            (not (eq calc-language 'unform))
 438            (= (length a) 3)
 439            (integerp (nth 2 a)))
 440       (let ((c (math-compose-expr (nth 1 a) -1)))
 441         (if (> prec (nth 2 a))
 442             (if (setq spfn (get calc-language 'math-big-parens))
 443                 (list 'horiz (car spfn) c (cdr spfn))
 444               (list 'horiz "(" c ")"))
 445           c)))
 446      ((and (eq (car a) 'calcFunc-choriz)
 447            (not (eq calc-language 'unform))
 448            (memq (length a) '(2 3 4))
 449            (math-vectorp (nth 1 a))
 450            (if (integerp (nth 2 a))
 451                (or (null (nth 3 a))
 452                    (and (math-vectorp (nth 3 a))
 453                         (math-vector-is-string (nth 3 a))))
 454              (or (null (nth 2 a))
 455                  (and (math-vectorp (nth 2 a))
 456                       (math-vector-is-string (nth 2 a))))))
 457       (let* ((cprec (and (integerp (nth 2 a)) (nth 2 a)))
 458              (sep (nth (if cprec 3 2) a))
 459              (bprec nil))
 460         (if sep
 461             (math-compose-vector (cdr (nth 1 a))
 462                                  (math-vector-to-string sep nil)
 463                                  (or cprec prec))
 464           (cons 'horiz (mapcar (function
 465                                 (lambda (x)
 466                                   (if (eq (car-safe x) 'calcFunc-bstring)
 467                                       (prog1
 468                                           (math-compose-expr
 469                                            x (or bprec cprec prec))
 470                                         (setq bprec -123))
 471                                     (math-compose-expr x (or cprec prec)))))
 472                                (cdr (nth 1 a)))))))
 473      ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
 474            (not (eq calc-language 'unform))
 475            (memq (length a) '(2 3))
 476            (math-vectorp (nth 1 a))
 477            (or (null (nth 2 a))
 478                (integerp (nth 2 a))))
 479       (let* ((base 0)
 480              (v 0)
 481              (prec (or (nth 2 a) prec))
 482              (c (mapcar (function
 483                          (lambda (x)
 484                            (let ((b nil) (cc nil) a d)
 485                              (if (and (memq (car-safe x) '(calcFunc-cbase
 486                                                            calcFunc-ctbase
 487                                                            calcFunc-cbbase))
 488                                       (memq (length x) '(1 2)))
 489                                  (setq b (car x)
 490                                        x (nth 1 x)))
 491                              (if (and (eq (car-safe x) 'calcFunc-crule)
 492                                       (memq (length x) '(1 2))
 493                                       (or (null (nth 1 x))
 494                                           (and (math-vectorp (nth 1 x))
 495                                                (= (length (nth 1 x)) 2)
 496                                                (math-vector-is-string
 497                                                 (nth 1 x)))
 498                                           (and (natnump (nth 1 x))
 499                                                (<= (nth 1 x) 255))))
 500                                  (setq cc (list
 501                                            'rule
 502                                            (if (math-vectorp (nth 1 x))
 503                                                (aref (math-vector-to-string
 504                                                       (nth 1 x) nil) 0)
 505                                              (or (nth 1 x) ?-))))
 506                                (or (and (memq (car-safe x) '(calcFunc-cvspace
 507                                                              calcFunc-ctspace
 508                                                              calcFunc-cbspace))
 509                                         (memq (length x) '(2 3))
 510                                         (eq (nth 1 x) 0))
 511                                    (null x)
 512                                    (setq cc (math-compose-expr x prec))))
 513                              (setq a (if cc (math-comp-ascent cc) 0)
 514                                    d (if cc (math-comp-descent cc) 0))
 515                              (if (eq b 'calcFunc-cbase)
 516                                  (setq base (+ v a -1))
 517                                (if (eq b 'calcFunc-ctbase)
 518                                    (setq base v)
 519                                  (if (eq b 'calcFunc-cbbase)
 520                                      (setq base (+ v a d -1)))))
 521                              (setq v (+ v a d))
 522                              cc)))
 523                         (cdr (nth 1 a)))))
 524         (setq c (delq nil c))
 525         (if c
 526             (cons (if (eq (car a) 'calcFunc-cvert) 'vcent
 527                     (if (eq (car a) 'calcFunc-clvert) 'vleft 'vright))
 528                   (cons base c))
 529           " ")))
 530      ((and (memq (car a) '(calcFunc-csup calcFunc-csub))
 531            (not (eq calc-language 'unform))
 532            (memq (length a) '(3 4))
 533            (or (null (nth 3 a))
 534                (integerp (nth 3 a))))
 535       (list (if (eq (car a) 'calcFunc-csup) 'supscr 'subscr)
 536             (math-compose-expr (nth 1 a) (or (nth 3 a) 0))
 537             (math-compose-expr (nth 2 a) 0)))
 538      ((and (eq (car a) 'calcFunc-cflat)
 539            (not (eq calc-language 'unform))
 540            (memq (length a) '(2 3))
 541            (or (null (nth 2 a))
 542                (integerp (nth 2 a))))
 543       (let ((calc-language (if (memq calc-language '(nil big))
 544                                'flat calc-language)))
 545         (math-compose-expr (nth 1 a) (or (nth 2 a) 0))))
 546      ((and (eq (car a) 'calcFunc-cspace)
 547            (memq (length a) '(2 3))
 548            (natnump (nth 1 a)))
 549       (if (nth 2 a)
 550           (cons 'horiz (make-list (nth 1 a)
 551                                   (if (and (math-vectorp (nth 2 a))
 552                                            (math-vector-is-string (nth 2 a)))
 553                                       (math-vector-to-string (nth 2 a) nil)
 554                                     (math-compose-expr (nth 2 a) 0))))
 555         (make-string (nth 1 a) ?\ )))
 556      ((and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
 557            (memq (length a) '(2 3))
 558            (natnump (nth 1 a)))
 559       (if (= (nth 1 a) 0)
 560           ""
 561         (let* ((c (if (nth 2 a)
 562                       (if (and (math-vectorp (nth 2 a))
 563                                (math-vector-is-string (nth 2 a)))
 564                           (math-vector-to-string (nth 2 a) nil)
 565                         (math-compose-expr (nth 2 a) 0))
 566                     " "))
 567                (ca (math-comp-ascent c))
 568                (cd (math-comp-descent c)))
 569           (cons 'vleft
 570                 (cons (if (eq (car a) 'calcFunc-ctspace)
 571                           (1- ca)
 572                         (if (eq (car a) 'calcFunc-cbspace)
 573                             (+ (* (1- (nth 1 a)) (+ ca cd)) (1- ca))
 574                           (/ (1- (* (nth 1 a) (+ ca cd))) 2)))
 575                       (make-list (nth 1 a) c))))))
 576      ((and (eq (car a) 'calcFunc-evalto)
 577            (setq calc-any-evaltos t)
 578            (setq spfn (get calc-language 'math-evalto))
 579            (= math-compose-level (if math-comp-tagged 2 1))
 580            (= (length a) 3))
 581       (list 'horiz
 582             (car spfn)
 583             (math-compose-expr (nth 1 a) 0)
 584             (cdr spfn)
 585             (math-compose-expr (nth 2 a) 0)))
 586      (t
 587       (let ((op (and (not (eq calc-language 'unform))
 588                      (if (and (eq (car a) 'calcFunc-if) (= (length a) 4))
 589                          (assoc "?" math-expr-opers)
 590                        (math-assq2 (car a) math-expr-opers)))))
 591         (cond ((and op
 592                     (or (= (length a) 3) (eq (car a) 'calcFunc-if))
 593                     (/= (nth 3 op) -1))
 594                (cond
 595                 ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
 596                  (if (and (memq calc-language '(tex latex))
 597                           (not (math-tex-expr-is-flat a)))
 598                      (if (eq (car-safe a) '/)
 599                          (list 'horiz "{" (math-compose-expr a -1) "}")
 600                        (list 'horiz "\\left( "
 601                              (math-compose-expr a -1)
 602                              " \\right)"))
 603                    (if (eq calc-language 'eqn)
 604                        (if (or (eq (car-safe a) '/)
 605                                (= (/ prec 100) 9))
 606                            (list 'horiz "{" (math-compose-expr a -1) "}")
 607                          (if (math-tex-expr-is-flat a)
 608                              (list 'horiz "( " (math-compose-expr a -1) " )")
 609                            (list 'horiz "{left ( "
 610                                  (math-compose-expr a -1)
 611                                  " right )}")))
 612                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 613                 ((and (memq calc-language '(tex latex))
 614                       (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
 615                       (>= prec 0))
 616                  (list 'horiz "{" (math-compose-expr a -1) "}"))
 617                 ((eq (car a) 'calcFunc-if)
 618                  (list 'horiz
 619                        (math-compose-expr (nth 1 a) (nth 2 op))
 620                        " ? "
 621                        (math-compose-expr (nth 2 a) 0)
 622                        " : "
 623                        (math-compose-expr (nth 3 a) (nth 3 op))))
 624                 (t
 625                  (let* ((math-comp-tagged (and math-comp-tagged
 626                                                (not (math-primp a))
 627                                                math-comp-tagged))
 628                         (setlev (if (= prec (min (nth 2 op) (nth 3 op)))
 629                                     (progn
 630                                       (setq math-compose-level
 631                                             (1- math-compose-level))
 632                                       nil)
 633                                   math-compose-level))
 634                         (lhs (math-compose-expr (nth 1 a) (nth 2 op)))
 635                         (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
 636                    (and (equal (car op) "^")
 637                         (eq (math-comp-first-char lhs) ?-)
 638                         (setq lhs (list 'horiz "(" lhs ")")))
 639                    (and (memq calc-language '(tex latex))
 640                         (or (equal (car op) "^") (equal (car op) "_"))
 641                         (not (and (stringp rhs) (= (length rhs) 1)))
 642                         (setq rhs (list 'horiz "{" rhs "}")))
 643                    (or (and (eq (car a) '*)
 644                             (or (null calc-language)
 645                                 (assoc "2x" math-expr-opers))
 646                             (let* ((prevt (math-prod-last-term (nth 1 a)))
 647                                    (nextt (math-prod-first-term (nth 2 a)))
 648                                    (prevc (or (math-comp-last-char lhs)
 649                                               (and (memq (car-safe prevt)
 650                                                          '(^ calcFunc-subscr
 651                                                              calcFunc-sqrt
 652                                                              frac))
 653                                                    (eq calc-language 'big)
 654                                                    ?0)))
 655                                    (nextc (or (math-comp-first-char rhs)
 656                                               (and (memq (car-safe nextt)
 657                                                          '(calcFunc-sqrt
 658                                                            calcFunc-sum
 659                                                            calcFunc-prod
 660                                                            calcFunc-integ))
 661                                                    (eq calc-language 'big)
 662                                                    ?0))))
 663                               (and prevc nextc
 664                                    (or (and (>= nextc ?a) (<= nextc ?z))
 665                                        (and (>= nextc ?A) (<= nextc ?Z))
 666                                        (and (>= nextc ?0) (<= nextc ?9))
 667                                        (memq nextc '(?. ?_ ?#
 668                                                         ?\( ?\[ ?\{))
 669                                        (and (eq nextc ?\\)
 670                                             (not (string-match
 671                                                   "\\`\\\\left("
 672                                                   (math-comp-first-string
 673                                                    rhs)))))
 674                                    (not (and (eq (car-safe prevt) 'var)
 675                                              (eq nextc ?\()))
 676                                    (list 'horiz
 677                                          (list 'set setlev 1)
 678                                          lhs
 679                                          (list 'break math-compose-level)
 680                                          " "
 681                                          rhs))))
 682                        (list 'horiz
 683                              (list 'set setlev 1)
 684                              lhs
 685                              (list 'break math-compose-level)
 686                              (if (or (equal (car op) "^")
 687                                      (equal (car op) "_")
 688                                      (equal (car op) "**")
 689                                      (and (equal (car op) "*")
 690                                           (math-comp-last-char lhs)
 691                                           (math-comp-first-char rhs))
 692                                      (and (equal (car op) "/")
 693                                           (math-num-integerp (nth 1 a))
 694                                           (math-integerp (nth 2 a))))
 695                                  (car op)
 696                                (if (and (eq calc-language 'big)
 697                                         (equal (car op) "=>"))
 698                                    "  =>  "
 699                                  (concat " " (car op) " ")))
 700                              rhs))))))
 701               ((and op (= (length a) 2) (= (nth 3 op) -1))
 702                (cond
 703                 ((or (> prec (or (nth 4 op) (nth 2 op)))
 704                      (and (not (eq (assoc (car op) math-expr-opers) op))
 705                           (> prec 0)))   ; don't write x% + y
 706                  (if (and (memq calc-language '(tex latex))
 707                           (not (math-tex-expr-is-flat a)))
 708                      (list 'horiz "\\left( "
 709                            (math-compose-expr a -1)
 710                            " \\right)")
 711                    (if (eq calc-language 'eqn)
 712                        (if (= (/ prec 100) 9)
 713                            (list 'horiz "{" (math-compose-expr a -1) "}")
 714                          (if (math-tex-expr-is-flat a)
 715                              (list 'horiz "{( " (math-compose-expr a -1) " )}")
 716                            (list 'horiz "{left ( "
 717                                  (math-compose-expr a -1)
 718                                  " right )}")))
 719                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 720                 (t
 721                  (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
 722                  (list 'horiz
 723                        lhs
 724                        (if (or (> (length (car op)) 1)
 725                                (not (math-comp-is-flat lhs)))
 726                            (concat " " (car op))
 727                          (car op)))))))
 728               ((and op (= (length a) 2) (= (nth 2 op) -1))
 729                (cond
 730                 ((eq (nth 3 op) 0)
 731                  (let ((lr (and (memq calc-language '(tex latex))
 732                                 (not (math-tex-expr-is-flat (nth 1 a))))))
 733                    (list 'horiz
 734                          (if lr "\\left" "")
 735                          (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
 736                              (substring (car op) 1)
 737                            (car op))
 738                          (if (or lr (> (length (car op)) 2)) " " "")
 739                          (math-compose-expr (nth 1 a) -1)
 740                          (if (or lr (> (length (car op)) 2)) " " "")
 741                          (if lr "\\right" "")
 742                          (car (nth 1 (memq op math-expr-opers))))))
 743                 ((> prec (or (nth 4 op) (nth 3 op)))
 744                  (if (and (memq calc-language '(tex latex))
 745                           (not (math-tex-expr-is-flat a)))
 746                      (list 'horiz "\\left( "
 747                            (math-compose-expr a -1)
 748                            " \\right)")
 749                    (if (eq calc-language 'eqn)
 750                        (if (= (/ prec 100) 9)
 751                            (list 'horiz "{" (math-compose-expr a -1) "}")
 752                          (if (math-tex-expr-is-flat a)
 753                              (list 'horiz "{( " (math-compose-expr a -1) " )}")
 754                            (list 'horiz "{left ( "
 755                                  (math-compose-expr a -1)
 756                                  " right )}")))
 757                      (list 'horiz "(" (math-compose-expr a 0) ")"))))
 758                 (t
 759                  (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
 760                    (list 'horiz
 761                          (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
 762                                                       (car op))
 763                                         (substring (car op) 1)
 764                                       (car op))))
 765                            (if (or (> (length ops) 1)
 766                                    (not (math-comp-is-flat rhs)))
 767                                (concat ops " ")
 768                              ops))
 769                          rhs)))))
 770               ((and (eq calc-language 'big)
 771                     (setq op (get (car a) 'math-compose-big))
 772                     (funcall op a prec)))
 773               ((and (setq op (assq calc-language
 774                                    '( ( nil . math-compose-normal )
 775                                       ( flat . math-compose-normal )
 776                                       ( big . math-compose-normal )
 777                                       ( c . math-compose-c )
 778                                       ( pascal . math-compose-pascal )
 779                                       ( fortran . math-compose-fortran )
 780                                       ( tex . math-compose-tex )
 781                                       ( latex . math-compose-latex )
 782                                       ( eqn . math-compose-eqn )
 783                                       ( yacas . math-compose-yacas )
 784                                       ( maxima . math-compose-maxima )
 785                                       ( giac . math-compose-giac )
 786                                       ( math . math-compose-math )
 787                                       ( maple . math-compose-maple ))))
 788                     (setq op (get (car a) (cdr op)))
 789                     (funcall op a prec)))
 790               (t
 791                (let* ((func (car a))
 792                       (func2 (assq func '(( mod . calcFunc-makemod )
 793                                           ( sdev . calcFunc-sdev )
 794                                           ( + . calcFunc-add )
 795                                           ( - . calcFunc-sub )
 796                                           ( * . calcFunc-mul )
 797                                           ( / . calcFunc-div )
 798                                           ( % . calcFunc-mod )
 799                                           ( ^ . calcFunc-pow )
 800                                           ( neg . calcFunc-neg )
 801                                           ( | . calcFunc-vconcat ))))
 802                       left right args)
 803                  (if func2
 804                      (setq func (cdr func2)))
 805                  (if (setq func2 (rassq func math-expr-function-mapping))
 806                      (setq func (car func2)))
 807                  (setq func (math-remove-dashes
 808                              (if (string-match
 809                                   "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
 810                                   (symbol-name func))
 811                                  (math-match-substring (symbol-name func) 1)
 812                                (symbol-name func))))
 813                  (if (memq calc-language calc-lang-allow-percentsigns)
 814                      (setq func (math-to-percentsigns func)))
 815                  (if (memq calc-language calc-lang-allow-underscores)
 816                      (setq func (math-to-underscores func)))
 817                  (if (setq spfn (get calc-language 'math-func-formatter))
 818                      (funcall spfn func a)
 819
 820                    (list 'horiz func calc-function-open
 821                        (math-compose-vector (cdr a) ", " 0)
 822                        calc-function-close))))))))))
 823
 824
 825 (defun math-prod-first-term (x)
 826   (while (eq (car-safe x) '*)
 827     (setq x (nth 1 x)))
 828   x)
 829
 830 (defun math-prod-last-term (x)
 831   (while (eq (car-safe x) '*)
 832     (setq x (nth 2 x)))
 833   x)
 834
 835 (defun math-compose-vector (a sep prec)
 836   (if a
 837       (cons 'horiz
 838             (cons (list 'set math-compose-level)
 839                   (let ((c (list (math-compose-expr (car a) prec))))
 840                     (while (setq a (cdr a))
 841                       (setq c (cons (if (eq (car-safe (car a))
 842                                             'calcFunc-bstring)
 843                                         (let ((math-compose-level
 844                                                (1- math-compose-level)))
 845                                           (math-compose-expr (car a) -123))
 846                                       (math-compose-expr (car a) prec))
 847                                     (cons (list 'break math-compose-level)
 848                                           (cons sep c)))))
 849                     (nreverse c))))
 850     ""))
 851
 852 (defun math-vector-no-parens (a)
 853   (or (cdr (cdr a))
 854       (not (eq (car-safe (nth 1 a)) '*))))
 855
 856 (defun math-compose-matrix (a col cols base)
 857   (let ((col 0)
 858         (res nil))
 859     (while (<= (setq col (1+ col)) cols)
 860       (setq res (cons (cons math-comp-just
 861                             (cons base
 862                                   (mapcar (function
 863                                            (lambda (r)
 864                                              (list 'horiz
 865                                                    (math-compose-expr
 866                                                     (nth col r)
 867                                                     math-comp-vector-prec)
 868                                                    (if (= col cols)
 869                                                        ""
 870                                                      (concat
 871                                                       math-comp-comma-spc " ")))))
 872                                           a)))
 873                       res)))
 874     (nreverse res)))
 875
 876 (defun math-compose-rows (a count first)
 877   (if (cdr a)
 878       (if (<= count 0)
 879           (if (< count 0)
 880               (math-compose-rows (cdr a) -1 nil)
 881             (cons (concat
 882                    (let ((mdots (get calc-language 'math-dots)))
 883                      (if mdots
 884                          (concat " " mdots)
 885                        "  ..."))
 886                    math-comp-comma)
 887                   (math-compose-rows (cdr a) -1 nil)))
 888         (cons (list 'horiz
 889                     (if first (concat math-comp-left-bracket " ") "  ")
 890                     (math-compose-expr (car a) math-comp-vector-prec)
 891                     math-comp-comma)
 892               (math-compose-rows (cdr a) (1- count) nil)))
 893     (list (list 'horiz
 894                 (if first (concat math-comp-left-bracket " ") "  ")
 895                 (math-compose-expr (car a) math-comp-vector-prec)
 896                 (concat " " math-comp-right-bracket)))))
 897
 898 (defun math-vector-is-string (a)
 899   (while (and (setq a (cdr a))
 900               (or (and (natnump (car a))
 901                        (<= (car a) 255))
 902                   (and (eq (car-safe (car a)) 'cplx)
 903                        (natnump (nth 1 (car a)))
 904                        (eq (nth 2 (car a)) 0)
 905                        (<= (nth 1 (car a)) 255)))))
 906   (null a))
 907
 908 (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
 909                                          ( ?\\ . "\\\\" )
 910                                          ( ?\a . "\\a" )
 911                                          ( ?\b . "\\b" )
 912                                          ( ?\e . "\\e" )
 913                                          ( ?\f . "\\f" )
 914                                          ( ?\n . "\\n" )
 915                                          ( ?\r . "\\r" )
 916                                          ( ?\t . "\\t" )
 917                                          ( ?\^? . "\\^?" )))
 918
 919 (defun math-vector-to-string (a &optional quoted)
 920   (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
 921                           (cdr a))))
 922   (if (string-match "[\000-\037\177\\\"]" a)
 923       (let ((p 0)
 924             (pat (if quoted "[\000-\037\177\\\"]" "[\000-\037\177]"))
 925             (codes (if quoted math-vector-to-string-chars '((?\^? . "^?"))))
 926             (fmt (if quoted "\\^%c" "^%c"))
 927             new)
 928         (while (setq p (string-match pat a p))
 929           (if (setq new (assq (aref a p) codes))
 930               (setq a (concat (substring a 0 p)
 931                               (cdr new)
 932                               (substring a (1+ p)))
 933                     p (+ p (length (cdr new))))
 934             (setq a (concat (substring a 0 p)
 935                             (format fmt (+ (aref a p) 64))
 936                             (substring a (1+ p)))
 937                   p (+ p 2))))))
 938   (if quoted
 939       (concat "\"" a "\"")
 940     a))
 941
 942
 943 (defun math-to-underscores (x)
 944   (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
 945       (math-to-underscores
 946        (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
 947     x))
 948
 949 (defun math-to-percentsigns (x)
 950   (if (string-match "\\`\\(.*\\)o'o\\(.*\\)\\'" x)
 951       (math-to-underscores
 952        (concat (math-match-substring x 1) "%" (math-match-substring x 2)))
 953     x))
 954
 955 (defun math-tex-expr-is-flat (a)
 956   (or (Math-integerp a)
 957       (memq (car a) '(float var))
 958       (and (memq (car a) '(+ - * neg))
 959            (progn
 960              (while (and (setq a (cdr a))
 961                          (math-tex-expr-is-flat (car a))))
 962              (null a)))
 963       (and (memq (car a) '(^ calcFunc-subscr))
 964            (math-tex-expr-is-flat (nth 1 a)))))
 965
 966 (put 'calcFunc-log 'math-compose-big 'math-compose-log)
 967 (defun math-compose-log (a prec)
 968   (and (= (length a) 3)
 969        (list 'horiz
 970              (list 'subscr "log"
 971                    (let ((calc-language 'flat))
 972                      (math-compose-expr (nth 2 a) 1000)))
 973              "("
 974              (math-compose-expr (nth 1 a) 1000)
 975              ")")))
 976
 977 (put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
 978 (defun math-compose-log10 (a prec)
 979   (and (= (length a) 2)
 980        (list 'horiz
 981              (list 'subscr "log" "10")
 982              "("
 983              (math-compose-expr (nth 1 a) 1000)
 984              ")")))
 985
 986 (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
 987 (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
 988 (defun math-compose-deriv (a prec)
 989   (when (= (length a) 3)
 990     (math-compose-expr (list '/
 991                              (list 'calcFunc-choriz
 992                                    (list 'vec
 993                                          '(calcFunc-string (vec ?d))
 994                                          (nth 1 a)))
 995                              (list 'calcFunc-choriz
 996                                    (list 'vec
 997                                          '(calcFunc-string (vec ?d))
 998                                          (nth 2 a))))
 999                        prec)))
1000
1001 (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
1002 (defun math-compose-sqrt (a prec)
1003   (when (= (length a) 2)
1004     (let* ((c (math-compose-expr (nth 1 a) 0))
1005            (a (math-comp-ascent c))
1006            (d (math-comp-descent c))
1007            (h (+ a d))
1008            (w (math-comp-width c)))
1009       (list 'vleft
1010             a
1011             (concat (if (= h 1) " " "  ")
1012                     (make-string (+ w 2) ?\_))
1013             (list 'horiz
1014                   (if (= h 1)
1015                       "V"
1016                     (append (list 'vleft (1- a))
1017                             (make-list (1- h) " |")
1018                             '("\\|")))
1019                   " "
1020                   c)))))
1021
1022 (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
1023 (defun math-compose-choose (a prec)
1024   (let ((a1 (math-compose-expr (nth 1 a) 0))
1025         (a2 (math-compose-expr (nth 2 a) 0)))
1026     (list 'horiz
1027           "("
1028           (list 'vcent
1029                 (math-comp-height a1)
1030                 a1 " " a2)
1031           ")")))
1032
1033 (put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
1034 (defun math-compose-integ (a prec)
1035   (and (memq (length a) '(3 5))
1036        (eq (car-safe (nth 2 a)) 'var)
1037        (let* ((parens (and (>= prec 196) (/= prec 1000)))
1038               (var (math-compose-expr (nth 2 a) 0))
1039               (over (and (eq (car-safe (nth 2 a)) 'var)
1040                          (or (and (eq (car-safe (nth 1 a)) '/)
1041                                   (math-numberp (nth 1 (nth 1 a))))
1042                              (and (eq (car-safe (nth 1 a)) '^)
1043                                   (math-looks-negp (nth 2 (nth 1 a)))))))
1044               (expr (math-compose-expr (if over
1045                                            (math-mul (nth 1 a)
1046                                                      (math-build-var-name
1047                                                       (format
1048                                                        "d%s"
1049                                                        (nth 1 (nth 2 a)))))
1050                                          (nth 1 a)) 185))
1051               (calc-language 'flat)
1052               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1053               (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
1054          (list 'horiz
1055                (if parens "(" "")
1056                (append (list 'vcent (if high 3 2))
1057                        (and high (list (list 'horiz "  " high)))
1058                        '("  /"
1059                          " | "
1060                          " | "
1061                          " | "
1062                          "/  ")
1063                        (and low (list (list 'horiz low "  "))))
1064                expr
1065                (if over
1066                    ""
1067                  (list 'horiz " d" var))
1068                (if parens ")" "")))))
1069
1070 (put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
1071 (defun math-compose-sum (a prec)
1072   (and (memq (length a) '(3 5 6))
1073        (let* ((expr (math-compose-expr (nth 1 a) 185))
1074               (calc-language 'flat)
1075               (var (math-compose-expr (nth 2 a) 0))
1076               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1077               (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1078          (list 'horiz
1079                (if (memq prec '(180 201)) "(" "")
1080                (append (list 'vcent (if high 3 2))
1081                        (and high (list high))
1082                        '("---- "
1083                          "\\    "
1084                          " >   "
1085                          "/    "
1086                          "---- ")
1087                        (if low
1088                            (list (list 'horiz var " = " low))
1089                          (list var)))
1090                (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
1091                    " " "")
1092                expr
1093                (if (memq prec '(180 201)) ")" "")))))
1094
1095 (put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
1096 (defun math-compose-prod (a prec)
1097   (and (memq (length a) '(3 5 6))
1098        (let* ((expr (math-compose-expr (nth 1 a) 198))
1099               (calc-language 'flat)
1100               (var (math-compose-expr (nth 2 a) 0))
1101               (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1102               (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1103          (list 'horiz
1104                (if (memq prec '(196 201)) "(" "")
1105                (append (list 'vcent (if high 3 2))
1106                        (and high (list high))
1107                        '("----- "
1108                          " | |  "
1109                          " | |  "
1110                          " | |  ")
1111                        (if low
1112                            (list (list 'horiz var " = " low))
1113                          (list var)))
1114                (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
1115                    " " "")
1116                expr
1117                (if (memq prec '(196 201)) ")" "")))))
1118
1119 ;; The variables math-svo-c, math-svo-wid and math-svo-off are local
1120 ;; to math-stack-value-offset in calc.el, but are used by
1121 ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
1122 (defvar math-svo-c)
1123 (defvar math-svo-wid)
1124 (defvar math-svo-off)
1125
1126 (defun math-stack-value-offset-fancy ()
1127   (let ((cwid (+ (math-comp-width math-svo-c))))
1128     (cond ((eq calc-display-just 'right)
1129            (if calc-display-origin
1130                (setq math-svo-wid (max calc-display-origin 5))
1131              (if (integerp calc-line-breaking)
1132                  (setq math-svo-wid calc-line-breaking)))
1133            (setq math-svo-off (- math-svo-wid cwid
1134                         (max (- (length calc-right-label)
1135                                 (if (and (integerp calc-line-breaking)
1136                                          calc-display-origin)
1137                                     (max (- calc-line-breaking
1138                                             calc-display-origin)
1139                                          0)
1140                                   0))
1141                              0))))
1142           (t
1143            (if calc-display-origin
1144                (progn
1145                  (setq math-svo-off (- calc-display-origin (/ cwid 2)))
1146                  (if (integerp calc-line-breaking)
1147                      (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
1148                                            (length calc-right-label)))))
1149                  (if (>= math-svo-off 0)
1150                      (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
1151              (if (integerp calc-line-breaking)
1152                  (setq math-svo-wid calc-line-breaking))
1153              (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
1154     (and (integerp calc-line-breaking)
1155          (or (< math-svo-off 0)
1156              (and calc-display-origin
1157                   (> calc-line-breaking calc-display-origin)))
1158          (setq math-svo-wid calc-line-breaking))))
1159
1160
1161 ;;; Convert a composition to string form, with embedded \n's if necessary.
1162
1163 (defun math-composition-to-string (c &optional width)
1164   (or width (setq width (calc-window-width)))
1165   (if calc-display-raw
1166       (math-comp-to-string-raw c 0)
1167     (if (math-comp-is-flat c)
1168         (math-comp-to-string-flat c width)
1169       (math-vert-comp-to-string
1170        (math-comp-simplify c width)))))
1171
1172 (defvar math-comp-buf-string (make-vector 10 ""))
1173 (defvar math-comp-buf-margin (make-vector 10 0))
1174 (defvar math-comp-buf-level (make-vector 10 0))
1175 (defun math-comp-is-flat (c)     ; check if c's height is 1.
1176   (cond ((not (consp c)) t)
1177         ((memq (car c) '(set break)) t)
1178         ((eq (car c) 'horiz)
1179          (while (and (setq c (cdr c))
1180                      (math-comp-is-flat (car c))))
1181          (null c))
1182         ((memq (car c) '(vleft vcent vright))
1183          (and (= (length c) 3)
1184               (= (nth 1 c) 0)
1185               (math-comp-is-flat (nth 2 c))))
1186         ((eq (car c) 'tag)
1187          (math-comp-is-flat (nth 2 c)))
1188         (t nil)))
1189
1190
1191 ;;; Convert a one-line composition to a string.  Break into multiple
1192 ;;; lines if necessary, choosing break points according to the structure
1193 ;;; of the formula.
1194
1195 ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
1196 ;; math-comp-level, math-comp-margin and math-comp-buf are local to
1197 ;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
1198 ;; which is called by math-comp-to-string-flat.
1199 ;; math-comp-highlight and math-comp-buf are also local to
1200 ;; math-comp-simplify-term and math-comp-simplify respectively, but are used
1201 ;; by math-comp-add-string.
1202 (defvar math-comp-full-width)
1203 (defvar math-comp-highlight)
1204 (defvar math-comp-word)
1205 (defvar math-comp-level)
1206 (defvar math-comp-margin)
1207 (defvar math-comp-buf)
1208 ;; The variable math-comp-pos is local to math-comp-to-string-flat, but
1209 ;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term,
1210 ;; which are called by math-comp-to-string-flat.
1211 (defvar math-comp-pos)
1212
1213 (defun math-comp-to-string-flat (c math-comp-full-width)
1214   (if math-comp-sel-hpos
1215       (let ((math-comp-pos 0))
1216         (math-comp-sel-flat-term c))
1217     (let ((math-comp-buf "")
1218           (math-comp-word "")
1219           (math-comp-pos 0)
1220           (math-comp-margin 0)
1221           (math-comp-highlight (and math-comp-selected calc-show-selections))
1222           (math-comp-level -1))
1223       (math-comp-to-string-flat-term '(set -1 0))
1224       (math-comp-to-string-flat-term c)
1225       (math-comp-to-string-flat-term '(break -1))
1226       (let ((str (aref math-comp-buf-string 0))
1227             (prefix ""))
1228         (and (> (length str) 0) (= (aref str 0) ? )
1229              (> (length math-comp-buf) 0)
1230              (let ((k (length math-comp-buf)))
1231                (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1232                (aset math-comp-buf k ? )
1233                (if (and (< (1+ k) (length math-comp-buf))
1234                         (= (aref math-comp-buf (1+ k)) ? ))
1235                    (progn
1236                      (aset math-comp-buf (1+ k) ?\n)
1237                      (setq prefix " "))
1238                  (setq prefix "\n"))))
1239         (concat math-comp-buf prefix str)))))
1240
1241 (defun math-comp-to-string-flat-term (c)
1242   (cond ((not (consp c))
1243          (if math-comp-highlight
1244              (setq c (math-comp-highlight-string c)))
1245          (setq math-comp-word (if (= (length math-comp-word) 0) c
1246                                 (concat math-comp-word c))
1247                math-comp-pos (+ math-comp-pos (length c))))
1248
1249         ((eq (car c) 'horiz)
1250          (while (setq c (cdr c))
1251            (math-comp-to-string-flat-term (car c))))
1252
1253         ((eq (car c) 'set)
1254          (if (nth 1 c)
1255              (progn
1256                (setq math-comp-level (1+ math-comp-level))
1257                (if (>= math-comp-level (length math-comp-buf-string))
1258                    (setq math-comp-buf-string (vconcat math-comp-buf-string
1259                                                        math-comp-buf-string)
1260                          math-comp-buf-margin (vconcat math-comp-buf-margin
1261                                                        math-comp-buf-margin)
1262                          math-comp-buf-level (vconcat math-comp-buf-level
1263                                                       math-comp-buf-level)))
1264                (aset math-comp-buf-string math-comp-level "")
1265                (aset math-comp-buf-margin math-comp-level (+ math-comp-pos
1266                                                         (or (nth 2 c) 0)))
1267                (aset math-comp-buf-level math-comp-level (nth 1 c)))))
1268
1269         ((eq (car c) 'break)
1270          (if (not calc-line-breaking)
1271              (setq math-comp-buf (concat math-comp-buf math-comp-word)
1272                    math-comp-word "")
1273            (let ((i 0) str)
1274              (if (and (> math-comp-pos math-comp-full-width)
1275                       (progn
1276                         (while (progn
1277                                  (setq str (aref math-comp-buf-string i))
1278                                  (and (= (length str) 0) (< i math-comp-level)))
1279                           (setq i (1+ i)))
1280                         (or (> (length str) 0) (> (length math-comp-buf) 0))))
1281                  (let ((prefix "") mrg wid)
1282                    (setq mrg (aref math-comp-buf-margin i))
1283                    (if (> mrg 12)  ; indenting too far, go back to far left
1284                        (let ((j i) (new (if calc-line-numbering 5 1)))
1285                          '(while (<= j math-comp-level)
1286                            (aset math-comp-buf-margin j
1287                                  (+ (aref math-comp-buf-margin j) (- new mrg)))
1288                            (setq j (1+ j)))
1289                          (setq mrg new)))
1290                    (setq wid (+ (length str) math-comp-margin))
1291                    (and (> (length str) 0) (= (aref str 0) ? )
1292                         (> (length math-comp-buf) 0)
1293                         (let ((k (length math-comp-buf)))
1294                           (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1295                           (aset math-comp-buf k ? )
1296                           (if (and (< (1+ k) (length math-comp-buf))
1297                                    (= (aref math-comp-buf (1+ k)) ? ))
1298                               (progn
1299                                 (aset math-comp-buf (1+ k) ?\n)
1300                                 (setq prefix " "))
1301                             (setq prefix "\n"))))
1302                    (setq math-comp-buf (concat math-comp-buf prefix str "\n"
1303                                           (make-string mrg ? ))
1304                          math-comp-pos (+ math-comp-pos (- mrg wid))
1305                          math-comp-margin mrg)
1306                    (aset math-comp-buf-string i "")
1307                    (while (<= (setq i (1+ i)) math-comp-level)
1308                      (if (> (aref math-comp-buf-margin i) wid)
1309                          (aset math-comp-buf-margin i
1310                                (+ (aref math-comp-buf-margin i)
1311                                   (- mrg wid))))))))
1312            (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level))
1313                     (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2)))
1314                ()  ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
1315              (let ((str (aref math-comp-buf-string math-comp-level)))
1316                (setq str (if (= (length str) 0)
1317                              math-comp-word
1318                            (concat str math-comp-word))
1319                      math-comp-word "")
1320                (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level))
1321                  (setq math-comp-level (1- math-comp-level))
1322                  (or (= (length (aref math-comp-buf-string math-comp-level)) 0)
1323                      (setq str (concat (aref math-comp-buf-string math-comp-level)
1324                                        str))))
1325                (aset math-comp-buf-string math-comp-level str)))))
1326
1327         ((eq (car c) 'tag)
1328          (cond ((eq (nth 1 c) math-comp-selected)
1329                 (let ((math-comp-highlight (not calc-show-selections)))
1330                   (math-comp-to-string-flat-term (nth 2 c))))
1331                ((eq (nth 1 c) t)
1332                 (let ((math-comp-highlight nil))
1333                   (math-comp-to-string-flat-term (nth 2 c))))
1334                (t (math-comp-to-string-flat-term (nth 2 c)))))
1335
1336         (t (math-comp-to-string-flat-term (nth 2 c)))))
1337
1338 (defun math-comp-highlight-string (s)
1339   (setq s (copy-sequence s))
1340   (let ((i (length s)))
1341     (while (>= (setq i (1- i)) 0)
1342       (or (memq (aref s i) '(32 ?\n))
1343           (aset s i (if calc-show-selections ?\. ?\#)))))
1344   s)
1345
1346
1347 ;; The variable math-comp-sel-tag is local to calc-find-selected-part
1348 ;; in calc-sel.el, but is used by math-comp-sel-flat-term and
1349 ;; math-comp-add-string-sel, which are called (indirectly) by
1350 ;; calc-find-selected-part.
1351 (defvar math-comp-sel-tag)
1352
1353 (defun math-comp-sel-flat-term (c)
1354   (cond ((not (consp c))
1355          (setq math-comp-pos (+ math-comp-pos (length c))))
1356         ((memq (car c) '(set break)))
1357         ((eq (car c) 'horiz)
1358          (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
1359            (math-comp-sel-flat-term (car c))))
1360         ((eq (car c) 'tag)
1361          (if (<= math-comp-pos math-comp-sel-cpos)
1362              (progn
1363                (math-comp-sel-flat-term (nth 2 c))
1364                (if (> math-comp-pos math-comp-sel-cpos)
1365                    (setq math-comp-sel-tag c
1366                          math-comp-sel-cpos 1000000)))
1367            (math-comp-sel-flat-term (nth 2 c))))
1368         (t (math-comp-sel-flat-term (nth 2 c)))))
1369
1370
1371 ;;; Simplify a composition to a canonical form consisting of
1372 ;;;   (vleft n "string" "string" "string" ...)
1373 ;;; where 0 <= n < number-of-strings.
1374
1375 ;; The variables math-comp-base, math-comp-hgt, math-comp-tag,
1376 ;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify,
1377 ;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt),
1378 ;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term
1379 ;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by
1380 ;; math-comp-simplify.
1381 (defvar math-comp-base)
1382 (defvar math-comp-hgt)
1383 (defvar math-comp-tag)
1384 (defvar math-comp-hpos)
1385 (defvar math-comp-vpos)
1386
1387 (defun math-comp-simplify (c full-width)
1388   (let ((math-comp-buf (list ""))
1389         (math-comp-base 0)
1390         (math-comp-hgt 1)
1391         (math-comp-hpos 0)
1392         (math-comp-vpos 0)
1393         (math-comp-highlight (and math-comp-selected calc-show-selections))
1394         (math-comp-tag nil))
1395     (math-comp-simplify-term c)
1396     (cons 'vleft (cons math-comp-base math-comp-buf))))
1397
1398 (defun math-comp-add-string (s h v)
1399   (and (> (length s) 0)
1400        (let ((vv (+ v math-comp-base)))
1401          (if math-comp-sel-hpos
1402              (math-comp-add-string-sel h vv (length s) 1)
1403            (if (< vv 0)
1404                (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf)
1405                      math-comp-base (- v)
1406                      math-comp-hgt (- math-comp-hgt vv)
1407                      vv 0)
1408              (if (>= vv math-comp-hgt)
1409                  (setq math-comp-buf (nconc math-comp-buf
1410                                        (make-list (1+ (- vv math-comp-hgt)) ""))
1411                        math-comp-hgt (1+ vv))))
1412            (let ((str (nthcdr vv math-comp-buf)))
1413              (setcar str (concat (car str)
1414                                  (make-string (- h (length (car str))) 32)
1415                                  (if math-comp-highlight
1416                                      (math-comp-highlight-string s)
1417                                    s))))))))
1418
1419 (defun math-comp-add-string-sel (x y w h)
1420   (if (and (<= y math-comp-sel-vpos)
1421            (> (+ y h) math-comp-sel-vpos)
1422            (<= x math-comp-sel-hpos)
1423            (> (+ x w) math-comp-sel-hpos))
1424       (setq math-comp-sel-tag math-comp-tag
1425             math-comp-sel-vpos 10000)))
1426
1427 (defun math-comp-simplify-term (c)
1428   (cond ((stringp c)
1429          (math-comp-add-string c math-comp-hpos math-comp-vpos)
1430          (setq math-comp-hpos (+ math-comp-hpos (length c))))
1431         ((memq (car c) '(set break))
1432          nil)
1433         ((eq (car c) 'horiz)
1434          (while (setq c (cdr c))
1435            (math-comp-simplify-term (car c))))
1436         ((memq (car c) '(vleft vcent vright))
1437          (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c))
1438                               (1- (math-comp-ascent (nth 2 c)))))
1439                 (widths (mapcar 'math-comp-width (cdr (cdr c))))
1440                 (maxwid (apply 'max widths))
1441                 (bias (cond ((eq (car c) 'vleft) 0)
1442                             ((eq (car c) 'vcent) 1)
1443                             (t 2))))
1444            (setq c (cdr c))
1445            (while (setq c (cdr c))
1446              (if (eq (car-safe (car c)) 'rule)
1447                  (math-comp-add-string (make-string maxwid (nth 1 (car c)))
1448                                        math-comp-hpos math-comp-vpos)
1449                (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid
1450                                                            (car widths)))
1451                                                 2))))
1452                  (math-comp-simplify-term (car c))))
1453              (and (cdr c)
1454                   (setq math-comp-vpos (+ math-comp-vpos
1455                                      (+ (math-comp-descent (car c))
1456                                         (math-comp-ascent (nth 1 c))))
1457                         widths (cdr widths))))
1458            (setq math-comp-hpos (+ math-comp-hpos maxwid))))
1459         ((eq (car c) 'supscr)
1460          (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
1461                 (desc (math-comp-descent (nth 2 c)))
1462                 (oldh (prog1
1463                           math-comp-hpos
1464                         (math-comp-simplify-term (nth 1 c))))
1465                 (math-comp-vpos (- math-comp-vpos (+ asc desc))))
1466            (math-comp-simplify-term (nth 2 c))
1467            (if math-comp-sel-hpos
1468                (math-comp-add-string-sel oldh
1469                                          (- math-comp-vpos
1470                                             -1
1471                                             (math-comp-ascent (nth 2 c)))
1472                                          (- math-comp-hpos oldh)
1473                                          (math-comp-height c)))))
1474         ((eq (car c) 'subscr)
1475          (let* ((asc (math-comp-ascent (nth 2 c)))
1476                 (desc (math-comp-descent (nth 1 c)))
1477                 (oldv math-comp-vpos)
1478                 (oldh (prog1
1479                           math-comp-hpos
1480                         (math-comp-simplify-term (nth 1 c))))
1481                 (math-comp-vpos (+ math-comp-vpos (+ asc desc))))
1482            (math-comp-simplify-term (nth 2 c))
1483            (if math-comp-sel-hpos
1484                (math-comp-add-string-sel oldh oldv
1485                                          (- math-comp-hpos oldh)
1486                                          (math-comp-height c)))))
1487         ((eq (car c) 'tag)
1488          (cond ((eq (nth 1 c) math-comp-selected)
1489                 (let ((math-comp-highlight (not calc-show-selections)))
1490                   (math-comp-simplify-term (nth 2 c))))
1491                ((eq (nth 1 c) t)
1492                 (let ((math-comp-highlight nil))
1493                   (math-comp-simplify-term (nth 2 c))))
1494                (t (let ((math-comp-tag c))
1495                     (math-comp-simplify-term (nth 2 c))))))))
1496
1497
1498 ;;; Measuring a composition.
1499
1500 (defun math-comp-first-char (c)
1501   (cond ((stringp c)
1502          (and (> (length c) 0)
1503               (elt c 0)))
1504         ((memq (car c) '(horiz subscr supscr))
1505          (while (and (setq c (cdr c))
1506                      (math-comp-is-null (car c))))
1507          (and c (math-comp-first-char (car c))))
1508         ((eq (car c) 'tag)
1509          (math-comp-first-char (nth 2 c)))))
1510
1511 (defun math-comp-first-string (c)
1512   (cond ((stringp c)
1513          (and (> (length c) 0)
1514               c))
1515         ((eq (car c) 'horiz)
1516          (while (and (setq c (cdr c))
1517                      (math-comp-is-null (car c))))
1518          (and c (math-comp-first-string (car c))))
1519         ((eq (car c) 'tag)
1520          (math-comp-first-string (nth 2 c)))))
1521
1522 (defun math-comp-last-char (c)
1523   (cond ((stringp c)
1524          (and (> (length c) 0)
1525               (elt c (1- (length c)))))
1526         ((eq (car c) 'horiz)
1527          (let ((c (reverse (cdr c))))
1528            (while (and c (math-comp-is-null (car c)))
1529              (setq c (cdr c)))
1530            (and c (math-comp-last-char (car c)))))
1531         ((eq (car c) 'tag)
1532          (math-comp-last-char (nth 2 c)))))
1533
1534 (defun math-comp-is-null (c)
1535   (cond ((stringp c) (= (length c) 0))
1536         ((memq (car c) '(horiz subscr supscr))
1537          (while (and (setq c (cdr c))
1538                      (math-comp-is-null (car c))))
1539          (null c))
1540         ((eq (car c) 'tag)
1541          (math-comp-is-null (nth 2 c)))
1542         ((memq (car c) '(set break)) t)))
1543
1544 (defun math-comp-width (c)
1545   (cond ((not (consp c)) (length c))
1546         ((memq (car c) '(horiz subscr supscr))
1547          (let ((accum 0))
1548            (while (setq c (cdr c))
1549              (setq accum (+ accum (math-comp-width (car c)))))
1550            accum))
1551         ((memq (car c) '(vcent vleft vright))
1552          (setq c (cdr c))
1553          (let ((accum 0))
1554            (while (setq c (cdr c))
1555              (setq accum (max accum (math-comp-width (car c)))))
1556            accum))
1557         ((eq (car c) 'tag)
1558          (math-comp-width (nth 2 c)))
1559         (t 0)))
1560
1561 (defun math-comp-height (c)
1562   (if (stringp c)
1563       1
1564     (+ (math-comp-ascent c) (math-comp-descent c))))
1565
1566 (defun math-comp-ascent (c)
1567   (cond ((not (consp c)) 1)
1568         ((eq (car c) 'horiz)
1569          (let ((accum 0))
1570            (while (setq c (cdr c))
1571              (setq accum (max accum (math-comp-ascent (car c)))))
1572            accum))
1573         ((memq (car c) '(vcent vleft vright))
1574          (if (> (nth 1 c) 0) (1+ (nth 1 c)) 1))
1575         ((eq (car c) 'supscr)
1576          (max (math-comp-ascent (nth 1 c)) (1+ (math-comp-height (nth 2 c)))))
1577         ((eq (car c) 'subscr)
1578          (math-comp-ascent (nth 1 c)))
1579         ((eq (car c) 'tag)
1580          (math-comp-ascent (nth 2 c)))
1581         (t 1)))
1582
1583 (defun math-comp-descent (c)
1584   (cond ((not (consp c)) 0)
1585         ((eq (car c) 'horiz)
1586          (let ((accum 0))
1587            (while (setq c (cdr c))
1588              (setq accum (max accum (math-comp-descent (car c)))))
1589            accum))
1590         ((memq (car c) '(vcent vleft vright))
1591          (let ((accum (- (nth 1 c))))
1592            (setq c (cdr c))
1593            (while (setq c (cdr c))
1594              (setq accum (+ accum (math-comp-height (car c)))))
1595            (max (1- accum) 0)))
1596         ((eq (car c) 'supscr)
1597          (math-comp-descent (nth 1 c)))
1598         ((eq (car c) 'subscr)
1599          (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
1600         ((eq (car c) 'tag)
1601          (math-comp-descent (nth 2 c)))
1602         (t 0)))
1603
1604 (defun calcFunc-cwidth (a &optional prec)
1605   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1606   (math-comp-width (math-compose-expr a (or prec 0))))
1607
1608 (defun calcFunc-cheight (a &optional prec)
1609   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1610   (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
1611            (memq (length a) '(2 3))
1612            (eq (nth 1 a) 0))
1613       0
1614     (math-comp-height (math-compose-expr a (or prec 0)))))
1615
1616 (defun calcFunc-cascent (a &optional prec)
1617   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1618   (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
1619            (memq (length a) '(2 3))
1620            (eq (nth 1 a) 0))
1621       0
1622     (math-comp-ascent (math-compose-expr a (or prec 0)))))
1623
1624 (defun calcFunc-cdescent (a &optional prec)
1625   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1626   (math-comp-descent (math-compose-expr a (or prec 0))))
1627
1628
1629 ;;; Convert a simplified composition into string form.
1630
1631 (defun math-vert-comp-to-string (c)
1632   (if (stringp c)
1633       c
1634     (math-vert-comp-to-string-step (cdr (cdr c)))))
1635
1636 (defun math-vert-comp-to-string-step (c)
1637   (if (cdr c)
1638       (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
1639     (car c)))
1640
1641
1642 ;;; Convert a composition to a string in "raw" form (for debugging).
1643
1644 (defun math-comp-to-string-raw (c indent)
1645   (cond ((or (not (consp c)) (eq (car c) 'set))
1646          (prin1-to-string c))
1647         ((null (cdr c))
1648          (concat "(" (symbol-name (car c)) ")"))
1649         (t
1650          (let ((next-indent (+ indent 2 (length (symbol-name (car c))))))
1651            (concat "("
1652                    (symbol-name (car c))
1653                    " "
1654                    (math-comp-to-string-raw (nth 1 c) next-indent)
1655                    (math-comp-to-string-raw-step (cdr (cdr c))
1656                                                  next-indent)
1657                    ")")))))
1658
1659 (defun math-comp-to-string-raw-step (cl indent)
1660   (if cl
1661       (concat "\n"
1662               (make-string indent 32)
1663               (math-comp-to-string-raw (car cl) indent)
1664               (math-comp-to-string-raw-step (cdr cl) indent))
1665     ""))
1666
1667 (provide 'calccomp)
1668
1669 ;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
1670 ;;; calccomp.el ends here