Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

gPOD

by KM (Priest)
on Jan 04, 2001 at 22:05 UTC ( #49803=sourcecode: print w/ replies, xml ) Need Help??

Category: GUI Programming
Author/Contact Info KM - http://perlguy.com/gpod/
Description: As an exercise to do some Perl/Gtk+ without using Glade, I decided to create a Gtk+ POD viewer, gPOD. I have been using it for the last few days, and actually kind of like it, so I thought I would share. I have a growing TODO list for it (adding color text, saving as things other than text, saving prefs, etc...) so if you happen to use it, and like it let me know so I can give you updates.
So, use it, abuse it, give me some comments (here or email), suggestions, patches, screenshots, etc.. I plan to continue to work on this and build a decent app.

So far, I have only tested this with Gtk 1.2.8/Gtk-Perl 0.7004, and Helix Gnome.

#!/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);
}

Comment on gPOD
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://49803]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (9)
As of 2014-08-28 00:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (253 votes), past polls