/[emacs]/emacs/lisp/calc/calccomp.el
ViewVC logotype

Diff of /emacs/lisp/calc/calccomp.el

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

revision 1.2 by walters, Wed Nov 14 09:09:03 2001 UTC revision 1.3 by walters, Mon Nov 19 07:43:35 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-comp.el]  ;;; calccomp.el --- composition functions for Calc
2    
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4  ;; Written by Dave Gillespie, daveg@synaptics.com.  
5    ;; Author: David Gillespie <daveg@synaptics.com>
6    ;; Maintainer: Colin Walters <walters@debian.org>
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 19  Line 22 
22  ;; file named COPYING.  Among other things, the copyright notice  ;; file named COPYING.  Among other things, the copyright notice
23  ;; and this notice must be preserved on all copies.  ;; and this notice must be preserved on all copies.
24    
25    ;;; Commentary:
26    
27    ;;; Code:
28    
29  ;; This file is autoloaded from calc-ext.el.  ;; This file is autoloaded from calc-ext.el.
30  (require 'calc-ext)  (require 'calc-ext)
# Line 28  Line 33 
33    
34  (defun calc-Need-calc-comp () nil)  (defun calc-Need-calc-comp () nil)
35    
36    (defconst math-eqn-special-funcs
37      '( calcFunc-log
38         calcFunc-ln calcFunc-exp
39         calcFunc-sin calcFunc-cos calcFunc-tan
40         calcFunc-sinh calcFunc-cosh calcFunc-tanh
41         calcFunc-arcsin calcFunc-arccos calcFunc-arctan
42         calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
43    
44  ;;; A "composition" has one of the following forms:  ;;; A "composition" has one of the following forms:
45  ;;;  ;;;
# Line 880  Line 892 
892                                              0)                                              0)
893                         right)))))))))                         right)))))))))
894    
 (defconst math-eqn-special-funcs  
   '( calcFunc-log  
      calcFunc-ln calcFunc-exp  
      calcFunc-sin calcFunc-cos calcFunc-tan  
      calcFunc-sinh calcFunc-cosh calcFunc-tanh  
      calcFunc-arcsin calcFunc-arccos calcFunc-arctan  
      calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh  
 ))  
   
895    
896  (defun math-prod-first-term (x)  (defun math-prod-first-term (x)
897    (while (eq (car-safe x) '*)    (while (eq (car-safe x) '*)
# Line 993  Line 996 
996                         (<= (nth 1 (car a)) 255)))))                         (<= (nth 1 (car a)) 255)))))
997    (null a))    (null a))
998    
999    (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
1000                                             ( ?\\ . "\\\\" )
1001                                             ( ?\a . "\\a" )
1002                                             ( ?\b . "\\b" )
1003                                             ( ?\e . "\\e" )
1004                                             ( ?\f . "\\f" )
1005                                             ( ?\n . "\\n" )
1006                                             ( ?\r . "\\r" )
1007                                             ( ?\t . "\\t" )
1008                                             ( ?\^? . "\\^?" )))
1009    
1010  (defun math-vector-to-string (a &optional quoted)  (defun math-vector-to-string (a &optional quoted)
1011    (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))    (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
1012                            (cdr a))))                            (cdr a))))
# Line 1015  Line 1029 
1029    (if quoted    (if quoted
1030        (concat "\"" a "\"")        (concat "\"" a "\"")
1031      a))      a))
1032  (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )  
                                          ( ?\\ . "\\\\" )  
                                          ( ?\a . "\\a" )  
                                          ( ?\b . "\\b" )  
                                          ( ?\e . "\\e" )  
                                          ( ?\f . "\\f" )  
                                          ( ?\n . "\\n" )  
                                          ( ?\r . "\\r" )  
                                          ( ?\t . "\\t" )  
                                          ( ?\^? . "\\^?" )  
 ))  
