1; Modifications of tex properties and formatting functions to yield output suitable for OpenOffice formula writer.
2; Modifications to src/mactex.lisp made by Dieter Schuster,
3; extracted into this file by Robert Dodier.
4; Lines beginning with ";-" are lines which have been modified.
5; In addition, all of the defprops here have been modified.
6
7; Usage:
8;  load (tex2ooo);
9;  tex (expr);
10
11
12(declare-top
13 (special lop rop ccol $gcprint texport $labels $inchar))
14
15(defun quote-% (sym)
16  (let* ((strsym (string sym))
17         (pos (position-if #'(lambda (c) (find c "%_")) strsym)))
18    (if pos
19;-      (concatenate 'string (subseq strsym 0 pos) "\\" (subseq strsym pos (1+ pos))
20        (concatenate 'string (subseq strsym 0 pos) "" (subseq strsym pos (1+ pos))
21                           (quote-% (subseq strsym (1+ pos))))
22      strsym)))
23
24(defun tex1 (mexplabel &optional filename ) ;; mexplabel, and optional filename
25  (prog (mexp  texport $gcprint ccol x y itsalabel)
26     ;; $gcprint = nil turns gc messages off
27     (setq ccol 1)
28     (cond ((null mexplabel)
29	    (displa " No eqn given to TeX")
30	    (return nil)))
31     ;; collect the file-name, if any, and open a port if needed
32     (setq texport (cond((null filename) *standard-output* ) ; t= output to terminal
33			(t
34			 (open (string (print-invert-case (stripdollar filename)))
35			       :direction :output
36			       :if-exists :append
37			       :if-does-not-exist :create))))
38     ;; go back and analyze the first arg more thoroughly now.
39     ;; do a normal evaluation of the expression in macsyma
40     (setq mexp (meval mexplabel))
41     (cond ((member mexplabel $labels :test #'eq)	; leave it if it is a label
42	    (setq mexplabel (concatenate 'string "(" (print-invert-case (stripdollar mexplabel))
43					 ")"))
44	    (setq itsalabel t))
45	   (t (setq mexplabel nil)))	;flush it otherwise
46
47     ;; maybe it is a function?
48     (cond((symbolp (setq x mexp)) ;;exclude strings, numbers
49	   (setq x ($verbify x))
50	   (cond ((setq y (mget x 'mexpr))
51		  (setq mexp (list '(mdefine) (cons (list x) (cdadr y)) (caddr y))))
52		 ((setq y (mget x 'mmacro))
53		  (setq mexp (list '(mdefmacro) (cons (list x) (cdadr y)) (caddr y))))
54		 ((setq y (mget x 'aexpr))
55		  (setq mexp (list '(mdefine) (cons (list x 'array) (cdadr y)) (caddr y)))))))
56     (cond ((and (null(atom mexp))
57		 (member (caar mexp) '(mdefine mdefmacro) :test #'eq))
58	    (if mexplabel (setq mexplabel (quote-% mexplabel)))
59	    (format texport "|~%" )	;delimit with |marks
60	    (cond (mexplabel (format texport "~a " mexplabel)))
61	    (mgrind mexp texport)	;write expression as string
62	    (format texport ";|~%"))
63	   ((and
64	     itsalabel ;; but is it a user-command-label?
65	     (<= (length (string $inchar)) (length (string mexplabel)))
66	     (string= (subseq (string $inchar) 1 (length (string $inchar)))
67		      (subseq (string mexplabel) 1 (length (string $inchar))))
68	     ;; Check to make sure it isn't an outchar in disguise
69	     (not
70	      (and
71	       (<= (length (string $outchar)) (length (string mexplabel)))
72	       (string= (subseq (string $outchar) 1 (length (string $outchar)))
73			(subseq (string mexplabel) 1 (length (string $outchar)))))))
74	    ;; aha, this is a C-line: do the grinding:
75	    (format texport "~%|~a " mexplabel) ;delimit with |marks
76	    (mgrind mexp texport)	;write expression as string
77	    (format texport ";|~%"))
78	   (t
79	    (if mexplabel (setq mexplabel (quote-% mexplabel)))
80					; display the expression for TeX now:
81;-	    (myprinc "$$")
82  	    (myprinc "" texport)
83	    (mapc #'(lambda (x) (myprinc x texport))
84		  ;;initially the left and right contexts are
85		  ;; empty lists, and there are implicit parens
86		  ;; around the whole expression
87		  (tex mexp nil nil 'mparen 'mparen))
88	    (cond (mexplabel
89;-		   (format texport "\\leqno{\\tt ~a}" mexplabel)))
90;-	    (format texport "$$")))
91  		   (format texport "" mexplabel)))
92  	    (format texport "")))
93     (terpri texport)
94     (cond (filename   ; and close port if not terminal
95	    (close texport)))
96     (return mexplabel)))
97
98(defun tex-string (x)
99  (cond ((equal x "") "")
100	((eql (elt x 0) #\\) x)
101;-	(t (concatenate 'string "\\mbox{{}" x "{}}"))))
102  	(t (concatenate 'string "" x ""))))
103
104(defun tex-char (x)
105;-  (if (eql x #\|) "\\mbox{\\verb/|/}"
106;-      (concatenate 'string "\\mbox{\\verb|" (string x) "|}")))
107    (if (eql x #\|) ""
108        (concatenate 'string "" (string x) "")))
109
110(defun tex-stripdollar(sym &aux )
111  (or (symbolp sym) (return-from tex-stripdollar sym))
112  (let* ((pname (quote-% sym))
113	 (l (length pname))
114	 (begin-sub
115	  (loop for i downfrom (1- l)
116		 when (not (digit-char-p (aref pname i)))
117		 do (return (1+ i))))
118	 (tem  (make-array (+ l 4) :element-type ' #.(array-element-type "abc") :fill-pointer 0)))
119    (loop for i below l
120	   do
121	   (cond ((eql i begin-sub)
122		  (let ((a (assoc tem  *tex-translations* :test 'equal)))
123		    (cond (a
124			   (setq a (cdr a))
125			   (setf (fill-pointer tem) 0)
126			   (loop for i below (length a)
127				  do
128				  (vector-push (aref a i) tem)))))
129;-		  (vector-push #\_ tem)
130  		  ;; (vector-push #\_ tem)
131		  (unless (eql i (- l 1))
132		    (vector-push #\{ tem)
133		    (setq begin-sub t))))
134	   (cond ((not (and (eql i 0) (eql (aref pname i) #\$)))
135		  (vector-push (aref pname i) tem)))
136	   finally
137	   (cond ((eql begin-sub t)
138		  (vector-push #\} tem))))
139    (intern tem)))
140
141(defun texnumformat(atom)
142  (let (r firstpart exponent)
143    (cond ((integerp atom)
144	   atom)
145	  (t
146	   (setq r (explode atom))
147	   (setq exponent (member 'e r :test #'string-equal)) ;; is it ddd.ddde+EE
148	   (cond ((null exponent)
149		  ;; it is not. go with it as given
150		  atom)
151		 (t
152		  (setq firstpart
153			(nreverse (cdr (member 'e (reverse r) :test #'string-equal))))
154		  (strcat (apply #'strcat firstpart )
155;-			  " \\times 10^{"
156  			  " times 10^{"
157			  (apply #'strcat (cdr exponent))
158			  "}")))))))
159
160(defun tex-paren (x l r)
161;-  (tex x (append l '("\\left(")) (cons "\\right)" r) 'mparen 'mparen))
162    (tex x (append l '(" left( ")) (cons " right)" r) 'mparen 'mparen))
163
164(defun tex-array (x l r)
165  (let ((f))
166    (if (eq 'mqapply (caar x))
167	(setq f (cadr x)
168	      x (cdr x)
169;-	      l (tex f (append l (list "\\left(")) (list "\\right)") 'mparen 'mparen))
170  	      l (tex f (append l (list " left( ")) (list " right) ") 'mparen 'mparen))
171	(setq f (caar x)
172	      l (tex f l nil lop 'mfunction)))
173    (setq
174     r (nconc (tex-list (cdr x) nil (list "}") ",") r))
175    (nconc l (list "_{") r  )))
176
177(defprop mprog "" texword)
178(defprop %erf " erf " texword)
179(defprop $erf " erf " texword) ;; etc for multicharacter names
180(defprop $true  " true "  texword)
181(defprop $false " false " texword)
182(defprop mprogn ((" left( ") " right) ") texsym)
183(defprop mlist ((" left[ ")" right] ") texsym)
184(defprop mabs ((" left lline ")" right rline ") texsym)
185(defprop $%pi "%pi" texword)
186(defprop $inf " infty " texword)
187(defprop $minf " - infty " texword)
188(defprop %laplace "%DELTA" texword)
189(defprop $alpha "%alpha" texword)
190(defprop $beta "%beta" texword)
191(defprop $gamma "%gamma" texword)
192(defprop %gamma "%GAMMA" texword)
193(defprop $%gamma "%gamma" texword)
194(defprop $delta "%delta" texword)
195(defprop $epsilon "%varepsilon" texword)
196(defprop $zeta "%zeta" texword)
197(defprop $eta "%eta" texword)
198(defprop $theta "%vartheta" texword)
199(defprop $iota "%iota" texword)
200(defprop $kappa "%varkappa" texword)
201(defprop $mu "%my" texword)
202(defprop $nu "%nu" texword)
203(defprop $xi "%xi" texword)
204(defprop $pi "%pi" texword)
205(defprop $rho "%rho" texword)
206(defprop $sigma "%sigma" texword)
207(defprop $tau "%tau" texword)
208(defprop $upsilon "%ypsilon" texword)
209(defprop $phi "%varphi" texword)
210(defprop $chi "%chi" texword)
211(defprop $psi "%psi" texword)
212(defprop $omega "%omega" texword)
213(defprop |$Gamma| "%GAMMA" texword)
214(defprop |$Delta| "%DELTA" texword)
215(defprop |$Theta| "%ThETA" texword)
216(defprop |$Lambda| "%LAMBDA" texword)
217(defprop |$Xi| "%XI" texword)
218(defprop |$Pi| "%PI" texword)
219(defprop |$Sigma| "%SIGMA" texword)
220(defprop |$Upsilon| "%YPSILON" texword)
221(defprop |$Phi| "%PHI" texword)
222(defprop |$Psi| "%PSI" texword)
223(defprop |$Omega| "%OMEGA" texword)
224(defprop marrow (" rightarrow ") texsym)
225
226(defun tex-mexpt (x l r)
227  (let((nc (eq (caar x) 'mncexpt)))	; true if a^^b rather than a^b
228    ;; here is where we have to check for f(x)^b to be displayed
229    ;; as f^b(x), as is the case for sin(x)^2 .
230    ;; which should be sin^2 x rather than (sin x)^2 or (sin(x))^2.
231    ;; yet we must not display (a+b)^2 as +^2(a,b)...
232    ;; or (sin(x))^(-1) as sin^(-1)x, which would be arcsine x
233    (cond ;; this whole clause
234      ;; should be deleted if this hack is unwanted and/or the
235      ;; time it takes is of concern.
236      ;; it shouldn't be too expensive.
237      ((and (eq (caar x) 'mexpt)      ; don't do this hack for mncexpt
238	    (let*
239		((fx (cadr x))		; this is f(x)
240		 (f (and (not (atom fx)) (atom (caar fx)) (caar fx))) ; this is f [or nil]
241		 (bascdr (and f (cdr fx))) ; this is (x) [maybe (x,y..), or nil]
242		 (expon (caddr x)) ;; this is the exponent
243		 (doit (and
244			f		; there is such a function
245			(member (get-first-char f) '(#\% #\$) :test #'char=) ;; insist it is a % or $ function
246			(not (member 'array (cdar fx) :test #'eq))	; fix for x[i]^2
247					; Jesper Harder <harder@ifa.au.dk>
248			(not (member f '(%sum %product %derivative %integrate %at
249				       %lsum %limit) :test #'eq)) ;; what else? what a hack...
250			(or (and (atom expon) (not (numberp expon))) ; f(x)^y is ok
251			    (and (atom expon) (numberp expon) (> expon 0))))))
252					; f(x)^3 is ok, but not f(x)^-1, which could
253					; inverse of f, if written f^-1 x
254					; what else? f(x)^(1/2) is sqrt(f(x)), ??
255	      (cond (doit
256		     (setq l (tex `((mexpt) ,f ,expon) l nil 'mparen 'mparen))
257		     (if (and (null (cdr bascdr))
258			      (eq (get f 'tex) 'tex-prefix))
259			 (setq r (tex (car bascdr) nil r f 'mparen))
260			 (setq r (tex (cons '(mprogn) bascdr) nil r 'mparen 'mparen))))
261		    (t nil)))))		; won't doit. fall through
262      (t (setq l (cond ((and (numberp (cadr x))
263			     (numneedsparen (cadr x)))
264;-			(tex (cadr x) (cons "\\left(" l) '("\\right)") lop
265  			(tex (cadr x) (cons " left( " l) '(" right) ") lop
266			     (caar x)))
267		       (t (tex (cadr x) l nil lop (caar x))))
268	       r (if (mmminusp (setq x (nformat (caddr x))))
269		     ;; the change in base-line makes parens unnecessary
270		     (if nc
271;-			 (tex (cadr x) '("^ {-\\langle ")(cons "\\rangle }" r) 'mparen 'mparen)
272  			 (tex (cadr x) '("^ {- langle ")(cons " rangle }" r) 'mparen 'mparen)
273			 (tex (cadr x) '("^ {- ")(cons " }" r) 'mparen 'mparen))
274		     (if nc
275;-			 (tex x (list "^{\\langle ")(cons "\\rangle}" r) 'mparen 'mparen)
276  			 (tex x (list "^{ langle ")(cons " rangle }" r) 'mparen 'mparen)
277			 (if (and (integerp x) (< x 10))
278;-			     (tex x (list "^")(cons "" r) 'mparen 'mparen)
279  			     (tex x (list "^")(cons " " r) 'mparen 'mparen)
280			     (tex x (list "^{")(cons "}" r) 'mparen 'mparen))
281			 )))))
282    (append l r)))
283
284(defprop mnctimes (" cdot ") texsym)
285(defprop mtimes (" cdot ") texsym)    ;; HMM, SEEMS INADVISABLE
286
287(defun tex-sqrt(x l r)
288  ;; format as \\sqrt { } assuming implicit parens for sqr grouping
289;-  (tex (cadr x) (append l  '("\\sqrt{")) (append '("}") r) 'mparen 'mparen))
290    (tex (cadr x) (append l  '(" sqrt {")) (append '("}") r) 'mparen 'mparen))
291
292(defun tex-cubrt (x l r)
293;-  (tex (cadr x) (append l  '("\\root 3 \\of{")) (append '("}") r) 'mparen 'mparen))
294    (tex (cadr x) (append l  '(" nroot {3} {")) (append '("}") r) 'mparen 'mparen))
295
296(defprop mquotient (" over ") texsym)
297
298(defun tex-mquotient (x l r)
299  (if (or (null (cddr x)) (cdddr x)) (wna-err (caar x)))
300;-  (setq l (tex (cadr x) (append l '("{{")) nil 'mparen 'mparen)
301    (setq l (tex (cadr x) (append l '("{alignc {")) nil 'mparen 'mparen)
302					;the divide bar groups things
303;-	r (tex (caddr x) (list "}\\over{") (append '("}}")r) 'mparen 'mparen))
304  	r (tex (caddr x) (list "} over {") (append '("}}")r) 'mparen 'mparen))
305  (append l r))
306
307(defun tex-matrix(x l r) ;;matrix looks like ((mmatrix)((mlist) a b) ...)
308;-  (append l `("\\pmatrix{")
309    (append l `(" left( matrix {")
310	  (let ((foo (mapcan #'(lambda(y)
311;-		      (tex-list (cdr y) nil (list "\\cr ") "&"))
312  		      (tex-list (cdr y) nil (list " ## ") " # "))
313		  (cdr x))))
314            (setf (car (last foo)) " ")
315            foo)
316;-	  '("}") r))
317  	  '("} right) ") r))
318
319(defun tex-lsum(x l r)
320;-  (let ((op (cond ((eq (caar x) '%lsum) "\\sum_{")
321    (let ((op (cond ((eq (caar x) '%lsum) "sum from {")
322		  ;; extend here
323		  ))
324	;; gotta be one of those above
325	(s1 (tex (cadr x) nil nil 'mparen rop))	;; summand
326	(index ;; "index = lowerlimit"
327	 (tex `((min simp) , (caddr x), (cadddr x))  nil nil 'mparen 'mparen)))
328    (append l `( ,op ,@index "}}{" ,@s1 "}") r)))
329
330(defun tex-sum(x l r)
331;-  (let ((op (cond ((eq (caar x) '%sum) "\\sum_{")
332;-		  ((eq (caar x) '%product) "\\prod_{")
333    (let ((op (cond ((eq (caar x) '%sum) " sum from {")
334  		  ((eq (caar x) '%product) " prod from {")
335		  ;; extend here
336		  ))
337	;; gotta be one of those above
338	(s1 (tex (cadr x) nil nil 'mparen rop))	;; summand
339	(index ;; "index = lowerlimit"
340	 (tex `((mequal simp) ,(caddr x),(cadddr x)) nil nil 'mparen 'mparen))
341	(toplim (tex (car(cddddr x)) nil nil 'mparen 'mparen)))
342;-    (append l `( ,op ,@index "}^{" ,@toplim "}{" ,@s1 "}") r)))
343      (append l `( ,op ,@index "} to {" ,@toplim "}{" ,@s1 "}") r)))
344
345(defun tex-int (x l r)
346  (let ((s1 (tex (cadr x) nil nil 'mparen 'mparen)) ;;integrand delims / & d
347	(var (tex (caddr x) nil nil 'mparen rop))) ;; variable
348    (cond((= (length x) 3)
349;-	  (append l `("\\int {" ,@s1 "}{\\;d" ,@var "}") r))
350  	  (append l `(" int {" ,@s1 "}{`d" ,@var "}") r))
351	 (t ;; presumably length 5
352	  (let ((low (tex (nth 3 x) nil nil 'mparen 'mparen))
353		;; 1st item is 0
354		(hi (tex (nth 4 x) nil nil 'mparen 'mparen)))
355;-	    (append l `("\\int_{" ,@low "}^{" ,@hi "}{" ,@s1 "\\;d" ,@var "}") r))))))
356  	    (append l `(" int from {" ,@low "} to {" ,@hi "}{" ,@s1 " d" ,@var "}") r))))))
357
358(defun tex-limit(x l r)	;; ignoring direction, last optional arg to limit
359  (let ((s1 (tex (cadr x) nil nil 'mparen rop))	;; limitfunction
360	(subfun	;; the thing underneath "limit"
361;-	 (subst "\\rightarrow " '=
362  	 (subst " rightarrow " '=
363		(tex `((mequal simp) ,(caddr x),(cadddr x))
364		     nil nil 'mparen 'mparen))))
365;-    (append l `("\\lim_{" ,@subfun "}{" ,@s1 "}") r)))
366      (append l `(" lim from {" ,@subfun "}{" ,@s1 "}") r)))
367
368(defun tex-at (x l r)
369  (let ((s1 (tex (cadr x) nil nil lop rop))
370	(sub (tex (caddr x) nil nil 'mparen 'mparen)))
371;-    (append l '("\\left.") s1  '("\\right|_{") sub '("}") r)))
372      (append l '(" left .") s1  '(" right |_{") sub '("}") r)))
373
374(defun tex-mbox (x l r)
375;-  (append l '("\\boxed{") (tex (cadr x) nil nil 'mparen 'mparen) '("}") r))
376    (append l '("{") (tex (cadr x) nil nil 'mparen 'mparen) '("}") r))
377
378(defun tex-choose (x l r)
379  `(,@l
380;-    "\\pmatrix{"
381      " matrix {"
382    ,@(tex (cadr x) nil nil 'mparen 'mparen)
383;-    "\\\\"
384      " ## "
385    ,@(tex (caddr x) nil nil 'mparen 'mparen)
386    "}"
387    ,@r))
388
389(defun tex-mplus (x l r)
390;-  (cond ((member 'trunc (car x) :test #'eq)(setq r (cons "+\\cdots " r))))
391    (cond ((member 'trunc (car x) :test #'eq)(setq r (cons " + dotsaxis " r))))
392  (cond ((null (cddr x))
393	 (if (null (cdr x))
394	     (tex-function x l r t)
395;-	     (tex (cadr x) (cons "+" l) r 'mplus rop)))
396  	     (tex (cadr x) (cons " + " l) r 'mplus rop)))
397	(t (setq l (tex (cadr x) l nil lop 'mplus)
398		 x (cddr x))
399	   (do ((nl l)  (dissym))
400	       ((null (cdr x))
401;-		(if (mmminusp (car x)) (setq l (cadar x) dissym (list "-"))
402;-		    (setq l (car x) dissym (list "+")))
403  		(if (mmminusp (car x)) (setq l (cadar x) dissym (list " - "))
404  		    (setq l (car x) dissym (list " + ")))
405		(setq r (tex l dissym r 'mplus rop))
406		(append nl r))
407;-	     (if (mmminusp (car x)) (setq l (cadar x) dissym (list "-"))
408;-		 (setq l (car x) dissym (list "+")))
409  	     (if (mmminusp (car x)) (setq l (cadar x) dissym (list " - "))
410  		 (setq l (car x) dissym (list " + ")))
411	     (setq nl (append nl (tex l dissym nil 'mplus 'mplus))
412		   x (cdr x))))))
413
414(defprop mminus (" `-`") texsym)
415(defprop min (" in ") texsym)
416(defprop mgeqp (" geq ") texsym)
417(defprop mleqp (" leq ") texsym)
418(defprop mnot (" not ") texsym)
419(defprop mand (" and ") texsym)
420(defprop mor (" or ") texsym)
421(defprop mnotequal (" neq ") texsym)
422
423(mapc #'tex-setup
424      '(
425	(%acos " arccos ")
426	(%asin " arcsin ")
427	(%atan " arctan ")
428	(%cos " cos ")
429	(%cosh " cosh ")
430	(%cot " cot ")
431	(%coth " coth ")
432	(%csc " csc ")
433	(%determinant " det ")
434	(%dim " dim ")
435	(%exp " exp ")
436	(%gcd " gcd ")
437	(%inf " inf ")
438	(%ln " ln ")
439	(%log " log ")
440	(%max " max ")
441	(%min " min ")
442	(%sec " sec ")
443	(%sin " sin ")
444	(%sinh " sinh ")
445	(%tan " tan ")
446	(%tanh " tanh ")
447 	))
448
449(defun tex-mcond (x l r)
450  (append l
451;-	  (tex (cadr x) '("\\mathbf{if}\\;")
452;-	       '("\\;\\mathbf{then}\\;") 'mparen 'mparen)
453  	  (tex (cadr x) '(" bold if")
454  	       '(" bold then") 'mparen 'mparen)
455     (if (eql (fifth x) '$false)
456         (tex (caddr x) nil r 'mcond rop)
457         (append (tex (caddr x) nil nil 'mparen 'mparen)
458;-		      (tex (fifth x) '("\\;\\mathbf{else}\\;") r 'mcond rop)))))
459  		      (tex (fifth x) '(" bold else") r 'mcond rop)))))
460
461(defun tex-mdo (x l r)
462;-  (tex-list (texmdo x) l r "\\;"))
463    (tex-list (texmdo x) l r "`"))
464
465(defun tex-mdoin (x l r)
466;-  (tex-list (texmdoin x) l r "\\;"))
467    (tex-list (texmdoin x) l r "`"))
468
469(defun texmdo (x)
470;-  (nconc (cond ((second x) `("\\mathbf{for}" ,(second x))))
471    (nconc (cond ((second x) `(" bold for" ,(second x))))
472	 (cond ((equal 1 (third x)) nil)
473;-	       ((third x)  `("\\mathbf{from}" ,(third x))))
474  	       ((third x)  `(" bold from" ,(third x))))
475	 (cond ((equal 1 (fourth x)) nil)
476;-	       ((fourth x) `("\\mathbf{step}" ,(fourth x)))
477;-	       ((fifth x)  `("\\mathbf{next}" ,(fifth x))))
478;-	 (cond ((sixth x)  `("\\mathbf{thru}" ,(sixth x))))
479  	       ((fourth x) `(" bold step" ,(fourth x)))
480  	       ((fifth x)  `(" bold next" ,(fifth x))))
481  	 (cond ((sixth x)  `(" bold thru" ,(sixth x))))
482	 (cond ((null (seventh x)) nil)
483	       ((eq 'mnot (caar (seventh x)))
484;-		`("\\mathbf{while}" ,(cadr (seventh x))))
485;-	       (t `("\\mathbf{unless}" ,(seventh x))))
486;-	 `("\\mathbf{do}" ,(eighth x))))
487  		`(" bold while" ,(cadr (seventh x))))
488  	       (t `(" bold unless" ,(seventh x))))
489  	 `(" bold do" ,(eighth x))))
490
491(defun texmdoin (x)
492;-  (nconc `("\\mathbf{for}" ,(second x) "\\mathbf{in}" ,(third x))
493;-	 (cond ((sixth x) `("\\mathbf{thru}" ,(sixth x))))
494    (nconc `(" bold for" ,(second x) " bold in" ,(third x))
495  	 (cond ((sixth x) `(" bold thru" ,(sixth x))))
496	 (cond ((null (seventh x)) nil)
497	       ((eq 'mnot (caar (seventh x)))
498;-		`("\\mathbf{while}" ,(cadr (seventh x))))
499;-	       (t `("\\mathbf{unless}" ,(seventh x))))
500;-	 `("\\mathbf{do}" ,(eighth x))))
501  		`(" bold while" ,(cadr (seventh x))))
502  	       (t `(" bold unless" ,(seventh x))))
503  	 `(" bold do" ,(eighth x))))
504
505(defprop | --> | " rightarrow " texsym)
506(defprop | WHERE | "` bold where`" texsym)
507
508(defun tex-mlabel (x l r)
509  (tex (caddr x)
510       (append l
511	       (if (cadr x)
512;-		   (list (format nil "\\mbox{\\tt\\red(~A) \\black}" (tex-stripdollar (cadr x))))
513  		   (list (format nil "" (tex-stripdollar (cadr x))))
514		   nil))
515       r 'mparen 'mparen))
516
517(defun tex-spaceout (x l r)
518;-  (append l (cons (format nil "\\hspace{~dmm}" (* 3 (cadr x))) r)))
519    (append l (cons (format nil "~" (* 3 (cadr x))) r)))
520