Parcourir la source

Column view: Skip COMMENT and ARCHIVE trees when capturing

Proposal by Giovanni Ridolfi.
Carsten Dominik il y a 16 ans
Parent
commit
9d59bc0d29
3 fichiers modifiés avec 59 ajouts et 39 suppressions
  1. 2 0
      lisp/ChangeLog
  2. 30 21
      lisp/org-colview-xemacs.el
  3. 27 18
      lisp/org-colview.el

+ 2 - 0
lisp/ChangeLog

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

+ 30 - 21
lisp/org-colview-xemacs.el

@@ -1269,31 +1269,40 @@ of fields."
   (if (featurep 'xemacs)
       (save-excursion
         (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)
           (goto-char (point-min))
 
 	  (while (re-search-forward "^\\(\\*+\\) " nil t)
-	    (when (and (or (null maxlevel)
-			   (>= maxlevel
-			       (if org-odd-levels-only
-				   (/ (1+ (length (match-string 1))) 2)
-				 (length (match-string 1)))))
-		       (get-char-property (match-beginning 0) 'org-columns-key))
-              (goto-char (match-beginning 0))
-              (setq row nil)
-              (loop for i from 0 to (1- n) do
-		    (push 
-		     (org-quote-vert
-		      (or (get-char-property (point)
-					     'org-columns-value-modified)
-			  (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))))
+	    (catch 'next
+	      (when (and (or (null maxlevel)
+			     (>= maxlevel
+				 (if org-odd-levels-only
+				     (/ (1+ (length (match-string 1))) 2)
+				   (length (match-string 1)))))
+			 (get-char-property (match-beginning 0) 'org-columns-key))
+		(goto-char (match-beginning 0))
+		(when (save-excursion
+			(goto-char (point-at-bol))
+			(or (looking-at re-comment)
+			    (looking-at re-archive)))
+		  (org-end-of-subtree t)
+		  (throw 'next t))
+		(setq row nil)
+		(loop for i from 0 to (1- n) do
+		      (push 
+		       (org-quote-vert
+			(or (get-char-property (point)
+					       'org-columns-value-modified)
+			    (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))))
     (save-excursion
       (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))

+ 27 - 18
lisp/org-colview.el

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