#!/usr/bin/perl
# 
#
# Authors:
#  Petr Blahos <pblahos@suse.cz>
#  Martin Vidner <mvidner@suse.cz>
#
# $Id$

=head1 NAME

ycpdoc - Creates html files based on comments in ycp file.

=head1 SYNOPSIS

  ycpdoc -h|--help|--man
  ycpdoc [-d <dir>] [-s <dir>] [-f html|xml] [-i] [-] [-o] [-wr] files.ycp...

=head1 OPTIONS AND ARGUMENTS

=over

=item B<-h>

Show this help screen

=item B<-d> I<dir>, B<--outputdir>=I<dir>

Output files are placed to directory I<dir>

=item B<-s> I<dir>, B<--strip>=I<dir>

Strip only I<dir> when generating output files (default all).
Remaining slashes are converted to double underscores.

=item B<-f> I<format>, B<--format>=I<format>

Produce output in given format, html or xml. The option may be repeated.
HTML is the default. XML produces ycpdoc.xml, the DTD is not stable yet.

=item B<-O> I<file>, B<--xml-output>=I<file>

For xml output, write to I<file>. The default is C<ycpdoc.xml>, I<not>
respecting I<outputdir>.

=item B<-i>, B<--noindex>

Do not generate index.html (intro.html, files.html)

=item B<->

Write output to stdout. Do not generate indexes.
If there are more input files, generate only one
output html file

=item B<-o>, B<--oldindex>

Old style of index: creates only index.html

=item B<-wr>

Do not warn about undeclared return types

=item B<--state>

For debugging, prints the parsing state for each line.

=back

=head1 DESCRIPTION

Processes special comments in ycp file and creates
html file from them. Uses the same comment syntax as
kdoc/ydoc.

=head2 File Description

Format:

	Attribute: value

Attributes: Author Authors Depends File Flags Module Package Summary

Flags: Stable Unstable

=head2 Function Description

	Supported tags:
            @short very short description
            @descr complete description
	    @param name description	html allowed
	    @return type description	html allowed
	    @since version		html allowed
	    @example anything		html allowed, <pre>
	    @example_file file path
	    @see function
	    @see #function
	    @see file#function
	    @see file#
	    @see <a href="uri">text</a>
	    @deprecated replacement
	    @stable or @unstable
	    @struct name		begins a struct description, <pre>
	    @ref function		(inline, otherwise like @see)
	    @internal			marks the module for internal
					use only (bnc #344926)

First line is automatically taken as short if it has no tag. Empty line after
the first line indicates begin of the description. Every following new line
indicates a new paragraph.

All tags except @see can be multiline.
Also processes initial comment of file if it starts at the
first line, html allowed.
Supports intro via /*** , html allowed.

Interface stability is marked by @stable or @unstable. The default is
@unstable.

See YaST2 Documentation public/Developers/Coding/rules.html
for example.

=head1 EXAMPLES

The most common use (I believe):
   cd doc/autodocs
   ycpdoc -d. ../../src/printconf*ycp
Creates index.html and one html file for each ycp file.

Generate html file to stdout. Skip index:
   ycpdoc - file.ycp

For example of comments in ycp file, please see example.ycp and modules.ycp.
You can also look at generated index.html, intro.html, files.html, example.html
and modules.html.

=head1 PARANOISM

ycpdoc reports functions without comment and functions that have
undocumented arguments and arguments that are documented but do not
exist.

=cut

use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use Pod::Usage;
use XML::Writer;
use Tie::Hash;
use Tie::Array;

sub main
{
    parse_arguments ();

    parse_sources ();
    write_docs ();
}


my @sources = ();

my @formats_wanted = ();
my $help = 0;
my $man = 0;
my $skip_index = 0;
my $output_stdout = 0;
my $output_dir = ".";
my $strip_prefix = "";		# both with a trailing slash
my $new_index_style = 1;
my $warning_level = 2;
my $xml_output = "ycpdoc.xml";
my $warn_return_types = 1;
my $show_state = 0;		# show which state we are in for each line

sub parse_arguments
{
##
## find switches
##
    Getopt::Long::Configure ("bundling");
    GetOptions (
		"help|h" => \$help,
		"man" => \$man,
		"noindex|i" => \$skip_index,
		"" => \$output_stdout,
		"outputdir|d=s" => \$output_dir,
		"strip|s=s" => \$strip_prefix,
		"oldindex|o" => sub { $new_index_style = 0; },
		"xml-output|O=s" => \$xml_output,
		"w=i" => \$warning_level,
		"wr" => sub { $warn_return_types = 0; },
		"format|f=s" => \@formats_wanted,
		"state" => \$show_state,
	       ) or pod2usage (2);
    pod2usage (1) if $help;
    pod2usage (-exitstatus => 0, -verbose => 2) if $man;


    if ($output_stdout)
    {
	$skip_index = 1;
    }
    if ($output_dir !~ /\/$/ )
    {
	$output_dir .= "/";
    }
    if ($strip_prefix !~ /\/$/ )
    {
	$strip_prefix .= "/";
    }
    if (@formats_wanted == 0)
    {
	@formats_wanted = ("html");
    }

    @sources = @ARGV;
    if (@sources == 0)
    {
	pod2usage (2);
    }
}

my %formats =
    (
     "html" => "ycpdoc::HTML",
     "xml" => "ycpdoc::XML",
    );

sub write_docs
{
    no strict "refs";
    foreach my $format (@formats_wanted)
    {
	my $fun = $formats{$format} ."::write_docs";
	&$fun;
    }
}


###
### information shared between parsing and writing
###

my $any_module = "";		# module to be put on index pages

# global map:
#   intro_html string, concatenated contents of (/*** */), leading * stripped
#   files map keyed by filenames
my $g;

# file map:
#   header map
#   requires list of maps
#   provides list of maps

