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 ()