Tk::Menubutton

Tk::Menubutton

Ein Tk::Menubutton ist ein Widget, das einen Text, ein Bitmap oder ein Bild anzeigt. In der Regel klappt ein Menü auf, wenn man auf einen Menubutton klickt.

Perl-Quellcode

#!perl

use strict;
use warnings;
use utf8;
use Tk;
use Tk::Menu;
use Path::Tiny;

my $current_file = undef;
my @ext = (
	["Text Files",	[qw/.txt/]],
	["All files",	[qw/*/]],
);
my $default_window_title = 'Wannabe Editor';

my $mw = Tk::MainWindow->new(-title => $default_window_title);

my $menuitems = [
    [Cascade => "~Datei", -menuitems =>
        [
            [Button => "~Neu", -command => \&new_file],
            [Separator => ''],
            [Button => "Ö~ffnen", -command => \&open_file],
            [Button => "~Speichern", -command => \&save_file],
			[Separator => ''],
			[Button => "~Beenden", -command => sub{ $mw->destroy; exit(0); }],
        ],
    ],
];
     
my $menu = $mw->Menu(-menuitems => $menuitems);

$mw->configure(-menu => $menu);

my $editor = $mw->Text()->pack(-fill => 'both',);

$mw->MainLoop();
exit(0);

sub open_file {
	
	my $answer = $mw->getOpenFile(
		-filetypes => \@ext,
	);

	if ( $answer ) {
		my $file = path($answer);
		my $guts = $file->slurp_utf8;
		$editor->delete('0.0', 'end');
		$editor->insert('0.0', $guts);
		
		_set_current_file( $answer );
	}
	
	return;
} # /open_file


sub save_file {
	
	unless( $current_file ) {
		# new file, ask for target file name
		my $answer = $mw->getSaveFile(
			-filetypes => \@ext,
		);
		return unless $answer;
		
		_set_current_file( $answer );
	}
	my $data = $editor->get('0.0', 'end');
	chomp($data);
	path($current_file)->spew_utf8($data);
	
	return;
} # /save_file


sub new_file {
	$editor->delete('0.0', 'end');
	$current_file = undef;
	$mw->configure(-title => $default_window_title);
} # /new_file


sub _set_current_file {
	my $file = shift;
	$mw->configure(-title => sprintf('%s (%s)', path($file)->basename, path($file)));
	$current_file = $file;
} # /_set_current_file