lisp/muse-groff.el

   1 ;;; muse-groff.el --- publish groff -mom -mwww files
   2
   3 ;; Copyright (C) 2005, 2006, 2007, 2008, 2009
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Andrew J. Korty (ajk AT iu DOT edu)
   7 ;; Date: Tue 5-Jul-2005
   8
   9 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
  10
  11 ;; Emacs Muse is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published
  13 ;; by the Free Software Foundation; either version 3, or (at your
  14 ;; option) any later version.
  15
  16 ;; Emacs Muse is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Contributors:
  29
  30 ;;; Code:
  31
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33 ;;
  34 ;; Muse Publishing Using groff -mom -mwww
  35 ;;
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37
  38 (require 'muse-publish)
  39
  40 (defgroup muse-groff nil
  41   "Rules for marking up a Muse file with groff -mom -mwww macros."
  42   :group 'muse-publish)
  43
  44 (defcustom muse-groff-extension ".groff"
  45   "Default file extension for publishing groff -mom -mwww files."
  46   :type 'string
  47   :group 'muse-groff)
  48
  49 (defcustom muse-groff-pdf-extension ".pdf"
  50   "Default file extension for publishing groff -mom -mwww files to PDF."
  51   :type 'string
  52   :group 'muse-groff)
  53
  54 (defcustom muse-groff-header
  55   ".TITLE \"<lisp>(muse-publishing-directive \"title\")</lisp>\"
  56 .SUBTITLE \"<lisp>(muse-publishing-directive \"date\")</lisp>\"
  57 .AUTHOR \"<lisp>(muse-publishing-directive \"author\")</lisp>\"
  58 .PRINTSTYLE TYPESET
  59 .de list
  60 .    LIST \\$1
  61 .    SHIFT_LIST \\$2
  62 ..
  63 .PARA_INDENT 0
  64 .START
  65 <lisp>(and muse-publish-generate-contents \".TOC\n\")</lisp>\n"
  66   "Header used for publishing groff -mom -mwww files."
  67   :type '(choice string file)
  68   :group 'muse-groff)
  69
  70 (defcustom muse-groff-footer " "
  71   "Footer used for publishing groff -mom -mwww files."
  72   :type '(choice string file)
  73   :group 'muse-groff)
  74
  75 (defcustom muse-groff-markup-regexps
  76   `((10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
  77                     "\\(["
  78                     muse-regexp-blank
  79                     "]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?")
  80            0 muse-groff-markup-paragraph))
  81 "List of markup regexps for identifying regions in a Muse page.
  82 For more on the structure of this list, see `muse-publish-markup-regexps'."
  83   :type '(repeat (choice
  84                   (list :tag "Markup rule"
  85                         integer
  86                         (choice regexp symbol)
  87                         integer
  88                         (choice string function symbol))
  89                   function))
  90   :group 'muse-groff)
  91
  92 (defcustom muse-groff-markup-functions
  93   '((table . muse-groff-markup-table))
  94   "An alist of style types to custom functions for that kind of text.
  95 For more on the structure of this list, see
  96 `muse-publish-markup-functions'."
  97   :type '(alist :key-type symbol :value-type function)
  98   :group 'muse-groff)
  99
 100 (defcustom muse-groff-markup-tags
 101   '()
 102   "A list of tag specifications, for specially marking up GROFF."
 103   :type '(repeat (list (string :tag "Markup tag")
 104                        (boolean :tag "Expect closing tag" :value t)
 105                        (boolean :tag "Parse attributes" :value nil)
 106                        (boolean :tag "Nestable" :value nil)
 107                        function))
 108   :group 'muse-groff)
 109
 110 (defcustom muse-groff-markup-strings
 111   `((image-with-desc . "\n.MPIMG -R %s.%s\n")
 112     (image           . "\n.MPIMG -R %s.%s\n")
 113     (image-link      . "\n.\\\" %s\n.MPIMG -R %s.%s")
 114     (url             . "\n.URL %s %s\n\\z")
 115     (link            . "\n.URL %s %s\n\\z")
 116     (email-addr      . "\f[C]%s\f[]")
 117     (emdash          . "\\(em")
 118     (rule            . "\n.RULE\n")
 119     (no-break-space  . "\\h")
 120     (line-break      . "\\p")
 121     (enddots         . "....")
 122     (dots            . "...")
 123 ;;     (part            . "\\part{")
 124 ;;     (part-end        . "}")
 125 ;;     (chapter         . "\\chapter{")
 126 ;;     (chapter-end     . "}")
 127     (section         . ".HEAD \"")
 128     (section-end     . "\"")
 129     (subsection      . ".SUBHEAD \"")
 130     (subsection-end  . "\"")
 131     (subsubsection   . ".PARAHEAD \"")
 132     (subsubsection-end . "\"")
 133 ;;     (footnote        . "\\c\n.FOOTNOTE\n")
 134 ;;     (footnote-end    . "\n.FOOTNOTE OFF\n")
 135 ;;     (footnotemark    . "\\footnotemark[%d]")
 136 ;;     (footnotetext    . "\\footnotetext[%d]{")
 137 ;;     (footnotetext-end . "}")
 138     (begin-underline . "\n.UNDERSCORE \"")
 139     (end-underline   . "\"\n")
 140     (begin-literal   . "\\fC")
 141     (end-literal     . "\\fP")
 142     (begin-emph      . "\\fI")
 143     (end-emph        . "\\fP")
 144     (begin-more-emph . "\\fB")
 145     (end-more-emph   . "\\fP")
 146     (begin-most-emph . "\\f(BI")
 147     (end-most-emph   . "\\fP")
 148     (begin-verse     . ".QUOTE")
 149     (end-verse       . ".QUOTE OFF")
 150     (begin-center    . "\n.CENTER\n")
 151     (end-center      . "\n.QUAD L\n")
 152     (begin-example   . ,(concat
 153                          ".QUOTE_FONT CR\n.QUOTE_INDENT 1\n"".QUOTE_SIZE -2\n"
 154                          ".UNDERLINE_QUOTES OFF\n.QUOTE"))
 155     (end-example     . ".QUOTE OFF")
 156     (begin-quote     . ".BLOCKQUOTE")
 157     (end-quote       . ".BLOCKQUOTE OFF")
 158     (begin-cite     . "")
 159     (begin-cite-author . "")
 160     (begin-cite-year . "")
 161     (end-cite        . "")
 162     (begin-uli       . ".list BULLET\n.SHIFT_LIST 2m\n.ITEM\n")
 163     (end-uli         . "\n.LIST OFF")
 164     (begin-oli       . ".list DIGIT\n.SHIFT_LIST 2m\n.ITEM\n")
 165     (end-oli         . "\n.LIST OFF")
 166     (begin-ddt       . "\\fB")
 167     (begin-dde       . "\\fP\n.IR 4P\n")
 168     (end-ddt         . ".IRX CLEAR"))
 169   "Strings used for marking up text.
 170 These cover the most basic kinds of markup, the handling of which
 171 differs little between the various styles."
 172   :type '(alist :key-type symbol :value-type string)
 173   :group 'muse-groff)
 174
 175 (defcustom muse-groff-markup-specials
 176   '((?\\ . "\\e"))
 177   "A table of characters which must be represented specially."
 178   :type '(alist :key-type character :value-type string)
 179   :group 'muse-groff)
 180
 181 (defun muse-groff-markup-paragraph ()
 182   (let ((end (copy-marker (match-end 0) t)))
 183     (goto-char (1+ (match-beginning 0)))
 184     (delete-region (point) end)
 185     (unless (looking-at "\.\\(\\(\\(SUB\\|PARA\\)?HEAD \\)\\|RULE$\\)")
 186       (muse-insert-markup ".ALD .5v\n.PP\n.ne 2\n"))))
 187
 188 (defun muse-groff-protect-leading-chars ()
 189   "Protect leading periods and apostrophes from being interpreted as
 190 command characters."
 191   (while (re-search-forward "^[.']" nil t)
 192     (replace-match "\\\\&\\&" t)))
 193
 194 (defun muse-groff-concat-lists ()
 195   "Join like lists."
 196   (let ((type "")
 197         arg begin)
 198     (while (re-search-forward "^\.LIST[ \t]+\\(.*\\)\n" nil t)
 199       (setq arg (match-string 1))
 200       (if (string= arg "OFF")
 201           (setq begin (match-beginning 0))
 202         (if (and begin (string= type arg))
 203             (delete-region begin (match-end 0))
 204           (setq type arg
 205                 begin 0))))))
 206
 207 (defun muse-groff-fixup-dquotes ()
 208   "Fixup double quotes."
 209   (let ((open t))
 210     (while (search-forward "\"" nil t)
 211       (unless (get-text-property (match-beginning 0) 'read-only)
 212         (if (and (bolp) (eq (char-before) ?\n))
 213             (setq open t))
 214         (if open
 215             (progn
 216               (replace-match "``")
 217               (setq open nil))
 218           (replace-match "''")
 219           (setq open t))))))
 220
 221 (defun muse-groff-prepare-buffer ()
 222   (goto-char (point-min))
 223   (muse-groff-protect-leading-chars))
 224
 225 (defun muse-groff-munge-buffer ()
 226   (goto-char (point-min))
 227   (muse-groff-concat-lists))
 228
 229 (defun muse-groff-pdf-browse-file (file)
 230   (shell-command (concat "open " file)))
 231
 232 (defun muse-groff-pdf-generate (file output-path final-target)
 233   (muse-publish-transform-output
 234    file output-path final-target "PDF"
 235    (function
 236     (lambda (file output-path)
 237       (let ((command
 238              (format
 239               (concat "file=%s; ext=%s; cd %s && cp $file$ext $file.ref && "
 240                       "groff -mom -mwww -t $file$ext > $file.ps && "
 241                       "pstopdf $file.ps")
 242               (file-name-sans-extension file)
 243               muse-groff-extension
 244               (file-name-directory output-path))))
 245         (shell-command command))))
 246    ".ps"))
 247
 248 ;;; Register the Muse GROFF Publisher
 249
 250 (muse-define-style "groff"
 251                    :suffix    'muse-groff-extension
 252                    :regexps   'muse-groff-markup-regexps
 253 ;;;                :functions 'muse-groff-markup-functions
 254                    :strings   'muse-groff-markup-strings
 255                    :tags      'muse-groff-markup-tags
 256                    :specials  'muse-groff-markup-specials
 257                    :before    'muse-groff-prepare-buffer
 258                    :before-end 'muse-groff-munge-buffer
 259                    :header    'muse-groff-header
 260                    :footer    'muse-groff-footer
 261                    :browser   'find-file)
 262
 263 (muse-derive-style "groff-pdf" "groff"
 264                    :final   'muse-groff-pdf-generate
 265                    :browser 'muse-groff-pdf-browse-file
 266                    :osuffix 'muse-groff-pdf-extension)
 267
 268 (provide 'muse-groff)
 269
 270 ;;; muse-groff.el ends here
 271 ;;
 272 ;; Local Variables:
 273 ;; indent-tabs-mode: nil
 274 ;; End: