Bladeren bron

Added new `org-agenda-filter-by-top-category' command

John Wiegley 13 jaren geleden
bovenliggende
commit
3bd1c2e9bf
1 gewijzigde bestanden met toevoegingen van 39 en 0 verwijderingen
  1. 39 0
      lisp/org-agenda.el

+ 39 - 0
lisp/org-agenda.el

@@ -6227,6 +6227,29 @@ The category is that of the current line."
 	       (list (concat (if strip "-" "+") cat)) 'category)
 	(error "No category at point")))))
 
+(defun org-find-top-category (&optional pos)
+  (save-excursion
+    (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
+     (if pos (goto-char pos))
+     ;; Skip up to the topmost parent
+     (while (ignore-errors (outline-up-heading 1) t))
+     (ignore-errors
+       (nth 4 (org-heading-components))))))
+
+(defvar org-agenda-filtered-by-top-category nil)
+
+(defun org-agenda-filter-by-top-category (strip)
+  "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+  (interactive "P")
+  (if org-agenda-filtered-by-top-category
+      (progn
+        (setq org-agenda-filtered-by-top-category nil)
+        (org-agenda-filter-show-all-cat))
+    (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker))))
+      (if cat (org-agenda-filter-top-category-apply cat strip)
+        (error "No top-level category at point")))))
+
 (defun org-agenda-filter-by-tag (strip &optional char narrow)
   "Keep only those lines in the agenda buffer that have a specific tag.
 The tag is selected with its fast selection letter, as configured.
@@ -6422,6 +6445,22 @@ If the line does not have an effort defined, return nil."
     (if (get-char-property (point) 'invisible)
 	(ignore-errors (org-agenda-previous-line)))))
 
+(defun org-agenda-filter-top-category-apply (category &optional negative)
+  "Set FILTER as the new agenda filter and apply it."
+  (org-agenda-set-mode-name)
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eobp))
+      (let* ((pos (org-get-at-bol 'org-hd-marker))
+             (topcat (and pos (org-find-top-category pos))))
+        (if (and topcat (funcall (if negative 'identity 'not)
+                                 (string= category topcat)))
+            (org-agenda-filter-hide-line 'category)))
+      (beginning-of-line 2)))
+  (if (get-char-property (point) 'invisible)
+      (org-agenda-previous-line))
+  (setq org-agenda-filtered-by-top-category t))
+
 (defun org-agenda-filter-hide-line (type)
   (let (ov)
     (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))