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