• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10.1/emacs-93/emacs/lisp/calc/

Lines Matching +defs:math +defs:comp +defs:height

35 (defconst math-eqn-special-funcs
61 ;;; (rule X) Horizontal line of X, full width of enclosing comp
65 ;; math-comp-just and math-comp-comma-spc are local to
66 ;; math-compose-expr, but are used by math-compose-matrix, which is
67 ;; called by math-compose-expr
68 (defvar math-comp-just)
69 (defvar math-comp-comma-spc)
71 ;; math-comp-vector-prec is local to math-compose-expr, but is used by
72 ;; math-compose-matrix and math-compose-rows, which are called by
73 ;; math-compose-expr.
74 (defvar math-comp-vector-prec)
76 ;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
77 ;; local to math-compose-expr, but are used by math-compose-rows, which is
78 ;; called by math-compose-expr.
79 (defvar math-comp-left-bracket)
80 (defvar math-comp-right-bracket)
81 (defvar math-comp-comma)
84 (defun math-compose-expr (a prec)
85 (let ((math-compose-level (1+ math-compose-level))
88 ((or (and (eq a math-comp-selected) a)
89 (and math-comp-tagged
90 (not (eq math-comp-tagged a))))
91 (let ((math-comp-selected nil))
92 (and math-comp-tagged (setq math-comp-tagged a))
93 (list 'tag a (math-compose-expr a prec))))
96 ((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
99 ((math-scalarp a)
102 (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
103 (let ((aa (math-adjust-fraction a))
105 (math-compose-expr (list '/
107 (math-float (nth 1 aa))
112 (let* ((aa (math-adjust-fraction a))
114 (math-radix-explicit-format nil)
116 (if (math-negp (nth 1 aa))
119 (math-format-number
120 (math-abs (nth 1 aa)))
122 (math-format-number (nth 2 aa))))))
128 (math-format-number a)))
130 (math-format-number a prec)
132 (if (math-zerop (nth 2 a))
133 (math-compose-expr (nth 1 a) prec)
135 (math-compose-expr (nth 1 a) 0)
137 (math-compose-expr (nth 2 a) 0) ")"))
142 (math-format-number a prec)
143 (let ((s (math-format-number a prec))
151 (math-match-substring s 2)
152 (math-match-substring s 1))))
159 (math-match-substring s 1)
160 (math-match-substring s 2))
161 (math-match-substring s 3))))
163 ((and (get (car a) 'math-compose-forms)
165 (let ((comps (get (car a) 'math-compose-forms))
170 (math-compose-expr temp prec))
176 (math-compose-expr temp prec))
180 (let* ((math-comp-left-bracket (if calc-vector-brackets
182 (math-comp-right-bracket (if calc-vector-brackets
187 (math-comp-comma-spc (or calc-vector-commas " "))
188 (math-comp-comma (or calc-vector-commas ""))
189 (math-comp-vector-prec (if (or (and calc-vector-commas
190 (math-vector-no-parens a))
192 (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
198 (math-matrixp a) (not (math-matrixp (nth 1 a)))
203 (setq math-comp-vector-prec (if (or (and calc-vector-commas
204 (math-vector-no-parens
210 (concat math-comp-left-bracket math-comp-left-bracket " ")
211 (math-compose-vector (cdr (nth 1 a)) (concat math-comp-comma " ")
212 math-comp-vector-prec)
213 (concat " " math-comp-right-bracket math-comp-right-bracket))
222 (concat math-comp-left-bracket
225 (concat math-comp-left-bracket
232 math-comp-left-bracket
234 (math-compose-matrix (cdr a) 1 cols base)
240 math-comp-right-bracket
242 math-comp-comma))
249 math-comp-right-bracket))
253 math-comp-right-bracket)))))))))
256 (math-vector-is-string a))
257 (math-vector-to-string a t)
266 (math-compose-rows
271 (math-matrixp a))
277 (math-compose-tex-matrix (cdr a))
280 (math-compose-tex-matrix (cdr a))
283 (math-matrixp a))
289 (math-compose-tex-matrix (cdr a) t)
292 (math-compose-tex-matrix (cdr a) t)
295 (math-matrixp a))
297 (math-compose-eqn-matrix
298 (cdr (math-transpose a)))
301 (math-matrixp a))
304 math-comp-left-bracket
305 (math-compose-vector (cdr a)
306 (concat math-comp-comma " ")
307 math-comp-vector-prec)
308 math-comp-right-bracket
311 math-comp-left-bracket
312 (math-compose-vector (cdr a)
313 (concat math-comp-comma " ")
314 math-comp-vector-prec)
315 math-comp-right-bracket)))))
317 math-comp-left-bracket
318 (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
319 (concat math-comp-comma " ")
320 math-comp-vector-prec)
321 math-comp-comma (if (memq calc-language '(tex latex))
323 math-comp-comma " "
324 (list 'break math-compose-level)
325 (math-compose-expr (nth (1- (length a)) a)
326 (if (equal math-comp-comma "") 1000 0))
327 math-comp-right-bracket)))))))
332 (math-compose-vector (cdr (cdr a)) ", " 0)
336 (math-compose-vector (cdr (cdr a)) ", " 0)
340 (math-compose-vector (cdr (cdr a)) "; " 0)
345 (math-compose-vector (cdr (cdr (cdr a))) " .. " 0)
353 (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
364 (if (and math-compose-hash-args
368 (setq p (and (eq math-compose-hash-args t) (cdr p))
371 (if (eq math-compose-hash-args 1)
375 (math-to-underscores (symbol-name (nth 1 a)))
378 (math-compose-expr
390 (math-compose-expr (nth 2 a) 0)
393 (math-compose-expr (nth 3 a) 0)
398 (math-format-date a)
399 (concat "<" (math-format-date a) ">")))
408 (math-compose-expr (nth 1 a) 1000)
410 (math-compose-vector args ", " 0)
414 (let* ((a1 (math-compose-expr (nth 1 a) 1000))
416 (a2 (math-compose-expr (nth 2 a) 0)))
429 (eq calc-language 'math))
431 (math-compose-expr (nth 1 a) 1000)
433 (math-compose-expr (nth 2 a) 0)
439 (math-compose-expr (nth 1 a) 0)
445 (math-compose-expr (nth 1 a) -1)
450 (if (or (math-looks-negp (nth 1 a))
453 (math-negp (nth 1 (nth 1 a)))
455 (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
456 (math-compose-expr (nth 1 a) 201))
459 (math-compose-expr (nth 2 a) 0))))
464 (math-compose-expr (nth 1 a) 0)))
467 (math-compose-expr (nth 2 a) 0))))
469 (math-comp-height a1)
475 "_{" (math-compose-expr (nth 2 a) 0)
476 "=" (math-compose-expr (nth 3 a) 0)
477 "}^{" (math-compose-expr (nth 4 a) 0)
478 "}{" (math-compose-expr (nth 1 a) 0) "}"))
484 (math-compose-hash-args (if (= (length a) 3) 1 t)))
489 (list (math-compose-vector
493 (list (math-compose-expr (nth (1- (length a)) a) 0)
497 (math-vectorp (nth 1 a))
498 (math-vector-is-string (nth 1 a)))
500 (concat "string(" (math-vector-to-string (nth 1 a) t) ")")
501 (math-vector-to-string (nth 1 a) nil)))
504 (math-vectorp (nth 1 a))
505 (math-vector-is-string (nth 1 a)))
507 (concat "bstring(" (math-vector-to-string (nth 1 a) t) ")")
509 (s (math-vector-to-string (nth 1 a) nil))
513 c (cons (list 'break math-compose-level)
519 (setq c (cons (list 'set math-compose-level 2) c)))
525 (let ((c (math-compose-expr (nth 1 a) -1)))
536 (math-vectorp (nth 1 a))
539 (and (math-vectorp (nth 3 a))
540 (math-vector-is-string (nth 3 a))))
542 (and (math-vectorp (nth 2 a))
543 (math-vector-is-string (nth 2 a))))))
548 (math-compose-vector (cdr (nth 1 a))
549 (math-vector-to-string sep nil)
555 (math-compose-expr
558 (math-compose-expr x (or cprec prec)))))
563 (math-vectorp (nth 1 a))
581 (and (math-vectorp (nth 1 x))
583 (math-vector-is-string
589 (if (math-vectorp (nth 1 x))
590 (aref (math-vector-to-string
599 (setq cc (math-compose-expr x prec))))
600 (setq a (if cc (math-comp-ascent cc) 0)
601 d (if cc (math-comp-descent cc) 0))
623 (math-compose-expr (nth 1 a) (or (nth 3 a) 0))
624 (math-compose-expr (nth 2 a) 0)))
632 (math-compose-expr (nth 1 a) (or (nth 2 a) 0))))
638 (if (and (math-vectorp (nth 2 a))
639 (math-vector-is-string (nth 2 a)))
640 (math-vector-to-string (nth 2 a) nil)
641 (math-compose-expr (nth 2 a) 0))))
649 (if (and (math-vectorp (nth 2 a))
650 (math-vector-is-string (nth 2 a)))
651 (math-vector-to-string (nth 2 a) nil)
652 (math-compose-expr (nth 2 a) 0))
654 (ca (math-comp-ascent c))
655 (cd (math-comp-descent c)))
666 (= math-compose-level (if math-comp-tagged 2 1))
670 (math-compose-expr (nth 1 a) 0)
672 (math-compose-expr (nth 2 a) 0)))
676 (assoc "?" math-expr-opers)
677 (math-assq2 (car a) math-expr-opers)))))
684 (not (math-tex-expr-is-flat a)))
686 (list 'horiz "{" (math-compose-expr a -1) "}")
688 (math-compose-expr a -1)
693 (list 'horiz "{" (math-compose-expr a -1) "}")
694 (if (math-tex-expr-is-flat a)
695 (list 'horiz "( " (math-compose-expr a -1) " )")
697 (math-compose-expr a -1)
699 (list 'horiz "(" (math-compose-expr a 0) ")"))))
703 (list 'horiz "{" (math-compose-expr a -1) "}"))
706 (math-compose-expr (nth 1 a) (nth 2 op))
708 (math-compose-expr (nth 2 a) 0)
710 (math-compose-expr (nth 3 a) (nth 3 op))))
712 (let* ((math-comp-tagged (and math-comp-tagged
713 (not (math-primp a))
714 math-comp-tagged))
717 (setq math-compose-level
718 (1- math-compose-level))
720 math-compose-level))
721 (lhs (math-compose-expr (nth 1 a) (nth 2 op)))
722 (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
724 (eq (math-comp-first-char lhs) ?-)
732 (assoc "2x" math-expr-opers))
733 (let* ((prevt (math-prod-last-term (nth 1 a)))
734 (nextt (math-prod-first-term (nth 2 a)))
735 (prevc (or (math-comp-last-char lhs)
742 (nextc (or (math-comp-first-char rhs)
759 (math-comp-first-string
766 (list 'break math-compose-level)
772 (list 'break math-compose-level)
777 (math-comp-last-char lhs)
778 (math-comp-first-char rhs))
780 (math-num-integerp (nth 1 a))
781 (math-integerp (nth 2 a))))
791 (and (not (eq (assoc (car op) math-expr-opers) op))
794 (not (math-tex-expr-is-flat a)))
796 (math-compose-expr a -1)
800 (list 'horiz "{" (math-compose-expr a -1) "}")
801 (if (math-tex-expr-is-flat a)
802 (list 'horiz "{( " (math-compose-expr a -1) " )}")
804 (math-compose-expr a -1)
806 (list 'horiz "(" (math-compose-expr a 0) ")"))))
808 (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
812 (not (math-comp-is-flat lhs)))
819 (not (math-tex-expr-is-flat (nth 1 a))))))
826 (math-compose-expr (nth 1 a) -1)
829 (car (nth 1 (memq op math-expr-opers))))))
832 (not (math-tex-expr-is-flat a)))
834 (math-compose-expr a -1)
838 (list 'horiz "{" (math-compose-expr a -1) "}")
839 (if (math-tex-expr-is-flat a)
840 (list 'horiz "{( " (math-compose-expr a -1) " )}")
842 (math-compose-expr a -1)
844 (list 'horiz "(" (math-compose-expr a 0) ")"))))
846 (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
853 (not (math-comp-is-flat rhs)))
858 (setq op (get (car a) 'math-compose-big))
861 '( ( nil . math-compose-normal )
862 ( flat . math-compose-normal )
863 ( big . math-compose-normal )
864 ( c . math-compose-c )
865 ( pascal . math-compose-pascal )
866 ( fortran . math-compose-fortran )
867 ( tex . math-compose-tex )
868 ( latex . math-compose-latex )
869 ( eqn . math-compose-eqn )
870 ( math . math-compose-math )
871 ( maple . math-compose-maple ))))
889 (if (setq func2 (rassq func math-expr-function-mapping))
891 (setq func (math-remove-dashes
895 (math-match-substring (symbol-name func) 1)
898 (setq func (math-to-underscores func)))
916 (not (math-tex-expr-is-flat (nth 1 a)))))
921 (not (math-tex-expr-is-flat (nth 1 a)))))
927 (memq (car a) math-eqn-special-funcs)))
942 (math-compose-vector (cdr a)
949 (defun math-prod-first-term (x)
954 (defun math-prod-last-term (x)
959 (defun math-compose-vector (a sep prec)
962 (cons (list 'set math-compose-level)
963 (let ((c (list (math-compose-expr (car a) prec))))
967 (let ((math-compose-level
968 (1- math-compose-level)))
969 (math-compose-expr (car a) -123))
970 (math-compose-expr (car a) prec))
971 (cons (list 'break math-compose-level)
976 (defun math-vector-no-parens (a)
980 (defun math-compose-matrix (a col cols base)
984 (setq res (cons (cons math-comp-just
989 (math-compose-expr
991 math-comp-vector-prec)
995 math-comp-comma-spc " ")))))
1000 (defun math-compose-rows (a count first)
1004 (math-compose-rows (cdr a) -1 nil)
1006 math-comp-comma)
1007 (math-compose-rows (cdr a) -1 nil)))
1009 (if first (concat math-comp-left-bracket " ") " ")
1010 (math-compose-expr (car a) math-comp-vector-prec)
1011 math-comp-comma)
1012 (math-compose-rows (cdr a) (1- count) nil)))
1014 (if first (concat math-comp-left-bracket " ") " ")
1015 (math-compose-expr (car a) math-comp-vector-prec)
1016 (concat " " math-comp-right-bracket)))))
1018 (defun math-compose-tex-matrix (a &optional ltx)
1020 (cons (append (math-compose-vector (cdr (car a)) " & " 0)
1022 (math-compose-tex-matrix (cdr a) ltx))
1023 (list (math-compose-vector (cdr (car a)) " & " 0))))
1025 (defun math-compose-eqn-matrix (a)
1032 (list 'break math-compose-level)
1036 (let ((math-compose-level (1+ math-compose-level)))
1037 (math-compose-vector (cdr (car a)) " above " 1000))
1040 (math-compose-eqn-matrix (cdr a)))))))
1043 (defun math-vector-is-string (a)
1053 (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
1064 (defun math-vector-to-string (a &optional quoted)
1070 (codes (if quoted math-vector-to-string-chars '((?\^? . "^?"))))
1088 (defun math-to-underscores (x)
1090 (math-to-underscores
1091 (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
1094 (defun math-tex-expr-is-flat (a)
1100 (math-tex-expr-is-flat (car a))))
1103 (math-tex-expr-is-flat (nth 1 a)))))
1105 (put 'calcFunc-log 'math-compose-big 'math-compose-log)
1106 (defun math-compose-log (a prec)
1111 (math-compose-expr (nth 2 a) 1000)))
1113 (math-compose-expr (nth 1 a) 1000)
1116 (put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
1117 (defun math-compose-log10 (a prec)
1122 (math-compose-expr (nth 1 a) 1000)
1125 (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
1126 (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
1127 (defun math-compose-deriv (a prec)
1129 (math-compose-expr (list '/
1140 (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
1141 (defun math-compose-sqrt (a prec)
1143 (let* ((c (math-compose-expr (nth 1 a) 0))
1144 (a (math-comp-ascent c))
1145 (d (math-comp-descent c))
1147 (w (math-comp-width c)))
1161 (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
1162 (defun math-compose-choose (a prec)
1163 (let ((a1 (math-compose-expr (nth 1 a) 0))
1164 (a2 (math-compose-expr (nth 2 a) 0)))
1168 (math-comp-height a1)
1172 (put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
1173 (defun math-compose-integ (a prec)
1177 (var (math-compose-expr (nth 2 a) 0))
1180 (math-numberp (nth 1 (nth 1 a))))
1182 (math-looks-negp (nth 2 (nth 1 a)))))))
1183 (expr (math-compose-expr (if over
1184 (math-mul (nth 1 a)
1185 (math-build-var-name
1191 (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1192 (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
1209 (put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
1210 (defun math-compose-sum (a prec)
1212 (let* ((expr (math-compose-expr (nth 1 a) 185))
1214 (var (math-compose-expr (nth 2 a) 0))
1215 (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1216 (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1234 (put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
1235 (defun math-compose-prod (a prec)
1237 (let* ((expr (math-compose-expr (nth 1 a) 198))
1239 (var (math-compose-expr (nth 2 a) 0))
1240 (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
1241 (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
1258 ;; The variables math-svo-c, math-svo-wid and math-svo-off are local
1259 ;; to math-stack-value-offset in calc.el, but are used by
1260 ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
1261 (defvar math-svo-c)
1262 (defvar math-svo-wid)
1263 (defvar math-svo-off)
1265 (defun math-stack-value-offset-fancy ()
1266 (let ((cwid (+ (math-comp-width math-svo-c))))
1269 (setq math-svo-wid (max calc-display-origin 5))
1271 (setq math-svo-wid calc-line-breaking)))
1272 (setq math-svo-off (- math-svo-wid cwid
1284 (setq math-svo-off (- calc-display-origin (/ cwid 2)))
1286 (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
1288 (if (>= math-svo-off 0)
1289 (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
1291 (setq math-svo-wid calc-line-breaking))
1292 (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
1294 (or (< math-svo-off 0)
1297 (setq math-svo-wid calc-line-breaking))))
1302 (defun math-composition-to-string (c &optional width)
1305 (math-comp-to-string-raw c 0)
1306 (if (math-comp-is-flat c)
1307 (math-comp-to-string-flat c width)
1308 (math-vert-comp-to-string
1309 (math-comp-simplify c width)))))
1311 (defvar math-comp-buf-string (make-vector 10 ""))
1312 (defvar math-comp-buf-margin (make-vector 10 0))
1313 (defvar math-comp-buf-level (make-vector 10 0))
1314 (defun math-comp-is-flat (c) ; check if c's height is 1.
1319 (math-comp-is-flat (car c))))
1324 (math-comp-is-flat (nth 2 c))))
1326 (math-comp-is-flat (nth 2 c)))
1334 ;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
1335 ;; math-comp-level, math-comp-margin and math-comp-buf are local to
1336 ;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
1337 ;; which is called by math-comp-to-string-flat.
1338 ;; math-comp-highlight and math-comp-buf are also local to
1339 ;; math-comp-simplify-term and math-comp-simplify respectively, but are used
1340 ;; by math-comp-add-string.
1341 (defvar math-comp-full-width)
1342 (defvar math-comp-highlight)
1343 (defvar math-comp-word)
1344 (defvar math-comp-level)
1345 (defvar math-comp-margin)
1346 (defvar math-comp-buf)
1347 ;; The variable math-comp-pos is local to math-comp-to-string-flat, but
1348 ;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term,
1349 ;; which are called by math-comp-to-string-flat.
1350 (defvar math-comp-pos)
1352 (defun math-comp-to-string-flat (c math-comp-full-width)
1353 (if math-comp-sel-hpos
1354 (let ((math-comp-pos 0))
1355 (math-comp-sel-flat-term c))
1356 (let ((math-comp-buf "")
1357 (math-comp-word "")
1358 (math-comp-pos 0)
1359 (math-comp-margin 0)
1360 (math-comp-highlight (and math-comp-selected calc-show-selections))
1361 (math-comp-level -1))
1362 (math-comp-to-string-flat-term '(set -1 0))
1363 (math-comp-to-string-flat-term c)
1364 (math-comp-to-string-flat-term '(break -1))
1365 (let ((str (aref math-comp-buf-string 0))
1368 (> (length math-comp-buf) 0)
1369 (let ((k (length math-comp-buf)))
1370 (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1371 (aset math-comp-buf k ? )
1372 (if (and (< (1+ k) (length math-comp-buf))
1373 (= (aref math-comp-buf (1+ k)) ? ))
1375 (aset math-comp-buf (1+ k) ?\n)
1378 (concat math-comp-buf prefix str)))))
1380 (defun math-comp-to-string-flat-term (c)
1382 (if math-comp-highlight
1383 (setq c (math-comp-highlight-string c)))
1384 (setq math-comp-word (if (= (length math-comp-word) 0) c
1385 (concat math-comp-word c))
1386 math-comp-pos (+ math-comp-pos (length c))))
1390 (math-comp-to-string-flat-term (car c))))
1395 (setq math-comp-level (1+ math-comp-level))
1396 (if (>= math-comp-level (length math-comp-buf-string))
1397 (setq math-comp-buf-string (vconcat math-comp-buf-string
1398 math-comp-buf-string)
1399 math-comp-buf-margin (vconcat math-comp-buf-margin
1400 math-comp-buf-margin)
1401 math-comp-buf-level (vconcat math-comp-buf-level
1402 math-comp-buf-level)))
1403 (aset math-comp-buf-string math-comp-level "")
1404 (aset math-comp-buf-margin math-comp-level (+ math-comp-pos
1406 (aset math-comp-buf-level math-comp-level (nth 1 c)))))
1410 (setq math-comp-buf (concat math-comp-buf math-comp-word)
1411 math-comp-word "")
1413 (if (and (> math-comp-pos math-comp-full-width)
1416 (setq str (aref math-comp-buf-string i))
1417 (and (= (length str) 0) (< i math-comp-level)))
1419 (or (> (length str) 0) (> (length math-comp-buf) 0))))
1421 (setq mrg (aref math-comp-buf-margin i))
1424 '(while (<= j math-comp-level)
1425 (aset math-comp-buf-margin j
1426 (+ (aref math-comp-buf-margin j) (- new mrg)))
1429 (setq wid (+ (length str) math-comp-margin))
1431 (> (length math-comp-buf) 0)
1432 (let ((k (length math-comp-buf)))
1433 (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
1434 (aset math-comp-buf k ? )
1435 (if (and (< (1+ k) (length math-comp-buf))
1436 (= (aref math-comp-buf (1+ k)) ? ))
1438 (aset math-comp-buf (1+ k) ?\n)
1441 (setq math-comp-buf (concat math-comp-buf prefix str "\n"
1443 math-comp-pos (+ math-comp-pos (- mrg wid))
1444 math-comp-margin mrg)
1445 (aset math-comp-buf-string i "")
1446 (while (<= (setq i (1+ i)) math-comp-level)
1447 (if (> (aref math-comp-buf-margin i) wid)
1448 (aset math-comp-buf-margin i
1449 (+ (aref math-comp-buf-margin i)
1451 (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level))
1452 (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2)))
1454 (let ((str (aref math-comp-buf-string math-comp-level)))
1456 math-comp-word
1457 (concat str math-comp-word))
1458 math-comp-word "")
1459 (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level))
1460 (setq math-comp-level (1- math-comp-level))
1461 (or (= (length (aref math-comp-buf-string math-comp-level)) 0)
1462 (setq str (concat (aref math-comp-buf-string math-comp-level)
1464 (aset math-comp-buf-string math-comp-level str)))))
1467 (cond ((eq (nth 1 c) math-comp-selected)
1468 (let ((math-comp-highlight (not calc-show-selections)))
1469 (math-comp-to-string-flat-term (nth 2 c))))
1471 (let ((math-comp-highlight nil))
1472 (math-comp-to-string-flat-term (nth 2 c))))
1473 (t (math-comp-to-string-flat-term (nth 2 c)))))
1475 (t (math-comp-to-string-flat-term (nth 2 c)))))
1477 (defun math-comp-highlight-string (s)
1486 ;; The variable math-comp-sel-tag is local to calc-find-selected-part
1487 ;; in calc-sel.el, but is used by math-comp-sel-flat-term and
1488 ;; math-comp-add-string-sel, which are called (indirectly) by
1490 (defvar math-comp-sel-tag)
1492 (defun math-comp-sel-flat-term (c)
1494 (setq math-comp-pos (+ math-comp-pos (length c))))
1497 (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
1498 (math-comp-sel-flat-term (car c))))
1500 (if (<= math-comp-pos math-comp-sel-cpos)
1502 (math-comp-sel-flat-term (nth 2 c))
1503 (if (> math-comp-pos math-comp-sel-cpos)
1504 (setq math-comp-sel-tag c
1505 math-comp-sel-cpos 1000000)))
1506 (math-comp-sel-flat-term (nth 2 c))))
1507 (t (math-comp-sel-flat-term (nth 2 c)))))
1514 ;; The variables math-comp-base, math-comp-hgt, math-comp-tag,
1515 ;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify,
1516 ;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt),
1517 ;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term
1518 ;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by
1519 ;; math-comp-simplify.
1520 (defvar math-comp-base)
1521 (defvar math-comp-hgt)
1522 (defvar math-comp-tag)
1523 (defvar math-comp-hpos)
1524 (defvar math-comp-vpos)
1526 (defun math-comp-simplify (c full-width)
1527 (let ((math-comp-buf (list ""))
1528 (math-comp-base 0)
1529 (math-comp-hgt 1)
1530 (math-comp-hpos 0)
1531 (math-comp-vpos 0)
1532 (math-comp-highlight (and math-comp-selected calc-show-selections))
1533 (math-comp-tag nil))
1534 (math-comp-simplify-term c)
1535 (cons 'vleft (cons math-comp-base math-comp-buf))))
1537 (defun math-comp-add-string (s h v)
1539 (let ((vv (+ v math-comp-base)))
1540 (if math-comp-sel-hpos
1541 (math-comp-add-string-sel h vv (length s) 1)
1543 (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf)
1544 math-comp-base (- v)
1545 math-comp-hgt (- math-comp-hgt vv)
1547 (if (>= vv math-comp-hgt)
1548 (setq math-comp-buf (nconc math-comp-buf
1549 (make-list (1+ (- vv math-comp-hgt)) ""))
1550 math-comp-hgt (1+ vv))))
1551 (let ((str (nthcdr vv math-comp-buf)))
1554 (if math-comp-highlight
1555 (math-comp-highlight-string s)
1558 (defun math-comp-add-string-sel (x y w h)
1559 (if (and (<= y math-comp-sel-vpos)
1560 (> (+ y h) math-comp-sel-vpos)
1561 (<= x math-comp-sel-hpos)
1562 (> (+ x w) math-comp-sel-hpos))
1563 (setq math-comp-sel-tag math-comp-tag
1564 math-comp-sel-vpos 10000)))
1566 (defun math-comp-simplify-term (c)
1568 (math-comp-add-string c math-comp-hpos math-comp-vpos)
1569 (setq math-comp-hpos (+ math-comp-hpos (length c))))
1574 (math-comp-simplify-term (car c))))
1576 (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c))
1577 (1- (math-comp-ascent (nth 2 c)))))
1578 (widths (mapcar 'math-comp-width (cdr (cdr c))))
1586 (math-comp-add-string (make-string maxwid (nth 1 (car c)))
1587 math-comp-hpos math-comp-vpos)
1588 (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid
1591 (math-comp-simplify-term (car c))))
1593 (setq math-comp-vpos (+ math-comp-vpos
1594 (+ (math-comp-descent (car c))
1595 (math-comp-ascent (nth 1 c))))
1597 (setq math-comp-hpos (+ math-comp-hpos maxwid))))
1599 (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
1600 (desc (math-comp-descent (nth 2 c)))
1602 math-comp-hpos
1603 (math-comp-simplify-term (nth 1 c))))
1604 (math-comp-vpos (- math-comp-vpos (+ asc desc))))
1605 (math-comp-simplify-term (nth 2 c))
1606 (if math-comp-sel-hpos
1607 (math-comp-add-string-sel oldh
1608 (- math-comp-vpos
1610 (math-comp-ascent (nth 2 c)))
1611 (- math-comp-hpos oldh)
1612 (math-comp-height c)))))
1614 (let* ((asc (math-comp-ascent (nth 2 c)))
1615 (desc (math-comp-descent (nth 1 c)))
1616 (oldv math-comp-vpos)
1618 math-comp-hpos
1619 (math-comp-simplify-term (nth 1 c))))
1620 (math-comp-vpos (+ math-comp-vpos (+ asc desc))))
1621 (math-comp-simplify-term (nth 2 c))
1622 (if math-comp-sel-hpos
1623 (math-comp-add-string-sel oldh oldv
1624 (- math-comp-hpos oldh)
1625 (math-comp-height c)))))
1627 (cond ((eq (nth 1 c) math-comp-selected)
1628 (let ((math-comp-highlight (not calc-show-selections)))
1629 (math-comp-simplify-term (nth 2 c))))
1631 (let ((math-comp-highlight nil))
1632 (math-comp-simplify-term (nth 2 c))))
1633 (t (let ((math-comp-tag c))
1634 (math-comp-simplify-term (nth 2 c))))))))
1639 (defun math-comp-first-char (c)
1645 (math-comp-is-null (car c))))
1646 (and c (math-comp-first-char (car c))))
1648 (math-comp-first-char (nth 2 c)))))
1650 (defun math-comp-first-string (c)
1656 (math-comp-is-null (car c))))
1657 (and c (math-comp-first-string (car c))))
1659 (math-comp-first-string (nth 2 c)))))
1661 (defun math-comp-last-char (c)
1667 (while (and c (math-comp-is-null (car c)))
1669 (and c (math-comp-last-char (car c)))))
1671 (math-comp-last-char (nth 2 c)))))
1673 (defun math-comp-is-null (c)
1677 (math-comp-is-null (car c))))
1680 (math-comp-is-null (nth 2 c)))
1683 (defun math-comp-width (c)
1688 (setq accum (+ accum (math-comp-width (car c)))))
1694 (setq accum (max accum (math-comp-width (car c)))))
1697 (math-comp-width (nth 2 c)))
1700 (defun math-comp-height (c)
1703 (+ (math-comp-ascent c) (math-comp-descent c))))
1705 (defun math-comp-ascent (c)
1710 (setq accum (max accum (math-comp-ascent (car c)))))
1715 (max (math-comp-ascent (nth 1 c)) (1+ (math-comp-height (nth 2 c)))))
1717 (math-comp-ascent (nth 1 c)))
1719 (math-comp-ascent (nth 2 c)))
1722 (defun math-comp-descent (c)
1727 (setq accum (max accum (math-comp-descent (car c)))))
1733 (setq accum (+ accum (math-comp-height (car c)))))
1736 (math-comp-descent (nth 1 c)))
1738 (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
1740 (math-comp-descent (nth 2 c)))
1744 (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1745 (math-comp-width (math-compose-expr a (or prec 0))))
1748 (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1753 (math-comp-height (math-compose-expr a (or prec 0)))))
1756 (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1761 (math-comp-ascent (math-compose-expr a (or prec 0)))))
1764 (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
1765 (math-comp-descent (math-compose-expr a (or prec 0))))
1770 (defun math-vert-comp-to-string (c)
1773 (math-vert-comp-to-string-step (cdr (cdr c)))))
1775 (defun math-vert-comp-to-string-step (c)
1777 (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
1783 (defun math-comp-to-string-raw (c indent)
1793 (math-comp-to-string-raw (nth 1 c) next-indent)
1794 (math-comp-to-string-raw-step (cdr (cdr c))
1798 (defun math-comp-to-string-raw-step (cl indent)
1802 (math-comp-to-string-raw (car cl) indent)
1803 (math-comp-to-string-raw-step (cdr cl) indent))