X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/136211a997eb94f7dc6f97219052317116e114da..6b61353c0a0320ee15bb6488149735381fed62ec:/lisp/calc/calccomp.el

diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 7d24794c85..59bbbebdc0 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,6 +1,10 @@
-;; Calculator for GNU Emacs, part II [calc-comp.el]
-;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
-;; Written by Dave Gillespie, daveg@synaptics.com.
+;;; calccomp.el --- composition functions for Calc
+
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
+
+;; Author: David Gillespie <daveg@synaptics.com>
+;; Maintainers: D. Goel <deego@gnufans.org>
+;;              Colin Walters <walters@debian.org>
 
 ;; This file is part of GNU Emacs.
 
@@ -19,7 +23,9 @@
 ;; file named COPYING.  Among other things, the copyright notice
 ;; and this notice must be preserved on all copies.
 
+;;; Commentary:
 
+;;; Code:
 
 ;; This file is autoloaded from calc-ext.el.
 (require 'calc-ext)
@@ -28,6 +34,13 @@
 
 (defun calc-Need-calc-comp () nil)
 
+(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))
 
 ;;; A "composition" has one of the following forms:
 ;;;
@@ -878,30 +891,18 @@
 					    (if (eq calc-language 'eqn)
 						" , " ", ")
 					    0)
-		       right))))))))
-)
-
-(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
-))
+		       right)))))))))
 
 
 (defun math-prod-first-term (x)
   (while (eq (car-safe x) '*)
     (setq x (nth 1 x)))
-  x
-)
+  x)
 
 (defun math-prod-last-term (x)
   (while (eq (car-safe x) '*)
     (setq x (nth 2 x)))
-  x
-)
+  x)
 
 (defun math-compose-vector (a sep prec)
   (if a
@@ -918,13 +919,11 @@
 				    (cons (list 'break math-compose-level)
 					  (cons sep c)))))
 		    (nreverse c))))
-    "")
-)
+    ""))
 
 (defun math-vector-no-parens (a)
   (or (cdr (cdr a))
-      (not (eq (car-safe (nth 1 a)) '*)))
-)
+      (not (eq (car-safe (nth 1 a)) '*))))
 
 (defun math-compose-matrix (a col cols base)
   (let ((col 0)
@@ -943,8 +942,7 @@
 						     (concat comma-spc " ")))))
 					  a)))
 		      res)))
-    (nreverse res))
-)
+    (nreverse res)))
 
 (defun math-compose-rows (a count first)
   (if (cdr a)
@@ -962,16 +960,14 @@
     (list (list 'horiz
 		(if first (concat left-bracket " ") "  ")
 		(math-compose-expr (car a) vector-prec)
-		(concat " " right-bracket))))
-)
+		(concat " " right-bracket)))))
 
 (defun math-compose-tex-matrix (a)
   (if (cdr a)
       (cons (math-compose-vector (cdr (car a)) " & " 0)
 	    (cons " \\\\ "
 		  (math-compose-tex-matrix (cdr a))))
-    (list (math-compose-vector (cdr (car a)) " & " 0)))
-)
+    (list (math-compose-vector (cdr (car a)) " & " 0))))
 
 (defun math-compose-eqn-matrix (a)
   (if a
@@ -989,8 +985,7 @@
 	  (cons
 	   " } "
 	   (math-compose-eqn-matrix (cdr a)))))))
-    nil)
-)
+    nil))
 
 (defun math-vector-is-string (a)
   (while (and (setq a (cdr a))
@@ -1000,8 +995,18 @@
 		       (natnump (nth 1 (car a)))
 		       (eq (nth 2 (car a)) 0)
 		       (<= (nth 1 (car a)) 255)))))
