share/ezunits/ezunits.lisp

   1 ;; ezunits: yet another units package for Maxima
   2 ;; This program copyright 2008 by Robert Dodier.
   3 ;; I release this program under the terms of the
   4 ;; GNU General Public License.
   5
   6 (defprop $\`\` tex-infix tex)
   7
   8 ;; Process tex(a`b): throw away the backtick, texify a,
   9 ;; and texify b with all symbols in b output as mathrm.
  10
  11 (defun tex-ezunits (x l r)
  12   (setq l (tex (second x) l '("\\;") lop (caar x)))
  13   (tex (mathrm-ify (third x)) l r (caar x) rop))
  14
  15 ;; If a symbol has a texword property, preserve it.
  16 ;; Otherwise replace each symbol with a gensym which has a mathrm texword property.
  17
  18 (defun mathrm-ify (e)
  19   (let
  20     ((v (reverse (cdr ($listofvars e)))))
  21     (let
  22       ((L (mapcar #'(lambda (s)
  23                       (if (get s 'texword)
  24                         s
  25                         (let
  26                           ((g (gensym)))
  27                           (putprop
  28                             g
  29                             (concatenate
  30                               'string
  31                               "\\mathrm{"
  32                               (maybe-invert-string-case (symbol-name (stripdollar s)))
  33                               "}")
  34                             'texword)
  35                           g)))
  36                   v)))
  37       ($substitute `((mlist) ,@(mapcar #'(lambda (a b) `((mequal) ,a ,b)) v L)) e))))
  38
  39 (defprop $\` tex-ezunits tex)
  40
  41 (defun $odds (a) (cons '(mlist) (odds (cdr a) 1)))
  42
  43 (defun $evens (a) (cons '(mlist) (odds (cdr a) 0)))
  44
  45 ;; MathML presentation code integration.
  46 ;;
  47 ;; The MATHML-PRESENTATION-EZUNITS function is used to display an ezunits
  48 ;; expression. It should only be called after the MathML presentation library
  49 ;; has been loaded (and, as such, MPR_ENGINE will be fbound)
  50
  51 (defun mathml-presentation-ezunits (mexpress)
  52   (funcall (symbol-function 'mPr_engine)
  53            `((mtimes) ,(second mexpress) ,(third mexpress)) 'mparen 'mparen))
  54
  55 ;; The ezunits-setup-mathml thunk gets installed into *MATHML-PRESENTATION-HOOK*
  56 ;; and is an idempotent setup function that registers the mathml output for
  57 ;; ezunits expressions.
  58
  59 (defun ezunits-setup-mathml ()
  60   (funcall (symbol-function 'setup)
  61            '($\` (mPrprocess mathml-presentation-ezunits))))
  62
  63 ;; This is a re-implementation of Emacs's WITH-EVAL-AFTER-LOAD. If and when we
  64 ;; put a more general version of that into Maxima, use it here!
  65 ;;
  66 ;; Register a hook so we set up properly if the MathML code hasn't yet been
  67 ;; loaded.
  68 (setf (symbol-value '*mathml-presentation-hook*)
  69       (cons 'ezunits-setup-mathml
  70             (remove 'ezunits-setup-mathml
  71                     (when (boundp '*mathml-presentation-hook*)
  72                       (symbol-value '*mathml-presentation-hook*)))))
  73 ;; But make sure we do the right thing if it's been loaded already
  74 (when (fboundp 'mPr_engine)
  75   (ezunits-setup-mathml))