Getting selected PCDATA

[Brandon Ibach <bibach@xxxxxxxxxxxxxx>]

   Okay... I accidentally deleted the original post before I was ready
to respond to it, but this has to do with the question about selecting
a portion of the PCDATA from a <parent> element within the rule for a
<child> element.
   Attached are a very simple document (including DTD) and a DSSSL
stylesheet which uses the SGML backend's "formatting-instruction" FO
to spit out the general structure of each <parent>'s content, then a
single line for each <child> in that <parent>, listing the content of
the child, an "=", and the immediately preceding "term" from the
parent.  The "term", in this case, is the chunk of text leading up to
the <child>, starting at either the beginning of the <parent> or the
most recent comma.  Before being printed, it is trimmed of whitespace
at the beginning and end.
   Note that the function which finds the "term" (lastterm) actually
accepts an optional singleton node list, which defaults to the current
node.  So, you could actually get the "term" preceding *any* node.
It doesn't even have to be an element.
   I hope the code will stand on its own and be clear enough, even
though I didn't really document it.  Any questions, please ask. :)

-Brandon :)

<!doctype dtest [
<!element dtest  o o (parent)*>
<!element parent o o (#PCDATA|child)*>
<!element child  - o (#PCDATA)*>
]>
<parent>some text<child>some term</child>,
other text<child>other term</child>, last text</parent>

<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN">

<style-specification>

(declare-flow-object-class formatting-instruction
  "UNREGISTERED::James Clark//Flow Object Class::formatting-instruction")

(define cr (string #\U-000D #\U-000A))

(define showkids (lambda (#!optional (nl (children (current-node))))
  (let loop ((n nl) (s "") (d 0))
    (if (node-list-empty? n) s
      (let* ((cn (node-list-first n)) (c (node-property 'class-name cn)))
        (loop (node-list-rest n)
              (apply string-append
                     (if (equal? 'data-char c)
                         (list s (if (= d 0) "  Data: " "")
                               (string (node-property 'char cn)))
                         (list s (if (> d 0) cr "")
                               (if (equal? 'element c)
                                   "  Element: " "  Node: ")
                               (if (equal? 'element c)
                                   (gi cn) (symbol->string c))
                               cr)))
              (if (equal? 'data-char c) (+ d 1) 0)))))))

(define node-list-contains? (lambda (nl snl)
  (cond ((node-list-empty? nl) #f)
        ((node-list=? snl (node-list-first nl)) #t)
        (else (node-list-contains? (node-list-rest nl) snl)))))

(define lastterm (lambda (#!optional (el (current-node))
                                     (nl (children (parent (current-node)))))
  (let loop ((n nl) (s ""))
    (if (node-list-empty? n) ""
      (let* ((cn (node-list-first n)))
        (if (node-list-contains? el cn) s
            (loop (node-list-rest n)
                  (if (equal? 'data-char (node-property 'class-name cn))
                      (let ((ch (string (node-property 'char cn))))
                        (if (equal? "," ch) "" (string-append s ch)))
                      s))))))))

(define trim (lambda (s)
  (let ((l (string-length s)))
    (let loop ((i 0) (r "") (w ""))
      (if (>= i l) r
          (if (member (string-ref s i) '(#\space #\U-0009 #\U-000A #\U-000D))
              (loop (+ i 1) r (string-append w (substring s i (+ i 1))))
              (loop (+ i 1) (string-append r (if (< 0 (string-length r)) w "")
                                           (substring s i (+ i 1))) "")))))))

(element PARENT (sosofo-append
  (make formatting-instruction
        data: (string-append "Parent: " cr (showkids) cr))
  (process-node-list (select-elements (children (current-node)) "CHILD"))))

(element CHILD
  (make formatting-instruction
        data: (string-append "Child: " (data (current-node))
                             " = " (trim (lastterm)) cr)))

</style-specification>