diff options
author | jake <jake@jakes-mail.top> | 2022-02-02 13:37:37 -0500 |
---|---|---|
committer | jake <jake@jakes-mail.top> | 2022-02-02 13:37:37 -0500 |
commit | a7cacde8a841b8b56e48cc07228e827af79541e8 (patch) | |
tree | f8c261ff5afdb99af88091205d9d3f94ee0ba5c8 /gmi.pl | |
parent | 54f42602c935aa107b5ac2d5986a31d5873560d6 (diff) |
can now Go to some url
Diffstat (limited to 'gmi.pl')
-rwxr-xr-x | gmi.pl | 274 |
1 files changed, 159 insertions, 115 deletions
@@ -38,7 +38,7 @@ require Text::Wrapper; # CPAN use Term::ReadKey; # CPAN use Term::ANSIColor; # Core use Path::Naive qw(normalize_path); # CPAN -use Text::ParseWords; # Core +#use Text::ParseWords; # Core use Term::ReadLine; # CPAN #use Smart::Comments; # CPAN use URI::Encode qw(uri_encode); # CPAN @@ -49,20 +49,56 @@ use File::BaseDir qw(xdg_config_home xdg_data_home xdg_cache_home); # CPAN use TOML qw(from_toml to_toml); # CPAN use Tk; use Tk::Text; -use Tk::Canvas; # sudo cpanm IO::Socket::SSL URL::XS IO::Pager Text::Wraper Term::ReadKey Path::Naive Text::ParseWords Term::ReadLine Smart::Comments URI::Encode IO::Socket::SSL::Utils File::Slurper File::BaseDir TOML Tk my $top = MainWindow->new; -my $t = $top->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true -height 30 -scrollbars e/); -$t->pack(qw/-expand yes -fill both/); - +my $control_frame = $top->Frame() + ->pack( + -fill=>'x', + -expand=>0, + ); +my $label = $control_frame->Label( + -text=>'URL:', + )->pack( + -side=>'left' + ); +my $entry = $control_frame->Entry( + )->pack( + -side=>'left', + -expand=>1, + ); +my $buttom = $control_frame->Button( + -text=>'Go!', + -command=>\&go_to_url, + )->pack( + -side=>'left', + ); + +my $body_frame = $top->Frame() + ->pack( + #-side=>'top', + -fill=>'both', + -expand=>1, + ); +my $t = $body_frame->Scrolled( + 'Text', + -relief=>'sunken', + -borderwidth=>2, + -setgrid=>'true', + #-height=>30, + -scrollbars=>'e', + #-font => 'fixed', + )->pack( + -expand=>'yes', + -fill=>'both', + ); + +my $something = "hello world"; $t->insert('0.0', "$something"); -$t->mark(qw/set insert 0.0/); -MainLoop; my %config = ( 'use_pager' => 1, @@ -92,7 +128,7 @@ my $use_cert = 0; my $cert; my $key; my %known_hosts; -my $program_name = 'jakes-gemini-client'; +my $program_name = 'jakes-gemini-client-tk'; my $bd = File::BaseDir->new; my $xdg_config = $bd->xdg_config_home . "/$program_name/"; my $xdg_data = $bd->xdg_data_home . "/$program_name/"; @@ -112,11 +148,17 @@ if (! -e $xdg_cache) { my @cache; load_config(); -my $wrapper = Text::Wrapper->new(columns=>$config{textwrap}, body_start=>''); -$ENV{PAGER} = $config{pager}; +MainLoop; +#my $wrapper = Text::Wrapper->new(columns=>$config{textwrap}, body_start=>''); +#$ENV{PAGER} = $config{pager}; my $term=new Term::ReadLine "hmm, what goes here?"; my $OUT = $term->OUT || \*STDOUT; +#my $OUT = \*STDOUT; + +sub go_to_url { + url($entry->get()); +} my %commands = ( 'url' => [sub { url($_[0]) }, 'Go to the specified URL.'], @@ -207,61 +249,61 @@ my %commands = ( 'bookmarks' => [sub { bookmarks(); }, 'Returns your bookmarks. Use \'nb\' or \'navb\' along with this.'], ); -my @completions = keys %commands; - -$term->Attribs->{'do_expand'}=1; -$term->Attribs->{'completion_entry_function'} = $term->Attribs->{'list_completion_function'}; -$term->Attribs->{'completion_word'} = \@completions; -$term->ornaments(0); - -$prompt = "$current_url > "; - -#print $OUT "gmi.pl Copyright (C) 2022 Jake Thoughts\n"; -#print $OUT "This program comes with ABSOLUTELY NO WARRANTY.\n"; -#print $OUT "This is free software, and you are welcome to redisdtribute it\n"; -#print $OUT "under certain conditions. See COPYING for details.\n"; -#print $OUT "Press <tab><tab> to see available commands.\n"; -#while ( defined ($_ = $term->readline($prompt)) ) { -# if ($_) { -# my ($command, $detail, @other_details) = split(/\s/, $_); -# do_command(\$command, \$detail, @other_details); +#my @completions = keys %commands; +# +#$term->Attribs->{'do_expand'}=1; +#$term->Attribs->{'completion_entry_function'} = $term->Attribs->{'list_completion_function'}; +#$term->Attribs->{'completion_word'} = \@completions; +#$term->ornaments(0); +# +#$prompt = "$current_url > "; +# +##print $OUT "gmi.pl Copyright (C) 2022 Jake Thoughts\n"; +##print $OUT "This program comes with ABSOLUTELY NO WARRANTY.\n"; +##print $OUT "This is free software, and you are welcome to redisdtribute it\n"; +##print $OUT "under certain conditions. See COPYING for details.\n"; +##print $OUT "Press <tab><tab> to see available commands.\n"; +##while ( defined ($_ = $term->readline($prompt)) ) { +## if ($_) { +## my ($command, $detail, @other_details) = split(/\s/, $_); +## do_command(\$command, \$detail, @other_details); +## } +## $prompt = "$current_url > "; +##} +# +#sub do_command { +# # referenced command, referenced arg, additional args +# my ($rCmd, $rArg, $rArgs) = @_; +# +# ### @_ +# # checking if %commands even has the command +# if (exists $commands{$$rCmd}) { +# +# # assigning a reference to a subroutine to the value +# my $rsub = $commands{$$rCmd}[0]; +# +# #running the subroutine +# &$rsub($$rArg,$rArgs); +# +# } +# # options doesn't have the command +# else { +# print $OUT "Command is invalid.\n"; +# } +#} +# +#sub help { +# my ($cmd) = @_; +# ### @_ +# if ($cmd and exists $commands{$cmd}) { +# print $OUT "$commands{$cmd}[1]\n"; +# } elsif ($cmd) { +# print $OUT "`$cmd' isn't an avaliable command.\n"; +# } +# else { +# print $OUT "$commands{help}[1]\n" # } -# $prompt = "$current_url > "; #} - -sub do_command { - # referenced command, referenced arg, additional args - my ($rCmd, $rArg, $rArgs) = @_; - - ### @_ - # checking if %commands even has the command - if (exists $commands{$$rCmd}) { - - # assigning a reference to a subroutine to the value - my $rsub = $commands{$$rCmd}[0]; - - #running the subroutine - &$rsub($$rArg,$rArgs); - - } - # options doesn't have the command - else { - print $OUT "Command is invalid.\n"; - } -} - -sub help { - my ($cmd) = @_; - ### @_ - if ($cmd and exists $commands{$cmd}) { - print $OUT "$commands{$cmd}[1]\n"; - } elsif ($cmd) { - print $OUT "`$cmd' isn't an avaliable command.\n"; - } - else { - print $OUT "$commands{help}[1]\n" - } -} sub url { my ($url) = @_; @@ -862,39 +904,41 @@ sub back { } sub display { - if ($config{pager_text_wrap_auto}) { - my ($wc) = GetTerminalSize(); - $wrapper->columns($wc); - } - if ($config{use_pager}) { - ### opening IO Pager - eval { - # catch it or big files ( >1000 lines ) will load but the script itself dies for some reason - local $SIG{PIPE} = sub { die }; - IO::Pager::open(my $FH) or warn($!); - for (@doc) { - _pre_block($_); - if ($pre_block) { - print $FH $_; - } - else { - print $FH $wrapper->wrap($_); - } - } - close $FH; - }; - } - else { - for (@doc) { - _pre_block($_); - if ($pre_block) { - print $OUT $_; - } - else { - print $OUT $wrapper->wrap($_); - } - } - } + $t->delete('0.0', 'end'); + $t->insert('0.0', "@doc"); +# if ($config{pager_text_wrap_auto}) { +# my ($wc) = GetTerminalSize(); +# $wrapper->columns($wc); +# } +# if ($config{use_pager}) { +# ### opening IO Pager +# eval { +# # catch it or big files ( >1000 lines ) will load but the script itself dies for some reason +# local $SIG{PIPE} = sub { die }; +# IO::Pager::open(my $FH) or warn($!); +# for (@doc) { +# _pre_block($_); +# if ($pre_block) { +# print $FH $_; +# } +# else { +# print $FH $wrapper->wrap($_); +# } +# } +# close $FH; +# }; +# } +# else { +# for (@doc) { +# _pre_block($_); +# if ($pre_block) { +# print $OUT $_; +# } +# else { +# print $OUT $wrapper->wrap($_); +# } +# } +# } } sub toggle { @@ -911,25 +955,25 @@ sub toggle { } } -sub textwrap { - my ($c) = @_; - if ($c and $c =~ m/^\d+$/) { - $config{textwrap} = $c; - $wrapper->columns($c); - $config{pager_text_wrap_auto} = 0; - } elsif ($c and $c eq 'auto') { - $config{pager_text_wrap_auto} = 1; - } - else { - if ($config{pager_text_wrap_auto}) { - my ($c) = GetTerminalSize(); - print("[AUTO] $c\n"); - } - else { - print "$config{textwrap}\n"; - } - } -} +#sub textwrap { +# my ($c) = @_; +# if ($c and $c =~ m/^\d+$/) { +# $config{textwrap} = $c; +# $wrapper->columns($c); +# $config{pager_text_wrap_auto} = 0; +# } elsif ($c and $c eq 'auto') { +# $config{pager_text_wrap_auto} = 1; +# } +# else { +# if ($config{pager_text_wrap_auto}) { +# my ($c) = GetTerminalSize(); +# print("[AUTO] $c\n"); +# } +# else { +# print "$config{textwrap}\n"; +# } +# } +#} sub pager { my ($p,@other) = @_; |