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

View File

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

View File

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