branch: externals/taxy
commit 09724dd73010a3ef1e799f20c6fe6daf121eb153
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Add: taxy-take-keyed
---
README.org | 17 ++---------------
taxy.el | 19 +++++++++++++++++++
2 files changed, 21 insertions(+), 15 deletions(-)
diff --git a/README.org b/README.org
index e3784ab..b4b07c2 100644
--- a/README.org
+++ b/README.org
@@ -151,20 +151,7 @@ You may not always know in advance what taxonomy a set of
objects fits into, so
:taxys (list
(make-taxy
:name "Modes"
- :take (lambda (buffer taxy)
- (let* ((key (buffery-major-mode buffer))
- (key-taxy
- (or (cl-find-if (lambda (taxy-key)
- (equal key taxy-key))
- (taxy-taxys taxy)
- :key #'taxy-key)
- (car
- (push (make-taxy
- :name key :key key
- :predicate (lambda (buffer)
- (equal key
(buffery-major-mode buffer))))
- (taxy-taxys taxy))))))
- (push buffer (taxy-objects key-taxy))))))))
+ :take (apply-partially #'taxy-take-keyed
#'buffery-major-mode)))))
;; Note the use of `taxy-copy' to avoid mutating the original taxy
definition.
(taxy-simple
@@ -172,7 +159,7 @@ You may not always know in advance what taxonomy a set of
objects fits into, so
(taxy-copy buffery)))
#+END_SRC
-Which produces this taxonomy of buffers:
+The taxy's ~:take~ function is set to the ~taxy-take-keyed~ function,
partially applied with the ~buffery-major-mode~ function as its ~key-fn~
(~taxy-fill~ supplies the buffer and the taxy as arguments), and it produces
this taxonomy of buffers:
#+BEGIN_SRC elisp
("Buffers"
diff --git a/taxy.el b/taxy.el
index 621e0fd..7aafb88 100644
--- a/taxy.el
+++ b/taxy.el
@@ -95,6 +95,25 @@ useful form after classification."
collect (taxy-apply fn taxy)))
taxy)
+(cl-defun taxy-take-keyed (key-fn object taxy &key (key-name-fn #'identity))
+ "Take OBJECT into TAXY, adding new taxys dynamically.
+Places OBJECT into a taxy in TAXY for the value returned by
+KEY-FN called with OBJECT. The new taxy's name is that returned
+by KEY-NAME-FN called with OBJECT."
+ (let* ((key (funcall key-fn object))
+ (key-taxy
+ (or (cl-find-if (lambda (taxy-key)
+ (equal key taxy-key))
+ (taxy-taxys taxy)
+ :key #'taxy-key)
+ (car
+ (push (make-taxy
+ :name (funcall key-name-fn key) :key key
+ :predicate (lambda (object)
+ (equal key (funcall key-fn object))))
+ (taxy-taxys taxy))))))
+ (push object (taxy-objects key-taxy))))
+
;;;; Footer
(provide 'taxy)
