changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: dblocks

changeset 638: 6c0e4a44c082
parent 637: b88bf15f60d0
child 639: 32375ed43c74
author: Richard Westhaver <ellis@rwest.io>
date: Sat, 07 Sep 2024 22:34:12 -0400
files: emacs/default.el emacs/lib/graph.el emacs/lib/inbox.el emacs/lib/publish.el emacs/lib/scrum.el emacs/lib/ulang.el
description: dblocks
     1.1--- a/emacs/default.el	Wed Sep 04 22:02:21 2024 -0400
     1.2+++ b/emacs/default.el	Sat Sep 07 22:34:12 2024 -0400
     1.3@@ -23,7 +23,7 @@
     1.4  display-time-format "%Y-%m-%d %H:%M"
     1.5  ring-bell-function 'ignore
     1.6  completion-ignore-case t
     1.7-;; NOTE 2023-11-04: you need to add the following lines to ~/.gnupg/gpg-agent.conf:
     1.8+ ;; NOTE 2023-11-04: you need to add the following lines to ~/.gnupg/gpg-agent.conf:
     1.9  ;; allow-emacs-pinentry
    1.10  ;; allow-loopback-pinentry
    1.11  epg-pinentry-mode 'loopback
    1.12@@ -102,7 +102,7 @@
    1.13    htmlize ;; html export
    1.14    all-the-icons all-the-icons-dired all-the-icons-ibuffer ;; icons
    1.15    hide-mode-line) ;; ui
    1.16-   ;; bbdb
    1.17+  ;; bbdb
    1.18   (package-install-selected-packages t))
    1.19 
    1.20 ;;; Env
    1.21@@ -147,16 +147,16 @@
    1.22   (corfu-popupinfo-mode)
    1.23   (corfu-echo-mode)
    1.24   (dolist (c (list (cons "SPC" " ")
    1.25-                 (cons "." ".")
    1.26-                 (cons "," ",")
    1.27-                 (cons ":" ":")
    1.28-                 (cons ")" ")")
    1.29-                 (cons "}" "}")
    1.30-                 (cons "]" "]")))
    1.31-  (define-key corfu-map (kbd (car c)) `(lambda ()
    1.32-                                         (interactive)
    1.33-                                         (corfu-insert)
    1.34-                                         (insert ,(cdr c)))))
    1.35+                   (cons "." ".")
    1.36+                   (cons "," ",")
    1.37+                   (cons ":" ":")
    1.38+                   (cons ")" ")")
    1.39+                   (cons "}" "}")
    1.40+                   (cons "]" "]")))
    1.41+    (define-key corfu-map (kbd (car c)) `(lambda ()
    1.42+                                           (interactive)
    1.43+                                           (corfu-insert)
    1.44+                                           (insert ,(cdr c)))))
    1.45   (add-to-list 'completion-at-point-functions #'cape-dabbrev t)
    1.46   (add-to-list 'completion-at-point-functions #'cape-abbrev t)
    1.47   (add-to-list 'completion-at-point-functions #'cape-file)
    1.48@@ -176,9 +176,9 @@
    1.49 (use-package kind-icon
    1.50   :ensure t
    1.51   :after corfu
    1.52-  ;:custom
    1.53-  ; (kind-icon-blend-background t)
    1.54-  ; (kind-icon-default-face 'corfu-default) ; only needed with blend-background
    1.55+                                        ;:custom
    1.56+                                        ; (kind-icon-blend-background t)
    1.57+                                        ; (kind-icon-default-face 'corfu-default) ; only needed with blend-background
    1.58   :config
    1.59   (add-to-list 'corfu-margin-formatters #'kind-icon-margin-formatter))
    1.60 
    1.61@@ -806,39 +806,66 @@
    1.62         ("C" . "comment")
    1.63         ("v" . "verse")))
    1.64 
    1.65+;; org-sbx [[https://list.orgmode.org/d429d29b-42fa-7d7b-6f3a-9fe692fd6dc7@grinta.net/T/]]
    1.66+(defun %org-sbx (name header args)
    1.67+  (let* ((args (mapconcat
    1.68+                (lambda (x)
    1.69+                  (format "%s=%S" (symbol-name (car x)) (cadr x)))
    1.70+                args ", "))
    1.71+         (ctx (list 'babel-call (list :call name
    1.72+                                      :name name
    1.73+                                      :inside-header header
    1.74+                                      :arguments args
    1.75+                                      :end-header ":results silent")))
    1.76+         (info (org-babel-lob-get-info ctx)))
    1.77+    (when info (org-babel-execute-src-block nil info))))
    1.78+
    1.79+(defmacro org-sbx (name &rest args)
    1.80+  (let* ((header (if (stringp (car args)) (car args) nil))
    1.81+	 (args (if (stringp (car args)) (cdr args) args)))
    1.82+    (unless (stringp name)
    1.83+      (setq name (symbol-name name)))
    1.84+    (let ((result (%org-sbx name header args)))
    1.85+       (org-trim (if (stringp result) result (format "%S" result))))))
    1.86+
    1.87+(defun org-babel-execute-region (beg end &optional arg)
    1.88+   (interactive "r")
    1.89+   (narrow-to-region beg end)
    1.90+   (org-babel-execute-buffer arg)
    1.91+   (widen))
    1.92+
    1.93 (defun org-schedule-effort ()
    1.94-(interactive)
    1.95+  (interactive)
    1.96   (save-excursion
    1.97     (org-back-to-heading t)
    1.98-    (let* (
    1.99-        (element (org-element-at-point))
   1.100-        (effort (org-element-property :EFFORT element))
   1.101-        (scheduled (org-element-property :scheduled element))
   1.102-        (ts-year-start (org-element-property :year-start scheduled))
   1.103-        (ts-month-start (org-element-property :month-start scheduled))
   1.104-        (ts-day-start (org-element-property :day-start scheduled))
   1.105-        (ts-hour-start (org-element-property :hour-start scheduled))
   1.106-        (ts-minute-start (org-element-property :minute-start scheduled)) )
   1.107+    (let* ((element (org-element-at-point))
   1.108+           (effort (org-element-property :EFFORT element))
   1.109+           (scheduled (org-element-property :scheduled element))
   1.110+           (ts-year-start (org-element-property :year-start scheduled))
   1.111+           (ts-month-start (org-element-property :month-start scheduled))
   1.112+           (ts-day-start (org-element-property :day-start scheduled))
   1.113+           (ts-hour-start (org-element-property :hour-start scheduled))
   1.114+           (ts-minute-start (org-element-property :minute-start scheduled)) )
   1.115       (org-schedule nil (concat
   1.116-        (format "%s" ts-year-start)
   1.117-        "-"
   1.118-        (if (< ts-month-start 10)
   1.119-          (concat "0" (format "%s" ts-month-start))
   1.120-          (format "%s" ts-month-start))
   1.121-        "-"
   1.122-        (if (< ts-day-start 10)
   1.123-          (concat "0" (format "%s" ts-day-start))
   1.124-          (format "%s" ts-day-start))
   1.125-        " "
   1.126-        (if (< ts-hour-start 10)
   1.127-          (concat "0" (format "%s" ts-hour-start))
   1.128-          (format "%s" ts-hour-start))
   1.129-        ":"
   1.130-        (if (< ts-minute-start 10)
   1.131-          (concat "0" (format "%s" ts-minute-start))
   1.132-          (format "%s" ts-minute-start))
   1.133-        "+"
   1.134-        effort)) )))
   1.135+                         (format "%s" ts-year-start)
   1.136+                         "-"
   1.137+                         (if (< ts-month-start 10)
   1.138+                             (concat "0" (format "%s" ts-month-start))
   1.139+                           (format "%s" ts-month-start))
   1.140+                         "-"
   1.141+                         (if (< ts-day-start 10)
   1.142+                             (concat "0" (format "%s" ts-day-start))
   1.143+                           (format "%s" ts-day-start))
   1.144+                         " "
   1.145+                         (if (< ts-hour-start 10)
   1.146+                             (concat "0" (format "%s" ts-hour-start))
   1.147+                           (format "%s" ts-hour-start))
   1.148+                         ":"
   1.149+                         (if (< ts-minute-start 10)
   1.150+                             (concat "0" (format "%s" ts-minute-start))
   1.151+                           (format "%s" ts-minute-start))
   1.152+                         "+"
   1.153+                         effort)) )))
   1.154 
   1.155 (setopt org-preview-latex-image-directory "~/.emacs.d/.cache/ltximg"
   1.156         org-latex-image-default-width "8cm"
   1.157@@ -994,7 +1021,7 @@
   1.158             (command-execute 'outline-next-visible-heading)
   1.159             ;; disable (message) that org-set-tags generates
   1.160             (cl-flet ((message (&rest ignored) nil))
   1.161-                  (org-set-tags 1 t))
   1.162+              (org-set-tags 1 t))
   1.163             (set-buffer-modified-p b-m-p))
   1.164         (error nil)))))
   1.165 
   1.166@@ -1052,7 +1079,7 @@
   1.167 (defun org-agenda-reschedule-to-today ()
   1.168   (interactive)
   1.169   (cl-flet ((org-read-date (&rest rest) (current-time)))
   1.170-        (call-interactively 'org-agenda-schedule)))
   1.171+    (call-interactively 'org-agenda-schedule)))
   1.172 
   1.173 ;; Patch org-mode to use vertical splitting
   1.174 (defadvice org-prepare-agenda (after org-fix-split)
     2.1--- a/emacs/lib/graph.el	Wed Sep 04 22:02:21 2024 -0400
     2.2+++ b/emacs/lib/graph.el	Sat Sep 07 22:34:12 2024 -0400
     2.3@@ -90,6 +90,7 @@
     2.4 (defun org-graph-from-id-locations ()
     2.5   "Populate the `org-graph' from `org-id-locations', filtering out any
     2.6 entries not under a member of `org-graph-locations'."
     2.7+  (interactive)
     2.8   (setq-local org-graph (copy-hash-table (org-id-locations-load)))
     2.9   (maphash
    2.10    (lambda (k v)
    2.11@@ -100,6 +101,11 @@
    2.12       org-graph-locations))
    2.13    org-graph))
    2.14 
    2.15+(defun org-dblock-write:links ()
    2.16+  "Generate a 'links' block for the designated node.")
    2.17+
    2.18+(defun org-dblock-write:graph ()
    2.19+  "Generate a 'graph' block for the designated set of nodes.")
    2.20+
    2.21 (provide 'graph)
    2.22 ;; graph.el ends here
    2.23-
     3.1--- a/emacs/lib/inbox.el	Wed Sep 04 22:02:21 2024 -0400
     3.2+++ b/emacs/lib/inbox.el	Sat Sep 07 22:34:12 2024 -0400
     3.3@@ -115,8 +115,8 @@
     3.4   (org-map-entries
     3.5    (lambda ()
     3.6      (unless (= (org-current-level) 1)
     3.7-     (org-todo "DONE"))
     3.8-   nil 'tree)))
     3.9+       (org-todo "DONE"))
    3.10+     nil 'tree)))
    3.11 
    3.12 (defmacro with-inbox-buffer (&rest body)
    3.13   `(save-excursion
    3.14@@ -162,7 +162,7 @@
    3.15     (cond
    3.16      ((< (cdr a) (cdr b)) t)
    3.17      ((> (cdr a) (cdr b)) nil)))))
    3.18-     
    3.19+
    3.20 
    3.21 (defun org-inbox-sort ()
    3.22   "Sort the current heading by todo order followed by priority."
    3.23@@ -195,7 +195,86 @@
    3.24     (kill-buffer inbox)))
    3.25 
    3.26 ;;; dblocks
    3.27-(defun org-dblock-write:summary ())
    3.28+
    3.29+;; summary
    3.30+(defun org-dblock-write:summary (params)
    3.31+  "Generate a file or heading summary section.")
    3.32+
    3.33+(defun org-summary ()
    3.34+  "Insert or update a summary section.")
    3.35+
    3.36+;; project-info
    3.37+(defcustom org-project-info-order '(details status churn log files)
    3.38+  "Order in which sections of the 'project-info' dblock will appear."
    3.39+  :type 'list
    3.40+  :group 'inbox)
    3.41+
    3.42+(defun org-dblock-write:project-info (params)
    3.43+  "Generate a project-info section.
    3.44+
    3.45+The following keyword parameters can be passed to the info dynamic block:
    3.46+
    3.47+:location Set or override the project location which is inferred by
    3.48+          checking for a LOCATION property in the current tree, followed
    3.49+          by the value of the `project-current' function.
    3.50+
    3.51+:branch Set or override the project branch to display info for. Default
    3.52+        branch name is 'default'.
    3.53+
    3.54+:files When nil don't include the files table.
    3.55+:churn When nil don't include the vc churn report.
    3.56+:log when nil don't include the vc log.
    3.57+:status when nil don't include vc status.
    3.58+:details When nil don't include the project details section."
    3.59+  (let ((location (or (when-let ((param (plist-get params :location)))
    3.60+                        (cl-coerce param 'string))
    3.61+                      (org-entry-get (point) "LOCATION")
    3.62+                      (when-let ((kw (org-collect-keywords '("LOCATION"))))
    3.63+                        (cadar kw))
    3.64+                      (project-root (project-current))))
    3.65+        (point (point))
    3.66+        (files (if-let ((val (plist-member params :files)))
    3.67+                   (cadr val)
    3.68+                 t))
    3.69+        (churn (if-let ((val (plist-member params :churn)))
    3.70+                   (cadr val)
    3.71+                 t))
    3.72+        (status (if-let ((val (plist-member params :log)))
    3.73+                    (cadr val)
    3.74+                  t))
    3.75+        (log (if-let ((val (plist-member params :status)))
    3.76+                 (cadr val)
    3.77+               t))
    3.78+        (details (if-let ((val (plist-member params :details)))
    3.79+                     (cadr val)
    3.80+                   t)))
    3.81+    (message "Generating info for project: %s" location)
    3.82+    (let* ((project (project-current nil location))
    3.83+           (project-name (project-name project))
    3.84+           (project-root (project-root project)))
    3.85+      (dolist (i org-project-info-order)
    3.86+        (pcase i
    3.87+          ('details (when details
    3.88+                      (message "building project details...")
    3.89+                      (insert "#+CALL: project-details() :dir " project-root "\n")
    3.90+                      (org-babel-execute-maybe)
    3.91+                      (org-table-align)))
    3.92+          ('status (when status
    3.93+                     (message "building project status...")
    3.94+                     (insert "#+CALL: hg-status() :dir " project-root "\n")))
    3.95+          ('churn (when churn
    3.96+                    (message "building project vc churn...")
    3.97+                    (insert "#+CALL: hg-churn() :dir " project-root "\n")))
    3.98+          ('log (when log
    3.99+                  (message "building project vc log...")))
   3.100+          ('files (when files
   3.101+                    (message "building project file table...")
   3.102+                    (insert "#+CALL: files() :dir " project-root "\n")))))
   3.103+      (org-babel-execute-region point (point)))))
   3.104+
   3.105+(defun org-project-info ()
   3.106+  "Insert or update a project-info dblock."
   3.107+  (interactive))
   3.108 
   3.109 (defun org-inbox-configure-dblock ()
   3.110   "Configure the current org-inbox-dblock at point."
   3.111@@ -212,19 +291,19 @@
   3.112   (erase-buffer)
   3.113   (remove-overlays)
   3.114   (widget-insert "\n\n")
   3.115-    (widget-create 'push-button
   3.116-      :notify (lambda(_widget &rest _ignore)
   3.117-                (with-current-buffer buffer
   3.118-                  (goto-char position)
   3.119-                  )
   3.120-                (kill-buffer)
   3.121-                (org-ctrl-c-ctrl-c))
   3.122-      (propertize "Apply" 'face 'font-lock-comment-face))
   3.123-    (widget-insert " ")
   3.124-    (widget-create 'push-button
   3.125-      :notify (lambda (_widget &rest _ignore)
   3.126-                (kill-buffer))
   3.127-      (propertize "Cancel" 'face 'font-lock-string-face))
   3.128+  (widget-create 'push-button
   3.129+                 :notify (lambda(_widget &rest _ignore)
   3.130+                           (with-current-buffer buffer
   3.131+                             (goto-char position)
   3.132+                             )
   3.133+                           (kill-buffer)
   3.134+                           (org-ctrl-c-ctrl-c))
   3.135+                 (propertize "Apply" 'face 'font-lock-comment-face))
   3.136+  (widget-insert " ")
   3.137+  (widget-create 'push-button
   3.138+                 :notify (lambda (_widget &rest _ignore)
   3.139+                           (kill-buffer))
   3.140+                 (propertize "Cancel" 'face 'font-lock-string-face))
   3.141   (use-local-map widget-keymap)
   3.142   (widget-setup))
   3.143 
     4.1--- a/emacs/lib/publish.el	Wed Sep 04 22:02:21 2024 -0400
     4.2+++ b/emacs/lib/publish.el	Sat Sep 07 22:34:12 2024 -0400
     4.3@@ -37,10 +37,9 @@
     4.4       debug-on-error t
     4.5       org-id-link-to-org-use-id t)
     4.6 
     4.7-(setq org-html-link-up "")
     4.8 (setq org-html-link-home url)
     4.9 
    4.10-(setq org-html-home/up-format "<div id=\"org-div-home-and-up\"><a href=\"%s\" accesskey=\"h\"><button class=home>~</button></a>
    4.11+(setq org-html-home/up-format "<div id=\"org-div-home-and-up\"><a href=\"%s\" accesskey=\"h\"><button class=home>⌂</button></a><a href=\"%s\" accesskey=\"u\"><button class=up>▲</button></a>
    4.12 <button accesskey=\"s\" class=show onclick=open_all_sections()>show</button> <button accesskey=\"x\" class=hide onclick=close_all_sections()>hide</button></div>")
    4.13       
    4.14 (setq org-publish-project-alist
    4.15@@ -185,7 +184,7 @@
    4.16 
    4.17 ;;;###autoload
    4.18 (defun publish (&optional sitemap static force async)
    4.19-  "publish `rwest-io' content.
    4.20+  "publish `compiler.company' content.
    4.21 If STATIC is t, also publish media and static files.
    4.22 If FORCE is t, skip checking file mod date and just publish all files.
    4.23 If ASYNC is t, call `org-publish' asynchronously.
     5.1--- a/emacs/lib/scrum.el	Wed Sep 04 22:02:21 2024 -0400
     5.2+++ b/emacs/lib/scrum.el	Sat Sep 07 22:34:12 2024 -0400
     5.3@@ -61,5 +61,12 @@
     5.4 
     5.5 (defvar scrum-tags '("demo" "mvp" "release" "major-release" "ua" "qa"))
     5.6 
     5.7+(defun org-dblock-write:scrumboard ()
     5.8+  "Generate a 'scrumboard'.")
     5.9+
    5.10+;; TODO 2024-09-06: eplot
    5.11+(defun org-dblock-write:burndown ()
    5.12+  "Generate a 'burndown' chart in the current buffer.")
    5.13+
    5.14 (provide 'scrum)
    5.15 ;;; scrum.el ends here
     6.1--- a/emacs/lib/ulang.el	Wed Sep 04 22:02:21 2024 -0400
     6.2+++ b/emacs/lib/ulang.el	Sat Sep 07 22:34:12 2024 -0400
     6.3@@ -48,7 +48,7 @@
     6.4 
     6.5 (org-dynamic-block-define "links" 'dblock-insert-links)
     6.6 
     6.7-(org-export-translate-to-lang (list '("Table of Contents" "Index")) "ulang")
     6.8+;; (org-export-translate-to-lang (list '("Table of Contents" "Index")) "ulang")
     6.9 ;; (setq org-export-global-macros nil)
    6.10 
    6.11 ;; todo keywords