head	1.2;
access;
symbols
	pkgsrc-2013Q2:1.2.0.30
	pkgsrc-2013Q2-base:1.2
	pkgsrc-2012Q4:1.2.0.28
	pkgsrc-2012Q4-base:1.2
	pkgsrc-2011Q4:1.2.0.26
	pkgsrc-2011Q4-base:1.2
	pkgsrc-2011Q2:1.2.0.24
	pkgsrc-2011Q2-base:1.2
	pkgsrc-2009Q4:1.2.0.22
	pkgsrc-2009Q4-base:1.2
	pkgsrc-2008Q4:1.2.0.20
	pkgsrc-2008Q4-base:1.2
	pkgsrc-2008Q3:1.2.0.18
	pkgsrc-2008Q3-base:1.2
	cube-native-xorg:1.2.0.16
	cube-native-xorg-base:1.2
	pkgsrc-2008Q2:1.2.0.14
	pkgsrc-2008Q2-base:1.2
	pkgsrc-2008Q1:1.2.0.12
	pkgsrc-2008Q1-base:1.2
	pkgsrc-2007Q4:1.2.0.10
	pkgsrc-2007Q4-base:1.2
	pkgsrc-2007Q3:1.2.0.8
	pkgsrc-2007Q3-base:1.2
	pkgsrc-2007Q2:1.2.0.6
	pkgsrc-2007Q2-base:1.2
	pkgsrc-2007Q1:1.2.0.4
	pkgsrc-2007Q1-base:1.2
	pkgsrc-2006Q4:1.2.0.2
	pkgsrc-2006Q4-base:1.2;
locks; strict;
comment	@# @;


1.2
date	2006.12.15.19.24.30;	author drochner;	state dead;
branches;
next	1.1;

1.1
date	2006.10.23.09.42.23;	author drochner;	state Exp;
branches;
next	;


desc
@@


1.2
log
@update to 1.0.6.7
changes:
Better LaTeX export of elsart style and other fixes in the LaTeX converter
Several minor improvements in the graphical mode
Fixes for Maxima 5.10.0
@
text
@; $NetBSD: texmacs-maxima-5.10.0.lisp,v 1.1 2006/10/23 09:42:23 drochner Exp $

(in-package :maxima)
#+clisp (defvar *old-suppress-check-redefinition* 
	      custom:*suppress-check-redefinition*)
