Fix gerror handling
* Added code to be enabled in future, when
lm_connection_unregister_reply_handler will
be officially avaliable.
* Do g_error_free
#! /usr/bin/perl
# Copyright 2009 Myhailo Danylenko
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
my %docs;
my @tags;
my $inside;
my $harvest;
my @values;
foreach my $file (@ARGV) {
if ( not open SOURCE, '<', $file ) {
print STDERR "Cannot open $file\n";
next;
}
my $chunk = 0;
while (<SOURCE>) {
if ( $inside ) {
if ( not /^\/\/\// ) {
$inside = 0;
$chunk++;
} elsif ( /^\/\/\/ G:/ ) {
$inside = 0;
$harvest = 'V: ' . substr ( $_, 6 );
} else {
push @{$docs{$file}[$chunk]}, substr ( $_, 4 );
}
} elsif ( $harvest ) {
if ( /\{\s*NULL.*\}/ ) {
push @{$docs{$file}[$chunk]}, $harvest . ' ' . join ( ', ', @values );
$harvest = undef;
@values = ();
$chunk++;
} elsif ( /\{\s*"(.+)".*\}/ ) {
push @values, $1;
}
} else {
next if not /^\/\/\//;
$inside = 1;
my $tag = substr $_, 4;
chomp $tag;
push @{$docs{$file}[$chunk]}, $tag;
# hack to allow twoword objects be written in text with spaces
# now it matches "lm message" instead of "lm message node" -.-
# and even if tag list will be reverse sorted by length,
# it will produce nested links...
# well, that all is now solved, but in not too impressive way..
$tag =~ s/_/./g;
push @tags, $tag;
}
}
close SOURCE;
}
print <<HEADER
<html>
<head><title>lua-loudmouth docs</title></head>
<body>
HEADER
;
@tags = reverse sort { length $a <=> length $b } @tags;
# TODO preserve original order
foreach my $file ( sort keys %docs ) {
print "<hr>";
foreach my $chunk ( @{$docs{$file}} ) {
my $head = shift @$chunk;
my $tag = $head;
my $list = undef;
$tag =~ s/_/./g;
print "<a name='$tag'></a><h2>$head</h2><p>";
foreach ( @$chunk ) {
s/^A: /<br\/>Arguments: /;
s/^R: /<br\/>Return values: /;
s/^V: /<br\/>Values: /;
s/^\[ /<br\/><pre>/;
s/^\]/<\/pre><br\/>/;
if ( $list ) {
if ( /^\* / ) {
s/^\* /<\/li><li>/;
} else {
s/^/<\/li><\/ul> /;
$list = undef;
}
} elsif ( /^\* / ) {
s/^\* /<ul><li>/;
$list = 1;
}
foreach my $tag ( @tags ) {
# TODO quotemeta required, but for now
# this bug is rather desired...
#s/\b$tag\b/<a href="#$tag">$&<\/a>/g;
s/(.)\b($tag)\b/ if ( $1 eq '#' or $1 eq '>' ) { "$1$2" } else { "$1<a href='#$tag'>$2<\/a>" } /ge;
}
print $_;
}
print "</li></ul>" if $list;
print "</p>"
}
print "<hr>";
}
print "</body></html>"
# The end