comparison lisp/calc/calccomp.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; calccomp.el --- composition functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainers: D. Goel <[e-mail]>
;;              Colin Walters <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

(require 'calc-macs)

(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:
;;;

;;;    (subscr C1 C2)        Composition C1 with subscript C2
;;;    (rule X)              Horizontal line of X, full width of enclosing comp
;;;
;;;    (tag X C)             Composition C corresponds to sub-expression X

(defun math-compose-expr (a prec)
  (let ((math-compose-level (1+ math-compose-level)))
    (cond
     ((or (and (eq a math-comp-selected) a)
	  (and math-comp-tagged
	       (not (eq math-comp-tagged a))))
      (let ((math-comp-selected nil))
	(and math-comp-tagged (setq math-comp-tagged a))
	(list 'tag a (math-compose-expr a prec))))
     ((and (not (consp a)) (not (integerp a)))
      (concat "'" (prin1-to-string a)))
     ((math-scalarp a)
      (if (or (eq (car-safe a) 'frac)
	      (and (nth 1 calc-frac-format) (Math-integerp a)))
	  (if (memq calc-language '(tex eqn math maple c fortran pascal))
	      (let ((aa (math-adjust-fraction a))
		    (calc-frac-format nil))
		(math-compose-expr (list '/
					 (if (memq calc-language '(c fortran))
					     (math-float (nth 1 aa))

			       (setq temp (apply (cdr temp2) (cdr a)))
			       (math-compose-expr temp prec))
			  (and (setq temp2 (assq nil (cdr temp)))
			       (funcall (cdr temp2) a))))))))
     ((eq (car a) 'vec)
      (let* ((left-bracket (if calc-vector-brackets
			       (substring calc-vector-brackets 0 1) ""))
	     (right-bracket (if calc-vector-brackets
				(substring calc-vector-brackets 1 2) ""))
	     (inner-brackets (memq 'R calc-matrix-brackets))
	     (outer-brackets (memq 'O calc-matrix-brackets))
	     (row-commas (memq 'C calc-matrix-brackets))
	     (comma-spc (or calc-vector-commas " "))
	     (comma (or calc-vector-commas ""))
	     (vector-prec (if (or (and calc-vector-commas
				       (math-vector-no-parens a))
				  (memq 'P calc-matrix-brackets)) 0 1000))
	     (just (cond ((eq calc-matrix-just 'right) 'vright)
			 ((eq calc-matrix-just 'center) 'vcent)
			 (t 'vleft)))
	     (break calc-break-vectors))
	(if (and (memq calc-language '(nil big))
		 (not calc-break-vectors)
		 (math-matrixp a) (not (math-matrixp (nth 1 a)))
		 (or calc-full-vectors
		     (and (< (length a) 7) (< (length (nth 1 a)) 7))
		     (progn (setq break t) nil)))
	    (if (progn
		  (setq vector-prec (if (or (and calc-vector-commas
						 (math-vector-no-parens
						  (nth 1 a)))
					    (memq 'P calc-matrix-brackets))
					0 1000))
		  (= (length a) 2))
		(list 'horiz
		      (concat left-bracket left-bracket " ")
		      (math-compose-vector (cdr (nth 1 a)) (concat comma " ")
					   vector-prec)
		      (concat " " right-bracket right-bracket))
	      (let* ((rows (1- (length a)))
		     (cols (1- (length (nth 1 a))))
		     (base (/ (1- rows) 2))
		     (calc-language 'flat))
		(append '(horiz)
			(list (append '(vleft)
				      (list base)
				      (list (concat (and outer-brackets
							 (concat left-bracket
								 " "))
						    (and inner-brackets
							 (concat left-bracket
								 " "))))
				      (make-list (1- rows)
						 (concat (and outer-brackets
							      "  ")
							 (and inner-brackets
							      (concat
							       left-bracket
							       " "))))))
			(math-compose-matrix (cdr a) 1 cols base)
			(list (append '(vleft)
				      (list base)
				      (make-list (1- rows)
						 (if inner-brackets
						     (concat " "
							     right-bracket
							     (and row-commas
								  comma))
						   (if (and outer-brackets
							    row-commas)
						       ";" "")))
				      (list (concat
					     (and inner-brackets
						  (concat " "
							  right-bracket))
					     (and outer-brackets
						  (concat
						   " "
						   right-bracket)))))))))
	  (if (and calc-display-strings
		   (cdr a)
		   (math-vector-is-string a))
	      (math-vector-to-string a t)
	    (if (and break (cdr a)
		     (not (eq calc-language 'flat)))
		(let* ((full (or calc-full-vectors (< (length a) 7)))
		       (rows (if full (1- (length a)) 5))
		       (base (/ (1- rows) 2))
		       (just 'vleft)
		       (calc-break-vectors nil))
		  (list 'horiz
			(cons 'vleft (cons base
					   (math-compose-rows
					    (cdr a)
					    (if full rows 3) t)))))
	      (if (or calc-full-vectors (< (length a) 7))
		  (if (and (eq calc-language 'tex)
			   (math-matrixp a))
		      (append '(horiz "\\matrix{ ")
			      (math-compose-tex-matrix (cdr a))
			      '(" }"))
		    (if (and (eq calc-language 'eqn)
			     (math-matrixp a))
			(append '(horiz "matrix { ")
				(math-compose-eqn-matrix
				 (cdr (math-transpose a)))
				'("}"))
		      (if (and (eq calc-language 'maple)
			       (math-matrixp a))
			  (list 'horiz
				"matrix("
				left-bracket
				(math-compose-vector (cdr a) (concat comma " ")
						     vector-prec)
				right-bracket
				")")
			(list 'horiz
			      left-bracket
			      (math-compose-vector (cdr a) (concat comma " ")
						   vector-prec)
			      right-bracket))))
		(list 'horiz
		      left-bracket
		      (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
					   (concat comma " ") vector-prec)
		      comma (if (eq calc-language 'tex) " \\ldots" " ...")
		      comma " "
		      (list 'break math-compose-level)
		      (math-compose-expr (nth (1- (length a)) a)
					 (if (equal comma "") 1000 0))
		      right-bracket)))))))
     ((eq (car a) 'incomplete)
      (if (cdr (cdr a))
	  (cond ((eq (nth 1 a) 'vec)
		 (list 'horiz "["
		       (math-compose-vector (cdr (cdr a)) ", " 0)

	      (t "( ..."))))
     ((eq (car a) 'var)
      (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
	(if v
	    (symbol-name (car v))
	  (if (and (eq calc-language 'tex)
		   calc-language-option
		   (not (= calc-language-option 0))
		   (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
				 (symbol-name (nth 1 a))))
	      (format "\\hbox{%s}" (symbol-name (nth 1 a)))
	    (if (and math-compose-hash-args
		     (let ((p calc-arg-values))
		       (setq v 1)
		       (while (and p (not (equal (car p) a)))
			 (setq p (and (eq math-compose-hash-args t) (cdr p))

     ((eq (car a) 'intv)
      (list 'horiz
	    (if (eq calc-language 'maple) ""
	      (if (memq (nth 1 a) '(0 1)) "(" "["))
	    (math-compose-expr (nth 2 a) 0)
	    (if (eq calc-language 'tex) " \\ldots "
	      (if (eq calc-language 'eqn) " ... " " .. "))
	    (math-compose-expr (nth 3 a) 0)
	    (if (eq calc-language 'maple) ""
	      (if (memq (nth 1 a) '(0 2)) ")" "]"))))
     ((eq (car a) 'date)

	    (math-compose-expr (nth 1 a) 1000)
	    "[["
	    (math-compose-expr (nth 2 a) 0)
	    "]]"))
     ((and (eq (car a) 'calcFunc-sqrt)
	   (eq calc-language 'tex))
      (list 'horiz
	    "\\sqrt{"
	    (math-compose-expr (nth 1 a) 0)
	    "}"))
     ((and nil (eq (car a) 'calcFunc-sqrt)

		  (math-compose-expr (nth 2 a) 0))))
	(list 'vcent
	      (math-comp-height a1)
	      a1 '(rule ?-) a2)))
     ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
	   (eq calc-language 'tex)
	   (= (length a) 5))
      (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
	    "_{" (math-compose-expr (nth 2 a) 0)
	    "=" (math-compose-expr (nth 3 a) 0)
	    "}^{" (math-compose-expr (nth 4 a) 0)

	   (not (eq calc-language 'unform))
	   (= (length a) 3)
	   (integerp (nth 2 a)))
      (let ((c (math-compose-expr (nth 1 a) -1)))
	(if (> prec (nth 2 a))
	    (if (eq calc-language 'tex)
		(list 'horiz "\\left( " c " \\right)")
	      (if (eq calc-language 'eqn)
		  (list 'horiz "{left ( " c " right )}")
		(list 'horiz "(" c ")")))
	  c)))

			    (+ (* (1- (nth 1 a)) (+ ca cd)) (1- ca))
			  (/ (1- (* (nth 1 a) (+ ca cd))) 2)))
		      (make-list (nth 1 a) c))))))
     ((and (eq (car a) 'calcFunc-evalto)
	   (setq calc-any-evaltos t)
	   (memq calc-language '(tex eqn))
	   (= math-compose-level (if math-comp-tagged 2 1))
	   (= (length a) 3))
      (list 'horiz
	    (if (eq calc-language 'tex) "\\evalto " "evalto ")
	    (math-compose-expr (nth 1 a) 0)
	    (if (eq calc-language 'tex) " \\to " " -> ")
	    (math-compose-expr (nth 2 a) 0)))
     (t
      (let ((op (and (not (eq calc-language 'unform))
		     (if (and (eq (car a) 'calcFunc-if) (= (length a) 4))
			 (assoc "?" math-expr-opers)

	(cond ((and op
		    (or (= (length a) 3) (eq (car a) 'calcFunc-if))
		    (/= (nth 3 op) -1))
	       (cond
		((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
		 (if (and (eq calc-language 'tex)
			  (not (math-tex-expr-is-flat a)))
		     (if (eq (car-safe a) '/)
			 (list 'horiz "{" (math-compose-expr a -1) "}")
		       (list 'horiz "\\left( "
			     (math-compose-expr a -1)

			     (list 'horiz "( " (math-compose-expr a -1) " )")
			   (list 'horiz "{left ( "
				 (math-compose-expr a -1)
				 " right )}")))
		     (list 'horiz "(" (math-compose-expr a 0) ")"))))
		((and (eq calc-language 'tex)
		      (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
		      (>= prec 0))
		 (list 'horiz "{" (math-compose-expr a -1) "}"))
		((eq (car a) 'calcFunc-if)
		 (list 'horiz

			(lhs (math-compose-expr (nth 1 a) (nth 2 op)))
			(rhs (math-compose-expr (nth 2 a) (nth 3 op))))
		   (and (equal (car op) "^")
			(eq (math-comp-first-char lhs) ?-)
			(setq lhs (list 'horiz "(" lhs ")")))
		   (and (eq calc-language 'tex)
			(or (equal (car op) "^") (equal (car op) "_"))
			(not (and (stringp rhs) (= (length rhs) 1)))
			(setq rhs (list 'horiz "{" rhs "}")))
		   (or (and (eq (car a) '*)
			    (or (null calc-language)

	      ((and op (= (length a) 2) (= (nth 3 op) -1))
	       (cond
		((or (> prec (or (nth 4 op) (nth 2 op)))
		     (and (not (eq (assoc (car op) math-expr-opers) op))
			  (> prec 0)))   ; don't write x% + y
		 (if (and (eq calc-language 'tex)
			  (not (math-tex-expr-is-flat a)))
		     (list 'horiz "\\left( "
			   (math-compose-expr a -1)
			   " \\right)")
		   (if (eq calc-language 'eqn)

			   (concat " " (car op))
			 (car op)))))))
	      ((and op (= (length a) 2) (= (nth 2 op) -1))
	       (cond
		((eq (nth 3 op) 0)
		 (let ((lr (and (eq calc-language 'tex)
				(not (math-tex-expr-is-flat (nth 1 a))))))
		   (list 'horiz
			 (if lr "\\left" "")
			 (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
			     (substring (car op) 1)

			 (math-compose-expr (nth 1 a) -1)
			 (if (or lr (> (length (car op)) 2)) " " "")
			 (if lr "\\right" "")
			 (car (nth 1 (memq op math-expr-opers))))))
		((> prec (or (nth 4 op) (nth 3 op)))
		 (if (and (eq calc-language 'tex)
			  (not (math-tex-expr-is-flat a)))
		     (list 'horiz "\\left( "
			   (math-compose-expr a -1)
			   " \\right)")
		   (if (eq calc-language 'eqn)

				      ( big . math-compose-normal )
				      ( c . math-compose-c )
				      ( pascal . math-compose-pascal )
				      ( fortran . math-compose-fortran )
				      ( tex . math-compose-tex )
				      ( eqn . math-compose-eqn )
				      ( math . math-compose-math )
				      ( maple . math-compose-maple ))))
		    (setq op (get (car a) (cdr op)))
		    (funcall op a prec)))

				  (symbol-name func))
				 (math-match-substring (symbol-name func) 1)
			       (symbol-name func))))
		 (if (memq calc-language '(c fortran pascal maple))
		     (setq func (math-to-underscores func)))
		 (if (and (eq calc-language 'tex)
			  calc-language-option
			  (not (= calc-language-option 0))
			  (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
		     (if (< (prefix-numeric-value calc-language-option) 0)
			 (setq func (format "\\%s" func))
		       (setq func (format "\\hbox{%s}" func))))
		 (if (and (eq calc-language 'eqn)
			  (string-match "[^']'+\\'" func))
		     (let ((n (- (length func) (match-beginning 0) 1)))
		       (setq func (substring func 0 (- n)))
		       (while (>= (setq n (1- n)) 0)
			 (setq func (concat func " prime")))))
		 (cond ((and (eq calc-language 'tex)
			     (or (> (length a) 2)
				 (not (math-tex-expr-is-flat (nth 1 a)))))
			(setq left "\\left( "
			      right " \\right)"))
		       ((and (eq calc-language 'eqn)
			     (or (> (length a) 2)
				 (not (math-tex-expr-is-flat (nth 1 a)))))
			(setq left "{left ( "
			      right " right )}"))
		       ((and (or (and (eq calc-language 'tex)
				      (eq (aref func 0) ?\\))
				 (and (eq calc-language 'eqn)
				      (memq (car a) math-eqn-special-funcs)))
			     (not (string-match "\\hbox{" func))
			     (= (length a) 2)
			     (or (Math-realp (nth 1 a))
				 (memq (car (nth 1 a)) '(var *))))
			(setq left (if (eq calc-language 'eqn) "~{" "{")
			      right "}"))

(defun math-compose-matrix (a col cols base)
  (let ((col 0)
	(res nil))
    (while (<= (setq col (1+ col)) cols)
      (setq res (cons (cons just
			    (cons base
				  (mapcar (function
					   (lambda (r)
					     (list 'horiz
						   (math-compose-expr
						    (nth col r)
						    vector-prec)
						   (if (= col cols)
						       ""
						     (concat comma-spc " ")))))
					  a)))
		      res)))
    (nreverse res)))

(defun math-compose-rows (a count first)
  (if (cdr a)
      (if (<= count 0)
	  (if (< count 0)
	      (math-compose-rows (cdr a) -1 nil)
	    (cons (concat (if (eq calc-language 'tex) "  \\ldots" "  ...")
			  comma)
		  (math-compose-rows (cdr a) -1 nil)))
	(cons (list 'horiz
		    (if first (concat left-bracket " ") "  ")
		    (math-compose-expr (car a) vector-prec)
		    comma)
	      (math-compose-rows (cdr a) (1- count) nil)))
    (list (list 'horiz
		(if first (concat left-bracket " ") "  ")
		(math-compose-expr (car a) vector-prec)
		(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))))

(defun math-compose-eqn-matrix (a)
  (if a
      (cons

	       (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
		   " " "")
	       expr
	       (if (memq prec '(196 201)) ")" "")))))


(defun math-stack-value-offset-fancy ()
  (let ((cwid (+ (math-comp-width c))))
    (cond ((eq calc-display-just 'right)
	   (if calc-display-origin
	       (setq wid (max calc-display-origin 5))
	     (if (integerp calc-line-breaking)
		 (setq wid calc-line-breaking)))
	   (setq off (- wid cwid
			(max (- (length calc-right-label)
				(if (and (integerp calc-line-breaking)
					 calc-display-origin)
				    (max (- calc-line-breaking
					    calc-display-origin)

				  0))
			     0))))
	  (t
	   (if calc-display-origin
	       (progn
		 (setq off (- calc-display-origin (/ cwid 2)))
		 (if (integerp calc-line-breaking)
		     (setq off (min off (- calc-line-breaking cwid
					   (length calc-right-label)))))
		 (if (>= off 0)
		     (setq wid (max wid (+ off cwid)))))
	     (if (integerp calc-line-breaking)
		 (setq wid calc-line-breaking))
	     (setq off (/ (- wid cwid) 2)))))
    (and (integerp calc-line-breaking)
	 (or (< off 0)
	     (and calc-display-origin
		  (> calc-line-breaking calc-display-origin)))
	 (setq wid calc-line-breaking))))



;;; Convert a composition to string form, with embedded \n's if necessary.

(defun math-composition-to-string (c &optional width)

;;; Convert a one-line composition to a string.  Break into multiple
;;; lines if necessary, choosing break points according to the structure
;;; of the formula.

(defun math-comp-to-string-flat (c full-width)
  (if math-comp-sel-hpos
      (let ((comp-pos 0))
	(math-comp-sel-flat-term c))
    (let ((comp-buf "")
	  (comp-word "")
	  (comp-pos 0)
	  (comp-margin 0)
	  (comp-highlight (and math-comp-selected calc-show-selections))
	  (comp-level -1))
      (math-comp-to-string-flat-term '(set -1 0))
      (math-comp-to-string-flat-term c)
      (math-comp-to-string-flat-term '(break -1))
      (let ((str (aref math-comp-buf-string 0))
	    (prefix ""))
	(and (> (length str) 0) (= (aref str 0) ? )
	     (> (length comp-buf) 0)
	     (let ((k (length comp-buf)))
	       (while (not (= (aref comp-buf (setq k (1- k))) ?\n)))
	       (aset comp-buf k ? )
	       (if (and (< (1+ k) (length comp-buf))
			(= (aref comp-buf (1+ k)) ? ))
		   (progn
		     (aset comp-buf (1+ k) ?\n)
		     (setq prefix " "))
		 (setq prefix "\n"))))
	(concat comp-buf prefix str)))))

(defun math-comp-to-string-flat-term (c)
  (cond ((not (consp c))
	 (if comp-highlight
	     (setq c (math-comp-highlight-string c)))
	 (setq comp-word (if (= (length comp-word) 0) c (concat comp-word c))
	       comp-pos (+ comp-pos (length c))))

	((eq (car c) 'horiz)
	 (while (setq c (cdr c))
	   (math-comp-to-string-flat-term (car c))))

	((eq (car c) 'set)
	 (if (nth 1 c)
	     (progn
	       (setq comp-level (1+ comp-level))
	       (if (>= comp-level (length math-comp-buf-string))
		   (setq math-comp-buf-string (vconcat math-comp-buf-string
						       math-comp-buf-string)
			 math-comp-buf-margin (vconcat math-comp-buf-margin
						       math-comp-buf-margin)
			 math-comp-buf-level (vconcat math-comp-buf-level
						      math-comp-buf-level)))
	       (aset math-comp-buf-string comp-level "")
	       (aset math-comp-buf-margin comp-level (+ comp-pos
							(or (nth 2 c) 0)))
	       (aset math-comp-buf-level comp-level (nth 1 c)))))

	((eq (car c) 'break)
	 (if (not calc-line-breaking)
	     (setq comp-buf (concat comp-buf comp-word)
		   comp-word "")
	   (let ((i 0) str)
	     (if (and (> comp-pos full-width)
		      (progn
			(while (progn
				 (setq str (aref math-comp-buf-string i))
				 (and (= (length str) 0) (< i comp-level)))
			  (setq i (1+ i)))
			(or (> (length str) 0) (> (length comp-buf) 0))))
		 (let ((prefix "") mrg wid)
		   (setq mrg (aref math-comp-buf-margin i))
		   (if (> mrg 12)  ; indenting too far, go back to far left
		       (let ((j i) (new (if calc-line-numbering 5 1)))
			 '(while (<= j comp-level)
			   (aset math-comp-buf-margin j
				 (+ (aref math-comp-buf-margin j) (- new mrg)))
			   (setq j (1+ j)))
			 (setq mrg new)))
		   (setq wid (+ (length str) comp-margin))
		   (and (> (length str) 0) (= (aref str 0) ? )
			(> (length comp-buf) 0)
			(let ((k (length comp-buf)))
			  (while (not (= (aref comp-buf (setq k (1- k))) ?\n)))
			  (aset comp-buf k ? )
			  (if (and (< (1+ k) (length comp-buf))
				   (= (aref comp-buf (1+ k)) ? ))
			      (progn
				(aset comp-buf (1+ k) ?\n)
				(setq prefix " "))
			    (setq prefix "\n"))))
		   (setq comp-buf (concat comp-buf prefix str "\n"
					  (make-string mrg ? ))
			 comp-pos (+ comp-pos (- mrg wid))
			 comp-margin mrg)
		   (aset math-comp-buf-string i "")
		   (while (<= (setq i (1+ i)) comp-level)
		     (if (> (aref math-comp-buf-margin i) wid)
			 (aset math-comp-buf-margin i
			       (+ (aref math-comp-buf-margin i)
				  (- mrg wid))))))))
	   (if (and (= (nth 1 c) (aref math-comp-buf-level comp-level))
		    (< comp-pos (+ (aref math-comp-buf-margin comp-level) 2)))
	       ()  ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
	     (let ((str (aref math-comp-buf-string comp-level)))
	       (setq str (if (= (length str) 0)
			     comp-word
			   (concat str comp-word))
		     comp-word "")
	       (while (< (nth 1 c) (aref math-comp-buf-level comp-level))
		 (setq comp-level (1- comp-level))
		 (or (= (length (aref math-comp-buf-string comp-level)) 0)
		     (setq str (concat (aref math-comp-buf-string comp-level)
				       str))))
	       (aset math-comp-buf-string comp-level str)))))

	((eq (car c) 'tag)
	 (cond ((eq (nth 1 c) math-comp-selected)
		(let ((comp-highlight (not calc-show-selections)))
		  (math-comp-to-string-flat-term (nth 2 c))))
	       ((eq (nth 1 c) t)
		(let ((comp-highlight nil))
		  (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)))))

    (while (>= (setq i (1- i)) 0)
      (or (memq (aref s i) '(32 ?\n))
	  (aset s i (if calc-show-selections ?\. ?\#)))))
  s)

(defun math-comp-sel-flat-term (c)
  (cond ((not (consp c))
	 (setq comp-pos (+ comp-pos (length c))))
	((memq (car c) '(set break)))
	((eq (car c) 'horiz)
	 (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
	   (math-comp-sel-flat-term (car c))))
	((eq (car c) 'tag)
	 (if (<= comp-pos math-comp-sel-cpos)
	     (progn
	       (math-comp-sel-flat-term (nth 2 c))
	       (if (> comp-pos math-comp-sel-cpos)
		   (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)))))


;;; Simplify a composition to a canonical form consisting of
;;;   (vleft n "string" "string" "string" ...)
;;; where 0 <= n < number-of-strings.

(defun math-comp-simplify (c full-width)
  (let ((comp-buf (list ""))
	(comp-base 0)
	(comp-height 1)
	(comp-hpos 0)
	(comp-vpos 0)
	(comp-highlight (and math-comp-selected calc-show-selections))
	(comp-tag nil))
    (math-comp-simplify-term c)
    (cons 'vleft (cons comp-base comp-buf))))

(defun math-comp-add-string (s h v)
  (and (> (length s) 0)
       (let ((vv (+ v comp-base)))
	 (if math-comp-sel-hpos
	     (math-comp-add-string-sel h vv (length s) 1)
	   (if (< vv 0)
	       (setq comp-buf (nconc (make-list (- vv) "") comp-buf)
		     comp-base (- v)
		     comp-height (- comp-height vv)
		     vv 0)
	     (if (>= vv comp-height)
		 (setq comp-buf (nconc comp-buf
				       (make-list (1+ (- vv comp-height)) ""))
		       comp-height (1+ vv))))
	   (let ((str (nthcdr vv comp-buf)))
	     (setcar str (concat (car str)
				 (make-string (- h (length (car str))) 32)
				 (if comp-highlight
				     (math-comp-highlight-string s)
				   s))))))))

(defun math-comp-add-string-sel (x y w h)
  (if (and (<= y math-comp-sel-vpos)
	   (> (+ y h) math-comp-sel-vpos)
	   (<= x math-comp-sel-hpos)
	   (> (+ x w) math-comp-sel-hpos))
      (setq math-comp-sel-tag comp-tag
	    math-comp-sel-vpos 10000)))

(defun math-comp-simplify-term (c)
  (cond ((stringp c)
	 (math-comp-add-string c comp-hpos comp-vpos)
	 (setq comp-hpos (+ comp-hpos (length c))))
	((memq (car c) '(set break))
	 nil)
	((eq (car c) 'horiz)
	 (while (setq c (cdr c))
	   (math-comp-simplify-term (car c))))
	((memq (car c) '(vleft vcent vright))
	 (let* ((comp-vpos (+ (- comp-vpos (nth 1 c))
			      (1- (math-comp-ascent (nth 2 c)))))
		(widths (mapcar 'math-comp-width (cdr (cdr c))))
		(maxwid (apply 'max widths))
		(bias (cond ((eq (car c) 'vleft) 0)
			    ((eq (car c) 'vcent) 1)
			    (t 2))))
	   (setq c (cdr c))
	   (while (setq c (cdr c))
	     (if (eq (car-safe (car c)) 'rule)
		 (math-comp-add-string (make-string maxwid (nth 1 (car c)))
				       comp-hpos comp-vpos)
	       (let ((comp-hpos (+ comp-hpos (/ (* bias (- maxwid
							   (car widths)))
						2))))
		 (math-comp-simplify-term (car c))))
	     (and (cdr c)
		  (setq comp-vpos (+ comp-vpos
				     (+ (math-comp-descent (car c))
					(math-comp-ascent (nth 1 c))))
			widths (cdr widths))))
	   (setq comp-hpos (+ comp-hpos maxwid))))
	((eq (car c) 'supscr)
	 (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
		(desc (math-comp-descent (nth 2 c)))
		(oldh (prog1
			  comp-hpos
			(math-comp-simplify-term (nth 1 c))))
		(comp-vpos (- comp-vpos (+ asc desc))))
	   (math-comp-simplify-term (nth 2 c))
	   (if math-comp-sel-hpos
	       (math-comp-add-string-sel oldh
					 (- comp-vpos
					    -1
					    (math-comp-ascent (nth 2 c)))
					 (- comp-hpos oldh)
					 (math-comp-height c)))))
	((eq (car c) 'subscr)
	 (let* ((asc (math-comp-ascent (nth 2 c)))
		(desc (math-comp-descent (nth 1 c)))
		(oldv comp-vpos)
		(oldh (prog1
			  comp-hpos
			(math-comp-simplify-term (nth 1 c))))
		(comp-vpos (+ comp-vpos (+ asc desc))))
	   (math-comp-simplify-term (nth 2 c))
	   (if math-comp-sel-hpos
	       (math-comp-add-string-sel oldh oldv
					 (- comp-hpos oldh)
					 (math-comp-height c)))))
	((eq (car c) 'tag)
	 (cond ((eq (nth 1 c) math-comp-selected)
		(let ((comp-highlight (not calc-show-selections)))
		  (math-comp-simplify-term (nth 2 c))))
	       ((eq (nth 1 c) t)
		(let ((comp-highlight nil))
		  (math-comp-simplify-term (nth 2 c))))
	       (t (let ((comp-tag c))
		    (math-comp-simplify-term (nth 2 c))))))))


;;; Measuring a composition.

	      (make-string indent 32)
	      (math-comp-to-string-raw (car cl) indent)
	      (math-comp-to-string-raw-step (cdr cl) indent))
    ""))

;;; calccomp.el ends here

88155:d7ddb3e565de

;;; calccomp.el --- composition functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Jay Belanger <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.

(require 'calc-ext)
(require 'calc-macs)

(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))

;;; A "composition" has one of the following forms:
;;;

;;;    (subscr C1 C2)        Composition C1 with subscript C2
;;;    (rule X)              Horizontal line of X, full width of enclosing comp
;;;
;;;    (tag X C)             Composition C corresponds to sub-expression X

;; math-comp-just and math-comp-comma-spc are local to 
;; math-compose-expr, but are used by math-compose-matrix, which is 
;; called by math-compose-expr
(defvar math-comp-just)
(defvar math-comp-comma-spc)

;; math-comp-vector-prec is local to math-compose-expr, but is used by 
;; math-compose-matrix and math-compose-rows, which are called by 
;; math-compose-expr.
(defvar math-comp-vector-prec)

;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are 
;; local to math-compose-expr, but are used by math-compose-rows, which is 
;; called by math-compose-expr.
(defvar math-comp-left-bracket)
(defvar math-comp-right-bracket)
(defvar math-comp-comma)


(defun math-compose-expr (a prec)
  (let ((math-compose-level (1+ math-compose-level))
        spfn)
    (cond
     ((or (and (eq a math-comp-selected) a)
	  (and math-comp-tagged
	       (not (eq math-comp-tagged a))))
      (let ((math-comp-selected nil))
	(and math-comp-tagged (setq math-comp-tagged a))
	(list 'tag a (math-compose-expr a prec))))
     ((and (not (consp a)) (not (integerp a)))
      (concat "'" (prin1-to-string a)))
     ((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
      (setq spfn (cdr spfn))
      (funcall (car spfn) a spfn))
     ((math-scalarp a)
      (if (or (eq (car-safe a) 'frac)
	      (and (nth 1 calc-frac-format) (Math-integerp a)))
	  (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
	      (let ((aa (math-adjust-fraction a))
		    (calc-frac-format nil))
		(math-compose-expr (list '/
					 (if (memq calc-language '(c fortran))
					     (math-float (nth 1 aa))

			       (setq temp (apply (cdr temp2) (cdr a)))
			       (math-compose-expr temp prec))
			  (and (setq temp2 (assq nil (cdr temp)))
			       (funcall (cdr temp2) a))))))))
     ((eq (car a) 'vec)
      (let* ((math-comp-left-bracket (if calc-vector-brackets
			       (substring calc-vector-brackets 0 1) ""))
	     (math-comp-right-bracket (if calc-vector-brackets
				(substring calc-vector-brackets 1 2) ""))
	     (inner-brackets (memq 'R calc-matrix-brackets))
	     (outer-brackets (memq 'O calc-matrix-brackets))
	     (row-commas (memq 'C calc-matrix-brackets))
	     (math-comp-comma-spc (or calc-vector-commas " "))
	     (math-comp-comma (or calc-vector-commas ""))
	     (math-comp-vector-prec (if (or (and calc-vector-commas
				       (math-vector-no-parens a))
				  (memq 'P calc-matrix-brackets)) 0 1000))
	     (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright)
                                      ((eq calc-matrix-just 'center) 'vcent)
                                      (t 'vleft)))
	     (break calc-break-vectors))
	(if (and (memq calc-language '(nil big))
		 (not calc-break-vectors)
		 (math-matrixp a) (not (math-matrixp (nth 1 a)))
		 (or calc-full-vectors
		     (and (< (length a) 7) (< (length (nth 1 a)) 7))
		     (progn (setq break t) nil)))
	    (if (progn
		  (setq math-comp-vector-prec (if (or (and calc-vector-commas
                                                           (math-vector-no-parens
                                                            (nth 1 a)))
                                                      (memq 'P calc-matrix-brackets))
                                                  0 1000))
		  (= (length a) 2))
		(list 'horiz
		      (concat math-comp-left-bracket math-comp-left-bracket " ")
		      (math-compose-vector (cdr (nth 1 a)) (concat math-comp-comma " ")
					   math-comp-vector-prec)
		      (concat " " math-comp-right-bracket math-comp-right-bracket))
	      (let* ((rows (1- (length a)))
		     (cols (1- (length (nth 1 a))))
		     (base (/ (1- rows) 2))
		     (calc-language 'flat))
		(append '(horiz)
			(list (append '(vleft)
				      (list base)
				      (list (concat (and outer-brackets
							 (concat math-comp-left-bracket
								 " "))
						    (and inner-brackets
							 (concat math-comp-left-bracket
								 " "))))
				      (make-list (1- rows)
						 (concat (and outer-brackets
							      "  ")
							 (and inner-brackets
							      (concat
							       math-comp-left-bracket
							       " "))))))
			(math-compose-matrix (cdr a) 1 cols base)
			(list (append '(vleft)
				      (list base)
				      (make-list (1- rows)
						 (if inner-brackets
						     (concat " "
							     math-comp-right-bracket
							     (and row-commas
								  math-comp-comma))
						   (if (and outer-brackets
							    row-commas)
						       ";" "")))
				      (list (concat
					     (and inner-brackets
						  (concat " "
							  math-comp-right-bracket))
					     (and outer-brackets
						  (concat
						   " "
						   math-comp-right-bracket)))))))))
	  (if (and calc-display-strings
		   (cdr a)
		   (math-vector-is-string a))
	      (math-vector-to-string a t)
	    (if (and break (cdr a)
		     (not (eq calc-language 'flat)))
		(let* ((full (or calc-full-vectors (< (length a) 7)))
		       (rows (if full (1- (length a)) 5))
		       (base (/ (1- rows) 2))
		       (calc-break-vectors nil))
		  (list 'horiz
			(cons 'vleft (cons base
					   (math-compose-rows
					    (cdr a)
					    (if full rows 3) t)))))
	      (if (or calc-full-vectors (< (length a) 7))
		  (if (and (eq calc-language 'tex)
			   (math-matrixp a))
                      (if (and (integerp calc-language-option)
                               (or (= calc-language-option 0)
                                   (> calc-language-option 1)
                                   (< calc-language-option -1)))
                          (append '(vleft 0 "\\matrix{")
                                  (math-compose-tex-matrix (cdr a))
                                  '("}"))
                        (append '(horiz "\\matrix{ ")
                                (math-compose-tex-matrix (cdr a))
                                '(" }")))
                    (if (and (eq calc-language 'latex)
                             (math-matrixp a))
                        (if (and (integerp calc-language-option)
                                 (or (= calc-language-option 0)
                                     (> calc-language-option 1)
                                     (< calc-language-option -1)))
                            (append '(vleft 0 "\\begin{pmatrix}")
                                    (math-compose-tex-matrix (cdr a))
                                    '("\\end{pmatrix}"))
                          (append '(horiz "\\begin{pmatrix} ")
                                  (math-compose-tex-matrix (cdr a))
                                  '(" \\end{pmatrix}")))
                      (if (and (eq calc-language 'eqn)
                               (math-matrixp a))
                          (append '(horiz "matrix { ")
                                  (math-compose-eqn-matrix
                                   (cdr (math-transpose a)))
                                  '("}"))
                        (if (and (eq calc-language 'maple)
                                 (math-matrixp 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
                                  ")")
                          (list 'horiz
                                math-comp-left-bracket
                                (math-compose-vector (cdr a) 
                                                     (concat math-comp-comma " ")
                                                     math-comp-vector-prec)
                                math-comp-right-bracket)))))
		(list 'horiz
		      math-comp-left-bracket
		      (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
					   (concat math-comp-comma " ") 
                                           math-comp-vector-prec)
		      math-comp-comma (if (memq calc-language '(tex latex)) 
                                          " \\ldots" " ...")
		      math-comp-comma " "
		      (list 'break math-compose-level)
		      (math-compose-expr (nth (1- (length a)) a)
					 (if (equal math-comp-comma "") 1000 0))
		      math-comp-right-bracket)))))))
     ((eq (car a) 'incomplete)
      (if (cdr (cdr a))
	  (cond ((eq (nth 1 a) 'vec)
		 (list 'horiz "["
		       (math-compose-vector (cdr (cdr a)) ", " 0)

	      (t "( ..."))))
     ((eq (car a) 'var)
      (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
	(if v
	    (symbol-name (car v))
	  (if (and (memq calc-language '(tex latex))
		   calc-language-option
		   (not (= calc-language-option 0))
		   (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
				 (symbol-name (nth 1 a))))
              (if (eq calc-language 'latex)
                  (format "\\text{%s}" (symbol-name (nth 1 a)))
                (format "\\hbox{%s}" (symbol-name (nth 1 a))))
	    (if (and math-compose-hash-args
		     (let ((p calc-arg-values))
		       (setq v 1)
		       (while (and p (not (equal (car p) a)))
			 (setq p (and (eq math-compose-hash-args t) (cdr p))

     ((eq (car a) 'intv)
      (list 'horiz
	    (if (eq calc-language 'maple) ""
	      (if (memq (nth 1 a) '(0 1)) "(" "["))
	    (math-compose-expr (nth 2 a) 0)
	    (if (memq calc-language '(tex latex)) " \\ldots "
	      (if (eq calc-language 'eqn) " ... " " .. "))
	    (math-compose-expr (nth 3 a) 0)
	    (if (eq calc-language 'maple) ""
	      (if (memq (nth 1 a) '(0 2)) ")" "]"))))
     ((eq (car a) 'date)

	    (math-compose-expr (nth 1 a) 1000)
	    "[["
	    (math-compose-expr (nth 2 a) 0)
	    "]]"))
     ((and (eq (car a) 'calcFunc-sqrt)
	   (memq calc-language '(tex latex)))
      (list 'horiz
	    "\\sqrt{"
	    (math-compose-expr (nth 1 a) 0)
	    "}"))
     ((and nil (eq (car a) 'calcFunc-sqrt)

		  (math-compose-expr (nth 2 a) 0))))
	(list 'vcent
	      (math-comp-height a1)
	      a1 '(rule ?-) a2)))
     ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
	   (memq calc-language '(tex latex))
	   (= (length a) 5))
      (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
	    "_{" (math-compose-expr (nth 2 a) 0)
	    "=" (math-compose-expr (nth 3 a) 0)
	    "}^{" (math-compose-expr (nth 4 a) 0)

	   (not (eq calc-language 'unform))
	   (= (length a) 3)
	   (integerp (nth 2 a)))
      (let ((c (math-compose-expr (nth 1 a) -1)))
	(if (> prec (nth 2 a))
	    (if (memq calc-language '(tex latex))
		(list 'horiz "\\left( " c " \\right)")
	      (if (eq calc-language 'eqn)
		  (list 'horiz "{left ( " c " right )}")
		(list 'horiz "(" c ")")))
	  c)))

			    (+ (* (1- (nth 1 a)) (+ ca cd)) (1- ca))
			  (/ (1- (* (nth 1 a) (+ ca cd))) 2)))
		      (make-list (nth 1 a) c))))))
     ((and (eq (car a) 'calcFunc-evalto)
	   (setq calc-any-evaltos t)
	   (memq calc-language '(tex latex eqn))
	   (= math-compose-level (if math-comp-tagged 2 1))
	   (= (length a) 3))
      (list 'horiz
	    (if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
	    (math-compose-expr (nth 1 a) 0)
	    (if (memq calc-language '(tex latex)) " \\to " " -> ")
	    (math-compose-expr (nth 2 a) 0)))
     (t
      (let ((op (and (not (eq calc-language 'unform))
		     (if (and (eq (car a) 'calcFunc-if) (= (length a) 4))
			 (assoc "?" math-expr-opers)

	(cond ((and op
		    (or (= (length a) 3) (eq (car a) 'calcFunc-if))
		    (/= (nth 3 op) -1))
	       (cond
		((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
		 (if (and (memq calc-language '(tex latex))
			  (not (math-tex-expr-is-flat a)))
		     (if (eq (car-safe a) '/)
			 (list 'horiz "{" (math-compose-expr a -1) "}")
		       (list 'horiz "\\left( "
			     (math-compose-expr a -1)

			     (list 'horiz "( " (math-compose-expr a -1) " )")
			   (list 'horiz "{left ( "
				 (math-compose-expr a -1)
				 " right )}")))
		     (list 'horiz "(" (math-compose-expr a 0) ")"))))
		((and (memq calc-language '(tex latex))
		      (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
		      (>= prec 0))
		 (list 'horiz "{" (math-compose-expr a -1) "}"))
		((eq (car a) 'calcFunc-if)
		 (list 'horiz

			(lhs (math-compose-expr (nth 1 a) (nth 2 op)))
			(rhs (math-compose-expr (nth 2 a) (nth 3 op))))
		   (and (equal (car op) "^")
			(eq (math-comp-first-char lhs) ?-)
			(setq lhs (list 'horiz "(" lhs ")")))
		   (and (memq calc-language '(tex latex))
			(or (equal (car op) "^") (equal (car op) "_"))
			(not (and (stringp rhs) (= (length rhs) 1)))
			(setq rhs (list 'horiz "{" rhs "}")))
		   (or (and (eq (car a) '*)
			    (or (null calc-language)

	      ((and op (= (length a) 2) (= (nth 3 op) -1))
	       (cond
		((or (> prec (or (nth 4 op) (nth 2 op)))
		     (and (not (eq (assoc (car op) math-expr-opers) op))
			  (> prec 0)))   ; don't write x% + y
		 (if (and (memq calc-language '(tex latex))
			  (not (math-tex-expr-is-flat a)))
		     (list 'horiz "\\left( "
			   (math-compose-expr a -1)
			   " \\right)")
		   (if (eq calc-language 'eqn)

			   (concat " " (car op))
			 (car op)))))))
	      ((and op (= (length a) 2) (= (nth 2 op) -1))
	       (cond
		((eq (nth 3 op) 0)
		 (let ((lr (and (memq calc-language '(tex latex))
				(not (math-tex-expr-is-flat (nth 1 a))))))
		   (list 'horiz
			 (if lr "\\left" "")
			 (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
			     (substring (car op) 1)

			 (math-compose-expr (nth 1 a) -1)
			 (if (or lr (> (length (car op)) 2)) " " "")
			 (if lr "\\right" "")
			 (car (nth 1 (memq op math-expr-opers))))))
		((> prec (or (nth 4 op) (nth 3 op)))
		 (if (and (memq calc-language '(tex latex))
			  (not (math-tex-expr-is-flat a)))
		     (list 'horiz "\\left( "
			   (math-compose-expr a -1)
			   " \\right)")
		   (if (eq calc-language 'eqn)

				      ( big . math-compose-normal )
				      ( c . math-compose-c )
				      ( pascal . math-compose-pascal )
				      ( fortran . math-compose-fortran )
				      ( tex . math-compose-tex )
				      ( latex . math-compose-latex )
				      ( eqn . math-compose-eqn )
				      ( math . math-compose-math )
				      ( maple . math-compose-maple ))))
		    (setq op (get (car a) (cdr op)))
		    (funcall op a prec)))

				  (symbol-name func))
				 (math-match-substring (symbol-name func) 1)
			       (symbol-name func))))
		 (if (memq calc-language '(c fortran pascal maple))
		     (setq func (math-to-underscores func)))
		 (if (and (memq calc-language '(tex latex))
			  calc-language-option
			  (not (= calc-language-option 0))
			  (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
		     (if (< (prefix-numeric-value calc-language-option) 0)
			 (setq func (format "\\%s" func))
		       (setq func (if (eq calc-language 'latex)
                                      (format "\\text{%s}" func)
                                    (format "\\hbox{%s}" func)))))
		 (if (and (eq calc-language 'eqn)
			  (string-match "[^']'+\\'" func))
		     (let ((n (- (length func) (match-beginning 0) 1)))
		       (setq func (substring func 0 (- n)))
		       (while (>= (setq n (1- n)) 0)
			 (setq func (concat func " prime")))))
		 (cond ((and (memq calc-language '(tex latex))
			     (or (> (length a) 2)
				 (not (math-tex-expr-is-flat (nth 1 a)))))
			(setq left "\\left( "
			      right " \\right)"))
		       ((and (eq calc-language 'eqn)
			     (or (> (length a) 2)
				 (not (math-tex-expr-is-flat (nth 1 a)))))
			(setq left "{left ( "
			      right " right )}"))
		       ((and (or (and (memq calc-language '(tex latex))
				      (eq (aref func 0) ?\\))
				 (and (eq calc-language 'eqn)
				      (memq (car a) math-eqn-special-funcs)))
			     (not (or
                                   (string-match "\\hbox{" func)
                                   (string-match "\\text{" func)))
			     (= (length a) 2)
			     (or (Math-realp (nth 1 a))
				 (memq (car (nth 1 a)) '(var *))))
			(setq left (if (eq calc-language 'eqn) "~{" "{")
			      right "}"))

(defun math-compose-matrix (a col cols base)
  (let ((col 0)
	(res nil))
    (while (<= (setq col (1+ col)) cols)
      (setq res (cons (cons math-comp-just
			    (cons base
				  (mapcar (function
					   (lambda (r)
					     (list 'horiz
						   (math-compose-expr
						    (nth col r)
						    math-comp-vector-prec)
						   (if (= col cols)
						       ""
						     (concat 
                                                      math-comp-comma-spc " ")))))
					  a)))
		      res)))
    (nreverse res)))

(defun math-compose-rows (a count first)
  (if (cdr a)
      (if (<= count 0)
	  (if (< count 0)
	      (math-compose-rows (cdr a) -1 nil)
	    (cons (concat (if (memq calc-language '(tex latex)) "  \\ldots" "  ...")
			  math-comp-comma)
		  (math-compose-rows (cdr a) -1 nil)))
	(cons (list 'horiz
		    (if first (concat math-comp-left-bracket " ") "  ")
		    (math-compose-expr (car a) math-comp-vector-prec)
		    math-comp-comma)
	      (math-compose-rows (cdr a) (1- count) nil)))
    (list (list 'horiz
		(if first (concat math-comp-left-bracket " ") "  ")
		(math-compose-expr (car a) math-comp-vector-prec)
		(concat " " math-comp-right-bracket)))))

(defun math-compose-tex-matrix (a)
  (if (cdr a)
      (cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
            (math-compose-tex-matrix (cdr a)))
    (list (math-compose-vector (cdr (car a)) " & " 0))))

(defun math-compose-eqn-matrix (a)
  (if a
      (cons

	       (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
		   " " "")
	       expr
	       (if (memq prec '(196 201)) ")" "")))))

;; The variables math-svo-c, math-svo-wid and math-svo-off are local
;; to math-stack-value-offset in calc.el, but are used by 
;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
(defvar math-svo-c)
(defvar math-svo-wid)
(defvar math-svo-off)

(defun math-stack-value-offset-fancy ()
  (let ((cwid (+ (math-comp-width math-svo-c))))
    (cond ((eq calc-display-just 'right)
	   (if calc-display-origin
	       (setq math-svo-wid (max calc-display-origin 5))
	     (if (integerp calc-line-breaking)
		 (setq math-svo-wid calc-line-breaking)))
	   (setq math-svo-off (- math-svo-wid cwid
			(max (- (length calc-right-label)
				(if (and (integerp calc-line-breaking)
					 calc-display-origin)
				    (max (- calc-line-breaking
					    calc-display-origin)

				  0))
			     0))))
	  (t
	   (if calc-display-origin
	       (progn
		 (setq math-svo-off (- calc-display-origin (/ cwid 2)))
		 (if (integerp calc-line-breaking)
		     (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
					   (length calc-right-label)))))
		 (if (>= math-svo-off 0)
		     (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
	     (if (integerp calc-line-breaking)
		 (setq math-svo-wid calc-line-breaking))
	     (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
    (and (integerp calc-line-breaking)
	 (or (< math-svo-off 0)
	     (and calc-display-origin
		  (> calc-line-breaking calc-display-origin)))
	 (setq math-svo-wid calc-line-breaking))))


;;; Convert a composition to string form, with embedded \n's if necessary.

(defun math-composition-to-string (c &optional width)

;;; Convert a one-line composition to a string.  Break into multiple
;;; lines if necessary, choosing break points according to the structure
;;; of the formula.

;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
;; math-comp-level, math-comp-margin and math-comp-buf are local to 
;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, 
;; which is called by math-comp-to-string-flat.
;; math-comp-highlight and math-comp-buf are also local to 
;; math-comp-simplify-term and math-comp-simplify respectively, but are used 
;; by math-comp-add-string.
(defvar math-comp-full-width)
(defvar math-comp-highlight)
(defvar math-comp-word)
(defvar math-comp-level)
(defvar math-comp-margin)
(defvar math-comp-buf)
;; The variable math-comp-pos is local to math-comp-to-string-flat, but
;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term,
;; which are called by math-comp-to-string-flat.
(defvar math-comp-pos)

(defun math-comp-to-string-flat (c math-comp-full-width)
  (if math-comp-sel-hpos
      (let ((math-comp-pos 0))
	(math-comp-sel-flat-term c))
    (let ((math-comp-buf "")
	  (math-comp-word "")
	  (math-comp-pos 0)
	  (math-comp-margin 0)
	  (math-comp-highlight (and math-comp-selected calc-show-selections))
	  (math-comp-level -1))
      (math-comp-to-string-flat-term '(set -1 0))
      (math-comp-to-string-flat-term c)
      (math-comp-to-string-flat-term '(break -1))
      (let ((str (aref math-comp-buf-string 0))
	    (prefix ""))
	(and (> (length str) 0) (= (aref str 0) ? )
	     (> (length math-comp-buf) 0)
	     (let ((k (length math-comp-buf)))
	       (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
	       (aset math-comp-buf k ? )
	       (if (and (< (1+ k) (length math-comp-buf))
			(= (aref math-comp-buf (1+ k)) ? ))
		   (progn
		     (aset math-comp-buf (1+ k) ?\n)
		     (setq prefix " "))
		 (setq prefix "\n"))))
	(concat math-comp-buf prefix str)))))

(defun math-comp-to-string-flat-term (c)
  (cond ((not (consp c))
	 (if math-comp-highlight
	     (setq c (math-comp-highlight-string c)))
	 (setq math-comp-word (if (= (length math-comp-word) 0) c 
                                (concat math-comp-word c))
	       math-comp-pos (+ math-comp-pos (length c))))

	((eq (car c) 'horiz)
	 (while (setq c (cdr c))
	   (math-comp-to-string-flat-term (car c))))

	((eq (car c) 'set)
	 (if (nth 1 c)
	     (progn
	       (setq math-comp-level (1+ math-comp-level))
	       (if (>= math-comp-level (length math-comp-buf-string))
		   (setq math-comp-buf-string (vconcat math-comp-buf-string
						       math-comp-buf-string)
			 math-comp-buf-margin (vconcat math-comp-buf-margin
						       math-comp-buf-margin)
			 math-comp-buf-level (vconcat math-comp-buf-level
						      math-comp-buf-level)))
	       (aset math-comp-buf-string math-comp-level "")
	       (aset math-comp-buf-margin math-comp-level (+ math-comp-pos
							(or (nth 2 c) 0)))
	       (aset math-comp-buf-level math-comp-level (nth 1 c)))))

	((eq (car c) 'break)
	 (if (not calc-line-breaking)
	     (setq math-comp-buf (concat math-comp-buf math-comp-word)
		   math-comp-word "")
	   (let ((i 0) str)
	     (if (and (> math-comp-pos math-comp-full-width)
		      (progn
			(while (progn
				 (setq str (aref math-comp-buf-string i))
				 (and (= (length str) 0) (< i math-comp-level)))
			  (setq i (1+ i)))
			(or (> (length str) 0) (> (length math-comp-buf) 0))))
		 (let ((prefix "") mrg wid)
		   (setq mrg (aref math-comp-buf-margin i))
		   (if (> mrg 12)  ; indenting too far, go back to far left
		       (let ((j i) (new (if calc-line-numbering 5 1)))
			 '(while (<= j math-comp-level)
			   (aset math-comp-buf-margin j
				 (+ (aref math-comp-buf-margin j) (- new mrg)))
			   (setq j (1+ j)))
			 (setq mrg new)))
		   (setq wid (+ (length str) math-comp-margin))
		   (and (> (length str) 0) (= (aref str 0) ? )
			(> (length math-comp-buf) 0)
			(let ((k (length math-comp-buf)))
			  (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n)))
			  (aset math-comp-buf k ? )
			  (if (and (< (1+ k) (length math-comp-buf))
				   (= (aref math-comp-buf (1+ k)) ? ))
			      (progn
				(aset math-comp-buf (1+ k) ?\n)
				(setq prefix " "))
			    (setq prefix "\n"))))
		   (setq math-comp-buf (concat math-comp-buf prefix str "\n"
					  (make-string mrg ? ))
			 math-comp-pos (+ math-comp-pos (- mrg wid))
			 math-comp-margin mrg)
		   (aset math-comp-buf-string i "")
		   (while (<= (setq i (1+ i)) math-comp-level)
		     (if (> (aref math-comp-buf-margin i) wid)
			 (aset math-comp-buf-margin i
			       (+ (aref math-comp-buf-margin i)
				  (- mrg wid))))))))
	   (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level))
		    (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2)))
	       ()  ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
	     (let ((str (aref math-comp-buf-string math-comp-level)))
	       (setq str (if (= (length str) 0)
			     math-comp-word
			   (concat str math-comp-word))
		     math-comp-word "")
	       (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level))
		 (setq math-comp-level (1- math-comp-level))
		 (or (= (length (aref math-comp-buf-string math-comp-level)) 0)
		     (setq str (concat (aref math-comp-buf-string math-comp-level)
				       str))))
	       (aset math-comp-buf-string math-comp-level str)))))

	((eq (car c) 'tag)
	 (cond ((eq (nth 1 c) math-comp-selected)
		(let ((math-comp-highlight (not calc-show-selections)))
		  (math-comp-to-string-flat-term (nth 2 c))))
	       ((eq (nth 1 c) t)
		(let ((math-comp-highlight nil))
		  (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)))))

    (while (>= (setq i (1- i)) 0)
      (or (memq (aref s i) '(32 ?\n))
	  (aset s i (if calc-show-selections ?\. ?\#)))))
  s)


;; The variable math-comp-sel-tag is local to calc-find-selected-part
;; in calc-sel.el, but is used by math-comp-sel-flat-term and 
;; math-comp-add-string-sel, which are called (indirectly) by 
;; calc-find-selected-part.
(defvar math-comp-sel-tag)

(defun math-comp-sel-flat-term (c)
  (cond ((not (consp c))
	 (setq math-comp-pos (+ math-comp-pos (length c))))
	((memq (car c) '(set break)))
	((eq (car c) 'horiz)
	 (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
	   (math-comp-sel-flat-term (car c))))
	((eq (car c) 'tag)
	 (if (<= math-comp-pos math-comp-sel-cpos)
	     (progn
	       (math-comp-sel-flat-term (nth 2 c))
	       (if (> math-comp-pos math-comp-sel-cpos)
		   (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)))))


;;; Simplify a composition to a canonical form consisting of
;;;   (vleft n "string" "string" "string" ...)
;;; where 0 <= n < number-of-strings.

;; The variables math-comp-base, math-comp-hgt, math-comp-tag,
;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify,
;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt),
;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term
;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by
;; math-comp-simplify.
(defvar math-comp-base)
(defvar math-comp-hgt)
(defvar math-comp-tag)
(defvar math-comp-hpos)
(defvar math-comp-vpos)

(defun math-comp-simplify (c full-width)
  (let ((math-comp-buf (list ""))
	(math-comp-base 0)
	(math-comp-hgt 1)
	(math-comp-hpos 0)
	(math-comp-vpos 0)
	(math-comp-highlight (and math-comp-selected calc-show-selections))
	(math-comp-tag nil))
    (math-comp-simplify-term c)
    (cons 'vleft (cons math-comp-base math-comp-buf))))

(defun math-comp-add-string (s h v)
  (and (> (length s) 0)
       (let ((vv (+ v math-comp-base)))
	 (if math-comp-sel-hpos
	     (math-comp-add-string-sel h vv (length s) 1)
	   (if (< vv 0)
	       (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf)
		     math-comp-base (- v)
		     math-comp-hgt (- math-comp-hgt vv)
		     vv 0)
	     (if (>= vv math-comp-hgt)
		 (setq math-comp-buf (nconc math-comp-buf
				       (make-list (1+ (- vv math-comp-hgt)) ""))
		       math-comp-hgt (1+ vv))))
	   (let ((str (nthcdr vv math-comp-buf)))
	     (setcar str (concat (car str)
				 (make-string (- h (length (car str))) 32)
				 (if math-comp-highlight
				     (math-comp-highlight-string s)
				   s))))))))

(defun math-comp-add-string-sel (x y w h)
  (if (and (<= y math-comp-sel-vpos)
	   (> (+ y h) math-comp-sel-vpos)
	   (<= x math-comp-sel-hpos)
	   (> (+ x w) math-comp-sel-hpos))
      (setq math-comp-sel-tag math-comp-tag
	    math-comp-sel-vpos 10000)))

(defun math-comp-simplify-term (c)
  (cond ((stringp c)
	 (math-comp-add-string c math-comp-hpos math-comp-vpos)
	 (setq math-comp-hpos (+ math-comp-hpos (length c))))
	((memq (car c) '(set break))
	 nil)
	((eq (car c) 'horiz)
	 (while (setq c (cdr c))
	   (math-comp-simplify-term (car c))))
	((memq (car c) '(vleft vcent vright))
	 (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c))
			      (1- (math-comp-ascent (nth 2 c)))))
		(widths (mapcar 'math-comp-width (cdr (cdr c))))
		(maxwid (apply 'max widths))
		(bias (cond ((eq (car c) 'vleft) 0)
			    ((eq (car c) 'vcent) 1)
			    (t 2))))
	   (setq c (cdr c))
	   (while (setq c (cdr c))
	     (if (eq (car-safe (car c)) 'rule)
		 (math-comp-add-string (make-string maxwid (nth 1 (car c)))
				       math-comp-hpos math-comp-vpos)
	       (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid
							   (car widths)))
						2))))
		 (math-comp-simplify-term (car c))))
	     (and (cdr c)
		  (setq math-comp-vpos (+ math-comp-vpos
				     (+ (math-comp-descent (car c))
					(math-comp-ascent (nth 1 c))))
			widths (cdr widths))))
	   (setq math-comp-hpos (+ math-comp-hpos maxwid))))
	((eq (car c) 'supscr)
	 (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
		(desc (math-comp-descent (nth 2 c)))
		(oldh (prog1
			  math-comp-hpos
			(math-comp-simplify-term (nth 1 c))))
		(math-comp-vpos (- math-comp-vpos (+ asc desc))))
	   (math-comp-simplify-term (nth 2 c))
	   (if math-comp-sel-hpos
	       (math-comp-add-string-sel oldh
					 (- math-comp-vpos
					    -1
					    (math-comp-ascent (nth 2 c)))
					 (- math-comp-hpos oldh)
					 (math-comp-height c)))))
	((eq (car c) 'subscr)
	 (let* ((asc (math-comp-ascent (nth 2 c)))
		(desc (math-comp-descent (nth 1 c)))
		(oldv math-comp-vpos)
		(oldh (prog1
			  math-comp-hpos
			(math-comp-simplify-term (nth 1 c))))
		(math-comp-vpos (+ math-comp-vpos (+ asc desc))))
	   (math-comp-simplify-term (nth 2 c))
	   (if math-comp-sel-hpos
	       (math-comp-add-string-sel oldh oldv
					 (- math-comp-hpos oldh)
					 (math-comp-height c)))))
	((eq (car c) 'tag)
	 (cond ((eq (nth 1 c) math-comp-selected)
		(let ((math-comp-highlight (not calc-show-selections)))
		  (math-comp-simplify-term (nth 2 c))))
	       ((eq (nth 1 c) t)
		(let ((math-comp-highlight nil))
		  (math-comp-simplify-term (nth 2 c))))
	       (t (let ((math-comp-tag c))
		    (math-comp-simplify-term (nth 2 c))))))))


;;; Measuring a composition.

	      (make-string indent 32)
	      (math-comp-to-string-raw (car cl) indent)
	      (math-comp-to-string-raw-step (cdr cl) indent))
    ""))

(provide 'calccomp)

;;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
;;; calccomp.el ends here