فهرست منبع

[emacs] Add org scrobbling functions take one

Colin Powell 1 ماه پیش
والد
کامیت
1a45c6107d
2فایلهای تغییر یافته به همراه275 افزوده شده و 1 حذف شده
  1. 273 0
      emacs/.config/doom/config.el
  2. 2 1
      emacs/.config/doom/custom.el

+ 273 - 0
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)

+ 2 - 1
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.