-  (null a)
-)
+  (null a))
+
+(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
+					 ( ?\\ . "\\\\" )
+					 ( ?\a . "\\a" )
+					 ( ?\b . "\\b" )
+					 ( ?\e . "\\e" )
+					 ( ?\f . "\\f" )
+					 ( ?\n . "\\n" )
+					 ( ?\r . "\\r" )
+					 ( ?\t . "\\t" )
+					 ( ?\^? . "\\^?" )))
 
 (defun math-vector-to-string (a &optional quoted)
   (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
@@ -1024,26 +1029,14 @@
 		  p (+ p 2))))))
   (if quoted
       (concat "\"" a "\"")
-    a)
-)
-(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
-					 ( ?\\ . "\\\\" )
-					 ( ?\a . "\\a" )
-					 ( ?\b . "\\b" )
-					 ( ?\e . "\\e" )
-					 ( ?\f . "\\f" )
-					 ( ?\n . "\\n" )
-					 ( ?\r . "\\r" )
-					 ( ?\t . "\\t" )
-					 ( ?\^? . "\\^?" )
-))
+    a))
+
 
 (defun math-to-underscores (x)
   (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
       (math-to-underscores
        (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
-    x)
-)
+    x))
 
 (defun math-tex-expr-is-flat (a)
   (or (Math-integerp a)
@@ -1054,8 +1047,7 @@
 			 (math-tex-expr-is-flat (car a))))
 	     (null a)))
       (and (memq (car a) '(^ calcFunc-subscr))
-	   (math-tex-expr-is-flat (nth 1 a))))
-)
+	   (math-tex-expr-is-flat (nth 1 a)))))
 
 (put 'calcFunc-log 'math-compose-big 'math-compose-log)
 (defun math-compose-log (a prec)
@@ -1066,8 +1058,7 @@
 		     (math-compose-expr (nth 2 a) 1000)))
 	     "("
 	     (math-compose-expr (nth 1 a) 1000)
-	     ")"))
-)
+	     ")")))
 
 (put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
 (defun math-compose-log10 (a prec)
@@ -1076,46 +1067,43 @@
 	     (list 'subscr "log" "10")
 	     "("
 	     (math-compose-expr (nth 1 a) 1000)
-	     ")"))
-)
+	     ")")))
 
 (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
 (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
 (defun math-compose-deriv (a prec)
-  (and (= (length a) 3)
-       (math-compose-expr (list '/
-				(list 'calcFunc-choriz
-				      (list 'vec
-					    '(calcFunc-string (vec ?d))
-					    (nth 1 a)))
-				(list 'calcFunc-choriz
-				      (list 'vec
-					    '(calcFunc-string (vec ?d))
-					    (nth 2 a))))
-			  prec))
-)
+  (when (= (length a) 3)
+    (math-compose-expr (list '/
+			     (list 'calcFunc-choriz
+				   (list 'vec
+					 '(calcFunc-string (vec ?d))
+					 (nth 1 a)))
+			     (list 'calcFunc-choriz
+				   (list 'vec
+					 '(calcFunc-string (vec ?d))
+					 (nth 2 a))))
+		       prec)))
 
 (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
 (defun math-compose-sqrt (a prec)
-  (and (= (length a) 2)
-       (let* ((c (math-compose-expr (nth 1 a) 0))
-	      (a (math-comp-ascent c))
-	      (d (math-comp-descent c))
-	      (h (+ a d))
-	      (w (math-comp-width c)))
-	 (list 'vleft
-	       a
-	       (concat (if (= h 1) " " "  ")
-		       (make-string (+ w 2) ?\_))
-	       (list 'horiz
-		     (if (= h 1)
-			 "V"
-		       (append (list 'vleft (1- a))
-			       (make-list (1- h) " |")
-			       '("\\|")))
-		     " "
-		     c))))
-)
+  (when (= (length a) 2)
+    (let* ((c (math-compose-expr (nth 1 a) 0))
+	   (a (math-comp-ascent c))
+	   (d (math-comp-descent c))
+	   (h (+ a d))
+	   (w (math-comp-width c)))
+      (list 'vleft
+	    a
+	    (concat (if (= h 1) " " "  ")
+		    (make-string (+ w 2) ?\_))
+	    (list 'horiz
+		  (if (= h 1)
+		      "V"
+		    (append (list 'vleft (1- a))
+			    (make-list (1- h) " |")
+			    '("\\|")))
+		  " "
+		  c)))))
 
 (put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
 (defun math-compose-choose (a prec)
@@ -1126,8 +1114,7 @@
 	  (list 'vcent
 		(math-comp-height a1)
 		a1 " " a2)
-	  ")"))
-)
+	  ")")))
 
 (put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
 (defun math-compose-integ (a prec)
@@ -1164,8 +1151,7 @@
 	       (if over
 		   ""
 		 (list 'horiz " d" var))
-	       (if parens ")" ""))))
-)
+	       (if parens ")" "")))))
 
 (put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
 (defun math-compose-sum (a prec)
@@ -1190,8 +1176,7 @@
 	       (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
 		   " " "")
 	       expr
-	       (if (memq prec '(180 201)) ")" ""))))
-)
+	       (if (memq prec '(180 201)) ")" "")))))
 
 (put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
 (defun math-compose-prod (a prec)
@@ -1215,8 +1200,7 @@
 	       (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
 		   " " "")
 	       expr
-	       (if (memq prec '(196 201)) ")" ""))))
-)
+	       (if (memq prec '(196 201)) ")" "")))))
 
 
 (defun math-stack-value-offset-fancy ()
@@ -1251,8 +1235,7 @@
 	 (or (< off 0)
 	     (and calc-display-origin
 		  (> calc-line-breaking calc-display-origin)))
-	 (setq wid calc-line-breaking)))
-)
+	 (setq wid calc-line-breaking))))
 
 
 
@@ -1265,9 +1248,11 @@
     (if (math-comp-is-flat c)
 	(math-comp-to-string-flat c width)
       (math-vert-comp-to-string
-       (math-comp-simplify c width))))
-)
+       (math-comp-simplify c width)))))
 
