1 |
;; Calculator for GNU Emacs, part II [calc-lang.el] |
;; Calculator for GNU Emacs, part II [calc-lang.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
46 |
(setq calc-language lang |
(setq calc-language lang |
47 |
calc-language-option option) |
calc-language-option option) |
48 |
(calc-change-mode '(calc-language calc-language-option) |
(calc-change-mode '(calc-language calc-language-option) |
49 |
(list lang option) t)) |
(list lang option) t))) |
|
) |
|
50 |
|
|
51 |
(defun calc-normal-language () |
(defun calc-normal-language () |
52 |
(interactive) |
(interactive) |
53 |
(calc-wrapper |
(calc-wrapper |
54 |
(calc-set-language nil) |
(calc-set-language nil) |
55 |
(message "Normal language mode.")) |
(message "Normal language mode."))) |
|
) |
|
56 |
|
|
57 |
(defun calc-flat-language () |
(defun calc-flat-language () |
58 |
(interactive) |
(interactive) |
59 |
(calc-wrapper |
(calc-wrapper |
60 |
(calc-set-language 'flat) |
(calc-set-language 'flat) |
61 |
(message "Flat language mode (all stack entries shown on one line).")) |
(message "Flat language mode (all stack entries shown on one line)."))) |
|
) |
|
62 |
|
|
63 |
(defun calc-big-language () |
(defun calc-big-language () |
64 |
(interactive) |
(interactive) |
65 |
(calc-wrapper |
(calc-wrapper |
66 |
(calc-set-language 'big) |
(calc-set-language 'big) |
67 |
(message "\"Big\" language mode.")) |
(message "\"Big\" language mode."))) |
|
) |
|
68 |
|
|
69 |
(defun calc-unformatted-language () |
(defun calc-unformatted-language () |
70 |
(interactive) |
(interactive) |
71 |
(calc-wrapper |
(calc-wrapper |
72 |
(calc-set-language 'unform) |
(calc-set-language 'unform) |
73 |
(message "Unformatted language mode.")) |
(message "Unformatted language mode."))) |
|
) |
|
74 |
|
|
75 |
|
|
76 |
(defun calc-c-language () |
(defun calc-c-language () |
77 |
(interactive) |
(interactive) |
78 |
(calc-wrapper |
(calc-wrapper |
79 |
(calc-set-language 'c) |
(calc-set-language 'c) |
80 |
(message "`C' language mode.")) |
(message "`C' language mode."))) |
|
) |
|
81 |
|
|
82 |
(put 'c 'math-oper-table |
(put 'c 'math-oper-table |
83 |
'( ( "u+" ident -1 1000 ) |
'( ( "u+" ident -1 1000 ) |
108 |
( "|||" calcFunc-por 75 76 ) |
( "|||" calcFunc-por 75 76 ) |
109 |
( "=" calcFunc-assign 51 50 ) |
( "=" calcFunc-assign 51 50 ) |
110 |
( ":=" calcFunc-assign 51 50 ) |
( ":=" calcFunc-assign 51 50 ) |
111 |
( "::" calcFunc-condition 45 46 ) |
( "::" calcFunc-condition 45 46 ))) ; should support full assignments |
|
)) ; should support full assignments |
|
112 |
|
|
113 |
(put 'c 'math-function-table |
(put 'c 'math-function-table |
114 |
'( ( acos . calcFunc-arccos ) |
'( ( acos . calcFunc-arccos ) |
117 |
( asinh . calcFunc-arcsinh ) |
( asinh . calcFunc-arcsinh ) |
118 |
( atan . calcFunc-arctan ) |
( atan . calcFunc-arctan ) |
119 |
( atan2 . calcFunc-arctan2 ) |
( atan2 . calcFunc-arctan2 ) |
120 |
( atanh . calcFunc-arctanh ) |
( atanh . calcFunc-arctanh ))) |
|
)) |
|
121 |
|
|
122 |
(put 'c 'math-variable-table |
(put 'c 'math-variable-table |
123 |
'( ( M_PI . var-pi ) |
'( ( M_PI . var-pi ) |
124 |
( M_E . var-e ) |
( M_E . var-e ))) |
|
)) |
|
125 |
|
|
126 |
(put 'c 'math-vector-brackets "{}") |
(put 'c 'math-vector-brackets "{}") |
127 |
|
|
141 |
(if (> n 0) |
(if (> n 0) |
142 |
"Pascal language mode (all uppercase)." |
"Pascal language mode (all uppercase)." |
143 |
"Pascal language mode (all lowercase).") |
"Pascal language mode (all lowercase).") |
144 |
"Pascal language mode."))) |
"Pascal language mode.")))) |
|
) |
|
145 |
|
|
146 |
(put 'pascal 'math-oper-table |
(put 'pascal 'math-oper-table |
147 |
'( ( "not" calcFunc-lnot -1 1000 ) |
'( ( "not" calcFunc-lnot -1 1000 ) |
169 |
( "&&&" calcFunc-pand 80 81 ) |
( "&&&" calcFunc-pand 80 81 ) |
170 |
( "|||" calcFunc-por 75 76 ) |
( "|||" calcFunc-por 75 76 ) |
171 |
( ":=" calcFunc-assign 51 50 ) |
( ":=" calcFunc-assign 51 50 ) |
172 |
( "::" calcFunc-condition 45 46 ) |
( "::" calcFunc-condition 45 46 ))) |
|
)) |
|
173 |
|
|
174 |
(put 'pascal 'math-input-filter 'calc-input-case-filter) |
(put 'pascal 'math-input-filter 'calc-input-case-filter) |
175 |
(put 'pascal 'math-output-filter 'calc-output-case-filter) |
(put 'pascal 'math-output-filter 'calc-output-case-filter) |
183 |
(cond ((or (null calc-language-option) (= calc-language-option 0)) |
(cond ((or (null calc-language-option) (= calc-language-option 0)) |
184 |
str) |
str) |
185 |
(t |
(t |
186 |
(downcase str))) |
(downcase str)))) |
|
) |
|
187 |
|
|
188 |
(defun calc-output-case-filter (str) |
(defun calc-output-case-filter (str) |
189 |
(cond ((or (null calc-language-option) (= calc-language-option 0)) |
(cond ((or (null calc-language-option) (= calc-language-option 0)) |
191 |
((> calc-language-option 0) |
((> calc-language-option 0) |
192 |
(upcase str)) |
(upcase str)) |
193 |
(t |
(t |
194 |
(downcase str))) |
(downcase str)))) |
|
) |
|
195 |
|
|
196 |
|
|
197 |
(defun calc-fortran-language (n) |
(defun calc-fortran-language (n) |
203 |
(if (> n 0) |
(if (> n 0) |
204 |
"FORTRAN language mode (all uppercase)." |
"FORTRAN language mode (all uppercase)." |
205 |
"FORTRAN language mode (all lowercase).") |
"FORTRAN language mode (all lowercase).") |
206 |
"FORTRAN language mode."))) |
"FORTRAN language mode.")))) |
|
) |
|
207 |
|
|
208 |
(put 'fortran 'math-oper-table |
(put 'fortran 'math-oper-table |
209 |
'( ( "u/" (math-parse-fortran-vector) -1 1 ) |
'( ( "u/" (math-parse-fortran-vector) -1 1 ) |
229 |
( "|||" calcFunc-por 75 76 ) |
( "|||" calcFunc-por 75 76 ) |
230 |
( "=" calcFunc-assign 51 50 ) |
( "=" calcFunc-assign 51 50 ) |
231 |
( ":=" calcFunc-assign 51 50 ) |
( ":=" calcFunc-assign 51 50 ) |
232 |
( "::" calcFunc-condition 45 46 ) |
( "::" calcFunc-condition 45 46 ))) |
|
)) |
|
233 |
|
|
234 |
(put 'fortran 'math-vector-brackets "//") |
(put 'fortran 'math-vector-brackets "//") |
235 |
|
|
246 |
( conjg . calcFunc-conj ) |
( conjg . calcFunc-conj ) |
247 |
( log . calcFunc-ln ) |
( log . calcFunc-ln ) |
248 |
( nint . calcFunc-round ) |
( nint . calcFunc-round ) |
249 |
( real . calcFunc-re ) |
( real . calcFunc-re ))) |
|
)) |
|
250 |
|
|
251 |
(put 'fortran 'math-input-filter 'calc-input-case-filter) |
(put 'fortran 'math-input-filter 'calc-input-case-filter) |
252 |
(put 'fortran 'math-output-filter 'calc-output-case-filter) |
(put 'fortran 'math-output-filter 'calc-output-case-filter) |
256 |
(prog1 |
(prog1 |
257 |
(math-read-brackets t "]") |
(math-read-brackets t "]") |
258 |
(setq exp-token (car math-parsing-fortran-vector) |
(setq exp-token (car math-parsing-fortran-vector) |
259 |
exp-data (cdr math-parsing-fortran-vector)))) |
exp-data (cdr math-parsing-fortran-vector))))) |
|
) |
|
260 |
|
|
261 |
(defun math-parse-fortran-vector-end (x op) |
(defun math-parse-fortran-vector-end (x op) |
262 |
(if math-parsing-fortran-vector |
(if math-parsing-fortran-vector |
265 |
exp-token 'end |
exp-token 'end |
266 |
exp-data "\000") |
exp-data "\000") |
267 |
x) |
x) |
268 |
(throw 'syntax "Unmatched closing `/'")) |
(throw 'syntax "Unmatched closing `/'"))) |
|
) |
|
269 |
(setq math-parsing-fortran-vector nil) |
(setq math-parsing-fortran-vector nil) |
270 |
|
|
271 |
(defun math-parse-fortran-subscr (sym args) |
(defun math-parse-fortran-subscr (sym args) |
273 |
(while args |
(while args |
274 |
(setq sym (list 'calcFunc-subscr sym (car args)) |
(setq sym (list 'calcFunc-subscr sym (car args)) |
275 |
args (cdr args))) |
args (cdr args))) |
276 |
sym |
sym) |
|
) |
|
277 |
|
|
278 |
|
|
279 |
(defun calc-tex-language (n) |
(defun calc-tex-language (n) |
285 |
(if (> n 0) |
(if (> n 0) |
286 |
"TeX language mode with \\hbox{func}(\\hbox{var})." |
"TeX language mode with \\hbox{func}(\\hbox{var})." |
287 |
"TeX language mode with \\func{\\hbox{var}}.") |
"TeX language mode with \\func{\\hbox{var}}.") |
288 |
"TeX language mode."))) |
"TeX language mode.")))) |
|
) |
|
289 |
|
|
290 |
(put 'tex 'math-oper-table |
(put 'tex 'math-oper-table |
291 |
'( ( "u+" ident -1 1000 ) |
'( ( "u+" ident -1 1000 ) |
340 |
( "\\to" calcFunc-evalto 40 41 ) |
( "\\to" calcFunc-evalto 40 41 ) |
341 |
( "\\to" calcFunc-evalto 40 -1 ) |
( "\\to" calcFunc-evalto 40 -1 ) |
342 |
( "=>" calcFunc-evalto 40 41 ) |
( "=>" calcFunc-evalto 40 41 ) |
343 |
( "=>" calcFunc-evalto 40 -1 ) |
( "=>" calcFunc-evalto 40 -1 ))) |
|
)) |
|
344 |
|
|
345 |
(put 'tex 'math-function-table |
(put 'tex 'math-function-table |
346 |
'( ( \\arccos . calcFunc-arccos ) |
'( ( \\arccos . calcFunc-arccos ) |
362 |
( \\sqrt . calcFunc-sqrt ) |
( \\sqrt . calcFunc-sqrt ) |
363 |
( \\tanh . calcFunc-tanh ) |
( \\tanh . calcFunc-tanh ) |
364 |
( \\phi . calcFunc-totient ) |
( \\phi . calcFunc-totient ) |
365 |
( \\mu . calcFunc-moebius ) |
( \\mu . calcFunc-moebius ))) |
|
)) |
|
366 |
|
|
367 |
(put 'tex 'math-variable-table |
(put 'tex 'math-variable-table |
368 |
'( ( \\pi . var-pi ) |
'( ( \\pi . var-pi ) |
371 |
( \\phi . var-phi ) |
( \\phi . var-phi ) |
372 |
( \\gamma . var-gamma ) |
( \\gamma . var-gamma ) |
373 |
( \\sum . (math-parse-tex-sum calcFunc-sum) ) |
( \\sum . (math-parse-tex-sum calcFunc-sum) ) |
374 |
( \\prod . (math-parse-tex-sum calcFunc-prod) ) |
( \\prod . (math-parse-tex-sum calcFunc-prod) ))) |
|
)) |
|
375 |
|
|
376 |
(put 'tex 'math-complex-format 'i) |
(put 'tex 'math-complex-format 'i) |
377 |
|
|
388 |
(or (equal exp-data "^") (throw 'syntax "Expected `^'")) |
(or (equal exp-data "^") (throw 'syntax "Expected `^'")) |
389 |
(math-read-token) |
(math-read-token) |
390 |
(setq high (math-read-factor)) |
(setq high (math-read-factor)) |
391 |
(list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)) |
(list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) |
|
) |
|
392 |
|
|
393 |
(defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789. |
(defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789. |
394 |
(while (string-match "[0-9]\\\\,[0-9]" str) |
(while (string-match "[0-9]\\\\,[0-9]" str) |
395 |
(setq str (concat (substring str 0 (1+ (match-beginning 0))) |
(setq str (concat (substring str 0 (1+ (match-beginning 0))) |
396 |
(substring str (1- (match-end 0)))))) |
(substring str (1- (match-end 0)))))) |
397 |
str |
str) |
|
) |
|
398 |
(put 'tex 'math-input-filter 'math-tex-input-filter) |
(put 'tex 'math-input-filter 'math-tex-input-filter) |
399 |
|
|
400 |
|
|
402 |
(interactive "P") |
(interactive "P") |
403 |
(calc-wrapper |
(calc-wrapper |
404 |
(calc-set-language 'eqn) |
(calc-set-language 'eqn) |
405 |
(message "Eqn language mode.")) |
(message "Eqn language mode."))) |
|
) |
|
406 |
|
|
407 |
(put 'eqn 'math-oper-table |
(put 'eqn 'math-oper-table |
408 |
'( ( "u+" ident -1 1000 ) |
'( ( "u+" ident -1 1000 ) |
456 |
( "->" calcFunc-evalto 40 41 ) |
( "->" calcFunc-evalto 40 41 ) |
457 |
( "->" calcFunc-evalto 40 -1 ) |
( "->" calcFunc-evalto 40 -1 ) |
458 |
( "=>" calcFunc-evalto 40 41 ) |
( "=>" calcFunc-evalto 40 41 ) |
459 |
( "=>" calcFunc-evalto 40 -1 ) |
( "=>" calcFunc-evalto 40 -1 ))) |
|
)) |
|
460 |
|
|
461 |
(put 'eqn 'math-function-table |
(put 'eqn 'math-function-table |
462 |
'( ( arc\ cos . calcFunc-arccos ) |
'( ( arc\ cos . calcFunc-arccos ) |
468 |
( GAMMA . calcFunc-gamma ) |
( GAMMA . calcFunc-gamma ) |
469 |
( phi . calcFunc-totient ) |
( phi . calcFunc-totient ) |
470 |
( mu . calcFunc-moebius ) |
( mu . calcFunc-moebius ) |
471 |
( matrix . (math-parse-eqn-matrix) ) |
( matrix . (math-parse-eqn-matrix) ))) |
|
)) |
|
472 |
|
|
473 |
(put 'eqn 'math-variable-table |
(put 'eqn 'math-variable-table |
474 |
'( ( inf . var-uinf ) |
'( ( inf . var-uinf ))) |
|
)) |
|
475 |
|
|
476 |
(put 'eqn 'math-complex-format 'i) |
(put 'eqn 'math-complex-format 'i) |
477 |
|
|
489 |
(or (equal exp-data calc-function-close) |
(or (equal exp-data calc-function-close) |
490 |
(throw 'syntax "Expected `}'")) |
(throw 'syntax "Expected `}'")) |
491 |
(math-read-token) |
(math-read-token) |
492 |
(math-transpose (cons 'vec (nreverse vec)))) |
(math-transpose (cons 'vec (nreverse vec))))) |
|
) |
|
493 |
|
|
494 |
(defun math-parse-eqn-prime (x sym) |
(defun math-parse-eqn-prime (x sym) |
495 |
(if (eq (car-safe x) 'var) |
(if (eq (car-safe x) 'var) |
508 |
(list 'var |
(list 'var |
509 |
(intern (concat (symbol-name (nth 1 x)) "'")) |
(intern (concat (symbol-name (nth 1 x)) "'")) |
510 |
(intern (concat (symbol-name (nth 2 x)) "'")))) |
(intern (concat (symbol-name (nth 2 x)) "'")))) |
511 |
(list 'calcFunc-Prime x)) |
(list 'calcFunc-Prime x))) |
|
) |
|
512 |
|
|
513 |
|
|
514 |
(defun calc-mathematica-language () |
(defun calc-mathematica-language () |
515 |
(interactive) |
(interactive) |
516 |
(calc-wrapper |
(calc-wrapper |
517 |
(calc-set-language 'math) |
(calc-set-language 'math) |
518 |
(message "Mathematica language mode.")) |
(message "Mathematica language mode."))) |
|
) |
|
519 |
|
|
520 |
(put 'math 'math-oper-table |
(put 'math 'math-oper-table |
521 |
'( ( "[[" (math-read-math-subscr) 250 -1 ) |
'( ( "[[" (math-read-math-subscr) 250 -1 ) |
621 |
(equal exp-data "]"))) |
(equal exp-data "]"))) |
622 |
(throw 'syntax "Expected ']]'")) |
(throw 'syntax "Expected ']]'")) |
623 |
(math-read-token) |
(math-read-token) |
624 |
(list 'calcFunc-subscr x idx)) |
(list 'calcFunc-subscr x idx))) |
|
) |
|
625 |
|
|
626 |
|
|
627 |
(defun calc-maple-language () |
(defun calc-maple-language () |
628 |
(interactive) |
(interactive) |
629 |
(calc-wrapper |
(calc-wrapper |
630 |
(calc-set-language 'maple) |
(calc-set-language 'maple) |
631 |
(message "Maple language mode.")) |
(message "Maple language mode."))) |
|
) |
|
632 |
|
|
633 |
(put 'maple 'math-oper-table |
(put 'maple 'math-oper-table |
634 |
'( ( "matrix" ident -1 300 ) |
'( ( "matrix" ident -1 300 ) |
698 |
(put 'maple 'math-complex-format 'I) |
(put 'maple 'math-complex-format 'I) |
699 |
|
|
700 |
(defun math-read-maple-dots (x op) |
(defun math-read-maple-dots (x op) |
701 |
(list 'intv 3 x (math-read-expr-level (nth 3 op))) |
(list 'intv 3 x (math-read-expr-level (nth 3 op)))) |
|
) |
|
702 |
|
|
703 |
|
|
704 |
|
|
1039 |
the-h2 h) |
the-h2 h) |
1040 |
(or short (= the-h2 h2) |
(or short (= the-h2 h2) |
1041 |
(math-read-big-error h baseline)) |
(math-read-big-error h baseline)) |
1042 |
p)) |
p))) |
|
) |
|
1043 |
|
|
1044 |
(defun math-read-big-char (h v) |
(defun math-read-big-char (h v) |
1045 |
(or (and (>= h h1) |
(or (and (>= h h1) |
1050 |
(and line |
(and line |
1051 |
(< h (length line)) |
(< h (length line)) |
1052 |
(aref line h)))) |
(aref line h)))) |
1053 |
?\ ) |
?\ )) |
|
) |
|
1054 |
|
|
1055 |
(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) |
(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) |
1056 |
(and (< ev1 v1) (setq ev1 v1)) |
(and (< ev1 v1) (setq ev1 v1)) |
1072 |
(< h eh1))) |
(< h eh1))) |
1073 |
(setq ev1 (1+ ev1) |
(setq ev1 (1+ ev1) |
1074 |
p (cdr p))) |
p (cdr p))) |
1075 |
(>= ev1 ev2)) |
(>= ev1 ev2))) |
|
) |
|
1076 |
|
|
1077 |
(defun math-read-big-error (h v &optional msg) |
(defun math-read-big-error (h v &optional msg) |
1078 |
(let ((pos 0) |
(let ((pos 0) |
1083 |
v (1- v))) |
v (1- v))) |
1084 |
(setq h (+ pos (min h (length (car p)))) |
(setq h (+ pos (min h (length (car p)))) |
1085 |
err-msg (list 'error h (or msg "Syntax error"))) |
err-msg (list 'error h (or msg "Syntax error"))) |
1086 |
(throw 'syntax nil)) |
(throw 'syntax nil))) |
|
) |
|
1087 |
|
|
1088 |
(defun math-read-big-balance (h v what &optional commas) |
(defun math-read-big-balance (h v what &optional commas) |
1089 |
(let* ((line (nth v lines)) |
(let* ((line (nth v lines)) |
1104 |
(memq (aref line h) '(?\) ?\]))) |
(memq (aref line h) '(?\) ?\]))) |
1105 |
(setq count (1- count)))) |
(setq count (1- count)))) |
1106 |
(setq h (1+ h)))) |
(setq h (1+ h)))) |
1107 |
h) |
h)) |
|
) |
|
|
|
|
|
|
|
|
|
|
1108 |
|
|
1109 |
|
;;; calc-lang.el ends here |