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>
This commit is contained in:
Nicolas Goaziou 2016-02-12 00:38:52 +01:00
parent 8eff64cffe
commit caf66ea779
1 changed files with 46 additions and 45 deletions

View File

@ -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)))