# header map:
#   module
#   file
#   authors: list
#   descr
#   summary
#   depends
#   flags: unstable (default) | stable
# requires map:
#   kind: include or import or (yuck! provides!) module
#   name
# provides map:
#   file => "routines"
#   kind: "function", "variable", "scruple" - struct or tuple ;-), ("info")
#    scruple is just a stub to generate index entries,
#    the description itself is in "scruple" fields (below)
#   global: boolean
#   name
#   return (description) @ref expanded
#   type   (variable type or return type)
#   parameters: list of maps
#   signature => formatted name (and parameters) FIXME: filled only by html
#   since => version
#   see => list of "see" strings
#   scruple => [ name, "blahblah...\nblahhy" ] # will be <pre>'d, @ref expanded
#   example => "<pre>blahblah...</pre>"
#   short => short description, @ref expanded
#   descr => list of description paragraphs, @ref expanded
#   deprecated => what to use instead (or "magicnumber" if not specified)
#   stability => unstable (default) | stable, overrides the file global setting
# see string: one of
#   #item
#   file
#   file#item
#   <a href...>foo</a>

# parameters map:
#   name
#   type
#   description => @ref expanded


###
### parsing
###


# quick and dirty: warn about the previous line
my $pathname;
my $lines_read;
# 1:debug 2:hint 3:warning 4:error
my @kind = ("InTeRnAl", "Debug", "Hint", "Warning", "Error");
sub warning ($;$)
{
    my $text = shift;
    my $level = shift || 3;
    if ($level >= $warning_level)
    {
	printf(STDERR "$pathname: %d: $kind[$level]: $text\n", $lines_read-1);
    }
}

