1;; $Id: dbpi.dsl,v 1.2 2003/04/28 05:18:24 adicarlo Exp $ 2;; 3;; This file is part of the Modular DocBook Stylesheet distribution. 4;; See ../README or http://nwalsh.com/docbook/dsssl/ 5;; 6 7(define (pi-value component piname) 8 ;; Returns the value of the (?piname value) PI (if one exists) 9 ;; as a child of component, otherwise returns #f 10 ;; 11 (let loop ((nl (select-by-class (children component) 'pi))) 12 (if (node-list-empty? nl) 13 #f 14 (let ((pidata (node-property 'system-data (node-list-first nl)))) 15 (if (and (> (string-length pidata) (string-length piname)) 16 (equal? piname 17 (substring pidata 0 (string-length piname)))) 18 (substring pidata 19 (+ (string-length piname) 1) 20 (string-length pidata)) 21 (loop (node-list-rest nl))))))) 22 23(define (inherited-pi-value component piname) 24 (let loop ((value #f) (nd component)) 25 (if (or value (node-list-empty? nd)) 26 value 27 (loop (pi-value nd piname) (parent nd))))) 28 29(define (dbhtml-findvalue pi-field-list name) 30 ;; pi-field-list is '(pitarget name1 value1 name2 value2 ...) 31 (let loop ((slist (cdr pi-field-list))) 32 (if (or (null? slist) 33 (not (pair? slist))) 34 #f 35 (if (string=? (car slist) name) 36 (car (cdr slist)) 37 (loop (cdr (cdr slist))))))) 38 39(define (dbhtml-value component name) 40 ;; Returns the value of "name='value'" in the <?dbhtml ...> PI 41 (let loop ((nl (select-by-class (children component) 'pi))) 42 (if (node-list-empty? nl) 43 #f 44 (let* ((pidata (node-property 'system-data (node-list-first nl))) 45 (pilist (if (and (> (string-length pidata) 7) 46 (string=? (substring pidata 0 7) "dbhtml ")) 47 (parse-starttag-pi pidata) 48 '())) 49 (value (if (null? pilist) #f (dbhtml-findvalue pilist name)))) 50 (if value 51 value 52 (loop (node-list-rest nl))))))) 53 54(define (inherited-dbhtml-value component name) 55 (let loop ((value #f) (nd component)) 56 (if (or value (node-list-empty? nd)) 57 value 58 (loop (dbhtml-value nd name) (parent nd))))) 59 60;; EOF dbpi.dsl 61 62 63