Update of /project/cl-soap/cvsroot/cl-soap/src In directory common-lisp.net:/tmp/cvs-serv23895/src

Modified Files: lxml.lisp Log Message: added example sexpr-get, (setf sexpr-getf), sexpr-select and sexpr-remove

Date: Mon Oct 3 14:29:21 2005 Author: scaekenberghe

Index: cl-soap/src/lxml.lisp diff -u cl-soap/src/lxml.lisp:1.8 cl-soap/src/lxml.lisp:1.9 --- cl-soap/src/lxml.lisp:1.8 Fri Sep 30 21:56:00 2005 +++ cl-soap/src/lxml.lisp Mon Oct 3 14:29:21 2005 @@ -1,8 +1,8 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: lxml.lisp,v 1.8 2005/09/30 19:56:00 scaekenberghe Exp $ +;;;; $Id: lxml.lisp,v 1.9 2005/10/03 12:29:21 scaekenberghe Exp $ ;;;; -;;;; Some tools to manipulate lxml +;;;; Common utilities (mostly lxml) and some internal/experimental stuff ;;;; ;;;; Copyright (C) 2005 Sven Van Caekenberghe, Beta Nine BVBA. All Rights Reserved. ;;;; @@ -47,7 +47,7 @@ "Find all elements of a specific tag in a lxml XML DOM list" (remove-if-not #'(lambda (x) (eql (lxml-get-tag x) tag)) lxml))

-;;; internal +;;; internal shared/common code

(defun actual-name (qname) "For now we ignore prefixes ;-)" @@ -58,5 +58,54 @@

(defun find-item-named (item-name sequence) (find (actual-name item-name) sequence :test #'string-equal :key #'get-name)) + +;;; manipulating sexpr (structured/nested plists with string keys) + +(defun sexpr-getf (sexpr key &optional default) + "Find the value of key in sexpr (returning default if not found)" + (cond ((null sexpr) default) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (string-equal current-key key) + (second sexpr) + (sexpr-getf (rest (rest sexpr)) key default)) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun (setf sexpr-getf) (value sexpr key) + "Destructively modify the value of key in sexpr to value (add at tail if not found)" + (cond ((null sexpr) (error "Cannot destructively add to the empty list")) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (string-equal current-key key) + (setf (second sexpr) value) + (if (null (rest (rest sexpr))) + (setf (rest (rest sexpr)) (list key value)) + (setf (sexpr-getf (rest (rest sexpr)) key) value))) + (error "Illegal key in sexpr: ~s" current-key)) + sexpr)) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun sexpr-select (sexpr keys) + "Return a new sexpr with keys and their values retained" + (cond ((null sexpr) '()) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (member current-key keys :test #'string-equal) + `(,current-key ,(second sexpr) ,@(sexpr-select (rest (rest sexpr)) keys)) + (sexpr-select (rest (rest sexpr)) keys)) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr)))) + +(defun sexpr-remove (sexpr keys) + "Return a new sexpr with keys and their values not retained" + (cond ((null sexpr) '()) + ((consp sexpr) (let ((current-key (first sexpr))) + (if (stringp current-key) + (if (member current-key keys :test #'string-equal) + (sexpr-remove (rest (rest sexpr)) keys) + `(,current-key ,(second sexpr) ,@(sexpr-remove (rest (rest sexpr)) keys))) + (error "Illegal key in sexpr: ~s" current-key)))) + (t (error "Not an sexpr: ~s" sexpr))))

;;;; eof