# convert a source file name to a form used as a key
sub base_source_name ($)
{
    my $source = shift;
    if ($strip_prefix ne "" && $source =~ s/^$strip_prefix//)
    {
	return $source;
    }
    else
    {
	return basename ($source);
    }
}

sub parse_sources ()
{
    $g->{"intro_html"} = "";
    tie %{$g->{files}}, "file";
    foreach my $source (@sources)
    {
	print STDERR "Parsing $source\n";
	my $b = base_source_name ($source);
	$g->{"files"}->{$b} = parse_file ($source);
    }
}

# see scanner.ll and parser.yy in libycp
# (?:foo) makes a grouping but not a backreference as (foo) does

# like "[[:alpha:]_][[:alnum:]_]*" except a single _
my $ycp_symbol = "(?:[[:alpha:]_][[:alnum:]_]+|[[:alpha:]][[:alnum:]_]*)";
my $ycp_quad = "(?:::)";
my $ycp_qualified_symbol = "(?:$ycp_quad?$ycp_symbol(?:$ycp_quad$ycp_symbol)*)";

my $ycp_simple_type = "(?:any|void|boolean|integer|float|string|byteblock"
    . "|list|map"		# _syntactically_ simple types
    . "|${ycp_symbol}_t"	# if it ends with _t, it is a type
    . "|locale|term|path|block|declaration|symbol)";

sub recursive_type ($)
{
    my $t = shift;
    return qr{(?:
     list  \s* <  \s* $t \s* >
    |block \s* <  \s* $t \s* >
    |map   \s* <  \s* $t \s* , \s* $t \s* >
    | $t	# must come last otherwise "list<foo>" would not
		# be parsed because of "list"
      (?!\w)    # (negative lookahead, man perlre)
		# Do not match "listmap", #133662
    )}x;
}

#3 levels of type nesting
my $ycp_typedecl =
    recursive_type (recursive_type (recursive_type ($ycp_simple_type)));

# Matches any string not containing '*/'.
# Helpful for the line-oriented parser not to slurp everything when it
# sees /*****/
my $no_comment_end = '(?:[^*]|\*[^*/])*';

##
## read file
##
sub parse_file ($)
{
    $pathname = shift;
    return {} if $pathname !~ /\.ycp$/;	# dummy for a non-ycp

    my $state = "firstline"; # aftercomment, fistcomment, firstline, incomment, intro, start,

    my $f = {};
    tie @{$f->{"provides"}}, "provides";
    tie @{$f->{"requires"}}, "requires";

    my @header_lines = ();	# list of header lines (first /** */)

    my @comments = (); # list of comment lines (presumably before a define)
    my $isglobal = 0;
    my $declared_type = "";
    my $name = "";
    my $params = "";
    my $shipout = 0; # 1 when we got a comment and optionally a define


    $lines_read = 0;
    open(INYCP, $pathname) or die "Cannot open file $pathname: $!";
    while (<INYCP>)
    {
	$lines_read = $lines_read + 1;
	if ($show_state) {
	    print STDERR "--$state\n";
	    print STDERR $_;
	}
	chomp;

	if ("aftercomment" eq $state)
	{
	    # function definition
	    if (/^\s*(global\s+)?(?:define\s+)?($ycp_typedecl)\s*($ycp_qualified_symbol)(\s*\(.*)/o)
	    {
		$isglobal = defined $1;
		$declared_type = $2 || "";
		$name = $3;
		$params = $4;
		if ($params =~ s/(;|(``)?\{).*//)
		{
		    $state = "start";
		    $shipout = 1;
		}
		else
		{
		    $state = "longdefine";
		}
	    }
	    # variable declaration
	    elsif (/^\s*(global\s+)?($ycp_typedecl)\s*($ycp_qualified_symbol)\s*=/o)
	    {
		  $isglobal = defined $1;
		  $declared_type = $2;
		  $name = $3;

		  $state = "start";
		  $shipout = 1;
	    }
	    elsif( /^\s*$/ )
	    {
		# allow empty lines between comment and declaration
	    }
	    else
	    {
		#info
		# ship out
		$state = "start";
		$shipout = 1;
	    }
	}
	elsif ($state eq "longdefine")
	{
	    if (s/(;|(``)?\{).*//)
	    {
		$state = "start";
		$shipout = 1;
	    }
	    $params .= $_;
	}
	elsif ($state eq "firstline")
	{
	    # skip empty lines, enter firstcomment or start
	    if(/^\s*\/\*\*\s*$/)
	    {
		$state = "firstcomment";
	    }
	    elsif ($_ ne "")
	    {
		$state = "start";
	    }
	}
	elsif ($state eq "firstcomment")
	{
	    if(/\*\//)
	    {
		$state = "start";
	    }
	    else
	    {
		s/^\s*\*//; # remove leading whitespace with asterisk
		push (@header_lines, $_);
	    }
	}
	elsif ($state eq "start")
	{
	    if(/^\s*\/\*\*\*\s*$/)
	    {
		$state = "intro";
		$g->{"intro_html"} .= "<!-- $pathname -->\n";
	    }

	    elsif(/^\s*\/\*\*\s*$/)
	    {
		$state = "incomment";
	    }
	    elsif (/^\s*(include|import)\s*\"([^\"]+)\"/) # "emacs
	    {
		my $req = { "kind" => $1, "name" => $2 };
		push (@{$f->{"requires"}}, $req);
	    }
	    elsif (/^\s*(module)\s*\"([^\"]+)\"/)
	    {
		my $prov = { "kind" => $1, "name" => $2 };
		push (@{$f->{"requires"}}, $prov);
	    }

	    # function, but not a declaration (;)
	    if (/^\s*(?:global\s+)?(?:define\s+)?(?:$ycp_typedecl)\s*(${ycp_qualified_symbol})\s*\([^;]*$/o)
	    {
		warning ("Function $1 has no comment.");
	    }
	}
	elsif ("incomment" eq $state)
	{
	    if (/\*\//)
	    {
		$state = "aftercomment";
	    }
	    else
	    {
		s/^\s*\*//;	# remove leading whitespace with asterisk
		push @comments, $_;
	    }
	}
	elsif ("intro" eq $state)
	{
	    if (/\*\//)
	    {
		$state = "start";
	    }
	    else
	    {
		# remove * from the beg. of line if there is any.
		s/^\s*\*//;
		$g->{"intro_html"} .= "$_\n";
	    }
	}

	if(0!=$shipout)
	{
	    push (@{$f->{"provides"}}, do_shipout (base_source_name ($pathname), $isglobal, $declared_type, $name, $params, @comments));
	    $shipout = 0;
	    $isglobal = 0;
	    $declared_type = "";
	    $name = "";
	    $params = "";
	    @comments = ();
	}
    }
    close(INYCP);

    $f->{"header"} = parse_header (@header_lines);
    return $f;
}

# parse_entry
# returns one entry, or, if there are scruples, a list of them!
sub do_shipout ($$$$$@)
{
    # file name,
    my ($file, $isglobal, $declared_type, $name, $params, @comments) = @_;

    my $entry = {};
    $entry->{"file"} = $file;
    $entry->{"name"} = $name;
    $entry->{"global"} = $isglobal;
    $entry->{"return"} = "";
    $entry->{"type"} = "";
    $entry->{"signature"} = ""; #TODO better place
    $entry->{"parameters"} = [];
    tie @{$entry->{"parameters"}}, "parameters";
    $entry->{"since"} = "";
    $entry->{"example"} = "";
    $entry->{"screenshot"} = "";
    $entry->{"example_file"} = [];
    tie @{$entry->{"example_file"}}, "example_file";
    $entry->{"scruple"} = [];
    $entry->{"see"} = [];
    tie @{$entry->{"see"}}, "see";
    $entry->{"short"} = "";
    $entry->{"descr"} = [];
    tie @{$entry->{"descr"}}, "descr";
    $entry->{"deprecated"} = "";
    my @entries = ($entry);

    my %param_infunc;	# (declared) parameter names, keyed by themselves
    my %param_incomment; # parameter descriptions

    my @parameters = ();

    if ($name eq "")
    {
	$entry->{"kind"} = "info";
    }
    elsif ($params eq "")
    {
	$entry->{"kind"} = "variable";
    }
    else
    {
	my $ok;
	$entry->{"kind"} = "function";
	# just the things inside parens
	$ok = ($params =~ s/^\s*\(\s*(.*)\s*\)\s*$/$1/);
	warn "No parentheses? '$params'" unless $ok;

	my $last_comma = ',';
	while ($params =~ m/\G\s*($ycp_typedecl\s*?\&?)\s*($ycp_symbol)\s*(,?)/ogc)
	{
	    warn "Missing comma before '$1 $2'" unless $last_comma;
	    $last_comma = $3;
	    # later: "description"
	    push @parameters, { "name" => $2, "type" => $1 };
	    $param_infunc{$2} = $2;
	}
	$params =~ m/\G(.*)/;
	warn "Bad parameter? '$1'" unless $1 eq "";
    }

    my $last_param;
    my $documented_type = "";
    my $para = "";		# paragraph. collects description lines
    my $lastwas = "";
    my $addto;			# reference to a string var
    foreach my $line (@comments)
    {
	my $line_is_blank = ($line =~ /^\s*$/);

	my ($tag, $spaces, $arg) = ("", "", "");
	if ($line =~ /^\s*\@(\S+)(\s*)(.*)/ && $1 ne "ref")
	    # ref is an inline tag so it does not count here
	{
	    ($tag, $spaces, $arg) = ($1, $2, $3);
	    $lastwas = $tag;
	}

	# "@tag:" == "@tag"
	# better to include a wrong tag than nothing
	$tag =~ s/:$//;

	if ($tag eq "param" || $tag eq "params")
	{
	    $arg =~ /($ycp_symbol)\s*(.*)/o;
	    $last_param = $1;
	    $addto = \ $param_incomment{$last_param};
	    $$addto = almost_html ($2);
	}
	elsif ($tag eq "return" || $tag eq "returns")
	{
	    $arg =~ /($ycp_typedecl)?\s*(.*)/o;
	    $documented_type = $1 || "";
	    $addto = \ $entry->{"return"};
	    $$addto = almost_html ($2);
	}
	elsif ($tag eq "since")
	{
	    $entry->{$tag} = almost_html ($arg);
	    $addto = undef;
	}
	elsif ($tag eq "see")
	{
	    # Simply copy it to the see list and let the backend do the work.
	    # Maybe do some syntax checks here?
	    push @{$entry->{$tag}}, $arg;
	    $addto = undef;
	}
	elsif ($tag eq "example_file")
	{
            push @{$entry->{$tag}}, $arg;
	    $addto = undef;
	}
	elsif ($tag eq "screenshot") # who uses this? nashif?
	{
	    $entry->{$tag} .= $arg;
	    $addto = undef;
	}
	elsif ($tag eq "example")
	{
	    $addto = \ $entry->{$tag};
	    $$addto .= almost_html ("\n$spaces$arg");
	}
	elsif ($tag eq "deprecated")
	{
	    $arg ||= "magicnumber";
	    $entry->{$tag} .= almost_html ($arg);
	    $addto = undef;
	}
	elsif ($tag eq "stable" || $tag eq "unstable")
	{
	    $entry->{stability} = $tag;
	    $addto = undef;
	}
	elsif ($tag eq "internal")
	{
	    $entry->{internal} = 1;
	    $addto = undef;
	}
	elsif ($tag eq "struct" || $tag eq "tuple")
	{
	    $tag = $lastwas = "scruple";
	    $entry->{$tag} = [$arg, ""];
	    $addto = \ $entry->{$tag}->[1];
	    push @entries, {"kind" => "scruple", "name" => $arg,
			    "signature" => $arg, "file" => $file};
	}
	elsif ($tag eq "short")
	{
	    $addto = \ $entry->{$tag};
	    $$addto = almost_html ($arg);
	}
	elsif ($tag eq "descr")
	{
            $para .= almost_html("\n$arg");
	    # ? addto
	}
	#
	elsif ($tag ne "")
	{
	    warning ("Unknown tag \@$tag");
	}
	elsif ($lastwas eq "short" && !$line_is_blank)
        {
	    $$addto .= almost_html ("\n$line");
        }
	# descr may be separated from short by an empty line
	elsif ($lastwas eq "short" || $lastwas eq "descr")
	{
            $lastwas = "descr";
            if ($line_is_blank)
            { 
                if ($para ne "")
                {
		    push @{$entry->{"descr"}}, $para;
                }
                $para = "";
            }
            else 
            {
                $para .= almost_html("\n$line");
            }
	}
	elsif (defined $addto)
	{
	    $$addto .= almost_html ("\n$line");
	}
	# no tag so far = short description
	else
	{
            $lastwas = "short";
	    $addto = \ $entry->{"short"};
	    $$addto .= almost_html ("\n$line");
	}
    }
    $entry->{"type"} = $declared_type || $documented_type;


    # check arguments

    # for actual parameters: add description or warn
    foreach my $param_mapref (@parameters)
    {
	my $name = $param_mapref->{"name"};
	my $cmt = $param_incomment{$name} || "";
	$param_mapref->{"description"} = $cmt;
#	if ($cmt eq "")
#	{
#	    warning ("Parameter $name declared in function header but not documented.");
#	}
	}
    # for commented parameters: warn if no such actual parameter
    foreach my $key (sort keys %param_incomment)
    {
	my $descr = $param_incomment{$key};
	if (!defined ($param_infunc{$key})) {
	    if ($entry->{"kind"} eq "function")
	    {
#		warning ("Parameter $key documented but not declared in function header.");
	    }
	    else
	    {
		# info (oldmodule parameters (Args)): ad
		push @parameters, { "name" => $key, "description" => $descr };
	    }
	}
    }

    push @{$entry->{"parameters"}}, @parameters;


    if ($entry->{"kind"} eq "function")
    {
	if ($declared_type eq "")
	{
	    if ($warn_return_types)
	    {
		if ($documented_type eq "")
		{
		    warning ("Return type not specified.");
		}
		else
		{
		    warning ("It is better to declare the type in the code.", 2);
		}
	    }
	}
	else
	{
	    if ($documented_type)
	    {
		# remove wehitespace before comparing
		$documented_type =~ s/\s//g;
		$declared_type   =~ s/\s//g;
		if ($documented_type ne $declared_type)
		{
		    warning ("Declared and documented return types do not match ($declared_type != $documented_type).");
		}
	    }
	}

	if ($entry->{"return"} eq "" && $entry->{"type"} !~ /^(void)?$/) #/)
	{
	    warning ("Return value not documented.");
	}
    }

    return @entries;
}

##
## parse header (comment at the beginning of file)
##

#convert to
sub parse_header (@)
{
    my @lines = @_;

    my $parsed_header = {};
    $parsed_header->{"module"} = "";
    $parsed_header->{"authors"} = [];

    my $key = "descr";
    foreach my $a (@lines)
    {
	#TODO: warn on unknown key, missing field
	if ($a =~ s/^\s*(Module|Package|File|Summary|Depends|Authors|Author|Flags):\s*(.*)/$2/)
	{
	    $key = lc $1;
	    # Module is old style, Package is new style. TODO, define meaning
	    $key = "module" if $key eq "package";
	    # tag alias (bug #188881)
	    $key = "authors" if $key eq "author";
	}
	elsif ($a =~ /^\s*(Stable|Unstable)\./)
	{
	    $key = "stability";
	    $a = lc $1;
	}
	elsif ($a =~ /^\s*(Internal)\s*$/)
	{
	    $key = "internal";
	    $a = "1";
	}
	elsif ($a =~ /^\s*\$Id/)
	{
	    $a = "";
	    $key = "descr";	# Id marks the start of description
	}

	# processing tags
	if ( $key eq "authors")
	{
	    my $mail = $a;
	    $mail =~ s/[^<(]*[(<]([^>)]*).*/$1/g;
	     # $a =~ s/[(<][^>)]*[>)]/&lt;<a href=\"mailto:$mail\">$mail<\/a>&gt;/g; # "emacs

	    if ($a !~ /^\s*$/)
	    {
		push @{$parsed_header->{$key}}, $a;
	    }
	}
	else
	{
	    if ( $key eq "module" )
	    {
		$any_module ||= $a;
	    }

	    if (defined $parsed_header->{$key})
	    {
		$parsed_header->{$key} .= almost_html ("\n$a");
	    }
	    else
	    {
		$parsed_header->{$key} = almost_html ($a);
	    }
	}

    }
    return $parsed_header;
}

sub almost_html ($)
{
    my $text = shift;
    $text =~ s/\&(?![A-Za-z])/\&amp;/g; # negative lookahead
    $text =~  s:<(?![A-Za-z/]):\&lt;:g;
    #$text =~ s/([[:space:]-])>/$1\&gt;/g;
    return $text;
}


###
### writing
###

package xhtml;

sub new ($)
{
    my $class = shift;
    my ($fh) = @_;
    # DATA_*: insert whitespace automatically
    my $xw = new XML::Writer (OUTPUT => $fh, DATA_MODE => 1, DATA_INDENT => 1, UNSAFE => 1);
    $xw->xmlDecl ("UTF-8");
    $xw->doctype ("html",
		  "-//W3C//DTD XHTML 1.1//EN",
		  "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd");

    return bless { fh => $fh, xw => $xw }, $class;
}

sub bye
{
    my $self = shift;
    $self->{xw}->end ();
}

sub elem
{
    my $self = shift;
    $self->{xw}->startTag (@_);
}

sub close
{
    my $self = shift;
    $self->{xw}->endTag ();
}

sub char
{
    my $self = shift;
    $self->{xw}->characters (@_);
}

sub raw
{
    my $self = shift;
    $self->{xw}->raw (@_);
}

# Arg is an array ref containing either of:
# "-" and character data
# "tag name", optional attributes, nested Args
sub tree
{
    my $self = shift;
    my @elem = @{$_[0]};
    if ($elem[0] eq "-")	# character data
    {
	shift @elem;
	$self->char (@elem);
    }
    else
    {
	my ($i, @tag);
	while (defined ($i = shift @elem))
	{
	    last if (ref $i);
	    push (@tag, $i);
	}
	# now $i is undef and @elem empty or $i is a reference
	if (!defined ($i))
	{
	    $self->{xw}->emptyTag (@tag);
	}
	else
	{
	    $self->elem (@tag);
	    while (defined $i)
	    {
		if (ref ($i) eq "ARRAY")
		{
		    $self->tree ($i);
		}
#		elsif (ref ($i) eq "CODE")
#		{
#		    &$i;
#		}
		$i = shift @elem;
	    }
	    $self->close ();
	}
    }
}

sub h1
{
    my $self = shift;
    $self->elem ("h1");
    $self->char (@_);
    $self->close ();
}

sub link_t
{
    my $self = shift;
    my ($href, $text) = @_;
    return ["a", "href" => $href, ["-", $text]];
}

sub link
{
    my $self = shift;
    $self->tree ($self->link_t (@_));
}

package ycpdoc::HTML;

use IO qw(File);

my $css_style = <<'END';
body { background-color: #c8c8c8 }
h1 { color: #e00000 }
table { width: 100%/ border: none }
img { border: 0px }
.sigbox { background-color: #ffc080; border: solid thin #f96500 }
.sig { font: larger monospace }
.padtbl { background-color: #ffc080; padding: 10px; margin: 10px }
/* arrow */
.a { color: #606060 }
/* type, parameter */
.t, .p { color: #c05000 }
.pbox { width: 20% }
.descbox { }
.right { align: right }
.header {}
.footer { clear: both}
.menu { width: 10%; float: left }
.main { width: 90%; float: left }
END


sub make_menu ($)
{
    my ($O) = @_;
    $O->tree (["div", "class" => 'menu',
	       ["img", "alt" => 'YaST', "src" => '/usr/share/doc/packages/yast2-devtools/images/yast2-half.png'],
	       ["br"], ["br"],
	       $O->link_t ("index.html", "functions"),
	       ["br"],
	       $O->link_t ("files.html", "files"),
	       ["br"],
	       $O->link_t ("intro.html", "intro"),
	       ]);
}

sub make_intro ($$$)
{
    my ($O, $module_name, $make_links) = @_;
    # doc elem
    $O->elem ("html");
    $O->tree (["head",
	       ["title", ["-", $module_name]],
	       ["style", "type" => 'text/css', ["-", $css_style]]
	      ]);
    $O->elem ("body");
    $O->tree (["div", "class", 'header',
	       ["i", ["-", "YaST2 Developers Documentation:"]],
	       ["a", "href", 'index.html',
		["b", ["-", $module_name]]
		],
	       ["img", "class", 'right', "alt", '', "src", '/usr/share/doc/packages/yast2-devtools/images/yast2-mini.png'],
	       ["hr"],
	       ]);
    make_menu ($O) if ($make_links);
    $O->elem ("div", "class", 'main');
}

sub make_outro ($)
{
    my ($O) = @_;
    $O->close (); #div.main
#    $O->{xw}->comment ("page footer");
    $O->tree (["div", class => 'footer',
	       ["hr"],
	       ["i", ["-", "YaST2 Developers Documentation"]],
	       ["img", class => 'right', alt => '', src => '/usr/share/doc/packages/yast2-devtools/images/yast2-mini.png'],
	       ]);
#    $O->{xw}->comment ("the end");
    $O->close ("body");
    $O->close ("html");
}

sub make_generic ($$$$)
{
    my ($O, $title, $text, $format) = @_;

    $O->elem ("dl");
    $O->tree (["dt", ["b", ["-", $title]]]);
    $O->elem ("dd");
    $O->elem ("table");
    $O->elem ("tr");
    $O->elem ("td", align => 'left', valign => 'top');
    if ($format eq "HTML")
    {
	$O->raw ($text);
    }
    else
    {
	$O->char ($text);
    }
    $O->close ("td");
    $O->close ("tr");
    $O->close ("table");
    $O->close ("dd");
    $O->close ("dl");
}

##
##
##

##
## process files, create output files and possibly index.html
##
sub write_docs
{
    while (my ($file, $f) = each %{$g->{"files"}})
    {
	write_onefile ($file, $f);
    }

    if (!$output_stdout && !$skip_index)
    {
	create_index ($new_index_style);
    }
}

# make an output file name from a base_source_name, not including output_dir
sub html_name ($)
{
    my $base = shift;
    $base =~ s/.(ycp|pm)$//;
    $base =~ s{/}{__}g;
    return $base . ".html";
}

##
## create index.html
##
sub create_index ($)
{
    my ($new) = @_;

    my $index = $output_dir."index.html";
    print STDERR "Writing $index\n";
    my $OUT = new IO::File(">$index") or die "Cannot open file $index: $!";
    my $O = new xhtml ($OUT);

    make_intro ($O, $any_module, $new);
    $O->tree (["h3", ["-", "Function index:"]]);
    $O->elem ("table", "class", 'funcidx');
    $O->tree (["tr",
	       ["th", ["-", "Function name"]],
	       ["th", ["-", "File name"]],
	      ]);

    my @entries = ();
    foreach my $f (values %{$g->{"files"}})
    {
	push @entries, @{$f->{"provides"} || []};
    }

    for my $one ( sort {$a->{"signature"} cmp $b->{"signature"}} @entries )
    {
	if($one->{"kind"} ne "info")
	{
	    my $hfile = html_name ($one->{"file"});
	    $O->tree(["tr",
		      ["td",
		       $O->link_t ($hfile ."#". $one->{"name"}, $one->{"signature"}),
		      ],
		      ["td",
		       $O->link_t ($hfile, $one->{"file"}),
		      ]
		     ]);
	}
    }
    $O->close ("table");

    # files.html, or into index.html
    my ($FO, $FOUT);
    if ($new)
    {
	$index = $output_dir."files.html";

	print STDERR "Writing $index\n";
	$FOUT = new IO::File(">$index") or die "Cannot open file $index: $!";
	$FO = new xhtml ($FOUT);
	make_intro ($FO, $any_module, 1);
    }
    else
    {
	$FOUT = new IO::File;
	$FO = $O;
    }

    $FO->tree (["h3", ["-", "File index:"]]);
    $FO->elem ("table", "class", 'fileidx');
    $FO->tree (["tr",
		["th", ["-", "File name"]],
	       ]);
    for ( sort keys %{$g->{"files"}} )
    {
	$FO->tree(["tr",
		   ["td",
		    $O->link_t (html_name ($_), $_)
		   ]
		  ]);
    }
    $FO->close ("table");
    if ($new)
    {
	make_outro ($FO);
	$FO->bye ();
	$FOUT->close ();
    }

    make_outro ($O);
    $O->bye ();
    $OUT->close ();

    # intro.html
    if ($new)
    {
	$index = $output_dir."intro.html";

	print STDERR "Writing $index\n";
	my $IOUT = new IO::File(">$index") or die "Cannot open file $index: $!";
	my $IO = new xhtml ($IOUT);
	make_intro ($IO, $any_module, 1);

	$IO->tree (["h3", ["-", "Introduction:"]]);
	print $IOUT $g->{"intro_html"};

	make_outro ($IO);
	$IO->bye ();
	$IOUT->close ();
    }
}

sub item_list ($$@)
{
    my ($O, $title, @items) = @_;
    if (@items > 0)
    {
	$O->h1 ($title);
	$O->elem ("ul");
	for my $one ( sort @items )
	{
	    $O->elem ("li");
	    $O->char ($one);
	    $O->close ();
	}
	$O->close ();
    }
}

# items are [$href, $text]
sub item_index ($$@)
{
    my ($O, $title, @items) = @_;
    if (@items > 0)
    {
	$O->h1 ($title);
	$O->elem ("ul");
	for my $one ( sort { $a->[0] cmp $b->[0] } @items )
	{
	    $O->elem ("li");
	    $O->link ($one->[0], $one->[1]);
	    $O->close ();
	}
	$O->close ();
    }
}

##
## write one html file (both header and functions)
##
sub write_onefile ($$)
{
    my ($file, $f) = @_;
    return if ! %$f; 		# empty, a dummy for non-ycp

    my $parsed_header = $f->{"header"};
    my $htmlfn = $output_dir . html_name ($file);

    my $OUT;
    if ( $output_stdout )
    {
	$OUT = new_from_fd IO::Handle (1, "wa");
    }
    else
    {
	print STDERR "Writing $htmlfn\n";
	$OUT = new IO::File(">$htmlfn") or die "Cannot open file $htmlfn: $!";
    }
    my $O = new xhtml ($OUT);

    $parsed_header->{"module"} ||= "Unknown YCP Module";
    make_intro ($O, $parsed_header->{"module"}, $new_index_style);

    #
    # create header
    #

    # headintro
    $O->elem ("div", "class" => 'sigbox');
    $O->elem ("table", "class" => 'padtbl');

    $O->elem ("tr");
    $O->tree (["td",
	       ["h1", ["-", $parsed_header->{module}]]
	      ]);
    if ( defined $parsed_header->{"file"} )
    {
	$O->tree (["td", "class", "filecell",
		   ["-", $parsed_header->{file}]
		  ]);
    }
    $O->close ("tr");

    $O->elem ("tr");
    $O->elem ("td");
    if( defined $parsed_header->{"summary"} )
    {
	# HTML
	print $OUT "$parsed_header->{summary}";
    }
    $O->close ("td");
    $O->close ("tr");

    $O->elem ("tr");
    $O->elem ("td");
    if ( @{$parsed_header->{"authors"}} )
    {
	$O->elem ("ul");
	foreach ( @{$parsed_header->{"authors"}} )
	{
	    $O->elem ("li");
	    print $OUT $_;
	    $O->close ();
	}
	$O->close ("ul");
    }
    $O->close ("td");
    $O->close ("tr");

    $O->elem ("tr");
    $O->elem ("td");

    my $stability = $parsed_header->{stability} || "unstable";
    if ($stability eq "unstable")
    {
	$O->tree (["p", ["-", "This module has an unstable interface."]]);
    }

    my $internal = $parsed_header->{internal} || "0";
    if ($internal)
    {
	$O->tree (["p", ["-", "This module is for internal use only."]]);
    }

    #TODO maybe add something about "stable"
    $O->close ("td");
    $O->close ("tr");

    $O->close ("table", "class" => 'padtbl');

    $O->elem ("table", "class" => 'padtbl');
    $O->elem ("tr");
    $O->elem ("td");
    if ( defined $parsed_header->{"descr"} )
    {
	# TODO HTML?
	print $OUT "$parsed_header->{descr}\n";
    }

    if ( defined $parsed_header->{"depends"} )
    {
	$O->h1 ("Depends on");
	$O->char ($parsed_header->{depends});
    }

    #
    # Create include index
    #
    my @imports = ();
    my @includes = ();

    for my $one (@{$f->{"requires"}})
    {
	if ($one->{"kind"} eq "import")
	{
	    push (@imports, $one->{"name"});
	}
	elsif ($one->{"kind"} eq "include")
	{
	    push (@includes, $one->{"name"});
	}
	elsif ($one->{"kind"} eq "module" && !$output_stdout)
	{
	    my $n = $one->{"name"};
	    # a hack to write a part of module index:
	    (my $modhtmlfn = $htmlfn) =~ s/html$/mod.html/;
	    (my $htmlbase = $htmlfn) =~ s{.*/}{};
	    print STDERR "Writing $modhtmlfn\n";
	    open (MOUT,">$modhtmlfn") or die "Cannot open file $modhtmlfn: $!";
	    print MOUT "<a href=\"$htmlbase\">$n</a>\n";
	    close (MOUT);
	}
    }


    item_list ($O, "Imports", @imports);
    item_list ($O, "Includes", @includes);

    #
    # Create variable and function index
    #
    my @global_variables = ();
    my @global_functions = ();
    my @local_variables = ();
    my @local_functions = ();
    my @scruples = ();

    for my $one ( @{$f->{"provides"}} )
    {
	if ($one->{"kind"} eq "variable" || $one->{"kind"} eq "scruple")
	{
	    my $n = $one->{"name"};
	    my $item = ["#$n", $n];
	    if ($one->{"kind"} eq "scruple")
	    {
		push (@scruples, $item);
	    }
	    elsif ($one->{"global"})
	    {
		push (@global_variables, $item);
	    }
	    else
	    {
		push (@local_variables, $item);
	    }
	}
	elsif ($one->{"kind"} eq "function")
	{
	    my $n = $one->{"name"};
	    my @params = ();
	    foreach my $param (@{$one->{"parameters"}})
	    {
		push (@params, $param->{"type"}." ".$param->{"name"});
	    }
	    # why put back?
	    $one->{"signature"} = $n ." (". join (", ", @params) .")";
	    my $item = ["#$n", $one->{"signature"}];
	    if ($one->{"global"})
	    {
		push (@global_functions, $item);
	    }
	    else
	    {
		push (@local_functions, $item);
	    }
	}
    }

    item_index ($O, "Structures", @scruples);
    item_index ($O, "Global Variables", @global_variables);
    item_index ($O, "Global Functions", @global_functions);
    item_index ($O, "Local Variables", @local_variables);
    item_index ($O, "Local Functions", @local_functions);

    # headoutro
    $O->close ("td");
    $O->close ("tr");
    $O->close ("table", class => 'padtbl');

    $O->close ("div", class => 'sigbox');

    # space after the index box
    $O->tree (["p"]);

    #
    # for each export...
    #
    for my $one ( @{$f->{"provides"}} )
    {
	# skip scruple stubs
	next if ($one->{"kind"} eq "scruple");

	if($one->{"kind"} eq "info")
	{
	    # if we did not print the header, the info text could be
	    # mistaken to belong to another function
	    $O->tree (["div", class => 'sigbox',
		       ["-", "Info:"]
		      ]);
	}
	else
	{
	    # functionhead
	    my $gl = $one->{"global"} ? "global":"local";
	    $one->{"signature"} ||= $one->{"name"};
	    my $sep = $one->{"type"} ? "->" : "";
	    $O->tree (["div", class => 'sigbox',
		       ["span", class => 'sig', id => $one->{name},
			["-", $gl, " "],
			["b",
			 ["-", $one->{signature}],
			 ["span", class => 'a', ["-", " $sep "]],
			 ["span", class => 't', ["-", $one->{type}]],
			],
		       ],
		      ]);
	}

	if ($one->{"deprecated"} ne "")
	{
	    $O->elem ("p");
	    $O->elem ("em");
	    $O->char ("This function is deprecated.");
	    if( $one->{"deprecated"} ne "magicnumber" )
	    {
		$O->char (" Use ");
		# TODO HTML (subst_refs...)
		$O->raw (make_ahref ($one->{"deprecated"}));
		$O->char (" instead.");
	    }
	    $O->close ("em");
	    $O->close ("p");
	}

	#functiondesc
	$O->elem ("p");
	#TODO HTML
	$O->raw (subst_refs ($one->{short}));
	$O->close ("p");
        foreach my $para (@{$one->{descr}})
        {
	    $O->elem ("p");
	    #TODO HTML. no subst refs?
	    $O->raw ($para);
	    $O->close ("p");
        }

	if (@{$one->{"scruple"}} == 2)
	{
	    $O->tree (["p",
		       ["-", "Structure "],
		       ["b",
			["a", id => $one->{scruple}->[0],
			 ["-", $one->{scruple}->[0]]
			]
		       ]
		      ]);
	    $O->tree (["pre",
		       ["-", subst_refs ($one->{scruple}->[1])]
		      ]);
	}

	if (@{$one->{"parameters"}} > 0)
	{
	    #functionparams
	    $O->elem ("dl");
	    $O->tree (["dt", ["b", ["-", "Parameters:"]]]);
	    $O->elem ("dd");
	    $O->elem ("table");
	    foreach my $param (@{$one->{"parameters"}})
	    {
		$O->elem ("tr");
		$O->tree (["td", class => 'pbox',
			   ["span", class => 'p',
			    ["-", $param->{name}]
			   ]
			  ]);
		$O->elem ("td", class => 'descbox');
		#TODO HTML
		$O->raw (subst_refs ($param->{description}));
		$O->close ();
		$O->close ("tr");
	    }
	    $O->close ("table");
	    $O->close ("dd");
	    $O->close ("dl");
	}
	if ($one->{"return"} ne "")
	{
	    #functionret
	    $O->elem ("dl");
	    $O->tree (["dt", ["b", ["-", "Return value:"]]]);
	    $O->elem ("dd");
	    $O->elem ("table");
	    {
		$O->elem ("tr");
		$O->tree (["td", class => 'pbox',
			   ["span", class => 't',
# uncomment this to see return type in Returns:
#			    ["-", $one->{type}]
			   ]
			  ]);
		$O->elem ("td", class => 'descbox');
		#TODO HTML
		$O->raw (subst_refs ($one->{return}));
		$O->close ();
		$O->close ("tr");
	    }
	    $O->close ("table");
	    $O->close ("dd");
	    $O->close ("dl");
	}

	if ($one->{"example"} ne "")
	{
	    make_generic ($O, "Example", '<pre>'. $one->{example} .'</pre>', "HTML");
	}
	if ($one->{"since"} ne "")
	{
	    make_generic ($O, "Since", $one->{since}, "TXT");
	}
	if (@{$one->{"see"}} > 0)
	{
	    make_generic ($O, "See",
			  join ("\n", map {make_ahref ($_)} @{$one->{"see"}}),
			  "HTML");
	}
    }

    make_outro ($O);
    $O->bye ();
    $OUT->close ();
}

sub subst_refs ($)
{
    $_[0] =~ s/\@ref\s+(\S+)/make_ahref($1)/eg;
    return $_[0];
}

sub make_ahref ($)
{
    my $see = shift;
    my $out;
    # <...
    # HTML ref.
    if ($see =~ /^</)
    {
	$out = $see;
    }
    # file#
    # ref. to file without function
    elsif ($see =~ /(.*)\#$/)
    {
	$out = "<a href=\"".html_name($1)."\">".$1."</a>";
    }
    # file#item
    elsif ($see =~ /(\S+)\#(.*)/)
    {
	$out = "<a href=\"".html_name($1)."#".$2."\">".$2." in ".$1."</a>";
    }
    # #item
    # item
    else
    {
	$see =~ /\#?(.*)/;
	$out = "<a href=\"#$1\">$1</a>";
    }
    return $out;
}


package ycpdoc::XML;

use IO qw(File);

my $writer;

sub write_docs
{
    my $output = new IO::File(">$xml_output") or die "Cannot open file $xml_output: $!";
    $writer = new XML::Writer (OUTPUT => $output, NEWLINES => 1);
    $writer->xmlDecl ("UTF-8");
    $writer->startTag ("ycpdoc");
    dump_data ($g);
    $writer->endTag ();
    $writer->end ();
    $output->close ();
}

sub dump_data
{
    my $node = shift;

    if (!ref ($node))
    {
	$writer->characters ($node);
    }
    elsif (ref ($node) eq "ARRAY")
    {
	my $t = tied(@{$node});
	foreach (@{$node})
	{
	    my $end = 1;
	    if (defined ($t))
	    {
		$writer->startTag (ref ($t)."_item");
	    }
	    elsif (!ref ($_))
	    {
		$writer->startTag ("ITEM");
	    }
	    else
	    {
		$end = 0;
	    }
	    dump_data ($_);
	    if ($end)
	    {
		$writer->endTag ();
	    }
	}
    }
    elsif (ref ($node) eq "HASH")
    {
	my $t = tied(%{$node});
	foreach (sort keys %{$node})
	{
	    next if (!defined $node->{$_} || $node->{$_} eq "");
	    if (defined ($t))
	    {
		$writer->startTag (ref ($t)."_item", "key" => $_);
	    }
	    else
	    {
		$writer->startTag ($_);
	    }
	    dump_data ($node->{$_});
	    $writer->endTag ();
	}
    }
    else
    {
	$writer->comment (ref($node));
    }
}

package file;
@file::ISA = ("Tie::StdHash");

package requires;
@requires::ISA = ("Tie::StdArray");

package provides;
@provides::ISA = ("Tie::StdArray");

package descr;
@descr::ISA = ("Tie::StdArray");

package example_file;
@example_file::ISA = ("Tie::StdArray");
package parameters;
@parameters::ISA = ("Tie::StdArray");

package see;
@see::ISA = ("Tie::StdArray");

package main;
main ();
