emacs: lisp/calc/calc-lang.el comparison

comparison lisp/calc/calc-lang.el @ 109033:d150a25a0eb9

Add some utf-8 coding cookies. * lisp/calc/calc-aent.el, lisp/calc/calc-ext.el, lisp/calc/calc-lang.el: * lisp/calc/calc-store.el, lisp/calc/calc-units.el, lisp/calc/calc.el: * lisp/calc/calccomp.el: Add explicit utf-8 coding cookies to files with utf-8 characters. Also delete trailing whitespace.

author	Glenn Morris <rgm@gnu.org>
date	Tue, 22 Jun 2010 00:41:10 -0700
parents	c84578d13e42
children	4e76c4e4f20f

comparison

equal deleted inserted replaced

-:d8720405694a
+:d150a25a0eb9
 ;;; calc-lang.el --- calc language functions
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;   2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 ;; Author: David Gillespie <daveg@synaptics.com>
 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
 ;; This file is part of GNU Emacs.
 (add-to-list 'calc-lang-slash-idiv 'fortran)
 (add-to-list 'calc-lang-allow-underscores 'fortran)
 (add-to-list 'calc-lang-parens-are-subscripts 'fortran)
 ;; The next few variables are local to math-read-exprs in calc-aent.el
 ;; and math-read-expr in calc-ext.el, but are set in functions they call.
 (defvar math-exp-token)
 (defvar math-expr-data)
 (defvar math-exp-old-pos)
 ((= n 0)
 (message "TeX language mode with multiline matrices"))
 ((= n 1)
 (message "TeX language mode with \\hbox{func}(\\hbox{var})"))
 ((> n 1)
 (message
 "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices"))
 ((= n -1)
 (message "TeX language mode with \\func(\\hbox{var})"))
 ((< n -1)
 (message
 "TeX language mode with \\func(\\hbox{var}) and multiline matrices")))))
 (defun calc-latex-language (n)
 (interactive "P")
 (calc-wrapper
 ((= n 0)
 (message "LaTeX language mode with multiline matrices"))
 ((= n 1)
 (message "LaTeX language mode with \\text{func}(\\text{var})"))
 ((> n 1)
 (message
 "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
 ((= n -1)
 (message "LaTeX language mode with \\func(\\text{var})"))
 ((< n -1)
 (message
 "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
 (put 'tex 'math-lang-name "TeX")
 (put 'latex 'math-lang-name "LaTeX")
 (calcFunc-prod . (math-compose-tex-sum "\\prod"))
 (calcFunc-sqrt . math-compose-tex-sqrt)
 (intv . math-compose-tex-intv)))
 (put 'tex 'math-variable-table
 '(
 ;; The Greek letters
 ( \\alpha      . var-alpha )
 ( \\beta       . var-beta  )
 ( \\gamma      . var-gamma )
 ( \\Gamma      . var-Gamma )
 (setq math-exp-str (copy-sequence math-exp-str))
 (aset math-exp-str right ?\]))))))))))
 (defun math-compose-tex-matrix (a &optional ltx)
 (if (cdr a)
 (cons (append (math-compose-vector (cdr (car a)) " & " 0)
 (if ltx '(" \\\\ ") '(" \\cr ")))
 (math-compose-tex-matrix (cdr a) ltx))
 (list (math-compose-vector (cdr (car a)) " & " 0))))
 (defun math-compose-tex-sum (a fn)
 (or (Math-realp (nth 1 a))
 (memq (car (nth 1 a)) '(var *))))
 (setq left "{" right "}"))
 (t (setq left calc-function-open
 right calc-function-close)))
 (list 'horiz func
 left
 (math-compose-vector (cdr a) ", " 0)
 right)))
 (put 'latex 'math-oper-table
 math-expr-data "[")
 (let ((right (string-match "}" math-exp-str math-exp-pos)))
 (and right
 (setq math-exp-str (copy-sequence math-exp-str))
 (aset math-exp-str right ?\]))))))))))
 (defun math-latex-parse-frac (f val)
 (let (numer denom)
 (setq numer (car (math-read-expr-list)))
 (math-read-token)
 (setq denom (math-read-factor))
 (append '(horiz "matrix { ")
 (math-compose-eqn-matrix
 (cdr (math-transpose a)))
 '("}")))))
 (put 'eqn 'math-var-formatter
 (function
 (lambda (a prec)
 (let (v)
 (if (and math-compose-hash-args
 (let ((p calc-arg-values))
 'var
 (intern (substring (symbol-name (nth 1 a)) 0 -1))
 (intern (substring (symbol-name (nth 2 a)) 0 -1))))
 prec)
 (symbol-name (nth 1 a))))))))
 (defconst math-eqn-special-funcs
 '( calcFunc-log
 calcFunc-ln calcFunc-exp
 calcFunc-sin calcFunc-cos calcFunc-tan
 calcFunc-sec calcFunc-csc calcFunc-cot
 calcFunc-sinh calcFunc-cosh calcFunc-tanh
 calcFunc-sech calcFunc-csch calcFunc-coth
 calcFunc-arcsin calcFunc-arccos calcFunc-arctan
 calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
 (put 'eqn 'math-func-formatter
 (function
 (lambda (func a)
 (let (left right)
 (if (string-match "[^']'+\\'" func)
 (let ((n (- (length func) (match-beginning 0) 1)))
 (setq func (concat func " prime")))))
 (cond ((or (> (length a) 2)
 (not (math-tex-expr-is-flat (nth 1 a))))
 (setq left "{left ( "
 right " right )}"))
 ((and
 (memq (car a) math-eqn-special-funcs)
 (= (length a) 2)
 (or (Math-realp (nth 1 a))
 (memq (car (nth 1 a)) '(var *))))
 (setq left "~{" right "}"))
 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
 ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
 ("above" punc ",")))
 (put 'eqn 'math-lang-adjust-words
 (function
 (lambda ()
 (let ((code (assoc math-expr-data math-eqn-ignore-words)))
 (cond ((null code))
 ((null (cdr code))
 (math-read-token))
 ( E           . var-e) ;; Not really in Yacas
 ( GoldenRatio . var-phi)
 ( Gamma       . var-gamma)))
 (put 'yacas 'math-parse-table
 '((("Deriv(" 0 ")" 0)
 calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA))
 (("D(" 0 ")" 0)
 calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA))
 (("Integrate(" 0 ")" 0)
 calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA))
 (("Integrate(" 0 "," 0 "," 0 ")" 0)
 calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA)
 (var ArgB var-ArgB) (var ArgC var-ArgC))
 (("Subst(" 0 "," 0 ")" 0)
 calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA)
 (var ArgB var-ArgB))
 (("Taylor(" 0 "," 0 "," 0 ")" 0)
 calcFunc-taylor (var ArgD var-ArgD)
 (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB))
 (var ArgC var-ArgC))))
 (put 'yacas 'math-oper-table
 '(("+"    +               30  30)
 ("-"    -               30  60)
 (nth 1 fn)
 "("
 (math-compose-expr (nth 2 a) -1)
 (if (not (nth 3 a))
 ")"
 (concat
 ","
 (math-compose-expr (nth 3 a) -1)
 ","
 (math-compose-expr (nth 4 a) -1)
 ")"))
 (put 'maxima 'math-oper-table
 '(("+"    +               100  100)
 ("-"    -               100  134)
 ("*"    *               120  120)
 ("."    *               130  129)
 ("/"    /               120  120)
 ("u-"   neg              -1  180)
 ("u+"   ident            -1  180)
 ("^"    ^               140  139)
 ("**"   ^               140  139)
 (nth 1 args)
 (nth 2 args))
 (nth 3 args))))
 (put 'maxima 'math-parse-table
 '((("if" 0 "then" 0 "else" 0)
 calcFunc-if
 (var ArgA var-ArgA)
 (var ArgB var-ArgB)
 (var ArgC var-ArgC))))
 (put 'maxima 'math-special-function-table
 '(( calcFunc-taylor . math-maxima-compose-taylor)
 (put 'maxima 'math-matrix-formatter
 (function
 (lambda (a)
 (list 'horiz
 "matrix("
 (math-compose-vector (cdr a)
 (concat math-comp-comma " ")
 math-comp-vector-prec)
 ")"))))
 (list (nth 2 f)
 (nth 1 args)
 (nth 0 args))))
 (put 'giac 'math-parse-table
 '((("set" 0)
 calcFunc-rdup
 (var ArgA var-ArgA))))
 (put 'giac 'math-special-function-table
 '((calcFunc-cons . (math-lang-compose-switch-args "prepend"))
 (defun math-lang-compose-switch-args (a fn)
 "Compose the arguments to a Calc function in reverse order.
 This is used for various language modes which have functions in reverse
 order to Calc's."
 (list 'horiz (nth 1 fn)
 "("
 (math-compose-expr (nth 2 a) 0)
 ","
 (math-compose-expr (nth 1 a) 0)
 ")"))
 (lambda (a)
 (let ((args (cdr (cdr a))))
 (list 'horiz
 (math-compose-expr (nth 1 a) 1000)
 "["
 (math-compose-expr
 (calc-normalize (list '- (nth 2 a) 1)) 0)
 "]")))))
 (defun math-read-giac-subscr (x op)
 (let ((idx (math-read-expr-level 0)))
 (function
 (lambda (a)
 (list 'horiz
 "matrix("
 math-comp-left-bracket
 (math-compose-vector (cdr a)
 (concat math-comp-comma " ")
 math-comp-vector-prec)
 math-comp-right-bracket
 ")"))))
 ;; local to math-read-big-expr in calc-ext.el, but used by
 ;; math-read-big-rec.
 (defvar math-read-big-baseline)
 (defvar math-read-big-h2)
 ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2
 ;; are local to math-read-big-rec, but are used by math-read-big-char,
 ;; math-read-big-emptyp and math-read-big-balance which are called by
 ;; math-read-big-rec.
 ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el,
 ;; which calls math-read-big-balance.
 (defvar math-rb-h1)
 (defvar math-rb-h2)
 (defvar math-rb-v1)
 (defvar math-rb-v2)
 (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
 &optional baseline prec short)
 (or prec (setq prec 0))
 ;; Clip whitespace above or below.
 (while (and (< math-rb-v1 math-rb-v2)
 (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
 (setq math-rb-v1 (1+ math-rb-v1)))
 (while (and (< math-rb-v1 math-rb-v2)
 (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2))
 (setq math-rb-v2 (1- math-rb-v2)))
 ;; If formula is a single line high, normal parser can handle it.
 (if (<= math-rb-v2 (1+ math-rb-v1))
 (if (or (<= math-rb-v2 math-rb-v1)
 	      (> math-rb-h1 (length (setq math-rb-v2
 (nth math-rb-v1 math-read-big-lines)))))
 	  (math-read-big-error math-rb-h1 math-rb-v1)
 	(setq math-read-big-baseline math-rb-v1
 	      math-read-big-h2 math-rb-h2
 	      math-rb-v2 (nth math-rb-v1 math-read-big-lines)
 	      math-rb-h2 (math-read-expr
 (substring math-rb-v2 math-rb-h1
 (min math-rb-h2 (length math-rb-v2)))))
 	(if (eq (car-safe math-rb-h2) 'error)
 	    (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2))
 math-rb-v1 (nth 2 math-rb-h2))
 	  math-rb-h2))
 ;; Clip whitespace at left or right.
 (while (and (< math-rb-h1 math-rb-h2)
 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2))
 (setq math-rb-h1 (1+ math-rb-h1)))
 (while (and (< math-rb-h1 math-rb-h2)
 (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2))
 (setq math-rb-h2 (1- math-rb-h2)))
 ;; Scan to find widest left-justified "----" in the region.
 (let* ((widest nil)
 	      len (min math-rb-h2 (length line)))
 	(and (< math-rb-h1 len)
 	     (/= (aref line math-rb-h1) ?\ )
 	     (if (and (= (aref line math-rb-h1) ?\-)
 		      ;; Make sure it's not a minus sign.
 		      (or (and (< (1+ math-rb-h1) len)
 (= (aref line (1+ math-rb-h1)) ?\-))
 			  (/= (math-read-big-char math-rb-h1 (1- v)) ?\ )
 			  (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ )))
 		 (progn
 		   (setq h math-rb-h1)
 		   v math-read-big-baseline))
 	    ;; Binomial coefficient.
 	    ((and (= other-char ?\()
 		  (= (math-read-big-char (1+ math-rb-h1) v) ?\ )
 		  (= (string-match "( *)" (nth v math-read-big-lines)
 math-rb-h1) math-rb-h1))
 	     (setq h (match-end 0))
 	     (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
 	     (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
 	     (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
 			   (math-read-big-rec (1+ math-rb-h1) (1+ v)
 					      (1- h) math-rb-v2))))
 	    ;; Minus sign.
 	    ((= other-char ?\-)
 	     (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1
 math-rb-h2 math-rb-v2 v 250 t))
 		   v math-read-big-baseline
 		   h math-read-big-h2))
 	    ;; Parentheses.
 	       (if (= sep ?\.)
 		   (setq h (1+ h)))
 	       (if (= sep ?\])
 		   (math-read-big-error (1- h) v "Expected `)'"))
 	       (if (= sep ?\))
 		   (setq p (math-read-big-rec
 (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v))
 		 (setq hmid (math-read-big-balance h v "(")
 		       p (list p
 (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v))
 		       h hmid)
 		 (cond ((= sep ?\.)
 			(setq p (cons 'intv (cons (if (= (math-read-big-char
 							  (1- h) v)
 	     (setq h (match-end 0)
 		   p (math-read-number (math-match-substring line 0)))
 	     (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
 	     (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)))
 ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2;
 ;; baseline = v.
 (if baseline
 	  (or (= v baseline)
 	      (math-read-big-error math-rb-h1 v "Inconsistent baseline in formula"))
 	(setq baseline v))
 				  h))
 			 (setq widest '("2x" * 196 195)))))
 	(cond ((eq (nth 3 widest) -1)
 	       (setq p (list (nth 1 widest) p)))
 	      ((equal (car widest) "?")
 	       (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
 math-rb-v2 baseline nil t)))
 		 (or (= (math-read-big-char math-read-big-h2 baseline) ?\:)
 		     (math-read-big-error math-read-big-h2 baseline "Expected `:'"))
 		 (setq p (list (nth 1 widest) p y
 			       (math-read-big-rec
 (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2
 baseline (nth 3 widest) t))
 		       h math-read-big-h2)))
 	      (t
 	       (setq p (list (nth 1 widest) p
 	(setq h (1+ h))))
 h))
 (provide 'calc-lang)
+;; Local variables:
+;; coding: utf-8
+;; End:
 ;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e
 ;;; calc-lang.el ends here

Mercurial > emacs

comparison lisp/calc/calc-lang.el @ 109033:d150a25a0eb9