--- deliantra/Deliantra-Client/DC/Pod.pm 2006/07/23 16:11:12 1.1 +++ deliantra/Deliantra-Client/DC/Pod.pm 2008/03/25 02:12:35 1.19 @@ -1,217 +1,192 @@ -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; +# nodes (order must stay as it is) +sub N_PARENT (){ 0 } +sub N_PAR (){ 1 } +sub N_LEVEL (){ 2 } +sub N_KW (){ 3 } +sub N_DOC (){ 4 } -use strict; - -use base "Pod::POM::View::Text"; +# paragraphs (order must stay as it is) +sub P_INDENT (){ 0 } +sub P_LEVEL (){ 1 } +sub P_MARKUP (){ 2 } +sub P_INDEX (){ 3 } -*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] }; +*wiki = Storable::retrieve DC::find_rcfile "docwiki.pst"; -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::asxml $text +sub goto_document($) { + $goto_document->(split /\//, $_[0]); } -sub view_item { - ("\t" x ($indent / 4)) - . $_[1]->title->present ($_[0]) - . "\n\n" - . $_[1]->content->present ($_[0]) -} +sub is_prefix_of($@) { + my ($node, @path) = @_; -sub view_verbatim { - (join "", - map +("\t" x ($indent / 2)) . "$_\n", - split /\n/, CFClient::asxml $_[1]) - . "\n" -} + return 1 unless @path; + + my $kw = lc pop @path; + + $node = $node->[N_PARENT] + or return 0; -sub view_textblock { - ("\t" x ($indent / 2)) . "$_[1]\n\n" + return scalar grep $_ eq $kw, @{ $node->[N_KW] }; } -sub view_head1 { - "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; +sub find(@) { + my (@path) = @_; -sub view_head2 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + return unless @path; -sub view_head3 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + my $kw = lc pop @path; -sub view_over { - local $indent = $indent + $_[1]->indent; - $_[1]->content->present ($_[0]) -} + # TODO: make sure results are unique -package CFClient::Pod::AsParagraphs; + grep { is_prefix_of $_, @path } + map @$_, + $kw eq "*" ? @wiki{sort keys %wiki} + : $wiki{$kw} || () +} -use strict; +sub full_path_of($) { + my ($node) = @_; -use base "Pod::POM::View"; + my @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] }; - -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->[N_PARENT]) { + unshift @path, $node; + $node = $node->[N_PARENT]; } - () -} -sub view { - my ($self, $type, $item) = @_; + @path +} - $item->content->present ($self); +sub full_path($) { + join "/", map $_->[N_KW][0], &full_path_of } -package CFClient::Pod; +sub section_of($) { + my ($node) = @_; + + my $doc = $node->[N_DOC]; + my $par = $node->[N_PAR]; + my $lvl = $node->[N_LEVEL]; -my $pod_cache = CFClient::db_table "pod_cache"; + my @res; -sub load($$$$) { - my ($path, $filtertype, $filterversion, $filtercb) = @_; + do { + my $p = $doc->[$par]; - stat $path - or die "$path: $!"; + if (length $p->[P_MARKUP]) { + push @res, { + markup => $p->[P_MARKUP], + indent => $p->[P_INDENT], + }; + } + } while $doc->[++$par][P_LEVEL] > $lvl; - my $phash = join ",", $filterversion, $VERSION, (stat _)[7,9]; + @res +} - my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; +sub section(@) { + map section_of $_, &find +} - return $pom if $chash eq $phash; +sub thaw_section(\@\%) { + for (@{$_[0]}) { + $_->{markup} =~ s{ + $MA_BEG + ([^$MA_END]+) + $MA_END + }{ + my ($type, @arg) = split /$MA_SEP/o, $1; - my $pod = do { - local $/; - open my $pod, "<:utf8", $_[0] - or die "$_[0]: $!"; - <$pod> - }; + $_[1]{$type}($_, @arg) + }ogex; + } +} - #utf8::downgrade $pod; +my %as_label = ( + image => sub { + my ($par, $path) = @_; - $pom = $filtercb->(Pod::POM->new->parse_text ($pod)); + "img" + }, + link => sub { + my ($par, $text, $link) = @_; - $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); + "↺" . (DC::asxml $text) . "" + }, +); - $pom -} +sub as_label(@) { + thaw_section @_, %as_label; -sub as_xml($) { - my ($pom) = @_; + my $text = + join "\n", + map +("\xa0" x ($_->{indent} / 4)) . $_->{markup}, + @_; - local $indent = 0; + $text =~ s/^\s+//; + $text =~ s/\s+$//; - $pom->present ("CFClient::Pod::AsXML") + $text } -sub as_paragraphs($) { - my ($pom) = @_; +my %as_paragraphs = ( + image => sub { + my ($par, $path, $flags) = @_; + + push @{ $par->{widget} }, new DC::UI::Image path => $path, + $flags & 1 ? (max_h => $::FONTSIZE) : (); - local @result = ( { } ); - local $indent = 0; + "\x{fffc}" + }, + link => sub { + my ($par, $text, $link) = @_; - $pom->present ("CFClient::Pod::AsParagraphs"); + 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; + }; + + "\x{fffc}" + }, +); + +sub as_paragraphs(@) { + thaw_section @_, %as_paragraphs; + + @_ +} + +sub section_paragraphs(@) { + as_paragraphs §ion +} - [grep exists $_->{text}, @result] +sub section_label(@) { + as_label §ion } +1