0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 18:36:26 +00:00

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

View file

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