emacs/pbook.el

   1 ;;; pbook.el -- Format a program listing for LaTeX.
   2 ;;;
   3 ;;; More mangling by Paul Khuong on 2007-Jan-31 to typeset
   4 ;;;  code in a more generic and customisable manner, including
   5 ;;;  a rough xref (annotates definition sites).
   6 ;;; Mangled by Paul Khuong (pvk@pvk.ca) on 2007-Jan-20 to
   7 ;;;  emit coloured/bold/italic \tt code instead of verbatim
   8 ;;;      pbook.el,v 1.4 2007/01/20
   9 ;;; Written by Luke Gorrie <luke@member.fsf.org> in May of 2004.
  10 ;;; $Id: pbook.el,v 1.3 2004/05/17 01:09:01 luke Exp luke $
  11 ;;;
  12 ;;; TODO:
  13 ;;;
  14 ;;; X Remove FIXMEs, etc from index.
  15 ;;;
  16 ;;; X Replace pbook-latex-escape with pbook-escape-code-substring
  17 ;;;    Find way to make space work.
  18 ;;;
  19 ;;; o Better xreferencing. Run a first pass to identify all
  20 ;;;   the toplevel definitions [as fontified], then annotate
  21 ;;;   the source correctly; either change the face, or use the
  22 ;;;   escaping mechanism. Changing the face sounds more robust.
  23 ;;;   This could run as advice over pbook-process-buffer.
  24 ;;;   The face changing could be an advice on pbook-escape-code,
  25 ;;;   or, since we ignore face info outside of code, over the
  26 ;;;   whole buffer, w/ the definition identification.
  27 ;;;   If want to avoid multiple passes (why?), can accumulate
  28 ;;;   toplevel defn names while processing them.
  29 ;;;
  30 ;;; X Add a public variable for the current line number (for
  31 ;;;   property -> latex, especially)
  32 ;;;
  33 ;;; _ Make all/most of the extras togglable.
  34 ;;;
  35 ;;; X Rewrite the code escaping functions to use regexes instead of
  36 ;;;   searching ourselves.
  37 ;;;
  38 ;;; ? Allow escaped `raw' latex strings in comments
  39 ;;;
  40 ;;; o Improve (think) the interface for customising code output
  41 ;;;
  42 ;;; X Find some way to customise font-lock for paper automatically,
  43 ;;;   or introduce alists for italic, bold & colour override (per face)?
  44 ;;;   Currently: converts to yuv, flips the luminance and back to rgb.
  45 ;;;
  46 ;;;# Introduction
  47 ;;;
  48 ;;; Have you ever printed out a program and read it on paper?
  49 ;;;
  50 ;;; It is an interesting exercise to try with one of your own
  51 ;;; programs, one that you think is well-written. The first few times
  52 ;;; you will probably find that it's torture to try and read in a
  53 ;;; straight line. What seemed so nice in Emacs is riddled with
  54 ;;; glaring problems on paper.
  55 ;;;
  56 ;;; How a program reads on paper may not be very important in itself,
  57 ;;; but there is wonderful upside to this. If you go through the
  58 ;;; program with a red pen and fix all the mind-bendingly obvious
  59 ;;; problems you see, what happens is that the program greatly
  60 ;;; improves -- not just on paper, but also in Emacs!
  61 ;;;
  62 ;;; This is a marvellously effective way to make programs
  63 ;;; better.
  64 ;;;
  65 ;;; Let's explore the idea some more!
  66 ;;;
  67 ;;;# `pbook'
  68 ;;;
  69 ;;; This program, `pbook', is a tool for making readable programs by
  70 ;;; generating LaTeX'ified program listings. Its purpose is to help
  71 ;;; you improve your programs by making them read well on paper. It
  72 ;;; serves this end by generating pretty-looking PDF output for you to
  73 ;;; print out and attack with a red pen, and perhaps use the medium to
  74 ;;; trick your mind into seeking the clarity of a technical paper and
  75 ;;; bringing your prose-editing skills to bear on your source code.
  76 ;;;
  77 ;;; `pbook' is aware of three things: headings, top-level comments,
  78 ;;; and code. Headings become LaTeX sections, and have entries in a
  79 ;;; table of contents. Top-level comments become plain text in a nice
  80 ;;; variable-width font. Other source code is listed as-is in a
  81 ;;; fixed-width font.
  82 ;;;
  83 ;;; These different elements are distinguished in the source using
  84 ;;; maximally unobtrusive markup, which you can see at work in the
  85 ;;; `pbook.el' source code.
  86 ;;;
  87 ;;; Read on to see the program and how it works.
  88 ;;;
  89 ;;;# Prelude
  90 ;;;
  91 ;;; (I have successfully tested this program with GNU Emacs versions
  92 ;;; 20.7 and 21.3, and with XEmacs version 21.5.)
  93 ;;;
  94 ;;; This is actually not true anymore. I have tested this in GNU Emacs
  95 ;;; 22.??? and 21.???. While I don't expect there to be any portability
  96 ;;; problem, it has not been tested in XEmacs at all.
  97 ;;;
  98 ;;; For some tiny luxuries and portability help we use the Common Lisp
  99 ;;; compatibility library:
 100 (require 'cl)
 101
 102 ;;;# Emacs commands
 103 ;;;
 104 ;;; A handful of Emacs commands make up the pbook user-interface. The
 105 ;;; most fundamental is to render a pbook-formatted Emacs buffer as
 106 ;;; LaTeX.
 107
 108 (defun pbook-buffer ()
 109   "Generate LaTeX from the current (pbook-formatted) buffer.
 110 The resulting source is displayed in a buffer called *pbook*."
 111   (interactive)
 112   (pbook-process-buffer))
 113
 114 ;;; A very handy utility is to display a summary of the buffer's
 115 ;;; structure and use it to jump to an appropriate section. I've
 116 ;;; always enjoyed being able to do this in texinfo-mode. Happily,
 117 ;;; pbook gets this for free using the `occur' function, which lists
 118 ;;; all lines in the buffer that match some regular expression.
 119
 120 (defun pbook-show-structure ()
 121   "Display the pbook heading structure of the current buffer."
 122   (interactive)
 123   (occur pbook-heading-regexp))
 124
 125 ;;; To avoid a lot of mucking about in the shell there is also a
 126 ;;; command to generate and display a PDF file. This function is a
 127 ;;; quick hack to make experimentation easy.
 128 ;;;
 129 ;;; I should add a function to do the same with dvis, and to output
 130 ;;; to non-temporary files.
 131
 132 (defun pbook-buffer-view-pdf ()
 133   "Generate and display PDF from the current buffer.
 134 The intermediate files are created in the standard temporary
 135 directory."
 136   (interactive)
 137   (save-window-excursion
 138     (pbook-buffer))
 139   (with-current-buffer "*pbook*"
 140     (let ((texfile (pbook-tmpfile "pbook" "tex"))
 141           (pdffile (pbook-tmpfile "pbook" "pdf"))
 142           (idxfile (pbook-tmpfile "pbook" "idx")))
 143       (write-region (point-min) (point-max) texfile)
 144       ;; Possibly there is a better way to ensure that LaTeX generates
 145       ;; the table of contents correctly than to run it more than
 146       ;; once, but I don't know one.
 147       (shell-command (format "\
 148   cd /tmp; latex %s && \
 149   makeindex %s && \
 150   pdflatex %s && acroread %s &"
 151                              texfile
 152                              idxfile
 153                              texfile pdffile)))))
 154
 155 (defun pbook-buffer-view-dvi ()
 156   "Generate and display DVI from the current buffer.
 157 The intermediate files are created in the standard temporary
 158 directory."
 159   (interactive)
 160   (save-window-excursion
 161     (pbook-buffer))
 162   (with-current-buffer "*pbook*"
 163     (let ((texfile (pbook-tmpfile "pbook" "tex"))
 164           (dvifile (pbook-tmpfile "pbook" "dvi"))
 165           (idxfile (pbook-tmpfile "pbook" "idx")))
 166       (write-region (point-min) (point-max) texfile)
 167       ;; Possibly there is a better way to ensure that LaTeX generates
 168       ;; the table of contents correctly than to run it more than
 169       ;; once, but I don't know one.
 170       (shell-command (format "\
 171   cd /tmp; latex %s && \
 172   makeindex %s && \
 173   latex %s && xdvi %s &"
 174                              texfile
 175                              idxfile
 176                              texfile dvifile)))))
 177
 178 (defun pbook-buffer-regenerate-dvi ()
 179   (interactive)
 180   (save-window-excursion
 181     (pbook-buffer))
 182   (with-current-buffer "*pbook*"
 183     (let ((texfile (pbook-tmpfile "pbook" "tex"))
 184           (idxfile (pbook-tmpfile "pbook" "idx")))
 185       (write-region (point-min) (point-max) texfile)
 186       ;; Possibly there is a better way to ensure that LaTeX generates
 187       ;; the table of contents correctly than to run it more than
 188       ;; once, but I don't know one.
 189       (shell-command (format "\
 190   cd /tmp; latex %s && \
 191   makeindex %s && \
 192   latex %s"
 193                              texfile
 194                              idxfile
 195                              texfile)))))
 196
 197 (defun pbook-tmpfile (name extension)
 198   "Return the full path to a temporary file called NAME and with EXTENSION.
 199 An appropriate directory is chosen and the PID of Emacs is inserted
 200 before the extension."
 201   (format "%s%s-%S.%s"
 202           (if (boundp 'temporary-file-directory)
 203               temporary-file-directory
 204             ;; XEmacs does it this way instead:
 205             (temp-directory))
 206           name (emacs-pid) extension))
 207
 208 ;;;# Configurable variables
 209 ;;;
 210 ;;; These are variables that can be customized to affect pbook's
 211 ;;; behaviour. The default regular expressions assume Lisp-style
 212 ;;; comment characters, but they can be overridden with buffer-local
 213 ;;; bindings from hooks for other programming modes. The other
 214 ;;; variables that control formatting are best configured with Emacs's
 215 ;;; magic "file variables" (see down the very bottom for an example).
 216
 217 (defvar pbook-commentary-regexp "^;;;\\($\\|[^#]\\)"
 218   "Regular expression matching lines of high-level commentary.")
 219
 220 (defvar pbook-heading-regexp "^;;;\\(#+\\)"
 221   "Regular expression matching heading lines of chapters/sections/headings.")
 222
 223 (defvar pbook-heading-level-subexp 1
 224   "The subexpression of `pbook-heading-regexp' whose length indicates nesting.")
 225
 226 (defvar pbook-include-toc t
 227   "When true include a table of contents.")
 228
 229 (defvar pbook-style 'article
 230   "Style of output. Either article (small) or book (large).")
 231
 232 (defvar pbook-author (user-full-name)
 233   "The name to use in the \author LaTeX command.")
 234
 235 ;;;## Configuration variables for code formatting
 236
 237 (defvar pbook-code-prologue "\
 238 \\vspace{1pc}
 239 \\begin{adjustwidth}{0in}{-1.5in}
 240 \\begin{flushleft}
 241 "
 242   "Tex string to prepend to code listings")
 243
 244 (defvar pbook-code-epilogue "\
 245 \\end{flushleft}
 246 \\end{adjustwidth}
 247 \\vspace{1pc}
 248 "
 249   "Tex string to append to code listings")
 250
 251 (defvar pbook-current-line nil
 252   "Holds the line number being processed. Note that this
 253 is reset for every new section of code. This variable
 254 is only accessible while processing code lines, obviously.")
 255
 256 (defvar pbook-current-total-lines nil
 257   "Holds the total number of lines in the section of
 258 code that's being processed.")
 259
 260 (defun pbook-around-code-line (line-number total-lines)
 261   "returns a list of Tex strings `(prepend append)' to
 262 surround the line in a code listing. It may also append
 263 any number of entries to put in `pbook-escaping-regexps'.
 264 It receives, as its arguments, the line number and the
 265 total number of lines in the code segment."
 266   (labels ((repeat (string num)
 267              (if (<= num 0)
 268                  ""
 269                (concat string (repeat string (1- num))))))
 270     (if (looking-at "^ *$")
 271         (list "~" "\\\\")
 272       (let ((str (number-to-string (1+ line-number))))
 273         (list (concat "\\hspace{-.4in}{\\small\\texttt{"
 274                       (repeat "\\ " (max 1 (- 4 (length str))))
 275                       str
 276                       "\\ \\ "
 277                       "}}")
 278               (if (= line-number (- total-lines 1))
 279                   "\\\\"
 280                  "\\nopagebreak[4]\\\\"))))))
 281
 282 (defvar pbook-dark-colors '("black")
 283   "List of dark colours. Used by the coloring property
 284 to detect when to flip luminances.")
 285
 286 (defvar pbook-face-latex-properties '()
 287   "plist of latex properties for current face
 288  (only active while calling functions in `pbook-properties')")
 289
 290 (defvar pbook-monochrome t
 291   "Force every color to be the specified color (list of rgb components)
 292 or t for standard black. nil for normal colors.")
 293
 294 (defvar pbook-font-lock-override '(("\\(\\.\\|\\w\\)\\{2,\\}"
 295                                     0 (string-to-syntax "word") ;; was `pbook-identifier'
 296                                     keep t))
 297   "Appended to `font-lock-syntactic-keywords' while fontifying.")
 298
 299 ;;;## configuration for the translation of properties to Latex
 300 ;;;
 301 ;;; The code formatting engine is composed of two parts:
 302 ;;; a system of properties that link font-lock faces and syntactic
 303 ;;; markup with latex environments, and a string escaping function.
 304 ;;; These variables let us easily customise both of these systems.
 305
 306 (defvar pbook-current-text-properties nil
 307   "text-properties of the current region of text. Maybe be used
 308 by the property transformation functions to fine-tune their
 309 output.")
 310
 311 ;;; The most common customisation will be to change the way faces
 312 ;;; are shown on paper. By default, they are translated faithfully:
 313 ;;; color, slantedness and boldness are directly translated.
 314 ;;; While a value of `nil' means don't care (and defers to other
 315 ;;; faces properties or default property values), `:no', by default,
 316 ;;; disables the associated property.
 317
 318 (defvar pbook-face-override '((font-lock-keyword-face :bold t :index :no)
 319                               (font-lock-builtin-face :bold t :index :no)
 320                               (font-lock-function-name-face
 321                                                       :sc t :tt :no
 322                                                       :index function)
 323                               (font-lock-variable-name-face
 324                                                       :sc t :tt :no
 325                                                       :index variable)
 326                               (font-lock-warning-face :bold t :index :no)
 327                               (font-lock-comment-face :italic t :tt :no :index :no)
 328                               (font-lock-doc-face     :italic t :tt :no :index :no)
 329                               (font-lock-constant-face :italic :no :index :no)
 330                               (font-lock-string-face  :index :no)
 331                               (paren-face             :intensity .5)
 332                               (default                :italic :no))
 333   "Alist that associates a face with a set of default properties.")
 334
 335 (defvar pbook-escaping-regexps '(("<" . "\\\\textless{}")
 336                                  (">" . "\\\\textgreater{}")
 337                                  ("\\\\" . "\\\\textbackslash{}")
 338                                  ("~" . "\\\\textasciitilde{}")
 339                                  ("\\^" . "\\\\textasciicircum{}")
 340                                  ("[#%&$_{}]" . "\\\\\\&")) ;;space added as needed in pbook-latex-escape
 341   "alist of regexp -> replacement (passed to re-search-forward and replace-match)
 342 A simple way to index FIXMEs would be to add a regex for that in this list.")
 343
 344 ;;; `pbook-properties' defines pbook properties: their name,
 345 ;;; when they are applied (by default), and how they are translated
 346 ;;; into Latex.
 347 ;;; It is a list of triples `([name] [default-value] [translater])'.
 348 ;;; `[name]' is an unique identifier for the property.
 349 ;;; `[default-value]' is an unary function that, given the face,
 350 ;;; returns the value to associate with the property (or `nil'
 351 ;;; to defer).
 352 ;;; `[translater]' is either an unary function that, given
 353 ;;; the property's value, returns a list of a string to prepend
 354 ;;; to the formatted region, a string to append to it, and
 355 ;;; any number of pairs as in `pbook-escaping-regexps'.
 356 ;;; Latex code is spliced outside (for the first property)
 357 ;;; in (for the last property).
 358
 359 (defvar pbook-properties
 360   `((:color
 361      pbook-face-color
 362      (lambda (color)
 363        (if (or (null color)
 364                (eq pbook-monochrome t)
 365                (every (lambda (component)
 366                         (< component 0.01))
 367                       color))
 368            nil
 369          (let ((components (mapcar (lambda (component)
 370                                      (if (< component 0.01)
 371                                          "0"
 372                                        (number-to-string component)))
 373                                    (or pbook-monochrome
 374                                        color))))
 375            (list (format "\\textcolor[rgb]{%s, %s, %s}{"
 376                          (first components)
 377                          (second components)
 378                          (third components))
 379                  "}")))))
 380
 381     (:intensity
 382      (lambda (face)
 383        nil)
 384      (lambda (intensity)
 385        (if (null intensity)
 386            nil
 387          (let* ((default-color (if (or (null pbook-monochrome)
 388                                        (eq pbook-monochrome t))
 389                                    '(0.0 0.0 0.0)
 390                                  pbook-monochrome))
 391                 (yuv-default   (apply 'pbook-rgb-yuv default-color))
 392                 (yuv-intensity (list* (- 1 (* intensity (- 1 (car yuv-default))))
 393                                       (cdr yuv-default)))
 394                 (rgb-intensity (apply 'pbook-yuv-rgb yuv-intensity)))
 395            (list (apply 'format
 396                         "\\textcolor[rgb]{%s, %s, %s}{"
 397                         rgb-intensity)
 398                  "}")))))
 399
 400     (:bold   face-bold-p
 401              (lambda (prop)
 402                (and prop
 403                     (not (eq prop :no))
 404                     (looking-at " *[^ ]")
 405                     '("\\textbf{" "}"))))
 406
 407     (:italic face-italic-p
 408              (lambda (prop)
 409                (and prop
 410                     (not (eq prop :no))
 411                     (looking-at " *[^ ]")
 412                     '("\\textit{" "}"))))
 413
 414     (:tt     (lambda (face)
 415                t)
 416              (lambda (prop)
 417                (when (or (not (looking-at " *[^ ]")) ;; always \tt whitespace.
 418                          (and prop
 419                               (not (eq prop :no))))
 420                  '("\\texttt{" "}"))))
 421
 422     (:sc     (lambda (face)
 423                nil)
 424              ("\\textsc{" "}"))
 425
 426     (:index  (lambda (face)
 427                (and (eq face 'default)
 428                     (equal (plist-get pbook-current-text-properties
 429                                       'syntax-table)
 430                            (string-to-syntax "word"))
 431                     'use))
 432              (lambda (index)
 433                (when (and index
 434                           (not (eq index :no)))
 435                  (let* ((pbook-escaping-regexps (list* (cons "[!@|]" "\"\\&")
 436                                                        pbook-escaping-regexps))
 437                         (word (pbook-latex-escape-string (buffer-string))))
 438                    (list (format "\\index{%s%s}{" word (ecase index
 439                                                          ((function) "|bb")
 440                                                          ((variable) "|ii")
 441                                                          ((use) "")))
 442                          "}")))))
 443     )
 444   "Complex system. See paragraph above.")
 445
 446 (defun pbook-face-color (face)
 447   "Given a face, return a triplet of rgb values. Flips the luminance
 448 as needed (to adapt dark background colours to a light background)."
 449   (let ((dark-bg-p (or (and (boundp 'face-background-mode)
 450                             (eq face-background-mode 'dark))
 451                        (member (face-background face)
 452                                pbook-dark-colors))))
 453     (and (face-foreground face)
 454          (let ((rgb-specs (mapcar (lambda (n)
 455                                     (/ n 65535.0))
 456                                   (color-values (face-foreground face)))))
 457            (and rgb-specs
 458                 (if dark-bg-p
 459                     (let ((yuv-specs (apply 'pbook-rgb-yuv rgb-specs)))
 460                       (pbook-yuv-rgb (* 0.25 (- 1 (first yuv-specs)))
 461                                      (second yuv-specs)
 462                                      (third yuv-specs)))
 463                   rgb-specs))))))
 464
 465 (defun pbook-rgb-yuv (r g b)
 466   "As http://en.wikipedia.org/wiki/YUV -- Matrix fixed by mjp."
 467   (let* ((y (+ (*  0.299    r)
 468                (*  0.587    g)
 469                (*  0.114    b)))
 470          (u (+ (* -0.168740 r)
 471                (* -0.331260 g)
 472                (*  0.500000 b)))
 473          (v (+ (*  0.500000 r)
 474                (* -0.418690 g)
 475                (* -0.081310 b))))
 476     (list y u v)))
 477
 478 (defun pbook-yuv-rgb (y u v)
 479   "As http://en.wikipedia.org/wiki/YUV -- Matrix fixed by mjp"
 480   (let ((r (+ y
 481
 482               (*  1.40200 v)))
 483         (g (+ y
 484               (* -0.34413 u)
 485               (* -0.71414 v)))
 486         (b (+ y
 487               (*  1.77200 u))))
 488     (mapcar (lambda (x)
 489               (cond ((< x 0) 0.0) ;; Need to clamp values for some reason
 490                     ((> x 1) 1.0)
 491                     (t       x)))
 492             (list r g b))))
 493 ;;;# Top-level logic
 494 ;;;
 495 ;;; Here we have the top level of the program. Setting up, calling the
 496 ;;; formatting engine, piecing things together, and putting on the
 497 ;;; finishing touches.
 498 ;;;
 499 ;;; The real work is done in a new buffer called *pbook*. First the
 500 ;;; source is fontified, then copied into this buffer and from there
 501 ;;; it is massaged into shape.
 502 ;;;
 503 ;;; Most of this is mundane, but there is one tricky part: the source
 504 ;;; buffer may have buffer-local values for some pbook settings, and
 505 ;;; we have to be careful or we'd lose them when switching into the
 506 ;;; *pbook* buffer. This is taken care of by moving the correct values
 507 ;;; of all the relevant customizable settings into new dynamic
 508 ;;; bindings.
 509
 510 (defun pbook-process-buffer ()
 511   "Generate pbook output for the current buffer
 512 The output is put in the buffer *pbook* and displayed."
 513   (interactive)
 514   (let ((font-lock-syntactic-keywords
 515          (append font-lock-syntactic-keywords
 516                  pbook-font-lock-override)))
 517     (setq font-lock-fontified nil) ;; pretend buffer isn't fontified
 518     (font-lock-default-fontify-buffer)  ;; HACK!!! Looks like an internal...
 519     )
 520   (let ((buffer    (current-buffer))
 521         (beginning (pbook-tex-beginning))
 522         (ending    (pbook-tex-ending))
 523         (text      (buffer-string)))
 524     (with-current-buffer (get-buffer-create "*pbook*")
 525       ;; Setup,
 526       (pbook-inherit-buffer-locals buffer
 527                                    '(pbook-commentary-regexp
 528                                      pbook-heading-regexp
 529                                      pbook-style
 530                                      pbook-heading-level-subexp
 531                                      pbook-include-toc
 532                                      pbook-monochrome
 533                                      pbook-font-lock-override
 534                                      pbook-face-override))
 535       (erase-buffer)
 536       (insert text)
 537       ;; Reformat as LaTeX,
 538       (pbook-preprocess)
 539       (pbook-format-buffer)
 540       ;; Insert header & footer.
 541       (goto-char (point-min))
 542       (insert beginning)
 543       (goto-char (point-max))
 544       (insert ending)
 545       (display-buffer (current-buffer)))))
 546
 547 (defun pbook-inherit-buffer-locals (buffer variables)
 548   "Make buffer-local bindings of VARIABLES using the values in BUFFER."
 549   (dolist (v variables)
 550     (set (make-local-variable v)
 551          (with-current-buffer buffer (symbol-value v)))))
 552
 553 (defun pbook-preprocess ()
 554   "Cleanup the buffer to prepare for formatting."
 555   (goto-char (point-min))
 556   ;; FIXME: Currently we just zap all pagebreak characters.
 557   (save-excursion
 558     (while (re-search-forward "\C-l" nil t)
 559       (replace-match "")))
 560   (unless (re-search-forward pbook-heading-regexp nil t)
 561     (error "File must have at least one heading."))
 562   (beginning-of-line)
 563   ;; Delete everything before the first heading.
 564   (delete-region (point-min) (point)))
 565
 566 (defun pbook-tex-beginning ()
 567   "Return the beginning prelude for the LaTeX output."
 568   (format "\
 569 \\documentclass[notitlepage,a4paper]{%s}
 570 \\usepackage[nohead,nofoot]{geometry}
 571 \\usepackage{color}
 572 \\usepackage{bold-extra}
 573 \\usepackage{chngpage}
 574 \\usepackage{index}
 575 \\newcommand{\\ii}[1]{{\\it #1}}
 576 \\newcommand{\\bb}[1]{{\\bf #1}}
 577 \\makeindex
 578 \\title{%s}
 579 \\author{%s}
 580 \\begin{document}
 581 \\maketitle
 582 %s\n"
 583           (symbol-name pbook-style)
 584           (pbook-latex-escape-string (buffer-name))
 585           (pbook-latex-escape-string pbook-author)
 586           (if pbook-include-toc "\\tableofcontents" "")))
 587
 588 (defun pbook-tex-ending ()
 589   "Return the ending of the LaTeX output."
 590   "\
 591 \\printindex
 592
 593 \\end{document}\n")
 594
 595 ;;;# Escaping special characters
 596 ;;;
 597 ;;; We have to escape characters that LaTeX treats specially. This is
 598 ;;; done based on `pbook-escaping-regexps', whicn is defined according
 599 ;;; to the rules in the `Special Characters' node of the
 600 ;;; LaTeX2e info manual. (CHECKME)
 601
 602 (defun pbook-latex-escape-string (string &optional space)
 603   (with-temp-buffer
 604     (insert string)
 605     (pbook-latex-escape (point-min) (point-max) space)
 606     (buffer-string)))
 607
 608 (defun pbook-latex-escape (start end &optional space)
 609   "LaTeX-escape special characters in the region from START to END."
 610   (when (or space
 611             pbook-escaping-regexps)
 612     (let* ((pbook-escaping-regexps (if space
 613                                        (append pbook-escaping-regexps
 614                                                (list (cons " " "\\\\\\&")))
 615                                      pbook-escaping-regexps))
 616            (scan-regexp (apply 'concat
 617                               (car (first pbook-escaping-regexps))
 618                               (mapcan (lambda (entry)
 619                                         (list "\\|"
 620                                               (car entry)))
 621                                       (rest pbook-escaping-regexps)))))
 622       (save-excursion
 623         (save-restriction
 624           (narrow-to-region start end)
 625           (goto-char start)
 626           (while (re-search-forward scan-regexp
 627                                     nil t)
 628             (goto-char (match-beginning 0))
 629             (catch 'out
 630               (dolist (entry pbook-escaping-regexps)
 631                 (let ((test (car entry))
 632                       (replace (cdr entry)))
 633                   (when (looking-at test)
 634                     (replace-match replace)
 635                     (throw 'out nil)))))))))))
 636
 637 ;;;# Processing engine
 638 ;;;
 639 ;;; The main loop scans through the source buffer piece by piece and
 640 ;;; converts each one to LaTeX as it goes. There are three sorts of
 641 ;;; pieces: headings, top-level commentary, and code.
 642 ;;;
 643 ;;; This loop recognises what type of piece is at the point and then
 644 ;;; calls the appropriate subroutine. The subroutines are responsible
 645 ;;; for determining where their piece finishes and for advancing the
 646 ;;; point beyond the region they have formatted.
 647
 648 (defun pbook-format-buffer ()
 649   (while (not (eobp))
 650     (if (looking-at "^\\s *$")
 651         ;; Skip blank lines.
 652         (forward-line)
 653       (cond ((looking-at pbook-heading-regexp)
 654              (pbook-do-heading))
 655             ((looking-at pbook-commentary-regexp)
 656              (pbook-do-commentary))
 657             (t
 658              (pbook-do-code))))))
 659
 660 ;;;## Heading formatting
 661 ;;;
 662 ;;; Each heading line is converted to a LaTeX sectioning command. The
 663 ;;; heading text is escaped.
 664
 665 (defun pbook-do-heading ()
 666   ;; NB: `looking-at' sets the Emacs match data (for match-string, etc)
 667   (assert (looking-at pbook-heading-regexp))
 668   (let ((depth (length (match-string-no-properties pbook-heading-level-subexp))))
 669     ;; Strip off the comment characters and whitespace.
 670     (replace-match "")
 671     (when (looking-at "\\s +")
 672       (replace-match ""))
 673     (pbook-latex-escape (line-beginning-position) (line-end-position))
 674     (wrap-line (format "\\%s{" (pbook-nth-sectioning-command depth))
 675                "}"))
 676   (forward-line))
 677
 678 (defun wrap-line (prefix suffix)
 679   "Insert PREFIX at the start of the current line and SUFFIX at the end."
 680   (save-excursion
 681     (goto-char (line-beginning-position))
 682     (insert prefix)
 683     (goto-char (line-end-position))
 684     (insert suffix)))
 685
 686 ;;; LaTeX has different sectioning commands for articles and books, so
 687 ;;; we have to choose from the right set. These variables define the
 688 ;;; sets in order of nesting -- the first element is top-level, etc.
 689
 690 (defconst pbook-article-sectioning-commands
 691   '("section" "subsection" "subsubsection")
 692   "LaTeX commands for sectioning articles.")
 693
 694 (defconst pbook-book-sectioning-commands
 695   (cons "chapter" pbook-article-sectioning-commands)
 696   "LaTeX commands for sectioning books.")
 697
 698 (defun pbook-nth-sectioning-command (n)
 699   "Return the sectioning command for nesting level N (top-level is 1)."
 700   (let ((commands (ecase pbook-style
 701                     (article pbook-article-sectioning-commands)
 702                     (book    pbook-book-sectioning-commands))))
 703     (nth (min (1- n) (1- (length commands))) commands)))
 704
 705 ;;;## Commentary formatting
 706 ;;;
 707 ;;; Top-level commentary is stripped of its comment characters and we
 708 ;;; escape all characters that LaTeX treats specially.
 709
 710 (defun pbook-do-commentary ()
 711   "Format one or more lines of commentary into LaTeX."
 712   (assert (looking-at pbook-commentary-regexp))
 713   (let ((start (point)))
 714     ;; Strip off comment characters line-by-line until end of section.
 715     (while (or (looking-at pbook-commentary-regexp)
 716                (and (looking-at "^\\s *$")
 717                     (not (eobp))))
 718       (replace-match "")
 719       (delete-horizontal-space)
 720       (forward-line))
 721     (save-excursion
 722       (pbook-latex-escape start (point))
 723       (pbook-pretty-commentary start (point)))))
 724
 725 ;;; These functions define a simple Wiki-like markup language for
 726 ;;; basic formatting.
 727
 728 (defun pbook-pretty-commentary (start end)
 729   "Make commentary prettier."
 730   (save-restriction
 731     (narrow-to-region start end)
 732     (goto-char (point-min))
 733     (save-excursion (pbook-pretty-tt))
 734     (save-excursion (pbook-pretty-doublequotes))))
 735
 736 (defun pbook-pretty-tt ()
 737   "Format `single quoted' text with a typewriter font."
 738   (while (re-search-forward "`\\([^`']*\\)'" nil t)
 739     (replace-match "{\\\\tt \\1}" t)))
 740
 741 (defun pbook-pretty-doublequotes ()
 742   "Format \"double quoted\" text with ``double single quotes''."
 743   (while (re-search-forward "\"\\([^\"]*\\)\"" nil t)
 744     (replace-match "``\\1''")))
 745
 746 ;;;## Source code formatting
 747 ;;;
 748 ;;; Source text is rendered as defined in pbook-properties.
 749
 750 (defun pbook-do-code ()
 751   (assert (and (not (looking-at pbook-commentary-regexp))
 752                (not (looking-at pbook-heading-regexp))))
 753   (let ((start (point))
 754         (end   (progn
 755                  (pbook-goto-end-of-code)
 756                  (point))))
 757     (save-restriction
 758       (narrow-to-region start end)
 759       (pbook-convert-tabs-to-spaces start end)
 760       ;;delete trailing newlines and spaces
 761       (goto-char (point-max))
 762       (while (or (equal (char-syntax (char-before)) " ")
 763                  (bolp))
 764         (delete-char -1))
 765       (pbook-format-code start (point-max)
 766                          (count-lines start (point-max)))
 767       (goto-char (point-min))
 768       (insert pbook-code-prologue)
 769       (goto-char (point-max))
 770       (insert "\n" pbook-code-epilogue "\n"))))
 771
 772 (defun pbook-goto-end-of-code ()
 773   "Goto the end of the current section of code."
 774   (if (re-search-forward (format "\\(%s\\)\\|\\(%s\\)"
 775                                  pbook-heading-regexp
 776                                  pbook-commentary-regexp)
 777                          nil t)
 778       (beginning-of-line)
 779     (goto-char (point-max))))
 780
 781 (defun pbook-convert-tabs-to-spaces (start end)
 782   "Replace tab characters with spaces."
 783   (save-excursion
 784     (save-restriction
 785       (narrow-to-region start end)
 786       (untabify start end))))
 787
 788
 789 (defun pbook-format-code (start end num-lines)
 790   "Format the section of code. The third argument is
 791 the total number of line in the section."
 792   (save-excursion
 793     (save-restriction
 794       (narrow-to-region start end)
 795       (goto-char (point-min))
 796       (let ((cur-line 0))
 797         (while (< cur-line num-lines)
 798           (pbook-format-line (line-beginning-position) (line-end-position)
 799                              cur-line num-lines)
 800           (incf cur-line)
 801           (beginning-of-line 2))))))
 802
 803 (defun pbook-get-inherits (face)
 804   "Flattens a face's inheritance list, in order."
 805   (let ((faces (cond ((eq face 'unspecified) nil)
 806                      ((listp face)           face)
 807                      (t                      (list face)))))
 808     (mapcan (lambda (face)
 809               (let ((inherits (face-attribute face :inherit)))
 810                 (if (and inherits
 811                          (not (eq inherits 'unspecified)))
 812                   (cons face (pbook-get-inherits inherits))
 813                 (list face))))
 814             faces)))
 815
 816 (defun pbook-translate-face-properties (face props)
 817   "Updates the list of properties `props' with those
 818 associates with `face'. `pbook-face-override' has priority"
 819   (setq props (append props
 820                       (copy-list (cdr (assoc face pbook-face-override)))))
 821   (dolist (defn pbook-properties)
 822     (let ((prop-name (first defn))
 823           (predicate (second defn)))
 824       (unless (plist-get props prop-name)
 825         (let ((value (funcall predicate face)))
 826           (when value
 827             (setq props (plist-put props prop-name value)))))))
 828   props)
 829
 830 (defun pbook-face-properties (face)
 831   "Finds a face's (and those from which it inherits) pbook
 832 properties. Earlier faces in the inheritance list (preorder
 833 depth-first) have priority."
 834   (let ((faces (append (pbook-get-inherits face)
 835                        '(default)))
 836         (props nil))
 837     (dolist (face faces props)
 838       (setq props (pbook-translate-face-properties face props)))))
 839
 840 (defun pbook-properties-latex-strings (plist)
 841   "Given a plist of pbook properties, finds the latex
 842 strings with which to wrap the text that is being formatted,
 843 and the additional regexps with which to escape it."
 844   (let* ((pbook-face-latex-properties plist) ;;special var
 845          (prepend nil)
 846          (append  nil)
 847          (regexps nil) ;;escaping-regexp entry
 848          )
 849     (dolist (property pbook-properties (list (apply 'concat
 850                                                     (reverse prepend))
 851                                              (apply 'concat append)
 852                                              regexps))
 853       (let* ((name         (first property))
 854              (transformer  (third property))
 855              (foundp (plist-member plist name))
 856              (prop   (plist-get plist name)))
 857         (when foundp
 858           (let ((wrap (if (and (listp transformer)
 859                                (not (eq (first transformer)
 860                                         'lambda)))
 861                           (and prop
 862                                (not (eq prop :no))
 863                                transformer)
 864                         (funcall transformer prop))))
 865             (when wrap
 866               (push (first wrap) prepend)
 867               (push (second wrap) append)
 868               (setq regexps (append (cddr wrap)
 869                                     regexps)))))))))
 870
 871 (defun pbook-format-line (start end line-number total-lines)
 872   "Format a complete line of code, by spans of constant text property.
 873 Also wraps it as per `pbook-around-code-line'. Each span is only escaped
 874 at the very end to facilitate examination of the buffer."
 875   (save-excursion
 876     (save-restriction
 877       (narrow-to-region start end)
 878       (goto-char start)
 879       (let* ((pbook-current-line line-number)
 880              (pbook-current-total-lines total-lines)
 881              (substr-beg (point-marker))
 882              (substr-end (point-marker))
 883              (wrap       (pbook-around-code-line line-number total-lines))
 884              (pbook-escaping-regexps (append (cddr wrap)
 885                                              pbook-escaping-regexps)))
 886         (move-marker substr-end
 887                      (next-char-property-change (marker-position substr-beg)))
 888         (set-marker-insertion-type substr-beg t)
 889         (set-marker-insertion-type substr-end t)
 890         ;; Main loop: find spans of constant text properties
 891         ;; then get the latex trings to wrap around it.
 892         (while (not (equal substr-beg substr-end))
 893           (goto-char (marker-position substr-beg))
 894           (let ((wrap (save-excursion     ;;DOCUMENT ME
 895                         (save-restriction
 896                           (narrow-to-region (marker-position substr-beg)
 897                                             (marker-position substr-end))
 898                           (let ((pbook-current-text-properties
 899                                  (text-properties-at (marker-position substr-beg))))
 900                             (pbook-properties-latex-strings
 901                              (pbook-face-properties
 902                               (get-char-property (marker-position substr-beg)
 903                                                  'face))))))))
 904             (insert (first wrap))
 905             (let ((pbook-escaping-regexps (append (third wrap)
 906                                                   pbook-escaping-regexps)))
 907               (pbook-latex-escape (marker-position substr-beg)
 908                                   (marker-position substr-end)
 909                                   t))
 910             (goto-char (marker-position substr-end))
 911             (insert (second wrap))
 912
 913             (move-marker substr-beg (marker-position substr-end))
 914             (move-marker substr-end
 915                          (next-char-property-change
 916                           (marker-position substr-beg)))))
 917         (wrap-line (first wrap)
 918                    (second wrap))))))
 919
 920 ;;;# Prologue and file variables
 921
 922 (provide 'pbook)
 923
 924 ;;; We use Emacs's magic `file variables' to make sure pbook is
 925 ;;; formatted how it should be:
 926
 927 ;; Local Variables:
 928 ;; pbook-author:     "Luke Gorrie, with modifications by Paul Khuong"
 929 ;; pbook-use-toc:    t
 930 ;; pbook-style:      article
 931 ;; pbook-monochrome: t
 932 ;; End: