lisp/ox-man.el

   1 ;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
   6 ;;      Luis R Anaya <papoanaya aroba hot mail punto com>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; This library implements a Man back-end for Org generic exporter.
  27 ;;
  28 ;; To test it, run
  29 ;;
  30 ;;   M-: (org-export-to-buffer 'man "*Test Man*") RET
  31 ;;
  32 ;; in an Org buffer then switch to the buffer to see the Man export.
  33 ;; See ox.el for more details on how this exporter works.
  34 ;;
  35 ;; It introduces one new buffer keywords:
  36 ;; "MAN_CLASS_OPTIONS".
  37
  38 ;;; Code:
  39
  40 (require 'cl-lib)
  41 (require 'ox)
  42
  43 (defvar org-export-man-default-packages-alist)
  44 (defvar org-export-man-packages-alist)
  45 (defvar orgtbl-exp-regexp)
  46
  47
  48 \f
  49 ;;; Define Back-End
  50
  51 (org-export-define-backend 'man
  52   '((babel-call . org-man-babel-call)
  53     (bold . org-man-bold)
  54     (center-block . org-man-center-block)
  55     (code . org-man-code)
  56     (drawer . org-man-drawer)
  57     (dynamic-block . org-man-dynamic-block)
  58     (entity . org-man-entity)
  59     (example-block . org-man-example-block)
  60     (export-block . org-man-export-block)
  61     (export-snippet . org-man-export-snippet)
  62     (fixed-width . org-man-fixed-width)
  63     (footnote-definition . org-man-footnote-definition)
  64     (footnote-reference . org-man-footnote-reference)
  65     (headline . org-man-headline)
  66     (horizontal-rule . org-man-horizontal-rule)
  67     (inline-babel-call . org-man-inline-babel-call)
  68     (inline-src-block . org-man-inline-src-block)
  69     (inlinetask . org-man-inlinetask)
  70     (italic . org-man-italic)
  71     (item . org-man-item)
  72     (keyword . org-man-keyword)
  73     (line-break . org-man-line-break)
  74     (link . org-man-link)
  75     (node-property . org-man-node-property)
  76     (paragraph . org-man-paragraph)
  77     (plain-list . org-man-plain-list)
  78     (plain-text . org-man-plain-text)
  79     (planning . org-man-planning)
  80     (property-drawer . org-man-property-drawer)
  81     (quote-block . org-man-quote-block)
  82     (radio-target . org-man-radio-target)
  83     (section . org-man-section)
  84     (special-block . org-man-special-block)
  85     (src-block . org-man-src-block)
  86     (statistics-cookie . org-man-statistics-cookie)
  87     (strike-through . org-man-strike-through)
  88     (subscript . org-man-subscript)
  89     (superscript . org-man-superscript)
  90     (table . org-man-table)
  91     (table-cell . org-man-table-cell)
  92     (table-row . org-man-table-row)
  93     (target . org-man-target)
  94     (template . org-man-template)
  95     (timestamp . org-man-timestamp)
  96     (underline . org-man-underline)
  97     (verbatim . org-man-verbatim)
  98     (verse-block . org-man-verse-block))
  99   :menu-entry
 100   '(?M "Export to MAN"
 101        ((?m "As MAN file" org-man-export-to-man)
 102         (?p "As PDF file" org-man-export-to-pdf)
 103         (?o "As PDF file and open"
 104             (lambda (a s v b)
 105               (if a (org-man-export-to-pdf t s v b)
 106                 (org-open-file (org-man-export-to-pdf nil s v b)))))))
 107   :options-alist
 108   '((:man-class "MAN_CLASS" nil nil t)
 109     (:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
 110     (:man-header-extra "MAN_HEADER" nil nil newline)
 111     ;; Other variables.
 112     (:man-tables-centered nil nil org-man-tables-centered)
 113     (:man-tables-verbatim nil nil org-man-tables-verbatim)
 114     (:man-table-scientific-notation nil nil org-man-table-scientific-notation)
 115     (:man-source-highlight nil nil org-man-source-highlight)
 116     (:man-source-highlight-langs nil nil org-man-source-highlight-langs)))
 117
 118
 119 \f
 120 ;;; User Configurable Variables
 121
 122 (defgroup org-export-man nil
 123   "Options for exporting Org mode files to Man."
 124   :tag "Org Export Man"
 125   :group 'org-export)
 126
 127 ;;; Tables
 128
 129 (defcustom org-man-tables-centered t
 130   "When non-nil, tables are exported in a center environment."
 131   :group 'org-export-man
 132   :version "24.4"
 133   :package-version '(Org . "8.0")
 134   :type 'boolean)
 135
 136 (defcustom org-man-tables-verbatim nil
 137   "When non-nil, tables are exported verbatim."
 138   :group 'org-export-man
 139   :version "24.4"
 140   :package-version '(Org . "8.0")
 141   :type 'boolean)
 142
 143
 144 (defcustom org-man-table-scientific-notation "%sE%s"
 145   "Format string to display numbers in scientific notation.
 146 The format should have \"%s\" twice, for mantissa and exponent
 147 \(i.e. \"%s\\\\times10^{%s}\").
 148
 149 When nil, no transformation is made."
 150   :group 'org-export-man
 151   :version "24.4"
 152   :package-version '(Org . "8.0")
 153   :type '(choice
 154           (string :tag "Format string")
 155           (const :tag "No formatting")))
 156
 157
 158 ;;; Inlinetasks
 159 ;; Src blocks
 160
 161 (defcustom org-man-source-highlight nil
 162   "Use GNU source highlight to embellish source blocks "
 163   :group 'org-export-man
 164   :version "24.4"
 165   :package-version '(Org . "8.0")
 166   :type 'boolean)
 167
 168
 169 (defcustom org-man-source-highlight-langs
 170   '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
 171     (scheme "scheme")
 172     (c "c") (cc "cpp") (csharp "csharp") (d "d")
 173     (fortran "fortran") (cobol "cobol") (pascal "pascal")
 174     (ada "ada") (asm "asm")
 175     (perl "perl") (cperl "perl")
 176     (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
 177     (java "java") (javascript "javascript")
 178     (tex "latex")
 179     (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
 180     (ocaml "caml") (caml "caml")
 181     (sql "sql") (sqlite "sql")
 182     (html "html") (css "css") (xml "xml")
 183     (bat "bat") (bison "bison") (clipper "clipper")
 184     (ldap "ldap") (opa "opa")
 185     (php "php") (postscript "postscript") (prolog "prolog")
 186     (properties "properties") (makefile "makefile")
 187     (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
 188   "Alist mapping languages to their listing language counterpart.
 189 The key is a symbol, the major mode symbol without the \"-mode\".
 190 The value is the string that should be inserted as the language
 191 parameter for the listings package.  If the mode name and the
 192 listings name are the same, the language does not need an entry
 193 in this list - but it does not hurt if it is present."
 194   :group 'org-export-man
 195   :version "24.4"
 196   :package-version '(Org . "8.0")
 197   :type '(repeat
 198           (list
 199            (symbol :tag "Major mode       ")
 200            (string :tag "Listings language"))))
 201
 202
 203 ;;; Compilation
 204
 205 (defcustom org-man-pdf-process
 206   '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
 207     "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
 208     "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
 209
 210   "Commands to process a Man file to a PDF file.
 211
 212 This is a list of strings, each of them will be given to the
 213 shell as a command.  %f in the command will be replaced by the
 214 relative file name, %F by the absolute file name, %b by the file
 215 base name (i.e. without directory and extension parts), %o by the
 216 base directory of the file and %O by the absolute file name of
 217 the output file.
 218
 219 By default, Org uses 3 runs of to do the processing.
 220
 221 Alternatively, this may be a Lisp function that does the
 222 processing.  This function should accept the file name as
 223 its single argument."
 224   :group 'org-export-pdf
 225   :group 'org-export-man
 226   :version "24.4"
 227   :package-version '(Org . "8.0")
 228   :type '(choice
 229           (repeat :tag "Shell command sequence"
 230                   (string :tag "Shell command"))
 231           (const :tag "2 runs of pdfgroff"
 232                  ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
 233                   "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" ))
 234           (const :tag "3 runs of pdfgroff"
 235                  ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
 236                   "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
 237                   "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"))
 238           (function)))
 239
 240 (defcustom org-man-logfiles-extensions
 241   '("log" "out" "toc")
 242   "The list of file extensions to consider as Man logfiles."
 243   :group 'org-export-man
 244   :version "24.4"
 245   :package-version '(Org . "8.0")
 246   :type '(repeat (string :tag "Extension")))
 247
 248 (defcustom org-man-remove-logfiles t
 249   "Non-nil means remove the logfiles produced by PDF production.
 250 These are the .aux, .log, .out, and .toc files."
 251   :group 'org-export-man
 252   :version "24.4"
 253   :package-version '(Org . "8.0")
 254   :type 'boolean)
 255
 256
 257 \f
 258 ;;; Internal Functions
 259
 260 (defun org-man--caption/label-string (element info)
 261   "Return caption and label Man string for ELEMENT.
 262
 263 INFO is a plist holding contextual information.  If there's no
 264 caption nor label, return the empty string.
 265
 266 For non-floats, see `org-man--wrap-label'."
 267   (let ((label (org-element-property :label element))
 268         (main (org-export-get-caption element))
 269         (short (org-export-get-caption element t)))
 270     (cond ((and (not main) (not label)) "")
 271           ((not main) (format "\\fI%s\\fP" label))
 272           ;; Option caption format with short name.
 273           (short (format "\\fR%s\\fP - \\fI\\P - %s\n"
 274                          (org-export-data short info)
 275                          (org-export-data main info)))
 276           ;; Standard caption format.
 277           (t (format "\\fR%s\\fP" (org-export-data main info))))))
 278
 279 (defun org-man--wrap-label (element output)
 280   "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
 281 This function shouldn't be used for floats.  See
 282 `org-man--caption/label-string'."
 283   (let ((label (org-element-property :name element)))
 284     (if (or (not output) (not label) (string= output "") (string= label ""))
 285         output
 286       (concat (format "%s\n.br\n" label) output))))
 287
 288
 289 \f
 290 ;;; Template
 291
 292 (defun org-man-template (contents info)
 293   "Return complete document string after Man conversion.
 294 CONTENTS is the transcoded contents string.  INFO is a plist
 295 holding export options."
 296   (let* ((title (when (plist-get info :with-title)
 297                   (org-export-data (plist-get info :title) info)))
 298         (attr (read (format "(%s)"
 299                             (mapconcat
 300                              #'identity
 301                              (list (plist-get info :man-class-options))
 302                              " "))))
 303         (section-item (plist-get attr :section-id)))
 304
 305     (concat
 306
 307      (cond
 308       ((and title (stringp section-item))
 309        (format ".TH \"%s\" \"%s\" \n" title section-item))
 310       ((and (string= "" title) (stringp section-item))
 311        (format ".TH \"%s\" \"%s\" \n" " " section-item))
 312       (title
 313        (format ".TH \"%s\" \"1\" \n" title))
 314       (t
 315        ".TH \" \" \"1\" "))
 316      contents)))
 317
 318
 319
 320 \f
 321 ;;; Transcode Functions
 322
 323 ;;; Babel Call
 324 ;;
 325 ;; Babel Calls are ignored.
 326
 327
 328 ;;; Bold
 329
 330 (defun org-man-bold (_bold contents _info)
 331   "Transcode BOLD from Org to Man.
 332 CONTENTS is the text with bold markup.  INFO is a plist holding
 333 contextual information."
 334   (format "\\fB%s\\fP" contents))
 335
 336
 337 ;;; Center Block
 338
 339 (defun org-man-center-block (center-block contents _info)
 340   "Transcode a CENTER-BLOCK element from Org to Man.
 341 CONTENTS holds the contents of the center block.  INFO is a plist
 342 holding contextual information."
 343   (org-man--wrap-label
 344    center-block
 345    (format ".ce %d\n.nf\n%s\n.fi"
 346            (- (length (split-string contents "\n")) 1 )
 347            contents)))
 348
 349
 350 ;;; Code
 351
 352 (defun org-man-code (code _contents _info)
 353   "Transcode a CODE object from Org to Man.
 354 CONTENTS is nil.  INFO is a plist used as a communication
 355 channel."
 356   (format "\\fC%s\\fP" code))
 357
 358
 359 ;;; Drawer
 360
 361 (defun org-man-drawer (_drawer contents _info)
 362   "Transcode a DRAWER element from Org to Man.
 363    DRAWER holds the drawer information
 364    CONTENTS holds the contents of the block.
 365    INFO is a plist holding contextual information. "
 366   contents)
 367
 368
 369 ;;; Dynamic Block
 370
 371 (defun org-man-dynamic-block (dynamic-block contents _info)
 372   "Transcode a DYNAMIC-BLOCK element from Org to Man.
 373 CONTENTS holds the contents of the block.  INFO is a plist
 374 holding contextual information.  See `org-export-data'."
 375   (org-man--wrap-label dynamic-block contents))
 376
 377
 378 ;;; Entity
 379
 380 (defun org-man-entity (entity _contents _info)
 381   "Transcode an ENTITY object from Org to Man.
 382 CONTENTS are the definition itself.  INFO is a plist holding
 383 contextual information."
 384   (org-element-property :utf-8 entity))
 385
 386
 387 ;;; Example Block
 388
 389 (defun org-man-example-block (example-block _contents info)
 390   "Transcode an EXAMPLE-BLOCK element from Org to Man.
 391 CONTENTS is nil.  INFO is a plist holding contextual
 392 information."
 393   (org-man--wrap-label
 394    example-block
 395    (format ".RS\n.nf\n%s\n.fi\n.RE"
 396            (org-export-format-code-default example-block info))))
 397
 398
 399 ;;; Export Block
 400
 401 (defun org-man-export-block (export-block _contents _info)
 402   "Transcode a EXPORT-BLOCK element from Org to Man.
 403 CONTENTS is nil.  INFO is a plist holding contextual information."
 404   (when (string= (org-element-property :type export-block) "MAN")
 405     (org-remove-indentation (org-element-property :value export-block))))
 406
 407
 408 ;;; Export Snippet
 409
 410 (defun org-man-export-snippet (export-snippet _contents _info)
 411   "Transcode a EXPORT-SNIPPET object from Org to Man.
 412 CONTENTS is nil.  INFO is a plist holding contextual information."
 413   (when (eq (org-export-snippet-backend export-snippet) 'man)
 414     (org-element-property :value export-snippet)))
 415
 416
 417 ;;; Fixed Width
 418
 419 (defun org-man-fixed-width (fixed-width _contents _info)
 420   "Transcode a FIXED-WIDTH element from Org to Man.
 421 CONTENTS is nil.  INFO is a plist holding contextual information."
 422   (org-man--wrap-label
 423    fixed-width
 424    (format "\\fC\n%s\\fP"
 425            (org-remove-indentation
 426             (org-element-property :value fixed-width)))))
 427
 428
 429 ;;; Footnote Definition
 430 ;;
 431 ;; Footnote Definitions are ignored.
 432
 433 ;;; Footnote References
 434 ;;
 435 ;; Footnote References are Ignored
 436
 437
 438 ;;; Headline
 439
 440 (defun org-man-headline (headline contents info)
 441   "Transcode a HEADLINE element from Org to Man.
 442 CONTENTS holds the contents of the headline.  INFO is a plist
 443 holding contextual information."
 444   (let* ((level (org-export-get-relative-level headline info))
 445          ;; Section formatting will set two placeholders: one for the
 446          ;; title and the other for the contents.
 447          (section-fmt
 448           (pcase level
 449             (1 ".SH \"%s\"\n%s")
 450             (2 ".SS \"%s\"\n%s")
 451             (3 ".SS \"%s\"\n%s")
 452             (_ nil)))
 453          (text (org-export-data (org-element-property :title headline) info)))
 454
 455     (cond
 456      ;; Case 1: This is a footnote section: ignore it.
 457      ((org-element-property :footnote-section-p headline) nil)
 458
 459      ;; Case 2. This is a deep sub-tree: export it as a list item.
 460      ;;         Also export as items headlines for which no section
 461      ;;         format has been found.
 462      ((or (not section-fmt) (org-export-low-level-p headline info))
 463       ;; Build the real contents of the sub-tree.
 464       (let ((low-level-body
 465              (concat
 466               ;; If the headline is the first sibling, start a list.
 467               (when (org-export-first-sibling-p headline info)
 468                 (format "%s\n" ".RS"))
 469               ;; Itemize headline
 470               ".TP\n.ft I\n" text "\n.ft\n"
 471               contents ".RE")))
 472         ;; If headline is not the last sibling simply return
 473         ;; LOW-LEVEL-BODY.  Otherwise, also close the list, before any
 474         ;; blank line.
 475         (if (not (org-export-last-sibling-p headline info)) low-level-body
 476           (replace-regexp-in-string
 477            "[ \t\n]*\\'" ""
 478            low-level-body))))
 479
 480      ;; Case 3. Standard headline.  Export it as a section.
 481      (t (format section-fmt text contents )))))
 482
 483 ;;; Horizontal Rule
 484 ;; Not supported
 485
 486 ;;; Inline Babel Call
 487 ;;
 488 ;; Inline Babel Calls are ignored.
 489
 490 ;;; Inline Src Block
 491
 492 (defun org-man-inline-src-block (inline-src-block _contents info)
 493   "Transcode an INLINE-SRC-BLOCK element from Org to Man.
 494 CONTENTS holds the contents of the item.  INFO is a plist holding
 495 contextual information."
 496   (let* ((code (org-element-property :value inline-src-block)))
 497     (cond
 498      ((plist-get info :man-source-highlight)
 499       (let* ((tmpdir temporary-file-directory)
 500              (in-file  (make-temp-name
 501                         (expand-file-name "srchilite" tmpdir)))
 502              (out-file (make-temp-name
 503                         (expand-file-name "reshilite" tmpdir)))
 504              (org-lang (org-element-property :language inline-src-block))
 505              (lst-lang
 506               (cadr (assq (intern org-lang)
 507                           (plist-get info :man-source-highlight-langs))))
 508
 509              (cmd (concat (expand-file-name "source-highlight")
 510                           " -s " lst-lang
 511                           " -f groff_man"
 512                           " -i " in-file
 513                           " -o " out-file )))
 514
 515         (if lst-lang
 516             (let ((code-block "" ))
 517               (with-temp-file in-file (insert code))
 518               (shell-command cmd)
 519               (setq code-block  (org-file-contents out-file))
 520               (delete-file in-file)
 521               (delete-file out-file)
 522               code-block)
 523           (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
 524                   code))))
 525
 526      ;; Do not use a special package: transcode it verbatim.
 527      (t
 528       (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
 529               "\\fP\n.fi\n.RE\n")))))
 530
 531
 532 ;;; Inlinetask
 533 ;;; Italic
 534
 535 (defun org-man-italic (_italic contents _info)
 536   "Transcode ITALIC from Org to Man.
 537 CONTENTS is the text with italic markup.  INFO is a plist holding
 538 contextual information."
 539   (format "\\fI%s\\fP" contents))
 540
 541
 542 ;;; Item
 543
 544
 545 (defun org-man-item (item contents info)
 546   "Transcode an ITEM element from Org to Man.
 547 CONTENTS holds the contents of the item.  INFO is a plist holding
 548 contextual information."
 549   (let* ((bullet (org-element-property :bullet item))
 550          (type (org-element-property :type (org-element-property :parent item)))
 551          (checkbox (pcase (org-element-property :checkbox item)
 552                      (`on "\\o'\\(sq\\(mu'")
 553                      (`off "\\(sq ")
 554                      (`trans "\\o'\\(sq\\(mi'")))
 555
 556          (tag (let ((tag (org-element-property :tag item)))
 557                 ;; Check-boxes must belong to the tag.
 558                 (and tag (format "\\fB%s\\fP"
 559                                  (concat checkbox
 560                                          (org-export-data tag info)))))))
 561
 562     (if (and (null tag) (null checkbox))
 563         (let* ((bullet (org-trim bullet))
 564                (marker (cond  ((string= "-" bullet) "\\(em")
 565                               ((string= "*" bullet) "\\(bu")
 566                               ((eq type 'ordered)
 567                                (format "%s " (org-trim bullet)))
 568                               (t "\\(dg"))))
 569           (concat ".IP " marker " 4\n"
 570                   (org-trim (or contents " " ))))
 571       (concat ".TP\n" (or tag (concat " " checkbox)) "\n"
 572               (org-trim (or contents " " ))))))
 573
 574 ;;; Keyword
 575
 576
 577 (defun org-man-keyword (keyword _contents _info)
 578   "Transcode a KEYWORD element from Org to Man.
 579 CONTENTS is nil.  INFO is a plist holding contextual information."
 580   (let ((key (org-element-property :key keyword))
 581         (value (org-element-property :value keyword)))
 582     (cond
 583      ((string= key "MAN") value)
 584      ((string= key "INDEX") nil)
 585      ((string= key "TOC"   ) nil))))
 586
 587
 588 ;;; Line Break
 589
 590 (defun org-man-line-break (_line-break _contents _info)
 591   "Transcode a LINE-BREAK object from Org to Man.
 592 CONTENTS is nil.  INFO is a plist holding contextual information."
 593   "\n.br\n")
 594
 595
 596 ;;; Link
 597
 598
 599 (defun org-man-link (link desc _info)
 600   "Transcode a LINK object from Org to Man.
 601
 602 DESC is the description part of the link, or the empty string.
 603 INFO is a plist holding contextual information.  See
 604 `org-export-data'."
 605   (let* ((type (org-element-property :type link))
 606          (raw-path (org-element-property :path link))
 607          ;; Ensure DESC really exists, or set it to nil.
 608          (desc (and (not (string= desc "")) desc))
 609          (path (cond
 610                 ((member type '("http" "https" "ftp" "mailto"))
 611                  (concat type ":" raw-path))
 612                 ((string= type "file") (org-export-file-uri raw-path))
 613                 (t raw-path))))
 614     (cond
 615      ;; Link type is handled by a special function.
 616      ((org-export-custom-protocol-maybe link desc 'man))
 617      ;; External link with a description part.
 618      ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
 619      ;; External link without a description part.
 620      (path (format "\\fI%s\\fP" path))
 621      ;; No path, only description.  Try to do something useful.
 622      (t (format "\\fI%s\\fP" desc)))))
 623
 624 ;;;; Node Property
 625
 626 (defun org-man-node-property (node-property _contents _info)
 627   "Transcode a NODE-PROPERTY element from Org to Man.
 628 CONTENTS is nil.  INFO is a plist holding contextual
 629 information."
 630   (format "%s:%s"
 631           (org-element-property :key node-property)
 632           (let ((value (org-element-property :value node-property)))
 633             (if value (concat " " value) ""))))
 634
 635 ;;; Paragraph
 636
 637 (defun org-man-paragraph (paragraph contents _info)
 638   "Transcode a PARAGRAPH element from Org to Man.
 639 CONTENTS is the contents of the paragraph, as a string.  INFO is
 640 the plist used as a communication channel."
 641   (let ((parent (plist-get (nth 1 paragraph) :parent)))
 642     (when parent
 643       (let ((parent-type (car parent))
 644             (fixed-paragraph ""))
 645         (cond ((and (eq parent-type 'item)
 646                     (plist-get (nth 1 parent) :bullet ))
 647                (setq fixed-paragraph (concat "" contents)))
 648               ((eq parent-type 'section)
 649                (setq fixed-paragraph (concat ".PP\n" contents)))
 650               ((eq parent-type 'footnote-definition)
 651                (setq fixed-paragraph contents))
 652               (t (setq fixed-paragraph (concat "" contents))))
 653         fixed-paragraph ))))
 654
 655
 656 ;;; Plain List
 657
 658 (defun org-man-plain-list (_plain-list contents _info)
 659   "Transcode a PLAIN-LIST element from Org to Man.
 660 CONTENTS is the contents of the list.  INFO is a plist holding
 661 contextual information."
 662   contents)
 663
 664 ;;; Plain Text
 665
 666 (defun org-man-plain-text (text info)
 667   "Transcode a TEXT string from Org to Man.
 668 TEXT is the string to transcode.  INFO is a plist holding
 669 contextual information."
 670   (let ((output text))
 671     ;; Protect various chars.
 672     (setq output (replace-regexp-in-string
 673                   "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
 674                   "$\\" output nil t 1))
 675     ;; Activate smart quotes.  Be sure to provide original TEXT string
 676     ;; since OUTPUT may have been modified.
 677     (when (plist-get info :with-smart-quotes)
 678       (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
 679     ;; Handle break preservation if required.
 680     (when (plist-get info :preserve-breaks)
 681       (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n"
 682                                              output)))
 683     ;; Return value.
 684     output))
 685
 686
 687
 688 ;;; Planning
 689
 690
 691 ;;; Property Drawer
 692
 693 (defun org-man-property-drawer (_property-drawer contents _info)
 694   "Transcode a PROPERTY-DRAWER element from Org to Man.
 695 CONTENTS holds the contents of the drawer.  INFO is a plist
 696 holding contextual information."
 697   (and (org-string-nw-p contents)
 698        (format ".RS\n.nf\n%s\n.fi\n.RE" contents)))
 699
 700 ;;; Quote Block
 701
 702 (defun org-man-quote-block (quote-block contents _info)
 703   "Transcode a QUOTE-BLOCK element from Org to Man.
 704 CONTENTS holds the contents of the block.  INFO is a plist
 705 holding contextual information."
 706   (org-man--wrap-label
 707    quote-block
 708    (format ".RS\n%s\n.RE" contents)))
 709
 710
 711 ;;; Radio Target
 712
 713 (defun org-man-radio-target (_radio-target text _info)
 714   "Transcode a RADIO-TARGET object from Org to Man.
 715 TEXT is the text of the target.  INFO is a plist holding
 716 contextual information."
 717   text)
 718
 719
 720 ;;; Section
 721
 722 (defun org-man-section (_section contents _info)
 723   "Transcode a SECTION element from Org to Man.
 724 CONTENTS holds the contents of the section.  INFO is a plist
 725 holding contextual information."
 726   contents)
 727
 728
 729 ;;; Special Block
 730
 731 (defun org-man-special-block (special-block contents _info)
 732   "Transcode a SPECIAL-BLOCK element from Org to Man.
 733 CONTENTS holds the contents of the block.  INFO is a plist
 734 holding contextual information."
 735   (org-man--wrap-label special-block (format "%s\n" contents)))
 736
 737
 738 ;;; Src Block
 739
 740 (defun org-man-src-block (src-block _contents info)
 741   "Transcode a SRC-BLOCK element from Org to Man.
 742 CONTENTS holds the contents of the item.  INFO is a plist holding
 743 contextual information."
 744   (if (not (plist-get info :man-source-highlight))
 745       (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
 746               (org-export-format-code-default src-block info))
 747     (let* ((tmpdir temporary-file-directory)
 748            (in-file  (make-temp-name (expand-file-name "srchilite" tmpdir)))
 749            (out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
 750            (code (org-element-property :value src-block))
 751            (org-lang (org-element-property :language src-block))
 752            (lst-lang
 753             (cadr (assq (intern org-lang)
 754                         (plist-get info :man-source-highlight-langs))))
 755            (cmd (concat "source-highlight"
 756                         " -s " lst-lang
 757                         " -f groff_man "
 758                         " -i " in-file
 759                         " -o " out-file)))
 760       (if lst-lang
 761           (let ((code-block ""))
 762             (with-temp-file in-file (insert code))
 763             (shell-command cmd)
 764             (setq code-block  (org-file-contents out-file))
 765             (delete-file in-file)
 766             (delete-file out-file)
 767             code-block)
 768         (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))
 769
 770
 771 ;;; Statistics Cookie
 772
 773 (defun org-man-statistics-cookie (statistics-cookie _contents _info)
 774   "Transcode a STATISTICS-COOKIE object from Org to Man.
 775 CONTENTS is nil.  INFO is a plist holding contextual information."
 776   (org-element-property :value statistics-cookie))
 777
 778
 779 ;;; Strike-Through
 780
 781 (defun org-man-strike-through (_strike-through contents _info)
 782   "Transcode STRIKE-THROUGH from Org to Man.
 783 CONTENTS is the text with strike-through markup.  INFO is a plist
 784 holding contextual information."
 785   (format "\\fI%s\\fP" contents))
 786
 787 ;;; Subscript
 788
 789 (defun org-man-subscript (_subscript contents _info)
 790   "Transcode a SUBSCRIPT object from Org to Man.
 791 CONTENTS is the contents of the object.  INFO is a plist holding
 792 contextual information."
 793   (format  "\\d\\s-2%s\\s+2\\u" contents))
 794
 795 ;;; Superscript "^_%s$
 796
 797 (defun org-man-superscript (_superscript contents _info)
 798   "Transcode a SUPERSCRIPT object from Org to Man.
 799 CONTENTS is the contents of the object.  INFO is a plist holding
 800 contextual information."
 801   (format  "\\u\\s-2%s\\s+2\\d" contents))
 802
 803
 804 ;;; Table
 805 ;;
 806 ;; `org-man-table' is the entry point for table transcoding.  It
 807 ;; takes care of tables with a "verbatim" attribute.  Otherwise, it
 808 ;; delegates the job to either `org-man-table--table.el-table' or
 809 ;; `org-man-table--org-table' functions, depending of the type of
 810 ;; the table.
 811 ;;
 812 ;; `org-man-table--align-string' is a subroutine used to build
 813 ;; alignment string for Org tables.
 814
 815 (defun org-man-table (table contents info)
 816   "Transcode a TABLE element from Org to Man.
 817 CONTENTS is the contents of the table.  INFO is a plist holding
 818 contextual information."
 819   (cond
 820    ;; Case 1: verbatim table.
 821    ((or (plist-get info :man-tables-verbatim)
 822         (let ((attr (read (format "(%s)"
 823                  (mapconcat
 824                   #'identity
 825                   (org-element-property :attr_man table)
 826                   " ")))))
 827
 828           (and attr (plist-get attr :verbatim))))
 829
 830     (format ".nf\n\\fC%s\\fP\n.fi"
 831             ;; Re-create table, without affiliated keywords.
 832             (org-trim
 833              (org-element-interpret-data
 834               `(table nil ,@(org-element-contents table))))))
 835    ;; Case 2: Standard table.
 836    (t (org-man-table--org-table table contents info))))
 837
 838 (defun org-man-table--align-string (divider table info)
 839   "Return an appropriate Man alignment string.
 840 TABLE is the considered table.  INFO is a plist used as
 841 a communication channel."
 842   (let (alignment)
 843     ;; Extract column groups and alignment from first (non-rule) row.
 844     (org-element-map
 845         (org-element-map table 'table-row
 846           (lambda (row)
 847             (and (eq (org-element-property :type row) 'standard) row))
 848           info 'first-match)
 849         'table-cell
 850       (lambda (cell)
 851         (let* ((borders (org-export-table-cell-borders cell info))
 852                (raw-width (org-export-table-cell-width cell info))
 853                (width-cm (when raw-width (/ raw-width 5)))
 854                (width (if raw-width (format "w(%dc)"
 855                                             (if (< width-cm 1) 1 width-cm)) "")))
 856           ;; Check left border for the first cell only.
 857           (when (and (memq 'left borders) (not alignment))
 858             (push "|" alignment))
 859           (push
 860            (concat (pcase (org-export-table-cell-alignment cell info)
 861                      (`left "l") (`right "r") (`center "c"))
 862                    width
 863                    divider)
 864            alignment)
 865           (when (memq 'right borders) (push "|" alignment))))
 866       info)
 867     (apply #'concat (reverse alignment))))
 868
 869 (defun org-man-table--org-table (table contents info)
 870   "Return appropriate Man code for an Org table.
 871
 872 TABLE is the table type element to transcode.  CONTENTS is its
 873 contents, as a string.  INFO is a plist used as a communication
 874 channel.
 875
 876 This function assumes TABLE has `org' as its `:type' attribute."
 877   (let* ((attr (org-export-read-attribute :attr_man table))
 878          (caption (and (not (plist-get attr :disable-caption))
 879                        (org-man--caption/label-string table info)))
 880          (divider (if (plist-get attr :divider) "|" " "))
 881
 882          ;; Determine alignment string.
 883          (alignment (org-man-table--align-string divider table info))
 884          ;; Extract others display options.
 885
 886          (lines (org-split-string contents "\n"))
 887
 888          (attr-list
 889           (delq nil
 890                 (list
 891                  (and (plist-get attr :expand) "expand")
 892                  (let ((placement (plist-get attr :placement)))
 893                    (cond ((string= placement 'center) "center")
 894                          ((string= placement 'left) nil)
 895                          ((plist-get info :man-tables-centered) "center")
 896                          (t "")))
 897                  (or (plist-get attr :boxtype) "box"))))
 898
 899          (title-line  (plist-get attr :title-line))
 900          (long-cells (plist-get attr :long-cells))
 901
 902          (table-format (concat
 903                         (format "%s" (or (car attr-list) "" ))
 904                         (or
 905                          (let ((output-list '()))
 906                            (when (cdr attr-list)
 907                              (dolist (attr-item (cdr attr-list))
 908                                (setq output-list (concat output-list  (format ",%s" attr-item)))))
 909                            output-list)
 910                          "")))
 911
 912          (first-line (when lines (org-split-string (car lines) "\t"))))
 913     ;; Prepare the final format string for the table.
 914
 915
 916     (cond
 917      ;; Others.
 918      (lines (concat ".TS\n " table-format ";\n"
 919
 920                     (format "%s.\n"
 921                             (let ((final-line ""))
 922                               (when title-line
 923                                 (dotimes (_ (length first-line))
 924                                   (setq final-line (concat final-line "cb" divider))))
 925
 926                               (setq final-line (concat final-line "\n"))
 927
 928                               (if alignment
 929                                   (setq final-line (concat final-line alignment))
 930                                 (dotimes (_ (length first-line))
 931                                   (setq final-line (concat final-line "c" divider))))
 932                               final-line ))
 933
 934                     (format "%s.TE\n"
 935                             (let ((final-line "")
 936                                   (long-line "")
 937                                   (lines (org-split-string contents "\n")))
 938
 939                               (dolist (line-item lines)
 940                                 (setq long-line "")
 941
 942                                 (if long-cells
 943                                     (progn
 944                                       (if (string= line-item "_")
 945                                           (setq long-line (format "%s\n" line-item))
 946                                         ;; else string =
 947                                         (let ((cell-item-list (org-split-string line-item "\t")))
 948                                           (dolist (cell-item cell-item-list)
 949
 950                                             (cond  ((eq cell-item (car (last cell-item-list)))
 951                                                     (setq long-line (concat long-line
 952                                                                             (format "T{\n%s\nT}\t\n"  cell-item ))))
 953                                                    (t
 954                                                     (setq long-line (concat long-line
 955                                                                             (format "T{\n%s\nT}\t"  cell-item ))))))
 956                                           long-line))
 957                                       ;; else long cells
 958                                       (setq final-line (concat final-line long-line )))
 959
 960                                   (setq final-line (concat final-line line-item "\n"))))
 961                               final-line))
 962
 963                     (and caption (format ".TB \"%s\"" caption)))))))
 964
 965 ;;; Table Cell
 966
 967 (defun org-man-table-cell (table-cell contents info)
 968   "Transcode a TABLE-CELL element from Org to Man
 969 CONTENTS is the cell contents.  INFO is a plist used as
 970 a communication channel."
 971   (concat
 972    (let ((scientific-format (plist-get info :man-table-scientific-notation)))
 973      (if (and contents
 974               scientific-format
 975               (string-match orgtbl-exp-regexp contents))
 976          ;; Use appropriate format string for scientific notation.
 977          (format scientific-format
 978                  (match-string 1 contents)
 979                  (match-string 2 contents))
 980        contents))
 981    (when (org-export-get-next-element table-cell info) "\t")))
 982
 983
 984 ;;; Table Row
 985
 986 (defun org-man-table-row (table-row contents info)
 987   "Transcode a TABLE-ROW element from Org to Man.
 988 CONTENTS is the contents of the row.  INFO is a plist used as
 989 a communication channel."
 990   ;; Rules are ignored since table separators are deduced from borders
 991   ;; of the current row.
 992   (when (eq (org-element-property :type table-row) 'standard)
 993     (let ((borders
 994            ;; TABLE-ROW's borders are extracted from its first cell.
 995            (org-export-table-cell-borders
 996             (car (org-element-contents table-row)) info)))
 997       (concat
 998        (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
 999        contents
1000        (cond ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
1001              ((memq 'below borders) "\n_"))))))
1002
1003
1004 ;;; Target
1005
1006 (defun org-man-target (target _contents info)
1007   "Transcode a TARGET object from Org to Man.
1008 CONTENTS is nil.  INFO is a plist holding contextual
1009 information."
1010   (format "\\fI%s\\fP" (org-export-get-reference target info)))
1011
1012
1013 ;;; Timestamp
1014
1015 (defun org-man-timestamp (_timestamp _contents _info)
1016   "Transcode a TIMESTAMP object from Org to Man.
1017 ONTENTS is nil.  INFO is a plist holding contextual information."
1018   "")
1019
1020
1021 ;;; Underline
1022
1023 (defun org-man-underline (_underline contents _info)
1024   "Transcode UNDERLINE from Org to Man.
1025 CONTENTS is the text with underline markup.  INFO is a plist
1026 holding contextual information."
1027   (format "\\fI%s\\fP" contents))
1028
1029
1030 ;;; Verbatim
1031
1032 (defun org-man-verbatim (_verbatim contents _info)
1033   "Transcode a VERBATIM object from Org to Man.
1034 CONTENTS is nil.  INFO is a plist used as a communication
1035 channel."
1036   (format ".nf\n%s\n.fi" contents))
1037
1038
1039 ;;; Verse Block
1040
1041 (defun org-man-verse-block (_verse-block contents _info)
1042   "Transcode a VERSE-BLOCK element from Org to Man.
1043 CONTENTS is verse block contents. INFO is a plist holding
1044 contextual information."
1045   (format ".RS\n.ft I\n%s\n.ft\n.RE" contents))
1046
1047
1048 \f
1049 ;;; Interactive functions
1050
1051 (defun org-man-export-to-man
1052   (&optional async subtreep visible-only body-only ext-plist)
1053   "Export current buffer to a Man file.
1054
1055 If narrowing is active in the current buffer, only export its
1056 narrowed part.
1057
1058 If a region is active, export that region.
1059
1060 A non-nil optional argument ASYNC means the process should happen
1061 asynchronously.  The resulting file should be accessible through
1062 the `org-export-stack' interface.
1063
1064 When optional argument SUBTREEP is non-nil, export the sub-tree
1065 at point, extracting information from the headline properties
1066 first.
1067
1068 When optional argument VISIBLE-ONLY is non-nil, don't export
1069 contents of hidden elements.
1070
1071 When optional argument BODY-ONLY is non-nil, only the body
1072 without any markers.
1073
1074 EXT-PLIST, when provided, is a property list with external
1075 parameters overriding Org default settings, but still inferior to
1076 file-local settings.
1077
1078 Return output file's name."
1079   (interactive)
1080   (let ((outfile (org-export-output-file-name ".man" subtreep)))
1081     (org-export-to-file 'man outfile
1082       async subtreep visible-only body-only ext-plist)))
1083
1084 (defun org-man-export-to-pdf
1085   (&optional async subtreep visible-only body-only ext-plist)
1086   "Export current buffer to Groff then process through to PDF.
1087
1088 If narrowing is active in the current buffer, only export its
1089 narrowed part.
1090
1091 If a region is active, export that region.
1092
1093 A non-nil optional argument ASYNC means the process should happen
1094 asynchronously.  The resulting file should be accessible through
1095 the `org-export-stack' interface.
1096
1097 When optional argument SUBTREEP is non-nil, export the sub-tree
1098 at point, extracting information from the headline properties
1099 first.
1100
1101 When optional argument VISIBLE-ONLY is non-nil, don't export
1102 contents of hidden elements.
1103
1104 When optional argument BODY-ONLY is non-nil, only write between
1105 markers.
1106
1107 EXT-PLIST, when provided, is a property list with external
1108 parameters overriding Org default settings, but still inferior to
1109 file-local settings.
1110
1111 Return PDF file's name."
1112   (interactive)
1113   (let ((outfile (org-export-output-file-name ".man" subtreep)))
1114     (org-export-to-file 'man outfile
1115       async subtreep visible-only body-only ext-plist
1116       (lambda (file) (org-latex-compile file)))))
1117
1118 (defun org-man-compile (file)
1119   "Compile a Groff file.
1120
1121 FILE is the name of the file being compiled.  Processing is done
1122 through the command specified in `org-man-pdf-process'.
1123
1124 Return PDF file name or an error if it couldn't be produced."
1125   (message "Processing Groff file %s..." file)
1126   (let ((output (org-compile-file file org-man-pdf-process "pdf")))
1127     (when org-man-remove-logfiles
1128       (let ((base (file-name-sans-extension output)))
1129         (dolist (ext org-man-logfiles-extensions)
1130           (let ((file (concat base "." ext)))
1131             (when (file-exists-p file) (delete-file file))))))
1132     (message "Process completed.")
1133     output))
1134
1135 (provide 'ox-man)
1136
1137 ;; Local variables:
1138 ;; generated-autoload-file: "org-loaddefs.el"
1139 ;; End:
1140
1141 ;;; ox-man.el ends here