diff options
Diffstat (limited to 'lisp/ox-man.el')
| -rw-r--r-- | lisp/ox-man.el | 1273 |
1 files changed, 1273 insertions, 0 deletions
diff --git a/lisp/ox-man.el b/lisp/ox-man.el new file mode 100644 index 0000000..b99a464 --- /dev/null +++ b/lisp/ox-man.el @@ -0,0 +1,1273 @@ +;; ox-man.el --- Man Back-End for Org Export Engine + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Luis R Anaya <papoanaya aroba hot mail punto com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This library implements a Man back-end for Org generic exporter. +;; +;; To test it, run +;; +;; M-: (org-export-to-buffer 'man "*Test Man*") RET +;; +;; in an org-mode buffer then switch to the buffer to see the Man +;; export. See ox.el for more details on how this exporter works. +;; +;; It introduces one new buffer keywords: +;; "MAN_CLASS_OPTIONS". + +;;; Code: + +(require 'ox) + +(eval-when-compile (require 'cl)) + +(defvar org-export-man-default-packages-alist) +(defvar org-export-man-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'man + '((babel-call . org-man-babel-call) + (bold . org-man-bold) + (center-block . org-man-center-block) + (clock . org-man-clock) + (code . org-man-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-man-drawer) + (dynamic-block . org-man-dynamic-block) + (entity . org-man-entity) + (example-block . org-man-example-block) + (export-block . org-man-export-block) + (export-snippet . org-man-export-snippet) + (fixed-width . org-man-fixed-width) + (footnote-definition . org-man-footnote-definition) + (footnote-reference . org-man-footnote-reference) + (headline . org-man-headline) + (horizontal-rule . org-man-horizontal-rule) + (inline-babel-call . org-man-inline-babel-call) + (inline-src-block . org-man-inline-src-block) + (inlinetask . org-man-inlinetask) + (italic . org-man-italic) + (item . org-man-item) + (keyword . org-man-keyword) + (line-break . org-man-line-break) + (link . org-man-link) + (paragraph . org-man-paragraph) + (plain-list . org-man-plain-list) + (plain-text . org-man-plain-text) + (planning . org-man-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-man-quote-block) + (quote-section . org-man-quote-section) + (radio-target . org-man-radio-target) + (section . org-man-section) + (special-block . org-man-special-block) + (src-block . org-man-src-block) + (statistics-cookie . org-man-statistics-cookie) + (strike-through . org-man-strike-through) + (subscript . org-man-subscript) + (superscript . org-man-superscript) + (table . org-man-table) + (table-cell . org-man-table-cell) + (table-row . org-man-table-row) + (target . org-man-target) + (template . org-man-template) + (timestamp . org-man-timestamp) + (underline . org-man-underline) + (verbatim . org-man-verbatim) + (verse-block . org-man-verse-block)) + :export-block "MAN" + :menu-entry + '(?m "Export to MAN" + ((?m "As MAN file" org-man-export-to-man) + (?p "As PDF file" org-man-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-man-export-to-pdf t s v b) + (org-open-file (org-man-export-to-pdf nil s v b))))))) + :options-alist + '((:man-class "MAN_CLASS" nil nil t) + (:man-class-options "MAN_CLASS_OPTIONS" nil nil t) + (:man-header-extra "MAN_HEADER" nil nil newline))) + + + +;;; User Configurable Variables + +(defgroup org-export-man nil + "Options for exporting Org mode files to Man." + :tag "Org Export Man" + :group 'org-export) + +;;; Tables + +(defcustom org-man-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-man-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-table-scientific-notation "%sE%s" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e. \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + + +;;; Inlinetasks +;; Src blocks + +(defcustom org-man-source-highlight nil + "Use GNU source highlight to embellish source blocks " + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-source-highlight-langs + '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") + (scheme "scheme") + (c "c") (cc "cpp") (csharp "csharp") (d "d") + (fortran "fortran") (cobol "cobol") (pascal "pascal") + (ada "ada") (asm "asm") + (perl "perl") (cperl "perl") + (python "python") (ruby "ruby") (tcl "tcl") (lua "lua") + (java "java") (javascript "javascript") + (tex "latex") + (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4") + (ocaml "caml") (caml "caml") + (sql "sql") (sqlite "sql") + (html "html") (css "css") (xml "xml") + (bat "bat") (bison "bison") (clipper "clipper") + (ldap "ldap") (opa "opa") + (php "php") (postscript "postscript") (prolog "prolog") + (properties "properties") (makefile "makefile") + (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + + + +(defvar org-man-custom-lang-environments nil + "Alist mapping languages to language-specific Man environments. + +It is used during export of src blocks by the listings and +man packages. For example, + + \(setq org-man-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during man export." +) + + +;;; Compilation + +(defcustom org-man-pdf-process + '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf") + + "Commands to process a Man file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + + +By default, Org uses 3 runs of to do the processing. + +Alternatively, this may be a Lisp function that does the +processing. This function should accept the file name as +its single argument." + :group 'org-export-pdf + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" )) + (const :tag "3 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) + (function))) + +(defcustom org-man-logfiles-extensions + '("log" "out" "toc") + "The list of file extensions to consider as Man logfiles." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat (string :tag "Extension"))) + +(defcustom org-man-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +These are the .aux, .log, .out, and .toc files." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Internal Functions + +(defun org-man--caption/label-string (element info) + "Return caption and label Man string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-man--wrap-label'." + (let ((label (org-element-property :label element)) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t))) + (cond ((and (not main) (not label)) "") + ((not main) (format "\\fI%s\\fP" label)) + ;; Option caption format with short name. + (short (format "\\fR%s\\fP - \\fI\\P - %s\n" + (org-export-data short info) + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\fR%s\\fP" (org-export-data main info)))))) + +(defun org-man--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-man--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (or (not output) (not label) (string= output "") (string= label "")) + output + (concat (format "%s\n.br\n" label) output)))) + + + +;;; Template + +(defun org-man-template (contents info) + "Return complete document string after Man conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let* ((title (org-export-data (plist-get info :title) info)) + (attr (read (format "(%s)" + (mapconcat + #'identity + (list (plist-get info :man-class-options)) + " ")))) + (section-item (plist-get attr :section-id))) + + (concat + + (cond + ((and title (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" title section-item)) + ((and (string= "" title) (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" " " section-item)) + (title + (format ".TH \"%s\" \"1\" \n" title)) + (t + ".TH \" \" \"1\" ")) + contents))) + + + + +;;; Transcode Functions + +;;; Babel Call +;; +;; Babel Calls are ignored. + + +;;; Bold + +(defun org-man-bold (bold contents info) + "Transcode BOLD from Org to Man. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "\\fB%s\\fP" contents)) + + +;;; Center Block + +(defun org-man-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Man. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-man--wrap-label + center-block + (format ".ce %d\n.nf\n%s\n.fi" + (- (length (split-string contents "\n")) 1 ) + contents))) + + +;;; Clock + +(defun org-man-clock (clock contents info) + "Transcode a CLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + "" ) + + +;;; Code + +(defun org-man-code (code contents info) + "Transcode a CODE object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\\fC%s\\fP" code)) + + +;;; Comment +;; +;; Comments are ignored. + + +;;; Comment Block +;; +;; Comment Blocks are ignored. + + +;;; Drawer + +(defun org-man-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Man. + DRAWER holds the drawer information + CONTENTS holds the contents of the block. + INFO is a plist holding contextual information. " + contents) + + +;;; Dynamic Block + +(defun org-man-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-man--wrap-label dynamic-block contents)) + + +;;; Entity + +(defun org-man-entity (entity contents info) + "Transcode an ENTITY object from Org to Man. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;; Example Block + +(defun org-man-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (org-man--wrap-label + example-block + (format ".RS\n.nf\n%s\n.fi\n.RE" + (org-export-format-code-default example-block info)))) + + +;;; Export Block + +(defun org-man-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "MAN") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;; Export Snippet + +(defun org-man-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'man) + (org-element-property :value export-snippet))) + + +;;; Fixed Width + +(defun org-man-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-man--wrap-label + fixed-width + (format "\\fC\n%s\\fP" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;; Footnote Definition +;; +;; Footnote Definitions are ignored. + +;;; Footnote References +;; +;; Footnote References are Ignored + + +;;; Headline + +(defun org-man-headline (headline contents info) + "Transcode a HEADLINE element from Org to Man. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (case level + (1 ".SH \"%s\"\n%s") + (2 ".SS \"%s\"\n%s") + (3 ".SS \"%s\"\n%s") + (t nil))) + (text (org-export-data (org-element-property :title headline) info))) + + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((or (not section-fmt) (org-export-low-level-p headline info)) + ;; Build the real contents of the sub-tree. + (let ((low-level-body + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "%s\n" ".RS")) + ;; Itemize headline + ".TP\n.ft I\n" text "\n.ft\n" + contents ".RE"))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" "" + low-level-body)))) + + ;; Case 3. Standard headline. Export it as a section. + (t (format section-fmt text contents ))))) + +;;; Horizontal Rule +;; Not supported + +;;; Inline Babel Call +;; +;; Inline Babel Calls are ignored. + +;;; Inline Src Block + +(defun org-man-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block))) + (cond + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + (org-lang (org-element-property :language inline-src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat (expand-file-name "source-highlight") + " -s " lst-lang + " -f groff_man" + " -i " in-file + " -o " out-file ))) + + (if lst-lang + (let ((code-block "" )) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n" + code)))) + + ;; Do not use a special package: transcode it verbatim. + (t + (concat ".RS\n.nf\n" "\\fC" "\n" code "\n" + "\\fP\n.fi\n.RE\n"))))) + + +;;; Inlinetask +;;; Italic + +(defun org-man-italic (italic contents info) + "Transcode ITALIC from Org to Man. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Item + + +(defun org-man-item (item contents info) + + "Transcode an ITEM element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + + (let* ((bullet (org-element-property :bullet item)) + (type (org-element-property :type (org-element-property :parent item))) + (checkbox (case (org-element-property :checkbox item) + (on "\\o'\\(sq\\(mu'") ;; + (off "\\(sq ") ;; + (trans "\\o'\\(sq\\(mi'" ))) ;; + + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "\\fB%s\\fP" + (concat checkbox + (org-export-data tag info))))))) + + (if (and (null tag ) + (null checkbox)) + (let* ((bullet (org-trim bullet)) + (marker (cond ((string= "-" bullet) "\\(em") + ((string= "*" bullet) "\\(bu") + ((eq type 'ordered) + (format "%s " (org-trim bullet))) + (t "\\(dg")))) + (concat ".IP " marker " 4\n" + (org-trim (or contents " " )))) + ; else + (concat ".TP\n" (or tag (concat " " checkbox)) "\n" + (org-trim (or contents " " )))))) + +;;; Keyword + + +(defun org-man-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "MAN") value) + ((string= key "INDEX") nil) + ((string= key "TOC" ) nil)))) + + +;;; Line Break + +(defun org-man-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + ".br\n") + + +;;; Link + + +(defun org-man-link (link desc info) + "Transcode a LINK object from Org to Man. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (when (string-match "\\(.+\\)::.+" raw-path) + (setq raw-path (match-string 1 raw-path))) + (if (file-name-absolute-p raw-path) + (concat "file://" (expand-file-name raw-path)) + (concat "file://" raw-path))) + (t raw-path))) + protocol) + (cond + ;; External link with a description part. + ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) + ;; External link without a description part. + (path (format "\\fI%s\\fP" path)) + ;; No path, only description. Try to do something useful. + (t (format "\\fI%s\\fP" desc))))) + + +;;; Paragraph + +(defun org-man-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Man. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let ((parent (plist-get (nth 1 paragraph) :parent))) + (when parent + (let ((parent-type (car parent)) + (fixed-paragraph "")) + (cond ((and (eq parent-type 'item) + (plist-get (nth 1 parent) :bullet )) + (setq fixed-paragraph (concat "" contents))) + ((eq parent-type 'section) + (setq fixed-paragraph (concat ".PP\n" contents))) + ((eq parent-type 'footnote-definition) + (setq fixed-paragraph contents)) + (t (setq fixed-paragraph (concat "" contents)))) + fixed-paragraph )))) + + +;;; Plain List + +(defun org-man-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Man. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + contents) + +;;; Plain Text + +(defun org-man-plain-text (text info) + "Transcode a TEXT string from Org to Man. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect various chars. + (setq output (replace-regexp-in-string + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\" output nil t 1)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" + output))) + ;; Return value. + output)) + + + +;;; Planning + + +;;; Property Drawer + + +;;; Quote Block + +(defun org-man-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-man--wrap-label + quote-block + (format ".RS\n%s\n.RE" contents))) + +;;; Quote Section + +(defun org-man-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format ".RS\\fI%s\\fP\n.RE\n" value)))) + + +;;; Radio Target + +(defun org-man-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Man. +TEXT is the text of the target. INFO is a plist holding +contextual information." + text ) + + +;;; Section + +(defun org-man-section (section contents info) + "Transcode a SECTION element from Org to Man. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;; Special Block + +(defun org-man-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block)))) + (org-man--wrap-label + special-block + (format "%s\n" contents)))) + + +;;; Src Block + +(defun org-man-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (code (org-element-property :value src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-man-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block))) + (cond + ;; Case 1. No source fontification. + ((not org-man-source-highlight) + (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" + (org-export-format-code-default src-block info))) + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + + (org-lang (org-element-property :language src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_man " + " -i " in-file + " -o " out-file))) + + (if lst-lang + (let ((code-block "")) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))) + + +;;; Statistics Cookie + +(defun org-man-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;; Strike-Through + +(defun org-man-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to Man. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + +;;; Subscript + +(defun org-man-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\d\\s-2%s\\s+2\\u" contents)) + +;;; Superscript "^_%s$ + +(defun org-man-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\u\\s-2%s\\s+2\\d" contents)) + + +;;; Table +;; +;; `org-man-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" attribute. Otherwise, it +;; delegates the job to either `org-man-table--table.el-table' or +;; `org-man-table--org-table' functions, depending of the type of +;; the table. +;; +;; `org-man-table--align-string' is a subroutine used to build +;; alignment string for Org tables. + +(defun org-man-table (table contents info) + "Transcode a TABLE element from Org to Man. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (cond + ;; Case 1: verbatim table. + ((or org-man-tables-verbatim + (let ((attr (read (format "(%s)" + (mapconcat + #'identity + (org-element-property :attr_man table) + " "))))) + + (and attr (plist-get attr :verbatim)))) + + (format ".nf\n\\fC%s\\fP\n.fi" + ;; Re-create table, without affiliated keywords. + (org-trim + (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Standard table. + (t (org-man-table--org-table table contents info)))) + +(defun org-man-table--align-string (divider table info) + "Return an appropriate Man alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (let (alignment) + ;; Extract column groups and alignment from first (non-rule) row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let* ((borders (org-export-table-cell-borders cell info)) + (raw-width (org-export-table-cell-width cell info)) + (width-cm (when raw-width (/ raw-width 5))) + (width (if raw-width (format "w(%dc)" + (if (< width-cm 1) 1 width-cm)) ""))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not alignment)) + (push "|" alignment)) + (push + (case (org-export-table-cell-alignment cell info) + (left (concat "l" width divider)) + (right (concat "r" width divider)) + (center (concat "c" width divider))) + alignment) + (when (memq 'right borders) (push "|" alignment)))) + info) + (apply 'concat (reverse alignment)))) + +(defun org-man-table--org-table (table contents info) + "Return appropriate Man code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' attribute." + (let* ((attr (org-export-read-attribute :attr_man table)) + (label (org-element-property :name table)) + (caption (and (not (plist-get attr :disable-caption)) + (org-man--caption/label-string table info))) + (divider (if (plist-get attr :divider) "|" " ")) + + ;; Determine alignment string. + (alignment (org-man-table--align-string divider table info)) + ;; Extract others display options. + + (lines (org-split-string contents "\n")) + + (attr-list + (delq nil + (list + (and (plist-get attr :expand) "expand") + (let ((placement (plist-get attr :placement))) + (cond ((string= placement 'center) "center") + ((string= placement 'left) nil) + (t (if org-man-tables-centered "center" "")))) + (or (plist-get attr :boxtype) "box")))) + + (title-line (plist-get attr :title-line)) + (long-cells (plist-get attr :long-cells)) + + (table-format (concat + (format "%s" (or (car attr-list) "" )) + (or + (let ((output-list '())) + (when (cdr attr-list) + (dolist (attr-item (cdr attr-list)) + (setq output-list (concat output-list (format ",%s" attr-item))))) + output-list) + ""))) + + (first-line (when lines (org-split-string (car lines) "\t")))) + ;; Prepare the final format string for the table. + + + (cond + ;; Others. + (lines (concat ".TS\n " table-format ";\n" + + (format "%s.\n" + (let ((final-line "")) + (when title-line + (dotimes (i (length first-line)) + (setq final-line (concat final-line "cb" divider)))) + + (setq final-line (concat final-line "\n")) + + (if alignment + (setq final-line (concat final-line alignment)) + (dotimes (i (length first-line)) + (setq final-line (concat final-line "c" divider)))) + final-line )) + + (format "%s.TE\n" + (let ((final-line "") + (long-line "") + (lines (org-split-string contents "\n"))) + + (dolist (line-item lines) + (setq long-line "") + + (if long-cells + (progn + (if (string= line-item "_") + (setq long-line (format "%s\n" line-item)) + ;; else string = + (let ((cell-item-list (org-split-string line-item "\t"))) + (dolist (cell-item cell-item-list) + + (cond ((eq cell-item (car (last cell-item-list))) + (setq long-line (concat long-line + (format "T{\n%s\nT}\t\n" cell-item )))) + (t + (setq long-line (concat long-line + (format "T{\n%s\nT}\t" cell-item )))))) + long-line)) + ;; else long cells + (setq final-line (concat final-line long-line ))) + + (setq final-line (concat final-line line-item "\n")))) + final-line)) + + (and caption (format ".TB \"%s\"" caption))))))) + +;;; Table Cell + +(defun org-man-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Man +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-man-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-man-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents ) + (when (org-export-get-next-element table-cell info) "\t"))) + + +;;; Table Row + +(defun org-man-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Man +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (mapconcat 'identity + (org-element-property + :attr_man (org-export-get-parent table-row)) + " ")) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders + (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; Mark horizontal lines + (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) + contents + + (cond + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and (memq 'bottom borders) (memq 'below borders)) "\n_") + ((memq 'below borders) "\n_")))))) + + +;;; Target + +(defun org-man-target (target contents info) + "Transcode a TARGET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\fI%s\\fP" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;; Timestamp + +(defun org-man-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Man. + CONTENTS is nil. INFO is a plist holding contextual + information." + "" ) + + +;;; Underline + +(defun org-man-underline (underline contents info) + "Transcode UNDERLINE from Org to Man. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Verbatim + +(defun org-man-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format ".nf\n%s\n.fi" contents)) + + +;;; Verse Block + +(defun org-man-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Man. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (format ".RS\n.ft I\n%s\n.ft\n.RE" contents)) + + + +;;; Interactive functions + +(defun org-man-export-to-man + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a Man file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only the body +without any markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'man)) + `(expand-file-name + (org-export-to-file + 'man ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) + (org-export-to-file + 'man outfile subtreep visible-only body-only ext-plist)))) + +(defun org-man-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to Groff then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write between +markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (if async + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'man)) + `(expand-file-name + (org-man-compile + (org-export-to-file + 'man ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist))))) + (org-man-compile + (org-man-export-to-man nil subtreep visible-only body-only ext-plist)))) + +(defun org-man-compile (file) + "Compile a Groff file. + +FILE is the name of the file being compiled. Processing is done +through the command specified in `org-man-pdf-process'. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p file) + (file-name-directory full-name) + default-directory)) + errors) + (message (format "Processing Groff file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-man-pdf-process) + (funcall org-man-pdf-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF Groff Output*" buffer. + ((consp org-man-pdf-process) + (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-man-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-man-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-man-remove-logfiles + (dolist (ext org-man-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-man-collect-errors (buffer) + "Collect some kind of errors from \"groff\" output +BUFFER is the buffer containing output. +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + ;; Find final run + nil ))) + + +(provide 'ox-man) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-man.el ends here |