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:
parent
8eff64cffe
commit
caf66ea779
|
@ -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)))
|
||||||
|
|
Loading…
Reference in a new issue