wasamasa/tree.el

## tree.el
(require 'pcase)
(require 'dash)

(defvar my-document
  "<!DOCTYPE html>
<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
  <head>
    <meta charset=\"utf-8\" />
    <link rel=\"self\" />
    <title>Foobar</title>
  </head>
  <body>
    <table>
      <tr class=\"even\">
        <td class=\"key\">Foo</td>
        <td class=\"value\">1</td>
      </tr>
      <tr class=\"odd\">
        <td class=\"key\">Bar</td>
        <td class=\"value\">2</td>
      </tr>
    </table>
  </body>
</html>")

(defvar my-tree
  (with-temp-buffer
    (insert my-document)
    (libxml-parse-html-region (point-min) (point-max))))

(defun my-tree-find (condition tree)
  (pcase tree
    (`(,tag ,attributes . ,children)
     (if (funcall condition tree)
         tree
       (cl-some (lambda (it) (my-tree-find condition it))
              children)))))

(defun my-tree-test ()
  (my-tree-find (lambda (subtree) (eq (car subtree) 'meta)) my-tree))

(my-tree-test)
;; returns '(meta ((charset . "utf-8")))

## tree.scm
(use srfi-1 matchable)

(define tree
  '(html ((xmlns . "http://www.w3.org/1999/xhtml")
          (xml:lang . "en"))
         (head ()
               (meta ((charset . "utf-8")))
               (link ((rel . "self")))
               (title () "Foobar"))
         (body ()
               (table ()
                      (tr ((class . "even"))
                          (td ((class . "key"))
                              "Foo")
                          (td ((class . "value"))
                              "1"))
                      (tr ((class . "odd"))
                          (td ((class . "key"))
                              "Bar")
                          (td ((class . "value"))
                              "2"))))))

(define (tree-find condition tree)
  (match tree
    ((tag attributes . children)
     (if (condition tree)
         tree
         (any (lambda (subtree) (tree-find condition subtree))
              children)))
    (else #f)))

(define (tree-test)
  (tree-find (lambda (subtree) (equal? (car subtree) 'meta)) tree))

(tree-test)
;; returns '(meta ((charset . "utf-8)))
	(require 'pcase)
	(require 'dash)

	(defvar my-document
	"<!DOCTYPE html>
	<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
	<head>
	<meta charset=\"utf-8\" />
	<link rel=\"self\" />
	<title>Foobar</title>
	</head>
	<body>
	<table>
	<tr class=\"even\">
	<td class=\"key\">Foo</td>
	<td class=\"value\">1</td>
	</tr>
	<tr class=\"odd\">
	<td class=\"key\">Bar</td>
	<td class=\"value\">2</td>
	</tr>
	</table>
	</body>
	</html>")

	(defvar my-tree
	(with-temp-buffer
	(insert my-document)
	(libxml-parse-html-region (point-min) (point-max))))

	(defun my-tree-find (condition tree)
	(pcase tree
	(`(,tag ,attributes . ,children)
	(if (funcall condition tree)
	tree
	(cl-some (lambda (it) (my-tree-find condition it))
	children)))))

	(defun my-tree-test ()
	(my-tree-find (lambda (subtree) (eq (car subtree) 'meta)) my-tree))

	(my-tree-test)
	;; returns '(meta ((charset . "utf-8")))
	(use srfi-1 matchable)

	(define tree
	'(html ((xmlns . "http://www.w3.org/1999/xhtml")
	(xml:lang . "en"))
	(head ()
	(meta ((charset . "utf-8")))
	(link ((rel . "self")))
	(title () "Foobar"))
	(body ()
	(table ()
	(tr ((class . "even"))
	(td ((class . "key"))
	"Foo")
	(td ((class . "value"))
	"1"))
	(tr ((class . "odd"))
	(td ((class . "key"))
	"Bar")
	(td ((class . "value"))
	"2"))))))

	(define (tree-find condition tree)
	(match tree
	((tag attributes . children)
	(if (condition tree)
	tree
	(any (lambda (subtree) (tree-find condition subtree))
	children)))
	(else #f)))

	(define (tree-test)
	(tree-find (lambda (subtree) (equal? (car subtree) 'meta)) tree))

	(tree-test)
	;; returns '(meta ((charset . "utf-8)))