external/smarkup/src/latex.cl

   1 ;;
   2 ;; Copyright (c) 2006, Cyrus Harmon
   3 ;;
   4 ;; latex.cl - latex output from smarkup
   5 ;;
   6
   7 (in-package :smarkup)
   8
   9 (defvar *baseline-skip* "12pt")
  10 (defvar *baseline-stretch* "1.6")
  11 (defvar *par-skip* "18pt")
  12 (defvar *latex-graphics-params* nil)
  13
  14 (defparameter *document-format-parameters*
  15   '(#+nil ("oddsidemargin" . "0.5in")
  16     #+nil ("textwidth" . "6.0in")
  17     #+nil ("topmargin" . "0in")
  18     #+nil ("headheight" . "0.1in")
  19     #+nil ("headsep" . "0.0in")
  20     #+nil ("textheight" . "9.6in")
  21     #+nil ("footskip" . "0.4in")
  22     #+nil ("parindent" . "0.5in")))
  23
  24 (defvar *section-numbering-depth* 5)
  25
  26 (defparameter *document-class* "article")
  27 (defparameter *document-options* '("10pt"))
  28
  29 (defvar *document-latex-commands*
  30   '("\\newcommand{\\argmax}{\\operatornamewithlimits{argmax}}"
  31     "\\newcommand{\\argmin}{\\operatornamewithlimits{argmin}}"))
  32
  33 (defparameter *latex-packages*
  34   '("amssymb" "amsmath" "verbatim" "graphicx" "subfigure"
  35     "caption" "hyperref" "fancyheadings" "longtable"
  36     ("geometry" . "letterpaper")))
  37
  38 (defparameter *thesis-preamble*
  39   "\\DeclareCaptionFont{singlespacing}{\\ssp}
  40 \\captionsetup{font={singlespacing,small}}")
  41
  42 ;;; \\captionsetup{font={singlespacing,small}}
  43
  44 (defparameter *beamer-preamble*
  45   "\\mode<presentation>{
  46 \\definecolor{nicegreen}{RGB}{10,100,10}
  47 \\setbeamercolor*{normal text}{bg=black,fg=white}
  48 \\setbeamercolor{structure}{fg=nicegreen}
  49 }
  50 ")
  51
  52
  53 (defparameter *res-preamble* "
  54 \\oddsidemargin -.5in
  55 \\evensidemargin -.5in
  56 \\textwidth=6.0in
  57 \\itemsep=0in
  58 \\parsep=0in
  59 \\parskip=6pt
  60 \\topmargin=-.4in
  61 \\textheight=60\\baselineskip
  62 \\hyphenpenalty=5000
  63 \\tolerance=1000
  64
  65 \\newenvironment{list1}{
  66   \\begin{list}{}{%
  67       \\setlength{\\itemsep}{0in}
  68       \\setlength{\\parsep}{0in} \\setlength{\\parskip}{0in}
  69       \\setlength{\\topsep}{0in} \\setlength{\\partopsep}{0in}
  70       \\setlength{\\leftmargin}{0.17in}}}{\\end{list}}
  71 \\newenvironment{list2}{
  72   \\begin{list}{$\\bullet$}{%
  73       \\setlength{\\itemsep}{0in}
  74       \\setlength{\\parsep}{0in} \\setlength{\\parskip}{0in}
  75       \\setlength{\\topsep}{0in} \\setlength{\\partopsep}{0in}
  76       \\setlength{\\leftmargin}{0.2in}}}{\\end{list}}")
  77
  78 (defparameter *llncs-preamble*
  79   "\\bibliographystyle{splncs}
  80 \\renewcommand\\floatpagefraction{.9}
  81 \\renewcommand\\topfraction{.9}
  82 \\renewcommand\\bottomfraction{.9}
  83 \\renewcommand\\textfraction{.1}
  84 \\setcounter{totalnumber}{50}
  85 \\setcounter{topnumber}{50}
  86 \\setcounter{bottomnumber}{50}
  87 ")
  88
  89 (defparameter *acm-proc-article-preamble*
  90   "\\bibliographystyle{splncs}
  91 \\renewcommand\\floatpagefraction{.95}
  92 \\renewcommand\\topfraction{.95}
  93 \\renewcommand\\bottomfraction{.95}
  94 \\renewcommand\\textfraction{.1}
  95 \\setcounter{totalnumber}{50}
  96 \\setcounter{topnumber}{50}
  97 \\setcounter{bottomnumber}{50}
  98 \\widowpenalty=10000
  99 \\clubpenalty=10000
 100 \\raggedbottom
 101 ")
 102
 103 (defparameter *article-preamble*
 104   "\\setcounter{topnumber}{2}
 105 \\setcounter{bottomnumber}{2}
 106 \\setcounter{totalnumber}{4}     % 2 may work better
 107 \\setcounter{dbltopnumber}{2}    % for 2-column pages
 108 \\renewcommand{\\dbltopfraction}{0.9}   % fit big float above 2-col. text
 109 \\renewcommand{\\textfraction}{0.07}    % allow minimal text w. figs
 110 %   Parameters for FLOAT pages (not text pages):
 111 \\renewcommand{\\floatpagefraction}{0.7}        % require fuller float pages
 112 % N.B.: floatpagefraction MUST be less than topfraction !!
 113 \\renewcommand{\\dblfloatpagefraction}{0.7}     % require fuller float pages
 114 \\setlength{\\captionmargin}{10pt}")
 115
 116 (defvar *article-headings* '((:h1 . "section")
 117                                    (:h2 . "subsection")
 118                                    (:h3 . "subsubsection")
 119                                    (:h4 . "paragraph")))
 120
 121 (defvar *thesis-headings* '((:h1 . "chapter")
 122                                   (:h2 . "section")
 123                                   (:h3 . "subsection")
 124                                   (:h4 . "subsubsection")))
 125
 126 (defparameter *thesis-approval-page* t)
 127
 128 (defun latex-command (command &optional arg)
 129   (format nil "~&\\~A~@[{~A}~]~%" command arg))
 130
 131 (defgeneric emit-latex (stream thing &key newline))
 132 (defgeneric emit-latex-gf (stream type children &key newline))
 133
 134 ;;; default is a no-op
 135 (defmethod emit-latex (stream thing &key newline)
 136   (declare (ignore newline)))
 137
 138 (defmethod emit-latex (stream (thing string) &key newline)
 139   (declare (ignore newline))
 140   (format stream "~A" thing))
 141
 142 (defmethod emit-latex (stream (thing string) &key newline)
 143   (format stream "~A~:[~;~%~]" thing newline))
 144
 145 (defmethod emit-latex (stream (thing character) &key newline)
 146   (emit-latex stream (string thing) :newline newline))
 147
 148 (defmethod emit-latex (stream (thing cons) &key (newline nil newline-supplied-p))
 149   (cond ((atom (car thing))
 150          (apply #'emit-latex-gf stream (car thing) (cdr thing)
 151                 (when newline-supplied-p `(:newline ,newline))))
 152         ((listp (car thing))
 153          (apply #'emit-latex-gf stream (caar thing) (cdr thing)
 154                 (when newline-supplied-p `(:newline ,newline))))))
 155
 156 (defmethod emit-latex (stream (thing (eql :nbsp)) &key (newline nil))
 157   (emit-latex stream "~" :newline newline))
 158
 159 (defmethod emit-latex (stream (thing (eql :hr)) &key (newline nil))
 160   (declare (ignore newline))
 161   (emit-latex-newline stream))
 162
 163 (defmethod emit-latex (stream (thing (eql :newline)) &key (newline nil))
 164   (declare (ignore newline))
 165   (emit-latex stream "\\\\" :newline t))
 166
 167 (defmethod emit-latex (stream (thing (eql :pause)) &key (newline nil))
 168   (emit-latex stream "\\pause" :newline newline))
 169
 170 (defmethod emit-latex (stream (thing (eql :hfill)) &key (newline nil))
 171   (emit-latex stream "\\hfill" :newline newline))
 172
 173 (defmethod emit-latex (stream (thing (eql :qquad)) &key (newline nil))
 174   (emit-latex stream "\\qquad" :newline newline))
 175
 176 (defmethod emit-latex (stream (thing (eql :quad)) &key (newline nil))
 177   (emit-latex stream "\\quad" :newline newline))
 178
 179 (defun emit-latex-freshline (stream)
 180   (format stream "~&"))
 181
 182 (defun emit-latex-newline (stream)
 183   (format stream "~%"))
 184
 185 ;;; default is a no-op
 186 (defmethod emit-latex-gf (stream type children &key newline)
 187   (declare (ignore newline)))
 188
 189 (defun emit-children-to-string (children)
 190   (cond ((null children) nil)
 191         ((listp children)
 192          (apply #'concatenate 'string
 193                 (loop for c in children collect (emit-latex nil c))))
 194         (t children)))
 195
 196 (defmethod emit-latex-gf (stream (type (eql :p)) children &key (newline t))
 197   (emit-latex-freshline stream)
 198   (dolist (c children)
 199     (emit-latex stream c))
 200   (when (or newline t)
 201     (emit-latex-newline stream)
 202     (emit-latex-newline stream)))
 203
 204 (defun emit-latex-command (stream command children
 205                            &key
 206                            (newline t)
 207                            (initial-freshline t)
 208                            (options))
 209   (format stream "~:[~;~&~]\\~A~@[[~A]~]~@[{~A}~]~:[~;~%~]"
 210           initial-freshline
 211           command
 212           options
 213           (cond ((null children) nil)
 214                 ((listp children)
 215                  (apply #'concatenate 'string
 216                         (loop for c in children collect (emit-latex nil c))))
 217                 (t children))
 218           newline))
 219
 220 (defun emit-latex-command-2 (stream command &key options arg1 arg2 (newline t))
 221   (format stream "~&\\~A~@[[~A]~]~@[{~A}~]~@[{~A}~]~:[~;~%~]" command options arg1 arg2 newline))
 222
 223 (defun emit-latex-command-3 (stream command section &key options arg1 arg2 (newline t))
 224   (format stream "~&\\~A{~A}~@[[~A]~]~@[{~A}~]~@[{~A}~]~:[~;~%~]" command section options arg1 arg2 newline))
 225
 226 (defun emit-latex-command-4 (stream command children
 227                            &key
 228                            (newline t)
 229                            (initial-freshline t)
 230                            (options))
 231   (format stream "~:[~;~&~]\\~A~@[[~A]~]{"
 232           initial-freshline
 233           command
 234           options)
 235   (loop for c in children do (emit-latex stream c))
 236   (format stream "}~:[~;~%~]" newline))
 237
 238 ;;;
 239 ;;; takes options command, options, arg1, arg2 and arg3, e.g.:
 240 ;;; (emit-latex-command-5 nil "command" :options "options" :arg1 "arg1" :arg2 "arg2")
 241 ;;; produces "\\command[options]{arg1}[arg2]{arg3}"
 242 ;;;
 243 (defun emit-latex-command-5 (stream command &key options arg1 arg2 arg3 (newline t))
 244   (format stream "~&\\~A~@[[~A]~]~@[{~A}~]~@[[~A]~]~@[{~A}~]~:[~;~%~]"
 245           command options arg1 arg2 arg3 newline))
 246
 247 (defun emit-latex-command-6 (stream command children
 248                            &key
 249                            (newline t)
 250                            (initial-freshline t)
 251                            (arg))
 252   (format stream "~:[~;~&~]\\~A~@[{~A}~]~:[~;{~]"
 253           initial-freshline
 254           command
 255           arg
 256           children)
 257   (loop for c in children do (emit-latex stream c))
 258   (format stream "~:[~;}~]~:[~;~%~]" children newline))
 259
 260 (defun emit-latex-parameter (stream command children &key (newline t))
 261   (format stream "~&\\~A~@[ ~A~]~:[~;~%~]"
 262           command
 263           (cond ((null children) nil)
 264                 ((listp children)
 265                  (apply #'concatenate 'string
 266                         (loop for c in children collect (emit-latex nil c))))
 267                 (t children))
 268           newline))
 269
 270 (defmethod emit-latex-gf (stream (type (eql :div)) children &key newline)
 271   (loop for c in children collect
 272        (emit-latex stream c))
 273   (when newline (emit-latex-newline stream)))
 274
 275 (defmethod emit-latex-gf (stream (type (eql :span)) children &key newline)
 276   #+nil (format stream "~{~A~}~:[~;~%~]"
 277                 (loop for c in children collect (emit-latex nil c))
 278                 newline)
 279   (loop for c in children collect (emit-latex stream c)))
 280
 281 (defun emit-latex-block (command stream children &key newline)
 282   (format stream "{\\~A ~{~A~}}~:[~;~%~]" command
 283           (loop for c in children collect (emit-latex nil c))
 284           newline))
 285
 286 (defmacro with-latex-block (command stream &rest rest)
 287   `(progn
 288      (format ,stream "{\\~A " ,command)
 289      ,@rest
 290      (format ,stream "}~:[~;~%~]" t)))
 291
 292 (defmethod emit-latex-gf (stream (type (eql :i)) children &key newline)
 293   (emit-latex-block "it" stream children :newline newline))
 294
 295 (defmethod emit-latex-gf (stream (type (eql :b)) children &key newline)
 296   (emit-latex-block "bf" stream children :newline newline))
 297
 298 (defmethod emit-latex-gf (stream (type (eql :sc)) children &key newline)
 299   (emit-latex-block "sc" stream children :newline newline))
 300
 301 (defparameter *document-single-space-count* 0)
 302
 303 (defun single-space (stream)
 304   (cond ((equal *document-class* "ucthesis")
 305          (incf *document-single-space-count*)
 306          (emit-latex stream "\\ssp" :newline t))
 307         ((equal *document-class* "beamer"))
 308         ((equal *document-class* "llncs"))
 309         ((equal *document-class* "acm_proc_article-sp"))
 310         (t (emit-latex stream (format nil "\\baselineskip~A" "12pt") :newline t))))
 311
 312 (defun default-space (stream)
 313   (cond ((equal *document-class* "ucthesis")
 314          (unless (plusp (decf *document-single-space-count*))
 315            (emit-latex stream (format nil "\\dsp") :newline t)))
 316         ((equal *document-class* "beamer"))
 317         ((equal *document-class* "llncs"))
 318         ((equal *document-class* "acm_proc_article-sp"))
 319         (t (emit-latex stream (format nil "\\baselineskip~A" *baseline-skip*) :newline t))))
 320
 321 (defmethod emit-latex-gf (stream (type (eql :pre)) children &key (newline nil))
 322   (declare (ignore newline))
 323   (emit-latex-newline stream)
 324   (single-space stream)
 325   (emit-latex-command stream "begin" '("verbatim") :newline nil)
 326   (format stream "~{~A~}"
 327           (loop for c in children collect (emit-latex nil c)))
 328   (emit-latex-command stream "end" '("verbatim"))
 329   (default-space stream))
 330
 331
 332 (defmethod emit-latex-gf (stream (type (eql :code)) children &key (newline nil))
 333   (format stream "~{~A~}~:[~;~%~]"
 334           (loop for c in children collect (emit-latex nil c))
 335           newline))
 336
 337 (defmethod emit-latex-gf (stream (type (eql :pseudocode)) children &key (newline t))
 338   (destructuring-bind (&key name (parameters " ") label)
 339       (car children)
 340     (single-space stream)
 341     (when (equal *document-class* "beamer")
 342       (emit-latex stream "{\\scriptsize"))
 343     (emit-latex-command-3 stream "begin" "pseudocode" :options "framebox" :arg1 name :arg2 parameters :newline nil)
 344     (format stream "~{~A~}~:[~;~%~]"
 345             (loop for c in (cdr children)
 346                collect (emit-latex nil c))
 347             newline)
 348     (when label
 349       (emit-latex-command stream "label" label :newline t))
 350     (emit-latex-command stream "end" "pseudocode" :newline newline)
 351     (when (equal *document-class* "beamer")
 352       (emit-latex stream "}" :newline t))
 353     (emit-latex-newline stream)
 354     (default-space stream)))
 355
 356 (defmethod emit-latex-gf (stream (type (eql :soutput)) children &key (newline))
 357   (declare (ignore newline))
 358   (single-space stream)
 359   (emit-latex stream "{\\scriptsize")
 360   (emit-latex-command stream "begin" "Soutput")
 361   (dolist (c children)
 362     (emit-latex stream c))
 363   (emit-latex-command stream "end" "Soutput")
 364   (emit-latex stream "}" :newline t)
 365   (default-space stream))
 366
 367 (defmethod emit-latex-gf (stream (type (eql :results)) children &key (newline nil))
 368   (format stream "~{~A~}~:[~;~%~]"
 369           (loop for c in children collect (emit-latex nil c))
 370           newline))
 371
 372 (defmethod emit-latex-gf (stream (type (eql :clearpage)) children &key (newline t))
 373   (emit-latex-command stream "clearpage" nil :newline t))
 374
 375 (defun get-headings ()
 376   (cond ((equal *document-class* "ucthesis")
 377          *thesis-headings*)
 378         (t *article-headings*)))
 379
 380 (defvar *default-font-size* "10pt")
 381
 382 (defun setup-headings ()
 383   (cond ((member *document-class* '("ucthesis") :test #'equal)
 384          (setf *document-options* '("11pt")))
 385         ((member *document-class* '("beamer") :test #'equal)
 386          (setf *document-options* '("10pt")))
 387         ((member *document-class* '("res") :test #'equal)
 388          (setf *document-options* '("margin" "line")))
 389         ((member *document-class* '("acm_proc_article-sp") :test #'equal)
 390          (setf *document-options* nil))
 391         ((member *document-class* '("llncs") :test #'equal)
 392          (setf *document-options* '("oribibl")))
 393         (t (setf *document-options* `(,*default-font-size*)))))
 394
 395 (defmethod emit-latex-gf (stream (type (eql :appendices)) children &key (newline t))
 396   (declare (ignore newline))
 397   (single-space stream)
 398   (emit-latex-command stream "appendix" nil)
 399   (loop for c in children
 400      do (emit-latex stream c))
 401   (default-space stream))
 402
 403 (defparameter *h1-default-clearpage* t)
 404 (defparameter *h2-default-clearpage* t)
 405
 406 (defparameter *default-number-sections* t)
 407
 408 (defmethod emit-latex-gf (stream (type (eql :h1)) children &key (newline t))
 409   (ch-util::with-keyword-args ((label
 410                                 (clearpage *h1-default-clearpage*)
 411                                 (no-number (not *default-number-sections*)))
 412                                children)
 413       children
 414     (when (and clearpage (not (eql clearpage :nil)))
 415       (emit-latex-command stream "clearpage" nil :newline t))
 416     (when (equal *document-class* "ucthesis")
 417       (emit-latex stream "\\pagestyle{fancyplain}" :newline t)
 418       (emit-latex stream "\\cfoot{}" :newline t))
 419     (emit-latex-command stream (format nil "~A~:[~;*~]"
 420                                        (cdr (assoc type (get-headings)))
 421                                        no-number)
 422                         children :newline newline)
 423     (when label
 424       (emit-latex-command stream "label" label :newline newline))))
 425
 426
 427 (defmethod emit-latex-header (stream type children &key (newline t))
 428   (ch-util::with-keyword-args ((label
 429                                 (clearpage *h2-default-clearpage*)
 430                                 (no-number (not *default-number-sections*))) children)
 431       children
 432     (when (and clearpage (not (eql clearpage :nil)))
 433       (emit-latex-command stream "clearpage" nil :newline t))
 434     (single-space stream)
 435     (emit-latex-command stream (format nil "~A~:[~;*~]"
 436                                        (cdr (assoc type (get-headings)))
 437                                        no-number)
 438                         children :newline newline)
 439     (when label
 440       (emit-latex-command stream "label" label :newline newline))
 441     (default-space stream)))
 442
 443 (defmethod emit-latex-gf (stream (type (eql :h2)) children &key (newline t))
 444
 445   (emit-latex-header stream type children :newline newline)
 446
 447   #+nil (ch-util::with-keyword-args ((label) children)
 448             children
 449           (when label
 450             (emit-latex-command stream 'label label :newline newline))))
 451
 452 (defmethod emit-latex-gf (stream (type (eql :h3)) children &key (newline t))
 453   #+nil (when (equal *document-class* "article")
 454     (emit-latex-command stream "res" '("-14pt")))
 455
 456   (emit-latex-header stream type children :newline newline))
 457
 458 (defmethod emit-latex-gf (stream (type (eql :h4)) children &key (newline t))
 459   #+nil (when (equal *document-class* "article")
 460           (emit-latex-command stream "res" '("-14pt")))
 461   (emit-latex-header stream type children :newline newline))
 462
 463 (defmethod emit-latex-gf (stream (type (eql :part)) children &key (newline nil))
 464   (emit-latex-command stream "part" (format nil "~{~A~^, ~}" children) :newline newline))
 465
 466 (defmethod emit-latex-gf (stream (type (eql :bibcite)) children &key (newline nil))
 467   (emit-latex-command stream "cite" (format nil "~{~A~^, ~}" children) :initial-freshline nil :newline newline))
 468
 469 (defmethod emit-latex-gf (stream (type (eql :caption)) children &key (newline nil))
 470   (ch-util::with-keyword-args (((figure-label t)) children)
 471       children
 472     (let ((label (if figure-label
 473                      "caption"
 474                      "caption*")))
 475       (emit-latex-command stream label children :newline newline :initial-freshline nil))))
 476
 477 (defmethod emit-latex-gf (stream (type (eql :label)) children &key (newline nil))
 478   (emit-latex-command stream "label" children :newline newline))
 479
 480 (defmethod emit-latex-gf (stream (type (eql :ref)) children &key newline)
 481   (declare (ignore newline))
 482   (emit-latex-command stream "ref" children :initial-freshline nil :newline nil))
 483
 484 (defmethod emit-latex-gf (stream (type (eql :nbsp)) children &key newline)
 485   (declare (ignore newline children))
 486   (emit-latex stream "~"))
 487
 488 (defmethod emit-latex-gf (stream (type (eql :centering)) children &key (newline nil))
 489   (emit-latex-command-6 stream "centering" children :newline newline))
 490
 491 (defmethod emit-latex-gf (stream (type (eql :center2)) children &key (newline nil))
 492   (declare (optimize (debug 3))
 493            (ignore newline))
 494   (emit-latex-newline stream)
 495   (emit-latex-command stream "begin" '("centering") :newline nil)
 496   (dolist (p children)
 497     (emit-latex stream p :newline nil))
 498   (emit-latex-command stream "end" '("centering")))
 499
 500 (defparameter *image-copy-path* nil)
 501
 502 (defparameter *copy-image-files* nil)
 503
 504 (defmethod emit-latex-gf (stream (type (eql :image)) children &key (newline t))
 505   (destructuring-bind (image-pathname &key
 506                                       (width)
 507                                       (copy *copy-image-files*)
 508                                       (convert-png-to-eps nil)
 509                                       &allow-other-keys)
 510       children
 511     (let ((image-file (ch-util:unix-name image-pathname)))
 512       (when (and copy *image-copy-path*)
 513         (let ((new-file (merge-pathnames (make-pathname :name (pathname-name image-file)
 514                                                         :type (pathname-type image-file)
 515                                                         :directory (cons :relative (nthcdr 5 (pathname-directory image-file))))
 516                                           *image-copy-path*)))
 517           (ensure-directories-exist new-file)
 518           (cond ((and convert-png-to-eps
 519                       (equal (pathname-type image-file)
 520                              "png"))
 521                  (setf new-file (merge-pathnames (make-pathname :type "eps")
 522                                                  new-file))
 523                  (print (sb-ext::run-program "/Users/sly/bin/png2eps"
 524                                              (list image-file)
 525                                              :environment '("PATH=/bobo/bin:/sw/bin:/sw/sbin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/Users/sly/bin:/opt/local/bin:")
 526                                              :if-output-exists :supersede
 527                                              :output new-file)))
 528                 (t
 529                  (cl-fad::copy-file image-file new-file :overwrite t)))
 530           (print (cons
 531                   new-file
 532                   image-file))
 533           (setf image-file new-file)))
 534       (apply #'emit-latex-command-2
 535              stream
 536              "includegraphics"
 537              (list*
 538               :arg1 image-file
 539               :newline newline
 540               (when width `(:options ,(format nil "width=~A" width))))))))
 541
 542 (defparameter *default-figure-placement* "tbp")
 543
 544 (defmethod emit-latex-gf (stream
 545                           (type (eql :figure))
 546                           children
 547                           &key
 548                           (newline t)
 549                           (placement *default-figure-placement*))
 550   (declare (ignorable newline))
 551   (ch-util::with-keyword-args (((placement placement)
 552                                 (increment-counter t)
 553                                 (subfigure-start 0)
 554                                 label) children)
 555       children
 556     (emit-latex-command-3 stream "begin" "figure" :options placement :newline nil)
 557     (when subfigure-start
 558       (let ((subfigure-start (if (numberp subfigure-start)
 559                                  subfigure-start
 560                                  (parse-integer subfigure-start))))
 561         (when (plusp subfigure-start)
 562           (list (emit-latex-command-2 stream "addtocounter"
 563                                       :arg1 "subfigure"
 564                                       :arg2 subfigure-start
 565                                       :newline nil)))))
 566     (dolist (p children)
 567       (emit-latex stream p :newline nil))
 568     (when label
 569       (emit-latex-command stream "label" label :newline t))
 570     (emit-latex-command stream "end" "figure")
 571     (when (or (not increment-counter)
 572               (eql increment-counter :nil))
 573       (list (emit-latex-command-2 stream "addtocounter" :arg1 "figure" :arg2 "-1" :newline nil)))))
 574
 575 (defmethod emit-latex-gf (stream
 576                           (type (eql :figure*))
 577                           children
 578                           &key
 579                           (newline t)
 580                           (placement *default-figure-placement*))
 581   (declare (ignorable newline))
 582   (ch-util::with-keyword-args (((placement placement) label) children)
 583       children
 584     (emit-latex-command-3 stream "begin" "figure*" :options placement :newline nil)
 585     (dolist (p children)
 586       (emit-latex stream p :newline nil))
 587     (when label
 588       (emit-latex-command stream "label" label :newline t))
 589     (emit-latex-command stream "end" "figure*")))
 590
 591 (defmethod emit-latex-gf (stream (type (eql :subfigure)) children &key (newline nil))
 592   (ch-util::with-keyword-args ((caption (increment-counter t)) children)
 593       children
 594     (when caption
 595       (setf caption (emit-children-to-string caption)))
 596     (apply #'concatenate 'string
 597            (apply #'emit-latex-command
 598                   stream "subfigure"
 599                   children
 600                   (append
 601                    (when caption `(:options ,caption))
 602                    `(:newline ,newline)))
 603            (unless (or caption increment-counter)
 604              (list (emit-latex-command-2 stream "addtocounter" :arg1 "subfigure" :arg2 "-1" :newline nil))))))
 605
 606 (defmethod emit-latex-gf (stream (type (eql :document-element)) children &key (newline t))
 607   (destructuring-bind (element &rest rest) children
 608     (emit-latex-command-3 stream "begin" element :newline newline)
 609     (dolist (p rest)
 610       (emit-latex stream p :newline nil))
 611     (when (string-equal element "abstract")
 612       (cond ((equal *document-class* "ucthesis")
 613              (emit-latex-command stream "abstractsignature" nil))))
 614     (emit-latex-command stream "end" element)))
 615
 616 (defmethod emit-latex-gf (stream (type (eql :document-command)) children &key (newline t))
 617   (destructuring-bind (element &rest rest) children
 618     (emit-latex-command-6 stream element rest :newline newline)))
 619
 620 ;;; "scicite" "pslatex" "times" "epsfig" "graphs" "newcent"
 621
 622 (defun include-contents-of-file-file (stream file)
 623   (emit-latex stream (ch-util::contents-of-file file)))
 624
 625 (defun latex-document-format (stream)
 626   (dolist (package *latex-packages*)
 627     (if (consp package)
 628         (emit-latex-command-2 stream "usepackage" :options (cdr package) :arg1 (car package))
 629         (emit-latex-command stream "usepackage" package)))
 630   (loop for (param . val) in *document-format-parameters*
 631      do (emit-latex-parameter stream param val))
 632   (dolist (command *document-latex-commands*)
 633     (emit-latex stream command)))
 634
 635 (defun latex-document (stream sexp &key (options *document-options*) (class *document-class*))
 636   (emit-latex-command-2 stream "documentclass"
 637                         :options (format nil "~{~A~^,~}" options) :arg1 class :newline t)
 638   (unless (equal *document-class* "llncs")
 639     (emit-latex-command-2 stream "setcounter"
 640                           :arg1 "secnumdepth"
 641                           :arg2 *section-numbering-depth* :newline t))
 642   (latex-document-format stream)
 643
 644   (when *document-title*
 645     (emit-latex-command stream "title" (list *document-title*)))
 646   (when *document-titlerunning*
 647     (emit-latex-command stream "titlerunning" (list *document-titlerunning*)))
 648   (when (and *document-subtitle*
 649              (equal *document-class* "beamer"))
 650     (emit-latex-command stream "subtitle" (list *document-subtitle*)))
 651   (when *document-author*
 652     (emit-latex-command stream "author" (list *document-author*)))
 653   (when *document-tocauthor*
 654     (emit-latex-command stream "tocauthor" (list *document-tocauthor*)))
 655   (when *document-authorrunning*
 656     (emit-latex-command stream "authorrunning" (list *document-authorrunning*)))
 657   (when *document-address*
 658     (emit-latex-command stream "address" (list *document-address*)))
 659   (when *document-institute*
 660     (emit-latex-command stream "institute" (list *document-institute*)))
 661   (when *document-date*
 662     (emit-latex-command stream "date" (list *document-date*)))
 663   (when (equal *document-class* "ucthesis")
 664     (when *document-degree-year*
 665       (emit-latex-command stream "degreeyear" (list *document-degree-year*)))
 666     (when *document-degree-semester*
 667       (emit-latex-command stream "degreesemester" (list *document-degree-semester*)))
 668     (when *document-degree*
 669       (emit-latex-command stream "degree" (list *document-degree*)))
 670     (when *document-chair*
 671       (emit-latex-command stream "chair" (list *document-chair*)))
 672     (when *document-other-members*
 673       (emit-latex-command stream "othermembers" (list *document-other-members*)))
 674     (when *document-number-of-members*
 675       (emit-latex-command stream "numberofmembers" (list *document-number-of-members*)))
 676     (when *document-prev-degrees*
 677       (emit-latex-command stream "prevdegrees" (list *document-prev-degrees*)))
 678     (when *document-field*
 679       (emit-latex-command stream "field" (list *document-field*)))
 680     (when *document-campus*
 681       (emit-latex-command stream "campus" (list *document-campus*))))
 682
 683   (cond ((equal *document-class* "ucthesis")
 684          (emit-latex stream
 685                      (format nil
 686                              "\\def\\dsp{\\def\\baselinestretch{~A}\\large\\normalsize}"
 687                              *baseline-stretch*)
 688                      :newline t)
 689          (emit-latex stream "\\dsp" :newline t)
 690
 691          (emit-latex stream "\\addtolength{\\headheight}{\\baselineskip}" :newline t)
 692          #+nil
 693          (progn
 694            (emit-latex stream "\\lhead[\\fancyplain{}\\sl\\thepage]{\\fancyplain{}\\sl\\rightmark}" :newline t)
 695            (emit-latex stream "\\rhead[\\fancyplain{}\\sl\\leftmark]{\\fancyplain{}\\sl\\thepage}" :newline t)
 696            (emit-latex stream "\\lhead[\\fancyplain{}\\bfseries\\thepage]{\\fancyplain{}\\bfseries\\rightmark}" :newline t)
 697            (emit-latex stream "\\rhead[\\fancyplain{}\\bfseries\\leftmark]{\\fancyplain{}\\bfseries\\thepage}" :newline t))
 698          (progn (emit-latex stream "\\lhead[\\fancyplain{}{}]{\\fancyplain{}{\\bfseries\\leftmark}}" :newline t)
 699                 (emit-latex stream "\\rhead[\\fancyplain{}{}]{\\fancyplain{\\bfseries\\thepage}{\\bfseries\\thepage}}" :newline t))
 700          (emit-latex stream "\\hyphenpenalty=1000" :newline t)
 701          (emit-latex stream "\\clubpenalty=500" :newline t)
 702          (emit-latex stream "\\widowpenalty=500" :newline t)
 703          (princ *thesis-preamble* stream))
 704         ((equal *document-class* "beamer")
 705          (princ *beamer-preamble* stream))
 706         ((equal *document-class* "res")
 707          (princ *res-preamble* stream))
 708         ((equal *document-class* "llncs")
 709          (princ *llncs-preamble* stream))
 710         ((equal *document-class* "acm_proc_article-sp")
 711          (princ *acm-proc-article-preamble* stream))
 712         (t
 713          (emit-latex stream "\\geometry{verbose,tmargin=1in,bmargin=1in,lmargin=1in,rmargin=1in}" :newline t)
 714          (princ *article-preamble* stream)))
 715
 716   (emit-latex-command stream "begin" "document")
 717   (emit-latex-freshline stream)
 718
 719   (cond ((equal *document-class* "beamer"))
 720         ((equal *document-class* "res"))
 721         ((equal *document-class* "acm_proc_article-sp"))
 722         (t
 723          (when *document-titlepage*
 724            (emit-latex stream "\\maketitle" :newline t))))
 725
 726   (cond ((equal *document-class* "llncs"))
 727         ((equal *document-class* "acm_proc_article-sp"))
 728         (t
 729          (emit-latex stream "\\let\\mypdfximage\\pdfximage" :newline t)
 730          (emit-latex stream "\\def\\pdfximage{\\immediate\\mypdfximage}" :newline t)))
 731
 732   (cond ((equal *document-class* "ucthesis")
 733          (progn
 734            (when *thesis-approval-page*
 735              (emit-latex stream "\\approvalpage" :newline t))
 736            (emit-latex stream "\\copyrightpage" :newline t)))
 737         ((equal *document-class* "beamer"))
 738         ((equal *document-class* "llncs"))
 739         ((equal *document-class* "acm_proc_article-sp"))
 740         (t
 741          (emit-latex stream (format nil "\\baselineskip~A" *baseline-skip*) :newline t)))
 742
 743   (dolist (p sexp)
 744     (emit-latex stream p))
 745
 746   (emit-latex-command stream "end" "document"))
 747
 748 (defun latex-use-package (stream package)
 749   (emit-latex-command stream "usepackage" package))
 750
 751 (defun latex-use-packages (stream &rest packages)
 752   (mapcar #'(lambda (x) (latex-use-package stream x)) packages))
 753
 754 ;;; Bibliography stuff
 755
 756 (defun latex-cite (stream ref)
 757   (emit-latex-command stream "cite" ref))
 758
 759 (defun latex-bibliography-style (stream style)
 760   (emit-latex-command stream "bibliographystyle" style))
 761
 762 (defun latex-bibliography (stream bib)
 763   (emit-latex-command stream "bibliography" bib))
 764
 765 ;;; The main entry point to this stuff
 766
 767 (defmethod render-as ((type (eql :latex)) sexp file)
 768   (let ((*document-class* *document-class*)
 769         (*document-degree-year* *document-degree-year*)
 770         (*document-degree-semester* *document-degree-semester*)
 771         (*document-degree* *document-degree*)
 772         (*document-chair* *document-chair*)
 773         (*document-other-members* *document-other-members*)
 774         (*document-number-of-members* *document-number-of-members*)
 775         (*document-prev-degrees* *document-prev-degrees*)
 776         (*document-field* *document-field*)
 777         (*document-campus* *document-campus*)
 778         (*latex-packages* *latex-packages*)
 779         (*document-format-parameters* *document-format-parameters*))
 780     (setup-headings))
 781   (with-open-file (stream file :direction :output :if-exists :supersede)
 782     (latex-document stream sexp)))
 783
 784
 785 ;; the intent here is that :bibliography is a tag with no children and
 786 ;; that we should output the appropriate latex bibliography here.
 787 (defmethod emit-latex-gf (stream (type (eql :bibliography)) children &key (newline t))
 788   (declare (optimize (debug 3)) (ignore newline))
 789   (destructuring-bind (&rest rest &key (clearpage t) &allow-other-keys)
 790       children
 791     (declare (ignore rest))
 792     (when (and clearpage (not (eql clearpage :nil)))
 793       (emit-latex-command stream "clearpage" nil :newline t)))
 794   (unless (member *document-class* '("beamer" "llncs") :test 'equal)
 795     (emit-latex stream (format nil "\\baselineskip~A" "11pt") :newline t))
 796   (let ((style-function (bibtex-compiler:find-bibtex-style *bibtex-style*))
 797       (bibtex-runtime:*cite-keys* (reverse *cite-keys*))
 798       (bibtex-runtime:*bib-macros* *bibtex-macros*)
 799       (bibtex-runtime:*bib-database* *bibtex-database*)
 800       (bibtex-runtime:*bib-files* nil)
 801       (bibtex-runtime:*bbl-output* stream))
 802   (funcall style-function)))
 803
 804 (defmethod emit-latex-gf (stream (type (eql :table-of-contents)) children &key (newline t))
 805   (declare (ignore newline))
 806   (emit-latex stream "\\tableofcontents" :newline t))
 807
 808 (defmethod emit-latex-gf (stream (type (eql :list-of-figures)) children &key (newline t))
 809   (declare (ignore newline))
 810   (emit-latex stream "\\listoffigures" :newline t))
 811
 812 (defmethod emit-latex-gf (stream (type (eql :table-of-tables)) children &key (newline t))
 813   (declare (ignore newline))
 814   (emit-latex stream "\\listoftables" :newline t))
 815
 816
 817 ;;; equations
 818
 819 ;; FIXME!!!
 820
 821 (defmethod emit-latex-gf (stream (type (eql :quotation)) children &key (newline t))
 822   (declare (ignorable newline))
 823   (emit-latex-command-3 stream "begin" "quotation" :newline nil)
 824   (dolist (p children)
 825     (emit-latex stream p :newline nil))
 826   (emit-latex-command stream "end" "quotation" :newline t))
 827
 828 (defmethod emit-latex-gf (stream (type (eql :equation)) children &key (newline t))
 829   (declare (ignorable newline))
 830   (emit-latex-command-3 stream "begin" "equation" :newline nil)
 831   (dolist (p children)
 832     (emit-latex stream p :newline nil))
 833   (emit-latex-command stream "end" "equation" :newline t))
 834
 835 (defmethod emit-latex-gf (stream (type (eql :matrix)) children &key (newline t))
 836   (declare (ignorable newline))
 837   (princ "$" stream)
 838   (emit-latex-command-3 stream "begin" "matrix" :newline nil)
 839   (dolist (p children)
 840     (emit-latex stream p :newline nil))
 841   (emit-latex-command stream "end" "matrix" :newline nil)
 842   (princ "$" stream))
 843
 844 (defmethod emit-latex-gf (stream (type (eql :bmatrix)) children &key (newline t))
 845   (declare (ignorable newline))
 846   (princ "$" stream)
 847   (emit-latex-command-3 stream "begin" "bmatrix" :newline nil)
 848   (dolist (p children)
 849     (emit-latex stream p :newline nil))
 850   (emit-latex-command stream "end" "bmatrix" :newline nil)
 851   (princ "$" stream))
 852
 853 ;;; tables
 854
 855 (defmethod emit-latex-gf (stream (type (eql :table)) children &key newline)
 856   (destructuring-bind ((&key cols
 857                              top-line) (&rest children))
 858       (apply #'ch-util::remove-keywordish-args '(:cols
 859                                                  :top-line) children)
 860     (emit-latex-command-3 stream "begin" "tabular" :arg1 cols)
 861     (when top-line
 862       (emit-latex stream (format nil "\\hline~%")))
 863     (loop for c in children collect
 864          (emit-latex stream c))
 865     (emit-latex-command-3 stream "end" "tabular")
 866     (when newline (emit-latex-newline stream))))
 867
 868 (defun emit-table-row (stream children &key (newline t))
 869   (emit-latex stream (format nil "~{~A~^ & ~}\\\\"
 870                              (mapcar #'(lambda (x)
 871                                          (emit-latex nil x))
 872                                      children)) :newline newline))
 873
 874 (defmethod emit-latex-gf (stream (type (eql :longtable)) children &key newline)
 875   (destructuring-bind ((&key cols
 876                              top-line
 877                              heading
 878                              caption
 879                              (first-heading heading)
 880                              (first-caption caption)
 881                              (font-size "small")) (&rest children))
 882       (apply #'ch-util::remove-keywordish-args '(:cols
 883                                                  :top-line
 884                                                  :heading
 885                                                  :caption
 886                                                  :first-heading
 887                                                  :first-caption
 888                                                  :font-size) children)
 889
 890     (single-space stream)
 891     (with-latex-block font-size
 892       stream
 893       (emit-latex-command-3 stream "begin" "longtable" :arg1 cols)
 894
 895       (when first-caption
 896         (destructuring-bind (first-caption)
 897             first-caption
 898           (emit-latex-command stream "caption" first-caption :newline nil)
 899           (emit-latex stream "\\\\" :newline t)))
 900
 901       (when top-line
 902         (emit-latex stream "\\hline" :newline t))
 903
 904       (when first-heading
 905         (emit-table-row stream (car first-heading))
 906         (loop for c in (cdr first-heading)
 907            do (emit-latex stream c)))
 908       (emit-latex stream "\\endfirsthead" :newline t)
 909
 910       (when caption
 911         (destructuring-bind (caption)
 912             caption
 913           (emit-latex-command stream "caption" caption :newline nil)
 914           (emit-latex stream "\\\\" :newline t)))
 915
 916       (when top-line
 917         (emit-latex stream "\\hline" :newline t))
 918
 919       (when heading
 920         (emit-table-row stream (car heading))
 921         (loop for c in (cdr heading)
 922            do (emit-latex stream c)))
 923       (emit-latex stream "\\endhead" :newline t)
 924
 925       (loop for c in children collect
 926            (emit-latex stream c))
 927       (emit-latex-command-3 stream "end" "longtable")
 928       (when newline (emit-latex-newline stream)))
 929     (default-space stream)))
 930
 931 (defmethod emit-latex-gf (stream (type (eql :table-row)) children &key (newline t))
 932   (destructuring-bind ((&key multicolumn (spec "|c|")) (&rest children))
 933       (apply #'ch-util::remove-keywordish-args '(:multicolumn :spec) children)
 934     (if multicolumn
 935         (progn (apply #'emit-latex-command-3 stream "multicolumn" multicolumn
 936                       :arg1 spec
 937                       :newline nil
 938                       :arg2 (mapcar #'(lambda (x)
 939                                         (emit-latex nil x))
 940                                     children))
 941                (emit-latex stream "\\\\" :newline newline))
 942         (emit-latex stream (format nil "~{~A~^ & ~}\\\\"
 943                                    (mapcar #'(lambda (x)
 944                                                (emit-latex nil x))
 945                                            children)) :newline newline))))
 946
 947 (defmethod emit-latex-gf (stream (type (eql :horizontal-line)) children &key (newline t))
 948   (emit-latex stream "\\hline" :newline newline))
 949
 950 ;;;
 951 ;;;
 952 ;;; beamer stuff
 953 (defmethod emit-latex-gf (stream (type (eql :slide)) children &key (newline t))
 954   (ch-util::with-keyword-args ((slide-title) children)
 955       children
 956     (emit-latex-command-2 stream "frame")
 957     (format stream "{")
 958     (when slide-title (emit-latex-command-2 stream "frametitle" :arg1 slide-title))
 959     (loop for c in children do (emit-latex stream c))
 960     (format stream "}")
 961     (when newline
 962       (emit-latex-newline stream))))
 963
 964 (defmethod emit-latex-gf (stream (type (eql :title-page)) children &key (newline t))
 965   (declare (ignore newline))
 966   (emit-latex-command-2 stream "titlepage"))
 967
 968 (defmethod emit-latex-gf (stream (type (eql :table-of-contents)) children &key (newline t))
 969   (declare (ignore newline))
 970   (emit-latex-command-2 stream "tableofcontents"))
 971
 972 (defmethod emit-latex-gf (stream (type (eql :list)) children &key (newline t))
 973   (emit-latex-command stream "begin" '("itemize") :newline newline)
 974   (loop for c in children do (emit-latex stream c))
 975   (emit-latex-command stream "end" '("itemize") :newline newline))
 976
 977 (defmethod emit-latex-gf (stream (type (eql :item)) children &key (newline t))
 978   (declare (ignore newline))
 979   (emit-latex-command-2 stream "item " :newline nil)
 980   (loop for c in children do (emit-latex stream c)))
 981
 982 (defmethod emit-latex-gf (stream (type (eql :colorbox)) children &key (newline nil))
 983   (ch-util::with-keyword-args (((color "white")) children)
 984       children
 985     (emit-latex-command-6 stream "colorbox" children :arg color :newline newline)))
 986
 987 ;;; columns for beamer
 988 (defmethod emit-latex-gf (stream (type (eql :columns)) children &key (newline t))
 989   (ch-util::with-keyword-args ((format) children)
 990       children
 991     (emit-latex-command-5 stream "begin" :arg1 "columns" :arg2 format :newline newline)
 992     (loop for c in children do (emit-latex stream c))
 993     (emit-latex-command stream "end" '("columns") :newline newline)))
 994
 995 (defmethod emit-latex-gf (stream (type (eql :column)) children &key (newline t))
 996   (ch-util::with-keyword-args ((width) children)
 997       children
 998     (emit-latex-command-2 stream "begin" :arg1 "column" :arg2 (format nil "~A\\textwidth" width) :newline newline)
 999     (loop for c in children do (emit-latex stream c))
1000     (emit-latex-command stream "end" '("column") :newline newline)))
1001
1002 ;;; minipage (for use with captions)
1003
1004
1005 (defmethod emit-latex-gf (stream (type (eql :minipage)) children &key (newline t))
1006   (ch-util::with-keyword-args (((width "0.5")) children)
1007       children
1008     (emit-latex-command-5 stream "begin" :arg1 "minipage" :arg2 "t"
1009                           :arg3 (format nil "~A\\linewidth" width) :newline newline)
1010     (loop for c in children do (emit-latex stream c))
1011     (emit-latex-command stream "end" '("minipage") :newline newline)))
1012
1013
1014 ;;; resume stuff
1015
1016 (defmethod emit-latex-gf (stream (type (eql :name)) children &key (newline nil))
1017   (emit-latex-command stream "name" children :newline newline))
1018
1019 (defmethod emit-latex-gf (stream (type (eql :employer)) children &key (newline nil))
1020   (emit-latex-command stream "employer" children :newline newline))
1021
1022 (defmethod emit-latex-gf (stream (type (eql :position-title)) children &key (newline nil))
1023   (emit-latex-command stream "title" children :newline newline))
1024
1025 (defmethod emit-latex-gf (stream (type (eql :dates)) children &key (newline nil))
1026   (emit-latex-command stream "dates" children :newline newline))
1027
1028 (defmethod emit-latex-gf (stream (type (eql :location)) children &key (newline nil))
1029   (emit-latex-command stream "location" children :newline newline))
1030
1031 (defmethod emit-latex-gf (stream (type (eql :position)) children &key (newline t))
1032   (emit-latex-command stream "begin" '("position") :newline newline)
1033   (loop for c in children do (emit-latex stream c))
1034   (emit-latex-command stream "end" '("position") :newline newline))
1035
1036 (defmethod emit-latex-gf (stream (type (eql :resume)) children &key (newline t))
1037   (emit-latex-command stream "begin" '("resume") :newline newline)
1038   (loop for c in children do (emit-latex stream c))
1039   (emit-latex-command stream "end" '("resume") :newline newline))
1040
1041 (defmethod emit-latex-gf (stream (type (eql :list1)) children &key (newline t))
1042   (emit-latex-command stream "begin" '("list1") :newline newline)
1043   (loop for c in children do (emit-latex stream c))
1044   (emit-latex-command stream "end" '("list1") :newline newline))
1045
1046 (defmethod emit-latex-gf (stream (type (eql :list2)) children &key (newline t))
1047   (emit-latex-command stream "begin" '("list2") :newline newline)
1048   (loop for c in children do (emit-latex stream c))
1049   (emit-latex-command stream "end" '("list2") :newline newline))
1050