Enhanced the org-e-groff.el code to use the Groff MM letter macros

* org-e-groff.el (org-e-groff-classes): Added
letter classes.
(org-e-groff-special-tags): New variable to identify special tags.
(org-e-groff--get-tagged-content): New function to retrieve
special tagged content.
(org-e-groff--mt-head): New function to create "memo" type headers.
(org-e-groff--letter-head): New function to create "letter" type headers.
(org-e-groff-template): Handle the "letter" type.
(org-e-groff-headline): handle special tags.
This commit is contained in:
Luis Anaya 2012-08-10 10:14:00 -04:00
parent d9ebb7c8be
commit 36bb59fdc5
1 changed files with 416 additions and 248 deletions

View File

@ -19,7 +19,6 @@
;; 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
@ -109,11 +108,10 @@
(: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.
"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
@ -146,15 +144,26 @@ structure of the values.")
(:heading custom-function :type "custom" :last-section "toc"))
("dummy" ""
(:heading 'default :type "memo"))
;; Dummy means, no Cover or Memorandum Type but calls to AU, AT,
;; ND and TL are made. This is to facilitate Abstract Insertion.
("ms" "ms"
(:heading 'default :type "cover" :last-section "toc"))
("se_ms" "se_ms"
(:heading 'default :type "cover" :last-section "toc"))
("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.
("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
@ -166,6 +175,7 @@ structure of the values.")
(list :tag "Heading")
(function :tag "Hook computing sectioning"))))))
(defcustom org-e-groff-date-format
(format-time-string "%Y-%m-%d")
"Format string for .ND "
@ -174,6 +184,9 @@ structure of the values.")
;;; 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.
@ -269,9 +282,8 @@ When nil, no transformation is made."
;;; Text markup
(defcustom org-e-groff-text-markup-alist
'((bold . "\\fB%s\\fP")
;; from "verb"
(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
@ -315,7 +327,6 @@ in order to mimic default behaviour:
"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
@ -347,7 +358,7 @@ in order to mimic default behaviour:
:group 'org-export-e-groff
:type 'function)
;;; Src blocks
;; Src blocks
(defcustom org-e-groff-source-highlight nil
"Use GNU source highlight to embellish source blocks "
@ -510,16 +521,16 @@ These are the .aux, .log, .out, and .toc files."
:type 'string)
;;; Preamble
;; Adding GROFF as a block parser to make sure that its contents
;; does not execute
(defvar org-e-groff-registered-references nil)
(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
@ -595,6 +606,126 @@ See `org-e-groff-text-markup-alist' for details."
;; 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
@ -616,106 +747,101 @@ holding export options."
(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
(unless (string= type-option "custom")
(progn
(concat
(when (and (stringp document-class-string)
(string= type-option "cover"))
(format ".COVER %s\n" document-class-string))
(if justify-right
(case justify-right
('yes ".SA 1 \n")
('no ".SA 0 \n")
(t ""))
"")
;; 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
(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))))
(cond ((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)))
(when (string= type-option "cover")
".COVEND\n"))))
;;6. Hyphenation and Right Justification
(let ((hyphenate (plist-get attr :hyphenate))
(justify-right (plist-get attr :justify-right)))
(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 ""))
"")))
(when (string= type-option "memo")
document-class-string)
;; 7. Document's body.
contents
;; 8. Table of Content must be placed at the end being that it
;; gets collected from all the headers. In the case of letters,
;; signature will be placed instead.
(if hyphenate
(case hyphenate
('yes ".nr Hy 1 \n")
('no ".nr Hy 0 \n")
(t ""))
"")
(cond
((string= last-option "toc") ".TC")
((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")))
".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")))))
(t "")))))
;;; Transcode Functions
@ -724,6 +850,7 @@ holding export options."
;;
;; Babel Calls are ignored.
;;; Bold
(defun org-e-groff-bold (bold contents info)
@ -763,9 +890,7 @@ CONTENTS is nil. INFO is a plist used as a communication
channel."
(org-e-groff--text-markup (org-element-property :value code) 'code))
;;; Comment and comment blocks
;;
;; Comment and comment blocks are ignored.
;;; Comments and Comment Blocks are ignored.
;;; Drawer
@ -846,8 +971,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(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)))
(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)
@ -930,11 +1055,30 @@ holding contextual information."
(make-string (org-element-property :pre-blank headline) 10)))
(cond
;; Case 1: This is a footnote section: ignore it.
;; 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 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.
;; 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
@ -952,7 +1096,8 @@ holding contextual information."
"[ \t\n]*\\'"
(concat "\n.LE")
low-level-body))))
;; Case 3. Standard headline. Export it as a section.
;; Case 4. Standard headline. Export it as a section.
(t
(format section-fmt full-text
(concat headline-label pre-blanks contents))))))
@ -983,6 +1128,7 @@ contextual information."
(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 "
@ -998,6 +1144,7 @@ contextual information."
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")))))
@ -1062,12 +1209,13 @@ contextual information."
(trans "\\o'\\(sq\\(mi'")))
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
(and tag (format "[%s]"
(and tag (format "%s"
(concat checkbox
(org-export-data tag info)))))))
(cond
((or checkbox tag)
(concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
(cond
((or checkbox tag)
(concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
"\n"
(org-trim (or contents " "))))
((eq type 'ordered)
@ -1080,7 +1228,7 @@ contextual information."
((string= "*" bullet) "\\(bu")
(t "\\(dg"))))
(concat ".LI " marker "\n"
(org-trim (or contents " " ))))))))
(org-trim (or contents " "))))))))
;;; Keyword
@ -1127,8 +1275,8 @@ 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.
;; 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.
@ -1139,23 +1287,22 @@ used as a communication channel."
(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)
" "))))
(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) ""))
(width (or (plist-get attr :width) ""))
(height (or (plist-get attr :height) ""))
(disable-caption (plist-get attr :disable-caption))
(disable-caption (plist-get attr :disable-caption))
(caption
(caption
(org-e-groff--caption/label-string
(org-element-property :caption parent)
(org-element-property :name parent)
@ -1199,12 +1346,10 @@ INFO is a plist holding contextual information. See
(cond
;; Image file.
(imagep (org-e-groff-link--inline-image link info))
;; Import groff files.
;; 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")
@ -1270,7 +1415,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"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)))
(let ((parent (plist-get (nth 1 paragraph) :parent)))
(when parent
(let* ((parent-type (car parent))
(fixed-paragraph "")
@ -1323,12 +1468,13 @@ contextual information."
"$\\" 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
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq text (replace-regexp-in-string
"\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" text)))
@ -1445,9 +1591,9 @@ contextual information."
(retain-labels (org-element-property :retain-labels src-block))
(attr
(read (format "(%s)"
(mapconcat #'identity
(org-element-property :attr_groff src-block)
" "))))
(mapconcat #'identity
(org-element-property :attr_groff src-block)
" "))))
(disable-caption (plist-get attr :disable-caption)))
(cond
@ -1461,35 +1607,38 @@ contextual information."
;; 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)))
(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))))))))
(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
@ -1498,6 +1647,7 @@ contextual information."
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)
@ -1522,11 +1672,12 @@ 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,
;; 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
@ -1540,8 +1691,8 @@ contextual information."
;; Case 1: verbatim table.
((or org-e-groff-tables-verbatim
(let ((attr (read (format "(%s)"
(mapconcat
#'identity
(mapconcat
#'identity
(org-element-property :attr_groff table) " ")))))
(and attr (plist-get attr :verbatim))))
@ -1558,32 +1709,35 @@ contextual information."
"Return an appropriate Groff alignment string.
TABLE is the considered table. INFO is a plist used as
a communication channel."
(let (alignment)
(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.
(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)
(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)
@ -1599,13 +1753,15 @@ This function assumes TABLE has `org' as its `:type' attribute."
(org-element-property :caption table) label info))
(attr (read (format "(%s)"
(mapconcat #'identity
(org-element-property :attr_groff table)
" "))))
(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
@ -1620,8 +1776,7 @@ This function assumes TABLE has `org' as its `:type' attribute."
('left nil)
(t
(if org-e-groff-tables-centered
"center"
"")))
"center" "")))
(case (plist-get attr :boxtype)
('box "box")
@ -1644,8 +1799,8 @@ This function assumes TABLE has `org' as its `:type' attribute."
(or (car attr-list) ""))
(or
(let (output-list)
(when (cdr attr-list)
(dolist (attr-item (cdr attr-list))
(when (cdr attr-list)
(dolist (attr-item (cdr attr-list))
(setq output-list (concat output-list
(format ",%s" attr-item)))))
output-list) "")))
@ -1653,47 +1808,57 @@ This function assumes TABLE has `org' as its `:type' attribute."
(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 ""))
(dolist (line-item lines)
(setq long-line "")
(if long-cells
(if (string= line-item "_")
(setq long-line (format "%s\n" line-item))
;; else
(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)
(setq final-line (concat final-line long-line)))
;; else
(setq final-line (concat final-line line-item "\n")))) final-line))
(if (not disable-caption)
(format ".TB \"%s\"" caption)
""))))))
(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
@ -1701,16 +1866,18 @@ This function assumes TABLE has `org' as its `:type' attribute."
"Transcode a TABLE-CELL element from Org to Groff
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
(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")))
(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
@ -1730,7 +1897,7 @@ a communication channel."
(org-export-table-cell-borders
(car (org-element-contents table-row)) info)))
(concat
;; Mark "hline" for horizontal lines.
;; Mark horizontal lines
(cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
contents
(cond
@ -1815,6 +1982,7 @@ 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)))
@ -1866,9 +2034,9 @@ Return PDF file name or an error if it couldn't be produced."
;; 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.
;; 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*")))