Move libxml2.scm to its own repo
Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
commit
5c2c317810
GPG Key ID:
4FD8F812083FF6F9
|
|
@ -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