summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJambunathan K <kjambunathan@gmail.com>2012-04-22 10:39:19 +0530
committerJambunathan K <kjambunathan@gmail.com>2012-04-22 19:46:26 +0530
commitc009f84f99278e947c012df017cb6807036d779c (patch)
tree654a3d646e1ba36a80622f22bbeadcc5e4b16285
parent0264495f52bfb6e105faf79377b6c026a0f8fd7f (diff)
downloadorg-mode-c009f84f99278e947c012df017cb6807036d779c.tar.gz
org-e-html/org-e-odt: Use new table infrastructure. First cut and slightly broken.
-rw-r--r--EXPERIMENTAL/org-e-html.el372
-rw-r--r--EXPERIMENTAL/org-e-odt.el621
2 files changed, 398 insertions, 595 deletions
diff --git a/EXPERIMENTAL/org-e-html.el b/EXPERIMENTAL/org-e-html.el
index f7ab3ff..35f2832 100644
--- a/EXPERIMENTAL/org-e-html.el
+++ b/EXPERIMENTAL/org-e-html.el
@@ -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
-
-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."
+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-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))
-;;;; Table
+;;;; Tabel Cell
-(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-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
+(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)) "&nbsp;" 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
- (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
+ ((= 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
- (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))))
+ ;; 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))))))
-(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)
+;;;; Table
- (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-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-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
diff --git a/EXPERIMENTAL/org-e-odt.el b/EXPERIMENTAL/org-e-odt.el
index 7010edb..c9d3bea 100644
--- a/EXPERIMENTAL/org-e-odt.el
+++ b/EXPERIMENTAL/org-e-odt.el
@@ -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-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>"))))
-
-(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)
+(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.
- (concat
- (org-e-odt-begin-table caption-from info)
- ;; FIXME (org-e-odt-table-preamble)
- (org-e-odt-begin-table-rowgroup head)
+Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
- (mapconcat
- (lambda (line)
- (cond
- ((equal line 'hline) (org-e-odt-begin-table-rowgroup))
- (t (org-e-odt-table-row line))))
- lines "\n")
+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'.
- (org-e-odt-end-table-rowgroup)
- (org-e-odt-end-table))))))
+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
+ ;; 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))))))
-(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