Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl use strict; use warnings; use Gnome; use Pod::Text; use Fcntl; use Config; my $NAME = 'gPOD'; my $VERSION = '0.1'; my %cache; my %saved; my $current; my @current_font = (undef, undef); my $file_dialog; my $font_diag; init Gnome $NAME; my $app = new Gnome::App $NAME, $NAME; signal_connect $app 'delete_event', sub { Gtk->main_quit; return 0 }; $app->create_menus( { type => 'subtree', label => '_File', subtree => [ # Don't need these (yet) #{ # type => 'item', # label => '_New', # pixmap_type => 'stock', # pixmap_info => 'Menu_New' #}, #{ # type => 'item', # label => '_Open...', # pixmap_type => 'stock', # pixmap_info => 'Menu_Open' #}, { type => 'item', label => '_Save', pixmap_type => 'stock', pixmap_info => 'Menu_Save', callback => \&signal_save_file }, #{ # type => 'item', # label => 'Save _As...', # pixmap_type => 'stock', # pixmap_info => 'Menu_Save As' #}, { type => 'separator' }, { type => 'item', label => 'E_xit', pixmap_type => 'stock', pixmap_info => 'Menu_Quit', callback => sub { Gtk->main_quit; ret +urn 0 } } ] }, { type => 'subtree', label => '_Edit', subtree => [ # Don't need these (yet) #{ # type => 'item', # label => 'C_ut', # pixmap_type => 'stock', # pixmap_info => 'Menu_Cut', #}, { type => 'item', label => '_Copy', pixmap_type => 'stock', pixmap_info => 'Menu_Copy' }, #{ # type => 'item', # label => '_Paste', # pixmap_type => 'stock', # pixmap_info => 'Menu_Paste' #} ] }, # No prefs, yet { type => 'subtree', label => '_Settings', subtree => [ { type => 'item', label => '_Fonts', pixmap_type => 'stock', pixmap_info => 'Menu_Preferences', callback => \&signal_show_fonts } ] }, # { # type => 'item', # label => '_Preferences...', # pixmap_type => 'stock', # pixmap_info => 'Menu_Preferences', # callback => \&signal_show_prefs # } # ] #}, { type => 'subtree', label => '_Help', subtree => [ {type => 'item', label => '_About...', pixmap_type => 'stock', pixmap_info => 'Menu_About', callback => \&about_box } ] } ); $app->create_toolbar( { type => 'item', label => 'Save', pixmap_type => 'stock', pixmap_info => 'Save', hint => "Save this POD", callback => \&signal_save_file }, { type => 'item', label => 'Exit', pixmap_type => 'stock', pixmap_info => 'Quit', hint => "Quit $NAME", callback => sub { Gtk->main_quit;} } ); # Get pod files my $PATH = $Config{installprivlib} . "/pod"; opendir (DIR, $PATH); my @pods = grep { /\.pod$/} readdir DIR; closedir DIR; $app->set_default_size(600,400); # Make window where POD text will be my $text = new Gtk::Text(undef, undef); $text->set_editable(0); $text->set_adjustments($text->hadj,$text->vadj); # Make scrollbar my $vscroll = new Gtk::VScrollbar($text->vadj); # Make window which will list PODs my $scrolled_window = new Gtk::ScrolledWindow( undef, undef ); $scrolled_window->set_policy( 'automatic', 'automatic' ); # Make list of PODs my $list = new Gtk::List; $list->signal_connect('selection_changed', \&signal_list_selected); $scrolled_window->add_with_viewport($list); # Create our list-o-PODs my $length = 0; my %holder; for my $pod (sort @pods) { my $item = new Gtk::ListItem; (my $cpod = $pod) =~ s!\.pod$!!; my $lab = new Gtk::Label($cpod); $length = length($pod) if length $pod > $length; $item->add($lab); $list->add($item); $holder{$item->{_gtk}} = $pod; } # Make the hbox my $box1 = new Gtk::HBox(0,0); # Define starting size of list window $scrolled_window->set_usize($length*8,0); # Define starting size of viewing window $text->set_usize(600-($length*8),0); # Pack up the hbox with goodies $box1->pack_start($scrolled_window, 0, 1, 0); $box1->pack_start($text, 1, 1, 0); $box1->pack_start($vscroll, 0, 0, 0); # Toss the hbox into the app $app->set_contents($box1); # App bar my $bar = new Gnome::AppBar 0,1,"user"; $bar->set_status(""); $app->set_statusbar($bar); show_all $app; main Gtk; # Signals and subroutines sub about_box { my $about = new Gnome::About $NAME, $VERSION, "(C) Kevin Meltzer, 2001", ["Kevin Meltzer <gpod\@perlguy.com>"], "A Gtk+ POD Viewer\n\n". "Gtk " . Gtk->major_version . "." . Gtk->minor_version . "." . Gtk->micro_version . "\n". "Gtk-Perl " . $Gtk::VERSION . "\n" . "This program is released under the same terms as Perl itself"; $about->set_title("About $NAME"); $about->position('mouse'); $about->set_policy(1,1,0); $about->set_modal(1); show $about; } sub signal_list_selected { my @list = @_; my @dlist = $list[0]->selection; # Must be an unselect.. so bail return unless @dlist; # This is dumb my $item = $holder{%{$dlist[0]}->{'_gtk'}}; $text->backward_delete($text->get_point); $text->set_point(0); $current = $item; # See if we have this POD in the cache already if (exists $cache{$item}) { $text->insert($current_font[0], $text->style->text('no +rmal'), undef, $cache{$item}); $bar->set_status("$item (From cache)"); return; } # Make temp file. my $tmp = "/tmp/gPOD.$item.$$"; # Do what part of perldoc does sysopen(OUT, $tmp, O_WRONLY | O_EXCL | O_CREAT, 0600) or die " +Can't open $tmp: $!"; # Hate to turn off warnings, but Pod::Text can throw crap at u +s {local $^W =0; Pod::Text->new()->parse_from_file("$PATH/$item" +,\*OUT);}; close OUT; # Open the file open(FH, $tmp); my @lines = <FH>; close FH; # cache it $cache{$item} = "@lines"; $text->insert($current_font[0], $text->style->text('normal'), +undef, "@lines"); $bar->set_status("$item (From file)"); # clean up unlink $tmp; } # Below is currently unused sub signal_show_prefs { my $option = new Gtk::Menu; my $option_item = new Gtk::MenuItem("Soon, you can prefer thin +gs"); $option->append($option_item); #$option_item->signal_connect('activate', sub {print "foo";}); $option_item->show; $option->popup(undef, undef, time(), undef, undef); } # Currently, only saving text. I want to change this. sub signal_save_file { # Do nothing if no file is being viewed return unless $current; # Create a new file selection widget $file_dialog = new Gtk::FileSelection("File Selection"); $file_dialog->signal_connect( "destroy", sub { $file_dialog->h +ide; } ); # Connect the ok_button to file_ok_sel function $file_dialog->ok_button->signal_connect( "clicked", \&file_ok_sel, $file_dialog ); # Connect the cancel_button to hide the widget $file_dialog->cancel_button->signal_connect( "clicked", sub {$file_dialog->hi +de;} ); # Lets set the filename, as if this were a save dialog, and we + are giving # a default filename $file_dialog->set_filename($current. ".txt"); $file_dialog->show(); } # Get the selected filename and print it to the console sub file_ok_sel { my ($widget, $file_selection) = @_; my $file = $file_selection->get_filename(); # For later use #$saved{$file}++; open(FH, ">>$file") or die "Can't open $file ($!)"; print FH $cache{$current}; close FH; $file_dialog->hide; } sub signal_show_fonts { $font_diag = new Gtk::FontSelectionDialog("Fonts"); $font_diag->signal_connect( "destroy", sub { $font_diag->hide; + } ); # Connect the ok_button to file_ok_sel function $font_diag->ok_button->signal_connect("clicked", \&font_ok_sel, $font_diag ); # Connect the cancel_button to hide the widget $font_diag->cancel_button->signal_connect("clicked", sub {$font_diag->hide;} +); $font_diag->set_font_name($current_font[1]) if $current_font[1 +]; $font_diag->show(); } sub font_ok_sel { my ($widget, $font_selection) = @_; my $font = $font_diag->get_font; my $font_full = $font_diag->get_font_name; $font_diag->hide; $text->backward_delete($text->get_point); $text->set_point(0); $text->insert($font , $text->style->text('normal'), undef,$cac +he{$current}) unless !exists $cache{$current}; @current_font = ($font, $font_full); }

In reply to gPOD by KM

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (7)
    As of 2014-07-26 15:16 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (178 votes), past polls