From 1a45c6107d87d234dae74bc4ad11892e79e3cb4c Mon Sep 17 00:00:00 2001 From: Colin Powell Date: Mon, 9 Jun 2025 10:41:10 -0400 Subject: [PATCH] [emacs] Add org scrobbling functions take one --- emacs/.config/doom/config.el | 273 +++++++++++++++++++++++++++++++++++ emacs/.config/doom/custom.el | 3 +- 2 files changed, 275 insertions(+), 1 deletion(-) diff --git a/emacs/.config/doom/config.el b/emacs/.config/doom/config.el index 98576fa..fec4e5f 100644 --- a/emacs/.config/doom/config.el +++ b/emacs/.config/doom/config.el @@ -130,3 +130,276 @@ ;; We only want Bash aliases to be loaded when Eshell loads its own aliases, ;; rather than every time `eshell-mode' is enabled. (add-hook 'eshell-alias-load-hook 'eshell-load-bash-aliases) + +(defun eshell-run-direnv-allow() + (direnv-allow)) + +(add-hook 'eshell-directory-change-hook 'eshell-run-direnv-allow) + +(defun org-raw-timestamp-to-iso (raw-ts) + "Convert Org RAW-TS like `<2025-06-12 Thu 14:00>` to `YYYY-MM-DDThh:mm:ss`." + (when raw-ts + (let* ((ts (org-parse-time-string raw-ts)) + (year (nth 5 ts)) (mon (nth 4 ts)) (day (nth 3 ts)) + (hour (nth 2 ts) 0) (min (nth 1 ts) 0)) + (format "%04d-%02d-%02dT%02d:%02d:00" year mon day hour min)))) + +(defun org-extract-labeled-timestamps () + "Return an alist of labeled ISO-formatted timestamps in the current Org subtree." + (save-restriction + (org-narrow-to-subtree) + (let ((parsed (org-element-parse-buffer)) + (labeled-ts '())) + (org-element-map parsed '(timestamp) + (lambda (ts) + (let* ((type (org-element-property :type ts)) + (raw (org-element-property :raw-value ts)) + (time (org-parse-time-string raw t)) + (date (format "%04d-%02d-%02d" + (nth 5 time) (nth 4 time) (nth 3 time))) + (hour (nth 2 time)) + (min (nth 1 time)) + (with-time (and hour min (format "%sT%02d:%02d" date hour min))) + (label (cond + ((eq type 'active) "timestamp") + ((eq type 'inactive) "inactive-timestamp") + (t "timestamp")))) + (push (cons label (or with-time date)) labeled-ts)))) + ;; Add planning info from heading (DEADLINE, SCHEDULED, CLOSED) + (dolist (key '("DEADLINE" "SCHEDULED" "CLOSED")) + (let ((raw (org-entry-get nil key t))) + (when raw + (let* ((ts (org-parse-time-string raw t)) + (date (format "%04d-%02d-%02d" (nth 5 ts) (nth 4 ts) (nth 3 ts))) + (hour (nth 2 ts)) + (min (nth 1 ts)) + (with-time (and hour min (format "%sT%02d:%02d" date hour min)))) + (push (cons (downcase key) (or with-time date)) labeled-ts))))) + (delete-dups labeled-ts)))) + +(defun org-get-body () + "Return the body text under the current Org heading as a string." + (save-excursion + (org-back-to-heading t) + (let ((start (progn (forward-line) (point))) + (end (progn (org-end-of-subtree t t) (point)))) + (buffer-substring-no-properties start end)))) + +(defun org-strip-timestamps-from-text (text) + "Remove Org timestamps and planning lines from TEXT." + (let* ((timestamp-re (rx (or (seq "<" (+ (not (any ">"))) ">") + (seq "[" (+ (not (any "]"))) "]")))) + (planning-line-re (rx line-start (zero-or-more space) + (or "DEADLINE:" "SCHEDULED:" "CLOSED:") " ")) + ;; Step 1: remove full planning lines + (without-planning-lines + (replace-regexp-in-string + (concat planning-line-re ".*\n?") "" text)) + ;; Step 2: remove inline timestamps + (without-inline + (replace-regexp-in-string timestamp-re "" without-planning-lines))) + (string-trim without-inline))) + +(defun org-extract-drawers () + "Extract all drawers (like LOGBOOK, PROPERTIES, etc.) from current org entry. +Returns an alist of (DRAWER-NAME . CONTENT) pairs. +- PROPERTIES content is parsed into (KEY . VALUE) +- Other drawers are returned as lists of lines (strings)" + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion (org-end-of-subtree t t))) + (drawers '())) + (while (re-search-forward "^\\s-*:\\([A-Z]+\\):\\s-*$" end t) + (let* ((name (match-string 1)) + (start (match-end 0)) + (drawer-end (when (re-search-forward "^\\s-*:END:\\s-*$" end t) + (match-beginning 0)))) + (when drawer-end + (let ((content (buffer-substring-no-properties start drawer-end))) + (setq drawers + (cons + (cons name + (if (string= name "PROPERTIES") + ;; parse :KEY: VALUE + (org-parse-properties content) + ;; just return line list + (split-string content "\n" t "[ \t]+"))) + drawers)))))) + (reverse drawers)))) + +(defun org-parse-properties (content) + "Parse PROPERTIES drawer content into an alist." + (let ((lines (split-string content "\n" t)) + (props '())) + (dolist (line lines) + (when (string-match "^\\s-*:\\([^:]+\\):\\s-*\\(.*\\)$" line) + (push (cons (match-string 1 line) (match-string 2 line)) props))) + (reverse props))) + +(defun org-clean-body-text (text) + "Remove planning lines, timestamps, and drawers from TEXT." + (let* ((timestamp-re + (rx (or (seq "<" (+ (not (any ">"))) ">") + (seq "[" (+ (not (any "]"))) "]")))) + (planning-re + (rx line-start (zero-or-more space) + (or "DEADLINE:" "SCHEDULED:" "CLOSED:") " " (* nonl) "\n")) + (text (replace-regexp-in-string planning-re "" text)) + (text (replace-regexp-in-string timestamp-re "" text)) + (text (org-strip-all-drawers text))) + (string-trim text))) + +(defun org-strip-timestamps-drawers-notes-from-text (text) + "Strip timestamps, planning lines, drawers, and note blocks from Org TEXT." + (let* ((timestamp-re + (rx (or (seq "<" (+ (not (any ">"))) ">") + (seq "[" (+ (not (any "]"))) "]")))) + (planning-re + (rx line-start (zero-or-more space) + (or "DEADLINE:" "SCHEDULED:" "CLOSED:") " " (* nonl) "\n")) + (drawer-re + "^\\s-*:[A-Z]+:\\(?:.\\|\n\\)*?:END:\n?") + (note-block-re + (rx-to-string + `(and bol (* space) "- Note taken on " + (or "[" "<") (+ (not (any "]>"))) (or "]" ">") + (*? anything) + (or "\n\n" eos)) + t))) + + ;; Strip drawers first + (setq text (replace-regexp-in-string drawer-re "" text)) + + ;; Strip entire note blocks (greedy match up to next blank line or end) + (setq text (replace-regexp-in-string note-block-re "" text)) + + ;; Strip planning lines and timestamps + (setq text (replace-regexp-in-string planning-re "" text)) + (setq text (replace-regexp-in-string timestamp-re "" text)) + + ;; Trim and return + (string-trim text))) + +(defun org-get-body-stripped () + "Get cleaned Org entry body without timestamps, planning lines, drawers, or notes." + (org-strip-timestamps-drawers-notes-from-text (org-get-body))) + + +(defun org-extract-notes () + "Extract notes from Org entry, each as an alist with `timestamp` and `content`." + (save-excursion + (org-back-to-heading t) + (let ((start (progn (forward-line) (point))) + (end (progn (org-end-of-subtree t t) (point))) + result) ;; ✅ initialize result list + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "^\\s-*[-+] Note taken on \\[\\([^]]+\\)\\]\\s-*\\(?:\\\\\\\\\\)?\\s-*$" nil t) + (let* ((raw-ts (match-string 1)) + (timestamp (let* ((ts (org-parse-time-string raw-ts t))) + (format "%04d-%02d-%02dT%02d:%02d" + (nth 5 ts) (nth 4 ts) (nth 3 ts) + (nth 2 ts) (nth 1 ts)))) + (note-start (progn + (forward-line) + ;; allow one optional blank line + (when (looking-at-p "^\\s-*$") (forward-line)) + (point))) + (note-end (or (save-excursion + (re-search-forward "^\\s-*[-+] Note taken on \\[" nil t)) + (point-max))) + (content (string-trim + (buffer-substring-no-properties note-start (1- note-end))))) + (push `(("timestamp" . ,timestamp) + ("content" . ,content)) + result)))) + (nreverse result)))) + +(require 'subr-x) ;; for string-trim and string functions, usually loaded by default + +(defun my-org-generate-uuid () + "Generate a random UUID string." + (let ((uuid (md5 (format "%s%s%s%s%s" + (user-uid) + (emacs-pid) + (float-time) + (random) + (emacs-pid))))) + (concat (substring uuid 0 8) "-" + (substring uuid 8 12) "-" + (substring uuid 12 16) "-" + (substring uuid 16 20) "-" + (substring uuid 20 32)))) + + + +(defun my-org-get-or-create-id () + "Get the ID property of the current Org heading, or create and set one if missing. +Returns the ID string." + (let ((id (org-entry-get nil "ID"))) + (unless id + (setq id (my-org-generate-uuid)) + (org-entry-put nil "ID" id) + (save-buffer)) ;; optional: save file after inserting ID + id)) + + +(defun send-org-todo-to-endpoint-on-state-change () + "Send the current Org-mode TODO item to an HTTP endpoint." + (interactive) + (when (org-at-heading-p) + (let ((state (org-get-todo-state))) + (when (member state '("STRT" "DONE")) + (let* ((heading (org-get-heading t t t t)) + (current-time (format-time-string "%Y-%m-%dT%H:%M:%SZ" (current-time) t)) ;; UTC ISO8601 + (tags (org-get-tags)) + (timestamps (org-extract-labeled-timestamps)) + (drawers (org-extract-drawers)) + (properties (cdr (assoc "PROPERTIES" drawers))) + (todo-id (my-org-get-or-create-id)) + (body (org-get-body-stripped)) + (notes (org-extract-notes)) + ;;(properties (org-entry-properties)) + (endpoint "http://localhost:8000/webhook/emacs/") + (data `(("title" . ,heading) + ("labels" . ,tags) + ("state" . ,state) + ("timestamps" . ,timestamps) + ("notes" . ,notes) + ("drawers" . ,drawers) + ("emacs_id" . ,todo-id) + ("updated_at" . ,current-time) + ("source" . "orgmode") + ("properties" . ,properties) + ("body" . ,body)))) + (request + endpoint + :type "POST" + :headers '(("Content-Type" . "application/json")) + :data (json-encode data) + :headers '(("Authorization" . "Token 27a4bde480a982e4e0bc74e9d74d052f071b1737") + ("Content-Type" . "application/json")) + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (message "Sent TODO: %s" data))) + :error (cl-function + (lambda (&rest args &key error-thrown &allow-other-keys) + (message "Error sending TODO: %S" error-thrown))))))))) + +(defun org-clock-on-state-change () + "Clock in when state is STRT, clock out otherwise." + (when (and (derived-mode-p 'org-mode) + (not (org-before-first-heading-p))) + (pcase org-state + ("STRT" + (unless org-clock-marker + (org-clock-in))) + ((or "DONE" "CANC" "WAIT" "HOLD" "TODO") + (when org-clock-marker + (org-clock-out)))))) + +(add-hook 'org-after-todo-state-change-hook #'org-clock-on-state-change) +(add-hook 'org-after-todo-state-change-hook #'send-org-todo-to-endpoint-on-state-change) + ;(setq org-clock-out-when-done t) diff --git a/emacs/.config/doom/custom.el b/emacs/.config/doom/custom.el index 114703b..a2a0d5c 100644 --- a/emacs/.config/doom/custom.el +++ b/emacs/.config/doom/custom.el @@ -4,7 +4,8 @@ ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. '(magit-todos-insert-after '(bottom) nil nil "Changed by setter of obsolete option `magit-todos-insert-at'") - '(package-selected-packages '(helix-theme nov w3m vulpea ef-themes)) + '(package-selected-packages + '(csv-mode direnv ef-themes helix-theme magit-todos nov vulpea w3m)) '(safe-local-variable-values '((pytest-global-name . "docker-compose run --rm test --")))) (custom-set-faces ;; custom-set-faces was added by Custom.