getting the attributes of a tag to qualify rewrites

[email protected] Tue, 13 Jul 2004 21:59:07 -0700 (PDT)
Newsgroups gmane.lisp.scheme.ssax-sxml
Message-ID <[email protected]> 
Hello!

> (define (xform-person-name name-string)
>     `(span *preorder* . ,(lambda (tag . content)
>                            '(span ,name-string))))
>
> But I need to make it more precise. I only want to rewrite span tags if 
> the span tag has an attribute named "hsi" with value "overwrite_name", eg:

There are several ways of accomplishing that, for example, the
following. The code below uses Gauche (which has a well-integrated
SXML/SSAX support). We use sxpath to check the existence of a particular
attribute with a particular value. If the condition holds, we 
re-write the element before transforming it into HTML. Otherwise, we
transform it into HTML as it is.

(use sxml.ssax)
(use sxml.sxpath)
(use util.list)
(use srfi-13)
(use sxml.tree-trans)
(use sxml.to-html)
(use sxml.adaptor)

(define nl (string #\newline))

(define doc
  (string-concatenate/shared
    (intersperse nl
      '("<body>"
	 "Hello there,"
	 "<span hsi='overwrite_name'>blah blah</span>"
	 "did you know that today was"
	 "<span hsi='todays_date'>blah blah blah</span>"
	 "</body>")
      )))

(define doc-sxml
  (call-with-input-string doc
    (lambda (port)
      (ssax:xml->sxml port '()))))

(display doc-sxml)
(newline)

(define string->goodHTML 
  (make-char-quotator 
    '((#\< . "&lt;") (#\> . "&gt;") (#\& . "&amp;") (#\" . "&quot;"))))

(define (entag tag elems)
  (if (and (pair? elems) (pair? (car elems)) (eq? '@ (caar elems)))
    (list #\newline #\< tag (cdar elems) #\>
      (and (pair? (cdr elems))
	(list (cdr elems) "</" tag #\>)))
    (list #\newline #\< tag #\> (and (pair? elems) (list elems "</" tag #\>))
      )))
 
(define (enattr attr-key value)
  (if (null? value) (list #\space attr-key)
    (list #\space attr-key "=\"" value #\")))


(define universal-conversion-rules
  `((@
      ((*default*       ; local override for attributes
        . ,(lambda (attr-key . value) (enattr attr-key value))))
      . ,(lambda (trigger . value) (cons '@ value)))
    (*default* . ,(lambda (tag . elems) (entag tag elems)))
    (*text* . ,(lambda (trigger str) 
		 (if (string? str) (string->goodHTML str) str)))
    (n_		; a non-breaking space
     . ,(lambda (tag . elems)
	  (cons "&nbsp;" elems)))))

(define (replace-text-with-ss new-text)
  `((@ 
      ((*text* . ,(lambda (tag str) str)))
      . ,(lambda x x))
    (*text* . ,(lambda (tag str) new-text))
    (*default* . ,(lambda x x))))

(display "Output") (newline)

(SRV:send-reply
  (pre-post-order doc-sxml
    `(
       (*TOP* . ,(lambda (x elem) elem))
       (span
	 *preorder*
	 . ,(lambda elem
	      (if 
		(null? ((sxpath '(@ hsi (equal? "overwrite_name"))) elem))
		(pre-post-order elem universal-conversion-rules)
		; do the replacement
		(pre-post-order
		  (pre-post-order elem (replace-text-with-ss "yada yada"))
		  universal-conversion-rules)
		)))
       ,@universal-conversion-rules)))

(newline)

>>> Output

<body>
Hello there,

<span hsi="overwrite_name">yada yada</span>
did you know that today was

<span hsi="todays_date">blah blah blah</span></body>



-------------------------------------------------------
This SF.Net email sponsored by Black Hat Briefings & Training.
Attend Black Hat Briefings & Training, Las Vegas July 24-29 - 
digital self defense, top technical experts, no vendor pitches, 
unmatched networking opportunities. Visit www.blackhat.com