changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: more elisp

changeset 666: f15e0f021a64
parent 665: c60decbaae3d
child 667: bb8aa1eda12b
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 22 Sep 2024 22:13:44 -0400
files: emacs/lib/graph.el emacs/util.el
description: more elisp
     1.1--- a/emacs/lib/graph.el	Sun Sep 22 21:29:15 2024 -0400
     1.2+++ b/emacs/lib/graph.el	Sun Sep 22 22:13:44 2024 -0400
     1.3@@ -89,9 +89,9 @@
     1.4   "Populate the `org-graph' from `org-id-locations', filtering out any
     1.5 entries not under a member of `org-graph-locations'. When EDGES is
     1.6 non-nil visit each node and collect all edges found."
     1.7-  (interactive)
     1.8+  (interactive "P")
     1.9   (save-excursion
    1.10-    (let* ((node-ids (org-id-locations-load))
    1.11+    (let* ((node-ids (copy-hash-table (org-id-locations-load))) ;; don't overwrite `org-id-locations'
    1.12            (graph (make-org-graph :nodes node-ids)))
    1.13       (maphash
    1.14        (lambda (k v)
    1.15@@ -122,7 +122,7 @@
    1.16   "The Emacs-native org-graph. Should be assigned to an `org-graph' instance.")
    1.17 
    1.18 (cl-defstruct org-graph-node id name file point)
    1.19-(cl-defstruct org-graph-edge (type 'link) in properties timestamp out)
    1.20+(cl-defstruct org-graph-edge (type 'link) in properties timestamp point out)
    1.21 
    1.22 (defun org-graph--file-hash (file)
    1.23   "Compute the hash of FILE."
    1.24@@ -151,40 +151,66 @@
    1.25       (puthash (org-graph-node-id node) node (org-graph-nodes (if (eql t update) org-graph update))))
    1.26     node))
    1.27 
    1.28+;; TODO 2024-09-22: properties
    1.29 (defun org-graph-collect-edge ()
    1.30   "Collect the edge at point which should be a line created with `org-graph-edge--insert'."
    1.31   (org-with-point-at (beginning-of-line)
    1.32     (when (org-at-timestamp-p 'lax)
    1.33-      (let ((ts (match-string-no-properties 0))
    1.34+      (let ((ep (point))
    1.35+            (ts (match-string-no-properties 0))
    1.36             (end (match-end 0)))
    1.37         (goto-char (1+ end))
    1.38         ;; next 2 chars are the arrow
    1.39-        (let ((arrow (org-graph-edge-arrow* (buffer-substring-no-properties (point) (1+ (point))))))
    1.40+        (let ((arrow (org-graph-edge-arrow* (buffer-substring-no-properties (point) (+ 2 (point))))))
    1.41           (goto-char (+ (point) 4))
    1.42           (make-org-graph-edge :in (org-id-get)
    1.43                                :type arrow
    1.44+                               :point ep
    1.45                                :timestamp (org-parse-time-string ts t) 
    1.46                                :out (string-trim (org--link-at-point) "id:")))))))
    1.47 
    1.48+(defun org-graph-map-edges (function)
    1.49+  "Eval FUNCTION once for each edge in node at point with point at start of the edge."
    1.50+  (with-org-graph-edge-drawer (end)
    1.51+    (re-search-backward (rx bol ?: (literal (org-graph-edge-drawer)) ?: eol) nil t)
    1.52+    (goto-char (1+ (match-end 0)))
    1.53+    (cl-loop while (> (point-max) end (point))
    1.54+             collect (funcall function)
    1.55+             do (next-line))))
    1.56+
    1.57+(defun org-graph-reduce-edges (function)
    1.58+  "Same as `cl-reduce' where SEQ is the list of edges at point. FUNCTION
    1.59+takes two `org-graph-edge' objects as input."
    1.60+  (let ((edges (org-graph-map-edges 'org-graph-collect-edge)))
    1.61+    (cl-reduce function edges)))
    1.62+
    1.63 (defun org-graph-collect-edges-at-point (&optional update)
    1.64   "Collect the contents of the EDGES drawer from node at point. When UPDATE
    1.65 is non-nil insert or update the node into the org-graph object specified
    1.66 or when 't' use the currently active org-graph."
    1.67-  (with-org-graph-edge-drawer (end)
    1.68-    (re-search-backward (rx bol ?: (literal (org-graph-edge-drawer)) ?: eol) nil t)
    1.69-    (goto-char (1+ (match-end 0)))
    1.70-    (let ((edges
    1.71-           (cl-loop while (> (point-max) end (point))
    1.72-                    collect (org-graph-collect-edge)
    1.73-                    do (next-line))))
    1.74-      (when update
    1.75-        (mapc (lambda (e)
    1.76-                (puthash 
    1.77-                 (org-graph-edge-in e) 
    1.78-                 e 
    1.79-                 (org-graph-edges (if (eql t update) org-graph update))))
    1.80-              edges))
    1.81-      edges)))
    1.82+  (let ((edges (org-graph-map-edges 'org-graph-collect-edge)))
    1.83+    (when update
    1.84+      (mapc (lambda (e)
    1.85+              (puthash 
    1.86+               (org-graph-edge-in e) 
    1.87+               e 
    1.88+               (org-graph-edges (if (eql t update) org-graph update))))
    1.89+            edges))
    1.90+    edges))
    1.91+
    1.92+(defun org-graph-edge-equal (a b)
    1.93+  "Return non-nil if A and B are 'equal' org-graph-edge objects."
    1.94+  (equal (org-graph-edge-out a) (org-graph-edge-out b)))
    1.95+
    1.96+(defun org-graph-edge-remove-duplicates ()
    1.97+  "Remove duplicate edge entries from node at point."
    1.98+  (org-graph-reduce-edges 
    1.99+   (lambda (a b) 
   1.100+     (when (org-graph-edge-equal a b)
   1.101+       (let ((tsa (org-graph-edge-timestamp a))
   1.102+             (tsb (org-graph-edge-timestamp b)))
   1.103+         (goto-char (org-graph-edge-point (if (org-time> tsa tsb) b a)))
   1.104+         (delete-line))))))
   1.105 
   1.106 (defun org-graph-edges-at-point (&optional update)
   1.107   "Return a list of `org-graph-edge' instances associated with the node at
     2.1--- a/emacs/util.el	Sun Sep 22 21:29:15 2024 -0400
     2.2+++ b/emacs/util.el	Sun Sep 22 22:13:44 2024 -0400
     2.3@@ -159,6 +159,16 @@
     2.4          (dow (nth 6 datetime)))
     2.5     (time-subtract now (days-to-time dow))))
     2.6 
     2.7+;;; Hashtables
     2.8+(defun hash-table-alist (table)
     2.9+  "Returns an association list containing the keys and values of hash table
    2.10+TABLE."
    2.11+  (let ((alist nil))
    2.12+    (maphash (lambda (k v)
    2.13+               (push (cons k v) alist))
    2.14+             table)
    2.15+    (nreverse alist)))
    2.16+
    2.17 ;;; Server
    2.18 ;;;###autoload
    2.19 (defun kill-emacs-restart ()