1.1--- a/emacs/lib/scrum.el	Sun Sep 08 20:11:35 2024 -0400
     1.2+++ b/emacs/lib/scrum.el	Sun Sep 08 21:14:30 2024 -0400
     1.3@@ -68,5 +68,102 @@
     1.4 (defun org-dblock-write:burndown ()
     1.5   "Generate a 'burndown' chart in the current buffer.")
     1.6 
     1.7+;;; Projects
     1.8+;; defining 'project' machinery here because we don't have a better
     1.9+;; place to put it. These functions are intended to map projects
    1.10+;; from 'skel' and 'project.el' into our task-based org system.
    1.11+
    1.12+;; Projects can contain many subprojects, which are identified by org
    1.13+;; headings with a 'PROJECT' todo keyword. Projects and sub-projects
    1.14+;; all have a 'VERSION' property assigned which can't be
    1.15+;; inherited. The 'PROJECT' property itself can be inherited.
    1.16+
    1.17+;; project-info
    1.18+(defcustom org-project-info-order '(details status tasks churn log files)
    1.19+  "Order in which sections of the 'project-info' dblock will appear."
    1.20+  :type 'list
    1.21+  :group 'scrum)
    1.22+
    1.23+(defun org-dblock-write:project-info (params)
    1.24+  "Generate a project-info section.
    1.25+
    1.26+The following keyword parameters can be passed to the info dynamic block:
    1.27+
    1.28+:location Set or override the project location which is inferred by
    1.29+          checking for a LOCATION property in the current tree, followed
    1.30+          by the value of the `project-current' function.
    1.31+
    1.32+:branch Set or override the project branch to display info for. Default
    1.33+        branch name is 'default'.
    1.34+
    1.35+:files When nil don't include the files table.
    1.36+:churn When nil don't include the vc churn report.
    1.37+:log when nil don't include the vc log.
    1.38+:status when nil don't include vc status.
    1.39+:details When nil don't include the project details section."
    1.40+  (let ((location (or (when-let ((param (plist-get params :location)))
    1.41+                        (cl-coerce param 'string))
    1.42+                      (org-entry-get (point) "LOCATION")
    1.43+                      (when-let ((kw (org-collect-keywords '("LOCATION"))))
    1.44+                        (cadar kw))
    1.45+                      (project-root (project-current))))
    1.46+        (point (point))
    1.47+        (files (if-let ((val (plist-member params :files)))
    1.48+                   (cadr val)
    1.49+                 t))
    1.50+        (churn (if-let ((val (plist-member params :churn)))
    1.51+                   (cadr val)
    1.52+                 t))
    1.53+        (status (if-let ((val (plist-member params :log)))
    1.54+                    (cadr val)
    1.55+                  t))
    1.56+        (log (if-let ((val (plist-member params :status)))
    1.57+                 (cadr val)
    1.58+               t))
    1.59+        (tasks (if-let ((val (plist-member params :tasks)))
    1.60+                   (cadr val)
    1.61+                 t))
    1.62+        (details (if-let ((val (plist-member params :details)))
    1.63+                     (cadr val)
    1.64+                   t)))
    1.65+    (message "Generating info for project: %s" location)
    1.66+    (let* ((project (project-current nil location))
    1.67+           (project-name (project-name project))
    1.68+           (project-root (project-root project)))
    1.69+      (dolist (i org-project-info-order)
    1.70+        (pcase i
    1.71+          ('details (when details
    1.72+                      (message "building project details...")
    1.73+                      (insert "#+CALL: project-details() :dir " project-root "\n")
    1.74+                      (org-babel-execute-maybe)
    1.75+                      (org-table-align)))
    1.76+          ('status (when status
    1.77+                     (message "building project status...")
    1.78+                     (insert "#+CALL: hg-status() :dir " project-root "\n")))
    1.79+          ('tasks (when tasks
    1.80+                    (message "building project tasks...")
    1.81+                    (insert "#+CALL: project-tasks() :dir " project-root "\n")))
    1.82+          ('churn (when churn
    1.83+                    (message "building project vc churn...")
    1.84+                    (insert "#+CALL: hg-churn() :dir " project-root "\n")))
    1.85+          ('log (when log
    1.86+                  (message "building project vc log...")))
    1.87+          ('files (when files
    1.88+                    (message "building project file table...")
    1.89+                    (insert "#+CALL: project-files() :dir " project-root "\n")))))
    1.90+      (org-babel-execute-region point (point)))))
    1.91+
    1.92+(defun org-project-info ()
    1.93+  "Insert or update a project-info dblock."
    1.94+  (interactive)
    1.95+  (if (re-search-forward (rx bol "#+BEGIN:" (+ space) "project-info") nil t)
    1.96+      (progn
    1.97+        (if (fboundp 'org-fold-show-entry)
    1.98+            (org-fold-show-entry)
    1.99+          (with-no-warnings (org-show-entry)))
   1.100+        (beginning-of-line))        
   1.101+    (org-create-dblock (list :name "project-info")))
   1.102+  (org-update-dblock))
   1.103+
   1.104 (provide 'scrum)
   1.105 ;;; scrum.el ends here