--- deliantra/Deliantra-Client/DC/Pod.pm 2006/07/23 16:11:12 1.1 +++ deliantra/Deliantra-Client/DC/Pod.pm 2007/12/26 21:03:21 1.17 @@ -1,217 +1,179 @@ -package CFClient::Pod; +package DC::Pod; use strict; +use utf8; -use Pod::POM; +use Storable; -use CFClient; -use CFClient::UI; +our $VERSION = 1.03; -our $VERSION = 1; # bump if resultant formatting changes +our $goto_document = sub { }; +our %wiki; -our @result; -our $indent; +my $MA_BEG = "\x{fcd0}"; +my $MA_SEP = "\x{fcd1}"; +my $MA_END = "\x{fcd2}"; -package CFClient::Pod::AsXML; +*wiki = Storable::retrieve DC::find_rcfile "docwiki.pst"; -use strict; +sub goto_document($) { + $goto_document->(split /\//, $_[0]); +} -use base "Pod::POM::View::Text"; +sub is_prefix_of($@) { + my ($node, @path) = @_; -*view_seq_code = -*view_seq_bold = sub { "$_[1]" }; -*view_seq_italic = sub { "$_[1]" }; -*view_seq_space = -*view_seq_link = -*view_seq_index = sub { CFClient::asxml $_[1] }; + return 1 unless @path; -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::asxml $text -} + my $kw = lc pop @path; -sub view_item { - ("\t" x ($indent / 4)) - . $_[1]->title->present ($_[0]) - . "\n\n" - . $_[1]->content->present ($_[0]) -} + $node = $node->{parent} + or return 0; -sub view_verbatim { - (join "", - map +("\t" x ($indent / 2)) . "$_\n", - split /\n/, CFClient::asxml $_[1]) - . "\n" + return ! ! grep $_ eq $kw, @{ $node->{kw} }; } -sub view_textblock { - ("\t" x ($indent / 2)) . "$_[1]\n\n" -} +sub find(@) { + my (@path) = @_; -sub view_head1 { - "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + return unless @path; -sub view_head2 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + my $kw = lc pop @path; -sub view_head3 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + # TODO: make sure results are unique -sub view_over { - local $indent = $indent + $_[1]->indent; - $_[1]->content->present ($_[0]) + grep { is_prefix_of $_, @path } + map @$_, + $kw eq "*" ? @wiki{sort keys %wiki} + : $wiki{$kw} || () } -package CFClient::Pod::AsParagraphs; +sub full_path_of($) { + my ($node) = @_; -use strict; + my @path; -use base "Pod::POM::View"; - -*view_seq_code = -*view_seq_bold = sub { "$_[1]" }; -*view_seq_italic = sub { "$_[1]" }; -*view_seq_space = -*view_seq_link = -*view_seq_index = sub { CFClient::asxml $_[1] }; - -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::asxml $text -} - -sub view_item { - push @result, { - indent => $indent * 8, - text => $_[1]->title->present ($_[0]) . "\n\n", - }; - $_[1]->content->present ($_[0]); - () -} - -sub view_verbatim { - push @result, { - indent => $indent * 16, - text => "" . (CFClient::asxml $_[1]) . "", - }; - () -} - -sub view_textblock { - push @result, { - indent => $indent * 16, - text => "$_[1]\n", - }; - () -} - -sub view_head1 { - push @result, { - indent => $indent * 16, - text => "\n\n" . $_[1]->title->present ($_[0]) . "\n", - }; - $_[1]->content->present ($_[0]); - () -}; - -sub view_head2 { - push @result, { - indent => $indent * 16, - text => "\n\n" . $_[1]->title->present ($_[0]) . "\n", - }; - $_[1]->content->present ($_[0]); - () -}; - -sub view_head3 { - push @result, { - indent => $indent * 16, - text => "\n\n" . $_[1]->title->present ($_[0]) . "\n", - }; - $_[1]->content->present ($_[0]); - () -}; - -sub view_over { - local $indent = $indent + $_[1]->indent; - push @result, { indent => $indent }; - $_[1]->content->present ($_[0]); - () -} - -sub view_for { - if ($_[1]->format eq "image") { - push @result, { - indent => $indent * 16, - text => "\x{fffc}", - obj => [new CFClient::UI::Image path => "pod/" . $_[1]->text], - }; + # skip toplevel hierarchy pod/, because its not a document + while ($node->{parent}) { + unshift @path, $node; + $node = $node->{parent}; } - () -} -sub view { - my ($self, $type, $item) = @_; + @path +} - $item->content->present ($self); +sub full_path($) { + join "/", map $_->{kw}[0], &full_path_of } -package CFClient::Pod; +sub section_of($) { + my ($node) = @_; + + my $doc = $node->{doc}; + my $par = $node->{par}; + my $lvl = $node->{level}; + + my @res; -my $pod_cache = CFClient::db_table "pod_cache"; + do { + my $p = $doc->[$par]; -sub load($$$$) { - my ($path, $filtertype, $filterversion, $filtercb) = @_; + if (length $p->{markup}) { + push @res, { + markup => $p->{markup}, + indent => $p->{indent}, + }; + } + } while $doc->[++$par]{level} > $lvl; - stat $path - or die "$path: $!"; + @res +} + +sub section(@) { + map section_of $_, &find +} - my $phash = join ",", $filterversion, $VERSION, (stat _)[7,9]; +sub thaw_section(\@\%) { + for (@{$_[0]}) { + $_->{markup} =~ s{ + $MA_BEG + ([^$MA_END]+) + $MA_END + }{ + my ($type, @arg) = split /$MA_SEP/o, $1; + + $_[1]{$type}($_, @arg) + }ogex; + } +} - my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; +my %as_label = ( + image => sub { + my ($par, $path) = @_; - return $pom if $chash eq $phash; + "img" + }, + link => sub { + my ($par, $text, $link) = @_; - my $pod = do { - local $/; - open my $pod, "<:utf8", $_[0] - or die "$_[0]: $!"; - <$pod> - }; + "↺" . (DC::asxml $text) . "" + }, +); - #utf8::downgrade $pod; +sub as_label(@) { + thaw_section @_, %as_label; - $pom = $filtercb->(Pod::POM->new->parse_text ($pod)); + my $text = + join "\n", + map +("\xa0" x ($_->{indent} / 4)) . $_->{markup}, + @_; - $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); + $text =~ s/^\s+//; + $text =~ s/\s+$//; - $pom + $text } -sub as_xml($) { - my ($pom) = @_; +my %as_paragraphs = ( + image => sub { + my ($par, $path, $flags) = @_; - local $indent = 0; + push @{ $par->{widget} }, new DC::UI::Image path => $path, + $flags & 1 ? (max_h => $::FONTSIZE) : (); - $pom->present ("CFClient::Pod::AsXML") -} + "\x{fffc}" + }, + link => sub { + my ($par, $text, $link) = @_; + + push @{ $par->{widget} }, new DC::UI::Label + markup => "↺" . (DC::asxml $text) . "", + fontsize => 0.8, + can_hover => 1, + can_events => 1, + padding_x => 0, + padding_y => 0, + tooltip => "Go to " . (DC::asxml $link) . "", + on_button_up => sub { + goto_document $link; + }; -sub as_paragraphs($) { - my ($pom) = @_; + "\x{fffc}" + }, +); - local @result = ( { } ); - local $indent = 0; +sub as_paragraphs(@) { + thaw_section @_, %as_paragraphs; - $pom->present ("CFClient::Pod::AsParagraphs"); + @_ +} + +sub section_paragraphs(@) { + as_paragraphs §ion +} - [grep exists $_->{text}, @result] +sub section_label(@) { + as_label §ion } +1