mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-26 10:49:38 +00:00
org-e-html/org-e-odt: Use new table infrastructure. First cut and slightly broken.
This commit is contained in:
Jambunathan K
parent
0264495f52
commit
c009f84f99
@ -140,8 +140,6 @@ specific properties, define a similar variable named
|
||||
the appropriate back-end. You can also redefine properties
|
||||
there, as they have precedence over these.")
|
||||
|
||||
(defvar html-table-tag nil) ; dynamically scoped into this.
|
||||
|
||||
;; FIXME: it already exists in org-e-html.el
|
||||
(defconst org-e-html-cvt-link-fn
|
||||
nil
|
||||
@ -158,11 +156,6 @@ Intended to be locally bound around a call to `org-export-as-html'." )
|
||||
(defvar htmlize-buffer-places) ; from htmlize.el
|
||||
(defvar body-only) ; dynamically scoped into this.
|
||||
|
||||
(defvar org-e-html-table-rowgrp-open)
|
||||
(defvar org-e-html-table-rownum)
|
||||
(defvar org-e-html-table-cur-rowgrp-is-hdr)
|
||||
(defvar org-lparse-table-is-styled)
|
||||
|
||||
|
||||
|
||||
;;; User Configuration Variables
|
||||
@ -1019,24 +1012,24 @@ in order to mimic default behaviour:
|
||||
|
||||
(defcustom org-e-html-quotes
|
||||
'(("fr"
|
||||
("\\(\\s-\\|[[(]\\)\"" . "«~")
|
||||
("\\(\\s-\\|[[(]\\|^\\)\"" . "«~")
|
||||
("\\(\\S-\\)\"" . "~»")
|
||||
("\\(\\s-\\|(\\)'" . "'"))
|
||||
("\\(\\s-\\|(\\|^\\)'" . "'"))
|
||||
("en"
|
||||
("\\(\\s-\\|[[(]\\)\"" . "``")
|
||||
("\\(\\s-\\|[[(]\\|^\\)\"" . "``")
|
||||
("\\(\\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
|
||||
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."
|
||||
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-html
|
||||
:type '(list
|
||||
(cons :tag "Opening quote"
|
||||
@ -1049,7 +1042,6 @@ replacement string for this quote."
|
||||
(string :tag "Regexp for char before")
|
||||
(string :tag "Replacement quote "))))
|
||||
|
||||
|
||||
;;;; Compilation
|
||||
|
||||
|
||||
@ -1083,13 +1075,6 @@ DESC is the link description, if any.
|
||||
ATTR is a string of other attributes of the \"a\" element."
|
||||
(declare (special org-lparse-par-open))
|
||||
(save-match-data
|
||||
(when (string= type-1 "coderef")
|
||||
(let ((ref fragment))
|
||||
(setq desc (format (org-export-get-coderef-format ref (and descp desc))
|
||||
(cdr (assoc ref org-export-code-refs)))
|
||||
fragment (concat "coderef-" ref)
|
||||
attr (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
|
||||
fragment fragment))))
|
||||
(let* ((may-inline-p
|
||||
(and (member type-1 '("http" "https" "file"))
|
||||
(org-lparse-should-inline-p path descp)
|
||||
@ -1393,14 +1378,6 @@ Replaces invalid characters with \"_\"."
|
||||
"<table>\n%s\n</table>\n"
|
||||
(mapconcat 'org-e-html-format-footnote-definition fn-alist "\n"))))))
|
||||
|
||||
(defun org-e-html-get-coding-system-for-write ()
|
||||
(or org-e-html-coding-system
|
||||
(and (boundp 'buffer-file-coding-system) buffer-file-coding-system)))
|
||||
|
||||
(defun org-e-html-get-coding-system-for-save ()
|
||||
(or org-e-html-coding-system
|
||||
(and (boundp 'buffer-file-coding-system) buffer-file-coding-system)))
|
||||
|
||||
(defun org-e-html-format-date (info)
|
||||
(let ((date (plist-get info :date)))
|
||||
(cond
|
||||
@ -2785,208 +2762,148 @@ contextual information."
|
||||
(format "<sup>%s</sup>" contents))
|
||||
|
||||
|
||||
;;;; Tabel Cell
|
||||
|
||||
(defun org-e-html-table-cell (table-cell contents info)
|
||||
"Transcode a TABLE-CELL element from Org to HTML.
|
||||
CONTENTS is nil. INFO is a plist used as a communication
|
||||
channel."
|
||||
(let* ((value (org-export-secondary-string
|
||||
(org-element-property :value table-cell) 'e-html info))
|
||||
(value (if (string= "" (org-trim value)) " " value))
|
||||
(table-row (org-export-get-parent table-cell info))
|
||||
(cell-attrs
|
||||
(if (not org-e-html-table-align-individual-fields) ""
|
||||
(format (if (and (boundp 'org-e-html-format-table-no-css)
|
||||
org-e-html-format-table-no-css)
|
||||
" align=\"%s\"" " class=\"%s\"")
|
||||
(org-export-table-cell-alignment table-cell info)))))
|
||||
(cond
|
||||
((= 1 (org-export-table-row-group table-row info))
|
||||
(concat "\n" (format (car org-e-html-table-header-tags) "col" cell-attrs)
|
||||
value (cdr org-e-html-table-header-tags)))
|
||||
((and org-e-html-table-use-header-tags-for-first-column
|
||||
(zerop (cdr (org-export-table-cell-address table-cell info))))
|
||||
(concat "\n" (format (car org-e-html-table-header-tags) "row" cell-attrs)
|
||||
value (cdr org-e-html-table-header-tags)))
|
||||
(t (concat "\n" (format (car org-e-html-table-data-tags) cell-attrs)
|
||||
value (cdr org-e-html-table-data-tags))))))
|
||||
|
||||
|
||||
;;;; Table Row
|
||||
|
||||
(defun org-e-html-table-row (table-row contents info)
|
||||
"Transcode a TABLE-ROW element from Org to HTML.
|
||||
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* ((first-rowgroup-p (= 1 (org-export-table-row-group table-row info)))
|
||||
(rowgroup-tags
|
||||
(cond
|
||||
;; Case 1: Row belongs to second or subsequent rowgroups.
|
||||
((not (= 1 (org-export-table-row-group table-row info)))
|
||||
'("\n<tbody>" . "\n</tbody>"))
|
||||
;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups.
|
||||
((org-export-table-has-header-p
|
||||
(org-export-get-parent-table table-row info) info)
|
||||
'("\n<thead>" . "\n</thead>"))
|
||||
;; Case 2: Row is from first and only row group.
|
||||
(t '("\n<tbody>" . "\n</tbody>")))))
|
||||
(concat
|
||||
;; Begin a rowgroup?
|
||||
(when (org-export-table-row-starts-rowgroup-p table-row info)
|
||||
(car rowgroup-tags))
|
||||
;; Actual table row
|
||||
(concat "\n" (eval (car org-e-html-table-row-tags))
|
||||
contents (eval (cdr org-e-html-table-row-tags)))
|
||||
;; End a rowgroup?
|
||||
(when (org-export-table-row-ends-rowgroup-p table-row info)
|
||||
(cdr rowgroup-tags))))))
|
||||
|
||||
|
||||
;;;; Table
|
||||
|
||||
(defun org-e-html-begin-table (caption label attributes)
|
||||
(let* ((html-table-tag (or (plist-get info :html-table-tag) ; FIXME
|
||||
org-e-html-table-tag))
|
||||
(html-table-tag
|
||||
(org-e-html-splice-attributes html-table-tag attributes)))
|
||||
(when label
|
||||
(setq html-table-tag
|
||||
(org-e-html-splice-attributes
|
||||
html-table-tag
|
||||
(format "id=\"%s\"" (org-solidify-link-text label)))))
|
||||
(concat "\n" html-table-tag
|
||||
(format "\n<caption>%s</caption>" (or caption "")))))
|
||||
(defun org-export-table-sample-row (table info)
|
||||
"A sample row from TABLE."
|
||||
(let ((table-row
|
||||
(org-element-map
|
||||
table 'table-row
|
||||
(lambda (row)
|
||||
(unless (eq (org-element-property :type row) 'rule) row))
|
||||
info 'first-match))
|
||||
(special-column-p (org-export-table-has-special-column-p table)))
|
||||
(if (not special-column-p) (org-element-contents table-row)
|
||||
(cdr (org-element-contents table-row)))))
|
||||
|
||||
(defun org-e-html-end-table ()
|
||||
"</table>\n")
|
||||
|
||||
(defun org-e-html-format-table-cell (text r c horiz-span)
|
||||
(let ((cell-style-cookie
|
||||
(if org-e-html-table-align-individual-fields
|
||||
(format (if (and (boundp 'org-e-html-format-table-no-css)
|
||||
org-e-html-format-table-no-css)
|
||||
" align=\"%s\"" " class=\"%s\"")
|
||||
(or (aref (plist-get table-info :alignment) c) "left")) ""))) ;; FIXME
|
||||
(cond
|
||||
(org-e-html-table-cur-rowgrp-is-hdr
|
||||
(concat
|
||||
(format (car org-e-html-table-header-tags) "col" cell-style-cookie)
|
||||
text (cdr org-e-html-table-header-tags)))
|
||||
((and (= c 0) org-e-html-table-use-header-tags-for-first-column)
|
||||
(concat
|
||||
(format (car org-e-html-table-header-tags) "row" cell-style-cookie)
|
||||
text (cdr org-e-html-table-header-tags)))
|
||||
(t
|
||||
(concat
|
||||
(format (car org-e-html-table-data-tags) cell-style-cookie)
|
||||
text (cdr org-e-html-table-data-tags))))))
|
||||
|
||||
(defun org-e-html-format-table-row (row)
|
||||
(concat (eval (car org-e-html-table-row-tags)) row
|
||||
(eval (cdr org-e-html-table-row-tags))))
|
||||
|
||||
(defun org-e-html-table-row (fields &optional text-for-empty-fields)
|
||||
(incf org-e-html-table-rownum)
|
||||
(let ((i -1))
|
||||
(org-e-html-format-table-row
|
||||
(mapconcat
|
||||
(lambda (x)
|
||||
(when (and (string= x "") text-for-empty-fields)
|
||||
(setq x text-for-empty-fields))
|
||||
(incf i)
|
||||
(let (horiz-span)
|
||||
(org-e-html-format-table-cell
|
||||
x org-e-html-table-rownum i (or horiz-span 0))))
|
||||
fields "\n"))))
|
||||
|
||||
(defun org-e-html-end-table-rowgroup ()
|
||||
(when org-e-html-table-rowgrp-open
|
||||
(setq org-e-html-table-rowgrp-open nil)
|
||||
(if org-e-html-table-cur-rowgrp-is-hdr "</thead>" "</tbody>")))
|
||||
|
||||
(defun org-e-html-begin-table-rowgroup (&optional is-header-row)
|
||||
(concat
|
||||
(when org-e-html-table-rowgrp-open
|
||||
(org-e-html-end-table-rowgroup))
|
||||
(progn
|
||||
(setq org-e-html-table-rowgrp-open t)
|
||||
(setq org-e-html-table-cur-rowgrp-is-hdr is-header-row)
|
||||
(if is-header-row "<thead>" "<tbody>"))))
|
||||
|
||||
(defun org-e-html-table-preamble ()
|
||||
(let ((colgroup-vector (plist-get table-info :column-groups)) ;; FIXME
|
||||
c gr colgropen preamble)
|
||||
(unless (aref colgroup-vector 0)
|
||||
(setf (aref colgroup-vector 0) 'start))
|
||||
(dotimes (c columns-number preamble)
|
||||
(setq gr (aref colgroup-vector c))
|
||||
(setq preamble
|
||||
(concat
|
||||
preamble
|
||||
(when (memq gr '(start start-end))
|
||||
(prog1 (if colgropen "</colgroup>\n<colgroup>" "\n<colgroup>")
|
||||
(setq colgropen t)))
|
||||
(let* ((colalign-vector (plist-get table-info :alignment)) ;; FIXME
|
||||
(align (cdr (assoc (aref colalign-vector c)
|
||||
'(("l" . "left")
|
||||
("r" . "right")
|
||||
("c" . "center")))))
|
||||
(alignspec (if (and (boundp 'org-e-html-format-table-no-css)
|
||||
org-e-html-format-table-no-css)
|
||||
" align=\"%s\"" " class=\"%s\""))
|
||||
(extra (format alignspec align)))
|
||||
(format "<col%s />" extra))
|
||||
(when (memq gr '(end start-end))
|
||||
(setq colgropen nil)
|
||||
"</colgroup>"))))
|
||||
(concat preamble (if colgropen "</colgroup>"))))
|
||||
|
||||
(defun org-e-html-list-table (lines caption label attributes)
|
||||
(setq lines (org-e-html-org-table-to-list-table lines))
|
||||
(let* ((splice nil) head
|
||||
(org-e-html-table-rownum -1)
|
||||
i (cnt 0)
|
||||
fields line
|
||||
org-e-html-table-cur-rowgrp-is-hdr
|
||||
org-e-html-table-rowgrp-open
|
||||
n
|
||||
(org-lparse-table-style 'org-table)
|
||||
org-lparse-table-is-styled)
|
||||
(cond
|
||||
(splice
|
||||
(setq org-lparse-table-is-styled nil)
|
||||
(mapconcat 'org-e-html-table-row lines "\n"))
|
||||
(t
|
||||
(setq org-lparse-table-is-styled t)
|
||||
|
||||
(concat
|
||||
(org-e-html-begin-table caption label attributes)
|
||||
(org-e-html-table-preamble)
|
||||
(org-e-html-begin-table-rowgroup head)
|
||||
|
||||
(mapconcat
|
||||
(lambda (line)
|
||||
(cond
|
||||
((equal line 'hline) (org-e-html-begin-table-rowgroup))
|
||||
(t (org-e-html-table-row line))))
|
||||
lines "\n")
|
||||
|
||||
(org-e-html-end-table-rowgroup)
|
||||
(org-e-html-end-table))))))
|
||||
|
||||
(defun org-e-html-transcode-table-row (row)
|
||||
(if (string-match org-table-hline-regexp row) 'hline
|
||||
(mapcar
|
||||
(lambda (cell)
|
||||
(org-export-secondary-string
|
||||
(let ((cell (org-element-parse-secondary-string
|
||||
cell
|
||||
(cdr (assq 'table org-element-string-restrictions)))))
|
||||
cell)
|
||||
'e-html info))
|
||||
(org-split-string row "[ \t]*|[ \t]*"))))
|
||||
|
||||
(defun org-e-html-org-table-to-list-table (lines &optional splice)
|
||||
"Convert org-table to list-table.
|
||||
LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
|
||||
element is a `string' representing a single row of org-table.
|
||||
Thus each ROW has vertical separators \"|\" separating the table
|
||||
fields. A ROW could also be a row-group separator of the form
|
||||
\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
|
||||
...). ROW could either be symbol `'hline' or a list of the
|
||||
form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
|
||||
(let (line lines-1)
|
||||
(cond
|
||||
(splice
|
||||
(while (setq line (pop lines))
|
||||
(unless (string-match "^[ \t]*|-" line)
|
||||
(push (org-e-html-transcode-table-row line) lines-1))))
|
||||
(t (while (setq line (pop lines))
|
||||
(cond
|
||||
((string-match "^[ \t]*|-" line)
|
||||
(when lines (push 'hline lines-1)))
|
||||
(t (push (org-e-html-transcode-table-row line) lines-1))))))
|
||||
(nreverse lines-1)))
|
||||
|
||||
(defun org-e-html-table-table (raw-table)
|
||||
(require 'table)
|
||||
(with-current-buffer (get-buffer-create "*org-export-table*")
|
||||
(erase-buffer))
|
||||
(let ((output (with-temp-buffer
|
||||
(insert raw-table)
|
||||
(goto-char 1)
|
||||
(re-search-forward "^[ \t]*|[^|]" nil t)
|
||||
(table-generate-source 'html "*org-export-table*")
|
||||
(with-current-buffer "*org-export-table*"
|
||||
(org-trim (buffer-string))))))
|
||||
(kill-buffer (get-buffer "*org-export-table*"))
|
||||
output))
|
||||
(defun org-e-html-table--table.el-table (table info)
|
||||
(when (eq (org-element-property :type table) 'table.el)
|
||||
(require 'table)
|
||||
(let ((outbuf (with-current-buffer
|
||||
(get-buffer-create "*org-export-table*")
|
||||
(erase-buffer) (current-buffer))))
|
||||
(with-temp-buffer
|
||||
(insert (org-element-property :value table))
|
||||
(goto-char 1)
|
||||
(re-search-forward "^[ \t]*|[^|]" nil t)
|
||||
(table-generate-source 'html outbuf))
|
||||
(with-current-buffer outbuf
|
||||
(prog1 (org-trim (buffer-string))
|
||||
(kill-buffer) )))))
|
||||
|
||||
(defun org-e-html-table (table contents info)
|
||||
"Transcode a TABLE element from Org to HTML.
|
||||
CONTENTS is nil. INFO is a plist holding contextual information."
|
||||
(let* ((label (org-element-property :name table))
|
||||
(caption (org-e-html--caption/label-string
|
||||
(org-element-property :caption table) label info))
|
||||
(attr (mapconcat #'identity
|
||||
(org-element-property :attr_html table)
|
||||
" "))
|
||||
(raw-table (org-element-property :raw-table table))
|
||||
(table-type (org-element-property :type table)))
|
||||
(case table-type
|
||||
(table.el
|
||||
(org-e-html-table-table raw-table))
|
||||
(t
|
||||
(let* ((table-info (org-export-table-format-info raw-table))
|
||||
(columns-number (length (plist-get table-info :alignment)))
|
||||
(lines (org-split-string
|
||||
(org-export-clean-table
|
||||
raw-table (plist-get table-info :special-column-p)) "\n")))
|
||||
(org-e-html-list-table lines caption label attr))))))
|
||||
|
||||
(case (org-element-property :type table)
|
||||
;; Case 1: table.el table. Convert it using appropriate tools.
|
||||
(table.el (org-e-html-table--table.el-table table info))
|
||||
;; Case 2: Standard table.
|
||||
(t
|
||||
(let* ((label (org-element-property :name table))
|
||||
(caption (org-e-html--caption/label-string
|
||||
(org-element-property :caption table) label info))
|
||||
(attributes (mapconcat #'identity
|
||||
(org-element-property :attr_html table)
|
||||
" "))
|
||||
(alignspec
|
||||
(if (and (boundp 'org-e-html-format-table-no-css)
|
||||
org-e-html-format-table-no-css)
|
||||
"align=\"%s\"" "class=\"%s\""))
|
||||
(table-column-specs
|
||||
(function
|
||||
(lambda (table info)
|
||||
(mapconcat
|
||||
(lambda (table-cell)
|
||||
(let ((alignment (org-export-table-cell-alignment
|
||||
table-cell info)))
|
||||
(concat
|
||||
;; Begin a colgroup?
|
||||
(when (org-export-table-cell-starts-colgroup-p
|
||||
table-cell info)
|
||||
"\n<colgroup>")
|
||||
;; Add a column. Also specify it's alignment.
|
||||
(format "\n<col %s/>" (format alignspec alignment))
|
||||
;; End a colgroup?
|
||||
(when (org-export-table-cell-ends-colgroup-p
|
||||
table-cell info)
|
||||
"\n</colgroup>"))))
|
||||
(org-export-table-sample-row table info) "\n"))))
|
||||
(table-attributes
|
||||
(let ((table-tag (plist-get info :html-table-tag)))
|
||||
(concat
|
||||
(and (string-match "<table\\(.*\\)>" table-tag)
|
||||
(match-string 1 table-tag))
|
||||
(and label (format " id=\"%s\""
|
||||
(org-solidify-link-text label)))))))
|
||||
;; Remove last blank line.
|
||||
(setq contents (substring contents 0 -1))
|
||||
;; FIXME: splice
|
||||
(format "\n<table%s>\n<caption>%s</caption>\n%s\n%s\n</table>"
|
||||
table-attributes
|
||||
(or caption "")
|
||||
(funcall table-column-specs table info)
|
||||
contents)))))
|
||||
|
||||
;;;; Target
|
||||
|
||||
@ -3109,6 +3026,7 @@ directory.
|
||||
|
||||
Return output file's name."
|
||||
(interactive)
|
||||
(setq debug-on-error t) ; FIXME
|
||||
(let* ((extension (concat "." org-e-html-extension))
|
||||
(file (org-export-output-file-name extension subtreep pub-dir)))
|
||||
(org-export-to-file
|
||||
|
||||
@ -239,19 +239,6 @@
|
||||
))
|
||||
(t (error "Unknown list type"))))
|
||||
|
||||
(defun org-e-odt-discontinue-list ()
|
||||
(let ((stashed-stack org-lparse-list-stack))
|
||||
(loop for list-type in stashed-stack
|
||||
do (org-lparse-end-list-item-1 list-type)
|
||||
(org-lparse-end-list list-type))
|
||||
(setq org-e-odt-list-stack-stashed stashed-stack)))
|
||||
|
||||
(defun org-e-odt-continue-list ()
|
||||
(setq org-e-odt-list-stack-stashed (nreverse org-e-odt-list-stack-stashed))
|
||||
(loop for list-type in org-e-odt-list-stack-stashed
|
||||
do (org-lparse-begin-list list-type)
|
||||
(org-lparse-begin-list-item list-type)))
|
||||
|
||||
(defun org-e-odt-write-automatic-styles ()
|
||||
"Write automatic styles to \"content.xml\"."
|
||||
(with-current-buffer
|
||||
@ -266,6 +253,25 @@
|
||||
(when (setq props (or (plist-get props :rel-width) 96))
|
||||
(insert (format org-e-odt-table-style-format style-name props))))))
|
||||
|
||||
(defun org-e-odt-update-display-level (&optional level)
|
||||
(with-current-buffer
|
||||
(find-file-noselect (expand-file-name "content.xml") t)
|
||||
;; position the cursor.
|
||||
(goto-char (point-min))
|
||||
;; remove existing sequence decls.
|
||||
(when (re-search-forward "<text:sequence-decls" nil t)
|
||||
(delete-region (match-beginning 0)
|
||||
(re-search-forward "</text:sequence-decls>" nil nil)))
|
||||
;; insert new ones.
|
||||
(insert "
|
||||
<text:sequence-decls>")
|
||||
(loop for x in org-e-odt-category-map-alist
|
||||
do (insert (format "
|
||||
<text:sequence-decl text:display-outline-level=\"%d\" text:name=\"%s\"/>"
|
||||
level (nth 1 x))))
|
||||
(insert "
|
||||
</text:sequence-decls>")))
|
||||
|
||||
(defun org-e-odt-add-automatic-style (object-type &optional object-props)
|
||||
"Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
|
||||
OBJECT-PROPS is (typically) a plist created by passing
|
||||
@ -291,203 +297,6 @@ new entry in `org-e-odt-automatic-styles'. Return (OBJECT-NAME
|
||||
(plist-get org-e-odt-automatic-styles object)))))
|
||||
(cons object-name style-name)))
|
||||
|
||||
(defun org-e-odt-format-table-columns ()
|
||||
(let* ((num-cols (length (plist-get table-info :alignment)))
|
||||
(col-nos (loop for i from 0 below num-cols collect i))
|
||||
(levels )
|
||||
(col-widths (plist-get table-info :width))
|
||||
(style (or (nth 1 org-e-odt-table-style-spec) "OrgTable")))
|
||||
(mapconcat
|
||||
(lambda (c)
|
||||
(let* ((width (or (and org-lparse-table-is-styled (aref col-widths c))
|
||||
0)))
|
||||
(org-e-odt-make-string
|
||||
(1+ width)
|
||||
(org-e-odt-format-tags
|
||||
"<table:table-column table:style-name=\"%sColumn\"/>" "" style))))
|
||||
col-nos "\n")))
|
||||
|
||||
(defun org-e-odt-begin-table (caption-from info)
|
||||
(let* ((captions (org-e-odt-format-label caption-from info 'definition))
|
||||
(caption (car captions)) (short-caption (cdr captions))
|
||||
(attributes (mapconcat #'identity
|
||||
(org-element-property :attr_odt caption-from)
|
||||
" "))
|
||||
(attributes (org-e-odt-parse-block-attributes attributes)))
|
||||
;; (setq org-e-odt-table-indentedp (not (null org-lparse-list-stack)))
|
||||
(setq org-e-odt-table-indentedp nil) ; FIXME
|
||||
(when org-e-odt-table-indentedp
|
||||
;; Within the Org file, the table is appearing within a list item.
|
||||
;; OpenDocument doesn't allow table to appear within list items.
|
||||
;; Temporarily terminate the list, emit the table and then
|
||||
;; re-continue the list.
|
||||
(org-e-odt-discontinue-list)
|
||||
;; Put the Table in an indented section.
|
||||
(let ((level (length org-e-odt-list-stack-stashed)))
|
||||
(org-e-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
|
||||
(setq org-e-odt-table-style (plist-get attributes :style))
|
||||
(setq org-e-odt-table-style-spec
|
||||
(assoc org-e-odt-table-style org-e-odt-table-styles))
|
||||
(concat
|
||||
(and caption (org-e-odt-format-stylized-paragraph 'table caption))
|
||||
(let ((automatic-name (org-e-odt-add-automatic-style "Table" attributes)))
|
||||
(format
|
||||
"\n<table:table table:name=\"%s\" table:style-name=\"%s\">\n"
|
||||
(or short-caption (car automatic-name))
|
||||
(or (nth 1 org-e-odt-table-style-spec) (cdr automatic-name) "OrgTable")))
|
||||
(org-e-odt-format-table-columns) "\n")))
|
||||
|
||||
(defun org-e-odt-end-table ()
|
||||
(concat
|
||||
"</table:table>"
|
||||
;; (when org-e-odt-table-indentedp
|
||||
;; (org-e-odt-end-section)
|
||||
;; (org-e-odt-continue-list))
|
||||
))
|
||||
|
||||
(defun org-e-odt-begin-table-rowgroup (&optional is-header-row)
|
||||
(prog1
|
||||
(concat (when org-e-odt-table-rowgrp-open
|
||||
(org-e-odt-end-table-rowgroup))
|
||||
(if is-header-row "<table:table-header-rows>"
|
||||
"<table:table-rows>"))
|
||||
(setq org-e-odt-table-rowgrp-open t)
|
||||
(setq org-e-odt-table-cur-rowgrp-is-hdr is-header-row)))
|
||||
|
||||
(defun org-e-odt-end-table-rowgroup ()
|
||||
(when org-e-odt-table-rowgrp-open
|
||||
(setq org-e-odt-table-rowgrp-open nil)
|
||||
(if org-e-odt-table-cur-rowgrp-is-hdr
|
||||
"</table:table-header-rows>" "</table:table-rows>")))
|
||||
|
||||
(defun org-e-odt-format-table-row (row)
|
||||
(org-e-odt-format-tags
|
||||
'("<table:table-row>" . "</table:table-row>") row))
|
||||
|
||||
(defun org-e-odt-get-column-alignment (c)
|
||||
(let ((colalign-vector (plist-get table-info :alignment)))
|
||||
;; FIXME
|
||||
(assoc-default (aref colalign-vector c)
|
||||
'(("l" . "left")
|
||||
("r" . "right")
|
||||
("c" . "center")))))
|
||||
|
||||
(defun org-e-odt-get-table-cell-styles (r c &optional style-spec)
|
||||
"Retrieve styles applicable to a table cell.
|
||||
R and C are (zero-based) row and column numbers of the table
|
||||
cell. STYLE-SPEC is an entry in `org-e-odt-table-styles'
|
||||
applicable to the current table. It is `nil' if the table is not
|
||||
associated with any style attributes.
|
||||
|
||||
Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
|
||||
|
||||
When STYLE-SPEC is nil, style the table cell the conventional way
|
||||
- choose cell borders based on row and column groupings and
|
||||
choose paragraph alignment based on `org-col-cookies' text
|
||||
property. See also
|
||||
`org-e-odt-get-paragraph-style-cookie-for-table-cell'.
|
||||
|
||||
When STYLE-SPEC is non-nil, ignore the above cookie and return
|
||||
styles congruent with the ODF-1.2 specification."
|
||||
(cond
|
||||
(style-spec
|
||||
|
||||
;; LibreOffice - particularly the Writer - honors neither table
|
||||
;; templates nor custom table-cell styles. Inorder to retain
|
||||
;; inter-operability with LibreOffice, only automatic styles are
|
||||
;; used for styling of table-cells. The current implementation is
|
||||
;; congruent with ODF-1.2 specification and hence is
|
||||
;; future-compatible.
|
||||
|
||||
;; Additional Note: LibreOffice's AutoFormat facility for tables -
|
||||
;; which recognizes as many as 16 different cell types - is much
|
||||
;; richer. Unfortunately it is NOT amenable to easy configuration
|
||||
;; by hand.
|
||||
|
||||
(let* ((template-name (nth 1 style-spec))
|
||||
(cell-style-selectors (nth 2 style-spec))
|
||||
(cell-type
|
||||
(cond
|
||||
((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
|
||||
(= c 0)) "FirstColumn")
|
||||
((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
|
||||
(= c (1- org-lparse-table-ncols))) "LastColumn")
|
||||
((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
|
||||
(= r 0)) "FirstRow")
|
||||
((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
|
||||
(= r org-e-odt-table-rownum))
|
||||
"LastRow")
|
||||
((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
|
||||
(= (% r 2) 1)) "EvenRow")
|
||||
((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
|
||||
(= (% r 2) 0)) "OddRow")
|
||||
((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
|
||||
(= (% c 2) 1)) "EvenColumn")
|
||||
((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
|
||||
(= (% c 2) 0)) "OddColumn")
|
||||
(t ""))))
|
||||
(cons
|
||||
(concat template-name cell-type "TableCell")
|
||||
(concat template-name cell-type "TableParagraph"))))
|
||||
(t
|
||||
(cons
|
||||
(concat
|
||||
"OrgTblCell"
|
||||
(cond
|
||||
((= r 0) "T")
|
||||
((eq (cdr (assoc r nil ;; org-lparse-table-rowgrp-info FIXME
|
||||
)) :start) "T")
|
||||
(t ""))
|
||||
(when (= r org-e-odt-table-rownum) "B")
|
||||
(cond
|
||||
((= c 0) "")
|
||||
((or (memq (nth c org-table-colgroup-info) '(:start :startend))
|
||||
(memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
|
||||
(t "")))
|
||||
(capitalize (org-e-odt-get-column-alignment c))))))
|
||||
|
||||
(defun org-e-odt-get-paragraph-style-cookie-for-table-cell (r c)
|
||||
(concat
|
||||
(and (not org-e-odt-table-style-spec)
|
||||
(cond
|
||||
(org-e-odt-table-cur-rowgrp-is-hdr "OrgTableHeading")
|
||||
((and (= c 0) nil
|
||||
;; (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS)
|
||||
)
|
||||
"OrgTableHeading")
|
||||
(t "OrgTableContents")))
|
||||
(and org-lparse-table-is-styled
|
||||
(cdr (org-e-odt-get-table-cell-styles
|
||||
r c org-e-odt-table-style-spec)))))
|
||||
|
||||
(defun org-e-odt-get-style-name-cookie-for-table-cell (r c)
|
||||
(when org-lparse-table-is-styled
|
||||
(let* ((cell-styles (org-e-odt-get-table-cell-styles
|
||||
r c org-e-odt-table-style-spec))
|
||||
(table-cell-style (car cell-styles)))
|
||||
table-cell-style)))
|
||||
|
||||
(defun org-e-odt-format-table-cell (data r c horiz-span)
|
||||
(concat
|
||||
(let* ((paragraph-style-cookie
|
||||
(org-e-odt-get-paragraph-style-cookie-for-table-cell r c))
|
||||
(style-name-cookie
|
||||
(org-e-odt-get-style-name-cookie-for-table-cell r c))
|
||||
(extra (and style-name-cookie
|
||||
(format " table:style-name=\"%s\"" style-name-cookie)))
|
||||
(extra (concat extra
|
||||
(and (> horiz-span 0)
|
||||
(format " table:number-columns-spanned=\"%d\""
|
||||
(1+ horiz-span))))))
|
||||
(org-e-odt-format-tags
|
||||
'("<table:table-cell%s>" . "</table:table-cell>")
|
||||
(if org-lparse-list-table-p data
|
||||
(org-e-odt-format-stylized-paragraph paragraph-style-cookie data)) extra))
|
||||
(let (s)
|
||||
(dotimes (i horiz-span)
|
||||
(setq s (concat s "\n<table:covered-table-cell/>"))) s)
|
||||
"\n"))
|
||||
|
||||
(defun org-e-odt-begin-toc (lang-specific-heading max-level)
|
||||
(concat
|
||||
(format "
|
||||
@ -742,7 +551,7 @@ Update styles.xml with styles that were collected as part of
|
||||
:row-groups (0)
|
||||
:special-column-p nil :width [8 1]))
|
||||
(org-lparse-table-ncols 2)) ; FIXME
|
||||
(org-e-odt-list-table
|
||||
(org-e-odt-list-table ; FIXME
|
||||
(list
|
||||
(list
|
||||
(org-e-odt-format-entity
|
||||
@ -912,13 +721,13 @@ ATTR is a string of other attributes of the a element."
|
||||
n note-class ref-format ref-name)
|
||||
"OrgSuperscript")))
|
||||
|
||||
(defun org-e-odt-parse-block-attributes (params)
|
||||
(save-match-data
|
||||
(when params
|
||||
(setq params (org-trim params))
|
||||
(unless (string-match "\\`(.*)\\'" params)
|
||||
(setq params (format "(%s)" params)))
|
||||
(ignore-errors (read params)))))
|
||||
(defun org-e-odt-element-attributes (element info)
|
||||
(let* ((raw-attr (org-element-property :attr_odt element))
|
||||
(raw-attr (and raw-attr
|
||||
(org-trim (mapconcat #'identity raw-attr " ")))))
|
||||
(unless (and raw-attr (string-match "\\`(.*)\\'" raw-attr))
|
||||
(setq raw-attr (format "(%s)" raw-attr)))
|
||||
(ignore-errors (read raw-attr))))
|
||||
|
||||
(defun org-e-odt-format-object-description (title description)
|
||||
(concat (and title (org-e-odt-format-tags
|
||||
@ -1170,12 +979,13 @@ ATTR is a string of other attributes of the a element."
|
||||
(find-file-noselect content-file t)
|
||||
(current-buffer))))
|
||||
|
||||
|
||||
|
||||
(defun org-e-odt-save-as-outfile (target opt-plist)
|
||||
;; write automatic styles
|
||||
(org-e-odt-write-automatic-styles)
|
||||
|
||||
;; update display levels
|
||||
(org-e-odt-update-display-level org-e-odt-display-outline-level)
|
||||
|
||||
;; write styles file
|
||||
;; (when (equal org-lparse-backend 'odt) FIXME
|
||||
;; )
|
||||
@ -3632,14 +3442,8 @@ used as a communication channel."
|
||||
(attr-from (case (org-element-type element)
|
||||
(link (org-export-get-parent-paragraph element info))
|
||||
(t element)))
|
||||
(attr (let ((raw-attr
|
||||
(mapconcat #'identity
|
||||
(org-element-property :attr_odt attr-from)
|
||||
" ")))
|
||||
(unless (string= raw-attr "") raw-attr)))
|
||||
(attr (if (not attr) "" (org-trim attr)))
|
||||
;; convert attributes to a plist.
|
||||
(attr-plist (org-e-odt-parse-block-attributes attr))
|
||||
(attr-plist (org-e-odt-element-attributes attr-from info))
|
||||
;; handle `:anchor', `:style' and `:attributes' properties.
|
||||
(user-frame-anchor
|
||||
(car (assoc-string (plist-get attr-plist :anchor)
|
||||
@ -3660,8 +3464,6 @@ used as a communication channel."
|
||||
"paragraph" ; FIXME
|
||||
))
|
||||
(width (car size)) (height (cdr size))
|
||||
|
||||
|
||||
(embed-as
|
||||
(case (org-element-type element)
|
||||
((org-e-odt-standalone-image-p element info) "paragraph")
|
||||
@ -3669,6 +3471,7 @@ used as a communication channel."
|
||||
(latex-environment "paragraph")
|
||||
(t "paragraph")))
|
||||
(captions (org-e-odt-format-label element info 'definition))
|
||||
(caption (car captions)) (short-caption (cdr captions))
|
||||
(entity (concat (and caption "Captioned") embed-as "Image")))
|
||||
(org-e-odt-format-entity entity href width height
|
||||
captions user-frame-params )))
|
||||
@ -4087,155 +3890,205 @@ contextual information."
|
||||
(org-e-odt-format-fontify contents 'superscript))
|
||||
|
||||
|
||||
;;;; Table
|
||||
;;;; Table Cell
|
||||
|
||||
(defun org-e-odt-get-colwidth (c)
|
||||
(let ((col-widths (plist-get table-info :width)))
|
||||
(or (and org-lparse-table-is-styled (aref col-widths c)) 0)))
|
||||
(defun org-e-odt-table-style-spec (element info)
|
||||
(let* ((table (org-export-get-parent-table element info))
|
||||
(table-attributes (org-e-odt-element-attributes table info))
|
||||
(table-style (plist-get table-attributes :style)))
|
||||
(assoc table-style org-e-odt-table-styles)))
|
||||
|
||||
(defun org-e-odt-table-row (fields &optional text-for-empty-fields)
|
||||
(incf org-e-odt-table-rownum)
|
||||
(let ((i -1))
|
||||
(org-e-odt-format-table-row
|
||||
(mapconcat
|
||||
(lambda (x)
|
||||
(when (and (string= x "") text-for-empty-fields)
|
||||
(setq x text-for-empty-fields))
|
||||
(incf i)
|
||||
(let ((horiz-span (org-e-odt-get-colwidth i)))
|
||||
(org-e-odt-format-table-cell
|
||||
x org-e-odt-table-rownum i horiz-span)))
|
||||
fields "\n"))))
|
||||
(defun org-e-odt-get-table-cell-styles (table-cell info)
|
||||
"Retrieve styles applicable to a table cell.
|
||||
R and C are (zero-based) row and column numbers of the table
|
||||
cell. STYLE-SPEC is an entry in `org-e-odt-table-styles'
|
||||
applicable to the current table. It is `nil' if the table is not
|
||||
associated with any style attributes.
|
||||
|
||||
(defun org-e-odt-table-preamble ()
|
||||
(let ((colgroup-vector (plist-get table-info :column-groups)) ;; FIXME
|
||||
c gr colgropen preamble)
|
||||
(unless (aref colgroup-vector 0)
|
||||
(setf (aref colgroup-vector 0) 'start))
|
||||
(dotimes (c columns-number preamble)
|
||||
(setq gr (aref colgroup-vector c))
|
||||
(setq preamble
|
||||
(concat
|
||||
preamble
|
||||
(when (memq gr '(start start-end))
|
||||
(prog1 (if colgropen "</colgroup>\n<colgroup>" "\n<colgroup>")
|
||||
(setq colgropen t)))
|
||||
(let* ((colalign-vector (plist-get table-info :alignment)) ;; FIXME
|
||||
(align (cdr (assoc (aref colalign-vector c)
|
||||
'(("l" . "left")
|
||||
("r" . "right")
|
||||
("c" . "center")))))
|
||||
(alignspec (if (and (boundp 'org-e-odt-format-table-no-css)
|
||||
org-e-odt-format-table-no-css)
|
||||
" align=\"%s\"" " class=\"%s\""))
|
||||
(extra (format alignspec align)))
|
||||
(format "<col%s />" extra))
|
||||
(when (memq gr '(end start-end))
|
||||
(setq colgropen nil)
|
||||
"</colgroup>"))))
|
||||
(concat preamble (if colgropen "</colgroup>"))))
|
||||
Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
|
||||
|
||||
(defun org-e-odt-list-table (lines caption-from info)
|
||||
(let* ((splice nil) head
|
||||
(org-e-odt-table-rownum -1)
|
||||
i (cnt 0)
|
||||
fields line
|
||||
org-e-odt-table-cur-rowgrp-is-hdr
|
||||
org-e-odt-table-rowgrp-open
|
||||
n
|
||||
(org-lparse-table-style 'org-table)
|
||||
org-lparse-table-is-styled)
|
||||
(cond
|
||||
(splice
|
||||
(setq org-lparse-table-is-styled nil)
|
||||
(mapconcat 'org-e-odt-table-row lines "\n"))
|
||||
(t
|
||||
(setq org-lparse-table-is-styled t)
|
||||
When STYLE-SPEC is nil, style the table cell the conventional way
|
||||
- choose cell borders based on row and column groupings and
|
||||
choose paragraph alignment based on `org-col-cookies' text
|
||||
property. See also
|
||||
`org-e-odt-get-paragraph-style-cookie-for-table-cell'.
|
||||
|
||||
When STYLE-SPEC is non-nil, ignore the above cookie and return
|
||||
styles congruent with the ODF-1.2 specification."
|
||||
(let* ((table-cell-address (org-export-table-cell-address table-cell info))
|
||||
(r (car table-cell-address)) (c (cdr table-cell-address))
|
||||
(style-spec (org-e-odt-table-style-spec table-cell info))
|
||||
(table-dimensions (org-export-table-dimensions
|
||||
(org-export-get-parent-table table-cell info)
|
||||
info)))
|
||||
(when style-spec
|
||||
;; LibreOffice - particularly the Writer - honors neither table
|
||||
;; templates nor custom table-cell styles. Inorder to retain
|
||||
;; inter-operability with LibreOffice, only automatic styles are
|
||||
;; used for styling of table-cells. The current implementation is
|
||||
;; congruent with ODF-1.2 specification and hence is
|
||||
;; future-compatible.
|
||||
|
||||
;; Additional Note: LibreOffice's AutoFormat facility for tables -
|
||||
;; which recognizes as many as 16 different cell types - is much
|
||||
;; richer. Unfortunately it is NOT amenable to easy configuration
|
||||
;; by hand.
|
||||
(let* ((template-name (nth 1 style-spec))
|
||||
(cell-style-selectors (nth 2 style-spec))
|
||||
(cell-type
|
||||
(cond
|
||||
((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
|
||||
(= c 0)) "FirstColumn")
|
||||
((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
|
||||
(= (1+ c) (cdr table-dimensions)))
|
||||
"LastColumn")
|
||||
((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
|
||||
(= r 0)) "FirstRow")
|
||||
((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
|
||||
(= (1+ r) (car table-dimensions)))
|
||||
"LastRow")
|
||||
((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
|
||||
(= (% r 2) 1)) "EvenRow")
|
||||
((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
|
||||
(= (% r 2) 0)) "OddRow")
|
||||
((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
|
||||
(= (% c 2) 1)) "EvenColumn")
|
||||
((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
|
||||
(= (% c 2) 0)) "OddColumn")
|
||||
(t ""))))
|
||||
(concat template-name cell-type)))))
|
||||
|
||||
(defun org-e-odt-table-cell (table-cell contents info)
|
||||
"Transcode a TABLE-CELL element from Org to ODT.
|
||||
CONTENTS is nil. INFO is a plist used as a communication
|
||||
channel."
|
||||
(let* ((value (org-export-secondary-string
|
||||
(org-element-property :value table-cell) 'e-odt info))
|
||||
|
||||
(table-cell-address (org-export-table-cell-address table-cell info))
|
||||
(r (car table-cell-address))
|
||||
(c (cdr table-cell-address))
|
||||
(horiz-span (or (org-export-table-cell-width table-cell info) 0))
|
||||
(table-row (org-export-get-parent table-cell info))
|
||||
(custom-style-prefix (org-e-odt-get-table-cell-styles
|
||||
table-cell info))
|
||||
(paragraph-style
|
||||
(or
|
||||
(and custom-style-prefix
|
||||
(format "%sTableParagraph" custom-style-prefix))
|
||||
(concat
|
||||
(cond
|
||||
((and (= 1 (org-export-table-row-group table-row info))
|
||||
(org-export-table-has-header-p
|
||||
(org-export-get-parent-table table-row info) info))
|
||||
"OrgTableHeading")
|
||||
((and (zerop c) t ;; (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS)
|
||||
)
|
||||
"OrgTableHeading")
|
||||
(t "OrgTableContents"))
|
||||
(capitalize (symbol-name (org-export-table-cell-alignment
|
||||
table-cell info))))))
|
||||
(cell-style-name
|
||||
(or
|
||||
(and custom-style-prefix (format "%sTableCell"
|
||||
custom-style-prefix))
|
||||
(concat
|
||||
"OrgTblCell"
|
||||
(when (or (org-export-table-row-starts-rowgroup-p table-row info)
|
||||
(zerop r)) "T")
|
||||
(when (org-export-table-row-ends-rowgroup-p table-row info) "B")
|
||||
(when (and (org-export-table-cell-starts-colgroup-p table-cell info)
|
||||
(not (zerop c)) ) "L"))))
|
||||
(cell-attributes
|
||||
(concat
|
||||
(format " table:style-name=\"%s\"" cell-style-name)
|
||||
(and (> horiz-span 0)
|
||||
(format " table:number-columns-spanned=\"%d\""
|
||||
(1+ horiz-span))))))
|
||||
(concat
|
||||
(org-e-odt-format-tags
|
||||
'("<table:table-cell%s>" . "</table:table-cell>")
|
||||
(org-e-odt-format-stylized-paragraph paragraph-style value) cell-attributes)
|
||||
(let (s)
|
||||
(dotimes (i horiz-span s)
|
||||
(setq s (concat s "\n<table:covered-table-cell/>"))))
|
||||
"\n")))
|
||||
|
||||
|
||||
;;;; Table Row
|
||||
|
||||
(defun org-e-odt-table-row (table-row contents info)
|
||||
"Transcode a TABLE-ROW element from Org to ODT.
|
||||
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* ((rowgroup-tags
|
||||
(if (and (= 1 (org-export-table-row-group table-row info))
|
||||
(org-export-table-has-header-p
|
||||
(org-export-get-parent-table table-row info) info))
|
||||
;; If the row belongs to the first rowgroup and the
|
||||
;; table has more than one row groups, then this row
|
||||
;; belongs to the header row group.
|
||||
'("\n<table:table-header-rows>" . "\n</table:table-header-rows>")
|
||||
;; Otherwise, it belongs to non-header row group.
|
||||
'("\n<table:table-rows>" . "\n</table:table-rows>"))))
|
||||
(concat
|
||||
(org-e-odt-begin-table caption-from info)
|
||||
;; FIXME (org-e-odt-table-preamble)
|
||||
(org-e-odt-begin-table-rowgroup head)
|
||||
;; Does this row begin a rowgroup?
|
||||
(when (org-export-table-row-starts-rowgroup-p table-row info)
|
||||
(car rowgroup-tags))
|
||||
;; Actual table row
|
||||
(org-e-odt-format-tags
|
||||
'("<table:table-row>" . "</table:table-row>") contents)
|
||||
;; Does this row end a rowgroup?
|
||||
(when (org-export-table-row-ends-rowgroup-p table-row info)
|
||||
(cdr rowgroup-tags))))))
|
||||
|
||||
(mapconcat
|
||||
(lambda (line)
|
||||
(cond
|
||||
((equal line 'hline) (org-e-odt-begin-table-rowgroup))
|
||||
(t (org-e-odt-table-row line))))
|
||||
lines "\n")
|
||||
|
||||
(org-e-odt-end-table-rowgroup)
|
||||
(org-e-odt-end-table))))))
|
||||
|
||||
(defun org-e-odt-transcode-table-row (row)
|
||||
(if (string-match org-table-hline-regexp row) 'hline
|
||||
(mapcar
|
||||
(lambda (cell)
|
||||
(org-export-secondary-string
|
||||
(let ((cell (org-element-parse-secondary-string
|
||||
cell
|
||||
(cdr (assq 'table org-element-string-restrictions)))))
|
||||
cell)
|
||||
'e-odt info))
|
||||
(org-split-string row "[ \t]*|[ \t]*"))))
|
||||
|
||||
(defun org-e-odt-org-table-to-list-table (lines &optional splice)
|
||||
"Convert org-table to list-table.
|
||||
LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
|
||||
element is a `string' representing a single row of org-table.
|
||||
Thus each ROW has vertical separators \"|\" separating the table
|
||||
fields. A ROW could also be a row-group separator of the form
|
||||
\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
|
||||
...). ROW could either be symbol `'hline' or a list of the
|
||||
form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
|
||||
(let (line lines-1)
|
||||
(cond
|
||||
(splice
|
||||
(while (setq line (pop lines))
|
||||
(unless (string-match "^[ \t]*|-" line)
|
||||
(push (org-e-odt-transcode-table-row line) lines-1))))
|
||||
(t (while (setq line (pop lines))
|
||||
(cond
|
||||
((string-match "^[ \t]*|-" line)
|
||||
(when lines (push 'hline lines-1)))
|
||||
(t (push (org-e-odt-transcode-table-row line) lines-1))))))
|
||||
(nreverse lines-1)))
|
||||
|
||||
(defun org-e-odt-table-table (raw-table)
|
||||
(require 'table)
|
||||
(with-current-buffer (get-buffer-create "*org-export-table*")
|
||||
(erase-buffer))
|
||||
(let ((output (with-temp-buffer
|
||||
(insert raw-table)
|
||||
(goto-char 1)
|
||||
(re-search-forward "^[ \t]*|[^|]" nil t)
|
||||
(table-generate-source 'html "*org-export-table*")
|
||||
(with-current-buffer "*org-export-table*"
|
||||
(org-trim (buffer-string))))))
|
||||
(kill-buffer (get-buffer "*org-export-table*"))
|
||||
output))
|
||||
;;;; Table
|
||||
|
||||
(defun org-e-odt-table (table contents info)
|
||||
"Transcode a TABLE element from Org to HTML.
|
||||
CONTENTS is nil. INFO is a plist holding contextual information."
|
||||
(let* ((raw-table (org-element-property :raw-table table))
|
||||
(table-type (org-element-property :type table)))
|
||||
(case table-type
|
||||
(table.el
|
||||
;; (org-e-odt-table-table raw-table)
|
||||
)
|
||||
(t
|
||||
(let* ((table-info (org-export-table-format-info raw-table))
|
||||
(columns-number (length (plist-get table-info :alignment)))
|
||||
(lines (org-split-string
|
||||
(org-export-clean-table
|
||||
raw-table (plist-get table-info :special-column-p)) "\n"))
|
||||
|
||||
(genealogy (org-export-get-genealogy table info))
|
||||
(parent (car genealogy))
|
||||
(parent-type (org-element-type parent)))
|
||||
(org-e-odt-list-table
|
||||
(org-e-odt-org-table-to-list-table lines) table info))))))
|
||||
(case (org-element-property :type table)
|
||||
(table.el nil)
|
||||
(t
|
||||
(let* ((captions (org-e-odt-format-label table info 'definition))
|
||||
(caption (car captions)) (short-caption (cdr captions))
|
||||
(attributes (org-e-odt-element-attributes table info))
|
||||
(custom-table-style (nth 1 (org-e-odt-table-style-spec table info)))
|
||||
(table-column-specs
|
||||
(function
|
||||
(lambda (table info)
|
||||
(let* ((table-style (or custom-table-style "OrgTable"))
|
||||
(column-style (format "%sColumn" table-style)))
|
||||
(mapconcat
|
||||
(lambda (table-column-properties)
|
||||
(let ((width (1+ (or (plist-get table-column-properties
|
||||
:width) 0))))
|
||||
(org-e-odt-make-string
|
||||
width
|
||||
(org-e-odt-format-tags
|
||||
"<table:table-column table:style-name=\"%s\"/>"
|
||||
"" column-style))))
|
||||
(org-export-table-column-properties table info) "\n"))))))
|
||||
(concat
|
||||
;; caption.
|
||||
(when caption (org-e-odt-format-stylized-paragraph 'table caption))
|
||||
;; begin table.
|
||||
(let* ((automatic-name
|
||||
(org-e-odt-add-automatic-style "Table" attributes)))
|
||||
(format
|
||||
"\n<table:table table:name=\"%s\" table:style-name=\"%s\">\n"
|
||||
(or short-caption (car automatic-name))
|
||||
(or custom-table-style (cdr automatic-name) "OrgTable")))
|
||||
;; column specification.
|
||||
(funcall table-column-specs table info)
|
||||
;; actual contents.
|
||||
"\n" contents
|
||||
;; end table.
|
||||
"</table:table>")))))
|
||||
|
||||
|
||||
;;;; Target
|
||||
@ -4508,6 +4361,38 @@ using `org-open-file'."
|
||||
|
||||
;;; FIXMES, TODOS, FOR REVIEW etc
|
||||
|
||||
;; (defun org-e-odt-discontinue-list ()
|
||||
;; (let ((stashed-stack org-lparse-list-stack))
|
||||
;; (loop for list-type in stashed-stack
|
||||
;; do (org-lparse-end-list-item-1 list-type)
|
||||
;; (org-lparse-end-list list-type))
|
||||
;; (setq org-e-odt-list-stack-stashed stashed-stack)))
|
||||
|
||||
;; (defun org-e-odt-continue-list ()
|
||||
;; (setq org-e-odt-list-stack-stashed (nreverse org-e-odt-list-stack-stashed))
|
||||
;; (loop for list-type in org-e-odt-list-stack-stashed
|
||||
;; do (org-lparse-begin-list list-type)
|
||||
;; (org-lparse-begin-list-item list-type)))
|
||||
|
||||
;; FIXME: Begin indented table
|
||||
;; (setq org-e-odt-table-indentedp (not (null org-lparse-list-stack)))
|
||||
;; (setq org-e-odt-table-indentedp nil) ; FIXME
|
||||
;; (when org-e-odt-table-indentedp
|
||||
;; ;; Within the Org file, the table is appearing within a list item.
|
||||
;; ;; OpenDocument doesn't allow table to appear within list items.
|
||||
;; ;; Temporarily terminate the list, emit the table and then
|
||||
;; ;; re-continue the list.
|
||||
;; (org-e-odt-discontinue-list)
|
||||
;; ;; Put the Table in an indented section.
|
||||
;; (let ((level (length org-e-odt-list-stack-stashed)))
|
||||
;; (org-e-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
|
||||
|
||||
;; FIXME: End indented table
|
||||
;; (when org-e-odt-table-indentedp
|
||||
;; (org-e-odt-end-section)
|
||||
;; (org-e-odt-continue-list))
|
||||
|
||||
|
||||
;;;; org-format-table-html
|
||||
;;;; org-format-org-table-html
|
||||
;;;; org-format-table-table-html
|
||||
|
||||
Loading…
Reference in New Issue
Block a user