#+clisp (setf custom:*suppress-check-redefinition* t)
(setf *alt-display2d* 'texmacs)
(setf *prompt-prefix* "channel:promptlatex:\\red ")
(setf *prompt-suffix* "\\black")
;(setf *general-display-prefix* "verbatim:")
(setf *maxima-prolog* "verbatim:")
(setf *maxima-epilog* "latex:\\red The end\\black")
#-gcl(setf *debug-io* (make-two-way-stream *standard-input* *standard-output*))
#+(or cmu sbcl scl)
(setf *terminal-io* (make-two-way-stream *standard-input* *standard-output*))

;; Small changes to mactex.lisp for interfacing with TeXmacs
;; Andrey Grozin, 2001-2005

(defun main-prompt ()
  (format () "~A(~A~D) ~A" *prompt-prefix* 
    (tex-stripdollar $inchar) $linenum *prompt-suffix*))

(declare-top
	 (special lop rop ccol $gcprint $inchar)
	 (*expr tex-lbp tex-rbp))
(defconstant texport *standard-output*)

(defun tex-stripdollar (x)
  (let ((s (quote-% (maybe-invert-string-case (symbol-name (stripdollar x))))))
    (if (> (length s) 1)
      (concatenate 'string "\\mathrm{" s "}")
      s)))

(defprop mtimes "\\*" texsym)

(defun texmacs (x)
  (let ((ccol 1))
    (mapc #'myprinc
        (tex x '("latex:$\\displaystyle ") '("$
") 'mparen 'mparen))))

;; In order to allow cut-and-paste from output to input,
;; we should output \sin(x), not \sin x.

(map 'list #'(lambda (f) (remprop f 'tex) (remprop f 'tex-rbp))
  '(%sin %cos %tan %cot %sec %csc %sinh %cosh %tanh %coth %asin %acos %atan %exp %log))

(remprop '$pi 'texword)
(remprop '$gamma 'texword)
(setf (get '$%i 'texword) "\\mathi")
(setf (get '$%e 'texword) "\\mathe")

;; Also, we should output f(x)^2, not f^2(x)

(defun tex-mexpt (x l r)
  (let((nc (eq (caar x) 'mncexpt)))	; true if a^^b rather than a^b
    (setq l (if (and (numberp (cadr x)) (numneedsparen (cadr x)))
                (tex (cadr x) (cons "\\left(" l) '("\\right)") lop (caar x))
		(tex (cadr x) l nil lop (caar x)))
          r (if (mmminusp (setq x (nformat (caddr x))))
		;; the change in base-line makes parens unnecessary
		(if nc
		    (tex (cadr x) '("^ {-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
		    (tex (cadr x) '("^ {- ")(cons " }" r) 'mminus 'mparen))
		(if nc
		    (tex x (list "^{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
		    (if (and (integerp x) (< x 10))
			(tex x (list "^")(cons "" r) 'mparen 'mparen)
			(tex x (list "^{")(cons "}" r) 'mparen 'mparen)))))
    (append l r)))

;; binomial coefficients

(defun tex-choose (x l r)
  `(,@@l
    "\\binom{"
    ,@@(tex (cadr x) nil nil 'mparen 'mparen)
    "}{"
    ,@@(tex (caddr x) nil nil 'mparen 'mparen)
    "}"
    ,@@r))

;; Integrals, sums, products

(defun tex-int (x l r)
  (let ((s1 (tex (cadr x) nil nil 'mparen 'mparen)) ;;integrand delims / & d
	(var (tex (caddr x) nil nil 'mparen rop))) ;; variable
    (cond((= (length x) 3)
	  (append l `("\\int {" ,@@s1 "}{\\;\\mathd\\;" ,@@var "}\\big.") r))
	 (t ;; presumably length 5
	  (let ((low (tex (nth 3 x) nil nil 'mparen 'mparen))
		;; 1st item is 0
		(hi (tex (nth 4 x) nil nil 'mparen 'mparen)))
	    (append l `("\\int_{" ,@@low "}^{" ,@@hi "}{" ,@@s1 "\\;\\mathd\\;" ,@@var "}\\big.") r))))))

(defun tex-sum(x l r)
  (let ((op (cond ((eq (caar x) '%sum) "\\sum_{")
		  ((eq (caar x) '%product) "\\prod_{")
		  ;; extend here
		  ))
	;; gotta be one of those above
	(s1 (tex (cadr x) nil nil 'mparen rop))	;; summand
	(index ;; "index = lowerlimit"
	 (tex `((mequal simp) ,(caddr x),(cadddr x)) nil nil 'mparen 'mparen))
	(toplim (tex (car(cddddr x)) nil nil 'mparen 'mparen)))
    (append l `( ,op ,@@index "}^{" ,@@toplim "}{" ,@@s1 "}\\big.") r)))

(defun tex-lsum(x l r)
  (let ((op (cond ((eq (caar x) '%lsum) "\\sum_{")
		  ;; extend here
		  ))
	;; gotta be one of those above 
	(s1 (tex (cadr x) nil nil 'mparen rop))	;; summand
	(index ;; "index = lowerlimit"
	 (tex `((min simp) , (caddr x), (cadddr x))  nil nil 'mparen 'mparen)))
    (append l `( ,op ,@@index "}}{" ,@@s1 "}\\big.") r)))

;; This is a hack for math input of integrals, sums, products

(defmfun $tmint (a b f x) ($integrate f x a b))

(defmspec $tmsum (l) (setq l (cdr l))
  (if (= (length l) 3)
      (dosum (caddr l) (cadar l) (meval (caddar l)) (meval (cadr l)) t)
      (wna-err '$tmsum)))

(defmspec $tmlsum (l) (setq l (cdr l))
  (or (= (length l) 2) (wna-err '$tmlsum))
  (let ((form (cadr l))
        (ind (cadar l))
        (lis (meval (caddar l)))
        (ans 0))
       (or (symbolp ind) (merror "Second argument not a variable ~M" ind))
       (cond (($listp lis)
              (loop for v in (cdr lis)
                    with lind = (cons ind nil)
                    for w = (cons v nil)
                    do
                    (setq ans (add* ans  (mbinding (lind w) (meval form)))))
                   ans)
           (t `((%lsum) ,form ,ind ,lis)))))

(defmspec $tmprod (l) (setq l (cdr l))
  (if (= (length l) 3)
      (dosum (caddr l) (cadar l) (meval (caddar l)) (meval (cadr l)) nil)
      (wna-err '$tmprod)))

#+clisp (setf custom:*suppress-check-redefinition*
	      *old-suppress-check-redefinition*)
@


1.1
log
@support maxima-5.10, from a post to the maxima mailing list
by Andrey Grozin
bump PKGREVISION
@
text
@d1 1
a1 1
; $NetBSD$
@