kake26/kpadold
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove old Perl/Tk version and port to GTK3 with improved syntax highlighting

Browse source
This commit is contained in:
kake26 2025-04-30 11:46:11 -05:00
parent 868aabae0a
commit 586cb285d3
Signed by: kake26
GPG key ID: E0A989B571D1F99F
3 changed files with 4 additions and 1073 deletions
Download patch file Download diff file Expand all files Collapse all files

4
README.md
View file

@ -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.
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
View file

@ -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
View file

@ -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();