share/contrib/maximaMathML/PrMathML.lisp

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;  Purpose:  Generate Presentation MathML code from MAXIMA
   4 ;;;  File: PrMathML.lsp
   5 ;;;  Author: Paul S. Wang
   6 ;;;  Date: March 1999
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;
   9 ;=============================================================================
  10 ;    (c) copyright 1999  Kent State University
  11 ;               all rights reserved.
  12 ;=============================================================================
  13 (in-package :maxima)
  14 (macsyma-module mathml)
  15
  16 ;; special variables used in TeXetting
  17 (declaim (special *row* *indent* ccol mPrport $mPrautolabel $mPrworksheet $lamPrworksheet
  18              $mPrlabelleft $lamPrautolabel $mPrdisplaytype $mPrevaluate
  19              macmPr-lib lop rop $labels casep))
  20
  21 ;;****************************************************************************
  22 ;;      Program : prmathml
  23 ;;****************************************************************************
  24 ;;Generatig MathML presenation codes for the expr
  25 ;;This is a maxima top-level function used  the form
  26 ;;              prmathml(expr, [,(filename|stream)[,t (d)]])  on the C-line
  27
  28 (defmfun $prmathml (&rest margs)
  29          (prog (ccol *row* *indent* filename mexplabel mexpress mPrport x y)
  30            (setq mexpress (car margs))
  31            (setq ccol 1 *indent* 0 *row* t)
  32            (cond
  33              ((null mexpress) (princ " NO EXPRESSION GIVEN ")
  34               (return nil))
  35              ((null (cdr margs)) (setq filename nil) (setq mPrport t))
  36              ((null (cddr margs))
  37               (setq mPrport
  38                     (if (stringp (cadr margs))
  39                       (progn
  40                         (setq filename (cadr margs))
  41                         (open (cadr margs)
  42                             :direction :output
  43                             :if-exists :append
  44                             :if-does-not-exist :create))
  45                       ;; otherwise, assume (cadr margs) is a stream.
  46                       (cadr margs))))
  47              (t (princ " wrong No. of Arguments given ")))
  48            (cond
  49              ((member mexpress $labels :test #'eq)
  50               (setq mexplabel
  51                     (intern (concatenate 'string "("
  52                                 (princ-to-string (fullstrip1 mexpress))
  53                                 ")")))
  54               (setq mexpress (eval mexpress)))
  55              (t (setq mexplabel nil)
  56                 (when $mPrevaluate (setq mexpress (meval mexpress)))))
  57            (when $mPrautolabel (setq mexplabel (updateautolabel)))
  58            (when (symbolp (setq x mexpress))
  59              (setq x ($verbify x))
  60              (cond
  61                ((setq y (mget x 'mexprer))
  62                 (setq mexpress
  63                       (list '(mdefine) (cons (list x) (cdadr y))
  64                             (caddr y))))
  65                ((setq y (mget x 'mmacro))
  66                 (setq mexpress
  67                       (list '(mdefmacro) (cons (list x) (cdadr y))
  68                             (caddr y))))
  69                ((setq y (mget x 'aexpr))
  70                 (setq mexpress
  71                       (list '(mdefine)
  72                             (cons (list x 'array)
  73                                   (cdadr y))
  74                             (caddr y))))))
  75            (when (and (consp mexpress) (consp (car mexpress))
  76                       (eq 'mlabel (caar mexpress)))
  77              (setq mexpress (cadr mexpress)))
  78            (cond
  79              ((and $lamPrworksheet
  80                    (when mexplabel
  81                      (member 'c (explode mexplabel) :test #'eq)))
  82               (format mPrport "\\begin{verbatim}~%~a " mexplabel)
  83               (mgrind mexpress mPrport)
  84               (format mPrport ";~%\\end{verbatim}~%"))
  85              ((and $mPrworksheet
  86                    (when mexplabel
  87                      (member 'c (explode mexplabel) :test
  88                              #'eq)))
  89               (format mPrport "|~a " mexplabel)
  90               (mgrind mexpress mPrport) (format mPrport ";|~%"))
  91              (t (cond
  92                   ($lamPrautolabel
  93                       (format mPrport "\\begin{equation}~%"))
  94                   ($mPrdisplaytype
  95                     (tprinc "<math  xmlns='http://www.w3.org/1998/Math/MathML'>") )
  96                   (t (tprinc "<math  xmlns='http://www.w3.org/1998/Math/MathML'>")))
  97                 (mPr_engine mexpress 'mparen 'mparen)
  98                 (cond
  99                   ($lamPrautolabel
 100                       (format mPrport "~%\\end{equation}~%"))
 101                   ($mPrdisplaytype
 102                       (when mexplabel
 103                         (if $mPrlabelleft
 104                             (format mPrport "\\leqno{\\tt ~a}" mexplabel)
 105                             (format mPrport "\\eqno{\\tt ~a}" mexplabel)))
 106                         (tprinc "</math>") (myterpri))
 107                   (t (tprinc "</math>")))))
 108            (when filename (terpri mPrport) (close mPrport))
 109            (return 'done)))
 110
 111
 112
 113 ;;      mPr_engine is a kernel function for this program. It checks whether
 114 ;;an argument "mexpress" is an atom or expression. Then it will assign
 115 ;;a proper function to the expression or just print if it is an atom.
 116 ;;This is an applied object-oriented programming technique.
 117
 118 ;;      arg: mexpress - macsyma internal representaton
 119 ;;           lop , rop - left and right handside operator of mexpress
 120
 121 ;;special check if expression is an array
 122 ;;check whether or not to put parenthesis
 123 ;;if not a keyword,it is a function
 124
 125 ;;;;;; This is the work house routine ;;;;;;;;
 126
 127 (defun mPr_engine (mexpress lop rop)
 128   (setq mexpress (nformat mexpress))
 129   (if (atom mexpress) (mPr-atom mexpress)
 130       (when (listp (car mexpress))
 131         (cond
 132           ((member 'array (car mexpress) :test #'eq)
 133            (mPr-array mexpress))
 134           ((or (<= (mPr-lbp (caar mexpress)) (mPr-rbp lop))
 135                (> (mPr-lbp rop) (mPr-rbp (caar mexpress))))
 136            (mPr-paren mexpress))
 137           (t (if (get (caar mexpress) 'mPrprocess)
 138                  (funcall (get (caar mexpress) 'mPrprocess) mexpress)
 139                  (mPr-function mexpress)))))))
 140
 141
 142
 143 ;*************************************************************************
 144 ;;
 145 ;;                              Utilities Section
 146 ;;
 147 ;*************************************************************************
 148
 149 ;;; tprinc is an intelligent low level printing routine.  it keeps track of
 150 ;;; the size of the output for purposes of allowing the TeX file to
 151 ;;; have a reasonable line-length. tprinc will break it at a space
 152 ;;; once it crosses a threshold.
 153 ;;; this has nothing to do with breaking the resulting equations.
 154
 155 ;-      arg:    chstr -  string or number to princ
 156 ;-      scheme: This function keeps track of the current location
 157 ;-              on the line of the cursor and makes sure
 158 ;-              that a value is all printed on one line (and not divided
 159 ;-              by the crazy top level os routines)
 160
 161 (defun row-begin(str)
 162   (myterpri)
 163   (princ str  mPrport)
 164   (incf *indent*)
 165   (setq *row* t))
 166
 167 (defun myindent()
 168   (do ((i *indent*))
 169       ((equal i 0) nil)
 170     (princ "   " mPrport)
 171     (decf i)))
 172
 173 (defun row-end(str)
 174   (decf *indent*)
 175   (myterpri)
 176   (princ str mPrport)
 177   (setq *row* t))
 178
 179 (defun tpchar (c)
 180   (incf ccol)
 181   (princ c mPrport))
 182
 183 ;would have exceeded the line length
 184 ; lead off with a space for safety
 185 ;so we split it up.
 186 (defun tprinc (chstr)
 187   (prog (chlst linebreak)
 188     (cond ((> (+ (length (setq chlst (exploden chstr))) ccol) 80)
 189         (setq linebreak t)))
 190     (cond (*row* (setq *row* nil) (myterpri))) ;; *row* calls for new row
 191     (do ((ch chlst (cdr ch)) (colc ccol (1+ colc)))
 192         ((null ch) (setq ccol colc))
 193       (write-char (car ch) mPrport)
 194       (if (and linebreak (eq (car ch) '>))  ;; line break only after >
 195           (myterpri))
 196 )))
 197
 198 ;;   myterpri is terpri with port and indent control
 199
 200 (defun myterpri ()
 201   (if mPrport (terpri mPrport) (mterpri))
 202   (setq ccol 1)
 203   (myindent)
 204 )
 205
 206 ;;      lastlementp is a predicate function to check a list l
 207 ;;that is there only one element left in the list.
 208
 209 (defun lastelementp (l) (equal (length l) 1))
 210
 211 ;;      getsymbol is a function tool. It'll  get the information
 212 ;;from the database which is a symbol for an argument (atom)
 213
 214 (defun getsymbol (atom) (get atom 'chchr))
 215
 216 ;;      get_process is a function tool. It'll  get the information
 217 ;;from the database about the process to handle the operator (atom)
 218 ;; (defun get_process (atom) (get atom 'mPrprocess))
 219
 220 ;;      setup is a function to build the database (put properties) for
 221 ;;each key word
 222
 223 ; check if property exists already
 224 (defun setup (arg)
 225   (mapc #'(lambda (ls) (setf (get (car arg) (car ls)) (cadr ls)))
 226         (cdr arg)))
 227
 228 ;;      mPr-lbp and mPr-rbp are the functions to get information
 229 ;;      about size of the particular operator
 230 ;;      this is from the latex version of this prog
 231 ;;      not sure how well it works for MathML
 232
 233 (defun mPr-lbp (x) (cond ((get x 'mPr-lbp)) (t (lbp x))))
 234
 235 (defun mPr-rbp (x) (cond ((get x 'mPr-rbp)) (t (rbp x))))
 236
 237 ;; reduce lbp and rbp value for mtimes to get less parenthesis
 238 (defun $lessparen ()
 239   (setf (get 'mtimes 'mPr-lbp) '110)
 240   (setf (get 'mtimes 'mPr-rbp) '110)
 241   '$done)
 242 ;; get back to normal case for paren
 243 (defun $parenback ()
 244   (setf (get 'mtimes 'mPr-lbp) '120)
 245   (setf (get 'mtimes 'mPr-rbp) '120)
 246   '$done)
 247
 248 ;;      mPr-abs is a function to handle abs()
 249
 250 (defun mPr-abs (mexpress)
 251   (tprinc "<mo>|</mo>")
 252   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 253   (tprinc "<mo>|</mo>"))
 254
 255 (defun mPr-conjugate (mexpress)
 256   (tprinc "<mover>")
 257   (tprinc "<mrow>")
 258   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 259   (tprinc "</mrow>")
 260   (tprinc "<mo>&#xaf;</mo>") ;; macron
 261   (tprinc "</mover>"))
 262
 263 ;; a[1]^2 or a[x,y]^z
 264 (defun mPr-arr-power(b e)
 265   (tprinc "<msubsup>")
 266   (mPr_engine (caar b) lop 'mfunction)
 267   (cond
 268    ((equal (length b) 2)
 269      (mPr_engine (cadr b) lop rop)
 270    )
 271    (t (row-begin "<mrow>") ;;(tprinc "<mrow>")
 272      (do ((l (cdr b) (cdr l))) ((null l)(row-end "</mrow>"))
 273        (mPr_engine (car l) lop rop)
 274        (when (not (lastelementp l)) (tprinc "<mo>,</mo>")))
 275   ))
 276   (mPr_engine e 'mparen 'mparen) (tprinc "</msubsup>")
 277 )
 278
 279 ;;      when the operator is array ,this function will be called
 280 ;;      ex. a[x1,..] is a top level representation
 281
 282 (defun mPr-array (mexpress)
 283   (tprinc "<msub>")
 284   (mPr_engine (caar mexpress) lop 'mfunction)
 285   (row-begin "<mrow>")
 286   (do ((l (cdr mexpress) (cdr l))) ((null l) (row-end "</mrow>")(tprinc "</msub>"))
 287     (mPr_engine (car l) lop rop)
 288     (when (not (lastelementp l)) (tprinc "<mo>,</mo>"))))
 289
 290 ;;      mPr-at is a function to handle at(..) function
 291 ;;
 292 (defun mPr-at (mexpress)
 293   (row-begin "<mrow>") ;;(tprinc "<mrow>")
 294   (mPr_engine (cadr mexpress) lop rop)
 295   (tprinc "<msub><mo>|</mo>")
 296   (mPr_engine (caddr mexpress) 'mparen 'mparen)
 297   (tprinc "</msub>") (row-end "</mrow>")
 298 )
 299 ;;      in mPr_engine ,whennever mexpress is an atom this function taking care
 300 ;;of it by getting a TeX symbol if it exists. Also it handles some word which
 301 ;;has a reserved character for TeX
 302
 303 ;; prints instead of returning value now
 304 (defun mPr-atom (chr)
 305   (cond
 306     ((numberp chr) (mPr-num chr))
 307     ;; pwang 1/2005
 308     ;; ((atom chr) (tprinc "<mi>") (tprinc (fullstrip1 chr)) (tprinc "</mi>"))
 309     ((safe-get chr 'chchr) (tprinc "<mi>")
 310      (tprinc (safe-get chr 'chchr)) (tprinc "</mi>"))
 311     (t
 312       (let ((my-atom (if (symbolp chr) (print-invert-case (stripdollar chr)) chr)))
 313         (tprinc "<mi>")
 314         (tprinc (coerce (mapcar #'handle_rsw (exploden my-atom)) 'string))
 315         (tprinc "</mi>")))))
 316
 317 (defun rm (a list)
 318   (do ((l list (cdr l)) (l2 nil)) ((null l) (reverse l2))
 319     (when (not (equal a (car l))) (setq l2 (cons (car l) l2)))))
 320
 321
 322 ;;      this fn is called by mPr-atom ,it checks for a reserved char.
 323 (defun handle_rsw (c)
 324   (cond
 325     ((equal c #\<) "&lt;")
 326     ((equal c #\>) "&gt;")
 327     ((equal c #\&) "&amp;")
 328     (t c)))
 329
 330 ;;      mPr-binomial :-
 331 ;;       top level:  binomail(x,y);
 332
 333 (defun mPr-binomial (mexpress)
 334   (row-begin "<mrow>") (tprinc "<mo>(</mo><mfrac linethickness=\"0\">")
 335   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 336   (tprinc "  ")
 337   (mPr_engine (caddr mexpress) 'mparen 'mparen)
 338   (tprinc "</mfrac><mo>)</mo>") (row-end "</mrow>"))
 339
 340
 341
 342 ;;      mPr-det is a function to handle determinant()
 343
 344 (defun mPr-det (mexpress)
 345   (let ((operand (cadr mexpress)))
 346     (tprinc "<mi>det</mi>")
 347     (mPr_engine operand 'mparen 'mparen)))
 348
 349 ;;      mPr-dif is a function to handle diferentiation function.
 350 ;;It calls to subfunctions powerof_d and denopart.
 351 ;;
 352 (defun mPr-diff (mexpress)
 353   (cond
 354     ((powerof_d (cddr mexpress)) (denopart (cddr mexpress))
 355      (tprinc "</mfrac><mo>&InvisibleTimes;</mo>")
 356      (mPr_engine (cadr mexpress) 'mtimes rop)
 357      (row-end "</mrow>"))
 358     (t (mPr_engine (cadr mexpress) lop rop))))
 359
 360 ;;if there is no repeating differentiation
 361 ;; just diff(exp,x)
 362 ;; if diff(exp,x,no,..)
 363 (defun powerof_d (l)
 364   (cond
 365     ((lastelementp l)
 366      (row-begin "<mrow>")(tprinc "<mfrac><mo> &dd; </mo>") t)
 367     (t (do ((l1 l (cddr l1)) (l2 nil (cons (cadr l1) l2))
 368             (power_of_d nil))
 369            ((null l1) (setq power_of_d (addn l2 nil))
 370             (cond
 371               ((numberp power_of_d)
 372                (cond
 373                  ((equal 0 power_of_d) nil)
 374                  ((equal 1 power_of_d)(row-begin "<mrow>")(tprinc "<mfrac><mo> &dd; </mo>") t)
 375                  (t (row-begin "<mrow>")(tprinc "<mfrac><msup><mo> &dd;</mo><mn>")
 376                     (tprinc power_of_d) (tprinc "</mn></msup>") t)))
 377               (t (row-begin "<mrow>")(tprinc "<mfrac><msup><mo> &dd;</mo>")
 378                  (mPr_engine power_of_d 'mparen 'mparen)
 379                  (tprinc "</msup>") t))))))
 380 )
 381
 382 ;;if just diff(exp,x)
 383 ;;if diff(exp,x,nox,y,noy,...)
 384 (defun denopart (l)
 385   (prog (result)
 386     (cond
 387       ((lastelementp l) (row-begin "<mrow>") (tprinc "<mo> &dd; </mo>")
 388        (p-op (getsymbol 'mtimes)) (mPr_engine (car l) 'mtimes rop)
 389       (row-end "</mrow>"))
 390       (t (do ((l1 l (cddr l1)) (l2 nil)) ((null l1) (setq result l2))
 391            (setq l2
 392                  (cons (append '((mexpt)) (list (car l1))
 393                                (list (cadr l1)))
 394                        l2)))
 395          (setq result (muln result nil))
 396          (cond
 397            ((atom result) (row-begin "<mrow>")(tprinc "<mo> &dd; </mo>")
 398             (p-op (getsymbol 'mtimes))
 399             (mPr_engine result 'mparen 'mparen) (row-end "</mrow>"))
 400            ((listp result)
 401             (cond
 402               ((eq (caar result) 'mexpt)
 403                (row-begin "<mrow>")(tprinc "<mo> &dd; </mo>")
 404                (p-op (getsymbol 'mtimes))
 405                (mPr_engine result 'mtimes 'mparen) (row-end "</mrow>"))
 406               (t (row-begin "<mrow>")
 407                  (do ((l1 (cdr result) (cdr l1)) (l2 nil)
 408                       (power_of_d nil))
 409                      ((null l1) (row-end "</mrow>"))
 410                    (tprinc "<mo> &dd; </mo>")
 411                    (p-op (getsymbol 'mtimes))
 412                    (mPr_engine (car l1) 'mtimes 'mtimes)
 413                    (when (not (lastelementp l1)) (tprinc "<mo>,</mo>"))
 414                  )
 415                  ))))))))
 416
 417 ;; this function is adopted the main idea form macTeX from Prof. Richard
 418 ;; Fateman in the mPr-mexpt
 419 ;;
 420 ;; insert left-angle-brackets for mncexpt. a^<n> is how a^^n looks.
 421 ;; here is where we have to check for f(x)^b to be displayed
 422 ;; as f^b(x), as is the case for sin(x)^2 .
 423 ;; which should be sin^2 x rather than (sin x)^2 or (sin(x))^2.
 424 ;; yet we must not display (a+b)^2 as +^2(a,b)...
 425 ;; or (sin(x))^(-1) as sin^(-1)x, which would be arcsine x
 426 ; this is f(x)
 427 ; this is f [or nil]
 428 ;this is (x) [maybe (x,y..), or nil]
 429 ;; this is the exponent
 430 ; there is such a function
 431 ;; insist it is a % or $ function
 432 ;     x
 433 ;;this case like sin(x)^x --> sin x
 434 ;; if for example exp = (x+2)^4
 435 ;;      in case x^^y
 436 (defun mPr-expt (mexpress)
 437  (cond
 438   ((eq (caar mexpress) 'mexpt)
 439    (if (and (not (atom (cadr mexpress)))
 440              (member 'array (caadr mexpress) :test #'eq) ;; array
 441        )
 442        (mPr-arr-power (cadr mexpress) (caddr mexpress))
 443        (let* ((fx (cadr mexpress))
 444             (f (and (not (atom fx)) (atom (caar fx)) (caar fx)))
 445             (bascdr (and f (cdr fx))) (expon (caddr mexpress))
 446             (doit (and f (member (char (string f) 0) (list #\% #\$))
 447                        (not (member f '(%sum %product) :test #'eq)))))
 448         (cond
 449            (doit (cond     ;;;; sin^2 x case
 450                  ((atom expon)
 451                   (row-begin "<mrow>")(tprinc "<msup>") (mPr-fname f)
 452                   (mPr-atom expon)(tprinc "</msup>")
 453                   (tprinc "<mo>&ApplyFunction;</mo>")
 454                   (if (cdr bascdr) (mPr-listparen bascdr)
 455                       (mPr_engine (car bascdr) 'mtimes 'mtimes))
 456                   (row-end "</mrow>")
 457                  )
 458                  (t (tprinc "<msup>")
 459                     (mPr_engine fx 'mparen 'mparen)
 460                     (mPr_engine expon 'mparen 'mparen)
 461                     (tprinc "</msup>"))))
 462           (t (tprinc "<msup>")
 463             (mPr_engine (cadr mexpress) lop (caar mexpress))
 464             (mPr_engine (caddr mexpress) 'mparen 'mparen)
 465             (tprinc "</msup>")))))
 466   )
 467   (t (tprinc "<msup>") ;;;  mnexpt case
 468        (mPr_engine (cadr mexpress) lop (caar mexpress))
 469        (row-begin "<mrow>")(tprinc "<mo>&LeftAngleBracket;</mo>")
 470        (mPr_engine (caddr mexpress) 'mparen 'mparen)
 471        (tprinc "<mo>&RightAngleBracket;</mo>")(row-end "</mrow>")
 472        (tprinc "</msup>")))
 473 )
 474 ;;      this function will check that whether or not an arg has a symbol
 475 ;;in data base or not, if not it 'll be treated to be function which 'll
 476 ;;be printed in rm font
 477 (defun mPr-fname (f)
 478      (tprinc "<mi>")
 479      (tprinc (if (getsymbol f) (getsymbol f) f))
 480      (tprinc "</mi>")
 481 )
 482 ;;      to handle if an operator is a function which will be printed
 483 (defun mPr-function (mexpress)
 484   (mPr_engine (caar mexpress) 'mparen 'mparen)
 485   (tprinc "<mo>&ApplyFunction;</mo>")
 486   (mPr-listparen (cdr mexpress)))
 487
 488 (defun mPr-gamma (mexpress)
 489   (mPr_engine '|$Gamma| 'mparen 'mparen) ;; ensure big gamma instead of little gamma (CHCHR property)
 490   (tprinc "<mo>&ApplyFunction;</mo>")
 491   (mPr-listparen (cdr mexpress)))
 492
 493 ;;      for infix operator , and also handle when there is a truncation
 494 ;;in macsyma expression (see mPr-infix1)
 495 ;;      mPr-infix calling
 496 ;;              1)mPr-infix1 calling
 497 ;;                      1.1) p-op-oprd
 498 ;;              2)p-op-oprd
 499 ;;
 500 ;if -x or +x so call mPr-function
 501 (defun mPr-infix (mexpress)
 502   (let ((moperator (car mexpress)) (moperands (cdr mexpress)))
 503     (cond
 504       ((equal (length moperands) 1) (mPr-function mexpress))
 505       (t (row-begin "<mrow>")
 506          (mPr_engine (car moperands) lop (car moperator))
 507          (p-op-oprd moperator (cadr moperands))
 508          (mPr-infix1 moperator (cddr moperands))
 509          (row-end "</mrow>")
 510 ))))
 511
 512 (defun mPr-infix1 (moperator moperands)
 513   (cond
 514     ((null moperands)
 515      (when (member 'trunc moperator :test #'equal)
 516        (p-op (getsymbol (car moperator)))
 517        (tprinc "<mo>&TripleDot;</mo>")))
 518     (t (p-op-oprd moperator (car moperands))
 519        (mPr-infix1 moperator (cdr moperands)))))
 520
 521 ;;      p-op-oprd is a function printing operator and operand consecutively
 522 ;;      ex      + x     when + is a infix op and x is oprd
 523
 524 (defun p-op-oprd (moperator moperand)
 525   (let ((op (car moperator)))
 526     (cond
 527       ((equal op 'mplus)
 528        (cond
 529          ((listp moperand)
 530           (cond
 531             ((equal (caar moperand) 'mminus) (tprinc "<mo>-</mo>")
 532              (mPr_engine (cadr moperand) 'mminus rop))
 533             (t (tprinc "<mo>+</mo>") (mPr_engine moperand 'mplus rop))))
 534          (t (tprinc "<mo>+</mo>") (mPr-atom moperand))))
 535       (t (p-op (getsymbol op))
 536          (mPr_engine moperand op op))))
 537 )
 538
 539 (defun p-op(symbol)
 540     (tprinc "<mo>")
 541     (tprinc symbol)
 542     (tprinc "</mo>")
 543 )
 544
 545 ;;      mPr-intgrate handles an integration expression
 546 ;;      It will detect that integrate function is called in short form
 547 ;; or long form example: integrate(x^4,x,0,inf) is a long form.
 548
 549 ;;short form
 550 ;;long form
 551 (defun mPr-integrate (mexpress)
 552   (setq mexpress (meval
 553     (list '($substitute) '((mminus) $inf) '$minf mexpress)))
 554   (cond
 555     ((equal (length mexpress) 3)
 556      (row-begin "<mrow>")(tprinc "<mo>&Integral;</mo>"))
 557     ((equal (length mexpress) 5)
 558      (row-begin "<mrow>")(tprinc "<msubsup><mo>&Integral;</mo>")
 559      (row-begin "<mrow>")
 560      (mPr_engine (cadddr mexpress) 'mparen 'mparen)
 561      (row-end "</mrow>")
 562      (tprinc "  ")
 563      (row-begin "<mrow>")
 564      (mPr_engine (car (cddddr mexpress)) 'mparen 'mparen)
 565      (row-end "</mrow>")
 566      (tprinc "</msubsup>"))
 567     (t (merror "Wrong NO. of Arguments")))
 568   (row-begin "<mrow>")
 569   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 570   (row-end "</mrow>")(tprinc "<mo>&InvisibleTimes;</mo><mo> &dd; </mo>")
 571   (mPr_engine (caddr mexpress) 'mparen rop)
 572   (row-end "</mrow>"))
 573
 574
 575 ;;      mPr-limit takes care the "limit(exp,var,val,dir)"
 576 (defun mPr-limit (mexpress)
 577   (setq mexpress (meval
 578     (list '($substitute) '((mminus) $inf) '$minf mexpress)))
 579   (row-begin "<mrow>")(tprinc "<munder><mo>lim</mo>")(row-begin "<mrow>")
 580   (mPr_engine (caddr mexpress) 'mparen 'mparen)
 581   (tprinc "<mo>&RightArrow;</mo>")
 582   (mPr_engine (cadddr mexpress) 'mparen 'mapren)
 583   (when (car (cddddr mexpress))
 584     (if (member (car (cddddr mexpress)) '($minus $plus) :test #'equal)
 585         (p-op (getsymbol (car (cddddr mexpress))))
 586         (merror "THE 4TH ARG MUST BE PLUS OR MINUS")))
 587   (row-end "</mrow>")(tprinc "</munder>")
 588   ;; (tprinc "<mo>&InvisibleTimes;</mo>")
 589   (mPr_engine (cadr mexpress) 'mparen rop)
 590   (row-end "</mrow>"))
 591 ;;      This function handles a macsyma list expression
 592 ;;
 593 (defun mPr-list (mexpress)
 594   (tprinc "<mo>[</mo>")
 595   (do ((l (cdr mexpress) (cdr l))) ((null l) (tprinc "<mo>]</mo>"))
 596     (mPr_engine (car l) 'mparen 'mparen)
 597     (when (not (lastelementp l)) (tprinc "<mo>,</mo>"))))
 598
 599
 600 ;;      This function is a subfunction of mPr-expt , mPr-function and
 601 ;; mPr-mqapply
 602 (defun mPr-listparen (mexpress)
 603   (row-begin "<mrow>")(tprinc "<mo>(</mo>")
 604   (do ((l mexpress (cdr l))) ((null l) (tprinc "<mo>)</mo>") (row-end "</mrow>"))
 605     (mPr_engine (car l) 'mparen 'mparen)
 606     (when (not (lastelementp l)) (tprinc "<mo>,</mo>"))))
 607
 608 ;;      mPr-matrix handles matrix function
 609 (defun mPr-matrix (mexpress)
 610   (row-begin "<mfenced open='(' close=')'><mtable>")
 611   (mapc #'(lambda (arg)
 612             (row-begin "<mtr>")
 613             (do ((l (cdr arg) (cdr l))) ((null l) (row-end "</mtr>"))
 614               (row-begin "<mtd>")
 615               (mPr_engine (car l) 'mparen 'mparen)
 616               (row-end "</mtd>")
 617               ))
 618         (cdr mexpress))
 619   (row-end "</mtable></mfenced>")
 620 )
 621
 622 (defun mPr-mqapply (mexpress)
 623   (mPr_engine (cadr mexpress) lop 'mfunction)
 624   (mPr-listparen (cddr mexpress)))
 625
 626 ;; this function handles the floating point number.
 627 ;; convert 1.2e20 to 1.2 \\cdot 10^{20}
 628 ;; is it ddd.ddde+EE
 629 ;; it is not. go with it as given
 630 (defun mPr-num (atom)
 631   (let (r firstpart exponent)
 632     (cond
 633       ((integerp atom) (tprinc "<mn>") (tprinc atom) (tprinc "</mn>"))
 634       (t (setq r (exploden atom))
 635          ;; Hmm. What if the exponent marker is something other than 'e' or 'E' ??
 636          (setq exponent (or (member #\e r) (member #\E r)))
 637          (cond
 638            ((null exponent) (tprinc "<mn>") (tprinc atom) (tprinc "</mn>"))
 639            (t (setq firstpart
 640                     (nreverse (cdr (or (member #\e (reverse r)) (member #\E (reverse r))))))
 641               (tprinc "<mn>")
 642               (mapc #'tpchar firstpart) (tprinc "</mn>")
 643               (tprinc "<mo>&CenterDot;</mo><msup><mn>10</mn> <mn>")
 644               (mapc #'tpchar (cdr exponent))
 645               (tprinc "</mn></msup>")))))))
 646
 647 ;;      this function puts parenthesis for the expression
 648 (defun mPr-paren (mexpress)
 649   (row-begin "<mrow>")(tprinc "<mo>(</mo>")
 650   (mPr_engine mexpress 'mparen 'mparen)
 651   (tprinc "<mo>)</mo>") (row-end "</mrow>"))
 652 ;;      this function handles "+" operator which is infix form
 653 ;;
 654 ;if -x or +x so call mPr-function
 655 (defun mPr-plus (mexpress)
 656   (let ((moperands (cdr mexpress))
 657         (flag_trunc (member 'trunc (car mexpress) :test #'eq)))
 658     (cond
 659       ((equal (length moperands) 1) (mPr-prefix mexpress))
 660       (t (row-begin "<mrow>")
 661          (mPr_engine (car moperands) lop 'mplus)
 662          (print_op_oprd (cadr moperands))
 663          (mPr-plus1 (cddr moperands) flag_trunc)
 664          (row-end "</mrow>")
 665       )
 666 )))
 667
 668 (defun mPr-plus1 (moperands flag_trunc)
 669   (cond
 670     ((null moperands) (when flag_trunc (tprinc "<mo>+</mo><mo>&TripleDot;</mo>")))
 671     (t (print_op_oprd (car moperands))
 672        (mPr-plus1 (cdr moperands) flag_trunc))))
 673
 674
 675 (defun print_op_oprd (moperand)
 676   (cond
 677     ((listp moperand)
 678      (cond
 679        ((equal (caar moperand) 'mminus) (tprinc "<mo>-</mo>")
 680         (mPr_engine (cadr moperand) 'mplus rop))
 681        (t (tprinc "<mo>+</mo>") (mPr_engine moperand 'mplus 'mparen))))
 682     (t (tprinc "<mo>+</mo>") (mPr-atom moperand))))
 683 ;;      mPr-postfix handles for postfix notation expression like factorial
 684 ;;
 685 (defun mPr-postfix (mexpress)
 686   (row-begin "<mrow>")
 687   (mPr_engine (cadr mexpress) lop (caar mexpress))
 688   (row-end "</mrow>")
 689   (p-op (getsymbol (caar mexpress))))
 690
 691 ;;      mPr-prefix is a function to handle a prefix notation form
 692 ;;
 693 (defun mPr-prefix (mexpress)
 694   (let ((op (caar mexpress)) (oprnd (cadr mexpress)))
 695     (row-begin "<mrow>")
 696     (p-op (getsymbol op))
 697     (mPr_engine oprnd op rop)
 698     (row-end "</mrow>")))
 699 ;;      this function takes care the quotient function or "/" sign
 700 ;;
 701 (defun mPr-quotient (mexpress)
 702   (row-begin "<mfrac><mrow>")
 703   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 704   (row-end "</mrow>")
 705   (row-begin "<mrow>")
 706   (mPr_engine (caddr mexpress) 'mparen 'mparen)
 707   (row-end "</mrow></mfrac>"))
 708
 709 (defun mPr-rat (mexpress) (mPr-quotient mexpress))
 710
 711 ;;      this function handles binomial coefficients
 712 ;;
 713 (defun mPr-binomial(mexpress)
 714     (row-begin "<mrow><mfenced open='(' close=')'><mfrac linethickness='0'><mrow>")
 715        (mPr_engine (cadr mexpress) 'mparen 'mparen)
 716        (tprinc "</mrow><mrow>")
 717        (mPr_engine (caddr mexpress) 'mparen 'mparen)
 718     (row-end  "</mrow></mfrac></mfenced></mrow>")
 719 )
 720
 721 ;;      this function handles sqrt
 722 ;;
 723 (defun mPr-sqrt (mexpress)
 724   (tprinc "<msqrt>")
 725   (mPr_engine (cadr mexpress) 'mparen 'mparen)
 726   (tprinc "</msqrt>"))
 727
 728 ;;      This function takes care both sum(exp,ind,lo,hi) and
 729 ;; product(exp,ind,lo,hi)
 730 ;;ind
 731 ;;low
 732 ;; hi
 733 ;;exp
 734 (defun mPr-sumprod (mexpress)
 735   (row-begin "<mrow>")(tprinc "<munderover>")
 736   (p-op (getsymbol (caar mexpress)))
 737   (row-begin "<mrow>")
 738   (mPr_engine (caddr mexpress) 'mparen 'mequal)
 739   (tprinc "<mo>=</mo>")
 740   (mPr_engine (meval
 741     (list '($substitute) '((mminus) $inf) '$minf (cadddr mexpress)))
 742     'mequal 'mparen)
 743   (row-end "</mrow>")
 744   (mPr_engine  (meval
 745     (list '($substitute) '((mminus) $inf) '$minf (car (cddddr mexpress))))
 746     'mparen 'mparen)
 747   (tprinc "</munderover>")
 748   (mPr_engine (cadr mexpress) 'mparen rop)
 749   (row-end "</mrow>"))
 750 ;;      mPr-times a function handle multiplication
 751 (defun mPr-times (mexpress)
 752   (let ((lop 'mtimes) (rop 'mtimes)) (mPr-infix mexpress)))
 753
 754 (defun mathml-presentation-lambda (mexpress)
 755   (let
 756     ((op (caar mexpress))
 757      (args (cdr (cadr mexpress)))
 758      (body (cddr mexpress)))
 759     (mPr_engine op 'mparen 'mparen)
 760     (if (= (length args) 1)
 761       (mPr_engine (car args) 'mparen 'mparen)
 762       (mPr-listparen args))
 763     (mPr_engine "." 'mparen 'mparen)
 764     (if (= (length body) 1)
 765       (mPr_engine (car body) 'mparen 'mparen)
 766       (mPr-listparen body))))
 767
 768 ;; An improvement on the default, but not much.
 769 ;; Could benefit from just a little more attention.
 770 (defun mathml-presentation-buildinfo (mexpress)
 771   (mPr_engine `(($matrix) ,@(mapcar #'(lambda (e) `((mlist) ,e)) (cdr mexpress))) 'mparen 'mparen))
 772
 773 ;;;;;;; Operators
 774
 775 (setup '(mlist (mPrprocess mPr-list)))
 776
 777 (setup '(mplus (mPrprocess mPr-plus) (mPr-lbp 100) (mPr-rbp 100)
 778                (chchr "+")))
 779
 780 (setup '(mminus (mPrprocess mPr-prefix) (mPr-lbp 100) (mPr-rbp 100)
 781                 (chchr "-")))
 782
 783 (setup '(mquote (mPrprocess mPr-prefix) (mPr-rbp 201) (chchr "'")))
 784
 785 (setup '(mand (mPrprocess mPr-infix) (mPr-lbp 60) (mPr-rbp 60)
 786               (chchr "and")))
 787
 788 (setup '(mor (mPrprocess mPr-infix) (mPr-lbp 50) (mPr-rbp 50)
 789              (chchr "or")))
 790
 791 (setup '(mnot (mPrprocess mPr-prefix) (mPr-rbp 70) (chchr "&not;")))
 792
 793 (setup '(mgreaterp (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 794             (chchr "&gt;")))
 795
 796 (setup '(mgeqp (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 797                (chchr "&ge;")))
 798
 799
 800 (setup '(mnotequal (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 801             (chchr "&NotEqual;")))
 802
 803 (setup '(mleqp (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 804                (chchr "&le;")))
 805
 806 (setup '(mlessp (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 807                 (chchr "&lt;")))
 808
 809 (setup '(msetq (mPrprocess mPr-infix) (mPr-lbp 180) (mPr-rbp 20)
 810                (chchr "&Assign;")))
 811
 812 (setup '(mset (mPrprocess mPr-infix) (mPr-lbp 180) (mPr-rbp 20)
 813                (chchr "&Assign;")))  ;;; This is not math
 814
 815 (setup '(mdefine (mPrprocess mPr-infix) (mPr-lbp 180) (mPr-rbp 20)
 816                  (chchr ":=")))
 817
 818 (setup '(mfactorial (mPrprocess mPr-postfix) (mPr-lbp 160) (chchr "!")))
 819
 820 (setup '(mabs (mPrprocess mPr-abs)))
 821
 822 (setup '(%abs (mPrprocess mPr-abs)))
 823
 824 (setup '($conjugate (mPrprocess mPr-conjugate)))
 825
 826 (setup '(mnctimes (mPrprocess mPr-infix) (mPr-lbp 110) (mPr-rbp 109)
 827             (chchr "&CenterDot;")))
 828
 829 (setup '(marrow (mPrprocess mPr-infix) (mPr-lbp 180) (mPr-rbp 20)
 830                 (chchr "&RightArrow;")))
 831
 832 (setup '(mrarrow (mPrprocess mPr-prefix) (mPr-lbp 180) (mPr-rbp 20)
 833                 (chchr "&RightArrow;")))
 834
 835 (setup '(mdif (mPrprocess mPr-infix) (mPr-lbp 100) (mPr-rbp 100)
 836               (chchr "-")))
 837
 838 (setup '(mtimes (mPrprocess mPr-times) (mPr-lbp 120) (mPr-rbp 120)
 839                 (chchr "&InvisibleTimes;")))
 840
 841 (setup '(mdottimes (mPrprocess mPr-infix) (mPr-lbp 120) (mPr-rbp 120)
 842             (chchr "&CenterDot;")))
 843
 844 (setup '(mexpt (mPrprocess mPr-expt) (mPr-lbp 140) (mPr-rbp 139)))
 845
 846 (setup '(mncexpt (mPrprocess mPr-expt) (mPr-lbp 135) (mPr-rbp 134)))
 847
 848 (setup '(%at (mPrprocess mPr-at)))
 849
 850 (setup '($at (mPrprocess mPr-at)))
 851
 852 (setup '($det (mPrprocess mPr-det)))
 853
 854 (setup '(%determinant (mPrprocess mPr-det)))
 855
 856 (setup '($binomial (mPrprocess mPr-binomial)))
 857
 858 (setup '(%binomial (mPrprocess mPr-binomial)))
 859
 860 (setup '(%sum (mPrprocess mPr-sumprod) (chchr "&Sum;")))
 861
 862 (setup '($sum (mPrprocess mPr-sumprod) (chchr "&Sum;")))
 863
 864 (setup '($product (mPrprocess mPr-sumprod) (chchr "&Prod;")))
 865
 866 (setup '(%product (mPrprocess mPr-sumprod) (chchr "&Prod;")))
 867
 868 (setup '($integrate (mPrprocess mPr-integrate) (chchr "&Integral;")))
 869
 870 (setup '(%integrate (mPrprocess mPr-integrate) (chchr "&Integral;")))
 871
 872 (setup '($diff (mPrprocess mPr-diff) (chchr "<mo>&dd;</mo>")))
 873
 874 (setup '(%derivative (mPrprocess mPr-diff) (chchr "<mo>&dd;</mo>")))
 875
 876 (setup '($limit (mPrprocess mPr-limit)))
 877
 878 (setup '(%limit (mPrprocess mPr-limit)))
 879
 880 (setup '($sqrt (mPrprocess mPr-sqrt) (chchr "&Sqrt;")))
 881
 882 (setup '(%sqrt (mPrprocess mPr-sqrt) (chchr "&Sqrt;")))
 883
 884 (setup '(%binomial (mPrprocess mPr-binomial)))
 885
 886 (setup '(mquotient (mPrprocess mPr-quotient) (mPr-lbp 122)
 887             (mPr-rbp 123) (chchr "<mo>/</mo>")))
 888
 889 (setup '(rat (mPrprocess mPr-rat) (mPr-lbp 120) (mPr-rbp 121)))
 890
 891 (setup '(mconc (mPrprocess mPr-infix) (chchr " ")))
 892
 893 (setup '(mparen (chchr " ")))
 894
 895 (setup '(mbrak (chchr " ")))
 896
 897 (setup '(mequal (mPrprocess mPr-infix) (mPr-lbp 80) (mPr-rbp 80)
 898                 (chchr "=")))
 899
 900 ;;(setup '(mmsubs (mPrprocess mPr-mmsubs) (chchr "&")))
 901
 902 (setup '(mqapply (mPrprocess mPr-mqapply)))
 903
 904 (setup '(mmfunct (mPrprocess mPr-funct)))
 905
 906 (setup '($matrix (mPrprocess mPr-matrix)))
 907
 908 (setup '(lambda (mPrprocess mathml-presentation-lambda)))
 909
 910 (setup '(%build_info (mPrprocess mathml-presentation-buildinfo)))
 911
 912 (setup '($%pi (chchr "&pi;")))
 913
 914 (setup '($%e (chchr "&ee;")))
 915
 916 (setup '($%gamma (chchr "&gamma;")))
 917
 918 (setup '($%phi (chchr "&phi;")))
 919
 920 (setup '(& (chchr "&amp;")))
 921
 922 (setup '(% (chchr "%")))
 923
 924 (setup '($ (chchr "$")))
 925
 926 (setup '(_ (chchr "_")))
 927
 928 (setup '($minus (chchr "-")))
 929
 930 (setup '($plus (chchr "+")))
 931 ;;
 932
 933 (setup '(mprog (chchr "block")))
 934
 935 (setup '($$block (chchr "block")))
 936
 937 (setup '($$boldif (chchr "if")))
 938
 939 (setup '($$boldthen (chchr "then")))
 940
 941 (setup '($$boldelse (chchr "else")))
 942
 943
 944 ;;;; routines to access these fields
 945
 946 ;;      The following are databases for special characters
 947
 948 (setf (get '$inf 'chchr) '"&infin;")
 949 ;;;(setf (get '$minf 'chchr) '"<mo>-</mo>&infin;")
 950
 951 ;;      lower case greek database
 952
 953 (setf (get '$alpha 'chchr) '"&alpha;")
 954 (setf (get '%alpha 'chchr) '"&alpha;")
 955 (setf (get '$beta 'chchr) '"&beta;")
 956 (setf (get '$gamma 'chchr) '"&gamma;")
 957 (setf (get '%gamma 'chchr) '"&gamma;")
 958 (setf (get '%gamma_incomplete 'chchr) '"&Gamma;")
 959 (setf (get '%gamma_incomplete_generalized 'chchr) '"&Gamma;")
 960 (setf (get '%gamma_incomplete_regularized 'chchr) '"Q")
 961 (setf (get '$gamma_incomplete_lower 'chchr) '"&gamma;")
 962 (setf (get '$delta 'chchr) '"&delta;")
 963 (setf (get '$epsilon 'chchr) '"&epsilon;")
 964 (setf (get '$varepsilon 'chchr) '"&varepsilon;")
 965 (setf (get '$zeta 'chchr) '"&zeta;")
 966 (setf (get '$eta 'chchr) '"&eta;")
 967 (setf (get '$theta 'chchr) '"&theta;")
 968 (setf (get '$vartheta 'chchr) '"&vartheta;")
 969 (setf (get '$iota 'chchr) '"&iota;")
 970 (setf (get '$kappa 'chchr) '"&kappa;")
 971 (setf (get '$lambda 'chchr) '"&lambda;")
 972 (setf (get 'lambda 'chchr) '"&lambda;")
 973 (setf (get '$mu 'chchr) '"&mu;")
 974 (setf (get '$nu 'chchr) '"&nu;")
 975 (setf (get '$xi 'chchr) '"&xi;")
 976 (setf (get '$pi 'chchr) '"&pi;")
 977 (setf (get '$varpi 'chchr) '"&varpi;")
 978 (setf (get '$rho 'chchr) '"&rho;")
 979 (setf (get '$varrho 'chchr) '"&varrho;")
 980 (setf (get '$sigma 'chchr) '"&sigma;")
 981 (setf (get '$varsigma 'chchr) '"&varsigma;")
 982 (setf (get '$tau 'chchr) '"&tau;")
 983 (setf (get '$upsilon 'chchr) '"&upsilon;")
 984 (setf (get '$phi 'chchr) '"&phi;")
 985 (setf (get '$varphi 'chchr) '"&varphi;")
 986 (setf (get '$chi 'chchr) '"&chi;")
 987 (setf (get '$psi 'chchr) '"&psi;")
 988 (setf (get '$omega 'chchr) '"&omega;")
 989
 990 ;;      Greek Upper Case Database
 991
 992 (setf (get '|$Alpha| 'chchr) '"&Alpha;")
 993 (setf (get '|$Gamma| 'chchr) '"&Gamma;")
 994 (setf (get '|$Delta| 'chchr) '"&Delta;")
 995 (setf (get '|$Theta| 'chchr) '"&Theta;")
 996 (setf (get '|$Lambda| 'chchr) '"&Lambda;")
 997 (setf (get '|$Xi| 'chchr) '"&Xi;")
 998 (setf (get '|$Pi| 'chchr) '"&Pi;")
 999 (setf (get '|$Sigma| 'chchr) '"&Sigma;")
1000 (setf (get '|$Upsilon| 'chchr) '"&Upsilon;")
1001 (setf (get '|$Phi| 'chchr) '"&Phi;")
1002 (setf (get '|$Psi| 'chchr) '"&Psi;")
1003 (setf (get '|$Omega| 'chchr) '"&Omega;")
1004 (setf (get '|$Re| 'chchr) '"&Re;")
1005 (setf (get '|$Im| 'chchr) '"&Im;")
1006
1007 ;;      Miscellaneous symbols
1008
1009 (setf (get '$aleph 'chchr) '"&aleph;")
1010 (setf (get '$hbar 'chchr) '"&hbar;")
1011 (setf (get '$%i 'chchr) '"&ii;")
1012 (setf (get '$%j 'chchr) '"&ij")
1013 (setf (get '$ell 'chchr) '"&ell;")
1014 (setf (get '$wp 'chchr) '"&wp;")
1015 (setf (get '$mho 'chchr) '"&mho;")
1016 (setf (get '$infty 'chchr) '"&infty;")
1017 (setf (get '$nabla 'chchr) '"&nabla;")
1018 (setf (get '$partial 'chchr) '"&PartialD;")
1019 (setf (get '$triangle 'chchr) '"&triangle;")
1020
1021
1022 (setup '(%sin (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sin")))
1023 (setup '(%cos (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cos")))
1024 (setup '(%tan (mPrprocess mPr-function) (mPr-rbp 110) (chchr"tan")))
1025 (setup '(%cot (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cot")))
1026 (setup '(%sec (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sec")))
1027 (setup '(%csc (mPrprocess mPr-function) (mPr-rbp 110) (chchr"csc")))
1028
1029 (setup '(%asin (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arcsin")))
1030 (setup '(%acos (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arccos")))
1031 (setup '(%atan (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arctan")))
1032 (setup '(%acot (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acot")))
1033 (setup '(%asec (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asec")))
1034 (setup '(%acsc (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acsc")))
1035 (setup '(%sinh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sinh")))
1036 (setup '(%cosh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cosh")))
1037 (setup '(%tanh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"tanh")))
1038 (setup '(%coth (mPrprocess mPr-function) (mPr-rbp 110) (chchr"coth")))
1039 (setup '(%sech (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sec")))
1040 (setup '(%csch (mPrprocess mPr-function) (mPr-rbp 110) (chchr"csch")))
1041
1042
1043 (setup '(%asinh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asinh")))
1044 (setup '(%acosh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acosh")))
1045 (setup '(%atanh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"atanh")))
1046 (setup '(%acoth (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acoth")))
1047 (setup '(%asech (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asec")))
1048 (setup '(%acsch (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acsch")))
1049
1050 (setup '(%ln (mPrprocess mPr-function) (mPr-rbp 110) (chchr"ln")))
1051 (setup '(%log (mPrprocess mPr-function) (mPr-rbp 110) (chchr"log")))
1052
1053 (setup '($sin (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sin")))
1054 (setup '($cos (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cos")))
1055 (setup '($tan (mPrprocess mPr-function) (mPr-rbp 110) (chchr"tan")))
1056 (setup '($cot (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cot")))
1057 (setup '($sec (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sec")))
1058 (setup '($csc (mPrprocess mPr-function) (mPr-rbp 110) (chchr"csc")))
1059
1060 (setup '($asin (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arcsin")))
1061 (setup '($acos (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arccos")))
1062 (setup '($atan (mPrprocess mPr-function) (mPr-rbp 110) (chchr"arctan")))
1063 (setup '($acot (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acot")))
1064 (setup '($asec (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asec")))
1065 (setup '($acsc (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acsc")))
1066
1067 (setup '($sinh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sinh")))
1068 (setup '($cosh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"cosh")))
1069 (setup '($tanh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"tanh")))
1070 (setup '($coth (mPrprocess mPr-function) (mPr-rbp 110) (chchr"coth")))
1071 (setup '($sech (mPrprocess mPr-function) (mPr-rbp 110) (chchr"sec")))
1072 (setup '($csch (mPrprocess mPr-function) (mPr-rbp 110) (chchr"csch")))
1073
1074 (setup '($asinh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asinh")))
1075 (setup '($acosh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acosh")))
1076 (setup '($atanh (mPrprocess mPr-function) (mPr-rbp 110) (chchr"atanh")))
1077 (setup '($acoth (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acoth")))
1078 (setup '($asech (mPrprocess mPr-function) (mPr-rbp 110) (chchr"asec")))
1079 (setup '($acsch (mPrprocess mPr-function) (mPr-rbp 110) (chchr"acsch")))
1080 (setup '($ln (mPrprocess mPr-function) (mPr-rbp 110) (chchr"ln")))
1081 (setup '($log (mPrprocess mPr-function) (mPr-rbp 110) (chchr"log")))
1082 (setup '(%gamma (mPrprocess mPr-gamma)))
1083
1084 ;;
1085 ;;
1086 ;;      set the preference feature
1087 ;;
1088 ($lessparen)
1089 (setq casep nil)                ;set to distinguish a capital or lower case
1090 (setq $mPrworksheet nil)        ;set TeX worksheet mode false
1091 (setq $lamPrworksheet nil)        ;set LaTeX worksheet mode false
1092 (setq $mPrlabelleft nil)        ;set Tex or LaTeX left Labeling mode false
1093 (setq $mPrdisplaytype t)        ;set default for TeX or LaTeX in display type
1094 (setq $mPrevaluate t)   ;set default for evaluating macsyma expression
1095 (setq $mPrautolabel nil) ;set autolabel mode off, can be set to be integer
1096 (setq $lamPrautolabel nil)      ;set LaTeX autolabel mode false
1097
1098 ;; The MathML presentation code has been loaded. Run each post-load hook. This
1099 ;; let other libraries hook in to the MathML library easily (doing so needs
1100 ;; SETUP and MPR_ENGINE to be defined).
1101 ;;
1102 ;; Each hook should be an idempotent thunk.
1103
1104 (when (boundp '*mathml-presentation-hook*)
1105   (dolist (hook (symbol-value '*mathml-presentation-hook*))
1106     (funcall hook)))