1 % Copyright (C) 1990, 2000 Aladdin Enterprises. All rights reserved.
3 % This software is provided AS-IS with no warranty, either express or
6 % This software is distributed under license and may not be copied,
7 % modified or distributed except as expressly authorized under the terms
8 % of the license contained in the file LICENSE in this distribution.
10 % For more information about licensing, please refer to
11 % http://www.ghostscript.com/licensing/. For information on
12 % commercial licensing, go to http://www.artifex.com/licensing/ or
13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
14 % San Rafael, CA 94903, U.S.A., +1(415)492-9861.
16 % $Id: gs_diskn.ps,v 1.5 2003/08/08 18:45:04 ray Exp $
17 % Initialization file for %disk device modifications
18 % When this is run, systemdict is still writable,
22 % Collect the list of searchable IODevices in SearchOrder
23 % Efficiency here doesn't matter since we run this at the end
24 % of gs_init and convert it to a static array.
25 /.getsearchabledevs { % - .getsearchabledevs [ list_of_strings ]
26 //systemdict /.searchabledevs .knownget not {
27 .currentglobal true .setglobal
29 dup length string copy dup currentdevparams /Searchable
30 .knownget { not { pop } if } { pop } ifelse
31 } 8192 string /IODevice resourceforall
33 % now process the array into correct SearchOrder
36 dup currentdevparams /SearchOrder get 2 index eq
37 { exch } { pop } ifelse
38 } forall % devices on the old list
40 % make the array and sort it by name
44 % collect all devices with SearchOrder > 2
46 dup currentdevparams /SearchOrder get 2 gt
47 { exch } { pop } ifelse
50 % We now have 4 arrays on the stack, SO=0 SO=1 SO=2 SO>2
51 % make them into a single array
52 mark 5 1 roll ] mark exch { { } forall } forall ]
53 //systemdict /.searchabledevs 2 index .forceput
57 } .bind executeonly def % must be bound and hidden for .forceput
59 % Modify .putdevparams to force regeneration of .searchabledevs list
61 % We could be smarter and check for %disk* device, but this
62 % doesn't get run enough to justify the complication
64 //systemdict /.searchabledevs .forceundef
65 } .bind odef % must be bound and hidden for .forceundef
67 % ------ extend filenameforall to handle wildcards in %dev% part of pattern -------%
73 % no device specified, so search them all
74 pop (*%) 3 index concatstrings
75 % we need to suppress the device when we return the string
76 % in order to match Adobe's behaviour with %disk devices.
77 4 -2 roll % the callers procedure
78 [ { (%) search { pop pop (%) search { pop pop } if } if } /exec load
79 4 -1 roll % the callers procedure
82 4 2 roll % put the modified procedure where it belongs
84 % extract device portion (up to end of string or next %)
85 (%) search { exch pop } if % stack: opat proc scratch npat device
86 dup (*) search { pop pop pop true } { pop false } ifelse
87 1 index (?) search { pop pop pop true } { pop false } ifelse
89 pop pop //filenameforall % device with no wildcard
91 (%) concatstrings (%) exch concatstrings
93 % find all matching devices and add the rest of the search string
95 dup counttomark 1 add index .stringmatch {
96 counttomark 2 add index concatstrings
104 % now we need to invoke filenameforall for each of the strings
105 % in the array. We do this by building a procedure that is like
106 % an unrolled 'forall' loop. We do this to get the parameters
107 % for each filenameforall, since each execution will pop its
108 % parameters, but we can't use the operand stack for storage
109 % since each invocation must have the same operand stack.
111 counttomark dup 3 add index exch
117 exec % run our unrolled loop
121 //filenameforall % not enough parameters -- just let it fail
126 % redefine file to search all devices in order
128 dup 0 get (r) 0 get eq dup {
129 pop false % success code
130 2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
131 { 3 index concatstrings % prepend the device
133 2 index //file } .internalstopped not {
134 4 1 roll pop pop pop true
135 exit % exit with success
144 not { % just let standard file operator handle things
150 % redefine deletefile to search all devices in order
153 1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
154 { 2 index concatstrings % prepend the device
155 { //deletefile } .internalstopped exch pop not {
156 pop true exit % exit with success
161 not { $error /errorname get /deletefile exch signalerror } if
164 % redefine status to search all devices in order
166 dup type /stringtype eq {
168 1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
169 { 2 index concatstrings % prepend the device
170 { //status } .internalstopped not {
171 { true 7 -2 roll pop pop true exit } % exit with success
177 % If we made it this far, no devices were found to status the file
178 % clean up to return 'false'
186 % Also redefine renamefile to search all devices in order
189 2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
190 { dup 4 index concatstrings % prepend the device
191 { (r) //file } .internalstopped
193 closefile exch pop true exit % exit with success
199 not { $error /errorname get /renamefile exch signalerror } if
200 3 -1 roll concatstrings exch
204 % redefine devforall to process devices in numeric order
205 % Spec's for 'devforall' are unclear, but font downloaders may expect this
206 /devforall { % <proc> <scratch> devforall -
207 [ { dup length string copy } 2 index //devforall ]
208 % stack: proc scratch array_of_device_names
210 % We don't really invoke the procedure with the scratch string
211 % but rather with the strings from our array