Perl Tk:帮助我修复文本编辑器中的突出显示

Question

所以我正在用Perl Tk编写一个文本编辑器，我有一个用于突出显示的子例程，它插入了两个突出显示的空格供您输入。

我有 3 个问题。

1. 我希望光标在触发突出显示子例程时移动到左侧 1 个空间。因此，当插入突出显示或下划线样式时，光标会自动位于两个空格之间，用户可以立即键入该样式，而不必使用左箭头键。我想我的问题是如何在光标而不是文件末尾插入样式。

2. 子例程的文本格式未正确保存到文件类型。我目前正在使用.rtf。

3. 我想实现一个从系统字体列表中提取的下拉字体选择菜单，但我不确定如何实现。

#!/usr/local/bin/perl
#!/C:/Perl/site/lib
use Tk;
use utf8;
use vars qw/$TOP/;
# Main Window
my $mw = new MainWindow;
#Making a text area
my $txt = $mw -> Scrolled('Text', -width => 50,-scrollbars=>'e') -> pack (), -setgrid => true;
#Declare that there is a menu
my $mbar = $mw -> Menu();
$mw -> configure(-menu => $mbar);
#The Main Buttons
my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $others = $mbar -> cascade(-label =>"Others", -underline=>0, -tearoff => 0);
my $help = $mbar -> cascade(-label =>"Help", -underline=>0, -tearoff => 0);
## File Menu ##
$file -> command(-label => "New", -underline=>0, 
-command=>sub { $txt -> delete('1.0','end');} );
$file -> checkbutton(-label =>"Open", -underline => 0,
-command => [&openfunction, "Open"]);
$file -> command(-label =>"Save", -underline => 0,
-command => [&savefunction, "Save"]);
$file -> separator();
$file -> command(-label =>"Exit", -underline => 1,
-command => sub { exit } );
## Others Menu ##
my $insert = $others -> cascade(-label =>"Insert", -underline => 0, -tearoff => 0);
$insert -> command(-label =>"Highlight", 
-command => [&highlight, "Highlight"]);
$insert -> command(-label =>"Underline", 
-command => [&underline, "Underline"]);
$insert -> command(-label =>"Title", 
-command => [&bold, "Title"]);
$insert -> command(-label =>"Stippling", 
-command => [&stippling, "Stippling"]);
$insert -> command(-label =>"Find & Replace", 
-command => [&find_replace, "Find & Replace"]);
$insert -> command(-label =>"Name", 
-command => sub { $txt->insert('end',"Name : Thaddeus Roebuck Badgercockn");});
$insert -> command(-label =>"Bullet Point", -command=>sub { 
$txt->insert('end',"⚫t");});
$insert -> command(-label =>"Email", 
-command=> sub {$txt->insert('end',"E-Mail :n");});
$others -> command(-label =>"Insert All", -underline => 7,
-command => sub { $txt->insert('end',"Name : Thaddeus Roebuck Badgercock
Website : 
E-Mail :");
});
## Help ##
$help -> command(-label =>"About", -command => sub { 
$txt->delete('1.0','end');
$txt->insert('end',
"About
----------
This is a simple text editor written in Perl Tk. This program is licensed under the GNU Public License and is Free Software.
"); });

## Tags ##
$txt->tag(qw/configure bgstipple  -background black -borderwidth 0
-bgstipple gray12/);
$txt->tag(qw/configure bold    -font C_bold/);
$txt->tag(qw/configure color1 -background/ => '#a0b7ce');
$txt->tag(qw/configure raised -background white -relief raised/);
$txt->tag(qw/configure sunken -background white -relief sunken/);
$txt->tag(qw/configure underline  -underline on/);
MainLoop; 
sub find_replace {
$txt->FindAndReplacePopUp;
}
sub stippling {
$txt->insert('end', '  ', 'bgstipple');
} # end style
sub bold {
$txt->insert('end', '  ', 'bold');
}
sub highlight {
$txt->insert('end', '  ', 'color1');
}
sub raised {
$txt->insert('end', '  ', 'raised');
}
sub underline {
$txt->insert('end', '  ', 'underline'); #how do 
}

sub savefunction {
my $fileDataToSave=$txt->get("1.0","end"); 
# Trigger dialog
$filename = $mw->getSaveFile( -title =>  "Selecting file to Save",
-defaultextension => '.rtf', -initialdir => '.' );
# save the file 
open(my $fh, '>', $filename) or die $!;
print $fh $fileDataToSave;
close $fh;
}
sub openfunction {
# function to get file dialog box
$filename = $mw->getOpenFile( -title => "Selecting file to Load",
-defaultextension => '.txt', -initialdir => '.' );
# function to load file into string e.g. if you have use File::Slurp
open($fh, '<', $filename) or die $!;
my $file_content = do { local $/; <$fh> };
close $fh;
$txt->Contents($file_content)
}
sub menuClicked {
my ($opt) = @_;
$mw->messageBox(-message=>"You have clicked $opt.
This function is not implemented yet.");
}
#todo:
#figure out how to package as monolithic executables for various platforms

Answer 1

您可以使用以下命令在当前光标位置插入突出显示格式：

sub highlight {
$txt->insert('insert', '  ', 'color1');
$txt->SetCursor( 'insert - 1 chars' ); # <-- moves the cursor back into the 
#     hightlight region
}