[docbook-checkins] CVS: dsssl/common dbcommon.dsl,1.2,1.3

[Norman W. <nw...@us...>]

Update of /cvsroot/docbook/dsssl/common
In directory usw-pr-cvs1:/tmp/cvs-serv27642/common

Modified Files:
	dbcommon.dsl 
Log Message:
Fix XML/SGML discrepancy wrt normalization of notation names; move some common stuff into dbcommon

Index: dbcommon.dsl
===================================================================
RCS file: /cvsroot/docbook/dsssl/common/dbcommon.dsl,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** dbcommon.dsl	2001/06/20 12:50:47	1.2
--- dbcommon.dsl	2001/08/30 12:07:15	1.3
***************
*** 1766,1768 ****
--- 1766,1839 ----
  	(normalize "bookbiblio")))
  
+ ;; === db31 common ======================================================
+ 
+ (define (data-filename dataobj)
+   (let* ((entityref (attribute-string (normalize "entityref") dataobj))
+ 	 (fileref   (attribute-string (normalize "fileref") dataobj))
+ 	 (filename  (if fileref
+ 			fileref
+ 			(system-id-filename entityref)))
+ 	 (ext       (file-extension filename)))
+     (if (or (not filename)
+ 	    (not %graphic-default-extension%)
+ 	    (member ext %graphic-extensions%))
+ 	filename
+ 	(string-append filename "." %graphic-default-extension%))))
+ 
+ (define (normalized-member string string-list)
+   (let loop ((sl string-list))
+     (if (null? sl)
+ 	#f
+ 	(if (string=? (normalize string) (normalize (car sl)))
+ 	    #t
+ 	    (loop (cdr sl))))))
+ 
+ 
+ (define (find-displayable-object objlist notlist extlist)
+   (let loop ((nl objlist))
+     (if (node-list-empty? nl)
+ 	(empty-node-list)
+ 	(let* ((objdata  (node-list-filter-by-gi
+ 			  (children (node-list-first nl))
+ 			  (list (normalize "videodata")
+ 				(normalize "audiodata")
+ 				(normalize "imagedata"))))
+ 	       (filename  (data-filename objdata))
+ 	       (extension (file-extension filename))
+ 	       (notation  (attribute-string (normalize "format") objdata)))
+ 	  (if (or (normalized-member notation notlist)
+ 		  (normalized-member extension extlist))
+ 	      (node-list-first nl)
+ 	      (loop (node-list-rest nl)))))))
+ 
+ (define (select-displayable-object objlist)
+   (let ((pref (find-displayable-object objlist
+ 				       preferred-mediaobject-notations
+ 				       preferred-mediaobject-extensions))
+ 	(ok   (find-displayable-object objlist
+ 				       acceptable-mediaobject-notations
+ 				       acceptable-mediaobject-extensions)))
+     (if (node-list-empty? pref)
+ 	ok
+ 	pref)))
+ 
+ (define ($mediaobject$)
+   (let* ((objects (node-list-filter-by-gi
+ 		   (children (current-node))
+ 		   (list (normalize "videoobject")
+ 			 (normalize "imageobject")
+ 			 (normalize "audioobject"))))
+ 	 (dobject (select-displayable-object objects))
+ 	 (textobj (select-elements (children (current-node))
+ 				   (normalize "textobject")))
+ 	 (caption (select-elements (children (current-node))
+ 				   (normalize "caption"))))
+     (make sequence
+       (if (node-list-empty? dobject)
+ 	  (if (node-list-empty? textobj)
+ 	      (empty-sosofo)
+ 	      (process-node-list (node-list-first textobj)))
+ 	  (process-node-list dobject))
+       (process-node-list caption))))
+ 
  ;; ======================================================================