Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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: (5)
    As of 2015-07-04 18:21 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (60 votes), past polls