%---------------------------------------------------------------------------
%  Time-stamp: "2005-08-19 00:24:30 ADT"         -*-coding:latin-1;-*-     µ
%
% desc{  PostScript function library for dumping PostScript data structures as XML.  }
%  2005  Sean M. Burke  «sburke@cpan.org»
%
% Examples:  
%
%
% From the shell:
%
%    echo '(ps2xml.ps)run devicenames XML_dump' | gs -q - | less
%
%    echo '(ps2xml.ps)run (gsdevs.xml) devicenames XML_dump_to_file' | gs -q -
%
%
% To exercise the the dumper a bit, try these from the "GS>" prompt:
%
%[ true /crunk false [[(oboy)] (stuff\n) (thingsé) (Pie) -456 ]  -3543.45] XML_dump_doc
%[ (Pies\n) ] XML_dump_doc
%[ true (crunk) false [[(oboy)] (stuff\n) (thingsé) (Pie) -456 ] -3543.45] XML_dump_doc
%
%() [123] XML_dump_to_file ==
%
%() [ true cvx (crunk) executeonly false [[(oh boy!)] (stuff\n) (\000\176\177\200\201\202\203<th>!&"\(\)\n\tingsé) (Pie) -456 ]]
%XML_dump_to_file ==
%
% [ true cvx (crunk) executeonly false [[(oh boy!)] (stuff\n) (\000\176\177\200\201\202\203<th>!&"\(\)\n\tingsé) (Pie) -456 ]] XML_dump_doc
%
%--------------------------------------------------------------------------

/!! {(ps2xml.ps) run } def
/P {XML_out_fh exch writestring} def

/i2s    { 40 string cvs } bind def
/name2s { dup length string cvs } bind def
/i2hex  { 16 20 string cvrs } bind def
/i2chr  { 1 string dup 0 4 -1 roll put } bind def

/@ {  %%  string1 string2 @  =>  string   ("@" because it ATpends strings)
  2 copy length exch length add string dup 4 2 roll 2 index 0 3 index
  putinterval exch length exch putinterval
} bind def

/filenamecounter 0 def
/newfilename {
  (psdata_)
  realtime dup 0 lt { 16#80000000 sub } if i2hex
  @
  (_)  @
  usertime i2hex  @
  (_)  @
  filenamecounter 1 add dup /filenamecounter exch def i2hex @
  (.xml) @
} def



% ---------------------------------------------------------------------------
/EscForm 256 array def
16#00 1 16#ff { EscForm exch dup  (&#) exch i2s @ (;) @  put } for

/to_e0xx { EscForm exch dup  (&#x) exch  16#e000 add  i2hex @ (;) @  put } def
/literally { { EscForm exch dup i2chr put } } def


% Now Move fishy stuff into U+E000 - U+E00FF (e.g., U+E07f-U+E09f)
%  From XML 1.1 spec: "[#x1-#x8] | [#xB-#xC] | [#xE-#x1F]
%   | [#x7F-#x84] | [#x86-#x9F]"

16#00 1 16#08 { to_e0xx } for
        16#0b   to_e0xx
        16#0c   to_e0xx
16#0e 1 16#1f { to_e0xx } for
16#7f 1 16#9f { to_e0xx } for

% Now things that don't need escaping:
(!#$%=)       literally forall
16#28 1 16#3b literally for
16#3f 1 16#7e literally for

% Since we declare latin-1 output encoding, we can leave these as literals too:
16#a1 1 16#ff literally for

% ---------------------------------------------------------------------------

/printEsc { { EscForm exch get P } forall } def

/IndentLevel 0 def
/++ { /IndentLevel  IndentLevel 1 add  def } def
/-- { /IndentLevel  IndentLevel 1 sub  def } def
/I  {  IndentLevel {(  )P} repeat } def

/How 20 dict def
 
How /stringtype  {I(<String )P R W X (value=")P        printEsc (" />\n)P } put
How /nametype    {I(<Name )P       X (value=")P name2s printEsc (" />\n)P } put
How /integertype {I(<Integer )P    X (value=")P  i2s P          (" />\n)P } put
How /realtype    {I(<Real )P       X (value=")P  i2s P          (" />\n)P } put

How /marktype    {I(<Mark )P X (/>\n)P pop                    } put
How /nulltype    {I(<Null )P X (/>\n)P pop                    } put

How /booleantype {dup I{(<True )} {(<False )} ifelse P X pop (/>\n) P } put
How /operatortype  {I(<Operator )P X (stringform=")P
 100 string cvs printEsc (" />\n)P } put

How /arraytype       {I(<Array )P R W X (>\n)P 
  ++ {XML_dump} forall -- I (</Array>\n)P } put
How /packedarraytype {I(<Array )P R W X ( packed='yes'>\n)P
  ++ {XML_dump} forall -- I (</Array>\n)P } put
  
How /dicttype {
  I(<Dictionary )P W X   (maxlength=")P   dup maxlength i2s P   (">\n)P
  ++
  {
    exch
    I(<DictionaryEntry>\n)P  ++ I(<DictionaryKey>\n)P    ++ XML_dump --  % key
    I(</DictionaryKey>\n)P      I(<DictionaryValue>\n)P  ++ XML_dump --  % value
    I(</DictionaryValue>\n)P -- I(</DictionaryEntry>\n)P
  } forall
  --
  I(</Dictionary>\n)P
} put

/R { dup  rcheck not {(executeonly="1" ) P pop (-)} if } def
/W { dup  wcheck not {(readonly="1" )    P        } if } def
/X { dup  xcheck     {(executable="1" )  P        } if } def

%---------------------------------------------------------------------------

/XML_dump {
  dup   type How exch known {
    dup type How exch get exec
  } {
    type I(<NotDumpable type=")P name2s P (" />\n)P
  } ifelse
} def

/XML_dump_doc {
  (<?xml version="1.0" encoding="iso-8859-1"?>\n) P
  (<PostScriptData xmlns="http://interglacial.com/~sburke/pub/ps2xml/">\n) P
  %(<!-- realtime: )P  realtime i2s P  ( -->\n)P
  XML_dump
  (</PostScriptData>\n) P
} def

/XML_out_fh (%stdout) (w) file def

/XML_dump_to_file {
  % filename obj XML_dump_to_file   =>   realfilename
  %
  % If filename is (), output is to a uniquely named file, which you
  % get as the return value.
    
  exch
  dup length 0 eq { pop newfilename } if
  dup /XML_out_filename exch def
  (w) file
  /XML_out_fh exch def
  XML_dump_doc
  XML_out_fh closefile
  /XML_out_fh (%stdout) (w) file def
  XML_out_filename
  /XML_out_filename ("-") def
} def

%End