lisp/ox-man.el

   1 ;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2011-2019 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 <https://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 (defun org-man--protect-text (text)
 289   "Protect minus and backslash characters in string TEXT."
 290   (replace-regexp-in-string "-" "\\-" text nil t))
 291
 292
 293 \f
 294 ;;; Template
 295
 296 (defun org-man-template (contents info)
 297   "Return complete document string after Man conversion.
 298 CONTENTS is the transcoded contents string.  INFO is a plist
 299 holding export options."
 300   (let* ((title (when (plist-get info :with-title)
 301                   (org-export-data (plist-get info :title) info)))
 302         (attr (read (format "(%s)"
 303                             (mapconcat
 304                              #'identity
 305                              (list (plist-get info :man-class-options))
 306                              " "))))
 307         (section-item (plist-get attr :section-id)))
 308
 309     (concat
 310
 311      (cond
 312       ((and title (stringp section-item))
 313        (format ".TH \"%s\" \"%s\" \n" title section-item))
 314       ((and (string= "" title) (stringp section-item))
 315        (format ".TH \"%s\" \"%s\" \n" " " section-item))
 316       (title
 317        (format ".TH \"%s\" \"1\" \n" title))
 318       (t
 319        ".TH \" \" \"1\" "))
 320      contents)))
 321
 322
 323
 324 \f
 325 ;;; Transcode Functions
 326
 327 ;;; Babel Call
 328 ;;
 329 ;; Babel Calls are ignored.
 330
 331
 332 ;;; Bold
 333
 334 (defun org-man-bold (_bold contents _info)
 335   "Transcode BOLD from Org to Man.
 336 CONTENTS is the text with bold markup.  INFO is a plist holding
 337 contextual information."
 338   (format "\\fB%s\\fP" contents))
 339
 340
 341 ;;; Center Block
 342
 343 (defun org-man-center-block (center-block contents _info)
 344   "Transcode a CENTER-BLOCK element from Org to Man.
 345 CONTENTS holds the contents of the center block.  INFO is a plist
 346 holding contextual information."
 347   (org-man--wrap-label
 348    center-block
 349    (format ".ce %d\n.nf\n%s\n.fi"
 350            (- (length (split-string contents "\n")) 1 )
 351            contents)))
 352
 353
 354 ;;; Code
 355
 356 (defun org-man-code (code _contents _info)
 357   "Transcode a CODE object from Org to Man."
 358   (format "\\fC%s\\fP"
 359           (org-man--protect-text (org-element-property :value code))))
 360
 361
 362 ;;; Drawer
 363
 364 (defun org-man-drawer (_drawer contents _info)
 365   "Transcode a DRAWER element from Org to Man.
 366    DRAWER holds the drawer information
 367    CONTENTS holds the contents of the block.
 368    INFO is a plist holding contextual information. "
 369   contents)
 370
 371
 372 ;;; Dynamic Block
 373
 374 (defun org-man-dynamic-block (dynamic-block contents _info)
 375   "Transcode a DYNAMIC-BLOCK element from Org to Man.
 376 CONTENTS holds the contents of the block.  INFO is a plist
 377 holding contextual information.  See `org-export-data'."
 378   (org-man--wrap-label dynamic-block contents))
 379
 380
 381 ;;; Entity
 382
 383 (defun org-man-entity (entity _contents _info)
 384   "Transcode an ENTITY object from Org to Man.
 385 CONTENTS are the definition itself.  INFO is a plist holding
 386 contextual information."
 387   (org-element-property :utf-8 entity))
 388
 389
 390 ;;; Example Block
 391
 392 (defun org-man-example-block (example-block _contents info)
 393   "Transcode an EXAMPLE-BLOCK element from Org to Man.
 394 CONTENTS is nil.  INFO is a plist holding contextual
 395 information."
 396   (org-man--wrap-label
 397    example-block
 398    (format ".RS\n.nf\n%s\n.fi\n.RE"
 399            (org-export-format-code-default example-block info))))
 400
 401
 402 ;;; Export Block
 403
 404 (defun org-man-export-block (export-block _contents _info)
 405   "Transcode a EXPORT-BLOCK element from Org to Man.
 406 CONTENTS is nil.  INFO is a plist holding contextual information."
 407   (when (string= (org-element-property :type export-block) "MAN")
 408     (org-remove-indentation (org-element-property :value export-block))))
 409
 410
 411 ;;; Export Snippet
 412
 413 (defun org-man-export-snippet (export-snippet _contents _info)
 414   "Transcode a EXPORT-SNIPPET object from Org to Man.
 415 CONTENTS is nil.  INFO is a plist holding contextual information."
 416   (when (eq (org-export-snippet-backend export-snippet) 'man)
 417     (org-element-property :value export-snippet)))
 418
 419
 420 ;;; Fixed Width
 421
 422 (defun org-man-fixed-width (fixed-width _contents _info)
 423   "Transcode a FIXED-WIDTH element from Org to Man.
 424 CONTENTS is nil.  INFO is a plist holding contextual information."
 425   (org-man--wrap-label
 426    fixed-width
 427    (format "\\fC\n%s\n\\fP"
 428            (org-remove-indentation
 429             (org-element-property :value fixed-width)))))
 430
 431
 432 ;;; Footnote Definition
 433 ;;
 434 ;; Footnote Definitions are ignored.
 435
 436 ;;; Footnote References
 437 ;;
 438 ;; Footnote References are Ignored
 439
 440
 441 ;;; Headline
 442
 443 (defun org-man-headline (headline contents info)
 444   "Transcode a HEADLINE element from Org to Man.
 445 CONTENTS holds the contents of the headline.  INFO is a plist
 446 holding contextual information."
 447   (let* ((level (org-export-get-relative-level headline info))
 448          ;; Section formatting will set two placeholders: one for the
 449          ;; title and the other for the contents.
 450          (section-fmt
 451           (pcase level
 452             (1 ".SH \"%s\"\n%s")
 453             (2 ".SS \"%s\"\n%s")
 454             (3 ".SS \"%s\"\n%s")
 455             (_ nil)))
 456          (text (org-export-data (org-element-property :title headline) info)))
 457
 458     (cond
 459      ;; Case 1: This is a footnote section: ignore it.
 460      ((org-element-property :footnote-section-p headline) nil)
 461
 462      ;; Case 2. This is a deep sub-tree: export it as a list item.
 463      ;;         Also export as items headlines for which no section
 464      ;;         format has been found.
 465      ((or (not section-fmt) (org-export-low-level-p headline info))
 466       ;; Build the real contents of the sub-tree.
 467       (let ((low-level-body
 468              (concat
 469               ;; If the headline is the first sibling, start a list.
 470               (when (org-export-first-sibling-p headline info)
 471                 (format "%s\n" ".RS"))
 472               ;; Itemize headline
 473               ".TP\n.ft I\n" text "\n.ft\n"
 474               contents ".RE")))
 475         ;; If headline is not the last sibling simply return
 476         ;; LOW-LEVEL-BODY.  Otherwise, also close the list, before any
 477         ;; blank line.
 478         (if (not (org-export-last-sibling-p headline info)) low-level-body
 479           (replace-regexp-in-string
 480            "[ \t\n]*\\'" ""
 481            low-level-body))))
 482
 483      ;; Case 3. Standard headline.  Export it as a section.
 484      (t (format section-fmt text contents )))))
 485
 486 ;;; Horizontal Rule
 487 ;; Not supported
 488
 489 ;;; Inline Babel Call
 490 ;;
 491 ;; Inline Babel Calls are ignored.
 492
 493 ;;; Inline Src Block
 494
 495 (defun org-man-inline-src-block (inline-src-block _contents info)
 496   "Transcode an INLINE-SRC-BLOCK element from Org to Man.
 497 CONTENTS holds the contents of the item.  INFO is a plist holding
 498 contextual information."
 499   (let* ((code (org-element-property :value inline-src-block)))
 500     (cond
 501      ((plist-get info :man-source-highlight)
 502       (let* ((tmpdir temporary-file-directory)
 503              (in-file  (make-temp-name
 504                         (expand-file-name "srchilite" tmpdir)))
 505              (out-file (make-temp-name
 506                         (expand-file-name "reshilite" tmpdir)))
 507              (org-lang (org-element-property :language inline-src-block))
 508              (lst-lang
 509               (cadr (assq (intern org-lang)
 510                           (plist-get info :man-source-highlight-langs))))
 511
 512              (cmd (concat (expand-file-name "source-highlight")
 513                           " -s " lst-lang
 514                           " -f groff_man"
 515                           " -i " in-file
 516                           " -o " out-file )))
 517
 518         (if lst-lang
 519             (let ((code-block "" ))
 520               (with-temp-file in-file (insert code))
 521               (shell-command cmd)
 522               (setq code-block  (org-file-contents out-file))
 523               (delete-file in-file)
 524               (delete-file out-file)
 525               code-block)
 526           (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
 527                   code))))
 528
 529      ;; Do not use a special package: transcode it verbatim.
 530      (t
 531       (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
 532               "\\fP\n.fi\n.RE\n")))))
 533
 534
 535 ;;; Inlinetask
 536 ;;; Italic
 537
 538 (defun org-man-italic (_italic contents _info)
 539   "Transcode ITALIC from Org to Man.
 540 CONTENTS is the text with italic markup.  INFO is a plist holding
 541 contextual information."
 542   (format "\\fI%s\\fP" contents))
 543
 544
 545 ;;; Item
 546
 547
 548 (defun org-man-item (item contents info)
 549   "Transcode an ITEM element from Org to Man.
 550 CONTENTS holds the contents of the item.  INFO is a plist holding
 551 contextual information."
 552   (let* ((bullet (org-element-property :bullet item))
 553          (type (org-element-property :type (org-element-property :parent item)))
 554          (checkbox (pcase (org-element-property :checkbox item)
 555                      (`on "\\o'\\(sq\\(mu'")
 556                      (`off "\\(sq ")
 557                      (`trans "\\o'\\(sq\\(mi'")))
 558
 559          (tag (let ((tag (org-element-property :tag item)))
 560                 ;; Check-boxes must belong to the tag.
 561                 (and tag (format "\\fB%s\\fP"
 562                                  (concat checkbox
 563                                          (org-export-data tag info)))))))
 564
 565     (if (and (null tag) (null checkbox))
 566         (let* ((bullet (org-trim bullet))
 567                (marker (cond  ((string= "-" bullet) "\\(em")
 568                               ((string= "*" bullet) "\\(bu")
 569                               ((eq type 'ordered)
 570                                (format "%s " (org-trim bullet)))
 571                               (t "\\(dg"))))
 572           (concat ".IP " marker " 4\n"
 573                   (org-trim (or contents " " ))))
 574       (concat ".TP\n" (or tag (concat " " checkbox)) "\n"
 575               (org-trim (or contents " " ))))))
 576
 577 ;;; Keyword
 578
 579
 580 (defun org-man-keyword (keyword _contents _info)
 581   "Transcode a KEYWORD element from Org to Man.
 582 CONTENTS is nil.  INFO is a plist holding contextual information."
 583   (let ((key (org-element-property :key keyword))
 584         (value (org-element-property :value keyword)))
 585     (cond
 586      ((string= key "MAN") value)
 587      ((string= key "INDEX") nil)
 588      ((string= key "TOC"   ) nil))))
 589
 590
 591 ;;; Line Break
 592
 593 (defun org-man-line-break (_line-break _contents _info)
 594   "Transcode a LINE-BREAK object from Org to Man.
 595 CONTENTS is nil.  INFO is a plist holding contextual information."
 596   "\n.br\n")
 597
 598
 599 ;;; Link
 600
 601
 602 (defun org-man-link (link desc _info)
 603   "Transcode a LINK object from Org to Man.
 604
 605 DESC is the description part of the link, or the empty string.
 606 INFO is a plist holding contextual information.  See
 607 `org-export-data'."
 608   (let* ((type (org-element-property :type link))
 609          (raw-path (org-element-property :path link))
 610          ;; Ensure DESC really exists, or set it to nil.
 611          (desc (and (not (string= desc "")) desc))
 612          (path (cond
 613                 ((member type '("http" "https" "ftp" "mailto"))
 614                  (concat type ":" raw-path))
 615                 ((string= type "file") (org-export-file-uri raw-path))
 616                 (t raw-path))))
 617     (cond
 618      ;; Link type is handled by a special function.
 619      ((org-export-custom-protocol-maybe link desc 'man))
 620      ;; External link with a description part.
 621      ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
 622      ;; External link without a description part.
 623      (path (format "\\fI%s\\fP" path))
 624      ;; No path, only description.  Try to do something useful.
 625      (t (format "\\fI%s\\fP" desc)))))
 626
 627 ;;;; Node Property
 628
 629 (defun org-man-node-property (node-property _contents _info)
 630   "Transcode a NODE-PROPERTY element from Org to Man.
 631 CONTENTS is nil.  INFO is a plist holding contextual
 632 information."
 633   (format "%s:%s"
 634           (org-element-property :key node-property)
 635           (let ((value (org-element-property :value node-property)))
 636             (if value (concat " " value) ""))))
 637
 638 ;;; Paragraph
 639
 640 (defun org-man-paragraph (paragraph contents _info)
 641   "Transcode a PARAGRAPH element from Org to Man.
 642 CONTENTS is the contents of the paragraph, as a string.  INFO is
 643 the plist used as a communication channel."
 644   (let ((parent (plist-get (nth 1 paragraph) :parent)))
 645     (when parent
 646       (let ((parent-type (car parent))
 647             (fixed-paragraph ""))
 648         (cond ((and (eq parent-type 'item)
 649                     (plist-get (nth 1 parent) :bullet ))
 650                (setq fixed-paragraph (concat "" contents)))
 651               ((eq parent-type 'section)
 652                (setq fixed-paragraph (concat ".PP\n" contents)))
 653               ((eq parent-type 'footnote-definition)
 654                (setq fixed-paragraph contents))
 655               (t (setq fixed-paragraph (concat "" contents))))
 656         fixed-paragraph ))))
 657
 658
 659 ;;; Plain List
 660
 661 (defun org-man-plain-list (_plain-list contents _info)
 662   "Transcode a PLAIN-LIST element from Org to Man.
 663 CONTENTS is the contents of the list.  INFO is a plist holding
 664 contextual information."
 665   contents)
 666
 667 ;;; Plain Text
 668
 669 (defun org-man-plain-text (text info)
 670   "Transcode a TEXT string from Org to Man.
 671 TEXT is the string to transcode.  INFO is a plist holding
 672 contextual information."
 673   (let ((output text))
 674     ;; Protect various chars.
 675     (setq output (replace-regexp-in-string
 676                   "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
 677                   "$\\" output nil t 1))
 678     ;; Activate smart quotes.  Be sure to provide original TEXT string
 679     ;; since OUTPUT may have been modified.
 680     (when (plist-get info :with-smart-quotes)
 681       (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
 682     ;; Handle break preservation if required.
 683     (when (plist-get info :preserve-breaks)
 684       (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n"
 685                                              output)))
 686     ;; Return value.
 687     output))
 688
 689
 690
 691 ;;; Planning
 692
 693
 694 ;;; Property Drawer
 695
 696 (defun org-man-property-drawer (_property-drawer contents _info)
 697   "Transcode a PROPERTY-DRAWER element from Org to Man.
 698 CONTENTS holds the contents of the drawer.  INFO is a plist
 699 holding contextual information."
 700   (and (org-string-nw-p contents)
 701        (format ".RS\n.nf\n%s\n.fi\n.RE" contents)))
 702
 703 ;;; Quote Block
 704
 705 (defun org-man-quote-block (quote-block contents _info)
 706   "Transcode a QUOTE-BLOCK element from Org to Man.
 707 CONTENTS holds the contents of the block.  INFO is a plist
 708 holding contextual information."
 709   (org-man--wrap-label
 710    quote-block
 711    (format ".RS\n%s\n.RE" contents)))
 712
 713
 714 ;;; Radio Target
 715
 716 (defun org-man-radio-target (_radio-target text _info)
 717   "Transcode a RADIO-TARGET object from Org to Man.
 718 TEXT is the text of the target.  INFO is a plist holding
 719 contextual information."
 720   text)
 721
 722
 723 ;;; Section
 724
 725 (defun org-man-section (_section contents _info)
 726   "Transcode a SECTION element from Org to Man.
 727 CONTENTS holds the contents of the section.  INFO is a plist
 728 holding contextual information."
 729   contents)
 730
 731
 732 ;;; Special Block
 733
 734 (defun org-man-special-block (special-block contents _info)
 735   "Transcode a SPECIAL-BLOCK element from Org to Man.
 736 CONTENTS holds the contents of the block.  INFO is a plist
 737 holding contextual information."
 738   (org-man--wrap-label special-block (format "%s\n" contents)))
 739
 740
 741 ;;; Src Block
 742
 743 (defun org-man-src-block (src-block _contents info)
 744   "Transcode a SRC-BLOCK element from Org to Man.
 745 CONTENTS holds the contents of the item.  INFO is a plist holding
 746 contextual information."
 747   (if (not (plist-get info :man-source-highlight))
 748       (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
 749               (org-export-format-code-default src-block info))
 750     (let* ((tmpdir temporary-file-directory)
 751            (in-file  (make-temp-name (expand-file-name "srchilite" tmpdir)))
 752            (out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
 753            (code (org-element-property :value src-block))
 754            (org-lang (org-element-property :language src-block))
 755            (lst-lang
 756             (cadr (assq (intern org-lang)
 757                         (plist-get info :man-source-highlight-langs))))
 758            (cmd (concat "source-highlight"
 759                         " -s " lst-lang
 760                         " -f groff_man "
 761                         " -i " in-file
 762                         " -o " out-file)))
 763       (if lst-lang
 764           (let ((code-block ""))
 765             (with-temp-file in-file (insert code))
 766             (shell-command cmd)
 767             (setq code-block  (org-file-contents out-file))
 768             (delete-file in-file)
 769             (delete-file out-file)
 770             code-block)
 771         (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))
 772
 773
 774 ;;; Statistics Cookie
 775
 776 (defun org-man-statistics-cookie (statistics-cookie _contents _info)
 777   "Transcode a STATISTICS-COOKIE object from Org to Man.
 778 CONTENTS is nil.  INFO is a plist holding contextual information."
 779   (org-element-property :value statistics-cookie))
 780
 781
 782 ;;; Strike-Through
 783
 784 (defun org-man-strike-through (_strike-through contents _info)
 785   "Transcode STRIKE-THROUGH from Org to Man.
 786 CONTENTS is the text with strike-through markup.  INFO is a plist
 787 holding contextual information."
 788   (format "\\fI%s\\fP" contents))
 789
 790 ;;; Subscript
 791
 792 (defun org-man-subscript (_subscript contents _info)
 793   "Transcode a SUBSCRIPT object from Org to Man.
 794 CONTENTS is the contents of the object.  INFO is a plist holding
 795 contextual information."
 796   (format  "\\d\\s-2%s\\s+2\\u" contents))
 797
 798 ;;; Superscript "^_%s$
 799
 800 (defun org-man-superscript (_superscript contents _info)
 801   "Transcode a SUPERSCRIPT object from Org to Man.
 802 CONTENTS is the contents of the object.  INFO is a plist holding
 803 contextual information."
 804   (format  "\\u\\s-2%s\\s+2\\d" contents))
 805
 806
 807 ;;; Table
 808 ;;
 809 ;; `org-man-table' is the entry point for table transcoding.  It
 810 ;; takes care of tables with a "verbatim" attribute.  Otherwise, it
 811 ;; delegates the job to either `org-man-table--table.el-table' or
 812 ;; `org-man-table--org-table' functions, depending of the type of
 813 ;; the table.
 814 ;;
 815 ;; `org-man-table--align-string' is a subroutine used to build
 816 ;; alignment string for Org tables.
 817
 818 (defun org-man-table (table contents info)
 819   "Transcode a TABLE element from Org to Man.
 820 CONTENTS is the contents of the table.  INFO is a plist holding
 821 contextual information."
 822   (cond
 823    ;; Case 1: verbatim table.
 824    ((or (plist-get info :man-tables-verbatim)
 825         (let ((attr (read (format "(%s)"
 826                  (mapconcat
 827                   #'identity
 828                   (org-element-property :attr_man table)
 829                   " ")))))
 830
 831           (and attr (plist-get attr :verbatim))))
 832
 833     (format ".nf\n\\fC%s\\fP\n.fi"
 834             ;; Re-create table, without affiliated keywords.
 835             (org-trim
 836              (org-element-interpret-data
 837               `(table nil ,@(org-element-contents table))))))
 838    ;; Case 2: Standard table.
 839    (t (org-man-table--org-table table contents info))))
 840
 841 (defun org-man-table--align-string (divider table info)
 842   "Return an appropriate Man alignment string.
 843 TABLE is the considered table.  INFO is a plist used as
 844 a communication channel."
 845   (let (alignment)
 846     ;; Extract column groups and alignment from first (non-rule) row.
 847     (org-element-map
 848         (org-element-map table 'table-row
 849           (lambda (row)
 850             (and (eq (org-element-property :type row) 'standard) row))
 851           info 'first-match)
 852         'table-cell
 853       (lambda (cell)
 854         (let* ((borders (org-export-table-cell-borders cell info))
 855                (raw-width (org-export-table-cell-width cell info))
 856                (width-cm (when raw-width (/ raw-width 5)))
 857                (width (if raw-width (format "w(%dc)"
 858                                             (if (< width-cm 1) 1 width-cm)) "")))
 859           ;; Check left border for the first cell only.
 860           (when (and (memq 'left borders) (not alignment))
 861             (push "|" alignment))
 862           (push
 863            (concat (pcase (org-export-table-cell-alignment cell info)
 864                      (`left "l") (`right "r") (`center "c"))
 865                    width
 866                    divider)
 867            alignment)
 868           (when (memq 'right borders) (push "|" alignment))))
 869       info)
 870     (apply #'concat (reverse alignment))))
 871
 872 (defun org-man-table--org-table (table contents info)
 873   "Return appropriate Man code for an Org table.
 874
 875 TABLE is the table type element to transcode.  CONTENTS is its
 876 contents, as a string.  INFO is a plist used as a communication
 877 channel.
 878
 879 This function assumes TABLE has `org' as its `:type' attribute."
 880   (let* ((attr (org-export-read-attribute :attr_man table))
 881          (caption (and (not (plist-get attr :disable-caption))
 882                        (org-man--caption/label-string table info)))
 883          (divider (if (plist-get attr :divider) "|" " "))
 884
 885          ;; Determine alignment string.
 886          (alignment (org-man-table--align-string divider table info))
 887          ;; Extract others display options.
 888
 889          (lines (org-split-string contents "\n"))
 890
 891          (attr-list
 892           (delq nil
 893                 (list
 894                  (and (plist-get attr :expand) "expand")
 895                  (let ((placement (plist-get attr :placement)))
 896                    (cond ((string= placement 'center) "center")
 897                          ((string= placement 'left) nil)
 898                          ((plist-get info :man-tables-centered) "center")
 899                          (t "")))
 900                  (or (plist-get attr :boxtype) "box"))))
 901
 902          (title-line  (plist-get attr :title-line))
 903          (long-cells (plist-get attr :long-cells))
 904
 905          (table-format (concat
 906                         (format "%s" (or (car attr-list) "" ))
 907                         (or
 908                          (let ((output-list '()))
 909                            (when (cdr attr-list)
 910                              (dolist (attr-item (cdr attr-list))
 911                                (setq output-list (concat output-list  (format ",%s" attr-item)))))
 912                            output-list)
 913                          "")))
 914
 915          (first-line (when lines (org-split-string (car lines) "\t"))))
 916     ;; Prepare the final format string for the table.
 917
 918
 919     (cond
 920      ;; Others.
 921      (lines (concat ".TS\n " table-format ";\n"
 922
 923                     (format "%s.\n"
 924                             (let ((final-line ""))
 925                               (when title-line
 926                                 (dotimes (_ (length first-line))
 927                                   (setq final-line (concat final-line "cb" divider))))
 928
 929                               (setq final-line (concat final-line "\n"))
 930
 931                               (if alignment
 932                                   (setq final-line (concat final-line alignment))
 933                                 (dotimes (_ (length first-line))
 934                                   (setq final-line (concat final-line "c" divider))))
 935                               final-line ))
 936
 937                     (format "%s.TE\n"
 938                             (let ((final-line "")
 939                                   (long-line "")
 940                                   (lines (org-split-string contents "\n")))
 941
 942                               (dolist (line-item lines)
 943                                 (setq long-line "")
 944
 945                                 (if long-cells
 946                                     (progn
 947                                       (if (string= line-item "_")
 948                                           (setq long-line (format "%s\n" line-item))
 949                                         ;; else string =
 950                                         (let ((cell-item-list (org-split-string line-item "\t")))
 951                                           (dolist (cell-item cell-item-list)
 952
 953                                             (cond  ((eq cell-item (car (last cell-item-list)))
 954                                                     (setq long-line (concat long-line
 955                                                                             (format "T{\n%s\nT}\t\n"  cell-item ))))
 956                                                    (t
 957                                                     (setq long-line (concat long-line
 958                                                                             (format "T{\n%s\nT}\t"  cell-item ))))))
 959                                           long-line))
 960                                       ;; else long cells
 961                                       (setq final-line (concat final-line long-line )))
 962
 963                                   (setq final-line (concat final-line line-item "\n"))))
 964                               final-line))
 965
 966                     (and caption (format ".TB \"%s\"" caption)))))))
 967
 968 ;;; Table Cell
 969
 970 (defun org-man-table-cell (table-cell contents info)
 971   "Transcode a TABLE-CELL element from Org to Man
 972 CONTENTS is the cell contents.  INFO is a plist used as
 973 a communication channel."
 974   (concat
 975    (let ((scientific-format (plist-get info :man-table-scientific-notation)))
 976      (if (and contents
 977               scientific-format
 978               (string-match orgtbl-exp-regexp contents))
 979          ;; Use appropriate format string for scientific notation.
 980          (format scientific-format
 981                  (match-string 1 contents)
 982                  (match-string 2 contents))
 983        contents))
 984    (when (org-export-get-next-element table-cell info) "\t")))
 985
 986
 987 ;;; Table Row
 988
 989 (defun org-man-table-row (table-row contents info)
 990   "Transcode a TABLE-ROW element from Org to Man.
 991 CONTENTS is the contents of the row.  INFO is a plist used as
 992 a communication channel."
 993   ;; Rules are ignored since table separators are deduced from borders
 994   ;; of the current row.
 995   (when (eq (org-element-property :type table-row) 'standard)
 996     (let ((borders
 997            ;; TABLE-ROW's borders are extracted from its first cell.
 998            (org-export-table-cell-borders
 999             (car (org-element-contents table-row)) info)))
1000       (concat
1001        (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
1002        contents
1003        (cond ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
1004              ((memq 'below borders) "\n_"))))))
1005
1006
1007 ;;; Target
1008
1009 (defun org-man-target (target _contents info)
1010   "Transcode a TARGET object from Org to Man.
1011 CONTENTS is nil.  INFO is a plist holding contextual
1012 information."
1013   (format "\\fI%s\\fP" (org-export-get-reference target info)))
1014
1015
1016 ;;; Timestamp
1017
1018 (defun org-man-timestamp (_timestamp _contents _info)
1019   "Transcode a TIMESTAMP object from Org to Man.
1020 CONTENTS is nil.  INFO is a plist holding contextual information."
1021   "")
1022
1023
1024 ;;; Underline
1025
1026 (defun org-man-underline (_underline contents _info)
1027   "Transcode UNDERLINE from Org to Man.
1028 CONTENTS is the text with underline markup.  INFO is a plist
1029 holding contextual information."
1030   (format "\\fI%s\\fP" contents))
1031
1032
1033 ;;; Verbatim
1034
1035 (defun org-man-verbatim (verbatim _contents _info)
1036   "Transcode a VERBATIM object from Org to Man."
1037   (format "\\fI%s\\fP"
1038           (org-man--protect-text (org-element-property :value verbatim))))
1039
1040
1041 ;;; Verse Block
1042
1043 (defun org-man-verse-block (_verse-block contents _info)
1044   "Transcode a VERSE-BLOCK element from Org to Man.
1045 CONTENTS is verse block contents. INFO is a plist holding
1046 contextual information."
1047   (format ".RS\n.ft I\n%s\n.ft\n.RE" contents))
1048
1049
1050 \f
1051 ;;; Interactive functions
1052
1053 (defun org-man-export-to-man
1054   (&optional async subtreep visible-only body-only ext-plist)
1055   "Export current buffer to a Man file.
1056
1057 If narrowing is active in the current buffer, only export its
1058 narrowed part.
1059
1060 If a region is active, export that region.
1061
1062 A non-nil optional argument ASYNC means the process should happen
1063 asynchronously.  The resulting file should be accessible through
1064 the `org-export-stack' interface.
1065
1066 When optional argument SUBTREEP is non-nil, export the sub-tree
1067 at point, extracting information from the headline properties
1068 first.
1069
1070 When optional argument VISIBLE-ONLY is non-nil, don't export
1071 contents of hidden elements.
1072
1073 When optional argument BODY-ONLY is non-nil, only the body
1074 without any markers.
1075
1076 EXT-PLIST, when provided, is a property list with external
1077 parameters overriding Org default settings, but still inferior to
1078 file-local settings.
1079
1080 Return output file's name."
1081   (interactive)
1082   (let ((outfile (org-export-output-file-name ".man" subtreep)))
1083     (org-export-to-file 'man outfile
1084       async subtreep visible-only body-only ext-plist)))
1085
1086 (defun org-man-export-to-pdf
1087   (&optional async subtreep visible-only body-only ext-plist)
1088   "Export current buffer to Groff then process through to PDF.
1089
1090 If narrowing is active in the current buffer, only export its
1091 narrowed part.
1092
1093 If a region is active, export that region.
1094
1095 A non-nil optional argument ASYNC means the process should happen
1096 asynchronously.  The resulting file should be accessible through
1097 the `org-export-stack' interface.
1098
1099 When optional argument SUBTREEP is non-nil, export the sub-tree
1100 at point, extracting information from the headline properties
1101 first.
1102
1103 When optional argument VISIBLE-ONLY is non-nil, don't export
1104 contents of hidden elements.
1105
1106 When optional argument BODY-ONLY is non-nil, only write between
1107 markers.
1108
1109 EXT-PLIST, when provided, is a property list with external
1110 parameters overriding Org default settings, but still inferior to
1111 file-local settings.
1112
1113 Return PDF file's name."
1114   (interactive)
1115   (let ((outfile (org-export-output-file-name ".man" subtreep)))
1116     (org-export-to-file 'man outfile
1117       async subtreep visible-only body-only ext-plist
1118       (lambda (file) (org-latex-compile file)))))
1119
1120 (defun org-man-compile (file)
1121   "Compile a Groff file.
1122
1123 FILE is the name of the file being compiled.  Processing is done
1124 through the command specified in `org-man-pdf-process'.
1125
1126 Return PDF file name or an error if it couldn't be produced."
1127   (message "Processing Groff file %s..." file)
1128   (let ((output (org-compile-file file org-man-pdf-process "pdf")))
1129     (when org-man-remove-logfiles
1130       (let ((base (file-name-sans-extension output)))
1131         (dolist (ext org-man-logfiles-extensions)
1132           (let ((file (concat base "." ext)))
1133             (when (file-exists-p file) (delete-file file))))))
1134     (message "Process completed.")
1135     output))
1136
1137 (provide 'ox-man)
1138
1139 ;; Local variables:
1140 ;; generated-autoload-file: "org-loaddefs.el"
1141 ;; End:
1142
1143 ;;; ox-man.el ends here