Browse Source

org-colview: Fix columnview table

* lisp/org-colview.el (org-columns-capture-view): Properties are not
  case sensitive.
(org-dblock-write:columnview): Take into consideration stars turned into
spaces (i.e., invisible leading stars) when computing heading level.
Also do not assume "ITEM" is always in the first column of the table.

Reported-by: Axel Kielhorn <org-mode@axelkielhorn.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/105051>
Nicolas Goaziou 5 years ago
parent
commit
caf66ea779
1 changed files with 46 additions and 45 deletions
  1. 46 45
      lisp/org-colview.el

+ 46 - 45
lisp/org-colview.el

@@ -1204,7 +1204,7 @@ containing the title row and all other rows.  Each row is a list
 of fields."
   (save-excursion
     (let* ((title (mapcar #'cadr org-columns-current-fmt-compiled))
-	   (has-item? (member "ITEM" title))
+	   (has-item? (assoc-string "ITEM" org-columns-current-fmt-compiled t))
 	   (n (length title))
 	   tbl)
       (goto-char (point-min))
@@ -1252,7 +1252,6 @@ PARAMS is a property list of parameters:
 	  When t, skip rows where all specifiers other than ITEM are empty.
 :format   When non-nil, specify the column view format to use."
   (let ((pos (point-marker))
-	(hlines (plist-get params :hlines))
 	(vlines (plist-get params :vlines))
 	(maxlevel (plist-get params :maxlevel))
 	(content-lines (org-split-string (plist-get params :content) "\n"))
@@ -1283,52 +1282,54 @@ PARAMS is a property list of parameters:
     (with-current-buffer (if view-file
 			     (get-file-buffer view-file)
 			   (current-buffer))
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (or view-pos (point)))
-	  (org-columns columns-fmt)
-	  (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
-	  (setq nfields (length (car tbl)))
-	  (org-columns-quit))))
+      (org-with-wide-buffer
+       (goto-char (or view-pos (point)))
+       (org-columns columns-fmt)
+       (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
+       (setq nfields (length (car tbl)))
+       (org-columns-quit)))
     (goto-char pos)
     (move-marker pos nil)
     (when tbl
-      (when (plist-get params :hlines)
-	(let (tmp)
-	  (while tbl
-	    (if (eq (car tbl) 'hline)
-		(push (pop tbl) tmp)
-	      (when (string-match "\\` *\\(\\*+\\)" (caar tbl))
-		(if (and (not (eq (car tmp) 'hline))
-			 (or (eq hlines t)
-			     (and (numberp hlines)
-				  (<= (- (match-end 1) (match-beginning 1))
-				      hlines))))
-		    (push 'hline tmp)))
-	      (push (pop tbl) tmp)))
-	  (setq tbl (nreverse tmp))))
-      ;; Remove stars.  Add indentation entities, if required.
-      (let ((index (cl-position
-		    "ITEM"
-		    (mapcar #'cadr org-columns-current-fmt-compiled)
-		    :test #'equal)))
-	(when index
-	  (dolist (row tbl)
-	    (unless (eq row 'hline)
-	      (let ((item (nth index row)))
-		(setf (nth index row)
-		      (replace-regexp-in-string
-		       "\\`\\(\\*+\\) +"
-		       (if (plist-get params :indent)
-			   (lambda (m)
-			     (let ((l (org-reduced-level
-				       (length (match-string 1 m)))))
-			       (if (= l 1) ""
-				 (concat "\\\\_"
-					 (make-string (* 2 (1- l)) ?\s)))))
-			 "")
-		       item)))))))
+      ;; Normalize headings in the table.  Remove stars, add
+      ;; indentation entities, if required, and possibly precede some
+      ;; of them with a horizontal rule.
+      (let ((item-index
+	     (let ((p (assoc-string "ITEM" org-columns-current-fmt-compiled t)))
+	       (and p (cl-position p
+				   org-columns-current-fmt-compiled
+				   :test #'equal))))
+	    (hlines (plist-get params :hlines))
+	    (indent (plist-get params :indent)))
+	(when item-index
+	  (let (new-table)
+	    ;; Copy header and first rule.
+	    (push (pop tbl) new-table)
+	    (push (pop tbl) new-table)
+	    (while tbl
+	      (let ((row (car tbl)))
+		(if (eq row 'hline)
+		    (push (pop tbl) new-table)
+		  (let* ((item (nth item-index row))
+			 (level (and (string-match "\\`\\( *\\*+\\) +" item)
+				     ;; Leading white spaces are
+				     ;; actually stars made invisible
+				     ;; (see `org-columns') so they
+				     ;; add up to heading level.
+				     (org-reduced-level
+				      (- (match-end 1) (match-beginning 1))))))
+		    (when (and (not (eq (car new-table) 'hline))
+			       (or (eq hlines t)
+				   (and (numberp hlines) (<= level hlines))))
+		      (push 'hline new-table))
+		    (setf (nth item-index row)
+			  (replace-match
+			   (if (or (not indent) (= level 1)) ""
+			     (concat "\\\\_"
+				     (make-string (* 2 (1- level)) ?\s)))
+			   nil nil item))
+		    (push (pop tbl) new-table)))))
+	    (setq tbl (nreverse new-table)))))
       (when vlines
 	(setq tbl (mapcar (lambda (x)
 			    (if (eq 'hline x) x (cons "" x)))