11
12
; (declare (special $prompt))
12
13
; (format nil "~A" (STRIPDOLLAR $PROMPT)))
14
(DEFMFUN DISPLA (FORM &aux #+kcl(form form))
15
(IF (OR (NOT #.TTYOFF) #.WRITEFILEP)
16
(cond #+Franz ($typeset (apply #'$photot (list form)))
17
((eq $display2d '$emaxima) (latex form))
20
(LINEARRAY (IF DISPLAYP (MAKE-array 80.) LINEARRAY))
21
(MRATP (CHECKRAT FORM))
22
(#.WRITEFILEP #.WRITEFILEP)
23
(MAXHT 1) (MAXDP 0) (WIDTH 0)
24
(HEIGHT 0) (DEPTH 0) (LEVEL 0) (SIZE 2)
25
(BREAK 0) (RIGHT 0) (LINES 1) BKPT
26
(BKPTWD 0) (BKPTHT 1) (BKPTDP 0) (BKPTOUT 0)
28
(MOREFLUSH D-MOREFLUSH)
32
(PROGN (SETQ FORM (DIMENSION FORM
33
NIL 'MPAREN 'MPAREN 0 0))
34
(CHECKBREAK FORM WIDTH)
35
(OUTPUT FORM (IF (AND (NOT $LEFTJUST) (= 2 LINES))
36
(f- LINEL (f- WIDTH BKPTOUT))
38
(IF (AND SMART-TTY (NOT (AND SCROLLP (NOT $CURSORDISP)))
39
(> (CAR (CURSORPOS)) (f- TTYHEIGHT 3)))
40
(LET (#.writefilep) (MTERPRI))))
41
;; make sure the linearray gets cleared out.
43
(T (LINEAR-DISPLA FORM)))))
45
15
(defun break-dbm-loop (at)
47
17
(*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*))
90
(setq $display2d 'true)
60
;(setq $display2d 'true)
93
63
;; (c) copyright 1987, Richard J. Fateman
94
64
;; Small changes for interfacing with TeXmacs: Andrey Grozin, 2001
95
65
;; Yet more small changes for interfacing with imaxima: Jesper Harder 2001
98
(special lop rop ccol $gcprint $inchar)
99
(*expr tex-lbp tex-rbp))
100
(defconstant texport t)
102
;;; myprinc is an intelligent low level printing routine. it keeps track of
103
;;; the size of the output for purposes of allowing the TeX file to
104
;;; have a reasonable line-line. myprinc will break it at a space
105
;;; once it crosses a threshold.
106
;;; this has nothign to do with breaking the resulting equations.
108
;- arg: chstr - string or number to princ
109
;- scheme: This function keeps track of the current location
110
;- on the line of the cursor and makes sure
111
;- that a value is all printed on one line (and not divided
112
;- by the crazy top level os routines)
114
(defun myprinc (chstr)
116
(cond ((greaterp (plus (length (setq chlst (exploden chstr)))
119
(terpri texport) ;would have exceeded the line length
121
(myprinc " ") ; lead off with a space for safety
122
)) ;so we split it up.
123
(do ((ch chlst (cdr ch))
124
(colc ccol (add1 colc)))
125
((null ch) (setq ccol colc))
126
(tyo (car ch) texport))))
129
(cond (texport (terpri texport))
66
;; Even more small changes for emaxima: Jay Belanger 2003
133
69
(defun tex (x l r lop rop)
134
70
;; x is the expression of interest; l is the list of strings to its
190
126
((eql l 1) (myquote pname))
191
127
(t (concatenate 'string "\\mathrm{" (myquote pname) "}")))))
193
(defun texnumformat(atom) ;; 10/14/87 RJF convert 1.2e20 to 1.2 \cdot 10^{20}
194
(let(r firstpart exponent)
195
(cond ((integerp atom)atom)
196
(t (setq r (explode atom))
197
(setq exponent (memq 'e r)) ;; is it ddd.ddde+EE
198
(cond ((null exponent) atom); it is not. go with it as given
199
(t (setq firstpart (nreverse (cdr (memq 'e (reverse r)))))
200
(strcat (apply #'strcat firstpart )
202
(apply #'strcat (cdr exponent))
129
(defun strcat (&rest args)
130
(apply #'concatenate 'string (mapcar #'string args)))
132
;; 10/14/87 RJF convert 1.2e20 to 1.2 \cdot 10^{20}
133
;; 03/30/01 RLT make that 1.2 \times 10^{20}
134
(defun texnumformat(atom)
135
(let (r firstpart exponent)
136
(cond ((integerp atom)
139
(setq r (explode atom))
140
(setq exponent (member 'e r :test #'string-equal));; is it ddd.ddde+EE
141
(cond ((null exponent)
142
;; it is not. go with it as given
146
(nreverse (cdr (member 'e (reverse r) :test #'string-equal))))
147
(strcat (apply #'strcat firstpart )
149
(apply #'strcat (cdr exponent))
205
152
(defun tex-paren (x l r)
206
153
(tex x (append l '("\\left(")) (cons "\\right)" r) 'mparen 'mparen))
213
160
(setq f (caar x)))
214
(setq l (tex (texword f) l nil lop 'mfunction)
216
r (nconc (tex-list (cdr x) nil (list "}") ",") r))
217
(nconc l (list "_{") r )))
162
;; subscript is an atom -- don't use \isubscript
164
(setq l (tex (texword f) l nil lop 'mfunction)
165
r (nconc (tex-list (cdr x) nil (list "}") ",") r))
166
(nconc l (list "_{") r))
167
(setq l (tex (texword f) (append l (list "\\isubscript{")) nil lop 'mfunction)
168
r (nconc (tex-list (cdr x) nil (list "}") ",") r))
169
(nconc l (list "}{") r ))))
219
171
;; we could patch this so sin x rather than sin(x), but instead we made sin a prefix
234
186
(setq nl (nconc nl (tex (car x) l r 'mparen 'mparen)))
236
; (setq nl (nconc nl (tex (car x) l (list sym) 'mparen 'mparen))
237
(setq nl (nconc nl (tex (car x) l (list (concat sym "\\linebreak[0]")) 'mparen 'mparen))
188
;; (setq nl (nconc nl (tex (car x) l (list sym) 'mparen 'mparen))
189
(setq nl (nconc nl (tex (car x) l (list (concatenate 'string sym "\\linebreak[0]")) 'mparen 'mparen))
241
193
(defun tex-prefix (x l r)
379
331
;; which should be sin^2 x rather than (sin x)^2 or (sin(x))^2.
380
332
;; yet we must not display (a+b)^2 as +^2(a,b)...
381
333
;; or (sin(x))^(-1) as sin^(-1)x, which would be arcsine x
382
(cond ;; this whole clause
383
;; should be deleted if this hack is unwanted and/or the
334
(cond ;; this whole clause
335
;; should be deleted if this hack is unwanted and/or the
384
336
;; time it takes is of concern.
385
337
;; it shouldn't be too expensive.
386
338
((and (eq (caar x) 'mexpt) ; don't do this hack for mncexpt
400
352
; inverse of f, if written f^-1 x
401
353
; what else? f(x)^(1/2) is sqrt(f(x)), ??
403
(setq l (tex `((mexpt) ,f ,expon) l nil 'mparen 'mparen))
405
(if (and (null (cdr bascdr)) (eq (get f 'tex) 'tex-prefix))
406
(car bascdr) (cons '(mprogn) bascdr))
408
(t nil))))) ; won't doit. fall through
409
(t (setq l (tex (cadr x) l nil lop (caar x))
410
r (if (mmminusp (setq x (nformat (caddr x))))
411
;; the change in base-line makes parens unnecessary
413
(tex (cadr x) '("^ {-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
414
(tex (cadr x) '("^ {- ")(cons " }" r) 'mparen 'mparen))
416
(tex x (list "^{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
417
(tex x (list "^{")(cons "}" r) 'mparen 'mparen))))))
355
(setq l (append (tex f l nil lop 'mexpt)
356
(tex expon (list "^{")
357
(cons " }" nil) 'mparen 'mparen)))
358
(if (and (null (cdr bascdr))
359
(eq (get f 'tex) 'tex-prefix))
360
(setq r (tex (car bascdr) nil r f 'mparen))
361
(setq r (tex (cons '(mprogn) bascdr) nil r 'mparen 'mparen)))
363
(t nil))))) ; won't doit. fall through
366
;; Don't use \iexpt when exponent is an atom
368
(setq l (tex (cadr x) l nil lop (caar x))
369
r (if (mmminusp (setq x (nformat (caddr x))))
370
;; the change in base-line makes parens unnecessary
372
(tex (cadr x) '("^ {-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
373
(tex (cadr x) '("^ {- ")(cons " }" r) 'mparen 'mparen))
375
(tex x (list "^{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
376
(tex x (list "^{")(cons "}" r) 'mparen 'mparen))))
378
(setq l (tex (cadr x) (append l (list "\\iexpt{")) nil lop (caar x))
379
r (if (mmminusp (setq x (nformat (caddr x))))
380
;; the change in base-line makes parens unnecessary
382
(tex (cadr x) '("{-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
383
(tex (cadr x) '("{- ")(cons " }" r) 'mparen 'mparen))
385
(tex x (list "{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
386
(tex x (list "{") (cons "}" r) 'mparen 'mparen))))
387
(append l (list "}") r))))))
420
389
(defprop mncexpt tex-mexpt tex)
453
422
(defun tex-mquotient (x l r)
454
423
(if (or (null (cddr x)) (cdddr x)) (wna-err (caar x)))
455
(setq l (tex (cadr x) (append l '("{{")) nil 'mparen 'mparen)
456
;the divide bar groups things
457
r (tex (caddr x) (list "}\\over{") (append '("}}")r) 'mparen 'mparen))
424
(cond ((and (atom (cadr x)) (atom (caddr x)))
425
;; both denom and numerator are atoms
426
(setq l (tex (cadr x) (append l '("\\frac{")) nil nil nil) ;;fixme
427
r (tex (caddr x) (list "}{") (append '("}")r) 'mparen 'mparen)))
429
;; numerator is an atom
430
(setq l (tex (cadr x) (append l '("\\frac{")) nil 'mparen 'mparen)
431
r (tex (caddr x) (list "}{") (append '("}")r) 'mparen 'mparen)))
434
(setq l (tex (cadr x) (append l '("\\frac{")) nil 'mparen 'mparen)
435
r (tex (caddr x) (list "}{") (append '("}")r) 'mparen 'mparen)))
438
(setq l (tex (cadr x) (append l '("\\frac{")) nil 'mparen 'mparen)
439
r (tex (caddr x) (list "}{") (append '("}")r) 'mparen 'mparen))))
460
442
(defprop $matrix tex-matrix tex)
527
509
(sub (tex (caddr x) nil nil 'mparen 'mparen)))
528
510
(append l '("\\left.") s1 '("\\right|_{") sub '("}") r)))
530
;; (defprop mbox tex-mbox tex)
532
;; (defun tex-mbox (x l r)
533
;; (append l '("\\fbox{") (tex (cadr x) nil nil 'mparen 'mparen) '("}"))) ; jh
512
(defprop mbox tex-mbox tex)
514
(defun tex-mbox (x l r)
515
(append l '("\\boxed{") (tex (cadr x) nil nil 'mparen 'mparen) '("}") r))
517
(defprop mlabox tex-mlabox tex)
519
(defun tex-mlabox (x l r)
520
(append l '("\\stackrel{") (tex (caddr x) nil nil 'mparen 'mparen)
521
'("}{\\boxed{") (tex (cadr x) nil nil 'mparen 'mparen) '("}}") r)) ; jh
535
523
;;binomial coefficients
647
635
(%asin "\\arcsin ")
648
636
(%acos "\\arccos ")
649
637
(%atan "\\arctan ")
638
(%acot "\\operatorname{arccot}")
639
(%asec "\\operatorname{arcsec}")
640
(%acsc "\\operatorname{arccsc}")
650
641
(%sinh "\\sinh ")
651
642
(%cosh "\\cosh ")
652
643
(%tanh "\\tanh ")
653
644
(%coth "\\coth ")
654
(%sech "{\\rm sech}") ;; jah
645
(%sech "\\operatorname{sech}")
646
(%csch "\\operatorname{csch}")
647
(%asinh "\\operatorname{arcsinh}")
648
(%acosh "\\operatorname{arccosh}")
649
(%atanh "\\operatorname{arctanh}")
650
(%acoth "\\operatorname{arccoth}")
651
(%asech "\\operatorname{arcsech}")
652
(%acsch "\\operatorname{arccsch}")
653
(%determinant "\\det ")
657
656
;; (%erf "{\\rm erf}") this would tend to set erf(x) as erf x. Unusual
677
676
(difflist (cddr x)) ;; list of derivs e.g. (x 1 y 2)
678
677
(ords (odds difflist 0)) ;; e.g. (1 2)
679
678
(vars (odds difflist 1)) ;; e.g. (x y)
680
(numer `((mexpt) $|d| ((mplus) ,@ords))) ; d^n numerator
679
(numer `((mexpt) ,dsym ((mplus) ,@ords))) ; d^n numerator
681
680
(denom (cons '(mtimes)
682
681
(mapcan #'(lambda(b e)
683
682
`(,dsym ,(simplifya `((mexpt) ,b ,e) nil)))
733
732
`("\\mathbf{do}" ,(eighth x))))
735
734
(defun texmdoin (x)
736
(nconc `("\\mathbf{for}" ,(second x) $|in| ,(third x))
735
(nconc `("\\mathbf{for}" ,(second x) "\\mathbf{in}" ,(third x))
737
736
(cond ((sixth x) `("\\mathbf{thru}" ,(sixth x))))
738
737
(cond ((null (seventh x)) nil)
739
738
((eq 'mnot (caar (seventh x)))
770
769
(append l (list "\\verb|" (make-string (cadr x) :initial-element #\space) "|") r))
772
771
; jh: verb & mbox
772
(defun qndispla (form)
773
(let (($display2d nil))
777
(if (and (listp x) (cdr x) (stringp (cadr x))
778
(equal (string-right-trim '(#\Space) (cadr x)) "Is"))
779
(tex x '("") '("") 'mparen 'mparen)
781
") 'mparen 'mparen)))
777
;; (princ x) ;; uncomment to debug.
779
(if (and (listp x) (cdr x)
780
(equal (string-right-trim '(#\Space) (cadr x)) "Is"))
781
(qndispla x) ;(tex x '("") '("") 'mparen 'mparen)
783
") 'mparen 'mparen))))
785
(let ((old-displa (symbol-function 'displa)))
787
(if (eq $display2d '$emaxima)
789
(funcall old-displa form))))
added
removed
interfaces/emacs/emaxima/emaxima.lisp
