archive
/
milkbone
1
0
Fork 0
Code Pull Requests Projects Releases Activity
Browse Source

""

master
milkbone57 22 years ago
parent
0f4720f08f
commit
7999d8b12d
4 changed files with 253 additions and 249 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      Milkbone.pm
  2. 57
      plugins/Tk-GUI/Tk-GUI.pl
  3. 7
      plugins/Tk-GUI/Tk/Browser.pm
  4. 16
      plugins/Tk-GUI/test.pl

2
Milkbone.pm
Unescape View File

@ -20,6 +20,8 @@ use Benchmark;
our $VERSION = "0.355"; our $VERSION = "0.355";
require Exporter; require Exporter;
our @ISA = qw( Exporter ); our @ISA = qw( Exporter );

57
plugins/Tk-GUI/Tk-GUI.pl
Unescape View File

@ -28,6 +28,9 @@ else
$defaultFont = 'arial'; $defaultFont = 'arial';
} }
my %fonts;
map { $fonts{$_} = 1 } $mw->fontFamilies;
$mw->optionAdd("*font", "-*-$defaultFont-norma-r-*-*-*-120-*-*-*-*-*-*"); $mw->optionAdd("*font", "-*-$defaultFont-norma-r-*-*-*-120-*-*-*-*-*-*");
$mw->optionAdd("*borderWidth", 1); $mw->optionAdd("*borderWidth", 1);
$mw->optionAdd("*highlightThickness", 0); $mw->optionAdd("*highlightThickness", 0);
@ -41,59 +44,65 @@ register_hook("tk_get_default_font", sub { $defaultFont });
register_hook("tick", \&tick); register_hook("tick", \&tick);
register_hook("tk_getmain", sub { register_hook("tk_getmain", sub {
return $mw; return $mw;
});
register_hook("tk_getfont". sub {
print "getfont called with" . $ARGS{-font};
return $ARGS{-font} if exists($fonts{$ARGS{-font}});
print "font doesn't exist - here's the default";
return $defaultFont;
}); });
register_hook("tk_bindwheel", sub { register_hook("tk_bindwheel", sub {
if($^O =~ /win32/i) if($^O =~ /win32/i)
{ {
$ARGS{-window}->bind('<MouseWheel>', $ARGS{-window}->bind('<MouseWheel>',
[ sub { $_[0]->yview('scroll', -($_[1] / 120), 'units') }, Tk::Ev('D')]); [ sub { $_[0]->yview('scroll', -($_[1] / 120), 'units') }, Tk::Ev('D')]);
} }
else else
{ {
$ARGS{-window}->bind('<4>' => sub { $_[0]->yview('scroll', -1, 'units') unless $Tk::strictMotif; $ARGS{-window}->bind('<4>' => sub { $_[0]->yview('scroll', -1, 'units') unless $Tk::strictMotif;
}); });
$ARGS{-window}->bind('<5>' => sub { $_[0]->yview('scroll', 1, 'units') unless $Tk::strictMotif; $ARGS{-window}->bind('<5>' => sub { $_[0]->yview('scroll', 1, 'units') unless $Tk::strictMotif;
}); });
} }
}); });
register_hook("after", sub { register_hook("after", sub {
$mw->after($ARGS{-time}, $ARGS{-code}); $mw->after($ARGS{-time}, $ARGS{-code});
}); });
sub tick sub tick
{ {
return unless $mw; return unless $mw;
$mw->DoOneEvent(Tk::ALL_EVENTS); $mw->DoOneEvent(Tk::ALL_EVENTS);
} }
sub on_destroy sub on_destroy
{ {
abort(); abort();
} }
register_hook("error", sub { register_hook("error", sub {
my $text = $ARGS{-short}; my $text = $ARGS{-short};
($text) = $text =~ m/^(.*?)\n/; ($text) = $text =~ m/^(.*?)\n/;
my $error_box = $mw->Toplevel(-title => "Milkbone Error"); my $error_box = $mw->Toplevel(-title => "Milkbone Error");
$error_box->Label(-text => $ARGS{-short}, -wraplength => 200)->pack; $error_box->Label(-text => $ARGS{-short}, -wraplength => 200)->pack;
$error_box->Button(-text => "OK", -command => [sub { $error_box->Button(-text => "OK", -command => [sub {
my ($self, $fatal) = @_; my ($self, $fatal) = @_;
$self->destroy; $self->destroy;
hook("protocol_signoff") if $fatal; hook("protocol_signoff") if $fatal;
$mw->destroy if $fatal && hook("protocol_signed_in"); $mw->destroy if $fatal && hook("protocol_signed_in");
}, $error_box, $ARGS{-fatal}])->pack->focus; }, $error_box, $ARGS{-fatal}])->pack->focus;
hook("tk_seticon", -wnd => $error_box); hook("tk_seticon", -wnd => $error_box);
$error_box->withdraw; $error_box->withdraw;
$error_box->geometry("+" . int(($mw->screenwidth() / 2) - int($error_box->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($error_box->height() / 2)) ); $error_box->geometry("+" . int(($mw->screenwidth() / 2) - int($error_box->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($error_box->height() / 2)) );
$error_box->deiconify; $error_box->deiconify;
$error_box->update; $error_box->update;
$error_box->focus; $error_box->focus;
}); });

7
plugins/Tk-GUI/Tk/Browser.pm
Unescape View File

@ -5,6 +5,8 @@ use Tk::Font;
use base 'Tk::ROText'; use base 'Tk::ROText';
use Cwd qw(abs_path); use Cwd qw(abs_path);
use Milkbone;
use strict; use strict;
use warnings; use warnings;
@ -15,7 +17,7 @@ sub insertHTML
my ($self, $pos, $html) = @_; my ($self, $pos, $html) = @_;
my @insert; my @insert;
$self->configure(-selectforeground => 'white', -selectbackground => 'black', -background => 'white'); $self->configure(-selectforeground => 'white', -selectbackground => 'black');
$html =~ s/<br>/\n/gi; $html =~ s/<br>/\n/gi;
$html =~ s/<body bgcolor=/<font back=/gi; $html =~ s/<body bgcolor=/<font back=/gi;
@ -179,7 +181,8 @@ sub font_begin
$realsize = int((8, 10, 12, 14, 18, 24, 38) [int($size) + 1]) if $size and $^O !~ /Win32/; $realsize = int((8, 10, 12, 14, 18, 24, 38) [int($size) + 1]) if $size and $^O !~ /Win32/;
$font->{-family} = "{$family}" if $family; $font->{-family} = "{" . hook("tk_getfont", -font => $family) . "}"
if $family;
$font->{-size} = $realsize if $size; $font->{-size} = $realsize if $size;
my %opts; my %opts;

16
plugins/Tk-GUI/test.pl
Unescape View File

@ -1,20 +1,10 @@
use Tk; use Tk;
use Tk::Text; use Tk::Browser;
$mw = MainWindow->new; $mw = MainWindow->new;
$edit = $mw->TextUndo->pack; $edit = $mw->Browser->pack;
$edit->insert('end', 't'); $edit->insertHTML('end', "<font face='garamond'>erererr");
$edit->tagConfigure('<b>', -font => $mw->Font(-family => 'times', -weight => 'bold'));
$edit->tagConfigure('elide', -elide => 1);
$tag = "<b>";
$mw->Button(-text => 'bold', -command => sub {
$edit->insert('insert', 'de', [$tag, 'elide']);
$edit->tagAdd($tag, 'insert');
})->pack;
MainLoop; MainLoop;
Write Preview
Loading…
Cancel
Save