view lisp/calc/calccomp.el @ 53879:e3771c262410

New file. Move original fringe related declarations and code from dispextern.h and xdisp.c here. Rework code to support user defined fringe bitmaps, redefining standard bitmaps, ability to overlay user defined bitmap with overlay arrow bitmap, and add faces to bitmaps. (Voverflow_newline_into_fringe): Declare here. (enum fringe_bitmap_align): New enum. (..._bits): All bitmaps are now defined without bitswapping; that is now done in init_fringe_once (if necessary). (standard_bitmaps): New array with specifications for the standard fringe bitmaps. (fringe_faces): New array. (valid_fringe_bitmap_id_p): New function. (draw_fringe_bitmap_1): Rename from draw_fringe_bitmap. (draw_fringe_bitmap): New function which draws fringe bitmap, possibly overlaying bitmap with cursor in right fringe or the overlay arrow in the left fringe. (update_window_fringes): Do not handle overlay arrow here. Compare and copy fringe bitmap faces. (init_fringe_bitmap): New function. (Fdefine_fringe_bitmap, Fdestroy_fringe_bitmap): New DEFUNs to define and destroy user defined fringe bitmaps. (Fset_fringe_bitmap_face): New DEFUN to set face for a fringe bitmap. (Ffringe_bitmaps_at_pos): New DEFUN to read current fringe bitmaps. (syms_of_fringe): New function. Defsubr new DEFUNs. DEFVAR_LISP Voverflow_newline_into_fringe. (init_fringe_once, init_fringe): New functions. (w32_init_fringe, w32_reset_fringes) [WINDOWS_NT]: New functions.

;;; 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
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; 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)

