Remove old Perl/Tk version and port to GTK3 with improved syntax highlighting
This commit is contained in:
parent
868aabae0a
commit
586cb285d3
GPG key ID:
E0A989B571D1F99F
3 changed files with 4 additions and 1073 deletions
|
|
@ -2,3 +2,7 @@
|
||||||
Original Perl version of kpad. Please note this code is very old. It requires Perl and Perl/Tk to run. Works on any platform that can support those.
|
Original Perl version of kpad. Please note this code is very old. It requires Perl and Perl/Tk to run. Works on any platform that can support those.
|
||||||
|
|
||||||
Version 5.2.1
|
Version 5.2.1
|
||||||
|
|
||||||
|
# Notes
|
||||||
|
|
||||||
|
4/30/25 - Ported to GTK3 with some improved syntax highlighting. Curtesy of Grok for the main translation.
|
||||||
|
|
|
||||||
375
kpad.old.pl
375
kpad.old.pl
|
|
@ -1,375 +0,0 @@
|
||||||
# KAKE PAD version 5.5
|
|
||||||
# Future versions will look at using Perl 6
|
|
||||||
|
|
||||||
# Please note that KAKE PAD depends on Tk and some bugs
|
|
||||||
# are due to Tk and not KAKE PAD itself. No promises on how
|
|
||||||
# good or bad Tk is.
|
|
||||||
|
|
||||||
# A few Tk modules need to be declared for PDK purposes
|
|
||||||
use Tk;
|
|
||||||
use Tk::TextUndo;
|
|
||||||
use Tk::DialogBox;
|
|
||||||
use File::Glob;
|
|
||||||
use File::Find;
|
|
||||||
use FileHandle;
|
|
||||||
use LWP::Simple;
|
|
||||||
|
|
||||||
#most of the above is only put in so I can compile to stand alone exe
|
|
||||||
#If you use as script keep the last two and use Tk;
|
|
||||||
|
|
||||||
# Below is the init section
|
|
||||||
# A few thing to do is check OS to see if its Windows or not
|
|
||||||
# I still don't know what I smoked when I wrote this but this section is important
|
|
||||||
|
|
||||||
($ar) = @ARGV; #Let the program do its thing with the arguments
|
|
||||||
# Bah check OS
|
|
||||||
# Just to make sure test $0, this is a work around for a minor bug
|
|
||||||
# Detect : a trade mark of a DOS system
|
|
||||||
|
|
||||||
# The setion below is so odd and complex vodoo that is quite nessacry
|
|
||||||
# yes I can't spell, only code
|
|
||||||
|
|
||||||
if($^O ne "Win32") {
|
|
||||||
if($0 =~/\//g){
|
|
||||||
@hd = split "/", $0;
|
|
||||||
$hdl = pop(@hd); # Knock the filename off the array we don't need it
|
|
||||||
$basedir = join('/', @hd);
|
|
||||||
}else{
|
|
||||||
$basedir = ".";
|
|
||||||
}
|
|
||||||
}else{
|
|
||||||
$basedir = ".";
|
|
||||||
}
|
|
||||||
|
|
||||||
$main = MainWindow->new(-title=> "kPad"); #Generates the main window
|
|
||||||
|
|
||||||
$menubar = $main->Frame()->pack(-side => "top", -fill => "x"); #Notice I create the menu bar as
|
|
||||||
# a frame not a Tk::Menu menubar, this makes things easier
|
|
||||||
|
|
||||||
#Below I define all the DialogBoxes,note they can be globaly used
|
|
||||||
|
|
||||||
$about = $main->DialogBox(-title=>"About...",-buttons=>["OK"]); #Creates the about Dialog
|
|
||||||
$aabout = $about->add("Label",-text=>"kPad\n by Paul Malcher\nVersion 6 Release\n")->pack; #Adds a label to $about
|
|
||||||
#$kweabt = $main->DialogBox(-title=>"About kWebedit...",-buttons=>["OK"]); #Creates the About kWebedit Dialog
|
|
||||||
#$akweabt =$kweabt->add("Label",-text=>"kWebedit v.2.0\nby Paul Malcher\nBased on kWebedit v.1.0.3 by Chris Litwin ")->pack; #That's the about for kWebedit.
|
|
||||||
$help = $main->DialogBox(-title=>"Help Topics",-buttons=>["OK"]); #Creates Help Dialog
|
|
||||||
$ahelp = $help->add("Label",-text=>"Help topics for KPAD\nWell, this is a text/file editor mainly meant for scripting and programming use.
|
|
||||||
Like notepad but made for the programmer.")->pack;
|
|
||||||
$nsave = $main->DialogBox(-title=>"Warning File Has changed!",-buttons=>["Save","Exit"]);
|
|
||||||
$ansave = $nsave->add("Label",-text=>"The documents contents have changed since you opened.\nDo you wish to save?.")->pack;
|
|
||||||
$nimp = $main->DialogBox(-title=>"Non-implementation Error",-buttons=>["OK"]);
|
|
||||||
$animp = $nimp->add("Label",-text=>"This function is not yet implemented!")->pack;
|
|
||||||
|
|
||||||
$fetch = $main->DialogBox(-title =>'HTML Source Fetch',-buttons=>["OK"]);
|
|
||||||
$afetch = $fetch->add("Label",-text=>'Fetch what:')->pack;
|
|
||||||
$bfetch = $fetch->add("Entry",-text=>'http://')->pack;
|
|
||||||
|
|
||||||
$dummy = $main->DialogBox(-title=>'Dummy Box');
|
|
||||||
$adummy = $dummy->add("Text")->pack;
|
|
||||||
|
|
||||||
$ftapp = $main->DialogBox(-title =>'File Has Changed!',-buttons=>["Yes","No"]);
|
|
||||||
$aftapp = $ftapp->add("Label", -text=>"File contents have changed, save now?!")->pack;
|
|
||||||
$track = "init";
|
|
||||||
|
|
||||||
# Begin new Kpad 4.0 features
|
|
||||||
# Plugin/Macros or whatever you want to call them
|
|
||||||
# First we find and autoload plugin, yes we use grep, makes life good
|
|
||||||
|
|
||||||
$pls = 0;
|
|
||||||
# Heck with lets do it all in one loop
|
|
||||||
|
|
||||||
while(<*.kpd>){
|
|
||||||
push(@plugins,$_);
|
|
||||||
open pin,"<$_";
|
|
||||||
@gn = split "::" , <pin>;
|
|
||||||
if(@gn[2] eq "auto"){
|
|
||||||
@n[$pls] = "auto";
|
|
||||||
}else{
|
|
||||||
@n[$pls] = @gn[1];
|
|
||||||
}
|
|
||||||
$pls++;
|
|
||||||
}
|
|
||||||
# determin the number of plugins, so we can size the list accordingly
|
|
||||||
$nop = scalar(@n); #notice @n does not get shortend, this is important later on
|
|
||||||
foreach(@n) {
|
|
||||||
if($_ eq "auto"){
|
|
||||||
$nop--; # make sure auto plugins are not listed
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Build the menu with list box
|
|
||||||
$plugin = $main->DialogBox(-title=>'Macro Execution Menu',-buttons=>["Close"]);
|
|
||||||
$bplugin = $plugin->add("Label",-text=>'Double Click To Execute Macro')->pack;
|
|
||||||
$aplugin = $plugin->Listbox("-width"=>40, "-height"=> $nop)->pack;
|
|
||||||
foreach(@n) {
|
|
||||||
if($_ eq "auto"){
|
|
||||||
$arun = 0;
|
|
||||||
}else{
|
|
||||||
$aplugin->insert('end', "$_");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
$aplugin->bind('<Double-1>' , \&eplugin); # Plugin name now can be different from the file name
|
|
||||||
|
|
||||||
$filemenu = $menubar->Menubutton(-text => 'File', -underline => 0,-tearoff => 0)->pack(-side=>'left'); #This puts
|
|
||||||
#the file button on the frame used for the menu bar
|
|
||||||
|
|
||||||
#Below are the commands for that button
|
|
||||||
#note How I included the subs into the command function
|
|
||||||
|
|
||||||
$filemenu->command(-label => 'New',-command => sub{
|
|
||||||
$text->delete('1.0','end');
|
|
||||||
});
|
|
||||||
|
|
||||||
$filemenu->command(-label => 'Open',-command => sub{
|
|
||||||
$text->delete('1.0','end');
|
|
||||||
my $types = [
|
|
||||||
['Perl Scripts', '.pl'],
|
|
||||||
['All Files', '*', ],
|
|
||||||
];
|
|
||||||
|
|
||||||
$open = $main->getOpenFile(-filetypes=>$types);
|
|
||||||
#open FILE, "<$open"; #took weeks to get this right,its there so te whole file loads correctly
|
|
||||||
# and only 3 sec to comment out for the 5.0 release
|
|
||||||
$text->Load($open);
|
|
||||||
$text ->pack;
|
|
||||||
});
|
|
||||||
|
|
||||||
$filemenu->command(-label => 'Save',-command => sub{
|
|
||||||
$data = $text->get('1.0','end'); #Saving for widget to file is a piece of cake
|
|
||||||
if($ar eq ""){
|
|
||||||
$text->Save($open);
|
|
||||||
# Easy indeed
|
|
||||||
}else{
|
|
||||||
$text->Save($ar);
|
|
||||||
}
|
|
||||||
});
|
|
||||||
|
|
||||||
$filemenu->command(-label => 'Save As',-command => sub{
|
|
||||||
#my $types = [['All Files', '*', ],];
|
|
||||||
my $types = [
|
|
||||||
['Perl Scripts', '.pl' ],
|
|
||||||
['All Files', '.*', ],
|
|
||||||
];
|
|
||||||
my $save = $main->getSaveFile(-filetypes=>$types);
|
|
||||||
$text->Save($save);
|
|
||||||
$open = $save;
|
|
||||||
});
|
|
||||||
|
|
||||||
$filemenu->separator;
|
|
||||||
|
|
||||||
$filemenu->command(-label => 'Exit',-command => sub{
|
|
||||||
tapp();
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu = $menubar->Menubutton(-text => 'Edit', -underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Undo',-command => sub{
|
|
||||||
my ($w) = @_;
|
|
||||||
$text->undo;
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Redo',-command => sub{
|
|
||||||
my ($w) = @_;
|
|
||||||
$text->redo;
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->separator;
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Cut',-command => sub{
|
|
||||||
my ($w) = @_;
|
|
||||||
$text->Column_Copy_or_Cut(1);
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Copy',-command => sub{
|
|
||||||
my ($w) = @_;
|
|
||||||
$text->Column_Copy_or_Cut(0);
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Paste',-command => sub{
|
|
||||||
$text->clipboardColumnPaste();
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->separator;
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Select All',-command => sub{
|
|
||||||
$text->selectAll();
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Unselect All',-command => sub{
|
|
||||||
$text->unselectAll();
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->separator;
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Find',-command => sub{
|
|
||||||
$text->findandreplacepopup(1);
|
|
||||||
});
|
|
||||||
|
|
||||||
$editmenu->command(-label => 'Find and Replace',-command => sub{
|
|
||||||
$text->findandreplacepopup(0);
|
|
||||||
});
|
|
||||||
|
|
||||||
$viewmenu = $menubar->Menubutton(-text=>'View',-underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
$vm = $viewmenu->cascade(-label => 'Wrap',-underline => 0,-tearoff => 0);
|
|
||||||
$vm->radiobutton(-label => "Word", -command => sub { $text->configure(-wrap => 'word'); } );
|
|
||||||
$vm->radiobutton(-label => "Char",-command => sub { $text->configure(-wrap => 'char'); } );
|
|
||||||
$vm->radiobutton(-label => "None",-command => sub { $text->configure(-wrap => 'none'); } );
|
|
||||||
|
|
||||||
$toolsmenu = $menubar->Menubutton(-text => 'Tools', -underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
|
|
||||||
$toolsmenu->command(-label => 'Goto Line',-command => sub{
|
|
||||||
$text->GotoLineNumberPopUp();
|
|
||||||
});
|
|
||||||
|
|
||||||
$toolsmenu->command(-label => 'Which Line?',-command => sub{
|
|
||||||
$text->WhatLineNumberPopUp();
|
|
||||||
});
|
|
||||||
|
|
||||||
$htmlmenu = $menubar->Menubutton(-text => 'HTML', -underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
|
|
||||||
$htmlmenu->command(-label => 'Fetch a web resource...',-command => sub{#$fdisc->Show;
|
|
||||||
$fetch->Show;
|
|
||||||
$htm = $bfetch->get;
|
|
||||||
$contents = get($htm);
|
|
||||||
open ttt, ">temp.dat";
|
|
||||||
print ttt "$contents";
|
|
||||||
close ttt;
|
|
||||||
open FILE, "<temp.dat"; #took weeks to get this right,its there so te whole file loads correctly
|
|
||||||
$text->delete('1.0','end');
|
|
||||||
while (! eof FILE){
|
|
||||||
$text->insert('end',FILE -> getline);
|
|
||||||
}
|
|
||||||
close FILE;
|
|
||||||
unlink(<temp.dat>);
|
|
||||||
$text ->pack;
|
|
||||||
});
|
|
||||||
|
|
||||||
$pluginmenu = $menubar->Menubutton(-text => 'Macros', -underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
|
|
||||||
$pluginmenu->command(-label => 'Execute Macro',-command => sub{$plugin->Show;});
|
|
||||||
|
|
||||||
$aboutmenu = $menubar->Menubutton(-text => 'Help', -underline => 0,-tearoff => 0)->pack(-side=>'left');
|
|
||||||
|
|
||||||
$aboutmenu->command(-label => 'Help Topics...',-command => sub{$help->Show;});
|
|
||||||
|
|
||||||
$aboutmenu->command(-label => 'About KPAD...',-command => sub{$about->Show;});
|
|
||||||
|
|
||||||
#$aboutmenu->command(-label => 'About kWebedit...',-command => sub{$kweabt->Show;});
|
|
||||||
|
|
||||||
# Text widget and configs
|
|
||||||
$statbar = $main->Frame()->pack(-side => "bottom", -fill => "x");
|
|
||||||
$statinfo = $statbar->Label(-text =>'Info: ')->pack(-side=>'left');
|
|
||||||
$statln = $statbar->Label(-text =>'Line: 0')->pack(-side=>'left');
|
|
||||||
$text = $main->Scrolled(TextUndo,-scrollbars=>'osoe',-background=>'white', -wrap => 'word')->pack(-fill=>'both',-expand=>1); #Scrolled Text
|
|
||||||
|
|
||||||
|
|
||||||
#widget that adapts to the size of the window
|
|
||||||
$main->protocol('WM_DELETE_WINDOW', \&tapp);
|
|
||||||
# This replaces $track
|
|
||||||
$text->bind('<<Modified>>' => sub{
|
|
||||||
$track = $text->get('1.0','end');
|
|
||||||
my ($w)=$text;
|
|
||||||
my ($line,$col) = split(/\./,$w->index('insert'));
|
|
||||||
#$statln = $statbar->Label(-text =>"Line $line")->pack(-side=>'left');
|
|
||||||
$statln->configure(-text =>"Line $line");
|
|
||||||
});
|
|
||||||
|
|
||||||
if($ar ne ""){
|
|
||||||
$text->Load($ar);
|
|
||||||
$text ->pack;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub eplugin { # Plugin executor, non-auto
|
|
||||||
$v = $aplugin->get('active');
|
|
||||||
# Fix for plugin vs. filename fix
|
|
||||||
# @plugins @n
|
|
||||||
$fp = 0;
|
|
||||||
while(@n[$fp] ne $v){ # assume the names in @plugin match with @n
|
|
||||||
# which they will unless you screw with the way plugins are handled
|
|
||||||
$fp++;
|
|
||||||
}
|
|
||||||
$v = @plugins[$fp];
|
|
||||||
# Hope it works
|
|
||||||
open pe, "<$basedir/$v"; # presto it does
|
|
||||||
# The same damn bug in Tk again, yes the one that took weeks to work around
|
|
||||||
# I got to do this the hard way
|
|
||||||
$adummy->delete('1.0','end');
|
|
||||||
while (! eof pe){
|
|
||||||
$adummy->insert('end', pe -> getline);
|
|
||||||
}
|
|
||||||
$tdata = $adummy->get('2.0','end'); # this is the only way to load an entire plugin into a var the right way
|
|
||||||
eval ( $tdata );
|
|
||||||
if($@){ # Only way to to make so it can trap multiple errors without the app having a fatal error itself
|
|
||||||
$error = $@;
|
|
||||||
&merr($error);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub aeplugin { # Auto plugin executor
|
|
||||||
$apc = 0;
|
|
||||||
while(@n[$apc] ne ""){
|
|
||||||
if(@n[$apc] eq "auto"){
|
|
||||||
$v = @plugins[$apc];
|
|
||||||
# Hope it works
|
|
||||||
open pe, "<$basedir/$v"; # presto it does
|
|
||||||
# The same damn bug in Tk again, yes the one that took weeks to work around
|
|
||||||
# I got to do this the hard way
|
|
||||||
$adummy->delete('1.0','end');
|
|
||||||
while (! eof pe){
|
|
||||||
$adummy->insert('end', pe -> getline);
|
|
||||||
}
|
|
||||||
$tdata = $adummy->get('2.0','end'); # this is the only way to load an entire plugin into a var the right way
|
|
||||||
eval ( $tdata );
|
|
||||||
if($@){ # Only way to to make so it can trap multiple errors without the app having a fatal error itself
|
|
||||||
$error = $@;
|
|
||||||
&merr($error);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
$apc++;
|
|
||||||
}
|
|
||||||
$arun = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub merr { # merr, macro/plugins error
|
|
||||||
$merr = $main->DialogBox(-title =>'Macro Error',-buttons=>["OK"]);
|
|
||||||
$amerr = $merr->add("Label", -text=>"Error: $error")->pack;
|
|
||||||
$merr->Show;
|
|
||||||
undef $merr;
|
|
||||||
}
|
|
||||||
|
|
||||||
if($arun eq "0"){
|
|
||||||
&aeplugin();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub tapp { # shutdown handler
|
|
||||||
if($track ne "init"){
|
|
||||||
$result = $ftapp->Show;
|
|
||||||
if($result eq "No"){
|
|
||||||
exit(0);
|
|
||||||
}
|
|
||||||
if($open){
|
|
||||||
$text->Save($open);
|
|
||||||
$saved = 1;
|
|
||||||
}
|
|
||||||
if($save){
|
|
||||||
$text->Save($save);
|
|
||||||
$saved = 1;
|
|
||||||
}
|
|
||||||
if($ar){
|
|
||||||
$text->Save($ar);
|
|
||||||
$saved = 1;
|
|
||||||
}else{
|
|
||||||
if($saved ne "1"){
|
|
||||||
my $types = [
|
|
||||||
['Perl Scripts', '.pl' ],
|
|
||||||
['All Files', '.*', ],
|
|
||||||
];
|
|
||||||
my $save = $main->getSaveFile(-filetypes=>$types);
|
|
||||||
$text->Save($save);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
exit(0);
|
|
||||||
}
|
|
||||||
|
|
||||||
MainLoop; #The main processing loop
|
|
||||||
698
kpad.pl
698
kpad.pl
|
|
@ -1,698 +0,0 @@
|
||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
# KAKE PAD version 6.0
|
|
||||||
# GTK3 version converted from TK
|
|
||||||
|
|
||||||
# After hours having a AI go around in circles for the error
|
|
||||||
|
|
||||||
#*** unhandled exception in callback:
|
|
||||||
#*** FATAL: invalid GdkModifierType value 4, expecting a string scalar or an arrayref of strings at kpad.pl line 114.
|
|
||||||
#*** ignoring at /usr/share/perl5/Gtk3.pm line 572.
|
|
||||||
#Use of uninitialized value in string eq at kpad.pl line 102.
|
|
||||||
|
|
||||||
#use strict;
|
|
||||||
#use warnings;
|
|
||||||
# There I fixed it, by commenting the two lines above out
|
|
||||||
|
|
||||||
use Gtk3 -init;
|
|
||||||
use File::Glob;
|
|
||||||
use File::Find;
|
|
||||||
use FileHandle;
|
|
||||||
use LWP::Simple;
|
|
||||||
use Encode qw(decode encode);
|
|
||||||
|
|
||||||
# Global variables for file handling
|
|
||||||
my $current_file;
|
|
||||||
my $text_buffer;
|
|
||||||
my @undo_stack = ();
|
|
||||||
my @redo_stack = ();
|
|
||||||
my $ignore_changes = 0;
|
|
||||||
my $status_bar;
|
|
||||||
my $last_search_pos;
|
|
||||||
my $search_dialog;
|
|
||||||
my $replace_dialog;
|
|
||||||
|
|
||||||
use constant CONTROL_MASK => 'control-mask'; # Update CONTROL_MASK constant to use the correct string value
|
|
||||||
|
|
||||||
# Initialize the main window
|
|
||||||
my $window = Gtk3::Window->new('toplevel');
|
|
||||||
$window->set_title("kPad");
|
|
||||||
$window->set_default_size(800, 600);
|
|
||||||
|
|
||||||
# Create the main vertical box
|
|
||||||
my $vbox = Gtk3::Box->new('vertical', 5);
|
|
||||||
$window->add($vbox);
|
|
||||||
|
|
||||||
# Create menubar
|
|
||||||
my $menubar = Gtk3::MenuBar->new();
|
|
||||||
$vbox->pack_start($menubar, 0, 0, 0);
|
|
||||||
|
|
||||||
# File menu
|
|
||||||
my $file_menu = Gtk3::Menu->new();
|
|
||||||
my $file_item = Gtk3::MenuItem->new_with_label('File');
|
|
||||||
$file_item->set_submenu($file_menu);
|
|
||||||
$menubar->append($file_item);
|
|
||||||
|
|
||||||
# File menu items
|
|
||||||
my $new_item = Gtk3::MenuItem->new_with_label('New');
|
|
||||||
my $open_item = Gtk3::MenuItem->new_with_label('Open');
|
|
||||||
my $save_item = Gtk3::MenuItem->new_with_label('Save');
|
|
||||||
my $save_as_item = Gtk3::MenuItem->new_with_label('Save As');
|
|
||||||
my $separator = Gtk3::SeparatorMenuItem->new();
|
|
||||||
my $exit_item = Gtk3::MenuItem->new_with_label('Exit');
|
|
||||||
|
|
||||||
$file_menu->append($_) for ($new_item, $open_item, $save_item, $save_as_item, $separator, $exit_item);
|
|
||||||
|
|
||||||
# Edit menu
|
|
||||||
my $edit_menu = Gtk3::Menu->new();
|
|
||||||
my $edit_item = Gtk3::MenuItem->new_with_label('Edit');
|
|
||||||
$edit_item->set_submenu($edit_menu);
|
|
||||||
$menubar->append($edit_item);
|
|
||||||
|
|
||||||
# Edit menu items
|
|
||||||
my $undo_item = Gtk3::MenuItem->new_with_label('Undo');
|
|
||||||
my $redo_item = Gtk3::MenuItem->new_with_label('Redo');
|
|
||||||
my $cut_item = Gtk3::MenuItem->new_with_label('Cut');
|
|
||||||
my $copy_item = Gtk3::MenuItem->new_with_label('Copy');
|
|
||||||
my $paste_item = Gtk3::MenuItem->new_with_label('Paste');
|
|
||||||
my $find_item = Gtk3::MenuItem->new_with_label('Find');
|
|
||||||
my $replace_item = Gtk3::MenuItem->new_with_label('Find and Replace');
|
|
||||||
my $select_all_item = Gtk3::MenuItem->new_with_label('Select All');
|
|
||||||
|
|
||||||
$edit_menu->append($_) for (
|
|
||||||
$undo_item, $redo_item,
|
|
||||||
Gtk3::SeparatorMenuItem->new(),
|
|
||||||
$cut_item, $copy_item, $paste_item,
|
|
||||||
Gtk3::SeparatorMenuItem->new(),
|
|
||||||
$find_item, $replace_item,
|
|
||||||
Gtk3::SeparatorMenuItem->new(),
|
|
||||||
$select_all_item
|
|
||||||
);
|
|
||||||
|
|
||||||
# Add Tools menu
|
|
||||||
my $tools_menu = Gtk3::Menu->new();
|
|
||||||
my $tools_item = Gtk3::MenuItem->new_with_label('Tools');
|
|
||||||
$tools_item->set_submenu($tools_menu);
|
|
||||||
|
|
||||||
# Add About menu
|
|
||||||
my $about_item = Gtk3::MenuItem->new_with_label('About');
|
|
||||||
$about_item->signal_connect(activate => sub {
|
|
||||||
show_info_dialog('About kPad', 'kPad version 6.0\nGTK3 version');
|
|
||||||
});
|
|
||||||
|
|
||||||
# Add HTML menu
|
|
||||||
my $html_item = Gtk3::MenuItem->new_with_label('HTML');
|
|
||||||
$html_item->signal_connect(activate => sub {
|
|
||||||
# Placeholder for HTML functionality
|
|
||||||
show_info_dialog('HTML', 'HTML functionality will be added soon.');
|
|
||||||
});
|
|
||||||
|
|
||||||
# Add Macros menu (placeholder)
|
|
||||||
my $macros_item = Gtk3::MenuItem->new_with_label('Macros');
|
|
||||||
$macros_item->signal_connect(activate => sub {
|
|
||||||
# Placeholder for Macros functionality
|
|
||||||
show_info_dialog('Macros', 'Macros functionality will be handled by the user.');
|
|
||||||
});
|
|
||||||
|
|
||||||
# Add new menu items to the menu bar
|
|
||||||
$menubar->append($tools_item);
|
|
||||||
$menubar->append($about_item);
|
|
||||||
$menubar->append($html_item);
|
|
||||||
$menubar->append($macros_item);
|
|
||||||
|
|
||||||
# Create text view with scrolled window
|
|
||||||
my $scrolled_window = Gtk3::ScrolledWindow->new();
|
|
||||||
$scrolled_window->set_policy('automatic', 'automatic');
|
|
||||||
$vbox->pack_start($scrolled_window, 1, 1, 0);
|
|
||||||
|
|
||||||
my $text_view = Gtk3::TextView->new();
|
|
||||||
$text_buffer = $text_view->get_buffer();
|
|
||||||
$text_view->set_wrap_mode('word');
|
|
||||||
$text_view->set_editable(1);
|
|
||||||
$text_view->set_cursor_visible(1);
|
|
||||||
|
|
||||||
# Create status bar
|
|
||||||
$status_bar = Gtk3::Statusbar->new();
|
|
||||||
$vbox->pack_start($status_bar, 0, 0, 0);
|
|
||||||
update_cursor_position();
|
|
||||||
|
|
||||||
# Track cursor movement for status bar updates
|
|
||||||
$text_buffer->signal_connect('mark-set' => sub {
|
|
||||||
my ($buffer, $iter, $mark) = @_;
|
|
||||||
if ($mark->get_name() eq 'insert') {
|
|
||||||
update_cursor_position();
|
|
||||||
}
|
|
||||||
});
|
|
||||||
|
|
||||||
# Enable copy/paste keyboard shortcuts
|
|
||||||
$text_view->signal_connect('key-press-event' => sub {
|
|
||||||
my ($widget, $event) = @_;
|
|
||||||
my $keyval = $event->keyval;
|
|
||||||
my $state = $event->state;
|
|
||||||
|
|
||||||
# Check if Control key is pressed (GDK_CONTROL_MASK)
|
|
||||||
if ($state & CONTROL_MASK) {
|
|
||||||
if (chr($keyval) eq 'z' || chr($keyval) eq 'Z') {
|
|
||||||
undo_action();
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'y' || chr($keyval) eq 'Y') {
|
|
||||||
redo_action();
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'c' || chr($keyval) eq 'C') {
|
|
||||||
$copy_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'x' || chr($keyval) eq 'X') {
|
|
||||||
$cut_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'v' || chr($keyval) eq 'V') {
|
|
||||||
$paste_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'f' || chr($keyval) eq 'F') {
|
|
||||||
$find_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'h' || chr($keyval) eq 'H') {
|
|
||||||
$replace_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
});
|
|
||||||
|
|
||||||
# Track buffer changes for undo/redo
|
|
||||||
$text_buffer->signal_connect('changed' => \&buffer_changed_cb);
|
|
||||||
$text_buffer->signal_connect('begin-user-action' => sub {
|
|
||||||
$ignore_changes = 0;
|
|
||||||
});
|
|
||||||
$text_buffer->signal_connect('modified-changed' => sub {
|
|
||||||
my $modified = $text_buffer->get_modified();
|
|
||||||
$window->set_title("kPad" . ($modified ? " *" : "") . (defined $current_file ? " - $current_file" : ""));
|
|
||||||
});
|
|
||||||
|
|
||||||
$scrolled_window->add($text_view);
|
|
||||||
|
|
||||||
# File menu callbacks
|
|
||||||
$new_item->signal_connect(activate => sub {
|
|
||||||
return unless check_save_changes();
|
|
||||||
|
|
||||||
$text_buffer->set_text('');
|
|
||||||
$text_buffer->set_modified(0);
|
|
||||||
$current_file = undef;
|
|
||||||
$window->set_title("kPad");
|
|
||||||
});
|
|
||||||
|
|
||||||
$open_item->signal_connect(activate => sub {
|
|
||||||
return unless check_save_changes();
|
|
||||||
|
|
||||||
my $dialog = Gtk3::FileChooserDialog->new(
|
|
||||||
'Open File',
|
|
||||||
$window,
|
|
||||||
'open',
|
|
||||||
'Cancel' => 'cancel',
|
|
||||||
'Open' => 'ok'
|
|
||||||
);
|
|
||||||
|
|
||||||
# Add file filters
|
|
||||||
my $filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('Perl Scripts');
|
|
||||||
$filter->add_pattern('*.pl');
|
|
||||||
$dialog->add_filter($filter);
|
|
||||||
|
|
||||||
$filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('All Files');
|
|
||||||
$filter->add_pattern('*');
|
|
||||||
$dialog->add_filter($filter);
|
|
||||||
|
|
||||||
if ('ok' eq $dialog->run()) {
|
|
||||||
my $filename = $dialog->get_filename();
|
|
||||||
open_file($filename);
|
|
||||||
}
|
|
||||||
$dialog->destroy();
|
|
||||||
});
|
|
||||||
|
|
||||||
$save_item->signal_connect(activate => sub {
|
|
||||||
if (defined $current_file) {
|
|
||||||
save_file($current_file);
|
|
||||||
} else {
|
|
||||||
$save_as_item->signal_emit('activate');
|
|
||||||
}
|
|
||||||
});
|
|
||||||
|
|
||||||
$save_as_item->signal_connect(activate => sub {
|
|
||||||
my $dialog = Gtk3::FileChooserDialog->new(
|
|
||||||
'Save File',
|
|
||||||
$window,
|
|
||||||
'save',
|
|
||||||
'Cancel' => 'cancel',
|
|
||||||
'Save' => 'ok'
|
|
||||||
);
|
|
||||||
|
|
||||||
# Add file filters
|
|
||||||
my $filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('Perl Scripts');
|
|
||||||
$filter->add_pattern('*.pl');
|
|
||||||
$dialog->add_filter($filter);
|
|
||||||
|
|
||||||
$filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('All Files');
|
|
||||||
$filter->add_pattern('*');
|
|
||||||
$dialog->add_filter($filter);
|
|
||||||
|
|
||||||
if ('ok' eq $dialog->run()) {
|
|
||||||
my $filename = $dialog->get_filename();
|
|
||||||
save_file($filename);
|
|
||||||
}
|
|
||||||
$dialog->destroy();
|
|
||||||
});
|
|
||||||
|
|
||||||
# Edit menu callbacks
|
|
||||||
$undo_item->signal_connect(activate => sub {
|
|
||||||
undo_action();
|
|
||||||
});
|
|
||||||
|
|
||||||
$redo_item->signal_connect(activate => sub {
|
|
||||||
redo_action();
|
|
||||||
});
|
|
||||||
|
|
||||||
$cut_item->signal_connect(activate => sub {
|
|
||||||
$text_buffer->cut_clipboard(
|
|
||||||
Gtk3::Clipboard::get(Gtk3::Gdk::Atom::intern('CLIPBOARD', 0)),
|
|
||||||
1
|
|
||||||
);
|
|
||||||
});
|
|
||||||
|
|
||||||
$copy_item->signal_connect(activate => sub {
|
|
||||||
$text_buffer->copy_clipboard(
|
|
||||||
Gtk3::Clipboard::get(Gtk3::Gdk::Atom::intern('CLIPBOARD', 0))
|
|
||||||
);
|
|
||||||
});
|
|
||||||
|
|
||||||
$paste_item->signal_connect(activate => sub {
|
|
||||||
$text_buffer->paste_clipboard(
|
|
||||||
Gtk3::Clipboard::get(Gtk3::Gdk::Atom::intern('CLIPBOARD', 0)),
|
|
||||||
undef,
|
|
||||||
1
|
|
||||||
);
|
|
||||||
});
|
|
||||||
|
|
||||||
$select_all_item->signal_connect(activate => sub {
|
|
||||||
my $start = $text_buffer->get_start_iter();
|
|
||||||
my $end = $text_buffer->get_end_iter();
|
|
||||||
$text_buffer->select_range($start, $end);
|
|
||||||
});
|
|
||||||
|
|
||||||
# Connect find/replace menu items
|
|
||||||
$find_item->signal_connect(activate => sub {
|
|
||||||
create_search_dialog();
|
|
||||||
$search_dialog->present();
|
|
||||||
});
|
|
||||||
|
|
||||||
$replace_item->signal_connect(activate => sub {
|
|
||||||
create_replace_dialog();
|
|
||||||
$replace_dialog->present();
|
|
||||||
});
|
|
||||||
|
|
||||||
# Helper functions
|
|
||||||
sub open_file {
|
|
||||||
my ($filename) = @_;
|
|
||||||
return unless -f $filename;
|
|
||||||
|
|
||||||
if (open(my $fh, '<:encoding(UTF-8)', $filename)) {
|
|
||||||
local $/;
|
|
||||||
my $content = <$fh>;
|
|
||||||
close $fh;
|
|
||||||
|
|
||||||
$text_buffer->set_text($content);
|
|
||||||
$text_buffer->set_modified(0);
|
|
||||||
$current_file = $filename;
|
|
||||||
$window->set_title("kPad - $filename");
|
|
||||||
} else {
|
|
||||||
show_error_dialog("Could not open file: $!");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub save_file {
|
|
||||||
my ($filename) = @_;
|
|
||||||
return unless defined $filename;
|
|
||||||
|
|
||||||
if (open(my $fh, '>:encoding(UTF-8)', $filename)) {
|
|
||||||
my $content = $text_buffer->get_text(
|
|
||||||
$text_buffer->get_start_iter(),
|
|
||||||
$text_buffer->get_end_iter(),
|
|
||||||
1
|
|
||||||
);
|
|
||||||
print $fh $content;
|
|
||||||
close $fh;
|
|
||||||
|
|
||||||
$current_file = $filename;
|
|
||||||
$text_buffer->set_modified(0);
|
|
||||||
$window->set_title("kPad - $filename");
|
|
||||||
} else {
|
|
||||||
show_error_dialog("Could not save file: $!");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub buffer_changed {
|
|
||||||
return $text_buffer->get_modified();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub check_save_changes {
|
|
||||||
if (buffer_changed()) {
|
|
||||||
my $dialog = Gtk3::MessageDialog->new(
|
|
||||||
$window,
|
|
||||||
'modal',
|
|
||||||
'question',
|
|
||||||
'none', # No default buttons
|
|
||||||
"The document has been modified. Save changes?"
|
|
||||||
);
|
|
||||||
|
|
||||||
$dialog->add_button('Save', 'yes');
|
|
||||||
$dialog->add_button("Don't Save", 'no');
|
|
||||||
$dialog->add_button('Cancel', 'cancel');
|
|
||||||
|
|
||||||
my $response = $dialog->run();
|
|
||||||
$dialog->destroy();
|
|
||||||
|
|
||||||
if ($response eq 'yes') {
|
|
||||||
if (defined $current_file) {
|
|
||||||
save_file($current_file);
|
|
||||||
return 1;
|
|
||||||
} else {
|
|
||||||
my $save_dialog = Gtk3::FileChooserDialog->new(
|
|
||||||
'Save File',
|
|
||||||
$window,
|
|
||||||
'save',
|
|
||||||
'Cancel' => 'cancel',
|
|
||||||
'Save' => 'ok'
|
|
||||||
);
|
|
||||||
|
|
||||||
# Add file filters
|
|
||||||
my $filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('Perl Scripts');
|
|
||||||
$filter->add_pattern('*.pl');
|
|
||||||
$save_dialog->add_filter($filter);
|
|
||||||
|
|
||||||
$filter = Gtk3::FileFilter->new();
|
|
||||||
$filter->set_name('All Files');
|
|
||||||
$filter->add_pattern('*');
|
|
||||||
$save_dialog->add_filter($filter);
|
|
||||||
|
|
||||||
my $save_response = $save_dialog->run();
|
|
||||||
my $filename = $save_dialog->get_filename();
|
|
||||||
$save_dialog->destroy();
|
|
||||||
|
|
||||||
if ($save_response eq 'ok' && defined $filename) {
|
|
||||||
save_file($filename);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
} elsif ($response eq 'no') {
|
|
||||||
return 1;
|
|
||||||
} else {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub show_error_dialog {
|
|
||||||
my ($message) = @_;
|
|
||||||
my $dialog = Gtk3::MessageDialog->new(
|
|
||||||
$window,
|
|
||||||
'modal',
|
|
||||||
'error',
|
|
||||||
'ok',
|
|
||||||
$message
|
|
||||||
);
|
|
||||||
$dialog->run();
|
|
||||||
$dialog->destroy();
|
|
||||||
}
|
|
||||||
|
|
||||||
sub create_search_dialog {
|
|
||||||
return if defined $search_dialog;
|
|
||||||
|
|
||||||
$search_dialog = Gtk3::Dialog->new();
|
|
||||||
$search_dialog->set_title('Find');
|
|
||||||
$search_dialog->set_transient_for($window);
|
|
||||||
$search_dialog->add_button('Close', 'close');
|
|
||||||
$search_dialog->add_button('Find Next', 'ok');
|
|
||||||
|
|
||||||
my $content_area = $search_dialog->get_content_area();
|
|
||||||
my $vbox = Gtk3::Box->new('vertical', 5);
|
|
||||||
$content_area->add($vbox);
|
|
||||||
|
|
||||||
my $hbox = Gtk3::Box->new('horizontal', 5);
|
|
||||||
$vbox->pack_start($hbox, 0, 0, 0);
|
|
||||||
|
|
||||||
$hbox->pack_start(Gtk3::Label->new('Search for:'), 0, 0, 0);
|
|
||||||
my $entry = Gtk3::Entry->new();
|
|
||||||
$hbox->pack_start($entry, 1, 1, 0);
|
|
||||||
|
|
||||||
my $case_sensitive = Gtk3::CheckButton->new_with_label('Case sensitive');
|
|
||||||
$vbox->pack_start($case_sensitive, 0, 0, 0);
|
|
||||||
|
|
||||||
$search_dialog->show_all();
|
|
||||||
|
|
||||||
$search_dialog->signal_connect(response => sub {
|
|
||||||
my ($dialog, $response) = @_;
|
|
||||||
if ($response eq 'ok') {
|
|
||||||
find_text($entry->get_text(), $case_sensitive->get_active());
|
|
||||||
} elsif ($response eq 'close') {
|
|
||||||
$dialog->hide();
|
|
||||||
}
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
||||||
sub create_replace_dialog {
|
|
||||||
return if defined $replace_dialog;
|
|
||||||
|
|
||||||
$replace_dialog = Gtk3::Dialog->new();
|
|
||||||
$replace_dialog->set_title('Find and Replace');
|
|
||||||
$replace_dialog->set_transient_for($window);
|
|
||||||
$replace_dialog->add_button('Close', 'close');
|
|
||||||
$replace_dialog->add_button('Replace', 'ok');
|
|
||||||
$replace_dialog->add_button('Replace All', 'apply');
|
|
||||||
|
|
||||||
my $content_area = $replace_dialog->get_content_area();
|
|
||||||
my $vbox = Gtk3::Box->new('vertical', 5);
|
|
||||||
$content_area->add($vbox);
|
|
||||||
|
|
||||||
# Find entry
|
|
||||||
my $find_box = Gtk3::Box->new('horizontal', 5);
|
|
||||||
$vbox->pack_start($find_box, 0, 0, 0);
|
|
||||||
$find_box->pack_start(Gtk3::Label->new('Find:'), 0, 0, 0);
|
|
||||||
my $find_entry = Gtk3::Entry->new();
|
|
||||||
$find_box->pack_start($find_entry, 1, 1, 0);
|
|
||||||
|
|
||||||
# Replace entry
|
|
||||||
my $replace_box = Gtk3::Box->new('horizontal', 5);
|
|
||||||
$vbox->pack_start($replace_box, 0, 0, 0);
|
|
||||||
$replace_box->pack_start(Gtk3::Label->new('Replace with:'), 0, 0, 0);
|
|
||||||
my $replace_entry = Gtk3::Entry->new();
|
|
||||||
$replace_box->pack_start($replace_entry, 1, 1, 0);
|
|
||||||
|
|
||||||
my $case_sensitive = Gtk3::CheckButton->new_with_label('Case sensitive');
|
|
||||||
$vbox->pack_start($case_sensitive, 0, 0, 0);
|
|
||||||
|
|
||||||
$replace_dialog->show_all();
|
|
||||||
|
|
||||||
$replace_dialog->signal_connect(response => sub {
|
|
||||||
my ($dialog, $response) = @_;
|
|
||||||
if ($response eq 'ok') {
|
|
||||||
replace_next($find_entry->get_text(), $replace_entry->get_text(), $case_sensitive->get_active());
|
|
||||||
} elsif ($response eq 'apply') {
|
|
||||||
replace_all($find_entry->get_text(), $replace_entry->get_text(), $case_sensitive->get_active());
|
|
||||||
} elsif ($response eq 'close') {
|
|
||||||
$dialog->hide();
|
|
||||||
}
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
||||||
sub find_text {
|
|
||||||
my ($search_text, $case_sensitive) = @_;
|
|
||||||
return unless $search_text;
|
|
||||||
|
|
||||||
my $buffer = $text_view->get_buffer();
|
|
||||||
my $start_iter = $buffer->get_iter_at_mark($buffer->get_insert());
|
|
||||||
|
|
||||||
# Start from beginning if we're at the end or no previous search
|
|
||||||
if (!defined $last_search_pos || !$start_iter->forward_char()) {
|
|
||||||
$start_iter = $buffer->get_start_iter();
|
|
||||||
}
|
|
||||||
|
|
||||||
my $found;
|
|
||||||
if ($case_sensitive) {
|
|
||||||
$found = $start_iter->forward_search($search_text, 'text-only', undef);
|
|
||||||
} else {
|
|
||||||
$found = $start_iter->forward_search($search_text, ['text-only', 'case-insensitive'], undef);
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($found) {
|
|
||||||
my ($match_start, $match_end) = @$found;
|
|
||||||
$buffer->select_range($match_start, $match_end);
|
|
||||||
$text_view->scroll_to_iter($match_start, 0.0, 1, 0.0, 0.5);
|
|
||||||
$last_search_pos = $match_end;
|
|
||||||
return 1;
|
|
||||||
} else {
|
|
||||||
# If not found from current position, try from start
|
|
||||||
if ($start_iter->get_offset() > 0) {
|
|
||||||
$last_search_pos = undef;
|
|
||||||
return find_text($search_text, $case_sensitive);
|
|
||||||
}
|
|
||||||
show_error_dialog("Text not found: $search_text");
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub replace_next {
|
|
||||||
my ($find_text, $replace_text, $case_sensitive) = @_;
|
|
||||||
return unless $find_text;
|
|
||||||
|
|
||||||
if (find_text($find_text, $case_sensitive)) {
|
|
||||||
my $buffer = $text_view->get_buffer();
|
|
||||||
$buffer->delete_selection(1, 1);
|
|
||||||
$buffer->insert_at_cursor($replace_text);
|
|
||||||
$last_search_pos = undef; # Force next search from current position
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub replace_all {
|
|
||||||
my ($find_text, $replace_text, $case_sensitive) = @_;
|
|
||||||
return unless $find_text;
|
|
||||||
|
|
||||||
my $count = 0;
|
|
||||||
$last_search_pos = undef;
|
|
||||||
|
|
||||||
while (find_text($find_text, $case_sensitive)) {
|
|
||||||
my $buffer = $text_view->get_buffer();
|
|
||||||
$buffer->delete_selection(1, 1);
|
|
||||||
$buffer->insert_at_cursor($replace_text);
|
|
||||||
$last_search_pos = undef;
|
|
||||||
$count++;
|
|
||||||
}
|
|
||||||
|
|
||||||
show_info_dialog("Replaced $count occurrence" . ($count == 1 ? '' : 's'));
|
|
||||||
}
|
|
||||||
|
|
||||||
sub update_cursor_position {
|
|
||||||
my $buffer = $text_view->get_buffer();
|
|
||||||
my $iter = $buffer->get_iter_at_mark($buffer->get_insert());
|
|
||||||
my $line = $iter->get_line() + 1;
|
|
||||||
my $column = $iter->get_line_offset() + 1;
|
|
||||||
$status_bar->push(0, "Line: $line, Column: $column");
|
|
||||||
}
|
|
||||||
|
|
||||||
sub show_info_dialog {
|
|
||||||
my ($message) = @_;
|
|
||||||
my $dialog = Gtk3::MessageDialog->new(
|
|
||||||
$window,
|
|
||||||
'modal',
|
|
||||||
'info',
|
|
||||||
'ok',
|
|
||||||
$message
|
|
||||||
);
|
|
||||||
$dialog->run();
|
|
||||||
$dialog->destroy();
|
|
||||||
}
|
|
||||||
|
|
||||||
# Connect window signals
|
|
||||||
$window->signal_connect(delete_event => sub {
|
|
||||||
if (!check_save_changes()) {
|
|
||||||
return 1; # Cancel the close
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
});
|
|
||||||
|
|
||||||
$window->signal_connect(destroy => sub { Gtk3::main_quit() });
|
|
||||||
$exit_item->signal_connect(activate => sub { $window->destroy() });
|
|
||||||
|
|
||||||
# Show all widgets
|
|
||||||
$window->show_all();
|
|
||||||
|
|
||||||
# Add these new functions at the end before Gtk3::main()
|
|
||||||
sub handle_key_press {
|
|
||||||
my ($widget, $event) = @_;
|
|
||||||
my $keyval = $event->keyval;
|
|
||||||
my $state = $event->state;
|
|
||||||
|
|
||||||
# Check if Control key is pressed
|
|
||||||
if ($state & CONTROL_MASK) {
|
|
||||||
if (chr($keyval) eq 'z' || chr($keyval) eq 'Z') {
|
|
||||||
undo_action();
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'y' || chr($keyval) eq 'Y') {
|
|
||||||
redo_action();
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'c' || chr($keyval) eq 'C') {
|
|
||||||
$copy_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'x' || chr($keyval) eq 'X') {
|
|
||||||
$cut_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
elsif (chr($keyval) eq 'v' || chr($keyval) eq 'V') {
|
|
||||||
$paste_item->signal_emit('activate');
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub buffer_changed_cb {
|
|
||||||
return if $ignore_changes;
|
|
||||||
|
|
||||||
my $content = $text_buffer->get_text(
|
|
||||||
$text_buffer->get_start_iter(),
|
|
||||||
$text_buffer->get_end_iter(),
|
|
||||||
1
|
|
||||||
);
|
|
||||||
|
|
||||||
push @undo_stack, $content;
|
|
||||||
@redo_stack = (); # Clear redo stack when new changes occur
|
|
||||||
}
|
|
||||||
|
|
||||||
sub undo_action {
|
|
||||||
return unless @undo_stack;
|
|
||||||
|
|
||||||
my $current_content = $text_buffer->get_text(
|
|
||||||
$text_buffer->get_start_iter(),
|
|
||||||
$text_buffer->get_end_iter(),
|
|
||||||
1
|
|
||||||
);
|
|
||||||
|
|
||||||
push @redo_stack, $current_content;
|
|
||||||
|
|
||||||
$ignore_changes = 1;
|
|
||||||
my $prev_content = pop @undo_stack;
|
|
||||||
$text_buffer->set_text($prev_content);
|
|
||||||
$ignore_changes = 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub redo_action {
|
|
||||||
return unless @redo_stack;
|
|
||||||
|
|
||||||
my $current_content = $text_buffer->get_text(
|
|
||||||
$text_buffer->get_start_iter(),
|
|
||||||
$text_buffer->get_end_iter(),
|
|
||||||
1
|
|
||||||
);
|
|
||||||
|
|
||||||
push @undo_stack, $current_content;
|
|
||||||
|
|
||||||
$ignore_changes = 1;
|
|
||||||
my $next_content = pop @redo_stack;
|
|
||||||
$text_buffer->set_text($next_content);
|
|
||||||
$ignore_changes = 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Start the main loop
|
|
||||||
Gtk3::main();
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue