lisp/muse-groff.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Muse Publishing Using groff -mom -mwww
   4 ;;
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 (require 'muse-publish)
   8
   9 (defgroup muse-groff nil
  10   "Rules for marking up a Muse file with groff -mom -mwww macros."
  11   :group 'muse-publish)
  12
  13 (defcustom muse-groff-extension ".groff"
  14   "Default file extension for publishing groff -mom -mwww files."
  15   :type 'string
  16   :group 'muse-groff)
  17
  18 (defcustom muse-groff-pdf-extension ".pdf"
  19   "Default file extension for publishing groff -mom -mwww files to PDF."
  20   :type 'string
  21   :group 'muse-groff)
  22
  23 (defcustom muse-groff-header
  24   ".TITLE \"<lisp>(muse-publishing-directive \"title\")</lisp>\"
  25 .SUBTITLE \"<lisp>(muse-publishing-directive \"date\")</lisp>\"
  26 .AUTHOR \"<lisp>(muse-publishing-directive \"author\")</lisp>\"
  27 .PRINTSTYLE TYPESET
  28 .de list
  29 .    LIST \\$1
  30 .    SHIFT_LIST \\$2
  31 ..
  32 .PARA_INDENT 0
  33 .START
  34 <lisp>(and muse-publish-generate-contents \".TOC\n\")</lisp>\n"
  35   "Header used for publishing groff -mom -mwww files."
  36   :type '(choice string file)
  37   :group 'muse-groff)
  38
  39 (defcustom muse-groff-footer " "
  40   "Footer used for publishing groff -mom -mwww files."
  41   :type '(choice string file)
  42   :group 'muse-groff)
  43
  44 (defcustom muse-groff-markup-regexps
  45   `((10400 ,(concat "\\(\n</\\(blockquote\\|center\\)>\\)?\n"
  46                     "\\(["
  47                     muse-regexp-blank
  48                     "]*\n\\)+\\(<\\(blockquote\\|center\\)>\n\\)?")
  49            0 muse-groff-markup-paragraph))
  50 "List of markup regexps for identifying regions in a Muse page.
  51 For more on the structure of this list, see `muse-publish-markup-regexps'."
  52   :type '(repeat (choice
  53                   (list :tag "Markup rule"
  54                         integer
  55                         (choice regexp symbol)
  56                         integer
  57                         (choice string function symbol))
  58                   function))
  59   :group 'muse-groff)
  60
  61 (defcustom muse-groff-markup-functions
  62   '((table . muse-groff-markup-table))
  63   "An alist of style types to custom functions for that kind of text.
  64 For more on the structure of this list, see
  65 `muse-publish-markup-functions'."
  66   :type '(alist :key-type symbol :value-type function)
  67   :group 'muse-groff)
  68
  69 (defcustom muse-groff-markup-tags
  70   '()
  71   "A list of tag specifications, for specially marking up GROFF."
  72   :type '(repeat (list (string :tag "Markup tag")
  73                        (boolean :tag "Expect closing tag" :value t)
  74                        (boolean :tag "Parse attributes" :value nil)
  75                        function))
  76   :group 'muse-groff)
  77
  78 (defcustom muse-groff-markup-strings
  79   `((image-with-desc . "\n.MPIMG -R %s\n")
  80     (image-link      . "\n.MPIMG -R %s\n")
  81     (url-with-image  . "\n.\\\" %s\n.MPIMG -R %s")
  82     (url-link        . "\n.URL %s %s\n\\z")
  83     (email-addr      . "\f[C]%s\f[]")
  84     (emdash          . "\\(em")
  85     (rule            . "\n.RULE\n")
  86     (enddots         . "....")
  87     (dots            . "...")
  88 ;;     (part            . "\\part{")
  89 ;;     (part-end        . "}")
  90 ;;     (chapter         . "\\chapter{")
  91 ;;     (chapter-end     . "}")
  92     (section         . ".HEAD \"")
  93     (section-end     . "\"")
  94     (subsection      . ".SUBHEAD \"")
  95     (subsection-end  . "\"")
  96     (subsubsection   . ".PARAHEAD \"")
  97     (subsubsection-end . "\"")
  98 ;;     (footnote        . "\\c\n.FOOTNOTE\n")
  99 ;;     (footnote-end    . "\n.FOOTNOTE OFF\n")
 100 ;;     (footnotemark    . "\\footnotemark[%d]")
 101 ;;     (footnotetext    . "\\footnotetext[%d]{")
 102 ;;     (footnotetext-end . "}")
 103     (begin-underline . "\n.UNDERSCORE \"")
 104     (end-underline   . "\"\n")
 105     (begin-literal   . "\\fC")
 106     (end-literal     . "\\fP")
 107     (begin-emph      . "\\fI")
 108     (end-emph        . "\\fP")
 109     (begin-more-emph . "\\fB")
 110     (end-more-emph   . "\\fP")
 111     (begin-most-emph . "\\f(BI")
 112     (end-most-emph   . "\\fP")
 113     (begin-verse     . ".QUOTE")
 114     (end-verse-line  . "")
 115     (last-stanza-end . "")
 116     (end-verse       . ".QUOTE OFF")
 117     (begin-center    . "\n.CENTER\n")
 118     (end-center      . "\n.QUAD L\n")
 119     (begin-example   . ,(concat
 120                          ".QUOTE_FONT CR\n.QUOTE_INDENT 1\n"".QUOTE_SIZE -2\n"
 121                          ".UNDERLINE_QUOTES OFF\n.QUOTE"))
 122     (end-example     . ".QUOTE OFF")
 123     (begin-quote     . ".BLOCKQUOTE")
 124     (end-quote       . ".BLOCKQUOTE OFF")
 125     (begin-uli       . ".list BULLET\n.SHIFT_LIST 2m\n.ITEM\n")
 126     (end-uli         . "\n.LIST OFF")
 127     (begin-oli       . ".list DIGIT\n.SHIFT_LIST 2m\n.ITEM\n")
 128     (end-oli         . "\n.LIST OFF")
 129     (begin-ddt       . "\\fB")
 130     (start-dde       . "\\fP\n.IR 4P\n")
 131     (end-ddt         . ".IRX CLEAR"))
 132   "Strings used for marking up text.
 133 These cover the most basic kinds of markup, the handling of which
 134 differs little between the various styles."
 135   :type '(alist :key-type symbol :value-type string)
 136   :group 'muse-groff)
 137
 138 (defcustom muse-groff-markup-specials
 139   '((?\\ . "\\e"))
 140   "A table of characters which must be represented specially."
 141   :type '(alist :key-type character :value-type string)
 142   :group 'muse-groff)
 143
 144 (defun muse-groff-markup-paragraph ()
 145   (let ((end (copy-marker (match-end 0) t)))
 146     (goto-char (1+ (match-beginning 0)))
 147     (delete-region (point) end)
 148     (unless (looking-at "\.\\(\\(\\(SUB\\|PARA\\)?HEAD \\)\\|RULE$\\)")
 149       (insert ".ALD .5v\n.PP\n.ne 2\n"))))
 150
 151 ;; (defun muse-latex-markup-table ()
 152 ;;   (let* ((str (prog1
 153 ;;                (match-string 1)
 154 ;;              (delete-region (match-beginning 0) (match-end 0))))
 155 ;;       (fields (split-string str "\\s-*|+\\s-*"))
 156 ;;       (type (and (string-match "\\s-*\\(|+\\)\\s-*" str)
 157 ;;                  (length (match-string 1 str)))))
 158 ;;     (insert "\\begin{tabular}{" (make-string (length fields) ?l) "}\n")
 159 ;;     (insert (mapconcat 'identity fields " & "))
 160 ;;     (insert " \\\\\n\\end{tabular}")))
 161
 162 (defun muse-groff-protect-leading-chars ()
 163   "Protect leading periods and apostrophes from being interpreted as
 164 command characters."
 165   (while (re-search-forward "^[.']" nil t)
 166     (replace-match "\\\\&\\&" t)))
 167
 168 (defun muse-groff-concat-lists ()
 169   "Join like lists."
 170   (let ((type "")
 171         arg begin)
 172     (while (re-search-forward "^\.LIST[ \t]+\\(.*\\)\n" nil t)
 173       (setq arg (match-string 1))
 174       (if (string= arg "OFF")
 175           (setq begin (match-beginning 0))
 176         (if (and begin (string= type arg))
 177             (delete-region begin (match-end 0))
 178           (setq type arg
 179                 begin 0))))))
 180
 181 (defun muse-groff-fixup-dquotes ()
 182   "Fixup double quotes."
 183   (let ((open t))
 184     (while (search-forward "\"" nil t)
 185       (unless (get-text-property (match-beginning 0) 'read-only)
 186         (if (and (bolp) (eq (char-before) ?\n))
 187             (setq open t))
 188         (if open
 189             (progn
 190               (replace-match "``")
 191               (setq open nil))
 192           (replace-match "''")
 193           (setq open t))))))
 194
 195 (defun muse-groff-prepare-buffer ()
 196   (goto-char (point-min))
 197   (muse-groff-protect-leading-chars))
 198
 199 (defun muse-groff-finalize-buffer ()
 200   (goto-char (point-min))
 201   (muse-groff-concat-lists))
 202
 203 (defun muse-groff-pdf-browse-file (file)
 204   (shell-command (concat "open " file)))
 205
 206 (defun muse-groff-pdf-generate (file output-path final-target)
 207   (muse-publish-transform-output
 208    file output-path final-target "PDF"
 209    (function
 210     (lambda (file output-path)
 211       (let ((command
 212              (format
 213               (concat "file=%s; ext=%s; cd %s && cp $file$ext $file.ref && "
 214                       "groff -mom -mwww -t $file$ext > $file.ps && "
 215                       "pstopdf $file.ps")
 216               (file-name-sans-extension file)
 217               muse-groff-extension
 218               (file-name-directory output-path))))
 219         (shell-command command))))
 220    ".ps"))
 221
 222 (unless (assoc "groff" muse-publishing-styles)
 223   (muse-define-style "groff"
 224                      :suffix    'muse-groff-extension
 225                      :regexps   'muse-groff-markup-regexps
 226 ;;;                  :functions 'muse-groff-markup-functions
 227                      :strings   'muse-groff-markup-strings
 228                      :tags      'muse-groff-markup-tags
 229                      :specials  'muse-groff-markup-specials
 230                      :before    'muse-groff-prepare-buffer
 231                      :after     'muse-groff-finalize-buffer
 232                      :header    'muse-groff-header
 233                      :footer    'muse-groff-footer
 234                      :browser   'find-file)
 235
 236   (muse-derive-style "groff-pdf" "groff"
 237                      :final   'muse-groff-pdf-generate
 238                      :browser 'muse-groff-pdf-browse-file
 239                      :osuffix 'muse-groff-pdf-extension))
 240
 241 (provide 'muse-groff)
 242
 243 ;;; muse-groff.el ends here
 244 ;;
 245 ;; Local Variables:
 246 ;; indent-tabs-mode: nil
 247 ;; End: