Triage and resolve open project issues

Author: colonelpanic8

README.org

@@ -35,13 +35,18 @@ You need to set the backend for `org-project-capture` using its class-based stru
     (make-instance 'org-project-capture-project-backend))
   #+END_SRC
 
-- If using `projectile` via `org-projectile`:
+- If using `projectile`:
 
   #+BEGIN_SRC emacs-lisp
+  (require 'org-projectile)
   (setq org-project-capture-default-backend
     (make-instance 'org-project-capture-projectile-backend))
   #+END_SRC
 
+`org-projectile` remains available as a compatibility layer, but the
+preferred setup is to configure `org-project-capture` directly and use the
+projectile backend.
+
 *** File Configuration
 
 Specify the location for storing project-specific TODOs:
@@ -56,8 +61,14 @@ Establish a keybinding for easy capturing:
 
   #+BEGIN_SRC emacs-lisp
   (global-set-key (kbd "C-c n p") 'org-project-capture-project-todo-completing-read)
+  (global-set-key (kbd "C-c n t") 'org-project-capture-capture-for-current-project)
+  (global-set-key (kbd "C-c n a") 'org-project-capture-agenda-for-current-project)
   #+END_SRC
 
+`org-project-capture-project-todo-completing-read` prompts for a project.
+`org-project-capture-capture-for-current-project` uses the current buffer's
+project automatically.
+
 *** Capture Strategy
 
 Determine if TODOs should be in a single file or across individual projects:
@@ -92,6 +103,41 @@ For those utilizing `use-package`, here's a streamlined setup:
       (org-project-capture-single-file))
   #+END_SRC
 
+** `org-capture` Integration
+
+If you prefer to drive everything through `org-capture`, add a project-aware
+template entry:
+
+#+BEGIN_SRC emacs-lisp
+(setq org-capture-templates
+      (append org-capture-templates
+              (list
+               (org-project-capture-project-todo-entry
+                :capture-character "p"
+                :capture-heading "Project TODO"))))
+#+END_SRC
+
+That template uses the current buffer's project automatically.  If you want a
+custom template body, pass `:capture-template`:
+
+#+BEGIN_SRC emacs-lisp
+(org-project-capture-project-todo-entry
+ :capture-character "p"
+ :capture-heading "Project TODO"
+ :capture-template "* NEXT %?\n%U\n")
+#+END_SRC
+
+The command-style entry points also accept `:capture-template` directly:
+
+#+BEGIN_SRC emacs-lisp
+(global-set-key
+ (kbd "C-c n T")
+ (lambda ()
+   (interactive)
+   (org-project-capture-capture-for-current-project
+    :capture-template "* TODO %?\nDEADLINE: %^T\n")))
+#+END_SRC
+
 ** Customization
 
 There are numerous customization options for `org-project-capture`:
@@ -100,4 +146,9 @@ There are numerous customization options for `org-project-capture`:
   M-x customize-group RET org-project-capture RET
   #+END_SRC
 
+Project categories come from the active backend's project names.  For
+`projectile`, that means `projectile-project-name-function` and related
+projectile naming overrides are respected.  This is the recommended way to
+avoid collisions when two different projects would otherwise share the same
+basename.
 

org-project-capture-backend.el

@@ -46,6 +46,11 @@
   ((_backend org-project-capture-backend) _filepath)
   "Return the project root containing FILEPATH.")
 
+(cl-defmethod org-project-capture-project-name-for-path
+  ((_backend org-project-capture-backend) project-path)
+  "Return the backend-specific project name for PROJECT-PATH."
+  (org-project-capture-category-from-project-root project-path))
+
 (cl-defmethod org-project-capture-current-project
   ((_backend org-project-capture-backend))
   "Return the current project name.")
@@ -55,19 +60,21 @@
   "Build an alist mapping category names to project paths for BACKEND."
   (mapcar
    (lambda (path)
-     (cons (org-project-capture-category-from-project-root path) path))
+     (cons (org-project-capture-project-name-for-path backend path) path))
    (org-project-capture-get-all-project-paths backend)))
 
 (cl-defmethod org-project-capture-category-from-file
   ((backend org-project-capture-backend) filepath)
   "Get the category for the project containing FILEPATH using BACKEND."
-  (org-project-capture-category-from-project-root
-   (org-project-capture-project-root-of-filepath backend filepath)))
+  (when-let ((project-root
+              (org-project-capture-project-root-of-filepath backend filepath)))
+    (org-project-capture-project-name-for-path backend project-root)))
 
 (cl-defmethod org-project-capture-get-all-categories
   ((backend org-project-capture-backend))
   "Return a list of all category names for BACKEND."
-  (mapcar 'org-project-capture-category-from-project-root
+  (mapcar (lambda (path)
+            (org-project-capture-project-name-for-path backend path))
           (org-project-capture-get-all-project-paths backend)))
 
 
@@ -80,6 +87,13 @@
   "Return all known project paths using `project-known-project-roots'."
   (project-known-project-roots))
 
+(cl-defmethod org-project-capture-project-name-for-path
+  ((_ org-project-capture-project-backend) project-path)
+  "Return the `project.el' name for PROJECT-PATH."
+  (or (when-let ((project (project-current nil project-path)))
+        (project-name project))
+      (org-project-capture-category-from-project-root project-path)))
+
 (cl-defmethod org-project-capture-project-root-of-filepath
   ((_ org-project-capture-project-backend) filepath)
   "Return the project root for FILEPATH using `project-current'."

org-project-capture.el

@@ -33,6 +33,7 @@
 (require 'dash)
 (require 'eieio)
 (require 'org)
+(require 'org-agenda)
 (require 'org-category-capture)
 (require 'org-project-capture-backend)
 (require 's)
@@ -425,6 +426,35 @@ ARGS are passed to `completing-read'."
   (apply 'completing-read prompt (occ-get-categories org-project-capture-strategy)
          args))
 
+(defun org-project-capture-current-project-context ()
+  "Build an `occ-context' for the current project."
+  (let* ((backend (org-project-capture-strategy-get-backend
+                   org-project-capture-strategy))
+         (project-name (org-project-capture-current-project backend)))
+    (unless project-name
+      (user-error "Current buffer is not in a recognized project"))
+    (make-instance 'occ-context
+                   :category project-name
+                   :template org-project-capture-capture-template
+                   :strategy org-project-capture-strategy
+                   :options nil)))
+
+(defun org-project-capture-current-project-agenda-settings ()
+  "Return agenda settings for the current project.
+The return value is a list of the form (PROJECT-NAME CAPTURE-FILE MATCHER)."
+  (let* ((context (org-project-capture-current-project-context))
+         (category (oref context category))
+         (strategy (if (object-of-class-p org-project-capture-strategy
+                                          'org-project-capture-combine-strategies)
+                       (org-project-capture-select-strategy-from-context
+                        org-project-capture-strategy context)
+                     org-project-capture-strategy))
+         (capture-file (occ-get-capture-file strategy category))
+         (matcher (when (object-of-class-p strategy
+                                           'org-project-capture-single-file-strategy)
+                    (format "CATEGORY=%S" category))))
+    (list category capture-file matcher)))
+
 ;;;###autoload
 (defun org-project-capture-goto-location-for-project (project)
   "Goto the location at which TODOs for PROJECT are stored."
@@ -494,5 +524,23 @@ were part of the capture template definition."
       (error (format "%s is not a recognized project."
                      project-name)))))
 
+;;;###autoload
+(defun org-project-capture-agenda-for-current-project (&optional arg)
+  "Show an agenda view restricted to the current project.
+
+With prefix ARG, pass it through to `org-todo-list' when the current
+project uses per-project storage."
+  (interactive "P")
+  (pcase-let ((`(,project-name ,capture-file ,matcher)
+               (org-project-capture-current-project-agenda-settings)))
+    (unless (file-exists-p capture-file)
+      (user-error "No TODO file exists for current project: %s" project-name))
+    (let ((org-agenda-files (list capture-file))
+          (org-agenda-overriding-header
+           (format "Project TODOs: %s" project-name)))
+      (if matcher
+          (org-tags-view t matcher)
+        (org-todo-list arg)))))
+
 (provide 'org-project-capture)
 ;;; org-project-capture.el ends here

org-projectile-helm.el

@@ -6,7 +6,7 @@
 ;; Keywords: org projectile todo helm outlines
 ;; URL: https://github.com/IvanMalison/org-projectile
 ;; Version: 0.0.0
-;; Package-Requires: ((org-projectile "1.0.0") (helm "2.3.1") (emacs "25"))
+;; Package-Requires: ((org-projectile "1.0.0") (helm "2.3.1") (helm-org "1.0") (emacs "25"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by

org-projectile.el

@@ -48,6 +48,14 @@
   "Return all known project paths from projectile."
   projectile-known-projects)
 
+(cl-defmethod org-project-capture-project-name-for-path
+  ((_ org-project-capture-projectile-backend) project-path)
+  "Return the projectile project name for PROJECT-PATH."
+  (let ((project-name (projectile-project-name project-path)))
+    (if (string-equal project-name "-")
+        (org-project-capture-category-from-project-root project-path)
+      project-name)))
+
 (cl-defmethod org-project-capture-project-root-of-filepath
   ((_ org-project-capture-projectile-backend) filepath)
   "Return the project root for FILEPATH using projectile."

test/org-project-capture-backend-test.el

@@ -89,6 +89,22 @@
         (should (assoc "beta" result))
         (should (assoc "gamma" result))))))
 
+(ert-deftest test-build-category-to-project-path-prefers-project-name ()
+  "Test building category map uses `project-name' when available."
+  (let ((backend (make-instance 'org-project-capture-project-backend)))
+    (cl-letf (((symbol-function 'project-known-project-roots)
+               (lambda () '("/path/to/alpha")))
+              ((symbol-function 'project-current)
+               (lambda (_maybe-prompt dir)
+                 (when (string-prefix-p "/path/to/alpha" dir)
+                   'fake-project)))
+              ((symbol-function 'project-name)
+               (lambda (project)
+                 (should (eq project 'fake-project))
+                 "renamed-alpha")))
+      (let ((result (org-project-capture-build-category-to-project-path backend)))
+        (should (equal result '(("renamed-alpha" . "/path/to/alpha"))))))))
+
 ;; Tests for category-from-file
 
 (ert-deftest test-category-from-file ()

test/org-projectile-test.el

@@ -159,6 +159,56 @@
       (should (eq (eieio-object-class selected)
                   'org-project-capture-per-project-strategy)))))
 
+(ert-deftest test-org-project-capture-projectile-backend-uses-custom-project-names ()
+  "Test that projectile category maps follow `projectile-project-name-function'."
+  (let* ((backend (make-instance 'org-project-capture-projectile-backend))
+         (a-project (org-project-capture-test-file "a"))
+         (b-project (org-project-capture-test-file "b"))
+         (projectile-known-projects (list a-project b-project))
+         (projectile-project-name-function
+          (lambda (project-root)
+            (format "named-%s"
+                    (file-name-nondirectory (directory-file-name project-root))))))
+    (should (equal
+             (org-project-capture-build-category-to-project-path backend)
+             `(("named-a" . ,a-project)
+               ("named-b" . ,b-project))))
+    (should (equal-as-sets
+             (org-project-capture-get-all-categories backend)
+             '("named-a" "named-b")))))
+
+(ert-deftest test-org-project-capture-current-project-agenda-settings-single-file ()
+  "Test agenda settings for single-file strategy."
+  (let ((org-project-capture-strategy
+         (make-instance 'org-project-capture-single-file-strategy)))
+    (cl-letf (((symbol-function 'org-project-capture-strategy-get-backend)
+               (lambda (_strategy) 'fake-backend))
+              ((symbol-function 'org-project-capture-current-project)
+               (lambda (_backend) "proj1"))
+              ((symbol-function 'occ-get-capture-file)
+               (lambda (_strategy category)
+                 (should (string-equal category "proj1"))
+                 "/tmp/projects.org")))
+      (should (equal
+               (org-project-capture-current-project-agenda-settings)
+               '("proj1" "/tmp/projects.org" "CATEGORY=\"proj1\""))))))
+
+(ert-deftest test-org-project-capture-current-project-agenda-settings-per-project ()
+  "Test agenda settings for per-project strategy."
+  (let ((org-project-capture-strategy
+         (make-instance 'org-project-capture-per-project-strategy)))
+    (cl-letf (((symbol-function 'org-project-capture-strategy-get-backend)
+               (lambda (_strategy) 'fake-backend))
+              ((symbol-function 'org-project-capture-current-project)
+               (lambda (_backend) "proj1"))
+              ((symbol-function 'occ-get-capture-file)
+               (lambda (_strategy category)
+                 (should (string-equal category "proj1"))
+                 "/tmp/proj1/TODO.org")))
+      (should (equal
+               (org-project-capture-current-project-agenda-settings)
+               '("proj1" "/tmp/proj1/TODO.org" nil))))))
+
 ;; Tests for heading text processing
 
 (ert-deftest test-org-project-capture-get-category-from-heading-strips-links ()