diff --git a/ppd/PPD.pm b/ppd/PPD.pm index 18a548e277e355efec1699c139c41e8be8a2d309..a8d701a0de90ff0865e92cefcff3c9b520f0c3ba 100644 --- a/ppd/PPD.pm +++ b/ppd/PPD.pm @@ -4,19 +4,19 @@ use strict; use warnings; use Exporter 'import'; -our @EXPORT = qw(get set maybe_set generate); +our @EXPORT = qw(get set maybe_set option generate); my %options = (); sub format_value($$) { my ($type, $value) = @_; $type //= 'q'; - if ($type eq 'q') { - # Quoted value - return '"' . $value . '"'; - } elsif ($type eq 'i') { - # Invocation value - return '"' . $value . '"'; + if ($type eq 'q' || $type eq 'i') { + # Quoted value / Invocation value + if ($value =~ /["\x00-\x08\x0b-\x1f\x7f-\xff]/) { die "Invalid value: $value\n"; } + $value = '"' . $value . '"'; + if ($value =~ /\n/) { $value .= "\n*End"; } + return $value; } elsif ($type eq 's') { # String value return $value; @@ -28,6 +28,7 @@ sub format_value($$) { } } +# get("section/option") sub get($) { my ($key, $value) = @_; my ($section, $opt) = split /\//, $key; @@ -39,6 +40,8 @@ sub get($) { } } +# set("section/option[:type]", value) +# types: q=quoted (default), i=invocation, s=string (unquoted), b=boolean sub set($$) { my ($key, $value) = @_; my ($section, $opt) = split /\//, $key; @@ -79,6 +82,52 @@ set('d/ColorDevice:b', 0); set('d/DefaultColorSpace:q', 'Gray'); set('d/FileSystem:b', 0); +my @ui_groups = (); + +sub ui_group($) { + my ($g) = @_; + my $key = $g->{'Key'}; + defined $options{'u'}{$key} and die "Duplicate UI group $key\n"; + $options{'u'}{$key} = $g; + push @ui_groups, $g; + $g->{'Options'} = []; +} + +# Section "u": UI groups +ui_group({ Key => '' }); + +# Section "n": non-UI options +$options{'n'} = { Key => '', Options => [] }; + +# option({ +# Key => key, # (mandatory) +# Name => name, # descriptive name (default: same as Key) +# Type => type, # PickOne / PickMany / Boolean +# UI => group, # UI group ('' if outside groups, default: non-UI option) +# JCL => 1, # if this is a JCL option +# Section => sec, # OrderDependency section: ExitServer / Prolog / DocumentSetup / +# # PageSetup / JCLSetup (default if JCL=1) / AnySetup (default if JCL=0) +# Priority => pri, # OrderDependency priority, default = 100 +# Values => [ # possible values (mandatory) +# { Key => key, # key (mandatory) +# Name => key, # descriptive name (default: same as Key) +# PS => string, # PS code to emit (mandatory) +# Default => 1, # if this is the default value +# }, +# ] +# }) +sub option($) { + my ($o) = @_; + my $ui = $o->{'UI'}; + my $g; + if (defined $ui) { + $g = $options{'u'}{$ui} or die "No such UI group $ui\n"; + } else { + $g = $options{'n'}; + } + push @{$g->{'Options'}}, $o; +} + sub heading($) { my ($h) = @_; print "\n"; @@ -101,6 +150,39 @@ sub emit($) { } } +sub get_default($) { + my ($o) = @_; + for my $val (@{$o->{Values}}) { + return $val->{Key} if $val->{Default}; + } + return $o->{Values}->[0]->{Key}; +} + +sub emit_option($) { + my ($o) = @_; + my $key = $o->{Key}; + my $jcl = ($o->{JCL} // ($key =~ /^JCL/)) ? "JCL" : ""; + if (defined $o->{UI}) { print "*${jcl}OpenUI *$key/", ($o->{Name} // $o->{Key}), ': ', $o->{Type}, "\n"; } + my $pri = $o->{Priority} // 100; + my $sec = $o->{Section} // ($jcl ? "JCLSetup" : "AnySetup"); + print '*', ((defined $o->{UI}) ? "" : 'NonUI'), "OrderDependency $pri $sec *$key\n"; + print "*Default$key: ", get_default($o), "\n"; + for my $v (@{$o->{Values}}) { + print "*$key ", $v->{Key}, '/', ($v->{Name} // $v->{Key}), ': ', format_value('i', $v->{PS}), "\n"; + } + if (defined $o->{UI}) { print "*${jcl}CloseUI *$key\n"; } + print "\n"; +} + +sub emit_group($) { + my ($g) = @_; + if ($g->{Key} ne '') { print '*OpenGroup: ', $g->{Key}, '/', ($g->{Name} // $g->{Key}), "\n\n"; } + for my $o (@{$g->{Options}}) { + emit_option($o); + } + if ($g->{Key} ne '') { print "\n", '*CloseGroup: ', $g->{Key}, "\n"; } +} + sub fill_missing() { my $model = get('p/ModelName'); if (defined $model) { @@ -128,6 +210,18 @@ sub generate() { heading("Device capabilities"); emit('d'); + + for my $g (@ui_groups) { + next if $g->{Key} eq ''; + heading($g->{Name}); + emit_group($g); + } + + heading("General UI options"); + emit_group($ui_groups[0]); + + heading("Non-UI options"); + emit_group($options{'n'}); } 42; diff --git a/ppd/gen-hp b/ppd/gen-hp index fe1303e6fd88d4af01e94a641f28fdacf5d02839..7f3533487367a660d2d4298313ddc09ed48ceceb 100755 --- a/ppd/gen-hp +++ b/ppd/gen-hp @@ -16,6 +16,18 @@ set('p/PSVersion', '(3010.107) 0'); set('d/Throughput', 35); set('d/TTRasterizer:s', 'Type42'); set('d/VariablePaperSize:b', 1); -set('d/Protocols:b', 'PJL TBCP'); +set('d/Protocols:s', 'PJL TBCP'); + +option({ + Key => 'Duplex', + Name => '2-Sided Printing', + Type => 'PickOne', + UI => '', + Values => [ + { Key => 'None', Name => 'Off (1-Sided)', PS => "<< /Duplex false >> setpagedevice" }, + { Key => 'DuplexNoTumble', Name => 'Long-Edge Binding', PS => "<< /Duplex true /Tumble false >> setpagedevice", Default => 1 }, + { Key => 'DuplexTumble', Name => 'Short-Edge Binding', PS => "<< /Duplex true /Tumble true >> setpagedevice" }, + ] +}); generate();