+(defvar math-comp-buf-string (make-vector 10 ""))
+(defvar math-comp-buf-margin (make-vector 10 0))
+(defvar math-comp-buf-level (make-vector 10 0))
 (defun math-comp-is-flat (c)     ; check if c's height is 1.
   (cond ((not (consp c)) t)
 	((memq (car c) '(set break)) t)
@@ -1281,8 +1266,7 @@
 	      (math-comp-is-flat (nth 2 c))))
 	((eq (car c) 'tag)
 	 (math-comp-is-flat (nth 2 c)))
-	(t nil))
-)
+	(t nil)))
 
 
 ;;; Convert a one-line composition to a string.  Break into multiple
@@ -1315,11 +1299,7 @@
 		     (aset comp-buf (1+ k) ?\n)
 		     (setq prefix " "))
 		 (setq prefix "\n"))))
-	(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))
+	(concat comp-buf prefix str)))))
 
 (defun math-comp-to-string-flat-term (c)
   (cond ((not (consp c))
@@ -1415,8 +1395,7 @@
 		  (math-comp-to-string-flat-term (nth 2 c))))
 	       (t (math-comp-to-string-flat-term (nth 2 c)))))
 
-	(t (math-comp-to-string-flat-term (nth 2 c))))
-)
+	(t (math-comp-to-string-flat-term (nth 2 c)))))
 
 (defun math-comp-highlight-string (s)
   (setq s (copy-sequence s))
@@ -1424,8 +1403,7 @@
     (while (>= (setq i (1- i)) 0)
       (or (memq (aref s i) '(32 ?\n))
 	  (aset s i (if calc-show-selections ?\. ?\#)))))
-  s
-)
+  s)
 
 (defun math-comp-sel-flat-term (c)
   (cond ((not (consp c))
@@ -1442,8 +1420,7 @@
 		   (setq math-comp-sel-tag c
 			 math-comp-sel-cpos 1000000)))
 	   (math-comp-sel-flat-term (nth 2 c))))
-	(t (math-comp-sel-flat-term (nth 2 c))))
-)
+	(t (math-comp-sel-flat-term (nth 2 c)))))
 
 
 ;;; Simplify a composition to a canonical form consisting of
@@ -1459,8 +1436,7 @@
 	(comp-highlight (and math-comp-selected calc-show-selections))
 	(comp-tag nil))
     (math-comp-simplify-term c)
-    (cons 'vleft (cons comp-base comp-buf)))
-)
+    (cons 'vleft (cons comp-base comp-buf))))
 
 (defun math-comp-add-string (s h v)
   (and (> (length s) 0)
@@ -1481,8 +1457,7 @@
 				 (make-string (- h (length (car str))) 32)
 				 (if comp-highlight
 				     (math-comp-highlight-string s)
-				   s)))))))
-)
+				   s))))))))
 
 (defun math-comp-add-string-sel (x y w h)
   (if (and (<= y math-comp-sel-vpos)
@@ -1490,8 +1465,7 @@
 	   (<= x math-comp-sel-hpos)
 	   (> (+ x w) math-comp-sel-hpos))
       (setq math-comp-sel-tag comp-tag
-	    math-comp-sel-vpos 10000))
-)
+	    math-comp-sel-vpos 10000)))
 
 (defun math-comp-simplify-term (c)
   (cond ((stringp c)
@@ -1561,8 +1535,7 @@
 		(let ((comp-highlight nil))
 		  (math-comp-simplify-term (nth 2 c))))
 	       (t (let ((comp-tag c))
-		    (math-comp-simplify-term (nth 2 c)))))))
-)
+		    (math-comp-simplify-term (nth 2 c))))))))
 
 
 ;;; Measuring a composition.
