-;; Calculator for GNU Emacs, part II [calc-comp.el]
+;;; calccomp.el --- composition functions for Calc
+
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-;; Written by Dave Gillespie, daveg@synaptics.com.
+
+;; Author: David Gillespie <daveg@synaptics.com>
+;; Maintainer: Jay Belanger <belanger@truman.edu>
;; This file is part of GNU Emacs.
;; 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-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-sec calcFunc-csc calcFunc-cot
+ calcFunc-sinh calcFunc-cosh calcFunc-tanh
+ calcFunc-sech calcFunc-csch calcFunc-coth
+ calcFunc-arcsin calcFunc-arccos calcFunc-arctan
+ calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
;;; A "composition" has one of the following forms:
;;;
;;;
;;; (tag X C) Composition C corresponds to sub-expression X
+;; math-comp-just and math-comp-comma-spc are local to
+;; math-compose-expr, but are used by math-compose-matrix, which is
+;; called by math-compose-expr
+(defvar math-comp-just)
+(defvar math-comp-comma-spc)
+
+;; math-comp-vector-prec is local to math-compose-expr, but is used by
+;; math-compose-matrix and math-compose-rows, which are called by
+;; math-compose-expr.
+(defvar math-comp-vector-prec)
+
+;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
+;; local to math-compose-expr, but are used by math-compose-rows, which is
+;; called by math-compose-expr.
+(defvar math-comp-left-bracket)
+(defvar math-comp-right-bracket)
+(defvar math-comp-comma)
+
+
(defun math-compose-expr (a prec)
- (let ((math-compose-level (1+ math-compose-level)))
+ (let ((math-compose-level (1+ math-compose-level))
+ spfn)
(cond
((or (and (eq a math-comp-selected) a)
(and math-comp-tagged
(list 'tag a (math-compose-expr a prec))))
((and (not (consp a)) (not (integerp a)))
(concat "'" (prin1-to-string a)))
+ ((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
+ (setq spfn (cdr spfn))
+ (funcall (car spfn) a spfn))
((math-scalarp a)
(if (or (eq (car-safe a) 'frac)
(and (nth 1 calc-frac-format) (Math-integerp a)))
- (if (memq calc-language '(tex eqn math maple c fortran pascal))
+ (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
(let ((aa (math-adjust-fraction a))
(calc-frac-format nil))
(math-compose-expr (list '/
(and (setq temp2 (assq nil (cdr temp)))
(funcall (cdr temp2) a))))))))
((eq (car a) 'vec)
- (let* ((left-bracket (if calc-vector-brackets
+ (let* ((math-comp-left-bracket (if calc-vector-brackets
(substring calc-vector-brackets 0 1) ""))
- (right-bracket (if calc-vector-brackets
+ (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))
- (comma-spc (or calc-vector-commas " "))
- (comma (or calc-vector-commas ""))
- (vector-prec (if (or (and calc-vector-commas
+ (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))
- (just (cond ((eq calc-matrix-just 'right) 'vright)
- ((eq calc-matrix-just 'center) 'vcent)
- (t 'vleft)))
+ (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)
(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))
+ (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 left-bracket left-bracket " ")
- (math-compose-vector (cdr (nth 1 a)) (concat comma " ")
- vector-prec)
- (concat " " right-bracket right-bracket))
+ (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))
(list (append '(vleft)
(list base)
(list (concat (and outer-brackets
- (concat left-bracket
+ (concat math-comp-left-bracket
" "))
(and inner-brackets
- (concat left-bracket
+ (concat math-comp-left-bracket
" "))))
(make-list (1- rows)
(concat (and outer-brackets
" ")
(and inner-brackets
(concat
- left-bracket
+ math-comp-left-bracket
" "))))))
(math-compose-matrix (cdr a) 1 cols base)
(list (append '(vleft)
(make-list (1- rows)
(if inner-brackets
(concat " "
- right-bracket
+ math-comp-right-bracket
(and row-commas
- comma))
+ math-comp-comma))
(if (and outer-brackets
row-commas)
";" "")))
(list (concat
(and inner-brackets
(concat " "
- right-bracket))
+ math-comp-right-bracket))
(and outer-brackets
(concat
" "
- right-bracket)))))))))
+ math-comp-right-bracket)))))))))
(if (and calc-display-strings
(cdr a)
(math-vector-is-string a))
(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
(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))))
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\matrix{")
+ (math-compose-tex-matrix (cdr a))
+ '("}"))
+ (append '(horiz "\\matrix{ ")
+ (math-compose-tex-matrix (cdr a))
+ '(" }")))
+ (if (and (eq calc-language 'latex)
+ (math-matrixp a))
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\begin{pmatrix}")
+ (math-compose-tex-matrix (cdr a))
+ '("\\end{pmatrix}"))
+ (append '(horiz "\\begin{pmatrix} ")
+ (math-compose-tex-matrix (cdr a))
+ '(" \\end{pmatrix}")))
+ (if (and (eq calc-language 'eqn)
+ (math-matrixp a))
+ (append '(horiz "matrix { ")
+ (math-compose-eqn-matrix
+ (cdr (math-transpose a)))
+ '("}"))
+ (if (and (eq calc-language 'maple)
+ (math-matrixp a))
+ (list 'horiz
+ "matrix("
+ math-comp-left-bracket
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ math-comp-right-bracket
+ ")")
+ (list 'horiz
+ math-comp-left-bracket
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ math-comp-right-bracket)))))
(list 'horiz
- left-bracket
+ math-comp-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 " "
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ math-comp-comma (if (memq calc-language '(tex latex))
+ " \\ldots" " ...")
+ math-comp-comma " "
(list 'break math-compose-level)
(math-compose-expr (nth (1- (length a)) a)
- (if (equal comma "") 1000 0))
- right-bracket)))))))
+ (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)
(let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
(if v
(symbol-name (car v))
- (if (and (eq calc-language 'tex)
+ (if (and (memq calc-language '(tex latex))
calc-language-option
(not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
(symbol-name (nth 1 a))))
- (format "\\hbox{%s}" (symbol-name (nth 1 a)))
+ (if (eq calc-language 'latex)
+ (format "\\text{%s}" (symbol-name (nth 1 a)))
+ (format "\\hbox{%s}" (symbol-name (nth 1 a))))
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(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 (memq calc-language '(tex latex)) " \\ldots "
(if (eq calc-language 'eqn) " ... " " .. "))
(math-compose-expr (nth 3 a) 0)
(if (eq calc-language 'maple) ""
(math-compose-expr (nth 2 a) 0)
"]]"))
((and (eq (car a) 'calcFunc-sqrt)
- (eq calc-language 'tex))
+ (memq calc-language '(tex latex)))
(list 'horiz
"\\sqrt{"
(math-compose-expr (nth 1 a) 0)
(math-comp-height a1)
a1 '(rule ?-) a2)))
((and (memq (car a) '(calcFunc-sum calcFunc-prod))
- (eq calc-language 'tex)
+ (memq calc-language '(tex latex))
(= (length a) 5))
(list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
"_{" (math-compose-expr (nth 2 a) 0)
(integerp (nth 2 a)))
(let ((c (math-compose-expr (nth 1 a) -1)))
(if (> prec (nth 2 a))
- (if (eq calc-language 'tex)
+ (if (memq calc-language '(tex latex))
(list 'horiz "\\left( " c " \\right)")
(if (eq calc-language 'eqn)
(list 'horiz "{left ( " c " right )}")
(make-list (nth 1 a) c))))))
((and (eq (car a) 'calcFunc-evalto)
(setq calc-any-evaltos t)
- (memq calc-language '(tex eqn))
+ (memq calc-language '(tex latex eqn))
(= math-compose-level (if math-comp-tagged 2 1))
(= (length a) 3))
(list 'horiz
- (if (eq calc-language 'tex) "\\evalto " "evalto ")
+ (if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
(math-compose-expr (nth 1 a) 0)
- (if (eq calc-language 'tex) " \\to " " -> ")
+ (if (memq calc-language '(tex latex)) " \\to " " -> ")
(math-compose-expr (nth 2 a) 0)))
(t
(let ((op (and (not (eq calc-language 'unform))
(/= (nth 3 op) -1))
(cond
((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
- (if (and (eq calc-language 'tex)
+ (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) "}")
(math-compose-expr a -1)
" right )}")))
(list 'horiz "(" (math-compose-expr a 0) ")"))))
- ((and (eq calc-language 'tex)
+ ((and (memq calc-language '(tex latex))
(memq (car a) '(/ calcFunc-choose calcFunc-evalto))
(>= prec 0))
(list 'horiz "{" (math-compose-expr a -1) "}"))
(and (equal (car op) "^")
(eq (math-comp-first-char lhs) ?-)
(setq lhs (list 'horiz "(" lhs ")")))
- (and (eq calc-language 'tex)
+ (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 (> 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)
+ (if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( "
(math-compose-expr a -1)
((and op (= (length a) 2) (= (nth 2 op) -1))
(cond
((eq (nth 3 op) 0)
- (let ((lr (and (eq calc-language 'tex)
+ (let ((lr (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat (nth 1 a))))))
(list 'horiz
(if lr "\\left" "")
(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)
+ (if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( "
(math-compose-expr a -1)
( pascal . math-compose-pascal )
( fortran . math-compose-fortran )
( tex . math-compose-tex )
+ ( latex . math-compose-latex )
( eqn . math-compose-eqn )
( math . math-compose-math )
( maple . math-compose-maple ))))
(symbol-name func))))
(if (memq calc-language '(c fortran pascal maple))
(setq func (math-to-underscores func)))
- (if (and (eq calc-language 'tex)
+ (if (and (memq calc-language '(tex latex))
calc-language-option
(not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
(if (< (prefix-numeric-value calc-language-option) 0)
(setq func (format "\\%s" func))
- (setq func (format "\\hbox{%s}" func))))
+ (setq func (if (eq calc-language 'latex)
+ (format "\\text{%s}" func)
+ (format "\\hbox{%s}" func)))))
(if (and (eq calc-language 'eqn)
(string-match "[^']'+\\'" func))
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
- (cond ((and (eq calc-language 'tex)
+ (cond ((and (memq calc-language '(tex latex))
(or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "\\left( "
(not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "{left ( "
right " right )}"))
- ((and (or (and (eq calc-language 'tex)
+ ((and (or (and (memq calc-language '(tex latex))
(eq (aref func 0) ?\\))
(and (eq calc-language 'eqn)
(memq (car a) math-eqn-special-funcs)))
- (not (string-match "\\hbox{" func))
+ (not (or
+ (string-match "\\hbox{" func)
+ (string-match "\\text{" func)))
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
0)
right)))))))))
-(defconst math-eqn-special-funcs
- '( calcFunc-log
- calcFunc-ln calcFunc-exp
- calcFunc-sin calcFunc-cos calcFunc-tan
- calcFunc-sinh calcFunc-cosh calcFunc-tanh
- calcFunc-arcsin calcFunc-arccos calcFunc-arctan
- calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh
-))
-
(defun math-prod-first-term (x)
(while (eq (car-safe x) '*)
(let ((col 0)
(res nil))
(while (<= (setq col (1+ col)) cols)
- (setq res (cons (cons just
+ (setq res (cons (cons math-comp-just
(cons base
(mapcar (function
(lambda (r)
(list 'horiz
(math-compose-expr
(nth col r)
- vector-prec)
+ math-comp-vector-prec)
(if (= col cols)
""
- (concat comma-spc " ")))))
+ (concat
+ math-comp-comma-spc " ")))))
a)))
res)))
(nreverse res)))
(if (<= count 0)
(if (< count 0)
(math-compose-rows (cdr a) -1 nil)
- (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")
- comma)
+ (cons (concat (if (memq calc-language '(tex latex)) " \\ldots" " ...")
+ math-comp-comma)
(math-compose-rows (cdr a) -1 nil)))
(cons (list 'horiz
- (if first (concat left-bracket " ") " ")
- (math-compose-expr (car a) vector-prec)
- comma)
+ (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 left-bracket " ") " ")
- (math-compose-expr (car a) vector-prec)
- (concat " " right-bracket)))))
+ (if first (concat math-comp-left-bracket " ") " ")
+ (math-compose-expr (car a) math-comp-vector-prec)
+ (concat " " math-comp-right-bracket)))))
(defun math-compose-tex-matrix (a)
(if (cdr a)
- (cons (math-compose-vector (cdr (car a)) " & " 0)
- (cons " \\\\ "
- (math-compose-tex-matrix (cdr a))))
+ (cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
+ (math-compose-tex-matrix (cdr a)))
(list (math-compose-vector (cdr (car a)) " & " 0))))
(defun math-compose-eqn-matrix (a)
(<= (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 quoted
(concat "\"" a "\"")
a))
-(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
- ( ?\\ . "\\\\" )
- ( ?\a . "\\a" )
- ( ?\b . "\\b" )
- ( ?\e . "\\e" )
- ( ?\f . "\\f" )
- ( ?\n . "\\n" )
- ( ?\r . "\\r" )
- ( ?\t . "\\t" )
- ( ?\^? . "\\^?" )
-))
+
(defun math-to-underscores (x)
(if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
(defun math-compose-deriv (a prec)
- (and (= (length a) 3)
- (math-compose-expr (list '/
- (list 'calcFunc-choriz
- (list 'vec
- '(calcFunc-string (vec ?d))
- (nth 1 a)))
- (list 'calcFunc-choriz
- (list 'vec
- '(calcFunc-string (vec ?d))
- (nth 2 a))))
- prec)))
+ (when (= (length a) 3)
+ (math-compose-expr (list '/
+ (list 'calcFunc-choriz
+ (list 'vec
+ '(calcFunc-string (vec ?d))
+ (nth 1 a)))
+ (list 'calcFunc-choriz
+ (list 'vec
+ '(calcFunc-string (vec ?d))
+ (nth 2 a))))
+ prec)))
(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
(defun math-compose-sqrt (a prec)
- (and (= (length a) 2)
- (let* ((c (math-compose-expr (nth 1 a) 0))
- (a (math-comp-ascent c))
- (d (math-comp-descent c))
- (h (+ a d))
- (w (math-comp-width c)))
- (list 'vleft
- a
- (concat (if (= h 1) " " " ")
- (make-string (+ w 2) ?\_))
- (list 'horiz
- (if (= h 1)
- "V"
- (append (list 'vleft (1- a))
- (make-list (1- h) " |")
- '("\\|")))
- " "
- c)))))
+ (when (= (length a) 2)
+ (let* ((c (math-compose-expr (nth 1 a) 0))
+ (a (math-comp-ascent c))
+ (d (math-comp-descent c))
+ (h (+ a d))
+ (w (math-comp-width c)))
+ (list 'vleft
+ a
+ (concat (if (= h 1) " " " ")
+ (make-string (+ w 2) ?\_))
+ (list 'horiz
+ (if (= h 1)
+ "V"
+ (append (list 'vleft (1- a))
+ (make-list (1- h) " |")
+ '("\\|")))
+ " "
+ c)))))
(put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
(defun math-compose-choose (a prec)
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 c))))
+ (let ((cwid (+ (math-comp-width math-svo-c))))
(cond ((eq calc-display-just 'right)
(if calc-display-origin
- (setq wid (max calc-display-origin 5))
+ (setq math-svo-wid (max calc-display-origin 5))
(if (integerp calc-line-breaking)
- (setq wid calc-line-breaking)))
- (setq off (- wid cwid
+ (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)
(t
(if calc-display-origin
(progn
- (setq off (- calc-display-origin (/ cwid 2)))
+ (setq math-svo-off (- calc-display-origin (/ cwid 2)))
(if (integerp calc-line-breaking)
- (setq off (min off (- calc-line-breaking cwid
+ (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid
(length calc-right-label)))))
- (if (>= off 0)
- (setq wid (max wid (+ off cwid)))))
+ (if (>= math-svo-off 0)
+ (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid)))))
(if (integerp calc-line-breaking)
- (setq wid calc-line-breaking))
- (setq off (/ (- wid cwid) 2)))))
+ (setq math-svo-wid calc-line-breaking))
+ (setq math-svo-off (/ (- math-svo-wid cwid) 2)))))
(and (integerp calc-line-breaking)
- (or (< off 0)
+ (or (< math-svo-off 0)
(and calc-display-origin
(> calc-line-breaking calc-display-origin)))
- (setq wid calc-line-breaking))))
-
+ (setq math-svo-wid calc-line-breaking))))
;;; Convert a composition to string form, with embedded \n's if necessary.
(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)
;;; lines if necessary, choosing break points according to the structure
;;; of the formula.
-(defun math-comp-to-string-flat (c full-width)
+;; 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 ((comp-pos 0))
+ (let ((math-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))
+ (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 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)) ? ))
+ (> (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 comp-buf (1+ k) ?\n)
+ (aset math-comp-buf (1+ k) ?\n)
(setq prefix " "))
(setq prefix "\n"))))
- (concat comp-buf prefix str)))))
-(setq math-comp-buf-string (make-vector 10 ""))
-(setq math-comp-buf-margin (make-vector 10 0))
-(setq math-comp-buf-level (make-vector 10 0))
+ (concat math-comp-buf prefix str)))))
(defun math-comp-to-string-flat-term (c)
(cond ((not (consp c))
- (if comp-highlight
+ (if math-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))))
+ (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))
((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-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 comp-level "")
- (aset math-comp-buf-margin comp-level (+ comp-pos
+ (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 comp-level (nth 1 c)))))
+ (aset math-comp-buf-level math-comp-level (nth 1 c)))))
((eq (car c) 'break)
(if (not calc-line-breaking)
- (setq comp-buf (concat comp-buf comp-word)
- comp-word "")
+ (setq math-comp-buf (concat math-comp-buf math-comp-word)
+ math-comp-word "")
(let ((i 0) str)
- (if (and (> comp-pos full-width)
+ (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 comp-level)))
+ (and (= (length str) 0) (< i math-comp-level)))
(setq i (1+ i)))
- (or (> (length str) 0) (> (length comp-buf) 0))))
+ (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 comp-level)
+ '(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) comp-margin))
+ (setq wid (+ (length str) math-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)) ? ))
+ (> (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 comp-buf (1+ k) ?\n)
+ (aset math-comp-buf (1+ k) ?\n)
(setq prefix " "))
(setq prefix "\n"))))
- (setq comp-buf (concat comp-buf prefix str "\n"
+ (setq math-comp-buf (concat math-comp-buf prefix str "\n"
(make-string mrg ? ))
- comp-pos (+ comp-pos (- mrg wid))
- comp-margin mrg)
+ math-comp-pos (+ math-comp-pos (- mrg wid))
+ math-comp-margin mrg)
(aset math-comp-buf-string i "")
- (while (<= (setq i (1+ i)) comp-level)
+ (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 comp-level))
- (< comp-pos (+ (aref math-comp-buf-margin comp-level) 2)))
+ (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 comp-level)))
+ (let ((str (aref math-comp-buf-string math-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)
+ 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 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 ((comp-highlight (not calc-show-selections)))
+ (let ((math-comp-highlight (not calc-show-selections)))
(math-comp-to-string-flat-term (nth 2 c))))
((eq (nth 1 c) t)
- (let ((comp-highlight nil))
+ (let ((math-comp-highlight nil))
(math-comp-to-string-flat-term (nth 2 c))))
(t (math-comp-to-string-flat-term (nth 2 c)))))
(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 comp-pos (+ comp-pos (length 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 (<= comp-pos math-comp-sel-cpos)
+ (if (<= math-comp-pos math-comp-sel-cpos)
(progn
(math-comp-sel-flat-term (nth 2 c))
- (if (> comp-pos math-comp-sel-cpos)
+ (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))))
;;; (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 ((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))
+ (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 comp-base comp-buf))))
+ (cons 'vleft (cons math-comp-base math-comp-buf))))
(defun math-comp-add-string (s h v)
(and (> (length s) 0)
- (let ((vv (+ v comp-base)))
+ (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 comp-buf (nconc (make-list (- vv) "") comp-buf)
- comp-base (- v)
- comp-height (- comp-height vv)
+ (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 comp-height)
- (setq comp-buf (nconc comp-buf
- (make-list (1+ (- vv comp-height)) ""))
- comp-height (1+ vv))))
- (let ((str (nthcdr vv comp-buf)))
+ (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 comp-highlight
+ (if math-comp-highlight
(math-comp-highlight-string s)
s))))))))
(> (+ y h) math-comp-sel-vpos)
(<= x math-comp-sel-hpos)
(> (+ x w) math-comp-sel-hpos))
- (setq math-comp-sel-tag comp-tag
+ (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 comp-hpos comp-vpos)
- (setq comp-hpos (+ comp-hpos (length 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* ((comp-vpos (+ (- comp-vpos (nth 1 c))
+ (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))
(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
+ 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 comp-vpos (+ comp-vpos
+ (setq math-comp-vpos (+ math-comp-vpos
(+ (math-comp-descent (car c))
(math-comp-ascent (nth 1 c))))
widths (cdr widths))))
- (setq comp-hpos (+ comp-hpos maxwid))))
+ (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
- comp-hpos
+ math-comp-hpos
(math-comp-simplify-term (nth 1 c))))
- (comp-vpos (- comp-vpos (+ asc desc))))
+ (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
- (- comp-vpos
+ (- math-comp-vpos
-1
(math-comp-ascent (nth 2 c)))
- (- comp-hpos oldh)
+ (- 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 comp-vpos)
+ (oldv math-comp-vpos)
(oldh (prog1
- comp-hpos
+ math-comp-hpos
(math-comp-simplify-term (nth 1 c))))
- (comp-vpos (+ comp-vpos (+ asc desc))))
+ (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
- (- comp-hpos oldh)
+ (- math-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)))
+ (let ((math-comp-highlight (not calc-show-selections)))
(math-comp-simplify-term (nth 2 c))))
((eq (nth 1 c) t)
- (let ((comp-highlight nil))
+ (let ((math-comp-highlight nil))
(math-comp-simplify-term (nth 2 c))))
- (t (let ((comp-tag c))
+ (t (let ((math-comp-tag c))
(math-comp-simplify-term (nth 2 c))))))))
(math-comp-to-string-raw-step (cdr cl) indent))
""))
+(provide 'calccomp)
+
+;;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
;;; calccomp.el ends here