interfaces/emacs/emaxima/emaxima.lisp

   1 ;; This is mostly from texmacs-maxima-5.9.2.lisp
   2 ;;    Small changes to mactex.lisp for interfacing with TeXmacs
   3 ;;    Andrey Grozin, 2001-2005
   4
   5 (in-package :maxima)
   6
   7 (setq $maxima_frontend "emaxima")
   8 (setq $maxima_frontend_version *autoconf-version*)
   9
  10 (declare-top
  11          (special lop rop $gcprint $inchar)
  12          (*expr tex-lbp tex-rbp))
  13
  14 (defun main-prompt ()
  15   (format () "(~A~D) "
  16     (print-invert-case (stripdollar $inchar)) $linenum))
  17
  18 (defun tex-stripdollar (x)
  19   (let ((s (quote-% (maybe-invert-string-case (symbol-name (stripdollar x))))))
  20     (if (> (length s) 1)
  21         (concatenate 'string "\\mathrm{" s "}")
  22       s)))
  23 ;(defun tex-stripdollar (sym)
  24 ;  (or (symbolp sym) (return-from tex-stripdollar sym))
  25 ;  (let* ((name (quote-% (print-invert-case sym)))
  26 ;      (name1 (if (memq (elt name 0) '(#\$ #\&)) (subseq name 1) name))
  27 ;      (l (length name1)))
  28 ;    (if (eql l 1) name1 (concatenate 'string "\\mathrm{" name1 "}"))))
  29
  30
  31 ;; Also, we should output f(x)^2, not f^2(x)
  32
  33 (defun tex-mexpt (x l r)
  34   (let((nc (eq (caar x) 'mncexpt)))     ; true if a^^b rather than a^b
  35     (setq l (if (and (numberp (cadr x)) (numneedsparen (cadr x)))
  36                 (tex (cadr x) (cons "\\left(" l) '("\\right)") lop (caar x))
  37                 (tex (cadr x) l nil lop (caar x)))
  38           r (if (mmminusp (setq x (nformat (caddr x))))
  39                 ;; the change in base-line makes parens unnecessary
  40                 (if nc
  41                     (tex (cadr x) '("^ {-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
  42                     (tex (cadr x) '("^ {- ")(cons " }" r) 'mparen 'mparen))
  43                 (if nc
  44                     (tex x (list "^{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
  45                     (if (and (integerp x) (< x 10))
  46                         (tex x (list "^")(cons "" r) 'mparen 'mparen)
  47                         (tex x (list "^{")(cons "}" r) 'mparen 'mparen)))))
  48     (append l r)))
  49
  50 ;; binomial coefficients
  51
  52 (defun tex-choose (x l r)
  53   `(,@l
  54     "\\binom{"
  55     ,@(tex (cadr x) nil nil 'mparen 'mparen)
  56     "}{"
  57     ,@(tex (caddr x) nil nil 'mparen 'mparen)
  58     "}"
  59     ,@r))
  60
  61 ;; Integrals, sums, products
  62
  63 (defun tex-int (x l r)
  64   (let ((s1 (tex (cadr x) nil nil 'mparen 'mparen)) ;;integrand delims / & d
  65         (var (tex (caddr x) nil nil 'mparen rop))) ;; variable
  66     (cond((= (length x) 3)
  67           (append l `("\\int {" ,@s1 "}{\\;d" ,@var "}\\big.") r))
  68          (t ;; presumably length 5
  69           (let ((low (tex (nth 3 x) nil nil 'mparen 'mparen))
  70                 ;; 1st item is 0
  71                 (hi (tex (nth 4 x) nil nil 'mparen 'mparen)))
  72             (append l `("\\int_{" ,@low "}^{" ,@hi "}{" ,@s1 "\\;d" ,@var "}\\big.") r))))))
  73
  74 (defun tex-sum(x l r)
  75   (let ((op (cond ((eq (caar x) '%sum) "\\sum_{")
  76                   ((eq (caar x) '%product) "\\prod_{")
  77                   ;; extend here
  78                   ))
  79         ;; gotta be one of those above
  80         (s1 (tex (cadr x) nil nil 'mparen rop)) ;; summand
  81         (index ;; "index = lowerlimit"
  82          (tex `((mequal simp) ,(caddr x),(cadddr x)) nil nil 'mparen 'mparen))
  83         (toplim (tex (car(cddddr x)) nil nil 'mparen 'mparen)))
  84     (append l `( ,op ,@index "}^{" ,@toplim "}{" ,@s1 "}\\big.") r)))
  85
  86 (defun tex-lsum(x l r)
  87   (let ((op (cond ((eq (caar x) '%lsum) "\\sum_{")
  88                   ;; extend here
  89                   ))
  90         ;; gotta be one of those above
  91         (s1 (tex (cadr x) nil nil 'mparen rop)) ;; summand
  92         (index ;; "index = lowerlimit"
  93          (tex `((min simp) , (caddr x), (cadddr x))  nil nil 'mparen 'mparen)))
  94     (append l `( ,op ,@index "}}{" ,@s1 "}\\big.") r)))
  95
  96 ;; This is a hack for math input of integrals, sums, products
  97
  98 (defmfun $tmint (a b f x) ($integrate f x a b))
  99
 100 (defmspec $tmsum (l) (setq l (cdr l))
 101   (if (= (length l) 3)
 102       (dosum (caddr l) (cadar l) (meval (caddar l)) (meval (cadr l)) t)
 103       (wna-err '$tmsum)))
 104
 105 (defmspec $tmlsum (l) (setq l (cdr l))
 106   (or (= (length l) 2) (wna-err '$tmlsum))
 107   (let ((form (cadr l))
 108         (ind (cadar l))
 109         (lis (meval (caddar l)))
 110         (ans 0))
 111        (or (symbolp ind) (merror "Second argument not a variable ~M" ind))
 112        (cond (($listp lis)
 113               (loop for v in (cdr lis)
 114                     with lind = (cons ind nil)
 115                     for w = (cons v nil)
 116                     do
 117                     (setq ans (add* ans  (mbinding (lind w) (meval form)))))
 118                    ans)
 119            (t `((%lsum) ,form ,ind ,lis)))))
 120
 121 (defmspec $tmprod (l) (setq l (cdr l))
 122   (if (= (length l) 3)
 123       (dosum (caddr l) (cadar l) (meval (caddar l)) (meval (cadr l)) nil)
 124       (wna-err '$tmprod)))
 125
 126 (defun tex-mlabel (x l r)
 127   (tex (caddr x)
 128     (append l
 129       (if (cadr x)
 130           (list (format nil "(~A) "
 131                         (print-invert-case (stripdollar (cadr x)))))
 132         nil))
 133     r 'mparen 'mparen))
 134
 135 (defun qndispla (form)
 136   (let (($display2d nil))
 137     (displa form)))
 138
 139 (defun latex (x)
 140   (mapc #'princ
 141         (if (and (listp x) (cdr x)
 142                  (equal (string-right-trim '(#\Space) (cadr x)) "Is"))
 143            (qndispla x)
 144           (tex x '("") '("
 145 ") 'mparen 'mparen))))
 146
 147 (let ((old-displa (symbol-function 'displa)))
 148   (defun displa (form)
 149     (if (eq $display2d '$emaxima)
 150         (latex form)
 151       (funcall old-displa form))))