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