view lisp/calc/calccomp.el @ 110410:f2e111723c3a

Merge changes made in Gnus trunk. Reimplement nnimap, and do tweaks to the rest of the code to support that. * gnus-int.el (gnus-finish-retrieve-group-infos) (gnus-retrieve-group-data-early): New functions. * gnus-range.el (gnus-range-nconcat): New function. * gnus-start.el (gnus-get-unread-articles): Support early retrieval of data. (gnus-read-active-for-groups): Support finishing the early retrieval of data. * gnus-sum.el (gnus-summary-move-article): Pass the move-to group name if the move is internal, so that nnimap can do fast internal moves. * gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for nnimap usage. * nnimap.el: Rewritten. * nnmail.el (nnmail-inhibit-default-split-group): New internal variable to allow the mail splitting to not return a default group. This is useful for nnimap, which will leave unmatched mail in the inbox. * utf7.el (utf7-encode): Autoload. Implement shell connection. * nnimap.el (nnimap-open-shell-stream): New function. (nnimap-open-connection): Use it. Get the number of lines by using BODYSTRUCTURE. (nnimap-transform-headers): Get the number of lines in each message. (nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the number of lines. Not all servers return UIDNEXT. Work past this problem. Remove junk from end of file. Fix typo in "bogus" section. Make capabilties be case-insensitive. Require cl when compiling. Don't bug out if the LIST command doesn't have any parameters. 2010-09-17 Knut Anders Hatlen <[e-mail]> (tiny change) * nnimap.el (nnimap-get-groups): Don't bug out if the LIST command doesn't have any parameters. (mm-text-html-renderer): Document gnus-article-html. 2010-09-17 Julien Danjou <[e-mail]> (tiny fix) * mm-decode.el (mm-text-html-renderer): Document gnus-article-html. * dgnushack.el: Define netrc-credentials. If the user doesn't have a /etc/services, supply some sensible port defaults. Have `unseen-or-unread' select an unread unseen article first. (nntp-open-server): Return whether the open was successful or not. Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ). Save result so that it doesn't say "failed" all the time. Add ~/.authinfo to the default, since that's probably most useful for users. Don't use the "finish" method when we're reading from the agent. Add some more nnimap-relevant agent stuff to nnagent.el. * nnimap.el (nnimap-with-process-buffer): Removed. Revert one line that was changed by mistake in the last checkin. (nnimap-open-connection): Don't error out when we can't make a connection nnimap-related changes to avoid bugging out if we can't contact a server. * gnus-start.el (gnus-get-unread-articles): Don't try to scan groups from methods that are denied. * nnimap.el (nnimap-possibly-change-group): Return nil if we can't log in. (nnimap-finish-retrieve-group-infos): Make sure we're not waiting for nothing. * gnus-sum.el (gnus-select-newsgroup): Indent.

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

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

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

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

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

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

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

;; 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-var (a)
  (let (v sn)
    (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))
      (setq sn (symbol-name (nth 1 a)))
      (if (memq calc-language calc-lang-allow-percentsigns)
          (setq sn (math-to-percentsigns sn)))
      (if (memq calc-language calc-lang-allow-underscores)
          (setq sn (math-to-underscores sn)))
      sn)))

(defun math-compose-expr (a prec)
  (let ((math-compose-level (1+ math-compose-level))
        (math-expr-opers (math-expr-ops))
        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)
                       (get calc-language 'math-special-function-table)))
      (setq spfn (cdr spfn))
      (if (consp spfn)
          (funcall (car spfn) a spfn)
        (funcall spfn a)))
     ((math-scalarp a)
      (if (or (eq (car-safe a) 'frac)
	      (and (nth 1 calc-frac-format) (Math-integerp a)))
	  (if (and
               calc-language
               (not (memq calc-language
                          '(flat big unform))))
	      (let ((aa (math-adjust-fraction a))
		    (calc-frac-format nil))
		(math-compose-expr (list '/
					 (if (memq calc-language
                                                   calc-lang-slash-idiv)
					     (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* ((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
                       (setq spfn (get calc-language 'math-matrix-formatter))
                       (math-matrixp a))
                      (funcall spfn a)
                    (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 (setq spfn (get calc-language 'math-dots))
                          (concat " " spfn)
                        " ...")
		      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)
		       " ..."))
		((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 (setq spfn (get calc-language 'math-var-formatter))
              (funcall spfn a prec)
            (math-compose-var a)))))
     ((eq (car a) 'intv)
      (list 'horiz
            (if (memq (nth 1 a) '(0 1)) "(" "[")
	    (math-compose-expr (nth 2 a) 0)
            " .. "
	    (math-compose-expr (nth 3 a) 0)
            (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)
           (setq spfn (get calc-language 'math-compose-subscr)))
      (funcall spfn a))
     ((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) '^)
	   (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)
                  (calc-twos-complement-mode nil))
	      (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 (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 (setq spfn (get calc-language 'math-big-parens))
                (list 'horiz (car spfn) c (cdr spfn))
              (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)
	   (setq spfn (get calc-language 'math-evalto))
	   (= math-compose-level (if math-comp-tagged 2 1))
	   (= (length a) 3))
      (list 'horiz
            (car spfn)
	    (math-compose-expr (nth 1 a) 0)
	    (cdr spfn)
	    (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 (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)
			     " \\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 (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
		       (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 (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)
				(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 ?α) (<= nextc ?ω))
				       (and (>= nextc ?Α) (<= nextc ?Ω))
				       (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 (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)
		       (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 (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)
			   (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 (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)
		       (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 )
				      ( latex . math-compose-latex )
				      ( eqn . math-compose-eqn )
                                      ( yacas . math-compose-yacas )
                                      ( maxima . math-compose-maxima )
                                      ( giac . math-compose-giac )
				      ( 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-Zα-ωΑ-Ω0-9']+\\)\\'"
				  (symbol-name func))
				 (math-match-substring (symbol-name func) 1)
			       (symbol-name func))))
		 (if (memq calc-language calc-lang-allow-percentsigns)
		     (setq func (math-to-percentsigns func)))
		 (if (memq calc-language calc-lang-allow-underscores)
		     (setq func (math-to-underscores func)))
                 (if (setq spfn (get calc-language 'math-func-formatter))
                     (funcall spfn func a)

                   (list 'horiz func calc-function-open
		       (math-compose-vector (cdr a) ", " 0)
		       calc-function-close))))))))))


(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 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
                   (let ((mdots (get calc-language 'math-dots)))
                     (if mdots
                         (concat " " mdots)
                       "  ..."))
                   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-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-to-percentsigns (x)
  (if (string-match "\\`\\(.*\\)o'o\\(.*\\)\\'" 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)) ")" "")))))

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

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

(defun math-comp-highlight-string (s)
  (setq s (copy-sequence s))
  (if calc-highlight-selections-with-faces
      (if (not calc-show-selections)
          (propertize s 'face 'calc-selected-face)
        (propertize s 'face 'calc-nonselected-face))
    (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))

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

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

(provide 'calccomp)

;; Local variables:
;; coding: utf-8
;; End:

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