contrib/lisp/org-e-groff.el

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