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