Browse Source

ox: Speed-up some tools on tables

* lisp/ox.el (org-export-table-has-special-column-p): Tiny
  refactoring.
(org-export-table-has-header-p): Fix cache use, i.e., no longer
re-compute return value when the table is already known to have no
header.
(org-export-table-row-group):
(org-export-table-row-number): Populate cache with all the rows
whenever a row is queried.  This fixes previous quadratic behaviour.

Reported-by: Thierry Banel <tbanelwebmin@free.fr>
<http://permalink.gmane.org/gmane.emacs.orgmode/111131>
Nicolas Goaziou 8 years ago
parent
commit
2f5cd67357
2 changed files with 78 additions and 72 deletions
  1. 66 60
      lisp/ox.el
  2. 12 12
      testing/lisp/test-ox.el

+ 66 - 60
lisp/ox.el

@@ -4747,19 +4747,20 @@ code."
 All special columns will be ignored during export."
   ;; The table has a special column when every first cell of every row
   ;; has an empty value or contains a symbol among "/", "#", "!", "$",
-  ;; "*" "_" and "^".  Though, do not consider a first row containing
-  ;; only empty cells as special.
-  (let ((special-column-p 'empty))
+  ;; "*" "_" and "^".  Though, do not consider a first column
+  ;; containing only empty cells as special.
+  (let ((special-column? 'empty))
     (catch 'exit
       (dolist (row (org-element-contents table))
 	(when (eq (org-element-property :type row) 'standard)
 	  (let ((value (org-element-contents
 			(car (org-element-contents row)))))
-	    (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
-		   (setq special-column-p 'special))
-		  ((not value))
+	    (cond ((member value
+			   '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+		   (setq special-column? 'special))
+		  ((null value))
 		  (t (throw 'exit nil))))))
-      (eq special-column-p 'special))))
+      (eq special-column? 'special))))
 
 (defun org-export-table-has-header-p (table info)
   "Non-nil when TABLE has a header.
@@ -4767,25 +4768,28 @@ 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 ((cache (or (plist-get info :table-header-cache)
-		   (let ((table (make-hash-table :test #'eq)))
-		     (plist-put info :table-header-cache table)
-		     table))))
-    (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))
-		 (cl-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)))))
+  (let* ((cache (or (plist-get info :table-header-cache)
+		    (let ((table (make-hash-table :test #'eq)))
+		      (plist-put info :table-header-cache table)
+		      table)))
+	 (cached (gethash table cache 'no-cache)))
+    (if (not (eq cached 'no-cache)) cached
+      (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))
+		       (cl-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 _)
   "Non-nil if TABLE-ROW is considered special.
@@ -4826,20 +4830,24 @@ INFO is a plist used as the communication channel.
 Return value is the group number, as an integer, or nil for
 special rows and rows separators.  First group is also table's
 header."
-  (let ((cache (or (plist-get info :table-row-group-cache)
-		   (let ((table (make-hash-table :test #'eq)))
-		     (plist-put info :table-row-group-cache table)
-		     table))))
-    (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 (cl-incf group) (setq row-flag t)))
-		   (when (eq table-row row) (puthash table-row group cache)))
-		 info 'first-match))))))
+  (when (eq (org-element-property :type table-row) 'standard)
+    (let* ((cache (or (plist-get info :table-row-group-cache)
+		      (let ((table (make-hash-table :test #'eq)))
+			(plist-put info :table-row-group-cache table)
+			table)))
+	   (cached (gethash table-row cache 'no-cache)))
+      (if (not (eq cached 'no-cache)) cached
+	;; First time a row is queried, populate cache with all the
+	;; rows from the table.
+	(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 (cl-incf group) (setq row-flag t))
+		(puthash row group cache)))
+	    info))
+	(gethash table-row cache)))))
 
 (defun org-export-table-cell-width (table-cell info)
   "Return TABLE-CELL contents width.
@@ -5102,26 +5110,24 @@ INFO is a plist used as a communication channel."
 (defun org-export-table-row-number (table-row info)
   "Return TABLE-ROW number.
 INFO is a plist used as a communication channel.  Return value is
-zero-based and ignores separators.  The function returns nil for
-special columns and separators."
-  (let* ((cache (or (plist-get info :table-row-number-cache)
-		    (let ((table (make-hash-table :test #'eq)))
-		      (plist-put info :table-row-number-cache table)
-		      table)))
-	 (cached (gethash table-row cache 'no-cache)))
-    (if (not (eq cached 'no-cache)) cached
-      (puthash table-row
-	       (and (eq (org-element-property :type table-row) 'standard)
-		    (not (org-export-table-row-is-special-p table-row info))
-		    (let ((number 0))
-		      (org-element-map (org-export-get-parent-table table-row)
-			  'table-row
-			(lambda (row)
-			  (cond ((eq row table-row) number)
-				((eq (org-element-property :type row) 'standard)
-				 (cl-incf number) nil)))
-			info 'first-match)))
-	       cache))))
+zero-indexed and ignores separators.  The function returns nil
+for special rows and separators."
+  (when (eq (org-element-property :type table-row) 'standard)
+    (let* ((cache (or (plist-get info :table-row-number-cache)
+		      (let ((table (make-hash-table :test #'eq)))
+			(plist-put info :table-row-number-cache table)
+			table)))
+	   (cached (gethash table-row cache 'no-cache)))
+      (if (not (eq cached 'no-cache)) cached
+	;; First time a row is queried, populate cache with all the
+	;; rows from the table.
+	(let ((number -1))
+	  (org-element-map (org-export-get-parent-table table-row) 'table-row
+	    (lambda (row)
+	      (when (eq (org-element-property :type row) 'standard)
+		(puthash row (cl-incf number) cache)))
+	    info))
+	(gethash table-row cache)))))
 
 (defun org-export-table-dimensions (table info)
   "Return TABLE dimensions.

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

@@ -3676,37 +3676,37 @@ Another text. (ref:text)
 
 (ert-deftest test-org-export/has-header-p ()
   "Test `org-export-table-has-header-p' specifications."
-  ;; 1. With an header.
-  (org-test-with-parsed-data "
+  ;; With an header.
+  (should
+   (org-test-with-parsed-data "
 | a | b |
 |---+---|
 | c | d |"
-    (should
      (org-export-table-has-header-p
       (org-element-map tree 'table 'identity info 'first-match)
       info)))
-  ;; 2. Without an header.
-  (org-test-with-parsed-data "
+  ;; Without an header.
+  (should-not
+   (org-test-with-parsed-data "
 | a | b |
 | c | d |"
-    (should-not
      (org-export-table-has-header-p
       (org-element-map tree 'table 'identity info 'first-match)
       info)))
-  ;; 3. Don't get fooled with starting and ending rules.
-  (org-test-with-parsed-data "
+  ;; Don't get fooled with starting and ending rules.
+  (should-not
+   (org-test-with-parsed-data "
 |---+---|
 | a | b |
 | c | d |
 |---+---|"
-    (should-not
      (org-export-table-has-header-p
       (org-element-map tree 'table 'identity info 'first-match)
       info))))
 
 (ert-deftest test-org-export/table-row-group ()
   "Test `org-export-table-row-group' specifications."
-  ;; 1. A rule creates a new group.
+  ;; A rule creates a new group.
   (should
    (equal '(1 rule 2)
 	  (org-test-with-parsed-data "
@@ -3717,7 +3717,7 @@ Another text. (ref:text)
 	      (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.
+  ;; Special rows are ignored in count.
   (should
    (equal
     '(rule 1)
@@ -3730,7 +3730,7 @@ Another text. (ref:text)
 	  (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.
+  ;; Double rules also are ignored in count.
   (should
    (equal '(1 rule rule 2)
 	  (org-test-with-parsed-data "