.emacs.d.git - Gitblit

Chizi123

2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d

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