mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-02-01 20:54:25 +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."
|
||||
(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)))
|
||||
|
Loading…
x
Reference in New Issue
Block a user