Path: utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!cs.utexas.edu!uunet!mcsun!hp4nl!phigate!prle!prles2!prles3.prl.philips.nl!debruyne
From: debruyne@prles3.prl.philips.nl
Newsgroups: comp.lang.postscript
Subject: Exploring PostScript's dictionaries
Message-ID: <723@prles2.UUCP>
Date: 4 Oct 89 08:23:07 GMT
Sender: nobody@prles2.UUCP
Reply-To: debruyne@prles3.prl.philips.nl ()
Organization: Philips Research Laboratories, Eindhoven the Netherlands
Lines: 419

: This is a shar archive.  Extract with sh, not csh.
: This archive ends with exit, so do not worry about trailing junk.
if test -f 'psdicts'
then	rm 'psdicts'
fi
if test -d 'psdicts'
then	:
else	echo 'Making     psdicts/'
	mkdir 'psdicts'
fi
chmod 'u=rwx,g=rx,o=rx' 'psdicts'
echo 'Extracting psdicts/README'
sed 's/^X//' > psdicts/README << '+ END-OF-FILE psdicts/README'
XHi there,
X
XWhile I was playing with PostScript a few weeks ago, I found out
Xthat it is possible to list the names of the keywords in PostScript's
Xdictionaries.
X
XBecause we're going to swich from an Apple LaserWriter to an
XAgfa P3400PS Laser Printer, I thought it might be nice to have a way
Xto compare the internal dictionaries of these printers.
X
XThis resulted in a recursive PostScript program, systemdict.ps, that 
Xlists the total contents of the printer's dicts.
X
XThe output is as follows (in regular expression syntax):
X  level keyword type value
X  where:
X    level 	= (.   )*
X    keyword 	= <The human readable keyword>
X    type	= "(" ((typeId ( access | none )) | none) ")"
X    typeId	= (array|boolean|dict|file|fontId|integer|mark|name|
X		   null|operator|packedarray|real|save|string)
X    access	= (","(r|-)(w|-)(x|-))
X    value	= (( "=" <the keyword's value>) | none )
X    none	= ""		     
X
X  which means:
X    level gives the level of the dictionary:
X      "" 	   means the upper level
X      ".   "	   means one level below the upper level
X      ".   .   "   means two levels below the upper level
X    and so on
X
X    Each time a dictionary is encountered the program descends a level
X    and that dictionary is then listed.
X    An empty line indicates that the program is ascending one level.
X    For instance, a part of the systemdict might look like:
X	type (operator)			% upper level (systemdict)
X	userdict (dict,rw-)		% userdict is encountered
X	.   #copies (integer) = 1	% #copies is a keyword in userdict
X	.   $IdleTimeDict (dict,rw-)	% a new dict is encountered
X	.   .   ROMnames (array,r--)	% an entry in $IdleTimeDict
X					% empty line: ascending one level
X	.   LocalDict (dict,rw-)	% LocalDict is a keyword in userdict..
X	.   .   Dlen (integer) = 24	% .. which is again a dict
X					% empty line: ascending
X	.   start (packedarray,r-x)	% a keyword in userdict
X					% empty line: back to systemdict
X	usertime (operator)		% a keyword in systemdict
X	version (string,r--) = 38.0	%   ...
X
X
X    In the latter example the keywords are: 
X      type, userdict, #copies, $IdleTimeDict, ROMnames, LocalDict, Dlen, 
X      start, usertime and version.
X
X    The types are:
X      operator, dict, integer, array, packedarray and string.
X
X    The accesses are:
X      r = read
X      w = write
X      x = execute
X    so rw- means: read access, write access, not executable 
X
X    If the keyword's value is of the type integer, string, name, boolean
X    or real, then the value of the keyword is listed if the ascii 
X    representation doesn't exeed 19 characters. If it exeeds 19 characters 
X    then the representation is clipped, which is indicated by three dots.
X    For instance:
X	Notice (string,r--) = Helvetica is a ...
X
X    
XThe font dictionaries, located in the FontDictionary, contain a dictionary
Xcalled CharStrings. See the Red Book page 92 for a description of this
Xdictionary. The contents of these dictionaries is not listed (it would
Xproduce many many pages of identical information). Instead, three dots 
Xindicate that there is more...
XFor instance:
X	FontDirectory (dict,r--)
X	.   Courier (dict,r--)
X	.   .   CharStrings (dict,r--)
X	.   .   .   ...
X
X	.   .   Encoding (array,r--)
X	.   .   FID (fontId)
X	and so on
X
X
XEvery dictionary is first sorted in alphabetically ascending order by the 
Xprocedure qsort, written August 31, 1989  by Scott Hemphill, who posted 
Xhis routine to comp.lang.postscript a while ago as an addition to the 
XPostScript toolkit.
X
X
XLine 265 in the file systemdict.ps is:
X/DictName (systemdict) def
X
XThe string systemdict can be changed to anything else that results in a 
Xdictionary on the stack. 
XFor instance:
X	/DictName (userdict) def
Xor:
X	/DictName (systemdict /statusdict get) def
X
XIf you do so, be sure to modify line 74 (starting level information) as well.
X
X
XIf you have any comments or if you encounter any bugs, please let me know.
X
XJos de Bruijne
XPhilips Research Laboratories
XEindhoven, The Netherlands
XEmail: debruyne@prles3.prl.philips.nl
X
+ END-OF-FILE psdicts/README
chmod 'u=rw,g=r,o=r' 'psdicts/README'
echo 'SENT: -rw-r--r--  1 debruyne     3990 Oct  3 13:09 psdicts/README'
echo -n 'RCVD: '
/bin/ls -l psdicts/README
echo 'Extracting psdicts/systemdict.ps'
sed 's/^X//' > psdicts/systemdict.ps << '+ END-OF-FILE psdicts/systemdict.ps'
X%!
X
X/qsortdict 7 dict def
Xqsortdict begin
X   /q-compare 0 def		% user-supplied comparison procedure
X   /q-array 1 def		% current sub-array being sorted by qsortsub
X   /q-length 2 def		% length of q-array
X   /q-left 3 def		% left scan index
X   /q-right 4 def		% right scan index
X   /q-last 5 def		% partitioning element
X   /q-temp 6 def		% temporary array element
Xend
X
X/qsort
X{
X   qsortdict begin
X   /q-compare exch def
X   qsortsub
X   end
X}
Xbind def
X
X/qsortsub
X{
X   /q-array exch def
X   /q-length q-array length def
X   q-length 1 gt
X   {
X      /q-left 0 def
X      /q-right q-length 1 sub def
X      /q-last q-array q-right get def
X      {
X         {
X            q-array q-left get q-last q-compare
X            {/q-left q-left 1 add def}
X            {exit}
X            ifelse
X         }
X         loop
X         {
X            q-left q-right eq {exit} if
X            q-array q-right get q-last q-compare
X            {exit}
X            {/q-right q-right 1 sub def}
X            ifelse
X         }
X         loop
X         q-left q-right eq {exit} if
X         /q-temp q-array q-left get def
X         q-array q-left q-array q-right get put
X         q-array q-right q-temp put
X      }
X      loop
X      q-array q-length 1 sub q-array q-left get put
X      q-array q-left q-last put
X      q-array q-left 1 add q-length q-left sub 1 sub getinterval
X         q-array 0 q-left getinterval
X         qsortsub
X      qsortsub
X   }
X   if
X}
Xbind def
X
Xgsave
X
Xserverdict begin
Xstatusdict begin
X/Times-Roman findfont 20 scalefont setfont 
X72 730 moveto 
X/Str 80 string def 
XStr printername show
X/Times-Roman findfont 12 scalefont setfont
X(\'s dictionaries  \(starting level: systemdict\)) show
Xend end
X
X/LocalDict 27 dict def
XLocalDict begin
X  /X 			0 def
X  /Y 			1 def
X  /row 			2 def
X  /col 			3 def
X  /crlf 		4 def
X  /showln 		5 def
X  /s 			6 def
X  /ShowOperandType 	7 def
X  /Oper 		8 def
X  /NewStr 		9 def
X  /loopvar 		10 def
X  /rwxcheck 		11 def
X  /showarr 		12 def
X  /Keyword 		13 def
X  /Operand 		14 def
X  /OperandType 		15 def
X  /arr 			16 def
X  /Str 			17 def
X  /NewLine		18 def
X  /Spaces		19 def
X  /DictName		20 def
X  /OldDictName		21 def
X  /Dlen			22 def
X  /TmpStr		23 def
X  /shw			24 def
X  /ShowContents		25 def
X  /PageNo		26 def
Xend
X
XLocalDict begin
X
X/X 72 def /Y 700 def /row 1 def /col 1 def
X/crlf { /Y Y 10 sub def X Y moveto /row row 1 add def } def
X
X/shw { % <any> "shw" -  (NOTE: string shown is at most 19 chars long)
X  dup type (                    ) cvs (stringtype) ne 
X    { /TmpStr 128 string def TmpStr cvs cvlit /TmpStr exch def }
X    { cvlit /TmpStr exch def } 
X  ifelse
X  TmpStr length 19 gt 
X    { /NewStr 19 string def
X      0 1 14 {
X	/loopvar exch def
X	TmpStr loopvar get NewStr exch loopvar exch put 
X      } for
X      16 1 18 { 
X	NewStr exch 46 put
X      } for
X      /TmpStr NewStr def
X    } if
X    TmpStr show
X} def % shw
X
X/showln { % <any> "showln" -
X  X Y moveto shw crlf 
X} def
X/s { % <any> "s" -
X  X Y moveto shw 
X} def
X
X/NewLine { 
X  crlf
X  row 60 eq {
X    /row 1 def
X    /Y 700 def
X    /X X 170 add def
X    /col col 1 add def
X    col 3 gt {
X      gsave
X      291 70 moveto
X      /Times-Roman findfont 9 scalefont setfont
X      (\-  ) show PageNo (   ) cvs show (  \-) show
X      showpage 
X      grestore
X      /PageNo PageNo 1 add def
X      /col 1 def
X      /X 72 def
X    } if
X  } if
X} def % NewLine
X
X/ShowOperandType { % <OperandTypeString> "ShowOperandType" -
X  /Oper exch def
X  Oper (fonttype) eq { (fontId) show }
X  {
X    /NewStr Oper length 4 sub string def
X    0 1 Oper length 5 sub {
X      /loopvar exch def
X      Oper loopvar get NewStr exch loopvar exch put
X    } for
X    NewStr show
X  } ifelse
X} def % ShowOperandType
X
X/rwxcheck { % <array|dict|file|string> "rwxcheck" -
X  (,) show
X  dup rcheck {(r) show} {(-) show} ifelse
X  dup wcheck {(w) show} {(-) show} ifelse
X  xcheck {(x) show} {(-) show} ifelse
X} def % rwxcheck
X
X/ShowContents { % - "ShowContents" -
X  /Times-Italic findfont 8 scalefont setfont
X  OperandType (integertype) eq    OperandType (stringtype) eq or 
X  OperandType (booleantype) eq or OperandType (nametype) eq or    
X  OperandType (realtype) eq or
X  { mark
X    { DictName cvx exec Keyword get } stopped 
X    { ( = \(\?\)) show }
X    { ( = ) show shw } ifelse
X    cleartomark
X  } if
X} def % ShowContents
X
X/showarr { % - showarr -
X  gsave
X  arr {
X    /Times-Bold findfont 8 scalefont setfont
X    /Keyword exch def
X    Spaces s Keyword shw 
X    /Times-Roman findfont 8 scalefont setfont
X    (  \() show 
X    { DictName cvx exec Keyword get } stopped 
X    {( ) show /OperandType (undef) def}
X    {
X      type (                         ) cvs
X      /OperandType exch def
X      OperandType ShowOperandType 
X      DictName cvx exec Keyword get 
X      OperandType (arraytype)  eq { rwxcheck }
X      { OperandType (packedarraytype)   eq { rwxcheck }
X	{ OperandType (dicttype)   eq { rwxcheck }
X    	  { OperandType (filetype)   eq { rwxcheck }
X      	    { OperandType (stringtype) eq { rwxcheck }
X              { pop
X	      } ifelse
X	    } ifelse
X	  } ifelse
X	} ifelse
X      } ifelse
X    } ifelse
X    (\)) show 
X    OperandType (dicttype) ne ShowContents
X    NewLine
X    OperandType (dicttype) eq Keyword (systemdict) ne and 
X      { Keyword (CharStrings) eq 
X	{ /Times-Bold findfont 8 scalefont setfont
X	  Spaces s (.   ...) show NewLine NewLine 
X	}
X	{ DictName cvx exec Keyword get rcheck 
X	  { DictName dup /OldDictName exch def
X	    /Dlen DictName length def
X 	    /DictName Dlen 6 add Keyword length add string def
X	    DictName 0 OldDictName putinterval
X	    DictName Dlen 1 add (\/) putinterval
X	    DictName Dlen 2 add Keyword putinterval
X	    DictName Dlen Keyword length add 3 add (get) putinterval
X	    Spaces
X	    /Spaces Spaces length 4 add string def
X	    1 4 Spaces length 1 sub {
X	      Spaces exch 46 put
X	    } for
X	    arr
X	    mark
X	    {/arr 
X	      [DictName cvx exec {pop /Str 80 string def Str cvs} forall] 
X	    def} stopped {} {
X	      arr /lt load qsort
X	      showarr
X	    } ifelse
X	    cleartomark
X	    /arr exch def
X	    /Spaces exch def
X	    /DictName exch def
X	    NewLine
X	  } if
X	} ifelse
X      } if
X  } forall
X  grestore
X} def
X
X/Times-Roman findfont 8 scalefont setfont
X
X/PageNo 1 def
X/Spaces 1 string def
X/DictName (systemdict) def
X/arr [DictName cvx exec {pop /Str 80 string def Str cvs} forall] def
Xarr /lt load qsort
Xshowarr
X
Xrow 1 ne col 1 ne or 
X  { 291 70 moveto
X    /Times-Roman findfont 9 scalefont setfont
X    (\-  ) show PageNo (   ) cvs show (  \-) show
X    showpage 
X  } if
X
X
Xgrestore
Xend % LocalDict
+ END-OF-FILE psdicts/systemdict.ps
chmod 'u=rw,g=r,o=r' 'psdicts/systemdict.ps'
echo 'SENT: -rw-r--r--  1 debruyne     6482 Oct  3 08:44 psdicts/systemdict.ps'
echo -n 'RCVD: '
/bin/ls -l psdicts/systemdict.ps
exit 0