1033    
1034  (defun math-to-underscores (x)  (defun math-to-underscores (x)
1035    (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)    (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
# Line 1067  Line 1071 
1071  (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)  (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
1072  (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)  (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
1073  (defun math-compose-deriv (a prec)  (defun math-compose-deriv (a prec)
1074    (and (= (length a) 3)    (when (= (length a) 3)
1075         (math-compose-expr (list '/      (math-compose-expr (list '/
1076                                  (list 'calcFunc-choriz                               (list 'calcFunc-choriz
1077                                        (list 'vec                                     (list 'vec
1078                                              '(calcFunc-string (vec ?d))                                           '(calcFunc-string (vec ?d))
1079                                              (nth 1 a)))                                           (nth 1 a)))
1080                                  (list 'calcFunc-choriz                               (list 'calcFunc-choriz
1081                                        (list 'vec                                     (list 'vec
1082                                              '(calcFunc-string (vec ?d))                                           '(calcFunc-string (vec ?d))
1083                                              (nth 2 a))))                                           (nth 2 a))))
1084                            prec)))                         prec)))
1085    
1086  (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)  (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
1087  (defun math-compose-sqrt (a prec)  (defun math-compose-sqrt (a prec)
1088    (and (= (length a) 2)    (when (= (length a) 2)
1089         (let* ((c (math-compose-expr (nth 1 a) 0))      (let* ((c (math-compose-expr (nth 1 a) 0))
1090                (a (math-comp-ascent c))             (a (math-comp-ascent c))
1091                (d (math-comp-descent c))             (d (math-comp-descent c))
1092                (h (+ a d))             (h (+ a d))
1093                (w (math-comp-width c)))             (w (math-comp-width c)))
1094           (list 'vleft        (list 'vleft
1095                 a              a
1096                 (concat (if (= h 1) " " "  ")              (concat (if (= h 1) " " "  ")
1097                         (make-string (+ w 2) ?\_))                      (make-string (+ w 2) ?\_))
1098                 (list 'horiz              (list 'horiz
1099                       (if (= h 1)                    (if (= h 1)
1100                           "V"                        "V"
1101                         (append (list 'vleft (1- a))                      (append (list 'vleft (1- a))
1102                                 (make-list (1- h) " |")                              (make-list (1- h) " |")
1103                                 '("\\|")))                              '("\\|")))
1104                       " "                    " "
1105                       c)))))                    c)))))
1106    
1107  (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)  (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
1108  (defun math-compose-choose (a prec)  (defun math-compose-choose (a prec)
# Line 1245  Line 1249 
1249        (math-vert-comp-to-string        (math-vert-comp-to-string
1250         (math-comp-simplify c width)))))         (math-comp-simplify c width)))))
1251    
1252    (defvar math-comp-buf-string (make-vector 10 ""))
1253    (defvar math-comp-buf-margin (make-vector 10 0))
1254    (defvar math-comp-buf-level (make-vector 10 0))
1255  (defun math-comp-is-flat (c)     ; check if c's height is 1.  (defun math-comp-is-flat (c)     ; check if c's height is 1.
1256    (cond ((not (consp c)) t)    (cond ((not (consp c)) t)
1257          ((memq (car c) '(set break)) t)          ((memq (car c) '(set break)) t)
# Line 1292  Line 1299 
1299                       (setq prefix " "))                       (setq prefix " "))
1300                   (setq prefix "\n"))))                   (setq prefix "\n"))))
1301          (concat comp-buf prefix str)))))          (concat comp-buf prefix str)))))
 (setq math-comp-buf-string (make-vector 10 ""))  
 (setq math-comp-buf-margin (make-vector 10 0))  
 (setq math-comp-buf-level (make-vector 10 0))  
1302    
1303  (defun math-comp-to-string-flat-term (c)  (defun math-comp-to-string-flat-term (c)
1304    (cond ((not (consp c))    (cond ((not (consp c))

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

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