Re: OpenJade News - July 8 1999

Subject: Re: OpenJade News - July 8 1999
From: Boris Goldowsky <boris@xxxxxxxxxxxxxxxxxxxx>
Date: Wed, 21 Jul 1999 11:28:28 -0400 (EDT)
>>>>> Joerg Wittenberger writes:
JW> Maybe I can prepare a
JW> scrambled version which has the same structure.  Did any1 write a
JW> tool, which keepts the tagging and scrables the text?

This was one of the early projects that sold me on DSSSL -- I love
this little program.  Its Output is guaranteed unreadable :-).

You'll need to plug in your own definition of "empties" (a list of the
empty elements in your DTD) -- or maybe someone wants to suggest a way
to get the information of whether an element is empty or not out of
the SGML property set?

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

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

(define empties '("COLSPEC" "SPANSPEC" "LINEB" "GRAPHIC" "ENTITY" "ANCHOR" "ICON" "PROMO"))

(default
  (if (member (gi) empties)
      (make empty-element gi: (gi) attributes: (copy-attributes))
      (make element       gi: (gi) attributes: (copy-attributes)
	    (process-text))))

(define (process-text #!optional (snl (current-node)))
   (let p-t-loop ((this-node (node-list-first (children snl)))
                  (other-nodes (node-list-rest (children snl))))
        (if (node-list-empty? this-node)
            (empty-sosofo)
            (sosofo-append
	     (case (node-property 'class-name this-node)
	       ;; handle special characters
	       ((data-char) (case (node-property 'char this-node)
			      ((#\space) (make character char: #\space))
			      (else (make character char: #\x))))
	       ((sdata) (literal "y"))
	       (else (process-node-list this-node)))
	     (p-t-loop (node-list-first other-nodes)
		       (node-list-rest other-nodes))))))

(define (copy-attributes #!optional (nd (current-node)))
  (let loop ((atts (named-node-list-names (attributes nd))))
    (if (null? atts)
        '()
        (let* ((name (car atts))
               (value (attribute-string name nd)))
          (if value
              (cons (list name value)
                    (loop (cdr atts)))
              (loop (cdr atts)))))))

Bng
--
Boris Goldowsky            Engineering & Development Manager
Information Please, LLC    boris@xxxxxxxxxxxxxxxxxxxx
www.infoplease.com         617 832-0324



 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist


Current Thread