/[emacs]/emacs/lisp/calc/calc-lang.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-lang.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:04:57 2001 UTC
# Line 1  Line 1 
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.
# Line 46  Line 46 
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 )
# Line 114  Line 108 
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 )
# Line 124  Line 117 
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    
# Line 150  Line 141 
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 )
# Line 179  Line 169 
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)
# Line 194  Line 183 
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))
# Line 203  Line 191 
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)
# Line 216  Line 203 
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 )
# Line 243  Line 229 
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    
# Line 261  Line 246 
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)
# Line 272  Line 256 
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
# Line 282  Line 265 
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)
# Line 291  Line 273 
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)
# Line 304  Line 285 
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 )
# Line 360  Line 340 
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 )
# Line 383  Line 362 
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 )
# Line 393  Line 371 
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    
# Line 411  Line 388 
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    
# Line 427  Line 402 
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 )
# Line 482  Line 456 
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 )
# Line 495  Line 468 
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    
# Line 518  Line 489 
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)
# Line 538  Line 508 
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 )
# Line 653  Line 621 
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 )
# Line 732  Line 698 
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    
# Line 1074  Line 1039 
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)
# Line 1086  Line 1050 
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))
# Line 1109  Line 1072 
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)
# Line 1121  Line 1083 
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))
# Line 1143  Line 1104 
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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26