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