lisp/muse-context.el

   1 ;;; muse-context.el --- publish entries in ConTeXt or PDF format
   2
   3 ;; Copyright (C) 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Jean Magnan de Bornier (jean@bornier.net)
   6 ;; Created: 16-Apr-2007
   7
   8 ;; Emacs Muse is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published
  10 ;; by the Free Software Foundation; either version 3, or (at your
  11 ;; option) any later version.
  12
  13 ;; This file when loaded allows you to publish .muse files as ConTeXt
  14 ;; files or as pdf files, using respectively the "context" and
  15 ;; "context-pdf" styles. It is far from being perfect, so any feedback
  16 ;; will be welcome and any mistake hopefully fixed.
  17
  18 ;;; Author:
  19
  20 ;; Jean Magnan de Bornier, who based this file on muse-latex.el and
  21 ;; made the context, context-pdf, context-slides, and
  22 ;; context-slides-pdf Muse publishing styles.
  23
  24 ;; 16 Avril 2007
  25
  26 ;;; Code:
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; Muse ConTeXt Publishing
  31 ;;
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33
  34 (require 'muse-publish)
  35
  36 (defgroup muse-context nil
  37   "Rules for marking up a Muse file as a ConTeXt article."
  38   :group 'muse-publish)
  39
  40 (defcustom muse-context-extension ".tex"
  41   "Default file extension for publishing ConTeXt files."
  42   :type 'string
  43   :group 'muse-context)
  44
  45 (defcustom muse-context-pdf-extension ".pdf"
  46   "Default file extension for publishing ConTeXt files to PDF."
  47   :type 'string
  48   :group 'muse-context)
  49
  50 (defcustom muse-context-pdf-program "texexec --pdf"
  51   "The program that is called to generate PDF content from ConTeXt content."
  52   :type 'string
  53   :group 'muse-context)
  54
  55 (defcustom muse-context-pdf-cruft '(".pgf" ".tmp" ".tui" ".tuo" ".toc"  ".log")
  56   "Extensions of files to remove after generating PDF output successfully."
  57   :type 'string
  58   :group 'muse-context)
  59
  60 (defcustom muse-context-header
  61   "\\setupinteraction [state=start]
  62 \\usemodule[tikz]
  63 \\usemodule[bib]\n
  64 <lisp>(muse-context-setup-bibliography)</lisp>
  65  \\setuppublications[]\n
  66 \\setuppublicationlist[]\n\\setupcite[]\n
  67 \\starttext
  68 \\startalignment[center]
  69   \\blank[2*big]
  70     {\\tfd <lisp>(muse-publishing-directive \"title\")</lisp>}
  71   \\blank[3*medium]
  72     {\\tfa <lisp>(muse-publishing-directive \"author\")</lisp>}
  73   \\blank[2*medium]
  74     {\\tfa <lisp>(muse-publishing-directive \"date\")</lisp>}
  75   \\blank[3*medium]
  76 \\stopalignment
  77
  78 <lisp>(and muse-publish-generate-contents
  79            (not muse-context-permit-contents-tag)
  80            \"\\\\placecontent\n\\\\page[yes]\")</lisp>\n\n"
  81   "Header used for publishing ConTeXt files.  This may be text or a filename."
  82   :type 'string
  83   :group 'muse-context)
  84
  85 (defcustom muse-context-footer "<lisp>(muse-context-bibliography)</lisp>
  86 \\stoptext\n"
  87   "Footer used for publishing ConTeXt files.  This may be text or a filename."
  88   :type 'string
  89   :group 'muse-context)
  90
  91 (defcustom muse-context-markup-regexps
  92   `(;; numeric ranges
  93     (10000 "\\([0-9]+\\)-\\([0-9]+\\)" 0 "\\1--\\2")
  94
  95     ;; be careful of closing quote pairs
  96     (10100 "\"'" 0 "\"\\\\-'"))
  97   "List of markup regexps for identifying regions in a Muse page.
  98 For more on the structure of this list, see `muse-publish-markup-regexps'."
  99   :type '(repeat (choice
 100                   (list :tag "Markup rule"
 101                         integer
 102                         (choice regexp symbol)
 103                         integer
 104                         (choice string function symbol))
 105                   function))
 106   :group 'muse-context)
 107
 108 (defcustom muse-context-markup-functions
 109   '((table . muse-context-markup-table))
 110   "An alist of style types to custom functions for that kind of text.
 111 For more on the structure of this list, see
 112 `muse-publish-markup-functions'."
 113   :type '(alist :key-type symbol :value-type function)
 114   :group 'muse-context)
 115
 116 (defcustom muse-context-markup-strings
 117   '((image-with-desc . "\\placefigure[][]{%3%}{\\externalfigure[%1%.%2%]}")
 118     (image           . "\\placefigure[][]{}{\\externalfigure[%s.%s]}")
 119     (image-link      . "\\useURL[aa][%s][][%1%] \\from[aa]")
 120     (anchor-ref      . "\\goto{%2%}{}[%1%]")
 121     (url             . "\\useURL[aa][%s][][%s] \\from[aa]")
 122     (url-and-desc    . "\\useURL[bb][%s][][%s]\\from[bb]\\footnote{%1%}")
 123     (link            . "\\goto{%2%}[program(%1%)]\\footnote{%1%}")
 124     (link-and-anchor . "\\useexternaldocument[%4%][%4%][] \\at{%3%, page}{}[%4%::%2%]\\footnote{%1%}")
 125     (email-addr      . "\\useURL[mail][mailto:%s][][%s]\\from[mail]")
 126     (anchor          . "\\reference[%s] ")
 127     (emdash          . "---")
 128     (comment-begin   . "\\doifmode{comment}{")
 129     (comment-end     . "}")
 130     (rule            . "\\blank[medium]\\hrule\\blank[medium]")
 131     (no-break-space  . "~")
 132     (enddots         . "\\ldots ")
 133     (dots            . "\\dots ")
 134     (part            . "\\part{")
 135     (part-end        . "}")
 136     (chapter         . "\\chapter{")
 137     (chapter-end     . "}")
 138     (section         . "\\section{")
 139     (section-end     . "}")
 140     (subsection      . "\\subsection{")
 141     (subsection-end  . "}")
 142     (subsubsection   . "\\subsubsection{")
 143     (subsubsection-end . "}")
 144     (section-other   . "\\subsubsubject{")
 145     (section-other-end . "}")
 146     (footnote        . "\\footnote{")
 147     (footnote-end    . "}")
 148     (footnotetext    . "\\footnotetext[%d]{")
 149     (begin-underline . "\\underbar{")
 150     (end-underline   . "}")
 151     (begin-literal   . "\\type{")
 152     (end-literal     . "}")
 153     (begin-emph      . "{\\em ")
 154     (end-emph        . "}")
 155     (begin-more-emph . "{\\bf ")
 156     (end-more-emph   . "}")
 157     (begin-most-emph . "{\\bf {\\em ")
 158     (end-most-emph   . "}}")
 159     (begin-example   . "\\starttyping")
 160     (end-example     . "\\stoptyping")
 161     (begin-center    . "\\startalignment[center]\n")
 162     (end-center      . "\n\\stopalignment")
 163     (begin-quote     . "\\startquotation\n")
 164     (end-quote       . "\n\\stopquotation")
 165     (begin-cite     . "\\cite[authoryear][")
 166     (begin-cite-author . "\\cite[author][")
 167     (begin-cite-year . "\\cite[year][")
 168     (end-cite        . "]")
 169     (begin-uli       . "\\startitemize\n")
 170     (end-uli         . "\n\\stopitemize")
 171     (begin-uli-item  . "\\item ")
 172     (begin-oli       . "\\startitemize[n]\n")
 173     (end-oli         . "\n\\stopitemize")
 174     (begin-oli-item  . "\\item ")
 175     (begin-dl        . "\\startitemize\n")
 176     (end-dl          . "\n\\stopitemize")
 177     (begin-ddt       . "\\head ")
 178     (end-ddt         . "\n")
 179     (begin-verse     . "\\blank[big]")
 180     (end-verse-line  . "\\par")
 181     (verse-space     . "\\fixedspaces ~~")
 182     (end-verse       . "\\blank[big]"))
 183   "Strings used for marking up text.
 184 These cover the most basic kinds of markup, the handling of which
 185 differs little between the various styles."
 186   :type '(alist :key-type symbol :value-type string)
 187   :group 'muse-context)
 188
 189 (defcustom muse-context-slides-header
 190   "\\usemodule[<lisp>(if (string-equal (muse-publishing-directive \"module\") nil) \"pre-01\" (muse-publishing-directive \"module\"))</lisp>]
 191 \\usemodule[tikz]
 192 \\usemodule[newmat]
 193 \\setupinteraction [state=start]
 194 \\starttext
 195 \\TitlePage { <lisp>(muse-publishing-directive \"title\")</lisp>
 196 \\blank[3*medium]
 197 \\tfa <lisp>(muse-publishing-directive \"author\")</lisp>
 198  \\blank[2*medium]
 199   \\tfa <lisp>(muse-publishing-directive \"date\")</lisp>}"
 200   "Header for publishing a presentation (slides) using ConTeXt.
 201 Any of the predefined modules, which are available in the
 202 tex/context/base directory, can be used by writing a \"module\"
 203 directive at the top of the muse file; if no such directive is
 204 provided, module pre-01 is used.  Alternatively, you can use your
 205 own style (\"mystyle\", in this example) by replacing
 206 \"\\usemodule[]\" with \"\\input mystyle\".
 207
 208 This may be text or a filename."
 209   :type 'string
 210   :group 'muse-context)
 211
 212 (defcustom muse-context-slides-markup-strings
 213    '((section      . "\\Topic {")
 214      (subsection   . "\\page \n{\\bf ")
 215      (subsubsection . "{\\em "))
 216   "Strings used for marking up text in ConTeXt slides."
 217   :type '(alist :key-type symbol :value-type string)
 218   :group 'muse-context)
 219
 220 (defcustom muse-context-markup-specials-document
 221   '((?\\ . "\\textbackslash{}")
 222     (?\_ . "\\textunderscore{}")
 223     (?\< . "\\switchtobodyfont[small]")
 224     (?\> . "\\switchtobodyfont[big]")
 225     (?^  . "\\^")
 226     (?\~ . "\\~")
 227     (?\@ . "\\@")
 228     (?\$ . "\\$")
 229     (?\% . "\\%")
 230     (?\{ . "\\{")
 231     (?\} . "\\}")
 232     (?\& . "\\&")
 233     (?\# . "\\#"))
 234   "A table of characters which must be represented specially.
 235 These are applied to the entire document, sans already-escaped
 236 regions."
 237   :type '(alist :key-type character :value-type string)
 238   :group 'muse-context)
 239
 240 (defcustom muse-context-markup-specials-example
 241   '()
 242   "A table of characters which must be represented specially.
 243 These are applied to <example> regions.
 244
 245 With the default interpretation of <example> regions, no specials
 246 need to be escaped."
 247   :type '(alist :key-type character :value-type string)
 248   :group 'muse-context)
 249
 250 (defcustom muse-context-markup-specials-literal
 251   '()
 252   "A table of characters which must be represented specially.
 253 This applies to =monospaced text= and <code> regions."
 254   :type '(alist :key-type character :value-type string)
 255   :group 'muse-context)
 256
 257 (defcustom muse-context-markup-specials-url
 258   '((?\\ . "\\textbackslash")
 259     (?\_ . "\\_")
 260     (?\< . "\\<")
 261     (?\> . "\\>")
 262     (?\$ . "\\$")
 263     (?\% . "\\%")
 264     (?\{ . "\\{")
 265     (?\} . "\\}")
 266     (?\& . "\\&")
 267     (?\# . "\\#"))
 268   "A table of characters which must be represented specially.
 269 These are applied to URLs."
 270   :type '(alist :key-type character :value-type string)
 271   :group 'muse-context)
 272
 273 (defcustom muse-context-markup-specials-image
 274   '((?\\ . "\\textbackslash")       ; cannot find suitable replacement
 275     (?\< . "\\<")
 276     (?\> . "\\>")
 277     (?\$ . "\\$")
 278     (?\% . "\\%")
 279     (?\{ . "\\{")
 280     (?\} . "\\}")
 281     (?\& . "\\&")
 282     (?\# . "\\#")                     ; cannot find suitable replacement
 283     )
 284   "A table of characters which must be represented specially.
 285 These are applied to image filenames."
 286   :type '(alist :key-type character :value-type string)
 287   :group 'muse-context)
 288
 289 (defun muse-context-decide-specials (context)
 290   "Determine the specials to escape, depending on the CONTEXT argument."
 291   (cond ((memq context '(underline emphasis document url-desc verbatim
 292                                    footnote))
 293          muse-context-markup-specials-document)
 294         ((eq context 'image)
 295          muse-context-markup-specials-image)
 296         ((memq context '(email url))
 297          muse-context-markup-specials-url)
 298         ((eq context 'literal)
 299          muse-context-markup-specials-literal)
 300         ((eq context 'example)
 301          muse-context-markup-specials-example)
 302         (t (error "Invalid context argument '%s' in muse-context" context))))
 303
 304 (defun muse-context-markup-table ()
 305   (let* ((table-info (muse-publish-table-fields (match-beginning 0)
 306                                                 (match-end 0)))
 307          (row-len (car table-info))
 308          (field-list (cdr table-info)))
 309     (when table-info
 310       (muse-insert-markup "\\starttable[|"
 311                           (mapconcat 'symbol-name (make-vector row-len 'l)
 312                                      "|") "|]\n \\HL\n \\VL ")
 313       (dolist (fields field-list)
 314         (let ((type (car fields)))
 315           (setq fields (cdr fields))
 316           (when (= type 3)
 317             (muse-insert-markup ""))
 318           (insert (car fields))
 319           (setq fields (cdr fields))
 320           (dolist (field fields)
 321             (muse-insert-markup " \\VL ")
 322             (insert field))
 323           (muse-insert-markup "\\VL\\NR\n \\HL\n \\VL ")
 324           (when (= type 2)
 325             (muse-insert-markup " "))))
 326       (muse-insert-markup "\\stoptable\n")
 327       (while (search-backward "VL \\stoptable" nil t)
 328         (replace-match "stoptable" nil t)))))
 329
 330 (defun muse-context-fixup-dquotes ()
 331   "Fixup double quotes."
 332   (goto-char (point-min))
 333   (let ((open t))
 334     (while (search-forward "\"" nil t)
 335       (unless (get-text-property (match-beginning 0) 'read-only)
 336         (when (or (bobp)
 337                   (eq (char-before) ?\n))
 338           (setq open t))
 339         (if open
 340             (progn
 341               (replace-match "``")
 342               (setq open nil))
 343           (replace-match "''")
 344           (setq open t))))))
 345
 346 (defcustom muse-context-permit-contents-tag nil
 347   "If nil, ignore <contents> tags.  Otherwise, insert table of contents.
 348
 349 Most of the time, it is best to have a table of contents on the
 350 first page, with a new page immediately following.  To make this
 351 work with documents published in both HTML and ConTeXt, we need to
 352 ignore the <contents> tag.
 353
 354 If you don't agree with this, then set this option to non-nil,
 355 and it will do what you expect."
 356   :type 'boolean
 357   :group 'muse-context)
 358
 359 (defun muse-context-fixup-citations ()
 360   "Replace semicolons in multi-head citations with colons."
 361   (goto-char (point-min))
 362   (while (re-search-forward "\\\\cite.?\\[" nil t)
 363     (let ((start (point))
 364           (end (re-search-forward "]")))
 365       (save-restriction
 366         (narrow-to-region start end)
 367         (goto-char (point-min))
 368         (while (re-search-forward ";" nil t)
 369           (replace-match ","))))))
 370
 371 (defun muse-context-munge-buffer ()
 372   (muse-context-fixup-dquotes)
 373   (muse-context-fixup-citations)
 374   (when (and muse-context-permit-contents-tag
 375              muse-publish-generate-contents)
 376     (goto-char (car muse-publish-generate-contents))
 377     (muse-insert-markup "\\placecontent")))
 378
 379 (defun muse-context-bibliography ()
 380   (save-excursion
 381     (goto-char (point-min))
 382     (if (re-search-forward "\\\\cite.?\\[" nil t)
 383         "\\completepublications[criterium=all]"
 384       "")))
 385
 386 (defun muse-context-setup-bibliography ()
 387   (save-excursion
 388     (goto-char (point-min))
 389     (if (re-search-forward "\\\\cite.?\\[" nil t)
 390         (concat
 391          "\\usemodule[bibltx]\n\\setupbibtex [database="
 392          (muse-publishing-directive "bibsource") "]")
 393       "")))
 394
 395 (defun muse-context-pdf-browse-file (file)
 396   (shell-command (concat "open " file)))
 397
 398 (defun muse-context-pdf-generate (file output-path final-target)
 399   (apply
 400    #'muse-publish-transform-output
 401    file output-path final-target "PDF"
 402    (function
 403     (lambda (file output-path)
 404       (let* ((fnd (file-name-directory output-path))
 405              (command (format "%s \"%s\""
 406                               muse-context-pdf-program
 407                               (file-relative-name file fnd)))
 408              (times 0)
 409              (default-directory fnd)
 410              result)
 411         ;; XEmacs can sometimes return a non-number result.  We'll err
 412         ;; on the side of caution by continuing to attempt to generate
 413         ;; the PDF if this happens and treat the final result as
 414         ;; successful.
 415         (while (and (< times 2)
 416                     (or (not (numberp result))
 417                         (not (eq result 0))
 418                         ;; table of contents takes 2 passes
 419 ;;                         (file-readable-p
 420 ;;                          (muse-replace-regexp-in-string
 421 ;;                           "\\.tex\\'" ".toc" file t t))
 422                         ))
 423           (setq result (shell-command command)
 424                 times (1+ times)))
 425         (if (or (not (numberp result))
 426                 (eq result 0))
 427             t
 428           nil))))
 429    muse-context-pdf-cruft))
 430
 431 (muse-define-style "context"
 432                    :suffix    'muse-context-extension
 433                    :regexps   'muse-context-markup-regexps
 434                    :functions 'muse-context-markup-functions
 435                    :strings   'muse-context-markup-strings
 436                    :specials  'muse-context-decide-specials
 437                    :after     'muse-context-munge-buffer
 438                    :header    'muse-context-header
 439                    :footer    'muse-context-footer
 440                    :browser   'find-file)
 441
 442 (muse-derive-style "context-pdf" "context"
 443                    :final   'muse-context-pdf-generate
 444                    :browser 'muse-context-pdf-browse-file
 445                    :link-suffix 'muse-context-pdf-extension
 446                    :osuffix 'muse-context-pdf-extension)
 447
 448 (muse-derive-style "context-slides" "context"
 449                    :header  'muse-context-slides-header
 450                    :strings 'muse-context-slides-markup-strings)
 451
 452 (muse-derive-style "context-slides-pdf" "context-pdf"
 453                    :header  'muse-context-slides-header
 454                    :strings 'muse-context-slides-markup-strings)
 455
 456 (provide 'muse-context)
 457
 458 ;;; muse-context.el ends here