(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:
;;;
;;;    "string"              A literal string
;;;
;;;    (horiz C1 C2 ...)     Horizontally abutted sub-compositions
;;;
;;;    (set LEVEL OFF)       Set left margin + offset for line-break level
;;;    (break LEVEL)         A potential line-break point
;;;
;;;    (vleft N C1 C2 ...)   Vertically stacked, left-justified sub-comps
;;;    (vcent N C1 C2 ...)   Vertically stacked, centered sub-comps
;;;    (vright N C1 C2 ...)  Vertically stacked, right-justified sub-comps
;;;                          N specifies baseline of the stack, 0=top line.
;;;
;;;    (supscr C1 C2)        Composition C1 with superscript C2
;;;    (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))
					   (nth 1 aa))
					 (nth 2 aa)) prec))
	    (if (and (eq calc-language 'big)
		     (= (length (car calc-frac-format)) 1))
		(let* ((aa (math-adjust-fraction a))
		       (calc-frac-format nil)
		       (math-radix-explicit-format nil)
		       (c (list 'horiz
				(if (math-negp (nth 1 aa))
				    "- " "")
				(list 'vcent 1
				      (math-format-number
				       (math-abs (nth 1 aa)))
				      '(rule ?-)
				      (math-format-number (nth 2 aa))))))
		  (if (= calc-number-radix 10)
		      c
		    (list 'horiz "(" c
			  (list 'subscr ")"
				(int-to-string calc-number-radix)))))
	      (math-format-number a)))
	(if (not (eq calc-language 'big))
	    (math-format-number a prec)
	  (if (memq (car-safe a) '(cplx polar))
	      (if (math-zerop (nth 2 a))
		  (math-compose-expr (nth 1 a) prec)
		(list 'horiz "("
		      (math-compose-expr (nth 1 a) 0)
		      (if (eq (car a) 'cplx) ", " "; ")
		      (math-compose-expr (nth 2 a) 0) ")"))
	    (if (or (= calc-number-radix 10)
		    (not (Math-realp a))
		    (and calc-group-digits
			 (not (assoc calc-group-char '((",") (" "))))))
		(math-format-number a prec)
	      (let ((s (math-format-number a prec))
		    (c nil))
		(while (string-match (if (> calc-number-radix 14)
					 "\\([0-9]+\\)#\\([0-9a-zA-Z., ]+\\)"
				       "\\([0-9]+\\)#\\([0-9a-dA-D., ]+\\)")
				     s)
		  (setq c (nconc c (list (substring s 0 (match-beginning 0))
					 (list 'subscr
					       (math-match-substring s 2)
					       (math-match-substring s 1))))
			s (substring s (match-end 0))))
		(if (string-match
		     "\\*\\([0-9.]+\\)\\^\\(-?[0-9]+\\)\\()?\\)\\'" s)
		    (setq s (list 'horiz
				  (substring s 0 (match-beginning 0)) " "
				  (list 'supscr
					(math-match-substring s 1)
					(math-match-substring s 2))
				  (math-match-substring s 3))))
		(if c (cons 'horiz (nconc c (list s))) s)))))))
     ((and (get (car a) 'math-compose-forms)
	   (not (eq calc-language 'unform))
	   (let ((comps (get (car a) 'math-compose-forms))
		 temp temp2)
	     (or (and (setq temp (assq calc-language comps))
		      (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
			       (setq temp (apply (cdr temp2) (cdr a)))
			       (math-compose-expr temp prec))
			  (and (setq temp2 (assq nil (cdr temp)))
			       (funcall (cdr temp2) a))))
		 (and (setq temp (assq nil comps))
		      (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
			       (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)
		       " ..."))
		((eq (nth 1 a) 'cplx)
		 (list 'horiz "("
		       (math-compose-vector (cdr (cdr a)) ", " 0)
		       ", ..."))
		((eq (nth 1 a) 'polar)
		 (list 'horiz "("
		       (math-compose-vector (cdr (cdr a)) "; " 0)
		       "; ..."))
		((eq (nth 1 a) 'intv)
		 (list 'horiz
		       (if (memq (nth 2 a) '(0 1)) "(" "[")
		       (math-compose-vector (cdr (cdr (cdr a))) " .. " 0)
		       " .. ..."))
		(t (format "%s" a)))
	(cond ((eq (nth 1 a) 'vec) "[ ...")
	      ((eq (nth 1 a) 'intv)
	       (if (memq (nth 2 a) '(0 1)) "( ..." "[ ..."))
	      (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))
			       v (1+ v)))
		       p))
		(if (eq math-compose-hash-args 1)
		    "#"
		  (format "#%d" v))
	      (if (memq calc-language '(c fortran pascal maple))
		  (math-to-underscores (symbol-name (nth 1 a)))
		(if (and (eq calc-language 'eqn)
			 (string-match ".'\\'" (symbol-name (nth 2 a))))
		    (math-compose-expr
		     (list 'calcFunc-Prime
			   (list
			    '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)))))))))
     ((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)
      (if (eq (car calc-date-format) 'X)
	  (math-format-date a)
	(concat "<" (math-format-date a) ">")))
     ((and (eq (car a) 'calcFunc-subscr) (cdr (cdr a))
	   (memq calc-language '(c pascal fortran maple)))
      (let ((args (cdr (cdr a))))
	(while (and (memq calc-language '(pascal fortran))
		    (eq (car-safe (nth 1 a)) 'calcFunc-subscr))
	  (setq args (append (cdr (cdr (nth 1 a))) args)
		a (nth 1 a)))
	(list 'horiz
	      (math-compose-expr (nth 1 a) 1000)
	      (if (eq calc-language 'fortran) "(" "[")
	      (math-compose-vector args ", " 0)
	      (if (eq calc-language 'fortran) ")" "]"))))
     ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3)
	   (eq calc-language 'big))
      (let* ((a1 (math-compose-expr (nth 1 a) 1000))
	     (calc-language 'flat)
	     (a2 (math-compose-expr (nth 2 a) 0)))
	(if (or (eq (car-safe a1) 'subscr)
		(and (eq (car-safe a1) 'tag)
		     (eq (car-safe (nth 2 a1)) 'subscr)
		     (setq a1 (nth 2 a1))))
	    (list 'subscr
		  (nth 1 a1)
		  (list 'horiz
			(nth 2 a1)
			", "
			a2))
	  (list 'subscr a1 a2))))
     ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3)
	   (eq calc-language 'math))
      (list 'horiz
	    (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)
	   (eq calc-language 'eqn))
      (list 'horiz
	    "sqrt {"
	    (math-compose-expr (nth 1 a) -1)
	    "}"))
     ((and (eq (car a) '^)
	   (eq calc-language 'big))
      (list 'supscr
	    (if (or (math-looks-negp (nth 1 a))
		    (memq (car-safe (nth 1 a)) '(^ / frac calcFunc-sqrt))
		    (and (eq (car-safe (nth 1 a)) 'cplx)
			 (math-negp (nth 1 (nth 1 a)))
			 (eq (nth 2 (nth 1 a)) 0)))
		(list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
	      (math-compose-expr (nth 1 a) 201))
	    (let ((calc-language 'flat)
		  (calc-number-radix 10))
	      (math-compose-expr (nth 2 a) 0))))
     ((and (eq (car a) '/)
	   (eq calc-language 'big))
      (let ((a1 (let ((calc-language (if (memq (car-safe (nth 1 a)) '(/ frac))
					 'flat 'big)))
		  (math-compose-expr (nth 1 a) 0)))
	    (a2 (let ((calc-language (if (memq (car-safe (nth 2 a)) '(/ frac))
					 'flat 'big)))
		  (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)
	    "}{" (math-compose-expr (nth 1 a) 0) "}"))
     ((and (eq (car a) 'calcFunc-lambda)
	   (> (length a) 2)
	   (memq calc-language '(nil flat big)))
      (let ((p (cdr a))
	    (ap calc-arg-values)
	    (math-compose-hash-args (if (= (length a) 3) 1 t)))
	(while (and (cdr p) (equal (car p) (car ap)))
	  (setq p (cdr p) ap (cdr ap)))
	(append '(horiz "<")
		(if (cdr p)
		    (list (math-compose-vector
			   (nreverse (cdr (reverse (cdr a)))) ", " 0)
			  " : ")
		  nil)
		(list (math-compose-expr (nth (1- (length a)) a) 0)
		      ">"))))
     ((and (eq (car a) 'calcFunc-string)
	   (= (length a) 2)
	   (math-vectorp (nth 1 a))
	   (math-vector-is-string (nth 1 a)))
      (if (eq calc-language 'unform)
	  (concat "string(" (math-vector-to-string (nth 1 a) t) ")")
	(math-vector-to-string (nth 1 a) nil)))
     ((and (eq (car a) 'calcFunc-bstring)
	   (= (length a) 2)
	   (math-vectorp (nth 1 a))
	   (math-vector-is-string (nth 1 a)))
      (if (eq calc-language 'unform)
	  (concat "bstring(" (math-vector-to-string (nth 1 a) t) ")")
	(let ((c nil)
	      (s (math-vector-to-string (nth 1 a) nil))
	      p)
	  (while (string-match "[^ ] +[^ ]" s)
	    (setq p (1- (match-end 0))
		  c (cons (list 'break math-compose-level)
			  (cons (substring s 0 p)
				c))
		  s (substring s p)))
	  (setq c (nreverse (cons s c)))
	  (or (= prec -123)
	      (setq c (cons (list 'set math-compose-level 2) c)))
	  (cons 'horiz c))))
     ((and (eq (car a) 'calcFunc-cprec)
	   (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)))
     ((and (eq (car a) 'calcFunc-choriz)
	   (not (eq calc-language 'unform))
	   (memq (length a) '(2 3 4))
	   (math-vectorp (nth 1 a))
	   (if (integerp (nth 2 a))
	       (or (null (nth 3 a))
		   (and (math-vectorp (nth 3 a))
			(math-vector-is-string (nth 3 a))))
	     (or (null (nth 2 a))
		 (and (math-vectorp (nth 2 a))
		      (math-vector-is-string (nth 2 a))))))
      (let* ((cprec (and (integerp (nth 2 a)) (nth 2 a)))
	     (sep (nth (if cprec 3 2) a))
	     (bprec nil))
	(if sep
	    (math-compose-vector (cdr (nth 1 a))
				 (math-vector-to-string sep nil)
				 (or cprec prec))
	  (cons 'horiz (mapcar (function
				(lambda (x)
				  (if (eq (car-safe x) 'calcFunc-bstring)
				      (prog1
					  (math-compose-expr
					   x (or bprec cprec prec))
					(setq bprec -123))
				    (math-compose-expr x (or cprec prec)))))
			       (cdr (nth 1 a)))))))
     ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
	   (not (eq calc-language 'unform))
	   (memq (length a) '(2 3))
	   (math-vectorp (nth 1 a))
	   (or (null (nth 2 a))
	       (integerp (nth 2 a))))
      (let* ((base 0)
	     (v 0)
	     (prec (or (nth 2 a) prec))
	     (c (mapcar (function
			 (lambda (x)
			   (let ((b nil) (cc nil) a d)
			     (if (and (memq (car-safe x) '(calcFunc-cbase
							   calcFunc-ctbase
							   calcFunc-cbbase))
				      (memq (length x) '(1 2)))
				 (setq b (car x)
				       x (nth 1 x)))
			     (if (and (eq (car-safe x) 'calcFunc-crule)
				      (memq (length x) '(1 2))
				      (or (null (nth 1 x))
					  (and (math-vectorp (nth 1 x))
					       (= (length (nth 1 x)) 2)
					       (math-vector-is-string
						(nth 1 x)))
					  (and (natnump (nth 1 x))
					       (<= (nth 1 x) 255))))
				 (setq cc (list
					   'rule
					   (if (math-vectorp (nth 1 x))
					       (aref (math-vector-to-string
						      (nth 1 x) nil) 0)
					     (or (nth 1 x) ?-))))
			       (or (and (memq (car-safe x) '(calcFunc-cvspace
							     calcFunc-ctspace
							     calcFunc-cbspace))
					(memq (length x) '(2 3))
					(eq (nth 1 x) 0))
				   (null x)
				   (setq cc (math-compose-expr x prec))))
			     (setq a (if cc (math-comp-ascent cc) 0)
				   d (if cc (math-comp-descent cc) 0))
			     (if (eq b 'calcFunc-cbase)
				 (setq base (+ v a -1))
			       (if (eq b 'calcFunc-ctbase)
				   (setq base v)
				 (if (eq b 'calcFunc-cbbase)
				     (setq base (+ v a d -1)))))
			     (setq v (+ v a d))
			     cc)))
			(cdr (nth 1 a)))))
	(setq c (delq nil c))
	(if c
	    (cons (if (eq (car a) 'calcFunc-cvert) 'vcent
		    (if (eq (car a) 'calcFunc-clvert) 'vleft 'vright))
		  (cons base c))
	  " ")))
     ((and (memq (car a) '(calcFunc-csup calcFunc-csub))
	   (not (eq calc-language 'unform))
	   (memq (length a) '(3 4))
	   (or (null (nth 3 a))
	       (integerp (nth 3 a))))
      (list (if (eq (car a) 'calcFunc-csup) 'supscr 'subscr)
	    (math-compose-expr (nth 1 a) (or (nth 3 a) 0))
	    (math-compose-expr (nth 2 a) 0)))
     ((and (eq (car a) 'calcFunc-cflat)
	   (not (eq calc-language 'unform))
	   (memq (length a) '(2 3))
	   (or (null (nth 2 a))
	       (integerp (nth 2 a))))
      (let ((calc-language (if (memq calc-language '(nil big))
			       'flat calc-language)))
	(math-compose-expr (nth 1 a) (or (nth 2 a) 0))))
     ((and (eq (car a) 'calcFunc-cspace)
	   (memq (length a) '(2 3))
	   (natnump (nth 1 a)))
      (if (nth 2 a)
	  (cons 'horiz (make-list (nth 1 a)
				  (if (and (math-vectorp (nth 2 a))
					   (math-vector-is-string (nth 2 a)))
				      (math-vector-to-string (nth 2 a) nil)
				    (math-compose-expr (nth 2 a) 0))))
	(make-string (nth 1 a) ?\ )))
     ((and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
	   (memq (length a) '(2 3))
	   (natnump (nth 1 a)))
      (if (= (nth 1 a) 0)
	  ""
	(let* ((c (if (nth 2 a)
		      (if (and (math-vectorp (nth 2 a))
			       (math-vector-is-string (nth 2 a)))
			  (math-vector-to-string (nth 2 a) nil)
			(math-compose-expr (nth 2 a) 0))
		    " "))
	       (ca (math-comp-ascent c))
	       (cd (math-comp-descent c)))
	  (cons 'vleft
		(cons (if (eq (car a) 'calcFunc-ctspace)
			  (1- ca)
			(if (eq (car a) 'calcFunc-cbspace)
			    (+ (* (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)
		       (math-assq2 (car a) 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)
			     " \\right)"))
		   (if (eq calc-language 'eqn)
		       (if (or (eq (car-safe a) '/)
			       (= (/ prec 100) 9))
			   (list 'horiz "{" (math-compose-expr a -1) "}")
			 (if (math-tex-expr-is-flat a)
			     (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
		       (math-compose-expr (nth 1 a) (nth 2 op))
		       " ? "
		       (math-compose-expr (nth 2 a) 0)
		       " : "
		       (math-compose-expr (nth 3 a) (nth 3 op))))
		(t
		 (let* ((math-comp-tagged (and math-comp-tagged
					       (not (math-primp a))
					       math-comp-tagged))
			(setlev (if (= prec (min (nth 2 op) (nth 3 op)))
				    (progn
				      (setq math-compose-level
					    (1- math-compose-level))
				      nil)
				  math-compose-level))
			(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)
				(assoc "2x" math-expr-opers))
			    (let* ((prevt (math-prod-last-term (nth 1 a)))
				   (nextt (math-prod-first-term (nth 2 a)))
				   (prevc (or (math-comp-last-char lhs)
					      (and (memq (car-safe prevt)
							 '(^ calcFunc-subscr
							     calcFunc-sqrt
							     frac))
						   (eq calc-language 'big)
						   ?0)))
				   (nextc (or (math-comp-first-char rhs)
					      (and (memq (car-safe nextt)
							 '(calcFunc-sqrt
							   calcFunc-sum
							   calcFunc-prod
							   calcFunc-integ))
						   (eq calc-language 'big)
						   ?0))))
			      (and prevc nextc
				   (or (and (>= nextc ?a) (<= nextc ?z))
				       (and (>= nextc ?A) (<= nextc ?Z))
				       (and (>= nextc ?0) (<= nextc ?9))
				       (memq nextc '(?. ?_ ?#
							?\( ?\[ ?\{))
				       (and (eq nextc ?\\)
					    (not (string-match
						  "\\`\\\\left("
						  (math-comp-first-string
						   rhs)))))
				   (not (and (eq (car-safe prevt) 'var)
					     (eq nextc ?\()))
				   (list 'horiz
					 (list 'set setlev 1)
					 lhs
					 (list 'break math-compose-level)
					 " "
					 rhs))))
		       (list 'horiz
			     (list 'set setlev 1)
			     lhs
			     (list 'break math-compose-level)
			     (if (or (equal (car op) "^")
				     (equal (car op) "_")
				     (equal (car op) "**")
				     (and (equal (car op) "*")
					  (math-comp-last-char lhs)
					  (math-comp-first-char rhs))
				     (and (equal (car op) "/")
					  (math-num-integerp (nth 1 a))
					  (math-integerp (nth 2 a))))
				 (car op)
			       (if (and (eq calc-language 'big)
					(equal (car op) "=>"))
				   "  =>  "
				 (concat " " (car op) " ")))
			     rhs))))))
	      ((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)
		       (if (= (/ prec 100) 9)
			   (list 'horiz "{" (math-compose-expr a -1) "}")
			 (if (math-tex-expr-is-flat a)
			     (list 'horiz "{( " (math-compose-expr a -1) " )}")
			   (list 'horiz "{left ( "
				 (math-compose-expr a -1)
				 " right )}")))
		     (list 'horiz "(" (math-compose-expr a 0) ")"))))
		(t
		 (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
		 (list 'horiz
		       lhs
		       (if (or (> (length (car op)) 1)
			       (not (math-comp-is-flat lhs)))
			   (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)
			   (car op))
			 (if (or lr (> (length (car op)) 2)) " " "")
			 (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)
		       (if (= (/ prec 100) 9)
			   (list 'horiz "{" (math-compose-expr a -1) "}")
			 (if (math-tex-expr-is-flat a)
			     (list 'horiz "{( " (math-compose-expr a -1) " )}")
			   (list 'horiz "{left ( "
				 (math-compose-expr a -1)
				 " right )}")))
		     (list 'horiz "(" (math-compose-expr a 0) ")"))))
		(t
		 (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
		   (list 'horiz
			 (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
						      (car op))
					(substring (car op) 1)
				      (car op))))
			   (if (or (> (length ops) 1)
				   (not (math-comp-is-flat rhs)))
			       (concat ops " ")
			     ops))
			 rhs)))))
	      ((and (eq calc-language 'big)
		    (setq op (get (car a) 'math-compose-big))
		    (funcall op a prec)))
	      ((and (setq op (assq calc-language
				   '( ( nil . math-compose-normal )
				      ( flat . math-compose-normal )
				      ( 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)))
	      (t
	       (let* ((func (car a))
		      (func2 (assq func '(( mod . calcFunc-makemod )
					  ( sdev . calcFunc-sdev )
					  ( + . calcFunc-add )
					  ( - . calcFunc-sub )
					  ( * . calcFunc-mul )
					  ( / . calcFunc-div )
					  ( % . calcFunc-mod )
					  ( ^ . calcFunc-pow )
					  ( neg . calcFunc-neg )
					  ( | . calcFunc-vconcat ))))
		      left right args)
		 (if func2
		     (setq func (cdr func2)))
		 (if (setq func2 (rassq func math-expr-function-mapping))
		     (setq func (car func2)))
		 (setq func (math-remove-dashes
			     (if (string-match
				  "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
				  (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 "}"))
		       ((eq calc-language 'eqn)
			(setq left " ( "
			      right " )"))
		       (t (setq left calc-function-open
				right calc-function-close)))
		 (list 'horiz func left
		       (math-compose-vector (cdr a)
					    (if (eq calc-language 'eqn)
						" , " ", ")
					    0)
		       right)))))))))


(defun math-prod-first-term (x)
  (while (eq (car-safe x) '*)
    (setq x (nth 1 x)))
  x)

(defun math-prod-last-term (x)
  (while (eq (car-safe x) '*)
    (setq x (nth 2 x)))
  x)

(defun math-compose-vector (a sep prec)
  (if a
      (cons 'horiz
	    (cons (list 'set math-compose-level)
		  (let ((c (list (math-compose-expr (car a) prec))))
		    (while (setq a (cdr a))
		      (setq c (cons (if (eq (car-safe (car a))
					    'calcFunc-bstring)
					(let ((math-compose-level
					       (1- math-compose-level)))
					  (math-compose-expr (car a) -123))
				      (math-compose-expr (car a) prec))
				    (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)) '*))))

(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
       (cond ((eq calc-matrix-just 'right) "rcol ")
	     ((eq calc-matrix-just 'center) "ccol ")
	     (t "lcol "))
       (cons
	(list 'break math-compose-level)
	(cons
	 "{ "
	 (cons
	  (let ((math-compose-level (1+ math-compose-level)))
	    (math-compose-vector (cdr (car a)) " above " 1000))
	  (cons
	   " } "
	   (math-compose-eqn-matrix (cdr a)))))))
    nil))

(defun math-vector-is-string (a)
  (while (and (setq a (cdr a))
	      (or (and (natnump (car a))
		       (<= (car a) 255))
		  (and (eq (car-safe (car a)) 'cplx)
		       (natnump (nth 1 (car a)))
		       (eq (nth 2 (car a)) 0)
		       (<= (nth 1 (car a)) 255)))))
  (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)))
			  (cdr a))))
  (if (string-match "[\000-\037\177\\\"]" a)
      (let ((p 0)
	    (pat (if quoted "[\000-\037\177\\\"]" "[\000-\037\177]"))
	    (codes (if quoted math-vector-to-string-chars '((?\^? . "^?"))))
	    (fmt (if quoted "\\^%c" "^%c"))
	    new)
	(while (setq p (string-match pat a p))
	  (if (setq new (assq (aref a p) codes))
	      (setq a (concat (substring a 0 p)
			      (cdr new)
			      (substring a (1+ p)))
		    p (+ p (length (cdr new))))
	    (setq a (concat (substring a 0 p)
			    (format fmt (+ (aref a p) 64))
			    (substring a (1+ p)))
		  p (+ p 2))))))
  (if quoted
      (concat "\"" a "\"")
    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))

(defun math-tex-expr-is-flat (a)
  (or (Math-integerp a)
      (memq (car a) '(float var))
      (and (memq (car a) '(+ - * neg))
	   (progn
	     (while (and (setq a (cdr a))
			 (math-tex-expr-is-flat (car a))))
	     (null a)))
      (and (memq (car a) '(^ calcFunc-subscr))
	   (math-tex-expr-is-flat (nth 1 a)))))

(put 'calcFunc-log 'math-compose-big 'math-compose-log)
(defun math-compose-log (a prec)
  (and (= (length a) 3)
       (list 'horiz
	     (list 'subscr "log"
		   (let ((calc-language 'flat))
		     (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)
  (and (= (length a) 2)
       (list 'horiz
	     (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)
  (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)
  (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)
  (let ((a1 (math-compose-expr (nth 1 a) 0))
	(a2 (math-compose-expr (nth 2 a) 0)))
    (list 'horiz
	  "("
	  (list 'vcent
		(math-comp-height a1)
		a1 " " a2)
	  ")")))

(put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
(defun math-compose-integ (a prec)
  (and (memq (length a) '(3 5))
       (eq (car-safe (nth 2 a)) 'var)
       (let* ((parens (and (>= prec 196) (/= prec 1000)))
	      (var (math-compose-expr (nth 2 a) 0))
	      (over (and (eq (car-safe (nth 2 a)) 'var)
			 (or (and (eq (car-safe (nth 1 a)) '/)
				  (math-numberp (nth 1 (nth 1 a))))
			     (and (eq (car-safe (nth 1 a)) '^)
				  (math-looks-negp (nth 2 (nth 1 a)))))))
	      (expr (math-compose-expr (if over
					   (math-mul (nth 1 a)
						     (math-build-var-name
						      (format
						       "d%s"
						       (nth 1 (nth 2 a)))))
					 (nth 1 a)) 185))
	      (calc-language 'flat)
	      (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
	      (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
	 (list 'horiz
	       (if parens "(" "")
	       (append (list 'vcent (if high 3 2))
		       (and high (list (list 'horiz "  " high)))
		       '("  /"
			 " | "
			 " | "
			 " | "
			 "/  ")
		       (and low (list (list 'horiz low "  "))))
	       expr
	       (if over
		   ""
		 (list 'horiz " d" var))
	       (if parens ")" "")))))

(put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
(defun math-compose-sum (a prec)
  (and (memq (length a) '(3 5 6))
       (let* ((expr (math-compose-expr (nth 1 a) 185))
	      (calc-language 'flat)
	      (var (math-compose-expr (nth 2 a) 0))
	      (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
	      (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
	 (list 'horiz
	       (if (memq prec '(180 201)) "(" "")
	       (append (list 'vcent (if high 3 2))
		       (and high (list high))
		       '("---- "
			 "\\    "
			 " >   "
			 "/    "
			 "---- ")
		       (if low
			   (list (list 'horiz var " = " low))
			 (list var)))
	       (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
		   " " "")
	       expr
	       (if (memq prec '(180 201)) ")" "")))))

(put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
(defun math-compose-prod (a prec)
  (and (memq (length a) '(3 5 6))
       (let* ((expr (math-compose-expr (nth 1 a) 198))
	      (calc-language 'flat)
	      (var (math-compose-expr (nth 2 a) 0))
	      (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
	      (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
	 (list 'horiz
	       (if (memq prec '(196 201)) "(" "")
	       (append (list 'vcent (if high 3 2))
		       (and high (list high))
		       '("----- "
			 " | |  "
			 " | |  "
			 " | |  ")
		       (if low
			   (list (list 'horiz var " = " low))
			 (list var)))
	       (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))
			     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)
  (or width (setq width (calc-window-width)))
  (if calc-display-raw
      (math-comp-to-string-raw c 0)
    (if (math-comp-is-flat c)
	(math-comp-to-string-flat c width)
      (math-vert-comp-to-string
       (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)
	((eq (car c) 'horiz)
	 (while (and (setq c (cdr c))
		     (math-comp-is-flat (car c))))
	 (null c))
	((memq (car c) '(vleft vcent vright))
	 (and (= (length c) 3)
	      (= (nth 1 c) 0)
	      (math-comp-is-flat (nth 2 c))))
	((eq (car c) 'tag)
	 (math-comp-is-flat (nth 2 c)))
	(t nil)))


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

(defun math-comp-highlight-string (s)
  (setq s (copy-sequence s))
  (let ((i (length s)))
    (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.

(defun math-comp-first-char (c)
  (cond ((stringp c)
	 (and (> (length c) 0)
	      (elt c 0)))
	((memq (car c) '(horiz subscr supscr))
	 (while (and (setq c (cdr c))
		     (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)))))

(defun math-comp-first-string (c)
  (cond ((stringp c)
	 (and (> (length c) 0)
	      c))
	((eq (car c) 'horiz)
	 (while (and (setq c (cdr c))
		     (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)))))

(defun math-comp-last-char (c)
  (cond ((stringp c)
	 (and (> (length c) 0)
	      (elt c (1- (length c)))))
	((eq (car c) 'horiz)
	 (let ((c (reverse (cdr c))))
	   (while (and c (math-comp-is-null (car c)))
	     (setq c (cdr c)))
	   (and c (math-comp-last-char (car c)))))
	((eq (car c) 'tag)
	 (math-comp-last-char (nth 2 c)))))

(defun math-comp-is-null (c)
  (cond ((stringp c) (= (length c) 0))
	((memq (car c) '(horiz subscr supscr))
	 (while (and (setq c (cdr c))
		     (math-comp-is-null (car c))))
	 (null c))
	((eq (car c) 'tag)
	 (math-comp-is-null (nth 2 c)))
	((memq (car c) '(set break)) t)))

(defun math-comp-width (c)
  (cond ((not (consp c)) (length c))
	((memq (car c) '(horiz subscr supscr))
	 (let ((accum 0))
	   (while (setq c (cdr c))
	     (setq accum (+ accum (math-comp-width (car c)))))
	   accum))
	((memq (car c) '(vcent vleft vright))
	 (setq c (cdr c))
	 (let ((accum 0))
	   (while (setq c (cdr c))
	     (setq accum (max accum (math-comp-width (car c)))))
	   accum))
	((eq (car c) 'tag)
	 (math-comp-width (nth 2 c)))
	(t 0)))

(defun math-comp-height (c)
  (if (stringp c)
      1
    (+ (math-comp-ascent c) (math-comp-descent c))))

(defun math-comp-ascent (c)
  (cond ((not (consp c)) 1)
	((eq (car c) 'horiz)
	 (let ((accum 0))
	   (while (setq c (cdr c))
	     (setq accum (max accum (math-comp-ascent (car c)))))
	   accum))
	((memq (car c) '(vcent vleft vright))
	 (if (> (nth 1 c) 0) (1+ (nth 1 c)) 1))
	((eq (car c) 'supscr)
	 (max (math-comp-ascent (nth 1 c)) (1+ (math-comp-height (nth 2 c)))))
	((eq (car c) 'subscr)
	 (math-comp-ascent (nth 1 c)))
	((eq (car c) 'tag)
	 (math-comp-ascent (nth 2 c)))
	(t 1)))

(defun math-comp-descent (c)
  (cond ((not (consp c)) 0)
	((eq (car c) 'horiz)
	 (let ((accum 0))
	   (while (setq c (cdr c))
	     (setq accum (max accum (math-comp-descent (car c)))))
	   accum))
	((memq (car c) '(vcent vleft vright))
	 (let ((accum (- (nth 1 c))))
	   (setq c (cdr c))
	   (while (setq c (cdr c))
	     (setq accum (+ accum (math-comp-height (car c)))))
	   (max (1- accum) 0)))
	((eq (car c) 'supscr)
	 (math-comp-descent (nth 1 c)))
	((eq (car c) 'subscr)
	 (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
	((eq (car c) 'tag)
	 (math-comp-descent (nth 2 c)))
	(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))))

(defun calcFunc-cheight (a &optional prec)
  (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
  (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
	   (memq (length a) '(2 3))
	   (eq (nth 1 a) 0))
      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))
  (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
	   (memq (length a) '(2 3))
	   (eq (nth 1 a) 0))
      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))))


;;; Convert a simplified composition into string form.

(defun math-vert-comp-to-string (c)
  (if (stringp c)
      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)))


;;; Convert a composition to a string in "raw" form (for debugging).

(defun math-comp-to-string-raw (c indent)
  (cond ((or (not (consp c)) (eq (car c) 'set))
	 (prin1-to-string c))
	((null (cdr c))
	 (concat "(" (symbol-name (car c)) ")"))
	(t
	 (let ((next-indent (+ indent 2 (length (symbol-name (car c))))))
	   (concat "("
		   (symbol-name (car c))
		   " "
		   (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
      (concat "\n"
	      (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