PPD: First options...

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;

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();