summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl')
-rw-r--r--Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl1346
1 files changed, 0 insertions, 1346 deletions
diff --git a/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl b/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl
deleted file mode 100644
index 595531b3057..00000000000
--- a/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl
+++ /dev/null
@@ -1,1346 +0,0 @@
-
-<!-- DSSSL Stylesheet fragment mathml.dsl
- (included as an entity into mathmlx.dsl)
- -->
-
-;;;
-;;; David Carlisle
-;;; davidc@nag.co.uk
-;;;
-;;; Copyright 1998 Nag Ltd, The OpenMath Consortium. Esprit Project 24.969.
-;;;
-
-
-
-
-;;; COLOUR
-;;;
-;;; Just RGB colour supported currentlly
-
-(define (rgb-color r g b)
- (color (color-space
- "ISO/IEC 10179:1996//Color-Space Family::Device RGB") r g b))
-
-
-
-;;; CONTENT MathML
-;;;
-;;; Content MathML is mainly implemented directly with element
-;;; declarations, and process-children. there is not too much
-;;; need for node list processing.
-;;;
-;;; Currently many attributes for font changes and spacing are silently
-;;; ignored.
-;;;
-;;; The mo element goes to some trouble to get its attributes as specified
-;;; in the MathML recomendation, but currently doesn't do much with them.
-
-
-;;; mrow
-;;; should check attributes (this comment applies to most elements
-;;; but won't be repeated
-
-(element mrow
- (process-children-trim))
-
-
-;;; mi
-;;; Math Identifier Defaults to italic.
-;;; Ought to switch between math italic and text italic
-;;; for multi letter identifiers (or just in tex backend?)
-
-(element mi
- (make math-sequence
- font-posture:
- (let ((fnt
- (if(attribute-string "fontstyle")
- (attribute-string "fontstyle")
- "italic")))
- (if (equal? "normal" fnt)
- 'upright
- (if (equal? "italic" fnt)
- 'italic
- #f)))
- (process-children-trim)))
-
-
-
-;;; mn
-;;; Same for numbers.
-
-(element mn
- (make math-sequence
- font-posture:
- (let ((fnt
- (if(attribute-string "fontstyle")
- (attribute-string "fontstyle")
- "normal")))
- (if (equal? "normal" fnt)
- 'upright
- (if (equal? "italic" fnt)
- 'italic
- #f)))
- (process-children-trim)))
-
-;;; mtext
-;;; Bits of non-math
-
-(element mtext
- (make unmath
- (process-children-trim)))
-
-;;; mspace
-;;; Grumble grumble it seems extraordinarily complicated to copy
-;;; a length from an attribute on the element to a keyword to a make
-;;; function. Also the rtf backend doesn't really support line-field
-;;; I couldn't get inline-space characters to work either.
-
-(element mspace
- (make line-field field-width:
- (let ((x (attribute-value "width" (current-node))))
- (measurement-to-length (if (attribute-string "width")
- (attribute-string "width")
- "0pt")))))
-
-;;; ms
-;;; Doesn't work right in tex backend: How do you specify mono space font
-;;; without specifying what font to use.
-
-(element ms
- (make unmath
- font-posture: 'upright
- font-family-name: "iso-monospace"
- (literal "\"")
- (process-children-trim)
- (literal "\"")))
-
-
-;;; mfrac
-;;; fractions.
-
-(element mfrac
- (make fraction
- (let ((nl (children(current-node))))
- (sosofo-append
- (make math-sequence
- label: 'numerator
- (process-node-list (node-list-first nl)))
- (make math-sequence
- label: 'denominator
- (process-node-list (node-list-rest nl)))))))
-
-;;; msqrt mroot
-;;; Radicals
-
-(element msqrt
- (make radical
- (process-children-trim)))
-
-
-(element mroot
- (make radical
- (let ((nl (children(current-node))))
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-first nl)))
- (make math-sequence
- label: 'degree
- (process-node-list (node-list-rest nl)))))))
-
-
-;;; mstyle
-;;; Style, what style?
-
-(element mstyle
- (make math-sequence
- (process-children-trim)))
-
-;;; merror
-;;; Ignore this, for now
-
-(element merror
- (make math-sequence
- (process-children-trim)))
-
-;;; mpadded
-;;; Hmmm
-(element mpadded
- (make math-sequence
- (process-children-trim)))
-
-
-;;; mphantom
-;; do it in white: not really the same as invisible
-;; but not sure if there is an easy general way to access
-;; background colour.
-
-(element mphantom
- (make math-sequence
- color: (rgb-color 1 1 1)
- (process-children-trim)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; mfenced
-;;; Doesn't do separators for now.
-
-(element mfenced
- (make fence
- (if (attribute-string "open")
- (make math-sequence
- label: 'open
- (literal (attribute-string "open")))
- (empty-sosofo))
- (if (attribute-string "close")
- (make math-sequence
- label: 'close
- (literal (attribute-string "close")))
- (empty-sosofo))
- (make math-sequence
- (process-children-trim))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Superscripts and subscripts
-
-;;; msup
-
-(element msup
- (make script
- (let ((nl (children(current-node))))
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-first nl)))
- (make math-sequence
- label: 'post-sup
- (process-node-list (node-list-rest nl)))))))
-
-;;; msub
-
-(element msub
- (make script
- (let ((nl (children(current-node))))
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-first nl)))
- (make math-sequence
- label: 'post-sub
- (process-node-list (node-list-rest nl)))))))
-
-;;; msubsup
-
-(element msubsup
- (make script
- (let* ((nl (children(current-node)))
- (nlr (node-list-rest nl)))
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-first nl)))
- (make math-sequence
- label: 'post-sub
- (process-node-list (node-list-first nlr)))
- (make math-sequence
- label: 'post-sup
- (process-node-list (node-list-rest nlr)))))))
-
-;;; mmultiscripts
-;;; In order to get the scripts aligning with each other
-;;; they all script an empty element (so ignore th esize of the base
-;;; I wish I could measure things in DSSSL....
-
-(element mmultiscripts
- (let* ((nl (children(current-node)))
- (base (node-list-first nl))
- (nlr (node-list-rest nl)))
- (process-multi-scripts base nlr #t (empty-sosofo) (empty-sosofo))))
-
-
-;;; while flag is true scoop up the scripts into the fourth argument
-;;; then when you see multiscripts switch the flag so then start collecting
-;;; in the third argument. Finally when rest is empty, stuff the scripts
-;;; around the base.
-
-(define (process-multi-scripts base rest flag left right )
- (if (node-list-empty? rest)
- (sosofo-append
- left
- (make math-sequence
- (process-node-list base))
- right)
-; else
- (if (equal? "mprescripts" (gi (node-list-first rest)))
- (process-multi-scripts base (node-list-rest rest) #f left right)
- (if flag
- (process-multi-scripts
- base
- (node-list-rest (node-list-rest rest))
- flag
- left
- (sosofo-append
- right
- (make script
- (make math-sequence
- label: 'post-sub
- (process-node-list (node-list-first rest)))
- (make math-sequence
- label: 'post-sup
- (process-node-list (node-list-first (node-list-rest rest)))))))
- ; else
- (process-multi-scripts
- base
- (node-list-rest (node-list-rest rest))
- flag
- (sosofo-append
- left
- (make script
- (make math-sequence
- label: 'post-sub
- (process-node-list (node-list-first rest)))
- (make math-sequence
- label: 'post-sup
- (process-node-list (node-list-first (node-list-rest rest))))))
- right)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; none/
-;;; Not the hardest thing to implement
-
-(element none
- (empty-sosofo))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Under and over bars.
-;;; These don't work yet.
-
-(element munder
- (make math-sequence
- (process-children-trim)))
-
-(element mover
- (make math-sequence
- (process-children-trim)))
-
-(element munderover
- (make math-sequence
- (process-children-trim)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Operator dictionary
-
-;;; This is just a small version, while I test various implementations.
-
-
-;;; First put back the indirection that TeX as but that MathML omitted.
-;;; Need the default lengths to refer to variables rather than explicit
-;;; lengths, so that you can change them all together.
-;;; Apart from the fact that it isn't implemented, there arelots of other
-;;; problems with this operator dictionay concept.
-
-;;; (mathml problem) As noted above the recommendation gives explicit lengths.
-;;; (mathml problem) As the recommendation gives fixed (as opposed to
-;;; variable/stretchy) lengths.
-;;; (dsssl problem) Full support of stretch operators would require an
-;;; extended dsssl flow object (or extended semantics
-;;; for the stretchy character characteristic) to support
-;;; `mid' fences.
-;;;
-(define %zskip 0em)
-(define %smallskip .05555em)
-(define %medskip .16666em)
-(define %bigskip .16666em)
-
-(define mathml-op-dict
-'(
- ("+"
- ("prefix". ((lspace . %zskip) (rspace . %bigskip)))
- ("infix" . ((lspace . %medskip) (rspace . %medskip))))
- ("*="
- ("infix" . ((lspace . %bigskip)(rspace . %bigskip))))
- ("("
- ("prefix" . ((fence . #t )(stretchy . #t)(lspace . %zskip)(rspace . %zskip))))
- (")"
- ("postfix" .((fence . #t )(stretchy . #t)(lspace . %zskip)(rspace . %zskip))))
-
-))
-
-
-;;; Helper function, just trims spaces from strings, actually
-;;; zaps all space. needed as mo doesn't use process-children-trim.
-
-(define (string-nospace s)
- (let ((l (string-length s)))
- (let loop ((i 0))
- (if (= i l)
- ""
- (let (( x (string-ref s i)))
- (if (equal? #\space x)
- (loop (+ i 1))
- (string-append (string x)
- (loop (+ i 1)))))))))
-
-;;; mo
-;;; This current version tries to implement the defaulting
-;;; of the various attributes. Although currently
-;;; It doesn't actually use th eattributes once it has got the
-;;; values.
-
-(element mo
- (let*
-;; First get the name of the operator
-;; and the surrounding node list which will be dealt with specially
-;; if it is mrow (or more correctly should be mrow-like)
- ((nm (string-append(string-nospace (data (current-node)))))
- (pnt (parent))
-;; An explicit form attribute (or #f)
- (form1 (attribute-string "form"))
-;; Look up the name in the operator dictionary, which will return
-;; another association list, for looking up the form [if the operator
-;; is in the dictionary].
- (p (assoc nm mathml-op-dict))
- (form
- (if form1
- (if p
-;; If a form was specified, and the operator is in the dictionary
-;; look up the list of defaults. If it isn't in the dictionary
-;; with this form just make up a list just consisting of the form.
- (or (assoc form1 (cdr p))
- (list form1))
- (list form1 ))
-;; Otherwise if a form was not specified, look up how many entries
-;; in the operator dictionary for this operator.
- (let* ((dict-entries (if p
- (length (cdr p))
- 0)))
- (if (= 0 dict-entries)
-;; If there are none, the operator is infix.
- (list "infix" )
- (if (= 1 dict-entries)
-;; If there is one, return that.
- (car (cdr p))
-;; If there is more than one, look where we are in the parent list
-;; to decide which one to use.
- (let ((d (assoc (if (string=? "mrow" (gi pnt))
- (let ((l (node-list-length (children pnt)))
- (n (absolute-child-number (current-node))))
- (if (> l 1)
- (if (= n 1)
- "prefix"
- (if (= n l)
- "postfix"
- "infix"))
- "infix"))
- "infix")
- (cdr p))))
- (if d
- d
- (car (cdr p))))
- ))) ; let*
- )) ; form
-;; Fence, from an attribute or out of the dictionary
- (fence1 (attribute-string "fence"))
- (fence (&my-debug(if fence1
- (string=? fence1 "true")
- (cdr (or (assoc 'fence (cdr form))
- '( #t . #f))))))
- ) ; end of let* settings
-;; Having done all that work, ignore all the attributes and just process
-;; the children.
- (make math-sequence
- (process-children-trim))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Helper function that just sticks a number of copies of a sosofo
-;;; on to the current sosofo. Used to pad out grids.
-
-(define (repeat-sosofo n sos)
- (if (equal? n 0)
- (empty-sosofo)
- (sosofo-append sos (repeat-sosofo (- n 1) sos))))
-
-;;; mtable
-;;; Spanning cells not supported as I need to use dsssl grid flow objects
-;;; which don't span. Dsssl table flow objects do support spanning but they
-;;; are display objects and can't be inlined so are no good for this.
-
-(element mtable
-;; Preliminary pass through the table to count the number of columns
- (let ((cols (&my-debug(node-list-reduce
- (children(current-node))
- (lambda (a b)
- (if (string=? "mtr" (gi b))
- (max a (node-list-length (children b)))
- a))
- 0))))
- (make grid
- grid-n-columns: cols
-;; Now main pass, making grid-cell flow object specifications.
- (node-list-reduce
- (children(current-node))
- (lambda (a b)
- (if (string=? "mtr" (gi b))
- (sosofo-append
- a
- (node-list-reduce
- (children b)
- (lambda (x y)
- (sosofo-append
- x
- (make grid-cell (process-node-list y))))
- (empty-sosofo))
- (repeat-sosofo
- (- cols (node-list-length (children b)))
- (make grid-cell (empty-sosofo))))
- (sosofo-append
- a
- (make grid-cell (process-node-list b))
- (repeat-sosofo (- cols 1) (make grid-cell (empty-sosofo))))))
- (empty-sosofo)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; semantics
-
-;;; Helper function to dig out a MathML-Presentation child
-;;; if it exists.
-
-(define (get-presentation nl)
- (if (node-list-empty? nl)
- #f
- (if (and
- (string=? "annotation-xml" (gi (node-list-first nl)))
- (string=? "MathML-Presentation"
- (or (attribute-string "encoding" (node-list-first nl)) "")))
- (children (node-list-first nl))
- (get-presentation (node-list-rest nl)))))
-
-;;; Typeset the body and ignore all annotations, unless there
-;;; is an annotation-xml giving MathML-Presentation
-;;; in which case use that and ignore everything else.
-
-(element semantics
- (let* ((nl (children (current-node))))
- (process-node-list (or
- (get-presentation (node-list-rest nl))
- (node-list-first nl)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;; Content MathML
-
-;;; In contrast to Presentation forms, Content MathML has vary few
-;;; elements defined in the dsssl, instead the apply element explitly
-;;; processes its children and calls [allegedly] suitable functions.
-
-;;; It would be nice to use the dsssl transformation language to explicitly
-;;; map content forms to presentation,
-;;; but the style language isn't available, so...
-
-
-;;; Helper function dealing with bound variables on sums and products
-;;; Checks for lowlimit child.
-
-(define (dobvar product-char-sosofo equal-char-sosofo b r)
- (let ((first (gi (node-list-first r))))
- (cond ((string=? "lowlimit" first)
- (bvarl product-char-sosofo
- (sosofo-append
- b
- equal-char-sosofo
- (process-node-list (node-list-first r)))
- (node-list-rest r)))
- ((string=? "condition" first)
- (bvarl
- product-char-sosofo
- (process-node-list (node-list-first r))
- (node-list-rest r)))
- (else (bvarl product-char-sosofo (empty-sosofo) r)))))
-
-
-;; Second function, checks for uplimit
-
-(define (bvarl product-char-sosofo low r)
- (if (string=? "uplimit" (gi (node-list-first r)))
- (bvaru
- product-char-sosofo
- low
- (process-node-list (node-list-first r))
- (node-list-rest r))
- (bvaru
- product-char-sosofo
- low
- (empty-sosofo)
- r)))
-
-;; third function, add the found limits to the sum or product character
-
-(define (bvaru product-char-sosofo low high r)
- (sosofo-append
- (make script
- (make math-sequence label: 'post-sub low)
- (make math-sequence label: 'post-sup high)
- product-char-sosofo)
- (process-node-list r)))
-
-;;; General function to typeset a function with braced arguments.
-
-(define (apply-braced-fn fn args)
- (make math-sequence
- (sosofo-append
- (literal fn)
- (make fence
- (make math-sequence label: 'open
- (literal "("))
- (make math-sequence label: 'close
- (literal ")"))
- (make math-sequence
- (process-node-list args))))))
-
-
-;;; product/ sum/
-;;; Look for bound vars, then call above helper function.
-
-(define (apply-product product-char-sosofo equal-char-sosofo args)
- (make math-sequence
- (let ((b (node-list-first args)))
- (if (string=? (gi b) "bvar")
- (dobvar
- product-char-sosofo
- equal-char-sosofo
- (process-node-list b)
- (node-list-rest args))
- (sosofo-append
- product-char-sosofo
- (process-node-list b))))))
-
-;;; log/
-;;; Just needs to check for logbase/
-
-(define (apply-log args)
- (make math-sequence
- (if (equal? "logbase" (gi (node-list-first args)))
- (sosofo-append
- (make script
- (sosofo-append
- (literal "log")
- (make math-sequence
- label: 'post-sub
- (process-node-list (node-list-first args)))))
- (apply-braced-fn "" (node-list-rest args)))
- (apply-braced-fn "log" args))))
-
-;;; root/ sqrt/
-;;; Checks for degree/
-
-(define (apply-root args)
- (make radical
- (if (equal? "degree" (gi (node-list-first args)))
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-rest args)))
- (make math-sequence
- label: 'degree
- (process-node-list (node-list-first args))))
- (make math-sequence
- (process-node-list args)))))
-
-
-;;; forall/ exists/
-;;; Typeset any bound variables and conditions,
-;;; separated by commas, then do a full stop and finally
-;;; the body.
-
-(define (apply-forall op c)
-(make math-sequence
- (sosofo-append
- op
- (process-node-list (node-list-first c))
- (node-list-reduce
- (node-list-rest c)
- (lambda (result n)
- (sosofo-append
- result
- (literal
- (if (or (equal? "bvar" (gi n)) (equal? "condition" (gi n)))
- ","
- "."))
- (process-node-list n)))
- (empty-sosofo)))))
-
-
-;;; int/
-
-(define (apply-int args)
- (make math-sequence
- (let ((b (node-list-first args)))
- (if (string=? (gi b) "bvar")
- (dobvar
- (literal "\integral")
- (empty-sosofo)
- (empty-sosofo)
- (node-list-rest args))
- (sosofo-append
- (literal "\integral")
- (process-node-list b))))))
-
-;;; power/
-
-(define (apply-power args)
- (make script
- (sosofo-append
- (make math-sequence
- (process-node-list (node-list-first args)))
- (make math-sequence
- label: 'post-sup
- (process-node-list (node-list-rest args))))))
-
-;;; inverse/
-
-(define (apply-inverse fname args)
- (make script
- (sosofo-append
- (make math-sequence
- (process-node-list args))
- (make math-sequence
- label: 'post-sup
- (case fname
- (("inverse") (literal "-1"))
- (("transpose") (literal "t")))))))
-
-;;; over bars (don't work)
-(define (apply-over args)
- (make math-sequence
- (process-node-list args))) ;; fix!
-
-;;; max/ and min/
-
-(define (apply-max fname args)
- (make math-sequence
- (sosofo-append
- (make unmath (literal fname))
- (do-set "{" "}" args))))
-
-;;; gcd/
-
-(define (apply-gcd fname args)
- (make math-sequence
- (sosofo-append
- (make unmath (literal fname))
- (do-set "(" ")" args))))
-
-;;; abs/
-
-(define (apply-abs args)
- (make fence
- (make math-sequence label: 'open
- (literal "|"))
- (make math-sequence label: 'close
- (literal "|"))
- (make math-sequence
- (process-node-list args))))
-
-;;; diff/
-;;; Trick is to get hold of the degree.
-;;; Recommendation is for
-;;; d f
-;;; --- (x)
-;;; d x
-;;;
-;;; but I don't currently test for special functions which are
-;;; just a single identifier like that, so currently you get
-;;; d d^3
-;;; --- f(x) and --- f(x)
-;;; d x d x^3
-
-(define (apply-diff args)
- (sosofo-append
- (let* ((f (node-list-first (&my-debug2 args))))
- (if (equal? "bvar" (gi f))
- (let ((d (&my-debug2 (node-list-filter
- (lambda (n) (equal? "degree" (gi n)))
- (children f)))))
- (make fraction
- (sosofo-append
- (make math-sequence
- label: 'numerator
- (make script
- (sosofo-append
- (literal "d")
- (make math-sequence
- label: 'post-sup
- (process-node-list d))))))
- (make math-sequence
- label: 'denominator
- (sosofo-append
- (literal "d")
- (make script
- (sosofo-append
- (process-node-list
- (node-list-filter
- (lambda (n) (not (equal? "degree" (gi n))))
- (children f)))
- (make math-sequence
- label: 'post-sup
- (process-node-list d))))))))
- (make fraction
- (sosofo-append
- (make math-sequence
- label: 'numerator
- (literal "d"))
- (make math-sequence
- label: 'denominator
- (sosofo-append
- (literal "d")
- (process-node-list f)))))))
- (process-node-list (node-list-rest args))))
-
-
-;;; partial differentiation
-;;;
-;;; Trick here is to amalgamate the degrees
-;;; in the numerator:
-;;; d^3
-;;; ---------- f(x)
-;;; d^2 x d y
-;;;
-
-;; helper function that sets the bit of the denominator
-;; corresponding to one bound variable.
-
-(define (do-one-partial nl)
- (let ((d (&my-debug2 (node-list-filter
- (lambda (n) (equal? "degree" (gi n)))
- (children nl)))))
- (make math-sequence
- label: 'denominator
- (sosofo-append
- (literal "d")
- (make script
- (sosofo-append
- (process-node-list
- (node-list-filter
- (lambda (n) (not (equal? "degree" (gi n))))
- (children nl)))
- (make math-sequence
- label: 'post-sup
- (process-node-list d))))))))
-
-
-;;; partialdiff
-;;; I suspect that I could make use of node-list-filter-by-gi
-;;; from dblib here, but I only just noticed that function...
-
-(define (apply-partialdiff args)
- (sosofo-append
- (let* ((bvars
- (node-list-filter
- (lambda (n) (equal? "bvar" (gi n)))
- args))
-;; totald is the sum of all the degrees [with 1 being supplied
-;; as a default in each case] There may be an easier way to get that.
- (totald
- (node-list-reduce
- bvars
- (lambda (result n)
- (+ result
- (or
- (string->number
- (string-nospace
- (data
- (node-list-filter
- (lambda (nn) (equal? "degree" (gi nn)))
- (children n)))))
- 1)))
- 0)))
-;; Now it is easy, set a fraction with the partial and the bound vars
-;; then put out the body.
- (make fraction
- (sosofo-append
- (make math-sequence
- label: 'numerator
- (make script
- (sosofo-append
- (literal "\partial-differential")
- (make math-sequence
- label: 'post-sup
- (literal (number->string totald))))))
- (make math-sequence
- label: 'denominator
- (node-list-reduce
- bvars
- (lambda (result n)
- (sosofo-append
-;; something is reversing the args, so I'll reverse them back
- (do-one-partial n)
- result))
- (empty-sosofo))))))
- (process-node-list (node-list-filter
- (lambda (n) (not (equal? "bvar" (gi n))))
- args))))
-
-
-
-
-
-;;; apply
-;;; This is the main switch for Content MathNL
-;;; Mainly just a case statement on th egi of the first child
-;;; with some fall back code in case the function argument isn't known.
-(element apply
- (let* ((nl (children (current-node)))
- (f (node-list-first nl))
- (fname (&my-debug (gi f)))
- (args (&my-debug (node-list-rest nl))))
- (case fname
- (("product")
- (apply-product (literal "\n-ary-product") (literal "=") args))
- (("sum")
- (apply-product (literal "\n-ary-summation") (literal "=") args))
- (("limit")
- (apply-product (literal "lim") (literal "\rightwards-arrow") args))
- (("int")
- (apply-int args))
- (("inverse" "transpose")
- (apply-inverse fname args))
- (("power")
- (apply-power args))
- (("forall")
- (apply-forall (literal "\for-all") args))
- (("exists")
- (apply-forall (literal "\there-exists") args))
- (("plus" "times" "minus" "union" "intersect" "compose" "divide" "rem")
- (do-nary-binop fname args))
- (("mean" "conjugate")
- (apply-over args))
- (("factorial")
- (sosofo-append (process-node-list args) (literal "!")))
- (("root")
- (apply-root args))
- (("sdev")
- (apply-braced-fn "\greek-small-letter-sigma" args))
- (("median" "mode")
- (apply-braced-fn fname args))
- (("max" "min")
- (apply-max fname args))
- (("gcd")
- (apply-gcd fname args))
- (("log")
- (apply-log args))
- (("abs")
- (apply-abs args))
- (("diff")
- (apply-diff args))
- (("partialdiff")
- (apply-partialdiff args))
- (("var")
- (make script
- (make math-sequence
- label: 'post-sup (literal "2"))
- (apply-braced-fn "\greek-small-letter-sigma" args)))
- (("transpose")
- (make script
- (make math-sequence
- label: 'post-sup (literal "t"))
- (process-node-list args)))
- (else
- (make math-sequence
- (sosofo-append
- (process-node-list f)
- (if (and (equal?
- 1 (&my-debug (node-list-length args)))
- (equal? "ci" (gi args)))
- (make math-sequence (process-node-list args))
- (make fence
- (make math-sequence label: 'open
- (literal "("))
- (make math-sequence label: 'close
- (literal ")"))
- (make math-sequence
- (process-node-list args))))))))))
-
-
-;;; reln
-;;; relations are similar to apply.
-;;; Currently there is a double test as this top level
-;;; function bunches all binops together, then do-binary-reln
-;;; tests again to separate them, perhaps not the best idea.
-
-(element reln
- (let* ((r (gi (node-list-first (children (current-node)))))
- (c(&my-debug (node-list-rest(children (current-node))))))
- (case r
- (("neq" "implies" "in" "notin" "notsubset" "notprsubset" "tendsto")
- (do-binary-reln r c))
- (("eq" "leq" "lt" "geq" "gt" "subset" "prsubset")
- (do-nary-reln r c)))))
-
-
-;;; Typeset a binary infix relation
-
-(define (do-binary-reln r c)
- (sosofo-append
- (process-node-list (node-list-first c))
- (literal (case r
- (("neq") "\not-equal-to")
- (("implies") "\leftwards-double-arrow")
- (("in") "\element-of")
- (("notin") "\not-an-element-of")
- (("notsubset") "\not-a-subset-of")
- (("notprsubset") "PR\not-a-subset-of"); fix!
- (("tendsto") "\rightwards-arrow"))); fix for type attribute
- (process-node-list (node-list-rest c))))
-
-;;; Typeset a nary infix relation
-;;; repeating the operator as many times as needed.
-
-(define (do-nary-reln r c)
- (let ((rs (literal
- (case r
- (("eq") "\equals-sign")
- (("leq") "\less-than-or-equal-to")
- (("lt") "\less-than-sign")
- (("geq") "\greater-than-or-equal-to")
- (("gt") "\greater-than-sign")
- (("subset") "\subset-of")
- (("prsubset") "PR\subset-of")))));fix!
- (sosofo-append
- (process-node-list (node-list-first c))
- (node-list-reduce
- (node-list-rest c)
- (lambda (result n)
- (sosofo-append
- result
- rs
- (process-node-list n)))
- (empty-sosofo)))))
-
-;;; typeset an nary operator, as for relations.
-
-(define (do-nary-binop op c)
- (let ((ops (literal
- (case op
- ((",") ",")
- (("plus") "\plus-sign")
- (("times") "")
- (("union") "\union")
- (("intersect") "\intersection")
- (("minus") "\minus-sign")
- (("divide") "\division-slash")
- (("rem") "mod") ;fix
- (("compose") "\U-2218") ))))
- (sosofo-append
- (process-node-list (node-list-first c))
- (node-list-reduce
- (node-list-rest c)
- (lambda (result n)
- (sosofo-append
- result
- ops
- (process-node-list n)))
- (empty-sosofo)))))
-
-
-;;;;;;;;;;;;;;;;
-
-;;;; ident
-
-(element ident
- (make math-sequence
- (literal "id")))
-
-
-
-;;; trig
-;;; Currently these done with th eelement declarations
-;;; and the fallback case of apply typesetting the arguments.
-;;; may need to change that.
-
-(define (do-sin sin)
- (make unmath
- font-posture: 'upright
- (literal sin)))
-
-(element sin
- (do-sin "sin"))
-
-(element cos
- (do-sin "cos"))
-
-(element tan
- (do-sin "tan"))
-
-(element sec
- (do-sin "sec"))
-
-(element csc
- (do-sin "csc"))
-
-(element cot
- (do-sin "cot"))
-
-(element sinh
- (do-sin "sinh"))
-
-(element cosh
- (do-sin "cosh"))
-
-(element tanh
- (do-sin "tanh"))
-
-(element sech
- (do-sin "sech"))
-
-(element csch
- (do-sin "csch"))
-
-(element coth
- (do-sin "coth"))
-
-(element arcsin
- (do-sin "arcsin"))
-
-(element arccos
- (do-sin "arccos"))
-
-(element arctan
- (do-sin "arctan"))
-
-;;;;
-
-;;; natural log and determinant are honourary trig functions.
-;;; I should make det applied to an explicit table use | | rather
-;;; than det ( ) I think.
-
-(element ln
- (do-sin "ln"))
-
-
-(element determinant
- (do-sin "det"))
-
-;;;;;;;;;;;
-
-;;; sets and lists
-
-(element set
- (do-set "{" "}" (children (current-node))))
-
-(element list
- (do-set "[" "]" (children (current-node))))
-
-(element vector
- (do-set "(" ")" (children (current-node))))
-
-(element interval
- (case (attribute-string "closure" (current-node))
- (("closed")
- (do-set "[" "]" (children (current-node))))
- (("open")
- (do-set "(" ")" (children (current-node))))
- (("open-closed")
- (do-set "(" "]" (children (current-node))))
- (("closed-open")
- (do-set "[" ")" (children (current-node))))))
-
-
-;;; helper function for sets.
-;;; Checks for two styles, comma separated explicit,
-;;; or via conditions and bound vars.
-
-(define (do-set left right args)
- (make fence
- (make math-sequence label: 'open
- (literal left))
- (make math-sequence label: 'close
- (literal right))
- (make math-sequence
- (if (equal? "bvar" (gi (node-list-first (&my-debug2 args))))
- (if (equal? 2 (node-list-length args))
-;; typeset bvar
- (sosofo-append
- (process-node-list (children (node-list-first args)))
- (literal "|")
- (process-node-list (children (node-list-rest args))))
-;; else dont
- (sosofo-append
- (process-node-list (node-list-rest(node-list-rest args)))
- (literal "|")
- (process-node-list (children (node-list-first (node-list-rest args))))))
-;; else stick in some commas
- (do-nary-binop "," args) ))))
-
-
-;;;;;;;
-
-;;; lambda [lamda according to Jade ?]
-
-(element lambda
- (sosofo-append
- (make math-sequence (literal "\greek-small-letter-lamda"))
- (do-nary-binop ","
- (node-list-filter
- (lambda (n) (equal? "bvar" (gi n)))
- (children (current-node))))
- (literal ".")
- (process-node-list
- (&my-debug2(node-list-filter
- (lambda (n) (not (equal? "bvar" (gi n))))
- (children (current-node)))))))
-
-
-;;;;;;;;;;;;;;;
-
-;;; cn
-
-;;; what to do if you see a sep element for rationals..
-
-(define (sep-rational top bottom)
- (make fraction
- (sosofo-append
- (make math-sequence
- label: 'numerator
- (process-node-list top))
- (make math-sequence
- label: 'denominator
- (process-node-list bottom)))))
-
-
-;;; and for complex cartesian
-
-(define (sep-complex-cartesian top bottom)
- (make math-sequence
- (sosofo-append
- (make math-sequence
- (process-node-list top))
- (make math-sequence (literal "+"))
- (make math-sequence
- (process-node-list bottom))
- (make math-sequence (literal "i")))))
-
-
-;;; and polar
-
-(define (sep-complex-polar top bottom)
- (make math-sequence
- (sosofo-append
- (make math-sequence (literal "Polar"))
- (make fence
- (sosofo-append
- (make math-sequence
- label: 'open
- (literal "("))
- (make math-sequence
- label: 'close
- (literal ")"))
- (sosofo-append
- (make math-sequence
- (process-node-list top))
- (make math-sequence (literal ","))
- (make math-sequence
- (process-node-list bottom))))))))
-
-;;; Function to collect node list before and after sep element
-;;; then finally call one of the above functions to typeset the
-;;; two halves of the number.
-
-(define (do-sep fn flag top bottom args)
- (if (equal? 0 (node-list-length args)); why can't I use null
- (fn top bottom)
- (if (equal? "sep" (gi (node-list-first args)))
- (do-sep fn #f top bottom (node-list-rest args))
- (if flag
- (do-sep fn flag
- (node-list
- top
- (node-list-first args))
- bottom
- (node-list-rest args))
- (do-sep fn flag
- top
- (node-list
- bottom
- (node-list-first args))
- (node-list-rest args))))))
-
-
-;;; cn
-;;; subscript with the base unless it is 10, or call one of the above functions
-;;; to start looking for sep element.
-
-(element cn
- (case (or (attribute-string "type" (current-node))
- "real")
- (("real" "constant")
- (make math-sequence (process-node-list (children (current-node)))))
- (("integer")
- (if (equal? "10" (attribute-string "base" (current-node)))
- (make math-sequence
- (process-node-list (children (current-node))))
- (make script
- (sosofo-append
- (make math-sequence
- (process-node-list (children (current-node))))
- (make math-sequence
- label: 'post-sub
- (literal
- (attribute-string "base" (current-node))))))))
- (("rational")
- (do-sep sep-rational
- #t
- (empty-node-list)
- (empty-node-list)
- (children (current-node))))
- (("complex-cartesian")
- (do-sep sep-complex-cartesian
- #t
- (empty-node-list)
- (empty-node-list)
- (children
- (current-node))))
- (("complex-polar")
- (do-sep sep-complex-polar
- #t
- (empty-node-list)
- (empty-node-list)
- (children (current-node))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; ought to share code with mtable, probably
-
-(element matrix
- (let* ((c (&my-debug (children (current-node))))
- (n (&my-debug (node-list-length (children (node-list-first c))))))
- (make fence
- (make math-sequence label: 'open
- (literal "("))
- (make math-sequence label: 'close
- (literal ")"))
- (make grid
- grid-n-columns: n
- (node-list-reduce
- c
- (lambda (a b)
- (sosofo-append
- a
- (node-list-reduce
- (children b)
- (lambda (x y)
- (sosofo-append
- x
- (make grid-cell
- (process-node-list y))))
- (empty-sosofo))))
- (empty-sosofo))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;