#!/usr/bin/perl -w
# Copyright © 2002-2014 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation. No representations are made about the suitability of this
# software for any purpose. It is provided "as is" without express or
# implied warranty.
#
# Created: 30-May-2002.
#
# This creates man pages from the XML program descriptions in
# xscreensaver/hacks/config/.
#
# They aren't necessarily the most accurate or well-written man pages,
# but at least they exist.
require 5;
use diagnostics;
use strict;
use Text::Wrap;
my $progname = $0; $progname =~ s@.*/@@g;
my ($version) = ('$Revision: 1.7 $' =~ m/\s(\d[.\d]+)\s/s);
my $verbose = 0;
my $default_args = ("[\\-display \\fIhost:display.screen\\fP]\n" .
"[\\-visual \\fIvisual\\fP]\n" .
"[\\-window]\n" .
"[\\-root]\n");
my $default_options = (".TP 8\n" .
".B \\-visual \\fIvisual\\fP\n" .
"Specify which visual to use. Legal values " .
"are the name of a visual class,\n" .
"or the id number (decimal or hex) of a " .
"specific visual.\n" .
".TP 8\n" .
".B \\-window\n" .
"Draw on a newly-created window. " .
"This is the default.\n" .
".TP 8\n" .
".B \\-root\n" .
"Draw on the root window.\n");
my $man_suffix = (".SH ENVIRONMENT\n" .
".PP\n" .
".TP 8\n" .
".B DISPLAY\n" .
"to get the default host and display number.\n" .
".TP 8\n" .
".B XENVIRONMENT\n" .
"to get the name of a resource file that overrides " .
"the global resources\n" .
"stored in the RESOURCE_MANAGER property.\n" .
".SH SEE ALSO\n" .
".BR X (1),\n" .
".BR xscreensaver (1)\n" .
".SH COPYRIGHT\n" .
"Copyright \\(co %YEAR% by %AUTHOR%. " .
"Permission to use, copy, modify, \n" .
"distribute, and sell this software and its " .
"documentation for any purpose is \n" .
"hereby granted without fee, provided that " .
"the above copyright notice appear \n" .
"in all copies and that both that copyright " .
"notice and this permission notice\n" .
"appear in supporting documentation. No " .
"representations are made about the \n" .
"suitability of this software for any purpose. " .
"It is provided \"as is\" without\n" .
"express or implied warranty.\n" .
".SH AUTHOR\n" .
"%AUTHOR%.\n");
sub xml2man($) {
my ($exe) = @_;
$exe =~ s/\.xml$//s;
my $cfgdir = (-d "config" ? "config" : "../config");
my $xml = "$cfgdir/$exe.xml";
my $man = "$exe.man";
error ("$exe does not exist") if (! -f $exe);
error ("$xml does not exist") if (! -f $xml);
error ("$man already exists") if (-f $man);
local *IN;
open (IN, "<$xml") || error ("$xml: $!");
my $xmltxt = "";
while (<IN>) { $xmltxt .= $_; }
close IN;
my $args = "";
my $body = "";
my $desc;
$xmltxt =~ s/\s+/ /gs;
$xmltxt =~ s/<!--.*?-->//g;
$xmltxt =~ s@(<[^/])@\n$1@gs;
foreach (split ('\n', $xmltxt)) {
next if m/^$/;
next if m/^<\?xml\b/;
next if m/^<screensaver\b/;
next if m/^<command\b/;
next if m/^<[hv]group\b/;
next if m/^<select\b/;
my ($x,$arg) = m@\barg(|-unset|-set)=\"([^\"]+)\"@;
my ($label) = m@\b_?label=\"([^\"]+)\"@;
my ($low) = m@\blow=\"([^\"]+)\"@;
my ($hi) = m@\bhigh=\"([^\"]+)\"@;
my ($def) = m@\bdefault=\"([^\"]+)\"@;
$arg =~ s@\s*\%\s*@ \\fInumber\\fP@g if ($arg);
my $carg = $arg;
my $boolp = m/^<boolean/;
my $novalsp = 0;
if ($arg && $arg =~ m/^-no(-.*)/) {
$arg = "$1 | \\$arg";
} elsif ($boolp && $arg) {
$arg = "$arg | \\-no$arg";
}
if ($carg && $carg =~ m/colors/) {
$hi = $low = undef;
}
if (!$carg) {
} elsif ($carg eq '-move' || $carg eq '-no-move' ||
$carg eq '-wander' || $carg eq '-no-wander') {
$label = "Whether the object should wander around the screen.";
} elsif ($boolp && ($carg eq '-spin' || $carg eq '-no-spin')) {
$label = "Whether the object should spin.";
} elsif ($carg eq '-spin X') {
$carg = '-spin \fI[XYZ]\fP';
$arg = $carg;
$label = "Around which axes should the object spin?";
} elsif ($carg eq '-fps' || $carg eq '-no-fps') {
$label = "Whether to show a frames-per-second display " .
"at the bottom of the screen.";
} elsif ($carg eq '-wireframe' || $carg eq '-wire') {
$label = "Render in wireframe instead of solid.";
} elsif ($carg =~ m/^-delay/ && $hi && $hi >= 10000) {
$label = "Per-frame delay, in microseconds.";
$def = sprintf ("%d (%0.2f seconds)", $def, ($def/1000000.0));
$low = $hi = undef;
} elsif ($carg eq '-speed \fInumber\fP') {
$label = "Animation speed. 2.0 means twice as fast, " .
"0.5 means half as fast.";
$novalsp = 1;
} elsif ($boolp) {
$label .= ". Boolean.";
} elsif ($label) {
$label .= ".";
}
if (m/^<(number|boolean|option)/) {
next if (!$arg && m/<option/);
if (!$label) {
print STDERR "$progname: ERROR: no label: $_\n";
$label = "???";
}
$args .= "[\\$carg]\n";
if (! $novalsp) {
$label .= " $low - $hi." if (defined($low) && defined($hi));
$label .= " Default: $def." if (defined ($def));
}
$label = wrap ("", "", $label);
$body .= ".TP 8\n.B \\$arg\n$label";
$body .= "\n";
} elsif (m@^<_description>\s*(.*)\s*</_description>@) {
$desc = $1;
} elsif (m@^<xscreensaver-updater@) {
} elsif (m@^<video\b@) {
} else {
print STDERR "$progname: ERROR: UNKNOWN: $_\n";
}
}
$desc = "Something pretty." unless $desc;
my $author = undef;
if ($desc =~ m@^(.*?)\s*(Written by|By) ([^.]+\.?\s*)$@s) {
$desc = $1;
$author = $3;
$author =~ s/\s*[.]\s*$//;
}
if (!$author) {
print STDERR "$progname: $exe: WARNING: unknown author\n";
$author = "UNKNOWN";
}
$desc =~ s@http://en\.wikipedia\.org/[^\s]+@@gs;
$desc = wrap ("", "", $desc);
$body = (".TH XScreenSaver 1 \"\" \"X Version 11\"\n" .
".SH NAME\n" .
"$exe - screen saver.\n" .
".SH SYNOPSIS\n" .
".B $exe\n" .
$default_args .
$args .
".SH DESCRIPTION\n" .
$desc . "\n" .
".SH OPTIONS\n" .
$default_options .
$body .
$man_suffix);
my $year = $1 if ($author =~ s/; (\d{4})$//s);
$year = (localtime)[5] + 1900 unless $year;
$body =~ s/%AUTHOR%/$author/g;
$body =~ s/%YEAR%/$year/g;
#print $body; exit 0;
local *OUT;
open (OUT, ">$man") || error ("$man: $!");
print OUT $body || error ("$man: $!");
close OUT || error ("$man: $!");
print STDERR "$progname: wrote $man\n";
}
sub error($) {
my ($err) = @_;
print STDERR "$progname: $err\n";
exit 1;
}
sub usage() {
print STDERR "usage: $progname [--verbose] programs...\n";
exit 1;
}
sub main() {
my @progs = ();
while ($_ = $ARGV[0]) {
shift @ARGV;
if ($_ eq "--verbose") { $verbose++; }
elsif (m/^-v+$/) { $verbose += length($_)-1; }
elsif (m/^-./) { usage; }
else { push @progs, $_; }
}
usage() if ($#progs < 0);
foreach (@progs) { xml2man($_); }
}
main();
exit 0;
