Column view: Skip COMMENT and ARCHIVE trees when capturing

Proposal by Giovanni Ridolfi.
This commit is contained in:
Carsten Dominik 2009-06-18 17:35:59 +02:00
parent 164678d549
commit 9d59bc0d29
3 changed files with 59 additions and 39 deletions

View File

@ -2,9 +2,11 @@
* org-colview.el (org-columns-capture-view): Protect vertical bars * org-colview.el (org-columns-capture-view): Protect vertical bars
in column values. in column values.
(org-columns-capture-view): Exclude comment and archived trees.
* org-colview-xemacs.el (org-columns-capture-view): Protect * org-colview-xemacs.el (org-columns-capture-view): Protect
vertical bars in column values. vertical bars in column values.
(org-columns-capture-view): Exclude comment and archived trees.
* org.el (org-quote-vert): New function. * org.el (org-quote-vert): New function.

View File

@ -1269,31 +1269,40 @@ of fields."
(if (featurep 'xemacs) (if (featurep 'xemacs)
(save-excursion (save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
(re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl) (n (length title)) row tbl)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil t) (while (re-search-forward "^\\(\\*+\\) " nil t)
(when (and (or (null maxlevel) (catch 'next
(>= maxlevel (when (and (or (null maxlevel)
(if org-odd-levels-only (>= maxlevel
(/ (1+ (length (match-string 1))) 2) (if org-odd-levels-only
(length (match-string 1))))) (/ (1+ (length (match-string 1))) 2)
(get-char-property (match-beginning 0) 'org-columns-key)) (length (match-string 1)))))
(goto-char (match-beginning 0)) (get-char-property (match-beginning 0) 'org-columns-key))
(setq row nil) (goto-char (match-beginning 0))
(loop for i from 0 to (1- n) do (when (save-excursion
(push (goto-char (point-at-bol))
(org-quote-vert (or (looking-at re-comment)
(or (get-char-property (point) (looking-at re-archive)))
'org-columns-value-modified) (org-end-of-subtree t)
(get-char-property (point) 'org-columns-value) (throw 'next t))
"")) (setq row nil)
row) (loop for i from 0 to (1- n) do
(org-columns-forward-char)) (push
(setq row (nreverse row)) (org-quote-vert
(unless (and skip-empty-rows (or (get-char-property (point)
(eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) 'org-columns-value-modified)
(push row tbl)))) (get-char-property (point) 'org-columns-value)
""))
row)
(org-columns-forward-char))
(setq row (nreverse row))
(unless (and skip-empty-rows
(eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
(push row tbl)))))
(append (list title 'hline) (nreverse tbl)))) (append (list title 'hline) (nreverse tbl))))
(save-excursion (save-excursion
(let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))

View File

@ -1081,27 +1081,36 @@ 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))
(re-comment (concat "\\*+[ \t]+" org-comment-string "\\>"))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl) (n (length title)) row tbl)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil t) (while (re-search-forward "^\\(\\*+\\) " nil t)
(when (and (or (null maxlevel) (catch 'next
(>= maxlevel (when (and (or (null maxlevel)
(if org-odd-levels-only (>= maxlevel
(/ (1+ (length (match-string 1))) 2) (if org-odd-levels-only
(length (match-string 1))))) (/ (1+ (length (match-string 1))) 2)
(get-char-property (match-beginning 0) 'org-columns-key)) (length (match-string 1)))))
(setq row nil) (get-char-property (match-beginning 0) 'org-columns-key))
(loop for i from 0 to (1- n) do (when (save-excursion
(push (goto-char (point-at-bol))
(org-quote-vert (or (looking-at re-comment)
(or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) (looking-at re-archive)))
(get-char-property (+ (match-beginning 0) i) 'org-columns-value) (org-end-of-subtree t)
"")) (throw 'next t))
row)) (setq row nil)
(setq row (nreverse row)) (loop for i from 0 to (1- n) do
(unless (and skip-empty-rows (push
(eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) (org-quote-vert
(push row tbl)))) (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
(get-char-property (+ (match-beginning 0) i) 'org-columns-value)
""))
row))
(setq row (nreverse row))
(unless (and skip-empty-rows
(eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
(push row tbl)))))
(append (list title 'hline) (nreverse tbl))))) (append (list title 'hline) (nreverse tbl)))))
(defun org-dblock-write:columnview (params) (defun org-dblock-write:columnview (params)