ox: Improve speed wrt table export
authorNicolas Goaziou <n.goaziou@gmail.com>
Sat, 18 May 2013 16:20:46 +0000 (18 18:20 +0200)
committerNicolas Goaziou <n.goaziou@gmail.com>
Sat, 18 May 2013 16:20:46 +0000 (18 18:20 +0200)
* lisp/ox.el (org-export-resolve-fuzzy-link): Change property name
  holding cache.
(org-export-table-has-header-p, org-export-table-row-group,
org-export-table-cell-width, org-export-table-cell-alignment): Cache
results.
(org-export-table-cell-address): Refactor.
(org-export-get-parent): Inline function.
* testing/lisp/test-ox.el: Update tests.

lisp/ox.el
testing/lisp/test-ox.el

index 36c35a8..76f3df9 100644 (file)
@@ -3989,10 +3989,10 @@ significant."
                (if match-title-p (substring raw-path 1) raw-path)))
         ;; Cache for destinations that are not position dependent.
         (link-cache
-         (or (plist-get info :fuzzy-link-cache)
-             (plist-get (setq info (plist-put info :fuzzy-link-cache
+         (or (plist-get info :resolve-fuzzy-link-cache)
+             (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
                                               (make-hash-table :test 'equal)))
-                        :fuzzy-link-cache)))
+                        :resolve-fuzzy-link-cache)))
         (cached (gethash path link-cache 'not-found)))
     (cond
      ;; Destination is not position dependent: use cached value.
@@ -4384,16 +4384,26 @@ All special columns will be ignored during export."
 INFO is a plist used as a communication channel.
 
 A table has a header when it contains at least two row groups."
-  (let ((rowgroup 1) row-flag)
-    (org-element-map table 'table-row
-      (lambda (row)
-       (cond
-        ((> rowgroup 1) t)
-        ((and row-flag (eq (org-element-property :type row) 'rule))
-         (incf rowgroup) (setq row-flag nil))
-        ((and (not row-flag) (eq (org-element-property :type row) 'standard))
-         (setq row-flag t) nil)))
-      info)))
+  (let ((cache (or (plist-get info :table-header-cache)
+                  (plist-get (setq info
+                                   (plist-put info :table-header-cache
+                                              (make-hash-table :test 'eq)))
+                             :table-header-cache))))
+    (or (gethash table cache)
+       (let ((rowgroup 1) row-flag)
+         (puthash
+          table
+          (org-element-map table 'table-row
+            (lambda (row)
+              (cond
+               ((> rowgroup 1) t)
+               ((and row-flag (eq (org-element-property :type row) 'rule))
+                (incf rowgroup) (setq row-flag nil))
+               ((and (not row-flag) (eq (org-element-property :type row)
+                                        'standard))
+                (setq row-flag t) nil)))
+            info 'first-match)
+          cache)))))
 
 (defun org-export-table-row-is-special-p (table-row info)
   "Non-nil if TABLE-ROW is considered special.
@@ -4432,26 +4442,28 @@ All special rows will be ignored during export."
           (eq special-row-p 'cookie)))))))
 
 (defun org-export-table-row-group (table-row info)
-  "Return TABLE-ROW's group.
+  "Return TABLE-ROW's group number, as an integer.
 
 INFO is a plist used as the communication channel.
 
 Return value is the group number, as an integer, or nil for
-special rows and table rules.  Group 1 is also table's header."
-  (unless (or (eq (org-element-property :type table-row) 'rule)
-             (org-export-table-row-is-special-p table-row info))
-    (let ((group 0) row-flag)
-      (catch 'found
-       (mapc
-        (lambda (row)
-          (cond
-           ((and (eq (org-element-property :type row) 'standard)
-                 (not (org-export-table-row-is-special-p row info)))
-            (unless row-flag (incf group) (setq row-flag t)))
-           ((eq (org-element-property :type row) 'rule)
-            (setq row-flag nil)))
-          (when (eq table-row row) (throw 'found group)))
-        (org-element-contents (org-export-get-parent table-row)))))))
+special rows and rows separators.  First group is also table's
+header."
+  (let ((cache (or (plist-get info :table-row-group-cache)
+                  (plist-get (setq info
+                                   (plist-put info :table-row-group-cache
+                                              (make-hash-table :test 'eq)))
+                             :table-row-group-cache))))
+    (cond ((gethash table-row cache))
+         ((eq (org-element-property :type table-row) 'rule) nil)
+         (t (let ((group 0) row-flag)
+              (org-element-map (org-export-get-parent table-row) 'table-row
+                (lambda (row)
+                  (if (eq (org-element-property :type row) 'rule)
+                      (setq row-flag nil)
+                    (unless row-flag (incf group) (setq row-flag t)))
+                  (when (eq table-row row) (puthash table-row group cache)))
+                info 'first-match))))))
 
 (defun org-export-table-cell-width (table-cell info)
   "Return TABLE-CELL contents width.
@@ -4461,31 +4473,34 @@ INFO is a plist used as the communication channel.
 Return value is the width given by the last width cookie in the
 same column as TABLE-CELL, or nil."
   (let* ((row (org-export-get-parent table-cell))
+        (table (org-export-get-parent row))
         (column (let ((cells (org-element-contents row)))
                   (- (length cells) (length (memq table-cell cells)))))
-        (table (org-export-get-parent-table table-cell))
-        cookie-width)
-    (mapc
-     (lambda (row)
-       (cond
-       ;; In a special row, try to find a width cookie at COLUMN.
-       ((org-export-table-row-is-special-p row info)
-        (let ((value (org-element-contents
-                      (elt (org-element-contents row) column))))
-          ;; The following checks avoid expanding unnecessarily the
-          ;; cell with `org-export-data'
-          (when (and value
-                     (not (cdr value))
-                     (stringp (car value))
-                     (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" (car value))
-                     (match-string 1 (car value)))
-            (setq cookie-width
-                  (string-to-number (match-string 1 (car value)))))))
-       ;; Ignore table rules.
-       ((eq (org-element-property :type row) 'rule))))
-     (org-element-contents table))
-    ;; Return value.
-    cookie-width))
+        (cache (or (plist-get info :table-cell-width-cache)
+                   (plist-get (setq info
+                                    (plist-put info :table-cell-width-cache
+                                               (make-hash-table :test 'equal)))
+                              :table-cell-width-cache)))
+        (key (cons table column)))
+    (or (let ((cached (gethash key cache 'no-result)))
+         (and (not (eq cached 'no-result)) cached))
+       (let (cookie-width)
+         (dolist (row (org-element-contents table)
+                      (puthash key cookie-width cache))
+           (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)))))))))))
 
 (defun org-export-table-cell-alignment (table-cell info)
   "Return TABLE-CELL contents alignment.
@@ -4498,57 +4513,66 @@ alignment value will be deduced from fraction of numbers in the
 column (see `org-table-number-fraction' for more information).
 Possible values are `left', `right' and `center'."
   (let* ((row (org-export-get-parent table-cell))
+        (table (org-export-get-parent row))
         (column (let ((cells (org-element-contents row)))
                   (- (length cells) (length (memq table-cell cells)))))
-        (table (org-export-get-parent-table table-cell))
-        (number-cells 0)
-        (total-cells 0)
-        cookie-align
-        previous-cell-number-p)
-    (mapc
-     (lambda (row)
-       (cond
-       ;; In a special row, try to find an alignment cookie at
-       ;; COLUMN.
-       ((org-export-table-row-is-special-p row info)
-        (let ((value (org-element-contents
-                      (elt (org-element-contents row) column))))
-          ;; Since VALUE is a secondary string, the following checks
-          ;; avoid useless expansion through `org-export-data'.
-          (when (and value
-                     (not (cdr value))
-                     (stringp (car value))
-                     (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'"
-                                   (car value))
-                     (match-string 1 (car value)))
-            (setq cookie-align (match-string 1 (car value))))))
-       ;; Ignore table rules.
-       ((eq (org-element-property :type row) 'rule))
-       ;; In a standard row, check if cell's contents are expressing
-       ;; some kind of number.  Increase NUMBER-CELLS accordingly.
-       ;; Though, don't bother if an alignment cookie has already
-       ;; defined cell's alignment.
-       ((not cookie-align)
-        (let ((value (org-export-data
-                      (org-element-contents
-                       (elt (org-element-contents row) column))
-                      info)))
-          (incf total-cells)
-          ;; Treat an empty cell as a number if it follows a number
-          (if (not (or (string-match org-table-number-regexp value)
-                       (and (string= value "") previous-cell-number-p)))
-              (setq previous-cell-number-p nil)
-            (setq previous-cell-number-p t)
-            (incf number-cells))))))
-     (org-element-contents table))
-    ;; Return value.  Alignment specified by cookies has precedence
-    ;; over alignment deduced from cells contents.
-    (cond ((equal cookie-align "l") 'left)
-         ((equal cookie-align "r") 'right)
-         ((equal cookie-align "c") 'center)
-         ((>= (/ (float number-cells) total-cells) org-table-number-fraction)
-          'right)
-         (t 'left))))
+        (cache (or (plist-get info :table-cell-alignment-cache)
+                   (plist-get (setq info
+                                    (plist-put info :table-cell-alignment-cache
+                                               (make-hash-table :test 'equal)))
+                              :table-cell-alignment-cache))))
+    (or (gethash (cons table column) cache)
+       (let ((number-cells 0)
+             (total-cells 0)
+             cookie-align
+             previous-cell-number-p)
+         (dolist (row (org-element-contents (org-export-get-parent row)))
+           (cond
+            ;; In a special row, try to find an alignment cookie at
+            ;; COLUMN.
+            ((org-export-table-row-is-special-p row info)
+             (let ((value (org-element-contents
+                           (elt (org-element-contents row) column))))
+               ;; Since VALUE is a secondary string, the following
+               ;; checks avoid useless expansion through
+               ;; `org-export-data'.
+               (when (and value
+                          (not (cdr value))
+                          (stringp (car value))
+                          (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'"
+                                        (car value))
+                          (match-string 1 (car value)))
+                 (setq cookie-align (match-string 1 (car value))))))
+            ;; Ignore table rules.
+            ((eq (org-element-property :type row) 'rule))
+            ;; In a standard row, check if cell's contents are
+            ;; expressing some kind of number.  Increase NUMBER-CELLS
+            ;; accordingly.  Though, don't bother if an alignment
+            ;; cookie has already defined cell's alignment.
+            ((not cookie-align)
+             (let ((value (org-export-data
+                           (org-element-contents
+                            (elt (org-element-contents row) column))
+                           info)))
+               (incf total-cells)
+               ;; Treat an empty cell as a number if it follows
+               ;; a number.
+               (if (not (or (string-match org-table-number-regexp value)
+                            (and (string= value "") previous-cell-number-p)))
+                   (setq previous-cell-number-p nil)
+                 (setq previous-cell-number-p t)
+                 (incf number-cells))))))
+         ;; Return value.  Alignment specified by cookies has
+         ;; precedence over alignment deduced from cell's contents.
+         (puthash (cons table column)
+                  (cond ((equal cookie-align "l") 'left)
+                        ((equal cookie-align "r") 'right)
+                        ((equal cookie-align "c") 'center)
+                        ((>= (/ (float number-cells) total-cells)
+                             org-table-number-fraction)
+                         'right)
+                        (t 'left))
+                  cache)))))
 
 (defun org-export-table-cell-borders (table-cell info)
   "Return TABLE-CELL borders.
@@ -4739,20 +4763,14 @@ Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
 zero-based index.  Only exportable cells are considered.  The
 function returns nil for other cells."
   (let* ((table-row (org-export-get-parent table-cell))
-        (table (org-export-get-parent-table table-cell)))
-    ;; Ignore cells in special rows or in special column.
-    (unless (or (org-export-table-row-is-special-p table-row info)
-               (and (org-export-table-has-special-column-p table)
-                    (eq (car (org-element-contents table-row)) table-cell)))
-      (cons
-       ;; Row number.
-       (org-export-table-row-number (org-export-get-parent table-cell) info)
-       ;; Column number.
-       (let ((col-count 0))
-        (org-element-map table-row 'table-cell
-          (lambda (cell)
-            (if (eq cell table-cell) col-count (incf col-count) nil))
-          info 'first-match))))))
+        (row-number (org-export-table-row-number table-row info)))
+    (when row-number
+      (cons row-number
+           (let ((col-count 0))
+             (org-element-map table-row 'table-cell
+               (lambda (cell)
+                 (if (eq cell table-cell) col-count (incf col-count) nil))
+               info 'first-match))))))
 
 (defun org-export-get-table-cell-at (address table info)
   "Return regular table-cell object at ADDRESS in TABLE.
@@ -5078,7 +5096,7 @@ Return the new string."
 ;; `org-export-get-genealogy' returns the full genealogy of a given
 ;; element or object, from closest parent to full parse tree.
 
-(defun org-export-get-parent (blob)
+(defsubst org-export-get-parent (blob)
   "Return BLOB parent or nil.
 BLOB is the element or object considered."
   (org-element-property :parent blob))
index 5e43df6..0f476a6 100644 (file)
@@ -2015,36 +2015,41 @@ Another text. (ref:text)
 (ert-deftest test-org-export/table-row-group ()
   "Test `org-export-table-row-group' specifications."
   ;; 1. A rule creates a new group.
-  (org-test-with-parsed-data "
+  (should
+   (equal '(1 rule 2)
+         (org-test-with-parsed-data "
 | a | b |
 |---+---|
 | 1 | 2 |"
-    (should
-     (equal
-      '(1 nil 2)
-      (mapcar (lambda (row) (org-export-table-row-group row info))
-             (org-element-map tree 'table-row 'identity)))))
+           (org-element-map tree 'table-row
+             (lambda (row)
+               (if (eq (org-element-property :type row) 'rule) 'rule
+                 (org-export-table-row-group row info)))))))
   ;; 2. Special rows are ignored in count.
-  (org-test-with-parsed-data "
+  (should
+   (equal
+    '(rule 1)
+    (org-test-with-parsed-data "
 | / | < | > |
 |---|---+---|
 |   | 1 | 2 |"
-    (should
-     (equal
-      '(nil nil 1)
-      (mapcar (lambda (row) (org-export-table-row-group row info))
-             (org-element-map tree 'table-row 'identity)))))
+      (org-element-map tree 'table-row
+       (lambda (row)
+         (if (eq (org-element-property :type row) 'rule) 'rule
+           (org-export-table-row-group row info)))
+       info))))
   ;; 3. Double rules also are ignored in count.
-  (org-test-with-parsed-data "
+  (should
+   (equal '(1 rule rule 2)
+         (org-test-with-parsed-data "
 | a | b |
 |---+---|
 |---+---|
 | 1 | 2 |"
-    (should
-     (equal
-      '(1 nil nil 2)
-      (mapcar (lambda (row) (org-export-table-row-group row info))
-             (org-element-map tree 'table-row 'identity))))))
+           (org-element-map tree 'table-row
+             (lambda (row)
+               (if (eq (org-element-property :type row) 'rule) 'rule
+                 (org-export-table-row-group row info))))))))
 
 (ert-deftest test-org-export/table-row-number ()
   "Test `org-export-table-row-number' specifications."