contrib/lisp/ox-groff.el

   1 ;;; ox-groff.el --- Groff Back-End for Org Export Engine
   2
   3 ;; Copyright (C) 2011-2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
   6 ;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21 ;;; Commentary:
  22 ;;
  23 ;; This library implements a Groff Memorandum Macro back-end for Org
  24 ;; generic exporter.
  25 ;;
  26 ;; To test it, run
  27 ;;
  28 ;;   M-: (org-export-to-buffer 'groff "*Test Groff*") RET
  29 ;;
  30 ;; in an org-mode buffer then switch to the buffer to see the Groff
  31 ;; export.  See ox.el for more details on how this exporter works.
  32 ;;
  33 ;; It introduces two new buffer keywords: "GROFF_CLASS" and
  34 ;; "GROFF_CLASS_OPTIONS".
  35
  36 ;;; Code:
  37
  38 (eval-when-compile (require 'cl))
  39 (require 'ox)
  40
  41 (defvar orgtbl-exp-regexp)
  42
  43 \f
  44 ;;; Define Back-End
  45
  46 (org-export-define-backend groff
  47   ((bold . org-groff-bold)
  48    (center-block . org-groff-center-block)
  49    (clock . org-groff-clock)
  50    (code . org-groff-code)
  51    (comment . (lambda (&rest args) ""))
  52    (comment-block . (lambda (&rest args) ""))
  53    (drawer . org-groff-drawer)
  54    (dynamic-block . org-groff-dynamic-block)
  55    (entity . org-groff-entity)
  56    (example-block . org-groff-example-block)
  57    (export-block . org-groff-export-block)
  58    (export-snippet . org-groff-export-snippet)
  59    (fixed-width . org-groff-fixed-width)
  60    (footnote-definition . org-groff-footnote-definition)
  61    (footnote-reference . org-groff-footnote-reference)
  62    (headline . org-groff-headline)
  63    (horizontal-rule . org-groff-horizontal-rule)
  64    (inline-src-block . org-groff-inline-src-block)
  65    (inlinetask . org-groff-inlinetask)
  66    (italic . org-groff-italic)
  67    (item . org-groff-item)
  68    (keyword . org-groff-keyword)
  69    (line-break . org-groff-line-break)
  70    (link . org-groff-link)
  71    (paragraph . org-groff-paragraph)
  72    (plain-list . org-groff-plain-list)
  73    (plain-text . org-groff-plain-text)
  74    (planning . org-groff-planning)
  75    (property-drawer . (lambda (&rest args) ""))
  76    (quote-block . org-groff-quote-block)
  77    (quote-section . org-groff-quote-section)
  78    (radio-target . org-groff-radio-target)
  79    (section . org-groff-section)
  80    (special-block . org-groff-special-block)
  81    (src-block . org-groff-src-block)
  82    (statistics-cookie . org-groff-statistics-cookie)
  83    (strike-through . org-groff-strike-through)
  84    (subscript . org-groff-subscript)
  85    (superscript . org-groff-superscript)
  86    (table . org-groff-table)
  87    (table-cell . org-groff-table-cell)
  88    (table-row . org-groff-table-row)
  89    (target . org-groff-target)
  90    (template . org-groff-template)
  91    (timestamp . org-groff-timestamp)
  92    (underline . org-groff-underline)
  93    (verbatim . org-groff-verbatim)
  94    (verse-block . org-groff-verse-block))
  95   :export-block "GROFF"
  96   :menu-entry
  97   (?g "Export to GROFF"
  98       ((?g "As GROFF file" org-groff-export-to-groff)
  99        (?p "As PDF file" org-groff-export-to-pdf)
 100        (?o "As PDF file and open"
 101            (lambda (a s v b)
 102              (if a (org-groff-export-to-pdf t s v b)
 103                (org-open-file (org-groff-export-to-pdf nil s v b)))))))
 104   :options-alist
 105   ((:groff-class "GROFF_CLASS" nil org-groff-default-class t)
 106    (:groff-class-options "GROFF_CLASS_OPTIONS" nil nil t)
 107    (:groff-header-extra "GROFF_HEADER" nil nil newline)))
 108
 109
 110 \f
 111 ;;; User Configurable Variables
 112
 113 (defgroup org-export-groff nil
 114   "Options for exporting Org mode files to Groff."
 115   :tag "Org Export Groff"
 116   :group 'org-export)
 117
 118 ;;; Preamble
 119
 120 (defcustom org-groff-default-class "internal"
 121   "The default Groff class."
 122   :group 'org-export-groff
 123   :type '(string :tag "Groff class"))
 124
 125 (defcustom org-groff-classes
 126   '(("file" ".MT 1"
 127      (:heading 'default :type "memo" :last-section "toc"))
 128     ("internal" ".MT 0"
 129      (:heading 'default :type "memo" :last-section "toc"))
 130     ("programmer" ".MT 2"
 131      (:heading 'default :type "memo" :last-section "toc"))
 132     ("engineer" ".MT 3"
 133      (:heading 'default :type "memo" :last-section "toc"))
 134     ("external" ".MT 4"
 135      (:heading 'default :type "memo" :last-section "toc"))
 136     ("letter" ".MT 5"
 137      (:heading 'default :type "memo" :last-section "sign"))
 138     ("custom" ".so file"
 139      (:heading custom-function :type "custom" :last-section "toc"))
 140     ("dummy" ""
 141      (:heading 'default :type "memo"))
 142     ("ms" "ms"
 143      (:heading 'default :type "cover" :last-section "toc"))
 144     ("se_ms" "se_ms"
 145      (:heading 'default :type "cover" :last-section "toc"))
 146     ("block" "BL"
 147      (:heading 'default :type "letter" :last-section "sign"))
 148     ("semiblock" "SB"
 149      (:heading 'default :type "letter" :last-section "sign"))
 150     ("fullblock" "FB"
 151      (:heading 'default :type "letter" :last-section "sign"))
 152     ("simplified" "SP"
 153      (:heading 'default :type "letter" :last-section "sign"))
 154     ("none" "" (:heading 'default :type "custom")))
 155
 156   ;; none means, no Cover or Memorandum Type and no calls to AU, AT, ND and TL
 157   ;; This is to facilitate the creation of custom pages.
 158
 159   ;; dummy means, no Cover or Memorandum Type but calls to AU, AT, ND and TL
 160   ;; are made. This is to facilitate Abstract Insertion.
 161
 162   "This list describes the attributes for the documents being created.
 163    It allows for the creation of new "
 164   :group 'org-export-groff
 165   :type '(repeat
 166           (list (string :tag "Document Type")
 167                 (string :tag "Header")
 168                 (repeat :tag "Options" :inline t
 169                         (choice
 170                          (list :tag "Heading")
 171                          (function :tag "Hook computing sectioning"))))))
 172
 173 ;;; Headline
 174
 175 (defconst org-groff-special-tags
 176   '("FROM" "TO" "ABSTRACT" "APPENDIX" "BODY" "NS"))
 177
 178 (defcustom org-groff-format-headline-function nil
 179   "Function to format headline text.
 180
 181 This function will be called with 5 arguments:
 182 TODO      the todo keyword (string or nil).
 183 TODO-TYPE the type of todo (symbol: `todo', `done', nil)
 184 PRIORITY  the priority of the headline (integer or nil)
 185 TEXT      the main headline text (string).
 186 TAGS      the tags as a list of strings (list of strings or nil).
 187
 188 The function result will be used in the section format string.
 189
 190 As an example, one could set the variable to the following, in
 191 order to reproduce the default set-up:
 192
 193 \(defun org-groff-format-headline (todo todo-type priority text tags)
 194   \"Default format function for a headline.\"
 195   \(concat (when todo
 196             \(format \"\\fB%s\\fP \" todo))
 197           \(when priority
 198             \(format \"[\\#%c] \" priority))
 199           text
 200           \(when tags
 201             \(format \" %s \"
 202               \(mapconcat 'identity tags \":\"))))"
 203   :group 'org-export-groff
 204   :type 'function)
 205
 206 ;;; Timestamps
 207
 208 (defcustom org-groff-active-timestamp-format "\\fI%s\\fP"
 209   "A printf format string to be applied to active timestamps."
 210   :group 'org-export-groff
 211   :type 'string)
 212
 213 (defcustom org-groff-inactive-timestamp-format "\\fI%s\\fP"
 214   "A printf format string to be applied to inactive timestamps."
 215   :group 'org-export-groff
 216   :type 'string)
 217
 218 (defcustom org-groff-diary-timestamp-format "\\fI%s\\fP"
 219   "A printf format string to be applied to diary timestamps."
 220   :group 'org-export-groff
 221   :type 'string)
 222
 223 ;;; Links
 224
 225 (defcustom org-groff-inline-image-rules
 226   '(("file" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'")
 227     ("fuzzy" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'"))
 228   "Rules characterizing image files that can be inlined into Groff.
 229
 230 A rule consists in an association whose key is the type of link
 231 to consider, and value is a regexp that will be matched against
 232 link's path.
 233
 234 Note that, by default, the image extensions actually allowed
 235 depend on the way the Groff file is processed.  When used with
 236 pdfgroff, pdf, jpg and png images are OK.  When processing
 237 through dvi to Postscript, only ps and eps are allowed.  The
 238 default we use here encompasses both."
 239   :group 'org-export-groff
 240   :type '(alist :key-type (string :tag "Type")
 241                 :value-type (regexp :tag "Path")))
 242
 243 (defcustom org-groff-link-with-unknown-path-format "\\fI%s\\fP"
 244   "Format string for links with unknown path type."
 245   :group 'org-export-groff
 246   :type 'string)
 247
 248 ;;; Tables
 249
 250 (defcustom org-groff-tables-centered t
 251   "When non-nil, tables are exported in a center environment."
 252   :group 'org-export-groff
 253   :type 'boolean)
 254
 255 (defcustom org-groff-tables-verbatim nil
 256   "When non-nil, tables are exported verbatim."
 257   :group 'org-export-groff
 258   :type 'boolean)
 259
 260 (defcustom org-groff-table-scientific-notation "%sE%s"
 261   "Format string to display numbers in scientific notation.
 262 The format should have \"%s\" twice, for mantissa and exponent
 263 \(i.e. \"%s\\\\times10^{%s}\").
 264
 265 When nil, no transformation is made."
 266   :group 'org-export-groff
 267   :type '(choice
 268           (string :tag "Format string")
 269           (const :tag "No formatting")))
 270
 271 ;;; Text markup
 272
 273 (defcustom org-groff-text-markup-alist
 274    '((bold . "\\fB%s\\fP")
 275     (code . "\\fC%s\\fP")
 276     (italic . "\\fI%s\\fP")
 277     (strike-through . "\\fC%s\\fP")  ; Strike through and underline
 278     (underline . "\\fI%s\\fP")       ; need to be revised.
 279     (verbatim .   "protectedtexttt"))
 280   "Alist of Groff expressions to convert text markup.
 281
 282 The key must be a symbol among `bold', `code', `italic',
 283 `strike-through', `underline' and `verbatim'.  The value is
 284 a formatting string to wrap fontified text with it.
 285
 286 If no association can be found for a given markup, text will be
 287 returned as-is."
 288   :group 'org-export-groff
 289   :type 'alist
 290   :options '(bold code italic strike-through underline verbatim))
 291
 292 ;;; Drawers
 293
 294 (defcustom org-groff-format-drawer-function nil
 295   "Function called to format a drawer in Groff code.
 296
 297 The function must accept two parameters:
 298   NAME      the drawer name, like \"LOGBOOK\"
 299   CONTENTS  the contents of the drawer.
 300
 301 The function should return the string to be exported.
 302
 303 For example, the variable could be set to the following function
 304 in order to mimic default behaviour:
 305
 306 \(defun org-groff-format-drawer-default \(name contents\)
 307   \"Format a drawer element for Groff export.\"
 308   contents\)"
 309   :group 'org-export-groff
 310   :type 'function)
 311
 312 ;;; Inlinetasks
 313
 314 (defcustom org-groff-format-inlinetask-function nil
 315   "Function called to format an inlinetask in Groff code.
 316
 317 The function must accept six parameters:
 318   TODO      the todo keyword, as a string
 319   TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
 320   PRIORITY  the inlinetask priority, as a string
 321   NAME      the inlinetask name, as a string.
 322   TAGS      the inlinetask tags, as a list of strings.
 323   CONTENTS  the contents of the inlinetask, as a string.
 324
 325 The function should return the string to be exported.
 326
 327 For example, the variable could be set to the following function
 328 in order to mimic default behaviour:
 329
 330 \(defun org-groff-format-inlinetask \(todo type priority name tags contents\)
 331 \"Format an inline task element for Groff export.\"
 332   \(let ((full-title
 333          \(concat
 334           \(when todo
 335             \(format \"\\fB%s\\fP \" todo))
 336           \(when priority (format \"[\\#%c] \" priority))
 337           title
 338           \(when tags
 339             \(format \":%s:\"
 340                     \(mapconcat 'identity tags \":\")))))
 341     \(format (concat \".DS L\\n\"
 342                     \"%s\\n\\n\"
 343                     \"%s\"
 344                     \".DE\")
 345             full-title contents))"
 346   :group 'org-export-groff
 347   :type 'function)
 348
 349 ;; Src blocks
 350
 351 (defcustom org-groff-source-highlight nil
 352   "Use GNU source highlight to embellish source blocks "
 353   :group 'org-export-groff
 354   :type 'boolean)
 355
 356 (defcustom org-groff-source-highlight-langs
 357   '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
 358     (scheme "scheme")
 359     (c "c") (cc "cpp") (csharp "csharp") (d "d")
 360     (fortran "fortran") (cobol "cobol") (pascal "pascal")
 361     (ada "ada") (asm "asm")
 362     (perl "perl") (cperl "perl")
 363     (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
 364     (java "java") (javascript "javascript")
 365     (tex "latex")
 366     (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
 367     (ocaml "caml") (caml "caml")
 368     (sql "sql") (sqlite "sql")
 369     (html "html") (css "css") (xml "xml")
 370     (bat "bat") (bison "bison") (clipper "clipper")
 371     (ldap "ldap") (opa "opa")
 372     (php "php") (postscript "postscript") (prolog "prolog")
 373     (properties "properties") (makefile "makefile")
 374     (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
 375   "Alist mapping languages to their listing language counterpart.
 376 The key is a symbol, the major mode symbol without the \"-mode\".
 377 The value is the string that should be inserted as the language
 378 parameter for the listings package.  If the mode name and the
 379 listings name are the same, the language does not need an entry
 380 in this list - but it does not hurt if it is present."
 381   :group 'org-export-groff
 382   :type '(repeat
 383           (list
 384            (symbol :tag "Major mode       ")
 385            (string :tag "Listings language"))))
 386
 387 (defcustom org-groff-source-highlight-options nil
 388   "Association list of options for the groff listings package.
 389
 390 These options are supplied as a comma-separated list to the
 391 \\lstset command.  Each element of the association list should be
 392 a list containing two strings: the name of the option, and the
 393 value.  For example,
 394
 395   (setq org-groff-source-highlight-options
 396     '((\"basicstyle\" \"\\small\")
 397       (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
 398
 399 will typeset the code in a small size font with underlined, bold
 400 black keywords.
 401
 402 Note that the same options will be applied to blocks of all
 403 languages."
 404   :group 'org-export-groff
 405   :type '(repeat
 406           (list
 407            (string :tag "Listings option name ")
 408            (string :tag "Listings option value"))))
 409
 410 (defvar org-groff-custom-lang-environments nil
 411   "Alist mapping languages to language-specific Groff environments.
 412
 413 It is used during export of src blocks by the listings and
 414 groff packages.  For example,
 415
 416   \(setq org-groff-custom-lang-environments
 417      '\(\(python \"pythoncode\"\)\)\)
 418
 419 would have the effect that if org encounters begin_src python
 420 during groff export it will use pythoncode as the source-highlight
 421 language.")
 422
 423 ;;; Plain text
 424
 425 (defcustom org-groff-special-char
 426   '(("(c)" . "\\\\(co")
 427     ("(tm)" . "\\\\(tm")
 428     ("(rg)" . "\\\\(rg"))
 429   "CONS list in which the value of the car
 430   is replace on the value of the CDR. "
 431   :group 'org-export-groff
 432   :type '(list
 433           (cons :tag "Character Subtitute"
 434                 (string :tag "Original Character Group")
 435                 (string :tag "Replacement Character"))))
 436
 437 ;;; Compilation
 438
 439 (defcustom org-groff-pdf-process
 440   '("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
 441     "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
 442     "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")
 443
 444   "Commands to process a Groff file to a PDF file.
 445 This is a list of strings, each of them will be given to the
 446 shell as a command.  %f in the command will be replaced by the
 447 full file name, %b by the file base name \(i.e. without
 448 extension) and %o by the base directory of the file."
 449   :group 'org-export-pdf
 450   :type '(choice
 451           (repeat :tag "Shell command sequence"
 452                   (string :tag "Shell command"))
 453           (const :tag "2 runs of pdfgroff"
 454                  ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
 455                   "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
 456           (const :tag "3 runs of pdfgroff"
 457                  ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
 458                   "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
 459                   "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
 460           (function)))
 461
 462 (defcustom org-groff-logfiles-extensions
 463   '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
 464   "The list of file extensions to consider as Groff logfiles."
 465   :group 'org-export-groff
 466   :type '(repeat (string :tag "Extension")))
 467
 468 (defcustom org-groff-remove-logfiles t
 469   "Non-nil means remove the logfiles produced by PDF production.
 470 These are the .aux, .log, .out, and .toc files."
 471   :group 'org-export-groff
 472   :type 'boolean)
 473
 474 (defcustom org-groff-organization "Org User"
 475   "Name of the organization used to populate the .AF command."
 476   :group 'org-export-groff
 477   :type 'string)
 478
 479 (defcustom org-groff-raster-to-ps nil
 480   "Command used to convert raster to EPS. Nil for no conversion. Make sure that
 481    `org-groff-inline-image-rules' is adjusted accordingly if not conversion is being
 482    done. In this case, remove the entries for jpg and png in the file and fuzzy lists."
 483   :group 'org-export-groff
 484   :type '(choice
 485          (repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
 486          (const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b} ;grep -v BeginData ${b} > b_${b};mv b_${b} ${b}" )
 487          (const :tag "NetPNM"  "a=%s;b=%s;pngtopnm ${a} | pnmtops -noturn > ${b}" )
 488          (const :tag "None" nil)))
 489
 490 (defvar org-groff-registered-references nil)
 491 (defvar org-groff-special-content nil)
 492
 493
 494 \f
 495 ;;; Internal Functions
 496
 497 (defun org-groff--caption/label-string (element info)
 498   "Return caption and label Groff string for ELEMENT.
 499
 500 INFO is a plist holding contextual information.  If there's no
 501 caption nor label, return the empty string.
 502
 503 For non-floats, see `org-groff--wrap-label'."
 504   (let ((main (org-export-get-caption element))
 505         (short (org-export-get-caption element t))
 506         (label (org-element-property :name element)))
 507     (cond ((and (not main) (not label)) "")
 508           ((not main) (format "\\fI%s\\fP" label))
 509           ;; Option caption format with short name.
 510           (short (format "%s\n.br\n - %s\n"
 511                          (org-export-data short info)
 512                          (org-export-data main info)))
 513           ;; Standard caption format.
 514           (t (format "\\fR%s\\fP" (org-export-data main info))))))
 515
 516 (defun org-groff--wrap-label (element output)
 517   "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
 518 This function shouldn't be used for floats.  See
 519 `org-groff--caption/label-string'."
 520   (let ((label (org-element-property :name element)))
 521     (if (or (not output) (not label) (string= output "") (string= label ""))
 522         output
 523       (concat (format "%s\n.br\n" label) output))))
 524
 525 (defun org-groff--text-markup (text markup)
 526   "Format TEXT depending on MARKUP text markup.
 527 See `org-groff-text-markup-alist' for details."
 528   (let ((fmt (cdr (assq markup org-groff-text-markup-alist))))
 529     (cond
 530      ;; No format string: Return raw text.
 531      ((not fmt) text)
 532      ((string= "protectedtexttt" fmt)
 533       (let ((start 0)
 534             (trans '(("\\" . "\\")))
 535             (rtn "")
 536             char)
 537         (while (string-match "[\\{}$%&_#~^]" text)
 538           (setq char (match-string 0 text))
 539           (if (> (match-beginning 0) 0)
 540               (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
 541           (setq text (substring text (1+ (match-beginning 0))))
 542           (setq char (or (cdr (assoc char trans)) (concat "\\" char))
 543                 rtn (concat rtn char)))
 544         (setq text (concat rtn text))
 545         (format "\\fC%s\\fP" text)))
 546      ;; Else use format string.
 547      (t (format fmt text)))))
 548
 549
 550 (defun org-groff--get-tagged-content  (tag info)
 551   (cdr  (assoc tag org-groff-special-content)))
 552
 553 (defun org-groff--mt-head (title contents attr info)
 554   (concat
 555
 556    ;; 1. Insert Organization
 557    (let ((firm-option (plist-get attr :firm)))
 558      (cond
 559       ((stringp firm-option)
 560        (format ".AF \"%s\" \n" firm-option))
 561       (t (format ".AF \"%s\" \n" (or org-groff-organization "")))))
 562
 563    ;; 2. Title
 564    (let ((subtitle1 (plist-get attr :subtitle1))
 565          (subtitle2 (plist-get attr :subtitle2)))
 566
 567      (cond
 568       ((string= "" title)
 569        (format ".TL \"%s\" \"%s\" \n%s\n"
 570                (or subtitle1 "")
 571                (or subtitle2 "") " "))
 572
 573       ((not (or subtitle1 subtitle2))
 574        (format ".TL\n%s\n"
 575                (or title "")))
 576       (t
 577        (format ".TL \"%s\" \"%s \" \n%s\n"
 578                (or subtitle1 "")
 579                (or subtitle2 "") title))))
 580
 581    ;; 3. Author.
 582    ;; In Groff, .AU *MUST* be placed after .TL
 583    ;; If From, populate with data from From else
 584    ;;
 585    (let ((author (and (plist-get info :with-author)
 586                       (let ((auth (plist-get info :author)))
 587                         (and auth (org-export-data auth info)))))
 588          (email (and (plist-get info :with-email)
 589                      (org-export-data (plist-get info :email) info)))
 590          (from-data  (org-groff--get-tagged-content "FROM" info))
 591
 592          (to-data  (org-groff--get-tagged-content "TO" info)))
 593
 594      (cond
 595       ((and author from-data)
 596        (let ((au-line
 597               (mapconcat
 598                (lambda (from-line)
 599                  (format " \"%s\" " from-line))
 600                (split-string
 601                 (setq from-data
 602                       (replace-regexp-in-string "\\.P\n" "" from-data)) "\n") "")))
 603
 604          (concat
 605           (format ".AU \"%s\" " author) au-line "\n")))
 606
 607       ((and author email (not (string= "" email)))
 608        (format ".AU \"%s\" \"%s\"\n" author email))
 609
 610       (author (format ".AU \"%s\"\n" author))
 611
 612       (t ".AU \"\" \n")))
 613
 614
 615    ;; 4. Author Title, if present
 616    (let ((at-item (plist-get attr :author-title)))
 617      (if (and at-item (stringp at-item))
 618          (format ".AT \"%s\" \n" at-item)
 619        ""))
 620
 621    ;; 5. Date.
 622    (when (plist-get info :with-date)
 623      (let ((date (org-export-data (plist-get info :date) info)))
 624        (and date (format ".ND \"%s\"\n" date))))
 625
 626    ;;
 627    ;; If Abstract, then Populate Abstract
 628    ;;
 629
 630    (let ((abstract-data (org-groff--get-tagged-content "ABSTRACT" info))
 631          (to-data (org-groff--get-tagged-content "TO" info)))
 632      (cond
 633       (abstract-data
 634        (format ".AS\n%s\n.AE\n" abstract-data))
 635       (to-data
 636        (format ".AS\n%s\n.AE\n" to-data))))))
 637
 638 (defun org-groff--letter-head (title contents attr info)
 639   (let ((author (and (plist-get info :with-author)
 640                      (let ((auth (plist-get info :author)))
 641                        (and auth (org-export-data auth info)))))
 642         (email (and (plist-get info :with-email)
 643                     (org-export-data (plist-get info :email) info)))
 644         (from-data  (org-groff--get-tagged-content "FROM" info))
 645         (at-item (plist-get attr :author-title))
 646         (to-data  (org-groff--get-tagged-content "TO" info)))
 647
 648
 649     ;; If FROM then get data from FROM
 650     (if from-data
 651         (setq from-data
 652               (replace-regexp-in-string "\\.P\n" "" from-data))
 653       (setq from-data ""))
 654
 655     (if to-data
 656         (setq to-data
 657               (replace-regexp-in-string "\\.P\n" "" to-data))
 658       (setq from-data ""))
 659
 660     (concat
 661      (cond
 662       (from-data
 663        (format ".WA \"%s\" \"%s\" \n%s\n.WE\n" author (or at-item "") from-data))
 664       ((and author email (not (string= "" email)))
 665        (format ".WA \"%s\"\n \"%s\"\n.WE\n" author email))
 666       (author (format ".WA \"%s\"\n.WE\n" author))
 667       (t ".WA \"\" \n.WE\n"))
 668
 669      ;; If TO then get data from TO
 670
 671      (when to-data
 672        (format ".IA \n%s\n.IE\n" to-data)))))
 673
 674 \f
 675 ;;; Template
 676
 677 (defun org-groff-template (contents info)
 678   "Return complete document string after Groff conversion.
 679 CONTENTS is the transcoded contents string.  INFO is a plist
 680 holding export options."
 681   (let* ((title (org-export-data (plist-get info :title) info))
 682          (attr (read
 683                 (format "(%s)"
 684                         (mapconcat
 685                          #'identity
 686                          (list (plist-get info :groff-class-options))
 687                          " "))))
 688          (class (plist-get info :groff-class))
 689          (class-options (plist-get info :groff-class-options))
 690          (classes (assoc class org-groff-classes))
 691          (classes-options (car (last classes)))
 692          (heading-option (plist-get classes-options :heading))
 693          (type-option (plist-get classes-options :type))
 694          (last-option (plist-get classes-options :last-section))
 695          (hyphenate (plist-get attr :hyphenate))
 696          (justify-right (plist-get attr :justify-right))
 697
 698          (document-class-string
 699           (progn
 700             (org-element-normalize-string
 701              (let* ((header (nth 1 (assoc class org-groff-classes)))
 702                     (document-class-item (if (stringp header) header "")))
 703                document-class-item)))))
 704
 705
 706     (concat
 707      (if justify-right
 708          (case justify-right
 709            ('yes ".SA 1 \n")
 710            ('no ".SA 0 \n")
 711            (t ""))
 712        "")
 713
 714      (if hyphenate
 715          (case hyphenate
 716            ('yes ".nr Hy 1 \n")
 717            ('no ".nr Hy 0 \n")
 718            (t ""))
 719        "")
 720
 721      (cond
 722       ((string= type-option "custom") "")
 723
 724       ((and (stringp document-class-string)
 725             (string= type-option "cover"))
 726
 727        (concat
 728         (format ".COVER %s\n" document-class-string)
 729         (org-groff--mt-head title contents attr info)
 730         ".COVEND\n"))
 731
 732       ((string= type-option "memo")
 733        (concat
 734         (org-groff--mt-head title contents attr info)
 735         document-class-string))
 736       ((string= type-option "letter")
 737        (concat
 738         (org-groff--letter-head title contents attr info)
 739         (let ((sa-item (plist-get attr :salutation))
 740               (cn-item (plist-get attr :confidential))
 741               (sj-item (plist-get attr :subject))
 742               (rn-item (plist-get attr :reference))
 743               (at-item (plist-get attr :attention)))
 744
 745           (concat
 746
 747            (if (stringp sa-item)
 748                (format ".LO SA \"%s\" \n"  sa-item)
 749              ".LO SA\n")
 750
 751            (when cn-item
 752              (if (stringp cn-item)
 753                  (format ".LO CN \"%s\"\n" cn-item)
 754                ".LO CN\n"))
 755
 756            (when (and at-item (stringp at-item))
 757              (format ".LO AT \"%s\" \n"  at-item))
 758            (when (and title rn-item)
 759              (format ".LO RN \"%s\"\n" title))
 760
 761            (when (and sj-item (stringp sj-item))
 762              (format ".LO SJ \"%s\" \n"  sj-item))
 763
 764
 765            ".LT " document-class-string  "\n"))))
 766
 767       (t ""))
 768
 769      contents
 770
 771      (cond
 772       ((string= last-option "toc")
 773        ".TC")
 774       ((string= last-option "sign")
 775        (let ((fc-item (plist-get attr :closing)))
 776          (concat (if (stringp fc-item)
 777                      (format ".FC \"%s\" \n" fc-item)
 778                    ".FC\n")
 779                  ".SG\n")))
 780       (t ""))
 781
 782      (progn
 783        (mapconcat
 784         (lambda (item)
 785           (when (string= (car item) "NS")
 786             (replace-regexp-in-string
 787                     "\\.P\n" "" (cdr item))))
 788         (reverse org-groff-special-content) "\n")))))
 789
 790
 791 \f
 792 ;;; Transcode Functions
 793
 794 ;;; Babel Call
 795 ;;
 796 ;; Babel Calls are ignored.
 797
 798
 799 ;;; Bold
 800
 801 (defun org-groff-bold (bold contents info)
 802   "Transcode BOLD from Org to Groff.
 803 CONTENTS is the text with bold markup.  INFO is a plist holding
 804 contextual information."
 805   (org-groff--text-markup contents 'bold))
 806
 807 ;;; Center Block
 808
 809 (defun org-groff-center-block (center-block contents info)
 810   "Transcode a CENTER-BLOCK element from Org to Groff.
 811 CONTENTS holds the contents of the center block.  INFO is a plist
 812 holding contextual information."
 813   (org-groff--wrap-label
 814    center-block
 815    (format ".DS C \n%s\n.DE" contents)))
 816
 817 ;;; Clock
 818
 819 (defun org-groff-clock (clock contents info)
 820   "Transcode a CLOCK element from Org to Groff.
 821 CONTENTS is nil.  INFO is a plist holding contextual
 822 information."
 823   (concat
 824    (format "\\fB%s\\fP " org-clock-string)
 825    (format org-groff-inactive-timestamp-format
 826            (concat (org-translate-time
 827                     (org-element-property :raw-value
 828                                           (org-element-property :value clock)))
 829                    (let ((time (org-element-property :duration clock)))
 830                      (and time (format " (%s)" time)))))))
 831
 832 ;;; Code
 833
 834 (defun org-groff-code (code contents info)
 835   "Transcode a CODE object from Org to Groff.
 836 CONTENTS is nil.  INFO is a plist used as a communication
 837 channel."
 838   (org-groff--text-markup (org-element-property :value code) 'code))
 839
 840 ;;; Comments and Comment Blocks are ignored.
 841
 842 ;;; Drawer
 843
 844 (defun org-groff-drawer (drawer contents info)
 845   "Transcode a DRAWER element from Org to Groff.
 846 CONTENTS holds the contents of the block.  INFO is a plist
 847 holding contextual information."
 848   (let* ((name (org-element-property :drawer-name drawer))
 849          (output (if (functionp org-groff-format-drawer-function)
 850                      (funcall org-groff-format-drawer-function
 851                               name contents)
 852                    ;; If there's no user defined function: simply
 853                    ;; display contents of the drawer.
 854                    contents)))
 855     (org-groff--wrap-label drawer output)))
 856
 857 ;;; Dynamic Block
 858
 859 (defun org-groff-dynamic-block (dynamic-block contents info)
 860   "Transcode a DYNAMIC-BLOCK element from Org to Groff.
 861 CONTENTS holds the contents of the block.  INFO is a plist
 862 holding contextual information.  See `org-export-data'."
 863   (org-groff--wrap-label dynamic-block contents))
 864
 865 ;;; Entity
 866
 867 (defun org-groff-entity (entity contents info)
 868   "Transcode an ENTITY object from Org to Groff.
 869 CONTENTS are the definition itself.  INFO is a plist holding
 870 contextual information."
 871   (org-element-property :utf-8 entity))
 872
 873 ;;; Example Block
 874
 875 (defun org-groff-example-block (example-block contents info)
 876   "Transcode an EXAMPLE-BLOCK element from Org to Groff.
 877 CONTENTS is nil.  INFO is a plist holding contextual
 878 information."
 879   (org-groff--wrap-label
 880    example-block
 881    (format ".DS L\n%s\n.DE"
 882            (org-export-format-code-default example-block info))))
 883
 884 ;;; Export Block
 885
 886 (defun org-groff-export-block (export-block contents info)
 887   "Transcode a EXPORT-BLOCK element from Org to Groff.
 888 CONTENTS is nil.  INFO is a plist holding contextual information."
 889   (when (string= (org-element-property :type export-block) "GROFF")
 890     (org-remove-indentation (org-element-property :value export-block))))
 891
 892 ;;; Export Snippet
 893
 894 (defun org-groff-export-snippet (export-snippet contents info)
 895   "Transcode a EXPORT-SNIPPET object from Org to Groff.
 896 CONTENTS is nil.  INFO is a plist holding contextual information."
 897   (when (eq (org-export-snippet-backend export-snippet) 'groff)
 898     (org-element-property :value export-snippet)))
 899
 900 ;;; Fixed Width
 901
 902 (defun org-groff-fixed-width (fixed-width contents info)
 903   "Transcode a FIXED-WIDTH element from Org to Groff.
 904 CONTENTS is nil.  INFO is a plist holding contextual information."
 905   (org-groff--wrap-label
 906    fixed-width
 907    (format "\\fC\n%s\\fP"
 908            (org-remove-indentation
 909             (org-element-property :value fixed-width)))))
 910
 911 ;;; Footnote Definition
 912 ;;
 913 ;; Footnote Definitions are ignored.
 914 ;;
 915 ;; Footnotes are handled automatically in GROFF.  Although manual
 916 ;; references can be added, not really required.
 917
 918 (defun org-groff-footnote-reference (footnote-reference contents info)
 919   ;; Changing from info to footnote-reference
 920   (let* ((raw (org-export-get-footnote-definition footnote-reference info))
 921                  (n (org-export-get-footnote-number footnote-reference info))
 922                  (data (org-trim (org-export-data raw info)))
 923          (ref-id (plist-get (nth 1 footnote-reference) :label)))
 924     ;; It is a reference
 925     (if (string-match "fn:rl" ref-id)
 926         (if (member ref-id org-groff-registered-references)
 927             (format "\\*[%s]" ref-id)
 928           (progn
 929             (push ref-id org-groff-registered-references)
 930             (format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id  data)))
 931       ;; else it is a footnote
 932       (format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data))))
 933
 934 ;;; Headline
 935
 936 (defun org-groff-headline (headline contents info)
 937   "Transcode a HEADLINE element from Org to Groff.
 938 CONTENTS holds the contents of the headline.  INFO is a plist
 939 holding contextual information."
 940   (let* ((class (plist-get info :groff-class))
 941          (level (org-export-get-relative-level headline info))
 942          (numberedp (org-export-numbered-headline-p headline info))
 943          ;; Section formatting will set two placeholders: one for the
 944          ;; title and the other for the contents.
 945          (classes (assoc class org-groff-classes))
 946          (classes-options (car (last classes)))
 947          (heading-option (plist-get classes-options :heading))
 948          (section-fmt
 949           (progn
 950             (cond
 951              ((and (symbolp heading-option)
 952                    (fboundp heading-option))
 953               (funcall heading-option level numberedp))
 954              ((> level 7) nil)
 955              (t (if numberedp
 956                     (concat ".H " (number-to-string level) " \"%s\"\n%s")
 957                   ".HU \"%s\"\n%s")))))
 958          ;; End of section-fmt
 959          (text (org-export-data (org-element-property :title headline) info))
 960          (todo
 961           (and (plist-get info :with-todo-keywords)
 962                (let ((todo (org-element-property :todo-keyword headline)))
 963                  (and todo (org-export-data todo info)))))
 964          (todo-type (and todo (org-element-property :todo-type headline)))
 965          (tags (and (plist-get info :with-tags)
 966                     (org-export-get-tags headline info)))
 967          (priority (and (plist-get info :with-priority)
 968                         (org-element-property :priority headline)))
 969          ;; Create the headline text along with a no-tag version.  The
 970          ;; latter is required to remove tags from table of contents.
 971          (full-text (if (functionp org-groff-format-headline-function)
 972                         ;; User-defined formatting function.
 973                         (funcall org-groff-format-headline-function
 974                                  todo todo-type priority text tags)
 975                       ;; Default formatting.
 976                       (concat
 977                        (when todo
 978                          (format "\\fB%s\\fP " todo))
 979                        (when priority (format " [\\#%c] " priority))
 980                        text
 981                        (when tags
 982                          (format " \\fC:%s:\\fP "
 983                                  (mapconcat 'identity tags ":"))))))
 984          (full-text-no-tag
 985           (if (functionp org-groff-format-headline-function)
 986               ;; User-defined formatting function.
 987               (funcall org-groff-format-headline-function
 988                        todo todo-type priority text nil)
 989             ;; Default formatting.
 990             (concat
 991              (when todo (format "\\fB%s\\fP " todo))
 992              (when priority (format " [\\#%c] " priority))
 993              text)))
 994          ;; Associate some \label to the headline for internal links.
 995          ;;      (headline-label
 996          ;;       (format "\\label{sec-%s}\n"
 997          ;;               (mapconcat 'number-to-string
 998          ;;                          (org-export-get-headline-number headline info)
 999          ;;                          "-")))
1000          (headline-label "")
1001          (pre-blanks
1002           (make-string (org-element-property :pre-blank headline) 10)))
1003
1004     (cond
1005      ;; Case 1: Special Tag
1006      ((member (car  tags)  org-groff-special-tags)
1007       (cond
1008        ((string= (car tags) "BODY") contents)
1009
1010        ((string= (car tags) "NS")
1011         (progn
1012           (push (cons (car tags)
1013                       (format ".NS \"%s\" 1 \n%s"
1014                               (car (org-element-property :title headline))
1015                               (or contents " ")))
1016                 org-groff-special-content) nil))
1017
1018        (t
1019         (progn
1020           (push (cons  (car tags) contents) org-groff-special-content)
1021           nil))))
1022
1023      ;; Case 2: This is a footnote section: ignore it.
1024      ((org-element-property :footnote-section-p headline) nil)
1025
1026      ;; Case 3: This is a deep sub-tree: export it as a list item.
1027      ;;         Also export as items headlines for which no section
1028      ;;         format has been found.
1029      ((or (not section-fmt) (org-export-low-level-p headline info))
1030       ;; Build the real contents of the sub-tree.
1031       (let ((low-level-body
1032              (concat
1033               ;; If the headline is the first sibling, start a list.
1034               (when (org-export-first-sibling-p headline info)
1035                 (format "%s\n" (if numberedp ".AL 1\n" ".DL \n")))
1036               ;; Itemize headline
1037               ".LI\n" full-text "\n" headline-label pre-blanks contents)))
1038         ;; If headline is not the last sibling simply return
1039         ;; LOW-LEVEL-BODY.  Otherwise, also close the list, before any
1040         ;; blank line.
1041         (if (not (org-export-last-sibling-p headline info)) low-level-body
1042           (replace-regexp-in-string
1043            "[ \t\n]*\\'"
1044            (concat "\n.LE")
1045            low-level-body))))
1046
1047      ;; Case 4. Standard headline.  Export it as a section.
1048      (t
1049       (format section-fmt full-text
1050               (concat headline-label pre-blanks contents))))))
1051
1052 ;;; Horizontal Rule
1053 ;; Not supported
1054
1055 ;;; Inline Babel Call
1056 ;;
1057 ;; Inline Babel Calls are ignored.
1058
1059 ;;; Inline Src Block
1060
1061 (defun org-groff-inline-src-block (inline-src-block contents info)
1062   "Transcode an INLINE-SRC-BLOCK element from Org to Groff.
1063 CONTENTS holds the contents of the item.  INFO is a plist holding
1064 contextual information."
1065   (let* ((code (org-element-property :value inline-src-block)))
1066     (cond
1067      (org-groff-source-highlight
1068       (let* ((tmpdir (if (featurep 'xemacs)
1069                          temp-directory
1070                        temporary-file-directory))
1071              (in-file  (make-temp-name
1072                         (expand-file-name "srchilite" tmpdir)))
1073              (out-file (make-temp-name
1074                         (expand-file-name "reshilite" tmpdir)))
1075              (org-lang (org-element-property :language inline-src-block))
1076              (lst-lang (cadr (assq (intern org-lang)
1077                                    org-groff-source-highlight-langs)))
1078
1079              (cmd (concat (expand-file-name "source-highlight")
1080                           " -s " lst-lang
1081                           " -f groff_mm_color "
1082                           " -i " in-file
1083                           " -o " out-file)))
1084         (if lst-lang
1085             (let ((code-block ""))
1086               (with-temp-file in-file (insert code))
1087               (shell-command cmd)
1088               (setq code-block  (org-file-contents out-file))
1089               (delete-file in-file)
1090               (delete-file out-file)
1091               code-block)
1092           (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
1093                   code))))
1094
1095      ;; Do not use a special package: transcode it verbatim.
1096      (t
1097       (concat ".DS I\n" "\\fC" code "\\fP\n.DE\n")))))
1098
1099 ;;; Inlinetask
1100
1101 (defun org-groff-inlinetask (inlinetask contents info)
1102   "Transcode an INLINETASK element from Org to Groff.
1103 CONTENTS holds the contents of the block.  INFO is a plist
1104 holding contextual information."
1105   (let ((title (org-export-data (org-element-property :title inlinetask) info))
1106         (todo (and (plist-get info :with-todo-keywords)
1107                    (let ((todo (org-element-property :todo-keyword inlinetask)))
1108                      (and todo (org-export-data todo info)))))
1109         (todo-type (org-element-property :todo-type inlinetask))
1110         (tags (and (plist-get info :with-tags)
1111                    (org-export-get-tags inlinetask info)))
1112         (priority (and (plist-get info :with-priority)
1113                        (org-element-property :priority inlinetask))))
1114     ;; If `org-groff-format-inlinetask-function' is provided, call it
1115     ;; with appropriate arguments.
1116     (if (functionp org-groff-format-inlinetask-function)
1117         (funcall org-groff-format-inlinetask-function
1118                  todo todo-type priority title tags contents)
1119       ;; Otherwise, use a default template.
1120       (org-groff--wrap-label
1121        inlinetask
1122        (let ((full-title
1123               (concat
1124                (when todo (format "\\fB%s\\fP " todo))
1125                (when priority (format " [\\#%c] " priority))
1126                title
1127                (when tags (format " \\fC:%s:\\fP "
1128                                   (mapconcat 'identity tags ":"))))))
1129          (format (concat "\n.DS I\n"
1130                          "%s\n"
1131                          ".sp"
1132                          "%s\n"
1133                          ".DE")
1134                  full-title contents))))))
1135
1136 ;;; Italic
1137
1138 (defun org-groff-italic (italic contents info)
1139   "Transcode ITALIC from Org to Groff.
1140 CONTENTS is the text with italic markup.  INFO is a plist holding
1141 contextual information."
1142   (org-groff--text-markup contents 'italic))
1143
1144 ;;; Item
1145
1146 (defun org-groff-item (item contents info)
1147   "Transcode an ITEM element from Org to Groff.
1148 CONTENTS holds the contents of the item.  INFO is a plist holding
1149 contextual information."
1150   (let* ((bullet (org-element-property :bullet item))
1151          (type (org-element-property
1152                 :type (org-element-property :parent item)))
1153          (checkbox (case (org-element-property :checkbox item)
1154                      (on "\\o'\\(sq\\(mu'")
1155                      (off "\\(sq")
1156                      (trans "\\o'\\(sq\\(mi'")))
1157          (tag (let ((tag (org-element-property :tag item)))
1158                 ;; Check-boxes must belong to the tag.
1159                 (and tag (format "%s"
1160                                  (concat checkbox
1161                                          (org-export-data tag info)))))))
1162
1163         (cond
1164          ((or checkbox tag)
1165           (concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
1166               "\n"
1167               (org-trim (or contents " "))))
1168      ((eq type 'ordered)
1169       (concat ".LI"
1170               "\n"
1171               (org-trim (or contents " "))))
1172      (t
1173       (let* ((bullet (org-trim bullet))
1174              (marker (cond  ((string= "-" bullet) "\\(em")
1175                             ((string= "*" bullet) "\\(bu")
1176                             (t "\\(dg"))))
1177         (concat ".LI " marker "\n"
1178                 (org-trim (or contents " "))))))))
1179
1180 ;;; Keyword
1181
1182 (defun org-groff-keyword (keyword contents info)
1183   "Transcode a KEYWORD element from Org to Groff.
1184 CONTENTS is nil.  INFO is a plist holding contextual information."
1185   (let ((key (org-element-property :key keyword))
1186         (value (org-element-property :value keyword)))
1187     (cond
1188      ((string= key "GROFF") value)
1189      (t nil))))
1190
1191 ;;; Line Break
1192
1193 (defun org-groff-line-break (line-break contents info)
1194   "Transcode a LINE-BREAK object from Org to Groff.
1195 CONTENTS is nil.  INFO is a plist holding contextual information."
1196   ".br\n")
1197
1198 ;;; Link
1199 ;; Inline images just place a call to .PSPIC or .PS/.PE
1200 ;;  and load the graph.
1201
1202 (defun org-groff-link--inline-image (link info)
1203   "Return Groff code for an inline image.
1204 LINK is the link pointing to the inline image.  INFO is a plist
1205 used as a communication channel."
1206   (let* ((parent (org-export-get-parent-element link))
1207          (path (let ((raw-path (org-element-property :path link)))
1208                  (if (not (file-name-absolute-p raw-path)) raw-path
1209                    (expand-file-name raw-path))))
1210          (attr (org-export-read-attribute :attr_groff link))
1211          (placement
1212           (case (plist-get attr :position)
1213             ('center "")
1214             ('left "-L")
1215             ('right "-R")
1216             (t "")))
1217          (width  (or (plist-get attr :width) ""))
1218          (height (or (plist-get attr :height) ""))
1219          (caption (and (not (plist-get attr :disable-caption))
1220                        (org-groff--caption/label-string parent info))))
1221     ;; Now clear ATTR from any special keyword and set a default value
1222     ;; if nothing is left.  Return proper string.
1223     (concat
1224      (cond
1225       ((and org-groff-raster-to-ps
1226             (or  (string-match ".\.png$" path)
1227                  (string-match ".\.jpg$" path)))
1228        (let ((eps-path (concat path ".eps")))
1229          (shell-command (format org-groff-raster-to-ps path eps-path))
1230          (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
1231                  placement eps-path width height)))
1232       ((string-match ".\.pic$" path)
1233        (format "\n.PS\ncopy \"%s\"\n.PE" path))
1234       (t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
1235                  placement path width height)))
1236      (and caption (format "\n.FG \"%s\"" caption)))))
1237
1238 (defun org-groff-link (link desc info)
1239   "Transcode a LINK object from Org to Groff.
1240
1241 DESC is the description part of the link, or the empty string.
1242 INFO is a plist holding contextual information.  See
1243 `org-export-data'."
1244
1245   (let* ((type (org-element-property :type link))
1246          (raw-path (org-element-property :path link))
1247          ;; Ensure DESC really exists, or set it to nil.
1248          (desc (and (not (string= desc "")) desc))
1249          (imagep (org-export-inline-image-p
1250                   link org-groff-inline-image-rules))
1251          (path (cond
1252                 ((member type '("http" "https" "ftp" "mailto"))
1253                  (concat type ":" raw-path))
1254                 ((string= type "file")
1255                  (when (string-match "\\(.+\\)::.+" raw-path)
1256                    (setq raw-path (match-string 1 raw-path)))
1257                  (if (file-name-absolute-p raw-path)
1258                      (concat "file://" (expand-file-name raw-path))
1259                    (concat "file://" raw-path)))
1260                 (t raw-path)))
1261          protocol)
1262     (cond
1263      ;; Image file.
1264      (imagep (org-groff-link--inline-image link info))
1265      ;; import groff files
1266      ((and (string= type "file")
1267            (string-match ".\.groff$" raw-path))
1268       (concat ".so " raw-path "\n"))
1269      ;; Radio link: transcode target's contents and use them as link's
1270      ;; description.
1271      ((string= type "radio")
1272       (let ((destination (org-export-resolve-radio-link link info)))
1273         (when destination
1274           (format "\\fI [%s] \\fP"
1275                   (org-export-solidify-link-text path)))))
1276
1277      ;; Links pointing to a headline: find destination and build
1278      ;; appropriate referencing command.
1279      ((member type '("custom-id" "fuzzy" "id"))
1280       (let ((destination (if (string= type "fuzzy")
1281                              (org-export-resolve-fuzzy-link link info)
1282                            (org-export-resolve-id-link link info))))
1283         (case (org-element-type destination)
1284           ;; Id link points to an external file.
1285           (plain-text
1286            (if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination)
1287              (format "\\fI file://%s \\fP" destination)))
1288           ;; Fuzzy link points nowhere.
1289           ('nil
1290            (format org-groff-link-with-unknown-path-format
1291                    (or desc
1292                        (org-export-data
1293                         (org-element-property :raw-link link) info))))
1294           ;; Fuzzy link points to an invisible target.
1295           (keyword nil)
1296           ;; LINK points to a headline.  If headlines are numbered
1297           ;; and the link has no description, display headline's
1298           ;; number.  Otherwise, display description or headline's
1299           ;; title.
1300           (headline
1301            (let ((label ""))
1302              (if (and (plist-get info :section-numbers) (not desc))
1303                  (format "\\fI%s\\fP" label)
1304                (format "\\fI%s\\fP"
1305                        (or desc
1306                            (org-export-data
1307                             (org-element-property :title destination) info))))))
1308           ;; Fuzzy link points to a target.  Do as above.
1309           (otherwise
1310            (let ((path (org-export-solidify-link-text path)))
1311              (if (not desc) (format "\\fI%s\\fP" path)
1312                (format "%s \\fBat\\fP \\fI%s\\fP" desc path)))))))
1313      ;; External link with a description part.
1314      ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
1315      ;; External link without a description part.
1316      (path (format "\\fI%s\\fP" path))
1317      ;; No path, only description.  Try to do something useful.
1318      (t (format org-groff-link-with-unknown-path-format desc)))))
1319
1320 ;;; Paragraph
1321
1322 (defun org-groff-paragraph (paragraph contents info)
1323   "Transcode a PARAGRAPH element from Org to Groff.
1324 CONTENTS is the contents of the paragraph, as a string.  INFO is
1325 the plist used as a communication channel."
1326   (let ((parent (plist-get (nth 1 paragraph) :parent)))
1327     (when parent
1328       (let* ((parent-type (car parent))
1329              (fixed-paragraph "")
1330              (class (plist-get info :groff-class))
1331              (class-options (plist-get info :groff-class-options))
1332              (classes (assoc class org-groff-classes))
1333              (classes-options (car (last classes)))
1334              (paragraph-option (plist-get classes-options :paragraph)))
1335         (cond
1336          ((and (symbolp paragraph-option)
1337                (fboundp paragraph-option))
1338           (funcall paragraph-option parent-type parent contents))
1339          ((and (eq parent-type 'item)
1340                (plist-get (nth 1 parent) :bullet))
1341           (setq fixed-paragraph (concat "" contents)))
1342          ((eq parent-type 'section)
1343           (setq fixed-paragraph (concat ".P\n" contents)))
1344          ((eq parent-type 'footnote-definition)
1345           (setq fixed-paragraph (concat "" contents)))
1346          (t (setq fixed-paragraph (concat "" contents))))
1347         fixed-paragraph))))
1348
1349 ;;; Plain List
1350
1351 (defun org-groff-plain-list (plain-list contents info)
1352   "Transcode a PLAIN-LIST element from Org to Groff.
1353 CONTENTS is the contents of the list.  INFO is a plist holding
1354 contextual information."
1355   (let* ((type (org-element-property :type plain-list))
1356          (attr (mapconcat #'identity
1357                           (org-element-property :attr_groff plain-list)
1358                           " "))
1359          (groff-type (cond
1360                       ((eq type 'ordered) ".AL")
1361                       ((eq type 'unordered) ".BL")
1362                       ((eq type 'descriptive) ".VL 2.0i"))))
1363     (org-groff--wrap-label
1364      plain-list
1365      (format "%s\n%s\n.LE" groff-type contents))))
1366
1367 ;;; Plain Text
1368
1369 (defun org-groff-plain-text (text info)
1370   "Transcode a TEXT string from Org to Groff.
1371 TEXT is the string to transcode.  INFO is a plist holding
1372 contextual information."
1373 (let ((output text))
1374   ;; Protect various characters.
1375   (setq output (replace-regexp-in-string
1376                 "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
1377                 "$\\" output nil t 1))
1378   ;; Activate smart quotes.  Be sure to provide original TEXT string
1379   ;; since OUTPUT may have been modified.
1380   (when (plist-get info :with-smart-quotes)
1381     (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
1382   ;; Handle Special Characters
1383   (if org-groff-special-char
1384       (dolist (special-char-list org-groff-special-char)
1385         (setq output
1386               (replace-regexp-in-string (car special-char-list)
1387                                         (cdr special-char-list) output))))
1388   ;; Handle break preservation if required.
1389   (when (plist-get info :preserve-breaks)
1390     (setq output (replace-regexp-in-string
1391                   "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" output)))
1392   ;; Return value.
1393   output))
1394
1395 ;;; Planning
1396
1397 (defun org-groff-planning (planning contents info)
1398   "Transcode a PLANNING element from Org to Groff.
1399 CONTENTS is nil.  INFO is a plist holding contextual
1400 information."
1401   (concat
1402    (mapconcat
1403     'identity
1404     (delq nil
1405           (list
1406            (let ((closed (org-element-property :closed planning)))
1407              (when closed
1408                (concat
1409                 (format "\\fR %s \\fP" org-closed-string)
1410                 (format org-groff-inactive-timestamp-format
1411                         (org-translate-time
1412                          (org-element-property :raw-value closed))))))
1413            (let ((deadline (org-element-property :deadline planning)))
1414              (when deadline
1415                (concat
1416                 (format "\\fB %s \\fP" org-deadline-string)
1417                 (format org-groff-active-timestamp-format
1418                         (org-translate-time
1419                          (org-element-property :raw-value deadline))))))
1420            (let ((scheduled (org-element-property :scheduled planning)))
1421              (when scheduled
1422                (concat
1423                 (format "\\fR %s \\fP" org-scheduled-string)
1424                 (format org-groff-active-timestamp-format
1425                         (org-translate-time
1426                          (org-element-property :raw-value scheduled))))))))
1427     "")
1428    ""))
1429
1430 ;;; Quote Block
1431
1432 (defun org-groff-quote-block (quote-block contents info)
1433   "Transcode a QUOTE-BLOCK element from Org to Groff.
1434 CONTENTS holds the contents of the block.  INFO is a plist
1435 holding contextual information."
1436   (org-groff--wrap-label
1437    quote-block
1438    (format ".DS I\n.I\n%s\n.R\n.DE" contents)))
1439
1440 ;;; Quote Section
1441
1442 (defun org-groff-quote-section (quote-section contents info)
1443   "Transcode a QUOTE-SECTION element from Org to Groff.
1444 CONTENTS is nil.  INFO is a plist holding contextual information."
1445   (let ((value (org-remove-indentation
1446                 (org-element-property :value quote-section))))
1447     (when value (format ".DS L\n\\fI%s\\fP\n.DE\n" value))))
1448
1449 ;;; Radio Target
1450
1451 (defun org-groff-radio-target (radio-target text info)
1452   "Transcode a RADIO-TARGET object from Org to Groff.
1453 TEXT is the text of the target.  INFO is a plist holding
1454 contextual information."
1455   (format "%s - %s"
1456           (org-export-solidify-link-text
1457            (org-element-property :value radio-target))
1458           text))
1459
1460 ;;; Section
1461
1462 (defun org-groff-section (section contents info)
1463   "Transcode a SECTION element from Org to Groff.
1464 CONTENTS holds the contents of the section.  INFO is a plist
1465 holding contextual information."
1466   contents)
1467
1468 ;;; Special Block
1469
1470 (defun org-groff-special-block (special-block contents info)
1471   "Transcode a SPECIAL-BLOCK element from Org to Groff.
1472 CONTENTS holds the contents of the block.  INFO is a plist
1473 holding contextual information."
1474   (let ((type (downcase (org-element-property :type special-block))))
1475     (org-groff--wrap-label
1476      special-block
1477      (format "%s\n" contents))))
1478
1479 ;;; Src Block
1480
1481 (defun org-groff-src-block (src-block contents info)
1482   "Transcode a SRC-BLOCK element from Org to Groff.
1483 CONTENTS holds the contents of the item.  INFO is a plist holding
1484 contextual information."
1485   (let* ((lang (org-element-property :language src-block))
1486          (label (org-element-property :name src-block))
1487          (code (org-element-property :value src-block))
1488          (custom-env (and lang
1489                           (cadr (assq (intern lang)
1490                                       org-groff-custom-lang-environments))))
1491          (num-start (case (org-element-property :number-lines src-block)
1492                       (continued (org-export-get-loc src-block info))
1493                       (new 0)))
1494          (retain-labels (org-element-property :retain-labels src-block))
1495          (caption (and (not (org-export-read-attribute
1496                              :attr_groff src-block :disable-caption))
1497                        (org-groff--caption/label-string src-block info))))
1498
1499     (cond
1500      ;; Case 1.  No source fontification.
1501      ((not org-groff-source-highlight)
1502       (concat
1503        (format ".DS I\n\\fC%s\\fP\n.DE\n"
1504                (org-export-format-code-default src-block info))
1505        (and caption (format ".EX \"%s\" " caption))))
1506
1507      ;; Case 2.  Source fontification.
1508      (org-groff-source-highlight
1509       (let* ((tmpdir (if (featurep 'xemacs)
1510                          temp-directory
1511                        temporary-file-directory))
1512              (in-file  (make-temp-name
1513                         (expand-file-name "srchilite" tmpdir)))
1514              (out-file (make-temp-name
1515                         (expand-file-name "reshilite" tmpdir)))
1516
1517              (org-lang (org-element-property :language src-block))
1518              (lst-lang (cadr (assq (intern org-lang)
1519                                    org-groff-source-highlight-langs)))
1520
1521              (cmd (concat "source-highlight"
1522                           " -s " lst-lang
1523                           " -f groff_mm_color "
1524                           " -i " in-file
1525                           " -o " out-file)))
1526
1527         (concat
1528          (if lst-lang
1529              (let ((code-block ""))
1530                (with-temp-file in-file (insert code))
1531                (shell-command cmd)
1532                (setq code-block  (org-file-contents out-file))
1533                (delete-file in-file)
1534                (delete-file out-file)
1535                (format "%s\n"  code-block))
1536            (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
1537                    code))
1538          (and caption (format ".EX \"%s\" " caption))))))))
1539
1540
1541 ;;; Statistics Cookie
1542
1543 (defun org-groff-statistics-cookie (statistics-cookie contents info)
1544   "Transcode a STATISTICS-COOKIE object from Org to Groff.
1545 CONTENTS is nil.  INFO is a plist holding contextual information."
1546   (org-element-property :value statistics-cookie))
1547
1548
1549 ;;; Strike-Through
1550
1551 (defun org-groff-strike-through (strike-through contents info)
1552   "Transcode STRIKE-THROUGH from Org to Groff.
1553 CONTENTS is the text with strike-through markup.  INFO is a plist
1554 holding contextual information."
1555   (org-groff--text-markup contents 'strike-through))
1556
1557 ;;; Subscript
1558
1559 (defun org-groff-subscript (subscript contents info)
1560   "Transcode a SUBSCRIPT object from Org to Groff.
1561 CONTENTS is the contents of the object.  INFO is a plist holding
1562 contextual information."
1563   (format  "\\d\\s-2%s\\s+2\\u" contents))
1564
1565 ;;; Superscript "^_%s$
1566
1567 (defun org-groff-superscript (superscript contents info)
1568   "Transcode a SUPERSCRIPT object from Org to Groff.
1569 CONTENTS is the contents of the object.  INFO is a plist holding
1570 contextual information."
1571   (format  "\\u\\s-2%s\\s+2\\d" contents))
1572
1573
1574 ;;; Table
1575 ;;
1576 ;; `org-groff-table' is the entry point for table transcoding.  It
1577 ;; takes care of tables with a "verbatim" attribute.  Otherwise, it
1578 ;; delegates the job to  `org-groff-table--org-table' function,
1579 ;; depending of the type of the table.
1580 ;;
1581 ;; `org-groff-table--align-string' is a subroutine used to build
1582 ;; alignment string for Org tables.
1583
1584 (defun org-groff-table (table contents info)
1585   "Transcode a TABLE element from Org to Groff.
1586 CONTENTS is the contents of the table.  INFO is a plist holding
1587 contextual information."
1588   (cond
1589    ;; Case 1: verbatim table.
1590    ((or org-groff-tables-verbatim
1591         (let ((attr (read (format "(%s)"
1592                  (mapconcat
1593                   #'identity
1594                                    (org-element-property :attr_groff table) " ")))))
1595           (and attr (plist-get attr :verbatim))))
1596
1597     (format ".DS L\n\\fC%s\\fP\n.DE"
1598             ;; Re-create table, without affiliated keywords.
1599             (org-trim
1600              (org-element-interpret-data
1601               `(table nil ,@(org-element-contents table))))))
1602
1603    ;; Case 2: Standard table.
1604    (t (org-groff-table--org-table table contents info))))
1605
1606 (defun org-groff-table--align-string (divider table info)
1607   "Return an appropriate Groff alignment string.
1608 TABLE is the considered table.  INFO is a plist used as
1609 a communication channel."
1610   (let (alignment)
1611     ;; Extract column groups and alignment from first (non-rule) row.
1612     (org-element-map
1613         (org-element-map table 'table-row
1614           (lambda (row)
1615             (and (eq (org-element-property :type row) 'standard) row))
1616           info 'first-match)
1617         'table-cell
1618       (lambda (cell)
1619         (let* ((borders (org-export-table-cell-borders cell info))
1620                (raw-width (org-export-table-cell-width cell info))
1621                (width-cm (when raw-width (/ raw-width 5)))
1622                (width (if raw-width (format "w(%dc)"
1623                                             (if (< width-cm 1) 1 width-cm)) "")))
1624           ;; Check left border for the first cell only.
1625           ;; Alignment is nil on assignment
1626
1627           (when (and (memq 'left borders) (not alignment))
1628             (push "|" alignment))
1629           (push
1630            (case (org-export-table-cell-alignment cell info)
1631              (left (concat "l" width divider))
1632              (right (concat "r" width divider))
1633              (center (concat "c" width divider)))
1634            alignment)
1635           (when (memq 'right borders) (push "|" alignment))))
1636       info)
1637     (apply 'concat (reverse alignment))))
1638
1639 (defun org-groff-table--org-table (table contents info)
1640   "Return appropriate Groff code for an Org table.
1641
1642 TABLE is the table type element to transcode.  CONTENTS is its
1643 contents, as a string.  INFO is a plist used as a communication
1644 channel.
1645
1646 This function assumes TABLE has `org' as its `:type' attribute."
1647   (let* ((attr (org-export-read-attribute :attr_groff table))
1648          (label (org-element-property :name table))
1649          (caption (and (not (plist-get attr :disable-caption))
1650                        (org-groff--caption/label-string table info)))
1651          (divider (if (plist-get attr :divider) "|" " "))
1652
1653          ;; Determine alignment string.
1654          (alignment (org-groff-table--align-string divider table info))
1655
1656          ;; Extract others display options.
1657
1658          (lines (org-split-string contents "\n"))
1659
1660          (attr-list
1661           (let (result-list)
1662             (dolist (attr-item
1663                      (list
1664                       (if (plist-get attr :expand)
1665                           "expand" nil)
1666
1667                       (case (plist-get attr :placement)
1668                         ('center "center")
1669                         ('left nil)
1670                         (t
1671                          (if org-groff-tables-centered
1672                              "center" "")))
1673
1674                       (case (plist-get attr :boxtype)
1675                         ('box "box")
1676                         ('doublebox "doublebox")
1677                         ('allbox "allbox")
1678                         ('none nil)
1679                         (t "box"))))
1680
1681               (if (not (null attr-item))
1682                   (add-to-list 'result-list attr-item)))
1683             result-list))
1684
1685          (title-line  (plist-get attr :title-line))
1686          (long-cells (plist-get attr :long-cells))
1687
1688          (table-format
1689           (concat
1690            (format "%s"
1691                    (or (car attr-list) ""))
1692            (or
1693             (let (output-list)
1694               (when (cdr attr-list)
1695                 (dolist (attr-item (cdr attr-list))
1696                   (setq output-list (concat output-list
1697                                             (format ",%s" attr-item)))))
1698               output-list) "")))
1699          (first-line
1700           (when lines (org-split-string (car lines) "\t"))))
1701     ;; Prepare the final format string for the table.
1702
1703
1704     (cond
1705      ;; Others.
1706      (lines
1707       (concat ".TS\n " table-format ";\n"
1708               (format "%s.\n"
1709                       (let ((final-line ""))
1710                         (when title-line
1711                           (dotimes (i (length first-line))
1712                             (setq final-line (concat final-line "cb" divider))))
1713
1714                         (setq final-line (concat final-line "\n"))
1715
1716                         (if alignment
1717                             (setq final-line (concat final-line alignment))
1718                           (dotimes (i (length first-line))
1719                             (setq final-line (concat final-line "c" divider))))
1720                         final-line))
1721
1722               (format "%s.TE\n"
1723                       (let ((final-line "")
1724                             (long-line "")
1725                             (lines (org-split-string contents "\n")))
1726
1727                         (dolist (line-item lines)
1728                           (setq long-line "")
1729
1730                           (if long-cells
1731                               (progn
1732                                 (if (string= line-item "_")
1733                                     (setq long-line (format "%s\n" line-item))
1734                                   ;; else string =
1735                                   (let ((cell-item-list (org-split-string line-item "\t")))
1736                                     (dolist (cell-item cell-item-list)
1737
1738                                       (cond  ((eq cell-item (car (last cell-item-list)))
1739                                               (setq long-line (concat long-line
1740                                                                       (format "T{\n%s\nT}\t\n"  cell-item))))
1741                                              (t
1742                                               (setq long-line (concat long-line
1743                                                                       (format "T{\n%s\nT}\t"  cell-item))))))
1744                                     long-line))
1745                                 ;; else long cells
1746                                 (setq final-line (concat final-line long-line)))
1747
1748                             (setq final-line (concat final-line line-item "\n"))))
1749                         final-line))
1750
1751               (if caption (format ".TB \"%s\"" caption) ""))))))
1752
1753 ;;; Table Cell
1754
1755 (defun org-groff-table-cell (table-cell contents info)
1756   "Transcode a TABLE-CELL element from Org to Groff
1757 CONTENTS is the cell contents.  INFO is a plist used as
1758 a communication channel."
1759   (progn
1760     (concat (if (and contents
1761                      org-groff-table-scientific-notation
1762                      (string-match orgtbl-exp-regexp contents))
1763                 ;; Use appropriate format string for scientific
1764                 ;; notation.
1765                 (format org-groff-table-scientific-notation
1766                         (match-string 1 contents)
1767                         (match-string 2 contents))
1768               contents)
1769             (when (org-export-get-next-element table-cell info) "\t"))))
1770
1771
1772 ;;; Table Row
1773
1774 (defun org-groff-table-row (table-row contents info)
1775   "Transcode a TABLE-ROW element from Org to Groff
1776 CONTENTS is the contents of the row.  INFO is a plist used as
1777 a communication channel."
1778   ;; Rules are ignored since table separators are deduced from
1779   ;; borders of the current row.
1780   (when (eq (org-element-property :type table-row) 'standard)
1781     (let* ((attr (mapconcat 'identity
1782                             (org-element-property
1783                              :attr_groff (org-export-get-parent table-row))
1784                             " "))
1785            ;; TABLE-ROW's borders are extracted from its first cell.
1786            (borders
1787             (org-export-table-cell-borders
1788              (car (org-element-contents table-row)) info)))
1789       (concat
1790        ;; Mark horizontal lines
1791        (cond  ((and (memq 'top borders) (memq 'above borders)) "_\n"))
1792        contents
1793        (cond
1794         ;; When BOOKTABS are activated enforce bottom rule even when
1795         ;; no hline was specifically marked.
1796         ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
1797         ((memq 'below borders) "\n_"))))))
1798
1799 ;;; Target
1800
1801 (defun org-groff-target (target contents info)
1802   "Transcode a TARGET object from Org to Groff.
1803 CONTENTS is nil.  INFO is a plist holding contextual
1804 information."
1805   (format "\\fI%s\\fP"
1806           (org-export-solidify-link-text (org-element-property :value target))))
1807
1808 ;;; Timestamp
1809
1810 (defun org-groff-timestamp (timestamp contents info)
1811   "Transcode a TIMESTAMP object from Org to Groff.
1812 CONTENTS is nil.  INFO is a plist holding contextual
1813 information."
1814   (let ((value (org-groff-plain-text
1815                 (org-timestamp-translate timestamp) info)))
1816     (case (org-element-property :type timestamp)
1817       ((active active-range)
1818        (format org-groff-active-timestamp-format value))
1819       ((inactive inactive-range)
1820        (format org-groff-inactive-timestamp-format value))
1821       (t (format org-groff-diary-timestamp-format value)))))
1822
1823 ;;; Underline
1824
1825 (defun org-groff-underline (underline contents info)
1826   "Transcode UNDERLINE from Org to Groff.
1827 CONTENTS is the text with underline markup.  INFO is a plist
1828 holding contextual information."
1829   (org-groff--text-markup contents 'underline))
1830
1831 ;;; Verbatim
1832
1833 (defun org-groff-verbatim (verbatim contents info)
1834   "Transcode a VERBATIM object from Org to Groff.
1835 CONTENTS is nil.  INFO is a plist used as a communication
1836 channel."
1837   (org-groff--text-markup (org-element-property :value verbatim) 'verbatim))
1838
1839 ;;; Verse Block
1840
1841 (defun org-groff-verse-block (verse-block contents info)
1842   "Transcode a VERSE-BLOCK element from Org to Groff.
1843 CONTENTS is verse block contents. INFO is a plist holding
1844 contextual information."
1845   (format ".DS C\n.ft HI\n%s\n.ft\n.DE" contents))
1846
1847 \f
1848 ;;; Interactive functions
1849
1850 (defun org-groff-export-to-groff
1851   (&optional async subtreep visible-only body-only ext-plist)
1852   "Export current buffer to a Groff file.
1853
1854 If narrowing is active in the current buffer, only export its
1855 narrowed part.
1856
1857 If a region is active, export that region.
1858
1859 A non-nil optional argument ASYNC means the process should happen
1860 asynchronously.  The resulting file should be accessible through
1861 the `org-export-stack' interface.
1862
1863 When optional argument SUBTREEP is non-nil, export the sub-tree
1864 at point, extracting information from the headline properties
1865 first.
1866
1867 When optional argument VISIBLE-ONLY is non-nil, don't export
1868 contents of hidden elements.
1869
1870 EXT-PLIST, when provided, is a property list with external
1871 parameters overriding Org default settings, but still inferior to
1872 file-local settings.
1873
1874 Return output file's name."
1875   (interactive)
1876   (let ((outfile (org-export-output-file-name ".groff" subtreep)))
1877     (if async
1878         (org-export-async-start
1879             (lambda (f) (org-export-add-to-stack f 'groff))
1880           (let ((org-groff-registered-references nil)
1881                 (org-groff-special-content nil))
1882             `(expand-file-name
1883               (org-export-to-file
1884                'groff ,outfile ,subtreep ,visible-only ,body-only
1885                ',ext-plist))))
1886       (let ((org-groff-registered-references nil)
1887             (org-groff-special-content nil))
1888         (org-export-to-file
1889          'groff outfile subtreep visible-only body-only ext-plist)))))
1890
1891 (defun org-groff-export-to-pdf
1892   (&optional async subtreep visible-only body-only ext-plist)
1893   "Export current buffer to Groff then process through to PDF.
1894
1895 If narrowing is active in the current buffer, only export its
1896 narrowed part.
1897
1898 If a region is active, export that region.
1899
1900 A non-nil optional argument ASYNC means the process should happen
1901 asynchronously.  The resulting file should be accessible through
1902 the `org-export-stack' interface.
1903
1904 When optional argument SUBTREEP is non-nil, export the sub-tree
1905 at point, extracting information from the headline properties
1906 first.
1907
1908 When optional argument VISIBLE-ONLY is non-nil, don't export
1909 contents of hidden elements.
1910
1911 EXT-PLIST, when provided, is a property list with external
1912 parameters overriding Org default settings, but still inferior to
1913 file-local settings.
1914
1915 Return PDF file's name."
1916   (interactive)
1917   (if async
1918       (let ((outfile (org-export-output-file-name ".groff" subtreep)))
1919         (org-export-async-start
1920             (lambda (f) (org-export-add-to-stack f 'groff))
1921           `(expand-file-name
1922             (org-groff-compile
1923              (org-export-to-file
1924               'groff ,outfile ,subtreep ,visible-only ,body-only
1925               ',ext-plist)))))
1926     (org-groff-compile
1927      (org-groff-export-to-groff
1928       nil subtreep visible-only body-only ext-plist))))
1929
1930 (defun org-groff-compile (file)
1931   "Compile a Groff file.
1932
1933 FILE is the name of the file being compiled.  Processing is done
1934 through the command specified in `org-groff-pdf-process'.
1935
1936 Return PDF file name or an error if it couldn't be produced."
1937   (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
1938          (full-name (file-truename file))
1939          (out-dir (file-name-directory file))
1940          ;; Make sure `default-directory' is set to FILE directory,
1941          ;; not to whatever value the current buffer may have.
1942          (default-directory (file-name-directory full-name))
1943          errors)
1944     (message (format "Processing Groff file %s ..." file))
1945     (save-window-excursion
1946       (cond
1947        ;; A function is provided: Apply it.
1948        ((functionp org-groff-pdf-process)
1949         (funcall org-groff-pdf-process (shell-quote-argument file)))
1950        ;; A list is provided: Replace %b, %f and %o with appropriate
1951        ;; values in each command before applying it.  Output is
1952        ;; redirected to "*Org PDF Groff Output*" buffer.
1953        ((consp org-groff-pdf-process)
1954         (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
1955           (mapc
1956            (lambda (command)
1957              (shell-command
1958               (replace-regexp-in-string
1959                "%b" (shell-quote-argument base-name)
1960                (replace-regexp-in-string
1961                 "%f" (shell-quote-argument full-name)
1962                 (replace-regexp-in-string
1963                  "%o" (shell-quote-argument out-dir) command t t)
1964                 t t) t t)
1965               outbuf))
1966            org-groff-pdf-process)
1967           ;; Collect standard errors from output buffer.
1968           (setq errors (org-groff-collect-errors outbuf))))
1969        (t (error "No valid command to process to PDF")))
1970       (let ((pdffile (concat out-dir base-name ".pdf")))
1971         ;; Check for process failure.  Provide collected errors if
1972         ;; possible.
1973         (if (not (file-exists-p pdffile))
1974             (error (concat (format "PDF file %s wasn't produced" pdffile)
1975                            (when errors (concat ": " errors))))
1976           ;; Else remove log files, when specified, and signal end of
1977           ;; process to user, along with any error encountered.
1978           (when org-groff-remove-logfiles
1979             (dolist (ext org-groff-logfiles-extensions)
1980               (let ((file (concat out-dir base-name "." ext)))
1981                 (when (file-exists-p file) (delete-file file)))))
1982           (message (concat "Process completed"
1983                            (if (not errors) "."
1984                              (concat " with errors: " errors)))))
1985         ;; Return output file name.
1986         pdffile))))
1987
1988 (defun org-groff-collect-errors (buffer)
1989   "Collect some kind of errors from \"groff\" output
1990 BUFFER is the buffer containing output.
1991 Return collected error types as a string, or nil if there was
1992 none."
1993   (with-current-buffer buffer
1994     (save-excursion
1995       (goto-char (point-max))
1996       ;; Find final run
1997       nil)))
1998
1999
2000 (provide 'ox-groff)
2001 ;;; ox-groff.el ends here