Move libxml2.scm to its own repo
Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
commit
5c2c317810
|
@ -0,0 +1,3 @@
|
||||||
|
[submodule "gumbo-libxml"]
|
||||||
|
path = gumbo-libxml
|
||||||
|
url = https://github.com/nostrademons/gumbo-libxml
|
|
@ -0,0 +1,16 @@
|
||||||
|
# guile-libxml2
|
||||||
|
`guile-libxml2` is a small binding library for Guile Scheme. I strongly recommend you do not use this in your own project, because it is nowhere near complete, and likely will never be. It only really exists for my front-ends.
|
||||||
|
|
||||||
|
# Building gumbo-libxml
|
||||||
|
1. `cd` into `gumbo-libxml`
|
||||||
|
2. Run the following
|
||||||
|
```bash
|
||||||
|
$ ./autogen.sh
|
||||||
|
$ ./configure
|
||||||
|
$ make
|
||||||
|
```
|
||||||
|
|
||||||
|
# Environment
|
||||||
|
`LIBXML2_LOCATION` - Path to `libxml2.so` (default `libxml2`, which checks `LD_LIBRARY_PATH`).
|
||||||
|
|
||||||
|
`GUMBO_LIBXML_LOCATION` - Path to `libgumbo_xml.so` (default `./gumbo-libxml/.libs/libgumbo_xml.so`, can be edited to `libgumbo_xml`, which does the same thing as `libxml2` in `LIBXML2_LOCATION`)
|
|
@ -0,0 +1,210 @@
|
||||||
|
;; Copyright (C) 2023 Skylar Widulski <cobra@vern.cc>
|
||||||
|
;;
|
||||||
|
;; This file is part of MeMe
|
||||||
|
;;
|
||||||
|
;; MeMe is free software: you can redistribute it and/or modify it under the
|
||||||
|
;; terms of the GNU Affero 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 Affero General Public License
|
||||||
|
;; for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU Affero General Public License
|
||||||
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (libxml2)
|
||||||
|
#:use-module (rnrs)
|
||||||
|
#:use-module (system foreign)
|
||||||
|
#:use-module (system foreign-library)
|
||||||
|
#:export (gumbo-libxml-parse
|
||||||
|
xml-free-doc
|
||||||
|
xml-node-list-get-string
|
||||||
|
xml-xpath-new-context
|
||||||
|
xml-xpath-eval-expression
|
||||||
|
xml-xpath-free-object
|
||||||
|
xml-child-element-count
|
||||||
|
xml-xpath-object
|
||||||
|
xml-node
|
||||||
|
xml-nodeset
|
||||||
|
next
|
||||||
|
child
|
||||||
|
child1
|
||||||
|
attrs
|
||||||
|
name
|
||||||
|
doc
|
||||||
|
text
|
||||||
|
nodeset
|
||||||
|
nodeset-nodes
|
||||||
|
nodeset-nodes-null?
|
||||||
|
xpath-null?
|
||||||
|
dump-xml
|
||||||
|
get-xpath
|
||||||
|
dump-xpath-xml
|
||||||
|
get-xpath-string
|
||||||
|
get-xpath-nodeset
|
||||||
|
get-xpath-node))
|
||||||
|
|
||||||
|
(define libxml2
|
||||||
|
(dynamic-link
|
||||||
|
(if (getenv "LIBXML2_LOCATION")
|
||||||
|
(getenv "LIBXML2_LOCATION")
|
||||||
|
"libxml2")))
|
||||||
|
|
||||||
|
(define gumbo-libxml
|
||||||
|
(dynamic-link
|
||||||
|
(if (getenv "GUMBO_LIBXML_LOCATION")
|
||||||
|
(getenv "GUMBO_LIBXML_LOCATION")
|
||||||
|
"./gumbo-libxml/.libs/libgumbo_xml.so")))
|
||||||
|
|
||||||
|
(define xml-xpath-object
|
||||||
|
(list int ; xmlXPathObjectType type
|
||||||
|
'* ; xmlNodeSetPtr nodesetval
|
||||||
|
int ; int boolval
|
||||||
|
double ; floatval
|
||||||
|
'* ; xmlChar *stringval
|
||||||
|
'* ; void *user
|
||||||
|
int ; int index
|
||||||
|
'* ; void *user2
|
||||||
|
int ; int index2
|
||||||
|
))
|
||||||
|
(define xml-nodeset
|
||||||
|
(list int
|
||||||
|
int
|
||||||
|
'*))
|
||||||
|
(define xml-node
|
||||||
|
(list '* ; void *_private
|
||||||
|
int ; xmlElementType type
|
||||||
|
'* ; char *name
|
||||||
|
'* ; _xmlNode *children
|
||||||
|
'* ; _xmlNode *last
|
||||||
|
'* ; _xmlNode *parent
|
||||||
|
'* ; _xmlNode *next
|
||||||
|
'* ; _xmlNode *prev
|
||||||
|
'* ; _xmlDoc *doc
|
||||||
|
'* ; _xmlNs *ns
|
||||||
|
'* ; xmlChar *content
|
||||||
|
'* ; _xmlDict *dict
|
||||||
|
'* ; void *psvi
|
||||||
|
'* ; _xmlAttr *properties
|
||||||
|
'*)); _xmlNs *nsDef
|
||||||
|
(define xml-buffer
|
||||||
|
(list '* ; xmlChar *content
|
||||||
|
unsigned-int ; unsigned int use
|
||||||
|
unsigned-int ; unsigned int size
|
||||||
|
int)); xmlBufferAllocationScheme alloc
|
||||||
|
|
||||||
|
(define gumbo-libxml-parse
|
||||||
|
(pointer->procedure '*
|
||||||
|
(dynamic-func "gumbo_libxml_parse" gumbo-libxml)
|
||||||
|
(list '*)))
|
||||||
|
(define xml-free-doc
|
||||||
|
(pointer->procedure void
|
||||||
|
(dynamic-func "xmlFreeDoc" libxml2)
|
||||||
|
(list '*)))
|
||||||
|
(define xml-node-list-get-string
|
||||||
|
(pointer->procedure '*
|
||||||
|
(dynamic-func "xmlNodeListGetString" libxml2)
|
||||||
|
(list '* '* int)))
|
||||||
|
(define xml-buffer-create
|
||||||
|
(pointer->procedure '*
|
||||||
|
(dynamic-func "xmlBufferCreate" libxml2)
|
||||||
|
(list)))
|
||||||
|
(define xml-buffer-free
|
||||||
|
(pointer->procedure void
|
||||||
|
(dynamic-func "xmlBufferFree" libxml2)
|
||||||
|
(list '*)))
|
||||||
|
(define xml-node-dump
|
||||||
|
(pointer->procedure void
|
||||||
|
(dynamic-func "xmlNodeDump" libxml2)
|
||||||
|
(list '* '* '* int int)))
|
||||||
|
|
||||||
|
(define xml-xpath-new-context
|
||||||
|
(pointer->procedure '*
|
||||||
|
(dynamic-func "xmlXPathNewContext" libxml2)
|
||||||
|
(list '*)))
|
||||||
|
(define xml-xpath-eval-expression
|
||||||
|
(pointer->procedure '*
|
||||||
|
(dynamic-func "xmlXPathEvalExpression" libxml2)
|
||||||
|
(list '* '*)))
|
||||||
|
(define xml-xpath-free-context
|
||||||
|
(pointer->procedure void
|
||||||
|
(dynamic-func "xmlXPathFreeContext" libxml2)
|
||||||
|
(list '*)))
|
||||||
|
(define xml-child-element-count
|
||||||
|
(pointer->procedure unsigned-long
|
||||||
|
(dynamic-func "xmlChildElementCount" libxml2)
|
||||||
|
(list '* int)))
|
||||||
|
|
||||||
|
(define (next ptr times)
|
||||||
|
(if (= times 0)
|
||||||
|
(list-ref (parse-c-struct ptr xml-node) 6)
|
||||||
|
(next (next ptr 0) (- times 1))))
|
||||||
|
(define (child ptr)
|
||||||
|
(cadddr (parse-c-struct ptr xml-node)))
|
||||||
|
(define (child1 ptr times)
|
||||||
|
(if (= times 0)
|
||||||
|
(next (child ptr) 0)
|
||||||
|
(child1 (next (child ptr) 0) (- times 1))))
|
||||||
|
(define (attrs ptr)
|
||||||
|
(list-ref (parse-c-struct ptr xml-node) 11))
|
||||||
|
(define (name ptr)
|
||||||
|
(pointer->string (caddr (parse-c-struct ptr xml-node))))
|
||||||
|
(define (doc ptr)
|
||||||
|
(list-ref (parse-c-struct ptr xml-node) 8))
|
||||||
|
(define (text ptr)
|
||||||
|
(cond
|
||||||
|
((not (null-pointer? (xml-node-list-get-string (doc ptr) (child ptr) 1)))
|
||||||
|
(pointer->string (xml-node-list-get-string (doc ptr) (child ptr) 1)))
|
||||||
|
(else
|
||||||
|
(pointer->string (xml-node-list-get-string (doc ptr)
|
||||||
|
(child (child ptr)) 1)))))
|
||||||
|
|
||||||
|
(define (nodeset ptr)
|
||||||
|
(cadr (parse-c-struct ptr xml-xpath-object)))
|
||||||
|
(define (nodeset-nodes ptr)
|
||||||
|
(dereference-pointer (caddr (parse-c-struct ptr xml-nodeset))))
|
||||||
|
(define (nodeset-nodes-null? ptr)
|
||||||
|
(null-pointer? (caddr (parse-c-struct ptr xml-nodeset))))
|
||||||
|
(define (xpath-null? xpath d)
|
||||||
|
(nodeset-nodes-null? (get-xpath-nodeset xpath d)))
|
||||||
|
|
||||||
|
(define (dump-xml node)
|
||||||
|
(define buffer (xml-buffer-create))
|
||||||
|
(define size (xml-node-dump buffer (doc node) node 0 1))
|
||||||
|
(define content (pointer->string (car (parse-c-struct buffer xml-buffer))))
|
||||||
|
(xml-buffer-free buffer)
|
||||||
|
content)
|
||||||
|
|
||||||
|
(define (get-xpath xpath d)
|
||||||
|
(define context (xml-xpath-new-context d))
|
||||||
|
(define result (xml-xpath-eval-expression
|
||||||
|
(string->pointer xpath)
|
||||||
|
context))
|
||||||
|
(xml-xpath-free-context context)
|
||||||
|
result)
|
||||||
|
|
||||||
|
(define (dump-xpath-xml xpath d)
|
||||||
|
(define buffer (xml-buffer-create))
|
||||||
|
(define nodes (get-xpath-node xpath d))
|
||||||
|
(define size (xml-node-dump buffer (doc nodes) nodes 0 1))
|
||||||
|
(define content (pointer->string (car (parse-c-struct buffer xml-buffer))))
|
||||||
|
(xml-buffer-free buffer)
|
||||||
|
content)
|
||||||
|
|
||||||
|
(define (get-xpath-string xpath d attr?)
|
||||||
|
(pointer->string
|
||||||
|
(xml-node-list-get-string
|
||||||
|
(doc (get-xpath-node xpath d))
|
||||||
|
(if attr?
|
||||||
|
(child (get-xpath-node xpath d))
|
||||||
|
(get-xpath-node xpath d))
|
||||||
|
1)))
|
||||||
|
|
||||||
|
(define (get-xpath-nodeset xpath d)
|
||||||
|
(nodeset (get-xpath xpath d)))
|
||||||
|
|
||||||
|
(define (get-xpath-node xpath d)
|
||||||
|
(nodeset-nodes (get-xpath-nodeset xpath d)))
|
Loading…
Reference in New Issue