occ/occ-tree.el at main · org-context-clock/occ · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
;;; occ-tree.el --- occ-api               -*- lexical-binding: t; -*-
;; Copyright (C) 2016  sharad

;; Author: sharad <sh4r4d _at_ _G-mail_>
;; Keywords: convenience

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:


(provide 'occ-tree)


(eval-when-compile
  (require 'occ-macros))


;; tree api
(defun tree-mapcar-nodes (subtreefn fn tree args)
  "Tree mapcar return result for FN for all TREE nodes with ARGS,
function SUBTREEFN require to find nonleaf node"
  (list
   (funcall fn tree args)
   :subtree
   (mapcar
    #'(lambda (e)
        (tree-mapcar-nodes subtreefn fn e args))
    (funcall subtreefn tree))))

(defun tree-mapc-nodes (subtreefn fn tree args)
  "Tree mapc run FN for all TREE nodes with ARGS, function
SUBTREEFN require to find nonleaf node"
  (funcall fn tree args)
  (mapc
   #'(lambda (e)
       (tree-mapc-nodes subtreefn fn e args))
   (funcall subtreefn tree)))

(defun tree-remove-if-not-nodes (subtreefn predicate tree args)
  "Tree remove if return TREE with all node and its subtree removed
if node return nil for PREDICATE, function SUBTREEFN require to
find nonleaf node"
  (if (funcall subtreefn tree)
      (let ((rootele
             (if (funcall predicate tree args) tree))
            (subtree
             (remove
              nil
              (mapcar
               #'(lambda (e)
                   (tree-remove-if-not-nodes subtreefn predicate e args))
               (funcall subtreefn tree)))))
        (if (or rootele subtree)
            (plist-put tree :subtree subtree)))
    (if (funcall predicate tree args) tree)))

;; (occ-testing
;;   (setq testxx-remove
;;         (tree-remove-if-not-nodes
;;            #'(lambda (e) (eq (plist-get e :pre-blank) 4)
;;                testxx)))

;;   (setq testxxmapcar
;;         (tree-mapcar-nodes #'(lambda (tx) (plist-get tx :subtree))
;;                            #'(lambda (tx) (plist-get tx :title))
;;                            ;; testxx
;;                            (cl-first (plist-get testxx :subtree))))

;;   (setq testxxmapc
;;         (tree-mapc-nodes #'(lambda (tx) (plist-get tx :subtree))
;;                          #'(lambda (tx) (plist-get tx :title))
;;                          ;; testxx
;;                          (cl-first (plist-get testxx :subtree)))))

;;; occ-tree.el ends here