215 lines
6.7 KiB
PostScript
215 lines
6.7 KiB
PostScript
% Copyright (C) 1990, 2000 Aladdin Enterprises. All rights reserved.
|
|
%
|
|
% This software is provided AS-IS with no warranty, either express or
|
|
% implied.
|
|
%
|
|
% This software is distributed under license and may not be copied,
|
|
% modified or distributed except as expressly authorized under the terms
|
|
% of the license contained in the file LICENSE in this distribution.
|
|
%
|
|
% For more information about licensing, please refer to
|
|
% http://www.ghostscript.com/licensing/. For information on
|
|
% commercial licensing, go to http://www.artifex.com/licensing/ or
|
|
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
|
|
% San Rafael, CA 94903, U.S.A., +1(415)492-9861.
|
|
|
|
% $Id: gs_diskn.ps,v 1.5 2003/08/08 18:45:04 ray Exp $
|
|
% Initialization file for %disk device modifications
|
|
% When this is run, systemdict is still writable,
|
|
|
|
systemdict begin
|
|
|
|
% Collect the list of searchable IODevices in SearchOrder
|
|
% Efficiency here doesn't matter since we run this at the end
|
|
% of gs_init and convert it to a static array.
|
|
/.getsearchabledevs { % - .getsearchabledevs [ list_of_strings ]
|
|
//systemdict /.searchabledevs .knownget not {
|
|
.currentglobal true .setglobal
|
|
mark (*) {
|
|
dup length string copy dup currentdevparams /Searchable
|
|
.knownget { not { pop } if } { pop } ifelse
|
|
} 8192 string /IODevice resourceforall
|
|
]
|
|
% now process the array into correct SearchOrder
|
|
0 1 2 {
|
|
mark exch 2 index {
|
|
dup currentdevparams /SearchOrder get 2 index eq
|
|
{ exch } { pop } ifelse
|
|
} forall % devices on the old list
|
|
pop
|
|
% make the array and sort it by name
|
|
] { lt } bind .sort
|
|
exch
|
|
} for
|
|
% collect all devices with SearchOrder > 2
|
|
mark 2 index {
|
|
dup currentdevparams /SearchOrder get 2 gt
|
|
{ exch } { pop } ifelse
|
|
} forall
|
|
] exch pop
|
|
% We now have 4 arrays on the stack, SO=0 SO=1 SO=2 SO>2
|
|
% make them into a single array
|
|
mark 5 1 roll ] mark exch { { } forall } forall ]
|
|
//systemdict /.searchabledevs 2 index .forceput
|
|
exch .setglobal
|
|
}
|
|
if
|
|
} .bind executeonly def % must be bound and hidden for .forceput
|
|
|
|
% Modify .putdevparams to force regeneration of .searchabledevs list
|
|
/.putdevparams {
|
|
% We could be smarter and check for %disk* device, but this
|
|
% doesn't get run enough to justify the complication
|
|
//.putdevparams
|
|
//systemdict /.searchabledevs .forceundef
|
|
} .bind odef % must be bound and hidden for .forceundef
|
|
|
|
% ------ extend filenameforall to handle wildcards in %dev% part of pattern -------%
|
|
/filenameforall {
|
|
count 3 ge {
|
|
2 index (%) search {
|
|
pop pop
|
|
} {
|
|
% no device specified, so search them all
|
|
pop (*%) 3 index concatstrings
|
|
% we need to suppress the device when we return the string
|
|
% in order to match Adobe's behaviour with %disk devices.
|
|
4 -2 roll % the callers procedure
|
|
[ { (%) search { pop pop (%) search { pop pop } if } if } /exec load
|
|
4 -1 roll % the callers procedure
|
|
/exec load
|
|
] cvx
|
|
4 2 roll % put the modified procedure where it belongs
|
|
} ifelse
|
|
% extract device portion (up to end of string or next %)
|
|
(%) search { exch pop } if % stack: opat proc scratch npat device
|
|
dup (*) search { pop pop pop true } { pop false } ifelse
|
|
1 index (?) search { pop pop pop true } { pop false } ifelse
|
|
or not {
|
|
pop pop //filenameforall % device with no wildcard
|
|
} {
|
|
(%) concatstrings (%) exch concatstrings
|
|
.getsearchabledevs
|
|
% find all matching devices and add the rest of the search string
|
|
mark exch {
|
|
dup counttomark 1 add index .stringmatch {
|
|
counttomark 2 add index concatstrings
|
|
} {
|
|
pop
|
|
} ifelse
|
|
} forall
|
|
]
|
|
3 1 roll pop pop
|
|
4 -1 roll pop
|
|
% now we need to invoke filenameforall for each of the strings
|
|
% in the array. We do this by building a procedure that is like
|
|
% an unrolled 'forall' loop. We do this to get the parameters
|
|
% for each filenameforall, since each execution will pop its
|
|
% parameters, but we can't use the operand stack for storage
|
|
% since each invocation must have the same operand stack.
|
|
mark exch {
|
|
counttomark dup 3 add index exch
|
|
2 add index
|
|
/filenameforall load
|
|
} forall
|
|
] cvx
|
|
3 1 roll pop pop
|
|
exec % run our unrolled loop
|
|
}
|
|
ifelse
|
|
} {
|
|
//filenameforall % not enough parameters -- just let it fail
|
|
}
|
|
ifelse
|
|
} odef
|
|
|
|
% redefine file to search all devices in order
|
|
/file {
|
|
dup 0 get (r) 0 get eq dup {
|
|
pop false % success code
|
|
2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
|
|
{ 3 index concatstrings % prepend the device
|
|
{
|
|
2 index //file } .internalstopped not {
|
|
4 1 roll pop pop pop true
|
|
exit % exit with success
|
|
} {
|
|
pop pop
|
|
}
|
|
ifelse
|
|
}
|
|
forall
|
|
}
|
|
if
|
|
not { % just let standard file operator handle things
|
|
//file
|
|
}
|
|
if
|
|
} bind odef
|
|
|
|
% redefine deletefile to search all devices in order
|
|
/deletefile {
|
|
false % success code
|
|
1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
|
|
{ 2 index concatstrings % prepend the device
|
|
{ //deletefile } .internalstopped exch pop not {
|
|
pop true exit % exit with success
|
|
}
|
|
if
|
|
}
|
|
forall
|
|
not { $error /errorname get /deletefile exch signalerror } if
|
|
} bind odef
|
|
|
|
% redefine status to search all devices in order
|
|
/status {
|
|
dup type /stringtype eq {
|
|
false % success code
|
|
1 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
|
|
{ 2 index concatstrings % prepend the device
|
|
{ //status } .internalstopped not {
|
|
{ true 7 -2 roll pop pop true exit } % exit with success
|
|
if
|
|
}
|
|
if
|
|
}
|
|
forall
|
|
% If we made it this far, no devices were found to status the file
|
|
% clean up to return 'false'
|
|
exch pop
|
|
} {
|
|
//status
|
|
}
|
|
ifelse
|
|
} bind odef
|
|
|
|
% Also redefine renamefile to search all devices in order
|
|
/renamefile {
|
|
false % success code
|
|
2 index 0 get 37 eq { [ () ] } { .getsearchabledevs } ifelse
|
|
{ dup 4 index concatstrings % prepend the device
|
|
{ (r) //file } .internalstopped
|
|
not {
|
|
closefile exch pop true exit % exit with success
|
|
} {
|
|
pop pop
|
|
} ifelse
|
|
}
|
|
forall
|
|
not { $error /errorname get /renamefile exch signalerror } if
|
|
3 -1 roll concatstrings exch
|
|
//renamefile
|
|
} bind odef
|
|
|
|
% redefine devforall to process devices in numeric order
|
|
% Spec's for 'devforall' are unclear, but font downloaders may expect this
|
|
/devforall { % <proc> <scratch> devforall -
|
|
[ { dup length string copy } 2 index //devforall ]
|
|
% stack: proc scratch array_of_device_names
|
|
{ lt } .sort
|
|
% We don't really invoke the procedure with the scratch string
|
|
% but rather with the strings from our array
|
|
exch pop exch forall
|
|
} odef
|
|
end % systemdict
|