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