summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps')
-rw-r--r--Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps124
1 files changed, 74 insertions, 50 deletions
diff --git a/Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps b/Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps
index 8fa7c51df15..e22597ebb5f 100644
--- a/Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps
+++ b/Master/tlpkg/tlgs/Resource/Init/gs_setpd.ps
@@ -608,59 +608,72 @@ NOMEDIAATTRS {
% in the <failed> dictionary with the policy value,
% and we replace the key in the <merged> dictionary with its prior value
% (or remove it if it had no prior value).
-/.policyprocs mark
+
% These procedures are called with the following on the stack:
% <orig> <merged> <failed> <Policies> <key> <policy>
% They are expected to consume the top 2 operands.
% NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
% the same as 0, i.e., we signal an error.
-%
-% M. Sweet, Easy Software Products:
-%
-% Define NOMEDIAATTRS to turn off the default (but unimplementable) media
-% selection policies for setpagedevice. This is used by CUPS to support
-% the standard Adobe media attributes.
- 0 { % Set errorinfo and signal a configurationerror.
- NOMEDIAATTRS {
- % NOMEDIAATTRS means that the default policy is 7...
- pop 2 index exch 7 put
- } {
- pop dup 4 index exch get 2 array astore
- $error /errorinfo 3 -1 roll put
- cleartomark
- /setpagedevice .systemvar /configurationerror signalerror
- } ifelse
- } bind
- 1 { % Roll back the failed request to its previous status.
-SETPDDEBUG { (Rolling back.) = pstack flush } if
- 3 index 2 index 3 -1 roll .forceput
- 4 index 1 index .knownget
- { 4 index 3 1 roll .forceput }
- { 3 index exch .undef }
- ifelse
- } .bind executeonly % must be bound and hidden for .forceput
- 7 { % For PageSize only, just impose the request.
- 1 index /PageSize eq
- { pop pop 1 index /PageSize 7 put }
- { .policyprocs 0 get exec }
- ifelse
- } bind
-.dicttomark readonly def
+/0Policy { % Set errorinfo and signal a configurationerror.
+ NOMEDIAATTRS {
+ % NOMEDIAATTRS means that the default policy is 7...
+ pop 2 index exch 7 put
+ } {
+ pop dup 4 index exch get 2 array astore
+ $error /errorinfo 3 -1 roll put
+ cleartomark
+ /setpagedevice .systemvar /configurationerror signalerror
+ } ifelse
+} bind executeonly odef
+
+% Making this an operator means we can properly hide
+% the contents - specifically .forceput
+/1Policy
+{
+ % Roll back the failed request to its previous status.
+ SETPDDEBUG { (Rolling back.) = pstack flush } if
+ 3 index 2 index 3 -1 roll .forceput
+ 4 index 1 index .knownget
+ { 4 index 3 1 roll .forceput }
+ { 3 index exch .undef }
+ ifelse
+} bind executeonly odef
+
+/7Policy { % For PageSize only, just impose the request.
+ 1 index /PageSize eq
+ { pop pop 1 index /PageSize 7 put }
+ { .policyprocs 0 get exec }
+ ifelse
+} bind executeonly odef
+
/.applypolicies % <orig> <merged> <failed> .applypolicies
% <orig> <merged'> <failed'>
- { 1 index /Policies get 1 index
- { type /integertype eq
- { pop % already processed
- }
- { 2 copy .knownget not { 1 index /PolicyNotFound get } if
- % Stack: <orig> <merged> <failed> <Policies> <key>
- % <policy>
- .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
- }
- ifelse
- }
- forall pop
- } bind def
+{
+ 1 index /Policies get 1 index
+ { type /integertype eq
+ {
+ pop % already processed
+ }{
+ 2 copy .knownget not { 1 index /PolicyNotFound get } if
+ % Stack: <orig> <merged> <failed> <Policies> <key>
+ % <policy>
+ dup 1 eq {
+ 1Policy
+ }{
+ dup 7 eq {
+ 7Policy
+ }{
+ 0Policy
+ } ifelse
+ } ifelse
+ } ifelse
+ }
+ forall pop
+} bind executeonly odef
+
+currentdict /0Policy undef
+currentdict /1Policy undef
+currentdict /7Policy undef
% Prepare to present parameters to the device, by spreading them onto the
% operand stack and removing any that shouldn't be presented.
@@ -877,7 +890,13 @@ SETPDDEBUG { (Selecting.) = pstack flush } if
% Stack: mark <orig> <request> <merged> <failed>
SETPDDEBUG { (Constructing.) = pstack flush } if
- currentdevice .devicename 2 index /OutputDevice get eq
+ % Non-obvious: we need to check the name of the output device, to tell
+ % whether we're going to have to replace the entire device chain (which
+ % may be only one device, or may be multiple devices.
+ % If we're not replacing the entire change, we have to use the device in
+ % the graphics state, so the configuration of the entire device chain is
+ % correctly set.
+ .currentoutputdevice .devicename 2 index /OutputDevice get eq
{ currentdevice }
{ 1 index /OutputDevice get finddevice }
ifelse
@@ -913,10 +932,15 @@ SETPDDEBUG { (Recovering.) = pstack flush } if
% Stack: mark ... <merged> <failed> <device> <eraseflag>
SETPDDEBUG { (Installing.) = pstack flush } if
- pop
+ pop
% .setdevice clears the current page device!
.currentpagedevice pop exch
- .setdevice pop
+ { .setdevice } stopped {
+ cleartomark exch pop
+ /setpagedevice $error /errorname get
+ signalerror
+ } if
+ pop
.setpagedevice
% Implement UseCIEColor directly if this is a LL3 system.
@@ -997,7 +1021,7 @@ SETPDDEBUG { (Installing.) = pstack flush } if
.postinstall
} ifelse
setglobal % return to original VM allocation mode
-} odef
+} bind executeonly odef
% We break out the code after calling the Install procedure into a
% separate procedure, since it is executed even if Install causes an error.