@@ -1576,8 +1549,7 @@
 		     (math-comp-is-null (car c))))
 	 (and c (math-comp-first-char (car c))))
 	((eq (car c) 'tag)
-	 (math-comp-first-char (nth 2 c))))
-)
+	 (math-comp-first-char (nth 2 c)))))
 
 (defun math-comp-first-string (c)
   (cond ((stringp c)
@@ -1588,8 +1560,7 @@
 		     (math-comp-is-null (car c))))
 	 (and c (math-comp-first-string (car c))))
 	((eq (car c) 'tag)
-	 (math-comp-first-string (nth 2 c))))
-)
+	 (math-comp-first-string (nth 2 c)))))
 
 (defun math-comp-last-char (c)
   (cond ((stringp c)
@@ -1601,8 +1572,7 @@
 	     (setq c (cdr c)))
 	   (and c (math-comp-last-char (car c)))))
 	((eq (car c) 'tag)
-	 (math-comp-last-char (nth 2 c))))
-)
+	 (math-comp-last-char (nth 2 c)))))
 
 (defun math-comp-is-null (c)
   (cond ((stringp c) (= (length c) 0))
@@ -1612,8 +1582,7 @@
 	 (null c))
 	((eq (car c) 'tag)
 	 (math-comp-is-null (nth 2 c)))
-	((memq (car c) '(set break)) t))
-)
+	((memq (car c) '(set break)) t)))
 
 (defun math-comp-width (c)
   (cond ((not (consp c)) (length c))
@@ -1630,14 +1599,12 @@
 	   accum))
 	((eq (car c) 'tag)
 	 (math-comp-width (nth 2 c)))
-	(t 0))
-)
+	(t 0)))
 
 (defun math-comp-height (c)
   (if (stringp c)
       1
-    (+ (math-comp-ascent c) (math-comp-descent c)))
-)
+    (+ (math-comp-ascent c) (math-comp-descent c))))
 
 (defun math-comp-ascent (c)
   (cond ((not (consp c)) 1)
@@ -1654,8 +1621,7 @@
 	 (math-comp-ascent (nth 1 c)))
 	((eq (car c) 'tag)
 	 (math-comp-ascent (nth 2 c)))
-	(t 1))
-)
+	(t 1)))
 
 (defun math-comp-descent (c)
   (cond ((not (consp c)) 0)
@@ -1676,13 +1642,11 @@
 	 (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
 	((eq (car c) 'tag)
 	 (math-comp-descent (nth 2 c)))
-	(t 0))
-)
+	(t 0)))
 
 (defun calcFunc-cwidth (a &optional prec)
   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
-  (math-comp-width (math-compose-expr a (or prec 0)))
-)
+  (math-comp-width (math-compose-expr a (or prec 0))))
 
 (defun calcFunc-cheight (a &optional prec)
   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
@@ -1690,8 +1654,7 @@
 	   (memq (length a) '(2 3))
 	   (eq (nth 1 a) 0))
       0
-    (math-comp-height (math-compose-expr a (or prec 0))))
-)
+    (math-comp-height (math-compose-expr a (or prec 0)))))
 
 (defun calcFunc-cascent (a &optional prec)
   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
@@ -1699,13 +1662,11 @@
 	   (memq (length a) '(2 3))
 	   (eq (nth 1 a) 0))
       0
-    (math-comp-ascent (math-compose-expr a (or prec 0))))
-)
+    (math-comp-ascent (math-compose-expr a (or prec 0)))))
 
 (defun calcFunc-cdescent (a &optional prec)
   (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
-  (math-comp-descent (math-compose-expr a (or prec 0)))
-)
+  (math-comp-descent (math-compose-expr a (or prec 0))))
 
 
 ;;; Convert a simplified composition into string form.
@@ -1713,14 +1674,12 @@
 (defun math-vert-comp-to-string (c)
   (if (stringp c)
       c
-    (math-vert-comp-to-string-step (cdr (cdr c))))
-)
+    (math-vert-comp-to-string-step (cdr (cdr c)))))
 
 (defun math-vert-comp-to-string-step (c)
   (if (cdr c)
       (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
-    (car c))
-)
+    (car c)))
 
 
 ;;; Convert a composition to a string in "raw" form (for debugging).
@@ -1738,8 +1697,7 @@
 		   (math-comp-to-string-raw (nth 1 c) next-indent)
 		   (math-comp-to-string-raw-step (cdr (cdr c))
 						 next-indent)
-		   ")"))))
-)
+		   ")")))))
 
 (defun math-comp-to-string-raw-step (cl indent)
   (if cl
@@ -1747,9 +1705,7 @@
 	      (make-string indent 32)
 	      (math-comp-to-string-raw (car cl) indent)
 	      (math-comp-to-string-raw-step (cdr cl) indent))
-    "")
-)
-
-
-
+    ""))
 
+;;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
+;;; calccomp.el ends here