lisp/muse-context.el

   1 ;;; muse-context.el --- publish entries in ConTeXt or PDF format
   2
   3 ;; Copyright (C) 2007 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[pre-63]
 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 You can use any of the predefined modules, which are available in
 202 the tex/context/base of your distribution, provided it has
 203 TitlePage and Topic defined.  Alternatively, you can use your own
 204 style (mystyle) by replacing \"\\usemodule[]\" with \"\\input mystyle\".
 205
 206 This may be text or a filename."
 207   :type 'string
 208   :group 'muse-context)
 209
 210 (defcustom muse-context-slides-markup-strings
 211    '((section      . "\\Topic {")
 212      (subsection   . "\\page \n{\\bf ")
 213      (subsubsection . "{\\em "))
 214   "Strings used for marking up text in ConTeXt slides."
 215   :type '(alist :key-type symbol :value-type string)
 216   :group 'muse-context)
 217
 218 (defcustom muse-context-markup-specials-document
 219   '((?\\ . "\\textbackslash")
 220     (?\_ . "\\textunderscore")
 221     (?\< . "\\switchtobodyfont[small]")
 222     (?\> . "\\switchtobodyfont[big]")
 223     (?^  . "\\^")
 224     (?\~ . "\\~")
 225     (?\@ . "\\@")
 226     (?\$ . "\\$")
 227     (?\% . "\\%")
 228     (?\{ . "\\{")
 229     (?\} . "\\}")
 230     (?\& . "\\&")
 231     (?\# . "\\#"))
 232   "A table of characters which must be represented specially.
 233 These are applied to the entire document, sans already-escaped
 234 regions."
 235   :type '(alist :key-type character :value-type string)
 236   :group 'muse-context)
 237
 238 (defcustom muse-context-markup-specials-example
 239   '()
 240   "A table of characters which must be represented specially.
 241 These are applied to <example> regions.
 242
 243 With the default interpretation of <example> regions, no specials
 244 need to be escaped."
 245   :type '(alist :key-type character :value-type string)
 246   :group 'muse-context)
 247
 248 (defcustom muse-context-markup-specials-literal
 249   '()
 250   "A table of characters which must be represented specially.
 251 This applies to =monospaced text= and <code> regions."
 252   :type '(alist :key-type character :value-type string)
 253   :group 'muse-context)
 254
 255 (defcustom muse-context-markup-specials-url
 256   '((?\\ . "\\textbackslash")
 257     (?\_ . "\\_")
 258     (?\< . "\\<")
 259     (?\> . "\\>")
 260     (?\$ . "\\$")
 261     (?\% . "\\%")
 262     (?\{ . "\\{")
 263     (?\} . "\\}")
 264     (?\& . "\\&")
 265     (?\# . "\\#"))
 266   "A table of characters which must be represented specially.
 267 These are applied to URLs."
 268   :type '(alist :key-type character :value-type string)
 269   :group 'muse-context)
 270
 271 (defcustom muse-context-markup-specials-image
 272   '((?\\ . "\\textbackslash")       ; cannot find suitable replacement
 273     (?\< . "\\<")
 274     (?\> . "\\>")
 275     (?\$ . "\\$")
 276     (?\% . "\\%")
 277     (?\{ . "\\{")
 278     (?\} . "\\}")
 279     (?\& . "\\&")
 280     (?\# . "\\#")                     ; cannot find suitable replacement
 281     )
 282   "A table of characters which must be represented specially.
 283 These are applied to image filenames."
 284   :type '(alist :key-type character :value-type string)
 285   :group 'muse-context)
 286
 287 (defun muse-context-decide-specials (context)
 288   "Determine the specials to escape, depending on the CONTEXT argument."
 289   (cond ((memq context '(underline emphasis document url-desc verbatim))
 290          muse-context-markup-specials-document)
 291         ((eq context 'image)
 292          muse-context-markup-specials-image)
 293         ((memq context '(email url))
 294          muse-context-markup-specials-url)
 295         ((eq context 'literal)
 296          muse-context-markup-specials-literal)
 297         ((eq context 'example)
 298          muse-context-markup-specials-example)
 299         (t (error "Invalid context argument '%s' in muse-context" context))))
 300
 301 (defun muse-context-markup-table ()
 302   (let* ((table-info (muse-publish-table-fields (match-beginning 0)
 303                                                 (match-end 0)))
 304          (row-len (car table-info))
 305          (field-list (cdr table-info)))
 306     (when table-info
 307       (muse-insert-markup "\\starttable[|"
 308                           (mapconcat 'symbol-name (make-vector row-len 'l)
 309                                      "|") "|]\n \\HL\n \\VL ")
 310       (dolist (fields field-list)
 311         (let ((type (car fields)))
 312           (setq fields (cdr fields))
 313           (when (= type 3)
 314             (muse-insert-markup ""))
 315           (insert (car fields))
 316           (setq fields (cdr fields))
 317           (dolist (field fields)
 318             (muse-insert-markup " \\VL ")
 319             (insert field))
 320           (muse-insert-markup "\\VL\\NR\n \\HL\n \\VL ")
 321           (when (= type 2)
 322             (muse-insert-markup " "))))
 323       (muse-insert-markup "\\stoptable\n")
 324       (while (search-backward "VL \\stoptable" nil t)
 325         (replace-match "stoptable" nil t)))))
 326
 327 (defun muse-context-fixup-dquotes ()
 328   "Fixup double quotes."
 329   (goto-char (point-min))
 330   (let ((open t))
 331     (while (search-forward "\"" nil t)
 332       (unless (get-text-property (match-beginning 0) 'read-only)
 333         (when (or (bobp)
 334                   (eq (char-before) ?\n))
 335           (setq open t))
 336         (if open
 337             (progn
 338               (replace-match "``")
 339               (setq open nil))
 340           (replace-match "''")
 341           (setq open t))))))
 342
 343 (defcustom muse-context-permit-contents-tag nil
 344   "If nil, ignore <contents> tags.  Otherwise, insert table of contents.
 345
 346 Most of the time, it is best to have a table of contents on the
 347 first page, with a new page immediately following.  To make this
 348 work with documents published in both HTML and ConTeXt, we need to
 349 ignore the <contents> tag.
 350
 351 If you don't agree with this, then set this option to non-nil,
 352 and it will do what you expect."
 353   :type 'boolean
 354   :group 'muse-context)
 355
 356 (defun muse-context-fixup-citations ()
 357   "Replace semicolons in multi-head citations with colons."
 358   (goto-char (point-min))
 359   (while (re-search-forward "\\\\cite.?\\[" nil t)
 360     (let ((start (point))
 361           (end (re-search-forward "]")))
 362       (save-restriction
 363         (narrow-to-region start end)
 364         (goto-char (point-min))
 365         (while (re-search-forward ";" nil t)
 366           (replace-match ","))))))
 367
 368 (defun muse-context-munge-buffer ()
 369   (muse-context-fixup-dquotes)
 370   (muse-context-fixup-citations)
 371   (when (and muse-context-permit-contents-tag
 372              muse-publish-generate-contents)
 373     (goto-char (car muse-publish-generate-contents))
 374     (muse-insert-markup "\\placecontent")))
 375
 376 (defun muse-context-bibliography ()
 377   (save-excursion
 378     (goto-char (point-min))
 379     (if (re-search-forward "\\\\cite.?\\[" nil t)
 380         "\\completepublications[criterium=all]"
 381       "")))
 382
 383 (defun muse-context-setup-bibliography ()
 384   (save-excursion
 385     (goto-char (point-min))
 386     (if (re-search-forward "\\\\cite.?\\[" nil t)
 387         (concat
 388          "\\usemodule[bibltx]\n\\setupbibtex [database="
 389          (muse-publishing-directive "bibsource") "]")
 390       "")))
 391
 392 (defun muse-context-pdf-browse-file (file)
 393   (shell-command (concat "open " file)))
 394
 395 (defun muse-context-pdf-generate (file output-path final-target)
 396   (apply
 397    #'muse-publish-transform-output
 398    file output-path final-target "PDF"
 399    (function
 400     (lambda (file output-path)
 401       (let* ((fnd (file-name-directory output-path))
 402              (command (format "cd \"%s\"; %s \"%s\""
 403                               fnd muse-context-pdf-program
 404                               (file-relative-name file fnd)))
 405              (times 0)
 406              result)
 407         ;; XEmacs can sometimes return a non-number result.  We'll err
 408         ;; on the side of caution by continuing to attempt to generate
 409         ;; the PDF if this happens and treat the final result as
 410         ;; successful.
 411         (while (and (< times 2)
 412                     (or (not (numberp result))
 413                         (not (eq result 0))
 414                         ;; table of contents takes 2 passes
 415 ;;                         (file-readable-p
 416 ;;                          (muse-replace-regexp-in-string
 417 ;;                           "\\.tex\\'" ".toc" file t t))
 418                         ))
 419           (setq result (shell-command command)
 420                 times (1+ times)))
 421         (if (or (not (numberp result))
 422                 (eq result 0))
 423             t
 424           nil))))
 425    muse-context-pdf-cruft))
 426
 427 (muse-define-style "context"
 428                    :suffix    'muse-context-extension
 429                    :regexps   'muse-context-markup-regexps
 430                    :functions 'muse-context-markup-functions
 431                    :strings   'muse-context-markup-strings
 432                    :specials  'muse-context-decide-specials
 433                    :after     'muse-context-munge-buffer
 434                    :header    'muse-context-header
 435                    :footer    'muse-context-footer
 436                    :browser   'find-file)
 437
 438 (muse-derive-style "context-pdf" "context"
 439                    :final   'muse-context-pdf-generate
 440                    :browser 'muse-context-pdf-browse-file
 441                    :link-suffix 'muse-context-pdf-extension
 442                    :osuffix 'muse-context-pdf-extension)
 443
 444 (muse-derive-style "context-slides" "context"
 445                    :header  'muse-context-slides-header
 446                    :strings 'muse-context-slides-markup-strings)
 447
 448 (muse-derive-style "context-slides-pdf" "context-pdf"
 449                    :header  'muse-context-slides-header
 450                    :strings 'muse-context-slides-markup-strings)
 451
 452 (provide 'muse-context)
 453
 454 ;;; muse-context.el ends here