lisp/ox-man.el

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