tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

ox: Make `org-export-table-cell-width' more robust 

* lisp/ox.el (org-export-table-cell-width): Make
  `org-export-table-cell-width' robust against malformed tables.

Reported-by: michael <m.schoenwaelder@posteo.de>
<http://lists.gnu.org/r/emacs-orgmode/2019-05/msg00215.html>
This commit is contained in:
Nicolas Goaziou 2019-05-30 14:59:10 +02:00
parent 24555a0c00
commit 967801e2b8
2 changed files with 46 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
lisp/ox.el
View File

@ -4916,26 +4916,32 @@ same column as TABLE-CELL, or nil."
(plist-put info :table-cell-width-cache table)
table)))
(width-vector (or (gethash table cache)
(puthash table (make-vector columns 'empty) cache)))
(value (aref width-vector column)))
(if (not (eq value 'empty)) value
(let (cookie-width)
(dolist (row (org-element-contents table)
(aset width-vector column cookie-width))
(when (org-export-table-row-is-special-p row info)
;; In a special row, try to find a width cookie at COLUMN.
(let* ((value (org-element-contents
(elt (org-element-contents row) column)))
(cookie (car value)))
;; The following checks avoid expanding unnecessarily
;; the cell with `org-export-data'.
(when (and value
(not (cdr value))
(stringp cookie)
(string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie)
(match-string 1 cookie))
(setq cookie-width
(string-to-number (match-string 1 cookie)))))))))))
(puthash table (make-vector columns 'empty) cache))))
;; Table may not have the same number of rows. Extend
;; WIDTH-VECTOR appropriately if we encounter a row larger than
;; expected.
(when (>= column (length width-vector))
(setq width-vector
(vconcat width-vector
(make-list (- (1+ column) (length width-vector))
'empty)))
(puthash table width-vector cache))
(pcase (aref width-vector column)
(`empty
(catch 'found
(dolist (row (org-element-contents table))
(when (org-export-table-row-is-special-p row info)
;; In a special row, try to find a width cookie at
;; COLUMN. The following checks avoid expanding
;; unnecessarily the cell with `org-export-data'.
(pcase (org-element-contents
(elt (org-element-contents row) column))
(`(,(and (pred stringp) cookie))
(when (string-match "\\`<[lrc]?\\([0-9]+\\)>\\'" cookie)
(let ((w (string-to-number (match-string 1 cookie))))
(throw 'found (aset width-vector column w))))))))
(aset width-vector column nil)))
(value value))))
(defun org-export-table-cell-alignment (table-cell info)
"Return TABLE-CELL contents alignment.

45
testing/lisp/test-ox.el
View File

@ -4148,33 +4148,28 @@ Another text. (ref:text)
(ert-deftest test-org-export/table-cell-width ()
"Test `org-export-table-cell-width' specifications."
;; 1. Width is primarily determined by width cookies. If no cookie
;; is found, cell's width is nil.
(org-test-with-parsed-data "
;; Width is primarily determined by width cookies. If no cookie is
;; found, cell's width is nil.
(should
(equal '(nil 6 7)
(org-test-with-parsed-data "
| / | <l> | <6> | <l7> |
| | a | b | c |"
(should
(equal
'(nil 6 7)
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity info)))))
;; 2. The last width cookie has precedence.
(org-test-with-parsed-data "
| <6> |
| <7> |
| a |"
(should
(equal
'(7)
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity info)))))
;; 3. Valid width cookies must have a specific row.
(org-test-with-parsed-data "| <6> | cell |"
(should
(equal
'(nil nil)
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity))))))
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity info)))))
;; Valid width cookies must have a specific row.
(should
(equal '(nil nil)
(org-test-with-parsed-data "| <6> | cell |"
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity)))))
;; Do not error on malformed tables.
(should
(org-test-with-parsed-data "
| a |
| b | c |"
(mapcar (lambda (cell) (org-export-table-cell-width cell info))
(org-element-map tree 'table-cell 'identity info)))))
(ert-deftest test-org-export/table-cell-alignment ()
"Test `org-export-table-cell-alignment' specifications."