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