Allow org-projectile-per-project-filepath to be a function

Fixes #39

Makefile

@@ -10,7 +10,7 @@ EMACS = $(shell sh -c 'evm bin')
 	$(CASK) install
 
 $(OBJECTS): .cask
-	$(CASK) build
+	$(CASK) build --verbose
 
 compile: $(OBJECTS)
 

org-category-capture.el

@@ -79,9 +79,10 @@
                           (plist-get org-store-link-plist :annotation)
                         (ignore-errors (org-store-link nil)))))
       (org-capture-put :original-buffer orig-buf
-                       :original-file (or (buffer-file-name orig-buf)
-                                          (and (featurep 'dired)
-                                               (car (rassq orig-buf dired-buffers))))
+                       :original-file
+                       (or (buffer-file-name orig-buf)
+                           (and (featurep 'dired)
+                                (car (rassq orig-buf dired-buffers))))
                        :original-file-nondirectory
                        (and (buffer-file-name orig-buf)
                             (file-name-nondirectory
@@ -108,19 +109,20 @@
   (occ-get-capture-marker (oref context strategy) context))
 
 (cl-defun occ-get-category-heading-location
-    (category &rest args &key do-tree &allow-other-keys)
+    (category &rest args &key goto-subheading &allow-other-keys)
   "Find a heading with text or category CATEGORY."
   (save-excursion
+    (when goto-subheading (funcall goto-subheading))
     (if (equal major-mode 'org-mode)
         (let (result)
           (org-map-entries
            (lambda ()
              (when (and (not result)
                         (equal (apply 'occ-get-heading-category args) category))
                (setq result (point))))
-           nil (when do-tree 'tree)
+           nil (when goto-subheading 'tree)
            (1+ (or (org-current-level) 0))
-           (occ-level-filter (if do-tree (1+ (org-current-level)) 1)))
+           (occ-level-filter (if goto-subheading (1+ (org-current-level)) 1)))
           result)
       (error "Can't get category heading in non org-mode file"))))
 
@@ -136,7 +138,7 @@
     (category &rest args &key (build-heading 'identity)
               (insert-heading-fn 'occ-insert-at-end-of-file)
               &allow-other-keys)
-  "Create a heading for CATEGORY unless one is found with `occ-goto-category-heading'.
+  "Navigate to the heading for CATEGORY, creating one if it does not exist.
 
 BUILD-HEADING will be applied to category to create the heading
 text. INSERT-HEADING-FN is the function that will be used to
@@ -159,14 +161,6 @@ tuned so that by default it looks and creates top level headings."
   (occ-end-of-properties)
   (org-insert-subheading t))
 
-(defun occ-goto-or-insert-category-heading-subtree (category &rest args)
-  "Call `occ-goto-or-insert-category-heading' with CATEGORY forwarding ARGS.
-
-Provide arguments that will make it consider subheadings of the
-current heading."
-  (apply 'occ-goto-or-insert-category-heading
-         category :insert-heading-fn 'occ-insert-subheading :do-tree t args))
-
 (defun occ-level-filter (level)
   (lambda ()
     (unless (equal (org-current-level) level)

org-projectile.el

@@ -47,8 +47,10 @@
   :group 'org-projectile)
 
 (defcustom org-projectile-per-project-filepath "TODO.org"
-  "The path (relative to the project) where todos will be stored."
-  :type '(string)
+  "The path (relative to the project) where todos will be stored.
+Alternatively you may provide a function that will compute this
+path."
+  :type '(choice string function)
   :group 'org-projectile)
 
 (defcustom org-projectile-capture-template "* TODO %?\n"
@@ -137,8 +139,12 @@
 ;; One file per project strategy
 
 (defun org-projectile-get-project-todo-file (project-path)
-  (concat
-   (file-name-as-directory project-path) org-projectile-per-project-filepath))
+  (let ((relative-filepath
+         (if (stringp org-projectile-per-project-filepath)
+             org-projectile-per-project-filepath
+           (funcall org-projectile-per-project-filepath project-path))))
+    (concat
+     (file-name-as-directory project-path) relative-filepath)))
 
 (defun org-projectile-get-category-from-project-todo-file (project-path)
   (let ((todo-filepath (org-projectile-get-project-todo-file project-path)))
@@ -191,34 +197,36 @@
 (defun org-projectile-get-categories-from-project-paths ()
   (mapcar 'org-projectile-category-from-project-root projectile-known-projects))
 
-(defclass org-projectile-top-level-heading-files-strategy nil nil)
+(defun org-projectile-linked-heading (heading)
+  (org-make-link-string
+   (format "elisp:(org-projectile-open-project \"%s\")" heading) heading))
+
+(defun org-projectile-build-heading (heading)
+  (when org-projectile-force-linked
+    (setq heading (org-projectile-linked-heading heading)))
+  (if org-projectile-counts-in-heading (concat heading " [/]")
+    heading))
+
+(defclass org-projectile-top-level-categories-specifier nil nil)
+
+(defmethod org-projectile-get-existing-categories
+  )
+
+(defclass org-projectile-single-file-strategy nil nil)
 
 (defmethod org-projectile-category-to-project-path
-    ((_s org-projectile-top-level-heading-files-strategy))
+    ((_s org-projectile-single-file-strategy))
   (org-projectile-default-project-categories))
 
 (defmethod occ-get-categories
-    ((_s org-projectile-top-level-heading-files-strategy))
+    ((_s org-projectile-single-file-strategy))
   (cl-remove-if
    'null
    (delete-dups
     (nconc
      (org-projectile-get-categories-from-project-paths)
      (occ-get-categories-from-filepath org-projectile-projects-file)))))
 
-(defun org-projectile-linked-heading (heading)
-  (org-make-link-string
-   (format "elisp:(org-projectile-open-project \"%s\")" heading) heading))
-
-(defun org-projectile-build-heading (heading)
-  (when org-projectile-force-linked
-    (setq heading (org-projectile-linked-heading heading)))
-  (if org-projectile-counts-in-heading (concat heading " [/]")
-    heading))
-
-(defclass org-projectile-single-file-strategy
-  (org-projectile-top-level-heading-files-strategy) nil)
-
 (defmethod occ-get-categories ((_s org-projectile-single-file-strategy))
   (cl-remove-if
    'null
@@ -274,13 +282,14 @@
            (capture-template org-projectile-capture-template)
            (capture-heading "Project Todo") &allow-other-keys)
   (let ((target-fn
-         (lambda () (occ-capture-goto-marker
-                     (make-instance 'occ-context
-                                    :category (org-projectile-category-from-file
-                                               (org-capture-get :original-file))
-                                    :template capture-template
-                                    :strategy org-projectile-strategy
-                                    :options additional-options)))))
+         (lambda ()
+           (occ-capture-goto-marker
+            (make-instance 'occ-context
+                           :category (org-projectile-category-from-file
+                                      (org-capture-get :original-file))
+                           :template capture-template
+                           :strategy org-projectile-strategy
+                           :options additional-options)))))
     `(,capture-character ,capture-heading entry
                          (function
                           ,target-fn)

test/org-projectile-test.el

@@ -41,5 +41,19 @@
                            '("proj1" "ideas2" "test" "proj4" "proj3"
                              "github-search")))))
 
+(ert-deftest org-projectile-per-project-filepath-with-function ()
+  (let ((org-projectile-strategy (make-instance 'org-projectile-per-project-strategy))
+        (projectile-known-projects '("/a" "/b"))
+        (org-projectile-per-project-filepath
+         (lambda (path)
+           (if (string-equal path "/a")
+               "OTHER.org"
+             "TODO.org"))))
+    (should (equal-as-sets (org-projectile-todo-files)
+                           '("/a/OTHER.org" "/b/TODO.org")))
+    (let ((org-projectile-per-project-filepath "COOL.org"))
+      (should (equal-as-sets (org-projectile-todo-files)
+                           '("/a/COOL.org" "/b/COOL.org"))))))
+
 (provide 'org-projectile-test)
 ;;; org-projectile-test.el ends here