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