diff options
| author | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
|---|---|---|
| committer | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
| commit | 7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch) | |
| tree | 24d0f1d2a9751ca8c063409fd2ab71478b296efb /contrib/lisp/org-e-groff.el | |
Imported Upstream version 7.9.2
Diffstat (limited to 'contrib/lisp/org-e-groff.el')
| -rw-r--r-- | contrib/lisp/org-e-groff.el | 2090 |
1 files changed, 2090 insertions, 0 deletions
diff --git a/contrib/lisp/org-e-groff.el b/contrib/lisp/org-e-groff.el new file mode 100644 index 0000000..756a818 --- /dev/null +++ b/contrib/lisp/org-e-groff.el @@ -0,0 +1,2090 @@ +;; org-e-groff.el --- Groff Back-End For Org Export Engine + +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Author: Luis R Anaya <papoanaya aroba hot mail punto com> +;; Keywords: outlines, hypermedia, calendar, wp +;; + +;; This program 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. + +;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. +;;; Commentary: +;; +;; This library implements a Groff Memorandum Macro back-end for +;; Org generic exporter. +;; +;; To test it, run +;; +;; M-: (org-export-to-buffer 'e-groff "*Test e-Groff*") RET +;; +;; in an org-mode buffer then switch to the buffer to see the Groff +;; export. See contrib/lisp/org-export.el for more details on how +;; this exporter works. +;; +;; It introduces two new buffer keywords: "GROFF_CLASS" and +;; "GROFF_CLASS_OPTIONS". + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defvar org-export-groff-default-packages-alist) +(defvar org-export-groff-packages-alist) + +(require 'org-export) + + +;;; Define Back-End + +(defvar org-e-groff-translate-alist + '((babel-call . org-e-groff-babel-call) + (bold . org-e-groff-bold) + (center-block . org-e-groff-center-block) + (clock . org-e-groff-clock) + (code . org-e-groff-code) + (comment . org-e-groff-comment) + (comment-block . org-e-groff-comment-block) + (drawer . org-e-groff-drawer) + (dynamic-block . org-e-groff-dynamic-block) + (entity . org-e-groff-entity) + (example-block . org-e-groff-example-block) + (export-block . org-e-groff-export-block) + (export-snippet . org-e-groff-export-snippet) + (fixed-width . org-e-groff-fixed-width) + (footnote-definition . org-e-groff-footnote-definition) + (footnote-reference . org-e-groff-footnote-reference) + (headline . org-e-groff-headline) + (horizontal-rule . org-e-groff-horizontal-rule) + (inline-babel-call . org-e-groff-inline-babel-call) + (inline-src-block . org-e-groff-inline-src-block) + (inlinetask . org-e-groff-inlinetask) + (italic . org-e-groff-italic) + (item . org-e-groff-item) + (keyword . org-e-groff-keyword) + (groff-environment . org-e-groff-groff-environment) + (groff-fragment . org-e-groff-groff-fragment) + (line-break . org-e-groff-line-break) + (link . org-e-groff-link) + (macro . org-e-groff-macro) + (paragraph . org-e-groff-paragraph) + (plain-list . org-e-groff-plain-list) + (plain-text . org-e-groff-plain-text) + (planning . org-e-groff-planning) + (property-drawer . org-e-groff-property-drawer) + (quote-block . org-e-groff-quote-block) + (quote-section . org-e-groff-quote-section) + (radio-target . org-e-groff-radio-target) + (section . org-e-groff-section) + (special-block . org-e-groff-special-block) + (src-block . org-e-groff-src-block) + (statistics-cookie . org-e-groff-statistics-cookie) + (strike-through . org-e-groff-strike-through) + (subscript . org-e-groff-subscript) + (superscript . org-e-groff-superscript) + (table . org-e-groff-table) + (table-cell . org-e-groff-table-cell) + (table-row . org-e-groff-table-row) + (target . org-e-groff-target) + (template . org-e-groff-template) + (timestamp . org-e-groff-timestamp) + (underline . org-e-groff-underline) + (verbatim . org-e-groff-verbatim) + (verse-block . org-e-groff-verse-block)) + "Alist between element or object types and translators.") + +(defconst org-e-groff-options-alist + '((:date "DATE" nil org-e-groff-date-format t) + (:groff-class "GROFF_CLASS" nil org-e-groff-default-class t) + (:groff-class-options "GROFF_CLASS_OPTIONS" nil nil t) + (:groff-header-extra "GROFF_HEADER" nil nil newline)) +"Alist between Groff export properties and ways to set them. +See `org-export-options-alist' for more information on the +structure of the values.") + + +;;; User Configurable Variables + +(defgroup org-export-e-groff nil + "Options for exporting Org mode files to Groff." + :tag "Org Export Groff" + :group 'org-export) + +;;; Preamble + +(defcustom org-e-groff-default-class "internal" + "The default Groff class." + :group 'org-export-e-groff + :type '(string :tag "Groff class")) + +(defcustom org-e-groff-classes + '(("file" ".MT 1" + (:heading 'default :type "memo" :last-section "toc")) + ("internal" ".MT 0" + (:heading 'default :type "memo" :last-section "toc")) + ("programmer" ".MT 2" + (:heading 'default :type "memo" :last-section "toc")) + ("engineer" ".MT 3" + (:heading 'default :type "memo" :last-section "toc")) + ("external" ".MT 4" + (:heading 'default :type "memo" :last-section "toc")) + ("letter" ".MT 5" + (:heading 'default :type "memo" :last-section "sign")) + ("custom" ".so file" + (:heading custom-function :type "custom" :last-section "toc")) + ("dummy" "" + (:heading 'default :type "memo")) + ("ms" "ms" + (:heading 'default :type "cover" :last-section "toc")) + ("se_ms" "se_ms" + (:heading 'default :type "cover" :last-section "toc")) + ("block" "BL" + (:heading 'default :type "letter" :last-section "sign")) + ("semiblock" "SB" + (:heading 'default :type "letter" :last-section "sign")) + ("fullblock" "FB" + (:heading 'default :type "letter" :last-section "sign")) + ("simplified" "SP" + (:heading 'default :type "letter" :last-section "sign")) + ("none" "" (:heading 'default :type "custom"))) + + ;; none means, no Cover or Memorandum Type and no calls to AU, AT, ND and TL + ;; This is to facilitate the creation of custom pages. + + ;; dummy means, no Cover or Memorandum Type but calls to AU, AT, ND and TL + ;; are made. This is to facilitate Abstract Insertion. + + "This list describes the attributes for the documents being created. + It allows for the creation of new " + :group 'org-export-e-groff + :type '(repeat + (list (string :tag "Document Type") + (string :tag "Header") + (repeat :tag "Options" :inline t + (choice + (list :tag "Heading") + (function :tag "Hook computing sectioning")))))) + + +(defcustom org-e-groff-date-format + (format-time-string "%Y-%m-%d") + "Format string for .ND " + :group 'org-export-e-groff + :type 'boolean) + +;;; Headline + +(defconst org-e-groff-special-tags + '("FROM" "TO" "ABSTRACT" "APPENDIX" "BODY" "NS")) + +(defcustom org-e-groff-format-headline-function nil + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +As an example, one could set the variable to the following, in +order to reproduce the default set-up: + +\(defun org-e-groff-format-headline (todo todo-type priority text tags) + \"Default format function for an headline.\" + \(concat (when todo + \(format \"\\fB%s\\fP \" todo)) + \(when priority + \(format \"[\\#%c] \" priority)) + text + \(when tags + \(format \" %s \" + \(mapconcat 'identity tags \":\"))))" + :group 'org-export-e-groff + :type 'function) + +;;; Timestamps + +(defcustom org-e-groff-active-timestamp-format "\\fI%s\\fP" + "A printf format string to be applied to active timestamps." + :group 'org-export-e-groff + :type 'string) + +(defcustom org-e-groff-inactive-timestamp-format "\\fI%s\\fP" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-e-groff + :type 'string) + +(defcustom org-e-groff-diary-timestamp-format "\\fI%s\\fP" + "A printf format string to be applied to diary timestamps." + :group 'org-export-e-groff + :type 'string) + +;;; Links + +(defcustom org-e-groff-inline-image-rules + '(("file" . "\\.\\(pdf\\|ps\\|eps\\|pic\\)\\'") + ("fuzzy" . "\\.\\(pdf\\|ps\\|eps\\|pic\\)\\'")) + "Rules characterizing image files that can be inlined into Groff. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path. + +Note that, by default, the image extensions actually allowed +depend on the way the Groff file is processed. When used with +pdfgroff, pdf, jpg and png images are OK. When processing +through dvi to Postscript, only ps and eps are allowed. The +default we use here encompasses both." + :group 'org-export-e-groff + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-e-groff-link-with-unknown-path-format "\\fI%s\\fP" + "Format string for links with unknown path type." + :group 'org-export-groff + :type 'string) + +;;; Tables + +(defcustom org-e-groff-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-e-groff + :type 'boolean) + +(defcustom org-e-groff-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-e-groff + :type 'boolean) + +(defcustom org-e-groff-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-e-groff + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + +;;; Text markup + +(defcustom org-e-groff-text-markup-alist + '((bold . "\\fB%s\\fP") + (code . "\\fC%s\\fP") + (italic . "\\fI%s\\fP") + (strike-through . "\\fC%s\\fP") ; Strike through and underline + (underline . "\\fI%s\\fP") ; need to be revised. + (verbatim . "protectedtexttt")) + "Alist of Groff expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with it. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-e-groff + :type 'alist + :options '(bold code italic strike-through underline verbatim)) + +;;; Drawers + +(defcustom org-e-groff-format-drawer-function nil + "Function called to format a drawer in Groff code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-e-groff-format-drawer-default \(name contents\) + \"Format a drawer element for Groff export.\" + contents\)" + :group 'org-export-e-groff + :type 'function) + +;;; Inlinetasks + +(defcustom org-e-groff-format-inlinetask-function nil + "Function called to format an inlinetask in Groff code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-e-groff-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for Groff export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"\\fB%s\\fP \" todo)) + \(when priority (format \"[\\#%c] \" priority)) + title + \(when tags + \(format \":%s:\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \".DS L\\n\" + \"%s\\n\\n\" + \"%s\" + \".DE\") + full-title contents))" + :group 'org-export-e-groff + :type 'function) + +;; Src blocks + +(defcustom org-e-groff-source-highlight nil + "Use GNU source highlight to embellish source blocks " + :group 'org-export-e-groff + :type 'boolean) + +(defcustom org-e-groff-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-e-groff + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + +(defcustom org-e-groff-source-highlight-options nil + "Association list of options for the groff listings package. + +These options are supplied as a comma-separated list to the +\\lstset command. Each element of the association list should be +a list containing two strings: the name of the option, and the +value. For example, + + (setq org-e-groff-source-highlight-options + '((\"basicstyle\" \"\\small\") + (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) + +will typeset the code in a small size font with underlined, bold +black keywords. + +Note that the same options will be applied to blocks of all +languages." + :group 'org-export-e-groff + :type '(repeat + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) + +(defvar org-e-groff-custom-lang-environments nil + "Alist mapping languages to language-specific Groff environments. + +It is used during export of src blocks by the listings and +groff packages. For example, + + \(setq org-e-groff-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during groff export it will use pythoncode as the source-highlight +language.") + +;;; Plain text + +(defcustom org-e-groff-quotes + '(("fr" + ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~") + ("\\(\\S-\\)\"" . "~»") + ("\\(\\s-\\|(\\|^\\)'" . "'")) + ("en" + ("\\(\\s-\\|[[(]\\|^\\)\"" . "``") + ("\\(\\S-\\)\"" . "''") + ("\\(\\s-\\|(\\|^\\)'" . "`"))) + "Alist for quotes to use when converting english double-quotes. + +The CAR of each item in this alist is the language code. +The CDR of each item in this alist is a list of three CONS: +- the first CONS defines the opening quote; +- the second CONS defines the closing quote; +- the last CONS defines single quotes. + +For each item in a CONS, the first string is a regexp +for allowed characters before/after the quote, the second +string defines the replacement string for this quote." + :group 'org-export-e-groff + :type '(list + (cons :tag "Opening quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")) + (cons :tag "Closing quote" + (string :tag "Regexp for char after ") + (string :tag "Replacement quote ")) + (cons :tag "Single quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")))) + +(defcustom org-e-groff-special-char + '(("(c)" . "\\\\(co") + ("(tm)" . "\\\\(tm") + ("(rg)" . "\\\\(rg")) + "CONS list in which the value of the car + is replace on the value of the CDR. " + :group 'org-export-e-groff + :type '(list + (cons :tag "Character Subtitute" + (string :tag "Original Character Group") + (string :tag "Replacement Character")))) + +;;; Compilation + +(defcustom org-e-groff-pdf-process + '("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" + "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" + "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf") + + "Commands to process a Groff 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 +extension) and %o by the base directory of the file." + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdfgroff" + ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" + "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")) + (const :tag "3 runs of pdfgroff" + ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" + "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" + "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")) + (function))) + +(defcustom org-e-groff-logfiles-extensions + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as Groff logfiles." + :group 'org-export-e-groff + :type '(repeat (string :tag "Extension"))) + +(defcustom org-e-groff-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-e-groff + :type 'boolean) + +(defcustom org-e-groff-organization "Org User" + "Name of the organization used to populate the .AF command." + :group 'org-export-e-groff + :type 'string) + + +;; Adding GROFF as a block parser to make sure that its contents +;; does not execute + +(add-to-list 'org-element-block-name-alist + '("GROFF" . org-element-export-block-parser)) + +(defvar org-e-groff-registered-references nil) +(defvar org-e-groff-special-content nil) + + + +;;; Internal Functions + +(defun org-e-groff--caption/label-string (caption label info) + "Return caption and label Groff string for floats. + +CAPTION is a cons cell of secondary strings, the car being the +standard caption and the cdr its short form. LABEL is a string +representing the label. INFO is a plist holding contextual +information. + +If there's no caption nor label, return the empty string. + +For non-floats, see `org-e-groff--wrap-label'." + (let ((label-str "")) + (cond + ((and (not caption) (not label)) "") + ((not caption) (format "\\fI%s\\fP" label)) + ;; Option caption format with short name. + ((cdr caption) + (format "%s\n.br\n%s - %s\n" + (org-export-data (cdr caption) info) + label-str + (org-export-data (car caption) info))) + ;; Standard caption format. + (t (format "\\fR%s\\fP" + (org-export-data (car caption) info)))))) + +(defun org-e-groff--quotation-marks (text info) + "Export quotation marks depending on language conventions. +TEXT is a string containing quotation marks to be replaced. INFO +is a plist used as a communication channel." + (mapc (lambda(l) + (let ((start 0)) + (while (setq start (string-match (car l) text start)) + (let ((new-quote (concat (match-string 1 text) (cdr l)))) + (setq text (replace-match new-quote t t text)))))) + (cdr (or (assoc (plist-get info :language) org-e-groff-quotes) + ;; Falls back on English. + (assoc "en" org-e-groff-quotes)))) + text) + +(defun org-e-groff--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-e-groff--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)))) + +(defun org-e-groff--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-e-groff-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-e-groff-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ((string= "protectedtexttt" fmt) + (let ((start 0) + (trans '(("\\" . "\\"))) + (rtn "") + char) + (while (string-match "[\\{}$%&_#~^]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq text (concat rtn text)) + (format "\\fC%s\\fP" text))) + ;; Else use format string. + (t (format fmt text))))) + + +(defun org-e-groff--get-tagged-content (tag info) + (cdr (assoc tag org-e-groff-special-content))) + +(defun org-e-groff--mt-head (title contents attr info) + (concat + + ;; 1. Insert Organization + (let ((firm-option (plist-get attr :firm))) + (cond + ((stringp firm-option) + (format ".AF \"%s\" \n" firm-option)) + (t (format ".AF \"%s\" \n" (or org-e-groff-organization ""))))) + + ;; 2. Title + (let ((subtitle1 (plist-get attr :subtitle1)) + (subtitle2 (plist-get attr :subtitle2))) + + (cond + ((string= "" title) + (format ".TL \"%s\" \"%s\" \n%s\n" + (or subtitle1 "") + (or subtitle2 "") " ")) + + ((not (or subtitle1 subtitle2)) + (format ".TL\n%s\n" + (or title ""))) + (t + (format ".TL \"%s\" \"%s \" \n%s\n" + (or subtitle1 "") + (or subtitle2 "") title)))) + + ;; 3. Author. + ;; In Groff, .AU *MUST* be placed after .TL + ;; If From, populate with data from From else + ;; + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info))) + (from-data (org-e-groff--get-tagged-content "FROM" info)) + + (to-data (org-e-groff--get-tagged-content "TO" info))) + + (cond + ((and author from-data) + (let ((au-line + (mapconcat + (lambda (from-line) + (format " \"%s\" " from-line)) + (split-string + (setq from-data + (replace-regexp-in-string "\\.P\n" "" from-data)) "\n") ""))) + + (concat + (format ".AU \"%s\" " author) au-line "\n"))) + + ((and author email (not (string= "" email))) + (format ".AU \"%s\" \"%s\"\n" author email)) + + (author (format ".AU \"%s\"\n" author)) + + (t ".AU \"\" \n"))) + + + ;; 4. Author Title, if present + (let ((at-item (plist-get attr :author-title))) + (if (and at-item (stringp at-item)) + (format ".AT \"%s\" \n" at-item) + "")) + + ;; 5. Date. + (let ((date (org-export-data (plist-get info :date) info))) + (and date (format ".ND \"%s\"\n" date))) + + ;; + ;; If Abstract, then Populate Abstract + ;; + + (let ((abstract-data (org-e-groff--get-tagged-content "ABSTRACT" info)) + (to-data (org-e-groff--get-tagged-content "TO" info))) + (cond + (abstract-data + (format ".AS\n%s\n.AE\n" abstract-data)) + (to-data + (format ".AS\n%s\n.AE\n" to-data)))))) + +(defun org-e-groff--letter-head (title contents attr info) + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info))) + (from-data (org-e-groff--get-tagged-content "FROM" info)) + (at-item (plist-get attr :author-title)) + (to-data (org-e-groff--get-tagged-content "TO" info))) + + + ;; If FROM then get data from FROM + (setq from-data + (replace-regexp-in-string "\\.P\n" "" from-data)) + + (setq to-data + (replace-regexp-in-string "\\.P\n" "" to-data)) + + (concat + (cond + (from-data + (format ".WA \"%s\" \"%s\" \n%s\n.WE\n" author (or at-item "") from-data)) + ((and author email (not (string= "" email))) + (format ".WA \"%s\"\n \"%s\"\n.WE\n" author email)) + (author (format ".WA \"%s\"\n.WE\n" author)) + (t ".WA \"\" \n.WE\n")) + + ;; If TO then get data from TO + + (when to-data + (format ".IA \n%s\n.IE\n" to-data))))) + + +;;; Template + +(defun org-e-groff-template (contents info) + "Return complete document string after Groff 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 :groff-class-options)) + " ")))) + (class (plist-get info :groff-class)) + (class-options (plist-get info :groff-class-options)) + (classes (assoc class org-e-groff-classes)) + (classes-options (car (last classes))) + (heading-option (plist-get classes-options :heading)) + (type-option (plist-get classes-options :type)) + (last-option (plist-get classes-options :last-section)) + (hyphenate (plist-get attr :hyphenate)) + (justify-right (plist-get attr :justify-right)) + + (document-class-string + (progn + (org-element-normalize-string + (let* ((header (nth 1 (assoc class org-e-groff-classes))) + (document-class-item (if (stringp header) header ""))) + document-class-item))))) + + + (concat + (if justify-right + (case justify-right + ('yes ".SA 1 \n") + ('no ".SA 0 \n") + (t "")) + "") + + (if hyphenate + (case hyphenate + ('yes ".nr Hy 1 \n") + ('no ".nr Hy 0 \n") + (t "")) + "") + + (cond + ((string= type-option "custom") "") + + ((and (stringp document-class-string) + (string= type-option "cover")) + + (concat + (format ".COVER %s\n" document-class-string) + (org-e-groff--mt-head title contents attr info) + ".COVEND\n")) + + ((string= type-option "memo") + (concat + (org-e-groff--mt-head title contents attr info) + document-class-string)) + ((string= type-option "letter") + (concat + (org-e-groff--letter-head title contents attr info) + (let ((sa-item (plist-get attr :salutation)) + (cn-item (plist-get attr :confidential)) + (sj-item (plist-get attr :subject)) + (rn-item (plist-get attr :reference)) + (at-item (plist-get attr :attention))) + + (concat + + (if (stringp sa-item) + (format ".LO SA \"%s\" \n" sa-item) + ".LO SA\n") + + (when cn-item + (if (stringp cn-item) + (format ".LO CN \"%s\"\n" cn-item) + ".LO CN\n")) + + (when (and at-item (stringp at-item)) + (format ".LO AT \"%s\" \n" at-item)) + (when (and title rn-item) + (format ".LO RN \"%s\"\n" title)) + + (when (and sj-item (stringp sj-item)) + (format ".LO SJ \"%s\" \n" sj-item)) + + + ".LT " document-class-string "\n")))) + + (t "")) + + contents + + (cond + ((string= last-option "toc") + ".TC") + ((string= last-option "sign") + (let ((fc-item (plist-get attr :closing))) + (concat (if (stringp fc-item) + (format ".FC \"%s\" \n" fc-item) + ".FC\n") + ".SG\n"))) + (t "")) + + (progn + (mapconcat + (lambda (item) + (when (string= (car item) "NS") + (replace-regexp-in-string + "\\.P\n" "" (cdr item)))) + (reverse org-e-groff-special-content) "\n"))))) + + + +;;; Transcode Functions + +;;; Babel Call +;; +;; Babel Calls are ignored. + + +;;; Bold + +(defun org-e-groff-bold (bold contents info) + "Transcode BOLD from Org to Groff. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-e-groff--text-markup contents 'bold)) + +;;; Center Block + +(defun org-e-groff-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Groff. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-e-groff--wrap-label + center-block + (format ".DS C \n%s\n.DE" contents))) + +;;; Clock + +(defun org-e-groff-clock (clock contents info) + "Transcode a CLOCK element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + (format "\\fB%s\\fP " org-clock-string) + (format org-e-groff-inactive-timestamp-format + (concat (org-translate-time (org-element-property :value clock)) + (let ((time (org-element-property :time clock))) + (and time (format " (%s)" time))))))) + +;;; Code + +(defun org-e-groff-code (code contents info) + "Transcode a CODE object from Org to Groff. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-e-groff--text-markup (org-element-property :value code) 'code)) + +;;; Comments and Comment Blocks are ignored. + +;;; Drawer + +(defun org-e-groff-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Groff. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (if (functionp org-e-groff-format-drawer-function) + (funcall org-e-groff-format-drawer-function + name contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents))) + (org-e-groff--wrap-label drawer output))) + +;;; Dynamic Block + +(defun org-e-groff-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Groff. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-e-groff--wrap-label dynamic-block contents)) + +;;; Entity + +(defun org-e-groff-entity (entity contents info) + "Transcode an ENTITY object from Org to Groff. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :utf8 entity))) ent)) + +;;; Example Block + +(defun org-e-groff-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual +information." + (org-e-groff--wrap-label + example-block + (format ".DS L\n%s\n.DE" + (org-export-format-code-default example-block info)))) + +;;; Export Block + +(defun org-e-groff-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "GROFF") + (org-remove-indentation (org-element-property :value export-block)))) + +;;; Export Snippet + +(defun org-e-groff-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'e-groff) + (org-element-property :value export-snippet))) + +;;; Fixed Width + +(defun org-e-groff-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-e-groff--wrap-label + fixed-width + (format "\\fC\n%s\\fP" + (org-remove-indentation + (org-element-property :value fixed-width))))) + +;;; Footnote Definition +;; +;; Footnote Definitions are ignored. +;; +;; Footnotes are handled automatically in GROFF. Although manual +;; references can be added, not really required. + +(defun org-e-groff-footnote-reference (footnote-reference contents info) + ;; Changing from info to footnote-reference + (let* ((raw (org-export-get-footnote-definition footnote-reference info)) + (n (org-export-get-footnote-number footnote-reference info)) + (data (org-trim (org-export-data raw info))) + (ref-id (plist-get (nth 1 footnote-reference) :label))) + ;; It is a reference + (if (string-match "fn:rl" ref-id) + (if (member ref-id org-e-groff-registered-references) + (format "\\*[%s]" ref-id) + (progn + (push ref-id org-e-groff-registered-references) + (format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data))) + ;; else it is a footnote + (format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data)))) + +;;; Headline + +(defun org-e-groff-headline (headline contents info) + "Transcode an HEADLINE element from Org to Groff. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((class (plist-get info :groff-class)) + (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. + (classes (assoc class org-e-groff-classes)) + (classes-options (car (last classes))) + (heading-option (plist-get classes-options :heading)) + (section-fmt + (progn + (cond + ((and (symbolp heading-option) + (fboundp heading-option)) + (funcall heading-option level numberedp)) + ((> level 7) nil) + (t (if numberedp + (concat ".H " (number-to-string level) " \"%s\"\n%s") + ".HU \"%s\"\n%s"))))) + ;; End of section-fmt + (text (org-export-data (org-element-property :title headline) info)) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + ;; Create the headline text along with a no-tag version. The + ;; latter is required to remove tags from table of contents. + (full-text (if (functionp org-e-groff-format-headline-function) + ;; User-defined formatting function. + (funcall org-e-groff-format-headline-function + todo todo-type priority text tags) + ;; Default formatting. + (concat + (when todo + (format "\\fB%s\\fP " todo)) + (when priority (format " [\\#%c] " priority)) + text + (when tags + (format " \\fC:%s:\\fP " + (mapconcat 'identity tags ":")))))) + (full-text-no-tag + (if (functionp org-e-groff-format-headline-function) + ;; User-defined formatting function. + (funcall org-e-groff-format-headline-function + todo todo-type priority text nil) + ;; Default formatting. + (concat + (when todo (format "\\fB%s\\fP " todo)) + (when priority (format " [\\#%c] " priority)) + text))) + ;; Associate some \label to the headline for internal links. + ;; (headline-label + ;; (format "\\label{sec-%s}\n" + ;; (mapconcat 'number-to-string + ;; (org-export-get-headline-number headline info) + ;; "-"))) + (headline-label "") + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) + + (cond + ;; Case 1: Special Tag + ((member (car tags) org-e-groff-special-tags) + (cond + ((string= (car tags) "BODY") contents) + + ((string= (car tags) "NS") + (progn + (push (cons (car tags) + (format ".NS \"%s\" 1 \n%s" + (car (org-element-property :title headline)) + (or contents " "))) + org-e-groff-special-content) nil)) + + (t + (progn + (push (cons (car tags) contents) org-e-groff-special-content) + nil)))) + + ;; Case 2: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + + ;; Case 3: 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" (if numberedp ".AL 1\n" ".DL \n"))) + ;; Itemize headline + ".LI\n" full-text "\n" headline-label pre-blanks contents))) + ;; 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]*\\'" + (concat "\n.LE") + low-level-body)))) + + ;; Case 4. Standard headline. Export it as a section. + (t + (format section-fmt full-text + (concat headline-label pre-blanks contents)))))) + +;;; Horizontal Rule +;; Not supported + +;;; Inline Babel Call +;; +;; Inline Babel Calls are ignored. + +;;; Inline Src Block + +(defun org-e-groff-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Groff. +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-e-groff-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-e-groff-source-highlight-langs))) + + (cmd (concat (expand-file-name "source-highlight") + " -s " lst-lang + " -f groff_mm_color " + " -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 ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n" + code)))) + + ;; Do not use a special package: transcode it verbatim. + (t + (concat ".DS I\n" "\\fC" code "\\fP\n.DE\n"))))) + +;;; Inlinetask + +(defun org-e-groff-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to Groff. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-e-groff-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (functionp org-e-groff-format-inlinetask-function) + (funcall org-e-groff-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (org-e-groff--wrap-label + inlinetask + (let ((full-title + (concat + (when todo (format "\\fB%s\\fP " todo)) + (when priority (format " [\\#%c] " priority)) + title + (when tags (format " \\fC:%s:\\fP " + (mapconcat 'identity tags ":")))))) + (format (concat "\n.DS I\n" + "%s\n" + ".sp" + "%s\n" + ".DE") + full-title contents)))))) + +;;; Italic + +(defun org-e-groff-italic (italic contents info) + "Transcode ITALIC from Org to Groff. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-e-groff--text-markup contents 'italic)) + +;;; Item + +(defun org-e-groff-item (item contents info) + "Transcode an ITEM element from Org to Groff. +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 "%s" + (concat checkbox + (org-export-data tag info))))))) + + (cond + ((or checkbox tag) + (concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\"" + "\n" + (org-trim (or contents " ")))) + ((eq type 'ordered) + (concat ".LI" + "\n" + (org-trim (or contents " ")))) + (t + (let* ((bullet (org-trim bullet)) + (marker (cond ((string= "-" bullet) "\\(em") + ((string= "*" bullet) "\\(bu") + (t "\\(dg")))) + (concat ".LI " marker "\n" + (org-trim (or contents " ")))))))) + +;;; Keyword + +(defun org-e-groff-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Groff. +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 "GROFF") value) + (t nil)))) + +;;; Groff Environment + +(defun org-e-groff-groff-environment (groff-environment contents info) + "Transcode a GROFF-ENVIRONMENT element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((label (org-element-property :name groff-environment)) + (value (org-remove-indentation + (org-element-property :value groff-environment)))) + (if (not (org-string-nw-p label)) value + ;; Environment is labelled: label must be within the environment + ;; (otherwise, a reference pointing to that element will count + ;; the section instead). + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (forward-line) + (insert (format "%s\n" label)) + (buffer-string))))) + +;;; Groff Fragment + +(defun org-e-groff-groff-fragment (groff-fragment contents info) + "Transcode a GROFF-FRAGMENT object from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value groff-fragment)) + +;;; Line Break + +(defun org-e-groff-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + ".br\n") + +;;; Link +;; Inline images just place a call to .PSPIC or .PS/.PE +;; and load the graph. + +(defun org-e-groff-link--inline-image (link info) + "Return Groff code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (let* ((parent (org-export-get-parent-element link)) + (path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) + (attr (read (format "(%s)" + (mapconcat + #'identity + (org-element-property :attr_groff parent) + " ")))) + (placement + (case (plist-get attr :position) + ('center "") + ('left "-L") + ('right "-R") + (t ""))) + (width (or (plist-get attr :width) "")) + (height (or (plist-get attr :height) "")) + + (disable-caption (plist-get attr :disable-caption)) + + (caption + (org-e-groff--caption/label-string + (org-element-property :caption parent) + (org-element-property :name parent) + info))) + + ;; Now clear ATTR from any special keyword and set a default value + ;; if nothing is left. Return proper string. + + (concat + (cond + ((string-match ".\.pic$" path) + (format "\n.PS\ncopy \"%s\"\n.PE" path)) + (t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE " + placement path width height))) + (unless disable-caption (format "\n.FG \"%s\"" caption))))) + +(defun org-e-groff-link (link desc info) + "Transcode a LINK object from Org to Groff. + +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)) + (imagep (org-export-inline-image-p + link org-e-groff-inline-image-rules)) + (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 + ;; Image file. + (imagep (org-e-groff-link--inline-image link info)) + ;; import groff files + ((and (string= type "file") + (string-match ".\.groff$" raw-path)) + (concat ".so " raw-path "\n")) + ;; Radio link: transcode target's contents and use them as link's + ;; description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "\\fI [%s] \\fP" + (org-export-solidify-link-text path))))) + + ;; Links pointing to an headline: find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination) + (format "\\fI file://%s \\fP" destination))) + ;; Fuzzy link points nowhere. + ('nil + (format org-e-groff-link-with-unknown-path-format + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; Fuzzy link points to an invisible target. + (keyword nil) + ;; LINK points to an headline. If headlines are numbered + ;; and the link has no description, display headline's + ;; number. Otherwise, display description or headline's + ;; title. + (headline + (let ((label "")) + (if (and (plist-get info :section-numbers) (not desc)) + (format "\\fI%s\\fP" label) + (format "\\fI%s\\fP" + (or desc + (org-export-data + (org-element-property :title destination) info)))))) + ;; Fuzzy link points to a target. Do as above. + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "\\fI%s\\fP" path) + (format "%s \\fBat\\fP \\fI%s\\fP" desc path))))))) + ;; 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 org-e-groff-link-with-unknown-path-format desc))))) + +;;; Macro + +(defun org-e-groff-macro (macro contents info) + "Transcode a MACRO element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + ;; Use available tools. + (org-export-expand-macro macro info)) + +;;; Paragraph + +(defun org-e-groff-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Groff. +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 "") + (class (plist-get info :groff-class)) + (class-options (plist-get info :groff-class-options)) + (classes (assoc class org-e-groff-classes)) + (classes-options (car (last classes))) + (paragraph-option (plist-get classes-options :paragraph))) + (cond + ((and (symbolp paragraph-option) + (fboundp paragraph-option)) + (funcall paragraph-option parent-type parent contents)) + ((and (eq parent-type 'item) + (plist-get (nth 1 parent) :bullet)) + (setq fixed-paragraph (concat "" contents))) + ((eq parent-type 'section) + (setq fixed-paragraph (concat ".P\n" contents))) + ((eq parent-type 'footnote-definition) + (setq fixed-paragraph (concat "" contents))) + (t (setq fixed-paragraph (concat "" contents)))) + fixed-paragraph)))) + +;;; Plain List + +(defun org-e-groff-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Groff. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attr (mapconcat #'identity + (org-element-property :attr_groff plain-list) + " ")) + (groff-type (cond + ((eq type 'ordered) ".AL") + ((eq type 'unordered) ".BL") + ((eq type 'descriptive) ".VL 2.0i")))) + (org-e-groff--wrap-label + plain-list + (format "%s\n%s\n.LE" groff-type contents)))) + +;;; Plain Text + +(defun org-e-groff-plain-text (text info) + "Transcode a TEXT string from Org to Groff. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + ;; Protect + (setq text (replace-regexp-in-string + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\" text nil t 1)) + ;; Handle quotation marks + (setq text (org-e-groff--quotation-marks text info)) + ;; Handle Special Characters + (if org-e-groff-special-char + (dolist (special-char-list org-e-groff-special-char) + (setq text + (replace-regexp-in-string (car special-char-list) + (cdr special-char-list) text)))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq text (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" text))) + ;; Return value. + text) + +;;; Planning + +(defun org-e-groff-planning (planning contents info) + "Transcode a PLANNING element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "\\fR %s \\fP" org-closed-string) + (format org-e-groff-inactive-timestamp-format + (org-translate-time closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "\\fB %s \\fP" org-deadline-string) + (format org-e-groff-active-timestamp-format + (org-translate-time deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "\\fR %s \\fP" org-scheduled-string) + (format org-e-groff-active-timestamp-format + (org-translate-time scheduled))))))) + "") + "")) + +;;; Property Drawer + +(defun org-e-groff-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;; Quote Block + +(defun org-e-groff-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Groff. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-e-groff--wrap-label + quote-block + (format ".DS I\n.I\n%s\n.R\n.DE" contents))) + +;;; Quote Section + +(defun org-e-groff-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format ".DS L\n\\fI%s\\fP\n.DE\n" value)))) + +;;; Radio Target + +(defun org-e-groff-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Groff. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "%s - %s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + +;;; Section + +(defun org-e-groff-section (section contents info) + "Transcode a SECTION element from Org to Groff. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + +;;; Special Block + +(defun org-e-groff-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Groff. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block)))) + (org-e-groff--wrap-label + special-block + (format "%s\n" contents)))) + +;;; Src Block + +(defun org-e-groff-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Groff. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (caption (org-element-property :caption src-block)) + (label (org-element-property :name src-block)) + (code (org-element-property :value src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-e-groff-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)) + (attr + (read (format "(%s)" + (mapconcat #'identity + (org-element-property :attr_groff src-block) + " ")))) + (disable-caption (plist-get attr :disable-caption))) + + (cond + ;; Case 1. No source fontification. + ((not org-e-groff-source-highlight) + (let ((caption-str (org-e-groff--caption/label-string caption label info))) + (concat + (format ".DS I\n\\fC%s\\fP\n.DE\n" + (org-export-format-code-default src-block info)) + (unless disable-caption (format ".EX \"%s\" " caption-str))))) + + ;; Case 2. Source fontification. + (org-e-groff-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory)) + (caption-str (org-e-groff--caption/label-string caption label info)) + (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-e-groff-source-highlight-langs))) + + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_mm_color " + " -i " in-file + " -o " out-file))) + + (concat + (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) + (format "%s\n" code-block)) + (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n" + code)) + (unless disable-caption (format ".EX \"%s\" " caption-str)))))))) + + +;;; Statistics Cookie + +(defun org-e-groff-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;; Strike-Through + +(defun org-e-groff-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to Groff. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (org-e-groff--text-markup contents 'strike-through)) + +;;; Subscript + +(defun org-e-groff-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Groff. +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-e-groff-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Groff. +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-e-groff-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" attribute. Otherwise, it +;; delegates the job to `org-e-groff-table--org-table' function, +;; depending of the type of the table. +;; +;; `org-e-groff-table--align-string' is a subroutine used to build +;; alignment string for Org tables. + +(defun org-e-groff-table (table contents info) + "Transcode a TABLE element from Org to Groff. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (cond + ;; Case 1: verbatim table. + ((or org-e-groff-tables-verbatim + (let ((attr (read (format "(%s)" + (mapconcat + #'identity + (org-element-property :attr_groff table) " "))))) + (and attr (plist-get attr :verbatim)))) + + (format ".DS L\n\\fC%s\\fP\n.DE" + ;; Re-create table, without affiliated keywords. + (org-trim + (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + + ;; Case 2: Standard table. + (t (org-e-groff-table--org-table table contents info)))) + +(defun org-e-groff-table--align-string (divider table info) + "Return an appropriate Groff 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. + ;; Alignment is nil on assignment + + (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-e-groff-table--org-table (table contents info) + "Return appropriate Groff 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* ((label (org-element-property :name table)) + (caption (org-e-groff--caption/label-string + (org-element-property :caption table) label info)) + (attr (read (format "(%s)" + (mapconcat #'identity + (org-element-property :attr_groff table) + " ")))) + (divider (if (plist-get attr :divider) "|" " ")) + + ;; Determine alignment string. + (alignment (org-e-groff-table--align-string divider table info)) + + ;; Extract others display options. + + (lines (org-split-string contents "\n")) + + (attr-list + (let (result-list) + (dolist (attr-item + (list + (if (plist-get attr :expand) + "expand" nil) + + (case (plist-get attr :placement) + ('center "center") + ('left nil) + (t + (if org-e-groff-tables-centered + "center" ""))) + + (case (plist-get attr :boxtype) + ('box "box") + ('doublebox "doublebox") + ('allbox "allbox") + ('none nil) + (t "box")))) + + (if (not (null attr-item)) + (add-to-list 'result-list attr-item))) + result-list)) + + (title-line (plist-get attr :title-line)) + (disable-caption (plist-get attr :disable-caption)) + (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\n.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)) + + (if (not disable-caption) + (format ".TB \"%s\"" + caption) "")))))) + +;;; Table Cell + +(defun org-e-groff-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Groff +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (progn + (concat (if (and contents + org-e-groff-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-e-groff-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-e-groff-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Groff +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_groff (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-e-groff-target (target contents info) + "Transcode a TARGET object from Org to Groff. +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-e-groff-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Groff. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-translate-time (org-element-property :value timestamp))) + (type (org-element-property :type timestamp))) + (cond ((memq type '(active active-range)) + (format org-e-groff-active-timestamp-format value)) + ((memq type '(inactive inactive-range)) + (format org-e-groff-inactive-timestamp-format value)) + (t (format org-e-groff-diary-timestamp-format value))))) + +;;; Underline + +(defun org-e-groff-underline (underline contents info) + "Transcode UNDERLINE from Org to Groff. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (org-e-groff--text-markup contents 'underline)) + +;;; Verbatim + +(defun org-e-groff-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Groff. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-e-groff--text-markup (org-element-property :value verbatim) 'verbatim)) + +;;; Verse Block + +(defun org-e-groff-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Groff. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (format ".DS C\n.ft HI\n%s\n.ft\n.DE" contents)) + + +;;; Interactive functions + +(defun org-e-groff-export-to-groff + (&optional subtreep visible-only body-only ext-plist pub-dir) + "Export current buffer to a Groff file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +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. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return output file's name." + (interactive) + (setq org-e-groff-registered-references nil) + (setq org-e-groff-special-content nil) + (let ((outfile (org-export-output-file-name ".groff" subtreep pub-dir))) + (org-export-to-file + 'e-groff outfile subtreep visible-only body-only ext-plist))) + +(defun org-e-groff-export-to-pdf + (&optional subtreep visible-only body-only ext-plist pub-dir) + "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. + +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. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return PDF file's name." + (interactive) + (org-e-groff-compile + (org-e-groff-export-to-groff + subtreep visible-only body-only ext-plist pub-dir))) + +(defun org-e-groff-compile (grofffile) + "Compile a Groff file. + +GROFFFILE is the name of the file being compiled. Processing is +done through the command specified in `org-e-groff-pdf-process'. + +Return PDF file name or an error if it couldn't be produced." + (let* ((wconfig (current-window-configuration)) + (grofffile (file-truename grofffile)) + (base (file-name-sans-extension grofffile)) + errors) + (message (format "Processing Groff file %s ..." grofffile)) + (unwind-protect + (progn + (cond + ;; A function is provided: Apply it. + ((functionp org-e-groff-pdf-process) + (funcall org-e-groff-pdf-process (shell-quote-argument grofffile))) + ;; 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-e-groff-pdf-process) + (let* ((out-dir (or (file-name-directory grofffile) "./")) + (outbuf (get-buffer-create "*Org PDF Groff Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base) + (replace-regexp-in-string + "%f" (shell-quote-argument grofffile) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) + t t) t t) + outbuf)) + org-e-groff-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-e-groff-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat base ".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-e-groff-remove-logfiles + (dolist (ext org-e-groff-logfiles-extensions) + (let ((file (concat base "." 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)) + (set-window-configuration wconfig)))) + +(defun org-e-groff-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 'org-e-groff) +;;; org-e-groff.el ends here |