Merge branch 'maint'
[org-mode.git] / lisp / ox-man.el
blobdf99602eaf297c3a696f0cb701693e7ef6b8fe81
1 ;; ox-man.el --- Man Back-End for Org Export Engine
3 ;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
6 ;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;;
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; This library implements a Man back-end for Org generic exporter.
27 ;; To test it, run
29 ;; M-: (org-export-to-buffer 'man "*Test Man*") RET
31 ;; in an org-mode buffer then switch to the buffer to see the Man
32 ;; export. See ox.el for more details on how this exporter works.
34 ;; It introduces one new buffer keywords:
35 ;; "MAN_CLASS_OPTIONS".
37 ;;; Code:
39 (require 'ox)
41 (eval-when-compile (require 'cl))
43 (defvar org-export-man-default-packages-alist)
44 (defvar org-export-man-packages-alist)
45 (defvar orgtbl-exp-regexp)
49 ;;; Define Back-End
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 (clock . org-man-clock)
56 (code . org-man-code)
57 (comment . org-man-comment)
58 (comment-block . org-man-comment-block)
59 (drawer . org-man-drawer)
60 (dynamic-block . org-man-dynamic-block)
61 (entity . org-man-entity)
62 (example-block . org-man-example-block)
63 (export-block . org-man-export-block)
64 (export-snippet . org-man-export-snippet)
65 (fixed-width . org-man-fixed-width)
66 (footnote-definition . org-man-footnote-definition)
67 (footnote-reference . org-man-footnote-reference)
68 (headline . org-man-headline)
69 (horizontal-rule . org-man-horizontal-rule)
70 (inline-babel-call . org-man-inline-babel-call)
71 (inline-src-block . org-man-inline-src-block)
72 (inlinetask . org-man-inlinetask)
73 (italic . org-man-italic)
74 (item . org-man-item)
75 (keyword . org-man-keyword)
76 (line-break . org-man-line-break)
77 (link . org-man-link)
78 (paragraph . org-man-paragraph)
79 (plain-list . org-man-plain-list)
80 (plain-text . org-man-plain-text)
81 (planning . org-man-planning)
82 (property-drawer . org-man-property-drawer)
83 (quote-block . org-man-quote-block)
84 (quote-section . org-man-quote-section)
85 (radio-target . org-man-radio-target)
86 (section . org-man-section)
87 (special-block . org-man-special-block)
88 (src-block . org-man-src-block)
89 (statistics-cookie . org-man-statistics-cookie)
90 (strike-through . org-man-strike-through)
91 (subscript . org-man-subscript)
92 (superscript . org-man-superscript)
93 (table . org-man-table)
94 (table-cell . org-man-table-cell)
95 (table-row . org-man-table-row)
96 (target . org-man-target)
97 (template . org-man-template)
98 (timestamp . org-man-timestamp)
99 (underline . org-man-underline)
100 (verbatim . org-man-verbatim)
101 (verse-block . org-man-verse-block))
102 :export-block "MAN"
103 :menu-entry
104 (?m "Export to MAN"
105 ((?m "As MAN file" org-man-export-to-man)
106 (?p "As PDF file" org-man-export-to-pdf)
107 (?o "As PDF file and open"
108 (lambda (a s v b)
109 (if a (org-man-export-to-pdf t s v b)
110 (org-open-file (org-man-export-to-pdf nil s v b)))))))
111 :options-alist
112 ((:man-class "MAN_CLASS" nil nil t)
113 (:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
114 (:man-header-extra "MAN_HEADER" nil nil newline)))
118 ;;; User Configurable Variables
120 (defgroup org-export-man nil
121 "Options for exporting Org mode files to Man."
122 :tag "Org Export Man"
123 :group 'org-export)
125 ;;; Tables
127 (defcustom org-man-tables-centered t
128 "When non-nil, tables are exported in a center environment."
129 :group 'org-export-man
130 :type 'boolean)
132 (defcustom org-man-tables-verbatim nil
133 "When non-nil, tables are exported verbatim."
134 :group 'org-export-man
135 :type 'boolean)
138 (defcustom org-man-table-scientific-notation "%sE%s"
139 "Format string to display numbers in scientific notation.
140 The format should have \"%s\" twice, for mantissa and exponent
141 \(i.e. \"%s\\\\times10^{%s}\").
143 When nil, no transformation is made."
144 :group 'org-export-man
145 :type '(choice
146 (string :tag "Format string")
147 (const :tag "No formatting")))
150 ;;; Inlinetasks
151 ;; Src blocks
153 (defcustom org-man-source-highlight nil
154 "Use GNU source highlight to embellish source blocks "
155 :group 'org-export-man
156 :type 'boolean)
159 (defcustom org-man-source-highlight-langs
160 '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
161 (scheme "scheme")
162 (c "c") (cc "cpp") (csharp "csharp") (d "d")
163 (fortran "fortran") (cobol "cobol") (pascal "pascal")
164 (ada "ada") (asm "asm")
165 (perl "perl") (cperl "perl")
166 (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
167 (java "java") (javascript "javascript")
168 (tex "latex")
169 (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
170 (ocaml "caml") (caml "caml")
171 (sql "sql") (sqlite "sql")
172 (html "html") (css "css") (xml "xml")
173 (bat "bat") (bison "bison") (clipper "clipper")
174 (ldap "ldap") (opa "opa")
175 (php "php") (postscript "postscript") (prolog "prolog")
176 (properties "properties") (makefile "makefile")
177 (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
178 "Alist mapping languages to their listing language counterpart.
179 The key is a symbol, the major mode symbol without the \"-mode\".
180 The value is the string that should be inserted as the language
181 parameter for the listings package. If the mode name and the
182 listings name are the same, the language does not need an entry
183 in this list - but it does not hurt if it is present."
184 :group 'org-export-man
185 :type '(repeat
186 (list
187 (symbol :tag "Major mode ")
188 (string :tag "Listings language"))))
192 (defvar org-man-custom-lang-environments nil
193 "Alist mapping languages to language-specific Man environments.
195 It is used during export of src blocks by the listings and
196 man packages. For example,
198 \(setq org-man-custom-lang-environments
199 '\(\(python \"pythoncode\"\)\)\)
201 would have the effect that if org encounters begin_src python
202 during man export."
206 ;;; Compilation
208 (defcustom org-man-pdf-process
209 '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
210 "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
211 "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
213 "Commands to process a Man file to a PDF file.
214 This is a list of strings, each of them will be given to the
215 shell as a command. %f in the command will be replaced by the
216 full file name, %b by the file base name (i.e. without directory
217 and extension parts) and %o by the base directory of the file.
220 By default, Org uses 3 runs of to do the processing.
222 Alternatively, this may be a Lisp function that does the
223 processing. This function should accept the file name as
224 its single argument."
225 :group 'org-export-pdf
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)))
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 :type '(repeat (string :tag "Extension")))
244 (defcustom org-man-remove-logfiles t
245 "Non-nil means remove the logfiles produced by PDF production.
246 These are the .aux, .log, .out, and .toc files."
247 :group 'org-export-man
248 :type 'boolean)
252 ;;; Internal Functions
254 (defun org-man--caption/label-string (element info)
255 "Return caption and label Man string for ELEMENT.
257 INFO is a plist holding contextual information. If there's no
258 caption nor label, return the empty string.
260 For non-floats, see `org-man--wrap-label'."
261 (let ((label (org-element-property :label element))
262 (main (org-export-get-caption element))
263 (short (org-export-get-caption element t)))
264 (cond ((and (not main) (not label)) "")
265 ((not main) (format "\\fI%s\\fP" label))
266 ;; Option caption format with short name.
267 (short (format "\\fR%s\\fP - \\fI\\P - %s\n"
268 (org-export-data short info)
269 (org-export-data main info)))
270 ;; Standard caption format.
271 (t (format "\\fR%s\\fP" (org-export-data main info))))))
273 (defun org-man--wrap-label (element output)
274 "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
275 This function shouldn't be used for floats. See
276 `org-man--caption/label-string'."
277 (let ((label (org-element-property :name element)))
278 (if (or (not output) (not label) (string= output "") (string= label ""))
279 output
280 (concat (format "%s\n.br\n" label) output))))
284 ;;; Template
286 (defun org-man-template (contents info)
287 "Return complete document string after Man conversion.
288 CONTENTS is the transcoded contents string. INFO is a plist
289 holding export options."
290 (let* ((title (org-export-data (plist-get info :title) info))
291 (attr (read (format "(%s)"
292 (mapconcat
293 #'identity
294 (list (plist-get info :man-class-options))
295 " "))))
296 (section-item (plist-get attr :section-id)))
298 (concat
300 (cond
301 ((and title (stringp section-item))
302 (format ".TH \"%s\" \"%s\" \n" title section-item))
303 ((and (string= "" title) (stringp section-item))
304 (format ".TH \"%s\" \"%s\" \n" " " section-item))
305 (title
306 (format ".TH \"%s\" \"1\" \n" title))
308 ".TH \" \" \"1\" "))
309 contents)))
314 ;;; Transcode Functions
316 ;;; Babel Call
318 ;; Babel Calls are ignored.
321 ;;; Bold
323 (defun org-man-bold (bold contents info)
324 "Transcode BOLD from Org to Man.
325 CONTENTS is the text with bold markup. INFO is a plist holding
326 contextual information."
327 (format "\\fB%s\\fP" contents))
330 ;;; Center Block
332 (defun org-man-center-block (center-block contents info)
333 "Transcode a CENTER-BLOCK element from Org to Man.
334 CONTENTS holds the contents of the center block. INFO is a plist
335 holding contextual information."
336 (org-man--wrap-label
337 center-block
338 (format ".ce %d\n.nf\n%s\n.fi"
339 (- (length (split-string contents "\n")) 1 )
340 contents)))
343 ;;; Clock
345 (defun org-man-clock (clock contents info)
346 "Transcode a CLOCK element from Org to Man.
347 CONTENTS is nil. INFO is a plist holding contextual
348 information."
349 "" )
352 ;;; Code
354 (defun org-man-code (code contents info)
355 "Transcode a CODE object from Org to Man.
356 CONTENTS is nil. INFO is a plist used as a communication
357 channel."
358 (format "\\fC%s\\fP" code))
361 ;;; Comment
363 ;; Comments are ignored.
366 ;;; Comment Block
368 ;; Comment Blocks are ignored.
371 ;;; Drawer
373 (defun org-man-drawer (drawer contents info)
374 "Transcode a DRAWER element from Org to Man.
375 DRAWER holds the drawer information
376 CONTENTS holds the contents of the block.
377 INFO is a plist holding contextual information. "
378 contents)
381 ;;; Dynamic Block
383 (defun org-man-dynamic-block (dynamic-block contents info)
384 "Transcode a DYNAMIC-BLOCK element from Org to Man.
385 CONTENTS holds the contents of the block. INFO is a plist
386 holding contextual information. See `org-export-data'."
387 (org-man--wrap-label dynamic-block contents))
390 ;;; Entity
392 (defun org-man-entity (entity contents info)
393 "Transcode an ENTITY object from Org to Man.
394 CONTENTS are the definition itself. INFO is a plist holding
395 contextual information."
396 (org-element-property :utf-8 entity))
399 ;;; Example Block
401 (defun org-man-example-block (example-block contents info)
402 "Transcode an EXAMPLE-BLOCK element from Org to Man.
403 CONTENTS is nil. INFO is a plist holding contextual
404 information."
405 (org-man--wrap-label
406 example-block
407 (format ".RS\n.nf\n%s\n.fi\n.RE"
408 (org-export-format-code-default example-block info))))
411 ;;; Export Block
413 (defun org-man-export-block (export-block contents info)
414 "Transcode a EXPORT-BLOCK element from Org to Man.
415 CONTENTS is nil. INFO is a plist holding contextual information."
416 (when (string= (org-element-property :type export-block) "MAN")
417 (org-remove-indentation (org-element-property :value export-block))))
420 ;;; Export Snippet
422 (defun org-man-export-snippet (export-snippet contents info)
423 "Transcode a EXPORT-SNIPPET object from Org to Man.
424 CONTENTS is nil. INFO is a plist holding contextual information."
425 (when (eq (org-export-snippet-backend export-snippet) 'man)
426 (org-element-property :value export-snippet)))
429 ;;; Fixed Width
431 (defun org-man-fixed-width (fixed-width contents info)
432 "Transcode a FIXED-WIDTH element from Org to Man.
433 CONTENTS is nil. INFO is a plist holding contextual information."
434 (org-man--wrap-label
435 fixed-width
436 (format "\\fC\n%s\\fP"
437 (org-remove-indentation
438 (org-element-property :value fixed-width)))))
441 ;;; Footnote Definition
443 ;; Footnote Definitions are ignored.
445 ;;; Footnote References
447 ;; Footnote References are Ignored
450 ;;; Headline
452 (defun org-man-headline (headline contents info)
453 "Transcode an HEADLINE element from Org to Man.
454 CONTENTS holds the contents of the headline. INFO is a plist
455 holding contextual information."
456 (let* ((level (org-export-get-relative-level headline info))
457 (numberedp (org-export-numbered-headline-p headline info))
458 ;; Section formatting will set two placeholders: one for the
459 ;; title and the other for the contents.
460 (section-fmt
461 (case level
462 (1 ".SH \"%s\"\n%s")
463 (2 ".SS \"%s\"\n%s")
464 (3 ".SS \"%s\"\n%s")
465 (t nil)))
466 (text (org-export-data (org-element-property :title headline) info)))
468 (cond
469 ;; Case 1: This is a footnote section: ignore it.
470 ((org-element-property :footnote-section-p headline) nil)
472 ;; Case 2. This is a deep sub-tree: export it as a list item.
473 ;; Also export as items headlines for which no section
474 ;; format has been found.
475 ((or (not section-fmt) (org-export-low-level-p headline info))
476 ;; Build the real contents of the sub-tree.
477 (let ((low-level-body
478 (concat
479 ;; If the headline is the first sibling, start a list.
480 (when (org-export-first-sibling-p headline info)
481 (format "%s\n" ".RS"))
482 ;; Itemize headline
483 ".TP\n.ft I\n" text "\n.ft\n"
484 contents ".RE")))
485 ;; If headline is not the last sibling simply return
486 ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
487 ;; blank line.
488 (if (not (org-export-last-sibling-p headline info)) low-level-body
489 (replace-regexp-in-string
490 "[ \t\n]*\\'" ""
491 low-level-body))))
493 ;; Case 3. Standard headline. Export it as a section.
494 (t (format section-fmt text contents )))))
496 ;;; Horizontal Rule
497 ;; Not supported
499 ;;; Inline Babel Call
501 ;; Inline Babel Calls are ignored.
503 ;;; Inline Src Block
505 (defun org-man-inline-src-block (inline-src-block contents info)
506 "Transcode an INLINE-SRC-BLOCK element from Org to Man.
507 CONTENTS holds the contents of the item. INFO is a plist holding
508 contextual information."
509 (let* ((code (org-element-property :value inline-src-block)))
510 (cond
511 (org-man-source-highlight
512 (let* ((tmpdir (if (featurep 'xemacs)
513 temp-directory
514 temporary-file-directory ))
515 (in-file (make-temp-name
516 (expand-file-name "srchilite" tmpdir)))
517 (out-file (make-temp-name
518 (expand-file-name "reshilite" tmpdir)))
519 (org-lang (org-element-property :language inline-src-block))
520 (lst-lang (cadr (assq (intern org-lang)
521 org-man-source-highlight-langs)))
523 (cmd (concat (expand-file-name "source-highlight")
524 " -s " lst-lang
525 " -f groff_man"
526 " -i " in-file
527 " -o " out-file )))
529 (if lst-lang
530 (let ((code-block "" ))
531 (with-temp-file in-file (insert code))
532 (shell-command cmd)
533 (setq code-block (org-file-contents out-file))
534 (delete-file in-file)
535 (delete-file out-file)
536 code-block)
537 (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
538 code))))
540 ;; Do not use a special package: transcode it verbatim.
542 (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
543 "\\fP\n.fi\n.RE\n")))))
546 ;;; Inlinetask
547 ;;; Italic
549 (defun org-man-italic (italic contents info)
550 "Transcode ITALIC from Org to Man.
551 CONTENTS is the text with italic markup. INFO is a plist holding
552 contextual information."
553 (format "\\fI%s\\fP" contents))
556 ;;; Item
559 (defun org-man-item (item contents info)
561 "Transcode an ITEM element from Org to Man.
562 CONTENTS holds the contents of the item. INFO is a plist holding
563 contextual information."
565 (let* ((bullet (org-element-property :bullet item))
566 (type (org-element-property :type (org-element-property :parent item)))
567 (checkbox (case (org-element-property :checkbox item)
568 (on "\\o'\\(sq\\(mu'") ;;
569 (off "\\(sq ") ;;
570 (trans "\\o'\\(sq\\(mi'" ))) ;;
572 (tag (let ((tag (org-element-property :tag item)))
573 ;; Check-boxes must belong to the tag.
574 (and tag (format "\\fB%s\\fP"
575 (concat checkbox
576 (org-export-data tag info)))))))
578 (if (and (null tag )
579 (null checkbox))
580 (let* ((bullet (org-trim bullet))
581 (marker (cond ((string= "-" bullet) "\\(em")
582 ((string= "*" bullet) "\\(bu")
583 ((eq type 'ordered)
584 (format "%s " (org-trim bullet)))
585 (t "\\(dg"))))
586 (concat ".IP " marker " 4\n"
587 (org-trim (or contents " " ))))
588 ; else
589 (concat ".TP\n" (or tag (concat " " checkbox)) "\n"
590 (org-trim (or contents " " ))))))
592 ;;; Keyword
595 (defun org-man-keyword (keyword contents info)
596 "Transcode a KEYWORD element from Org to Man.
597 CONTENTS is nil. INFO is a plist holding contextual information."
598 (let ((key (org-element-property :key keyword))
599 (value (org-element-property :value keyword)))
600 (cond
601 ((string= key "MAN") value)
602 ((string= key "INDEX") nil)
603 ;; Invisible targets.
604 ((string= key "TARGET") nil)
605 ((string= key "TOC" ) nil))))
608 ;;; Line Break
610 (defun org-man-line-break (line-break contents info)
611 "Transcode a LINE-BREAK object from Org to Man.
612 CONTENTS is nil. INFO is a plist holding contextual information."
613 ".br\n")
616 ;;; Link
619 (defun org-man-link (link desc info)
620 "Transcode a LINK object from Org to Man.
622 DESC is the description part of the link, or the empty string.
623 INFO is a plist holding contextual information. See
624 `org-export-data'."
626 (let* ((type (org-element-property :type link))
627 (raw-path (org-element-property :path link))
628 ;; Ensure DESC really exists, or set it to nil.
629 (desc (and (not (string= desc "")) desc))
631 (path (cond
632 ((member type '("http" "https" "ftp" "mailto"))
633 (concat type ":" raw-path))
634 ((string= type "file")
635 (when (string-match "\\(.+\\)::.+" raw-path)
636 (setq raw-path (match-string 1 raw-path)))
637 (if (file-name-absolute-p raw-path)
638 (concat "file://" (expand-file-name raw-path))
639 (concat "file://" raw-path)))
640 (t raw-path)))
641 protocol)
642 (cond
643 ;; External link with a description part.
644 ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
645 ;; External link without a description part.
646 (path (format "\\fI%s\\fP" path))
647 ;; No path, only description. Try to do something useful.
648 (t (format "\\fI%s\\fP" desc)))))
651 ;;; Paragraph
653 (defun org-man-paragraph (paragraph contents info)
654 "Transcode a PARAGRAPH element from Org to Man.
655 CONTENTS is the contents of the paragraph, as a string. INFO is
656 the plist used as a communication channel."
657 (let ((parent (plist-get (nth 1 paragraph) :parent)))
658 (when parent
659 (let ((parent-type (car parent))
660 (fixed-paragraph ""))
661 (cond ((and (eq parent-type 'item)
662 (plist-get (nth 1 parent) :bullet ))
663 (setq fixed-paragraph (concat "" contents)))
664 ((eq parent-type 'section)
665 (setq fixed-paragraph (concat ".PP\n" contents)))
666 ((eq parent-type 'footnote-definition)
667 (setq fixed-paragraph contents))
668 (t (setq fixed-paragraph (concat "" contents))))
669 fixed-paragraph ))))
672 ;;; Plain List
674 (defun org-man-plain-list (plain-list contents info)
675 "Transcode a PLAIN-LIST element from Org to Man.
676 CONTENTS is the contents of the list. INFO is a plist holding
677 contextual information."
678 contents)
680 ;;; Plain Text
682 (defun org-man-plain-text (text info)
683 "Transcode a TEXT string from Org to Man.
684 TEXT is the string to transcode. INFO is a plist holding
685 contextual information."
686 (let ((output text))
687 ;; Protect various chars.
688 (setq output (replace-regexp-in-string
689 "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
690 "$\\" output nil t 1))
691 ;; Activate smart quotes. Be sure to provide original TEXT string
692 ;; since OUTPUT may have been modified.
693 (when (plist-get info :with-smart-quotes)
694 (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
695 ;; Handle break preservation if required.
696 (when (plist-get info :preserve-breaks)
697 (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n"
698 output)))
699 ;; Return value.
700 output))
704 ;;; Planning
707 ;;; Property Drawer
710 ;;; Quote Block
712 (defun org-man-quote-block (quote-block contents info)
713 "Transcode a QUOTE-BLOCK element from Org to Man.
714 CONTENTS holds the contents of the block. INFO is a plist
715 holding contextual information."
716 (org-man--wrap-label
717 quote-block
718 (format ".RS\n%s\n.RE" contents)))
720 ;;; Quote Section
722 (defun org-man-quote-section (quote-section contents info)
723 "Transcode a QUOTE-SECTION element from Org to Man.
724 CONTENTS is nil. INFO is a plist holding contextual information."
725 (let ((value (org-remove-indentation
726 (org-element-property :value quote-section))))
727 (when value (format ".RS\\fI%s\\fP\n.RE\n" value))))
730 ;;; Radio Target
732 (defun org-man-radio-target (radio-target text info)
733 "Transcode a RADIO-TARGET object from Org to Man.
734 TEXT is the text of the target. INFO is a plist holding
735 contextual information."
736 text )
739 ;;; Section
741 (defun org-man-section (section contents info)
742 "Transcode a SECTION element from Org to Man.
743 CONTENTS holds the contents of the section. INFO is a plist
744 holding contextual information."
745 contents)
748 ;;; Special Block
750 (defun org-man-special-block (special-block contents info)
751 "Transcode a SPECIAL-BLOCK element from Org to Man.
752 CONTENTS holds the contents of the block. INFO is a plist
753 holding contextual information."
754 (let ((type (downcase (org-element-property :type special-block))))
755 (org-man--wrap-label
756 special-block
757 (format "%s\n" contents))))
760 ;;; Src Block
762 (defun org-man-src-block (src-block contents info)
763 "Transcode a SRC-BLOCK element from Org to Man.
764 CONTENTS holds the contents of the item. INFO is a plist holding
765 contextual information."
766 (let* ((lang (org-element-property :language src-block))
767 (code (org-element-property :value src-block))
768 (custom-env (and lang
769 (cadr (assq (intern lang)
770 org-man-custom-lang-environments))))
771 (num-start (case (org-element-property :number-lines src-block)
772 (continued (org-export-get-loc src-block info))
773 (new 0)))
774 (retain-labels (org-element-property :retain-labels src-block)))
775 (cond
776 ;; Case 1. No source fontification.
777 ((not org-man-source-highlight)
778 (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
779 (org-export-format-code-default src-block info)))
780 (org-man-source-highlight
781 (let* ((tmpdir (if (featurep 'xemacs)
782 temp-directory
783 temporary-file-directory ))
785 (in-file (make-temp-name
786 (expand-file-name "srchilite" tmpdir)))
787 (out-file (make-temp-name
788 (expand-file-name "reshilite" tmpdir)))
790 (org-lang (org-element-property :language src-block))
791 (lst-lang (cadr (assq (intern org-lang)
792 org-man-source-highlight-langs)))
794 (cmd (concat "source-highlight"
795 " -s " lst-lang
796 " -f groff_man "
797 " -i " in-file
798 " -o " out-file)))
800 (if lst-lang
801 (let ((code-block ""))
802 (with-temp-file in-file (insert code))
803 (shell-command cmd)
804 (setq code-block (org-file-contents out-file))
805 (delete-file in-file)
806 (delete-file out-file)
807 code-block)
808 (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))))
811 ;;; Statistics Cookie
813 (defun org-man-statistics-cookie (statistics-cookie contents info)
814 "Transcode a STATISTICS-COOKIE object from Org to Man.
815 CONTENTS is nil. INFO is a plist holding contextual information."
816 (org-element-property :value statistics-cookie))
819 ;;; Strike-Through
821 (defun org-man-strike-through (strike-through contents info)
822 "Transcode STRIKE-THROUGH from Org to Man.
823 CONTENTS is the text with strike-through markup. INFO is a plist
824 holding contextual information."
825 (format "\\fI%s\\fP" contents))
827 ;;; Subscript
829 (defun org-man-subscript (subscript contents info)
830 "Transcode a SUBSCRIPT object from Org to Man.
831 CONTENTS is the contents of the object. INFO is a plist holding
832 contextual information."
833 (format "\\d\\s-2%s\\s+2\\u" contents))
835 ;;; Superscript "^_%s$
837 (defun org-man-superscript (superscript contents info)
838 "Transcode a SUPERSCRIPT object from Org to Man.
839 CONTENTS is the contents of the object. INFO is a plist holding
840 contextual information."
841 (format "\\u\\s-2%s\\s+2\\d" contents))
844 ;;; Table
846 ;; `org-man-table' is the entry point for table transcoding. It
847 ;; takes care of tables with a "verbatim" attribute. Otherwise, it
848 ;; delegates the job to either `org-man-table--table.el-table' or
849 ;; `org-man-table--org-table' functions, depending of the type of
850 ;; the table.
852 ;; `org-man-table--align-string' is a subroutine used to build
853 ;; alignment string for Org tables.
855 (defun org-man-table (table contents info)
856 "Transcode a TABLE element from Org to Man.
857 CONTENTS is the contents of the table. INFO is a plist holding
858 contextual information."
859 (cond
860 ;; Case 1: verbatim table.
861 ((or org-man-tables-verbatim
862 (let ((attr (read (format "(%s)"
863 (mapconcat
864 #'identity
865 (org-element-property :attr_man table)
866 " ")))))
868 (and attr (plist-get attr :verbatim))))
870 (format ".nf\n\\fC%s\\fP\n.fi"
871 ;; Re-create table, without affiliated keywords.
872 (org-trim
873 (org-element-interpret-data
874 `(table nil ,@(org-element-contents table))))))
875 ;; Case 2: Standard table.
876 (t (org-man-table--org-table table contents info))))
878 (defun org-man-table--align-string (divider table info)
879 "Return an appropriate Man alignment string.
880 TABLE is the considered table. INFO is a plist used as
881 a communication channel."
882 (let (alignment)
883 ;; Extract column groups and alignment from first (non-rule) row.
884 (org-element-map
885 (org-element-map table 'table-row
886 (lambda (row)
887 (and (eq (org-element-property :type row) 'standard) row))
888 info 'first-match)
889 'table-cell
890 (lambda (cell)
891 (let* ((borders (org-export-table-cell-borders cell info))
892 (raw-width (org-export-table-cell-width cell info))
893 (width-cm (when raw-width (/ raw-width 5)))
894 (width (if raw-width (format "w(%dc)"
895 (if (< width-cm 1) 1 width-cm)) "")))
896 ;; Check left border for the first cell only.
897 (when (and (memq 'left borders) (not alignment))
898 (push "|" alignment))
899 (push
900 (case (org-export-table-cell-alignment cell info)
901 (left (concat "l" width divider))
902 (right (concat "r" width divider))
903 (center (concat "c" width divider)))
904 alignment)
905 (when (memq 'right borders) (push "|" alignment))))
906 info)
907 (apply 'concat (reverse alignment))))
909 (defun org-man-table--org-table (table contents info)
910 "Return appropriate Man code for an Org table.
912 TABLE is the table type element to transcode. CONTENTS is its
913 contents, as a string. INFO is a plist used as a communication
914 channel.
916 This function assumes TABLE has `org' as its `:type' attribute."
917 (let* ((attr (org-export-read-attribute :attr_man table))
918 (label (org-element-property :name table))
919 (caption (and (not (plist-get attr :disable-caption))
920 (org-man--caption/label-string table info)))
921 (divider (if (plist-get attr :divider) "|" " "))
923 ;; Determine alignment string.
924 (alignment (org-man-table--align-string divider table info))
925 ;; Extract others display options.
927 (lines (org-split-string contents "\n"))
929 (attr-list
930 (let ((result-list '()))
931 (dolist (attr-item
932 (list
933 (if (plist-get attr :expand)
934 "expand" nil)
936 (case (plist-get attr :placement)
937 ('center "center")
938 ('left nil)
939 (t (if org-man-tables-centered "center" "")))
941 (case (plist-get attr :boxtype)
942 ('box "box")
943 ('doublebox "doublebox")
944 ('allbox "allbox")
945 ('none nil)
946 (t "box"))))
948 (if attr-item
949 (add-to-list 'result-list attr-item)))
950 result-list ))
953 (title-line (plist-get attr :title-line))
954 (long-cells (plist-get attr :long-cells))
956 (table-format (concat
957 (format "%s" (or (car attr-list) "" ))
959 (let ((output-list '()))
960 (when (cdr attr-list)
961 (dolist (attr-item (cdr attr-list))
962 (setq output-list (concat output-list (format ",%s" attr-item)))))
963 output-list)
964 "")))
966 (first-line (when lines (org-split-string (car lines) "\t"))))
967 ;; Prepare the final format string for the table.
970 (cond
971 ;; Others.
972 (lines (concat ".TS\n " table-format ";\n"
974 (format "%s.\n"
975 (let ((final-line ""))
976 (when title-line
977 (dotimes (i (length first-line))
978 (setq final-line (concat final-line "cb" divider))))
980 (setq final-line (concat final-line "\n"))
982 (if alignment
983 (setq final-line (concat final-line alignment))
984 (dotimes (i (length first-line))
985 (setq final-line (concat final-line "c" divider))))
986 final-line ))
988 (format "%s.TE\n"
989 (let ((final-line "")
990 (long-line "")
991 (lines (org-split-string contents "\n")))
993 (dolist (line-item lines)
994 (setq long-line "")
996 (if long-cells
997 (progn
998 (if (string= line-item "_")
999 (setq long-line (format "%s\n" line-item))
1000 ;; else string =
1001 (let ((cell-item-list (org-split-string line-item "\t")))
1002 (dolist (cell-item cell-item-list)
1004 (cond ((eq cell-item (car (last cell-item-list)))
1005 (setq long-line (concat long-line
1006 (format "T{\n%s\nT}\t\n" cell-item ))))
1008 (setq long-line (concat long-line
1009 (format "T{\n%s\nT}\t" cell-item ))))))
1010 long-line))
1011 ;; else long cells
1012 (setq final-line (concat final-line long-line )))
1014 (setq final-line (concat final-line line-item "\n"))))
1015 final-line))
1017 (and caption (format ".TB \"%s\"" caption)))))))
1019 ;;; Table Cell
1021 (defun org-man-table-cell (table-cell contents info)
1022 "Transcode a TABLE-CELL element from Org to Man
1023 CONTENTS is the cell contents. INFO is a plist used as
1024 a communication channel."
1025 (concat (if (and contents
1026 org-man-table-scientific-notation
1027 (string-match orgtbl-exp-regexp contents))
1028 ;; Use appropriate format string for scientific
1029 ;; notation.
1030 (format org-man-table-scientific-notation
1031 (match-string 1 contents)
1032 (match-string 2 contents))
1033 contents )
1034 (when (org-export-get-next-element table-cell info) "\t")))
1037 ;;; Table Row
1039 (defun org-man-table-row (table-row contents info)
1040 "Transcode a TABLE-ROW element from Org to Man
1041 CONTENTS is the contents of the row. INFO is a plist used as
1042 a communication channel."
1043 ;; Rules are ignored since table separators are deduced from
1044 ;; borders of the current row.
1045 (when (eq (org-element-property :type table-row) 'standard)
1046 (let* ((attr (mapconcat 'identity
1047 (org-element-property
1048 :attr_man (org-export-get-parent table-row))
1049 " "))
1050 ;; TABLE-ROW's borders are extracted from its first cell.
1051 (borders
1052 (org-export-table-cell-borders
1053 (car (org-element-contents table-row)) info)))
1054 (concat
1055 ;; Mark horizontal lines
1056 (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
1057 contents
1059 (cond
1060 ;; When BOOKTABS are activated enforce bottom rule even when
1061 ;; no hline was specifically marked.
1062 ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
1063 ((memq 'below borders) "\n_"))))))
1066 ;;; Target
1068 (defun org-man-target (target contents info)
1069 "Transcode a TARGET object from Org to Man.
1070 CONTENTS is nil. INFO is a plist holding contextual
1071 information."
1072 (format "\\fI%s\\fP"
1073 (org-export-solidify-link-text (org-element-property :value target))))
1076 ;;; Timestamp
1078 (defun org-man-timestamp (timestamp contents info)
1079 "Transcode a TIMESTAMP object from Org to Man.
1080 CONTENTS is nil. INFO is a plist holding contextual
1081 information."
1082 "" )
1085 ;;; Underline
1087 (defun org-man-underline (underline contents info)
1088 "Transcode UNDERLINE from Org to Man.
1089 CONTENTS is the text with underline markup. INFO is a plist
1090 holding contextual information."
1091 (format "\\fI%s\\fP" contents))
1094 ;;; Verbatim
1096 (defun org-man-verbatim (verbatim contents info)
1097 "Transcode a VERBATIM object from Org to Man.
1098 CONTENTS is nil. INFO is a plist used as a communication
1099 channel."
1100 (format ".nf\n%s\n.fi" contents))
1103 ;;; Verse Block
1105 (defun org-man-verse-block (verse-block contents info)
1106 "Transcode a VERSE-BLOCK element from Org to Man.
1107 CONTENTS is verse block contents. INFO is a plist holding
1108 contextual information."
1109 (format ".RS\n.ft I\n%s\n.ft\n.RE" contents))
1113 ;;; Interactive functions
1115 (defun org-man-export-to-man
1116 (&optional async subtreep visible-only body-only ext-plist)
1117 "Export current buffer to a Man file.
1119 If narrowing is active in the current buffer, only export its
1120 narrowed part.
1122 If a region is active, export that region.
1124 A non-nil optional argument ASYNC means the process should happen
1125 asynchronously. The resulting file should be accessible through
1126 the `org-export-stack' interface.
1128 When optional argument SUBTREEP is non-nil, export the sub-tree
1129 at point, extracting information from the headline properties
1130 first.
1132 When optional argument VISIBLE-ONLY is non-nil, don't export
1133 contents of hidden elements.
1135 When optional argument BODY-ONLY is non-nil, only the body
1136 without any markers.
1138 EXT-PLIST, when provided, is a property list with external
1139 parameters overriding Org default settings, but still inferior to
1140 file-local settings.
1142 Return output file's name."
1143 (interactive)
1144 (let ((outfile (org-export-output-file-name ".man" subtreep)))
1145 (if async
1146 (org-export-async-start
1147 (lambda (f) (org-export-add-to-stack f 'man))
1148 `(expand-file-name
1149 (org-export-to-file
1150 'man ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))
1151 (org-export-to-file
1152 'man outfile subtreep visible-only body-only ext-plist))))
1154 (defun org-man-export-to-pdf
1155 (&optional async subtreep visible-only body-only ext-plist)
1156 "Export current buffer to Groff then process through to PDF.
1158 If narrowing is active in the current buffer, only export its
1159 narrowed part.
1161 If a region is active, export that region.
1163 A non-nil optional argument ASYNC means the process should happen
1164 asynchronously. The resulting file should be accessible through
1165 the `org-export-stack' interface.
1167 When optional argument SUBTREEP is non-nil, export the sub-tree
1168 at point, extracting information from the headline properties
1169 first.
1171 When optional argument VISIBLE-ONLY is non-nil, don't export
1172 contents of hidden elements.
1174 When optional argument BODY-ONLY is non-nil, only write between
1175 markers.
1177 EXT-PLIST, when provided, is a property list with external
1178 parameters overriding Org default settings, but still inferior to
1179 file-local settings.
1181 Return PDF file's name."
1182 (interactive)
1183 (if async
1184 (let ((outfile (org-export-output-file-name ".man" subtreep)))
1185 (org-export-async-start
1186 (lambda (f) (org-export-add-to-stack f 'man))
1187 `(expand-file-name
1188 (org-man-compile
1189 (org-export-to-file
1190 'man ,outfile ,subtreep ,visible-only ,body-only
1191 ',ext-plist)))))
1192 (org-man-compile
1193 (org-man-export-to-man nil subtreep visible-only body-only ext-plist))))
1195 (defun org-man-compile (file)
1196 "Compile a Groff file.
1198 FILE is the name of the file being compiled. Processing is done
1199 through the command specified in `org-man-pdf-process'.
1201 Return PDF file name or an error if it couldn't be produced."
1202 (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
1203 (full-name (file-truename file))
1204 (out-dir (file-name-directory file))
1205 ;; Make sure `default-directory' is set to FILE directory,
1206 ;; not to whatever value the current buffer may have.
1207 (default-directory (file-name-directory full-name))
1208 errors)
1209 (message (format "Processing Groff file %s ..." file))
1210 (save-window-excursion
1211 (cond
1212 ;; A function is provided: Apply it.
1213 ((functionp org-man-pdf-process)
1214 (funcall org-man-pdf-process (shell-quote-argument file)))
1215 ;; A list is provided: Replace %b, %f and %o with appropriate
1216 ;; values in each command before applying it. Output is
1217 ;; redirected to "*Org PDF Groff Output*" buffer.
1218 ((consp org-man-pdf-process)
1219 (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
1220 (mapc
1221 (lambda (command)
1222 (shell-command
1223 (replace-regexp-in-string
1224 "%b" (shell-quote-argument base-name)
1225 (replace-regexp-in-string
1226 "%f" (shell-quote-argument full-name)
1227 (replace-regexp-in-string
1228 "%o" (shell-quote-argument out-dir) command t t) t t) t t)
1229 outbuf))
1230 org-man-pdf-process)
1231 ;; Collect standard errors from output buffer.
1232 (setq errors (org-man-collect-errors outbuf))))
1233 (t (error "No valid command to process to PDF")))
1234 (let ((pdffile (concat out-dir base-name ".pdf")))
1235 ;; Check for process failure. Provide collected errors if
1236 ;; possible.
1237 (if (not (file-exists-p pdffile))
1238 (error (concat (format "PDF file %s wasn't produced" pdffile)
1239 (when errors (concat ": " errors))))
1240 ;; Else remove log files, when specified, and signal end of
1241 ;; process to user, along with any error encountered.
1242 (when org-man-remove-logfiles
1243 (dolist (ext org-man-logfiles-extensions)
1244 (let ((file (concat out-dir base-name "." ext)))
1245 (when (file-exists-p file) (delete-file file)))))
1246 (message (concat "Process completed"
1247 (if (not errors) "."
1248 (concat " with errors: " errors)))))
1249 ;; Return output file name.
1250 pdffile))))
1252 (defun org-man-collect-errors (buffer)
1253 "Collect some kind of errors from \"groff\" output
1254 BUFFER is the buffer containing output.
1255 Return collected error types as a string, or nil if there was
1256 none."
1257 (with-current-buffer buffer
1258 (save-excursion
1259 (goto-char (point-max))
1260 ;; Find final run
1261 nil )))
1264 (provide 'ox-man)
1266 ;; Local variables:
1267 ;; generated-autoload-file: "org-loaddefs.el"
1268 ;; End:
1270 ;;; ox-man.el ends here