/usr/share/common-lisp/source/xmls/xmlrep-helpers.lisp is in cl-xmls 1.4.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;;;---------------------------------------------------------------------------
;;; File Description:
;;;
;;; Contains utility functions that are helpful in manipulating the
;;; list representation that XMLS uses as the source or destination
;;; of translation to or from XML.
;;;
;;; History/Bugs/Notes:
;;;
;;; [2004/09/15:Robert P. Goldman] Created.
;;;
;;;---------------------------------------------------------------------------
(in-package :xmls)
(defun make-xmlrep (tag &key attribs children)
`(,tag ,attribs ,@children))
(defun xmlrep-add-child! (xmlrep child)
(nconc xmlrep (list child)))
(defun xmlrep-tag (treenode)
(node-name treenode))
(defun xmlrep-tagmatch (tag treenode)
(string-equal tag (xmlrep-tag treenode)))
(defun xmlrep-attribs (treenode)
(node-attrs treenode))
(defun xmlrep-children (treenode)
(cddr treenode))
(defun xmlrep-find-child-tags (tag treenode)
"Find all the children of TREENODE with TAG."
(remove-if-not #'(lambda (child) (xmlrep-tagmatch tag child))
(xmlrep-children treenode)))
(defun xmlrep-find-child-tag (tag treenode
&optional (if-unfound :error))
"Find a single child of TREENODE with TAG. Returns an error
if there is more or less than one such child."
(let ((matches (xmlrep-find-child-tags tag treenode)))
(case (length matches)
(0 (if (eq if-unfound :error)
(error "Couldn't find child tag ~A in ~A"
tag treenode)
if-unfound))
(1 (first matches))
(otherwise (error "Child tag ~A multiply defined in ~A"
tag treenode)))))
(defun xmlrep-attrib-value (attrib treenode
&optional (if-undefined :error))
"Find the value of ATTRIB, a string, in TREENODE.
if there is no ATTRIB, will return the value of IF-UNDEFINED,
which defaults to :ERROR."
(let ((found-attrib (find attrib (xmlrep-attribs treenode)
:test #'string=
:key #'car)))
(cond (found-attrib
(second found-attrib))
((eq if-undefined :error)
(error "XML attribute ~S undefined in ~S"
attrib treenode))
(t
if-undefined))))
(defun xmlrep-boolean-attrib-value (attrib treenode
&optional (if-undefined :error))
"Find the value of ATTRIB, a string, in TREENODE.
The value should be either \"true\" or \"false\". The
function will return T or NIL, accordingly. If there is no ATTRIB,
will return the value of IF-UNDEFINED, which defaults to :ERROR."
(let ((val (xmlrep-attrib-value attrib treenode
if-undefined)))
(cond ((string-equal val "true")
t)
((string-equal val "false") nil)
(t (error "Not a boolean value, ~A for attribute ~A."
val attrib)))))
|