sys/lib/ghostscript/uninfo.ps

   1 %!
   2 % Copyright (C) 1997 Aladdin Enterprises.  All rights reserved
   3 %
   4 % This software is provided AS-IS with no warranty, either express or
   5 % implied.
   6 %
   7 % This software is distributed under license and may not be copied,
   8 % modified or distributed except as expressly authorized under the terms
   9 % of the license contained in the file LICENSE in this distribution.
  10 %
  11 % For more information about licensing, please refer to
  12 % http://www.ghostscript.com/licensing/. For information on
  13 % commercial licensing, go to http://www.artifex.com/licensing/ or
  14 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  15 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  16
  17 % $Id: uninfo.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
  18 % uninfo.ps: Utilities for "printing" PostScript items, especially dictionaries
  19 % Usage:
  20 % (prefix-string) dict unprint
  21
  22 % Maximum Print-Width
  23 /HSpwidth 80 def
  24
  25 % any  HScvs string
  26 /HScvs {
  27 % Number-Syntax
  28   dup type % stack: any /anytype
  29   dup /integertype eq 1 index /realtype eq or { pop
  30     16 string cvs
  31   }{
  32 % Logical-Type
  33     dup /booleantype eq { pop
  34       5 string cvs
  35     }{
  36 % Identifiers
  37       dup /nametype eq { pop
  38         dup length 1 add string
  39         dup 0 (/) putinterval
  40         exch 1 index 1 1 index length 1 sub getinterval cvs pop
  41       }{
  42 % Strings
  43         dup /stringtype eq { pop
  44 % ------- Compute Length
  45           2 1 index { % stack: str len item
  46             dup 32 lt 1 index 126 gt or { % need 4
  47               pop 4 add
  48             }{
  49               dup 40 eq 1 index 41 eq or 1 index 92 eq or {
  50                 pop 2 add
  51               }{
  52                 pop 1 add
  53               } ifelse
  54             } ifelse
  55           } forall
  56 % ------- Allocate & Fill String
  57           string dup 0 (\() putinterval 1
  58           3 -1 roll { % outstr pos item
  59             dup 32 lt 1 index 126 gt or {
  60               dup 7 le {
  61                 2 index 2 index (\\00) putinterval
  62                 8 3 index 3 index 3 add 1 getinterval cvrs
  63               }{
  64                 dup 63 le {
  65                   2 index 2 index (\\0) putinterval
  66                   8 3 index 3 index 2 add 2 getinterval cvrs
  67                 }{
  68                   2 index 2 index (\\) putinterval
  69                   8 3 index 3 index 1 add 3 getinterval cvrs
  70                 } ifelse
  71               } ifelse
  72               pop 4 add
  73             }{
  74               dup 40 eq 1 index 41 eq or 1 index 92 eq or {
  75                 2 index 2 index (\\) putinterval
  76                 exch 1 add exch
  77               } if
  78               2 index exch 2 index exch put
  79               1 add
  80             } ifelse
  81           } forall
  82           1 index exch (\)) putinterval
  83         }{ exch pop
  84           dup length 1 add string
  85           dup 0 (-) putinterval
  86           exch 1 index 1 1 index length 1 sub getinterval cvs pop
  87           dup dup length 4 sub (-) putinterval
  88           0 1 index length 3 sub getinterval
  89         } ifelse
  90       } ifelse
  91     } ifelse
  92   } ifelse
  93 } bind def
  94
  95 % int HSpindent - indent-spaces
  96 /HSpindent {
  97   dup 0 gt {
  98     1 1 3 -1 roll { pop ( ) print } for
  99   }{
 100     pop
 101   } ifelse
 102 } bind def
 103
 104 % indent array HSaprint -> Print an Array
 105 /HSaprint {
 106   dup type /arraytype eq {
 107     ( [) print
 108     exch 1 add dup 1 add
 109     3 -1 roll { % rind pos item
 110       HScvs dup length % rind pos str len
 111       dup 3 index add HSpwidth ge {
 112         (\n) print
 113         3 index HSpindent
 114         3 -1 roll pop
 115         2 index add
 116         exch
 117       }{
 118         ( ) print
 119         2 index add 1 add
 120         3 -1 roll pop
 121         exch
 122       } ifelse
 123       print
 124     } forall
 125     ( ]) print
 126     pop pop
 127   }{
 128     ( ) print
 129     HScvs print pop
 130   } ifelse
 131   (\n) print
 132 } bind def
 133
 134 % dict HSdnames dict names (creates sorted name-strings)
 135 /HSdnames {
 136 % Build namelist, stack: dic
 137   dup length 0 eq {
 138     []
 139   }{
 140     [ 1 index {
 141         pop dup type /nametype eq {
 142           dup length string cvs
 143         }{
 144           pop
 145         } ifelse
 146       } forall
 147     ]
 148 % Sort the namelist, stack: dic nam
 149     0 1 2 index length 2 sub { % stack: dic nam I
 150       2 copy get % stack: pre dic nam I nam[I]
 151       1 index 1 add 1 4 index length 1 sub { % stack: dic nam I nam[I] J
 152         3 index 1 index get % dic nam I S[I] J S[J]
 153         2 index 1 index gt { % swap them
 154            4 index 2 index 4 index put
 155            4 index 4 index 2 index put
 156            3 1 roll
 157         } if
 158         pop pop
 159       } for
 160       pop pop
 161     } for
 162   } ifelse
 163 } bind def
 164
 165 % string:prefix dict:which unprint
 166 /unprint {
 167   HSdnames % pre dic nam
 168 % compute the maximum length
 169   0 1 index { % pre dic nam maxlen nam[I]
 170     length 2 copy lt { exch } if pop
 171   } forall
 172 % Print out all the items, stack: pre dic nam maxlen
 173   (\n) print
 174   exch { % pre dic maxlen nam[I]
 175 % no prefix yet, -> flush right
 176     3 index length 0 eq {
 177       dup length 2 index exch sub HSpindent
 178     }{
 179       3 index print (/) print
 180     } ifelse
 181 % print the name
 182     dup print
 183 % prefix: fill up with blanks
 184     3 index length 0 ne {
 185       dup length 2 index exch sub HSpindent
 186     } if
 187 % now print the item itself, stack: pre dic maxlen nam[I]
 188     2 index 1 index cvn get dup type % stack: pre dic maxlen nam[i] item typ
 189 % Dict-Syntax
 190     dup /dicttype eq { pop % stack: pre dic maxlen nam[i] item
 191       ( ) print dup HScvs print
 192       4 index length 0 eq { % brand new prefix
 193         2 index string 0 1 5 index 1 sub { 1 index exch 32 put } for
 194         dup 4 index 4 index length sub 5 -1 roll putinterval
 195       }{
 196         4 index length 1 add 2 index length add string
 197         dup 0 7 index putinterval
 198         dup 6 index length (/) putinterval
 199         dup 6 index length 1 add 5 -1 roll putinterval
 200       } ifelse
 201       exch unprint
 202     }{
 203       3 -1 roll pop % tack: pre dic maxlen item typ
 204 % Array-Syntax
 205       dup /arraytype eq { pop % stack: pre dic maxlen item
 206         3 index length dup 0 ne { 1 add } if 2 index add
 207         exch HSaprint
 208       }{ pop
 209         ( ) print
 210         HScvs print
 211         (\n) print
 212       } ifelse
 213     } ifelse
 214   } forall
 215   pop pop length -1 eq { (\n) print } if
 216 } bind def
 217
 218 /currentpagedevice where { % check for currentpagedevice
 219    /currentpagedevice get exec () exch unprint
 220 } if