Jetzt wollen wir uns ansehen wie wir ein Menü erzeugen können um Beispielsweise einen Texteditor zu erzeugen..........

#!/usr/local/bin/perl -w

use strict;
use Tk;

# Deklarationen unserer Variablen
my ($mw);
my ($mb, $m_file, $m_edit, $m_opts, $m_help);
my ($m_help_about);
my ($o_radio, $o_check1, $o_check2)=0;

# Wir erzeugen ein neues Fenster
$mw = MainWindow->new();


##### Zuerst erstellen wir eine horizontale Menübar
$mb = $mw->Frame(-relief => 'ridge', -bd => 5);

# Jetzt erstellen wir die Menübuttons für die Menübar
$m_file = $mb->Menubutton(-text      => "Datei",
                          -underline => 1);
#underline=Buchstabennummer die Unterstichen werden soll <-= a
$m_edit = $mb->Menubutton(-text      => "Bearbeiten",
                          -underline => 0);
$m_opts = $mb->Menubutton(-text      => "Optionen",
                          -underline => 0);
$m_help = $mb->Menubutton(-text      => "Hilfe",
                          -underline => 0);

# Zeig es uns
$mb->pack(-side => "top", -fill => "x");
$m_file->pack(-side => "left");
$m_edit->pack(-side => "left");
$m_opts->pack(-side => "left");
$m_help->pack(-side => "right");

#### Jetzt erstellen wir die Untermenüs

# Die Dateimenüs
$m_file->command(-label => "Neu",
                 -command => [\&file, "neu"]);
$m_file->command(-label => "Öffnen",
                 -command => [\&file, "open"]);
$m_file->command(-label => "Speichern",
                 -command => [\&file, "speichern"],
                 -state => "disabled");  #Deaktiviert
$m_file->command(-label => "Speichern unter...",
                 -command => [\&file, "speichern unter..."],
                 -state => "disabled");   #Deaktiviert
#Ein Seperator der immer unten positioniert wird  und von den anderen Getrennt ist
$m_file->separator();
$m_file->command(-label => "Exit",
                 -underline => 1,
                 -command => sub { exit 0; });

# Berarbeiten Untermenü
$m_edit->command(-label   => "Kopieren",
                 -command => [\&edit, "kopieren"]);
$m_edit->command(-label   => "Ausschneiden",
                 -command => [\&edit, "ausschneiden"]);
$m_edit->command(-label => "Einfügen",
                 -command => [\&edit, "einfügen"]);

# Optionsmenü
$m_opts->command(-label   => "Ausführen",
                 -command => [\&opts, "ausführen"]);
#Wieder seperat..............
$m_opts->separator();
#Checkboxen und Radiobuttons
$m_opts->checkbutton(-label    => "Check 1",
                     -variable => \$o_check1,
                     -command  => [\&opts, "check"]);
$m_opts->checkbutton(-label    => "Check 2",
                     -variable => \$o_check2,
                     -command  => [\&opts, "check"]);
$m_opts->separator();
$m_opts->radiobutton(-label    => "Radio 1",
                     -variable => \$o_radio,
                     -value    => "r1",
                     -command  => [\&opts, "radio"]);
$m_opts->radiobutton(-label    => "Radio 2",
                     -variable => \$o_radio,
                     -value    => "r2",
                     -command  => [\&opts, "radio"]);

# Hilfe Menu
$m_help->command(-label => "Inhalt",
                 -command => [\&help, "inhalt"]);
$m_help->command(-label => "Hilfe",
                -command => [\&help, "hilfe"]);
#wieder mal seperat
$m_help->separator();

#Ein Untermenü im Untermenü...............
$m_help_about = $m_help->cget(-menu)->Menu();
$m_help->cascade(-label => "Über.....",
                  -menu => $m_help_about);
#Inhalt des Unter-Untermenü ;)
$m_help_about->command(-label => "Perl",
                       -command => [\&about, "perl"]);
$m_help_about->command(-label => "Tk",
                       -command => [\&about, "tk"]);
$m_help_about->command(-label => "UNIX",
                       -command => [\&about, "unix"]);
$m_help_about->command(-label => "C/C++",
                        -command => [\&about, "C/C++"]);

MainLoop;

#### die callbacks
sub file {
    my ($arg) = @_;
    my $tw=$mw->Toplevel(-title => "Datei $arg");
    my $mes=$tw->Message(-text => "Datei $arg ist nicht aktiv",
                         -width => '10c', -justify => 'center')->
                         pack(-side => 'top');
    my $but=$tw->Button(-text => "Schließen",
                        -command => [$tw => 'destroy'])->pack(-side => 'top');
}

sub edit {
    my ($arg) = @_;
    my $tw=$mw->Toplevel(-title => "Bearbeitung $arg");
    my $mes=$tw->Message(-text => "Bearbeitung $arg ist nicht aktiv",
                         -width => '10c', -justify => 'center')->
                         pack(-side => 'top');
    my $but=$tw->Button(-text => "Schließen",
                        -command => [$tw => 'destroy'])->
                        pack(-side => 'top');
}

sub opts {
    my ($arg) = @_;
    print "opts: $arg\n";
    print "radio  : $o_radio\n";
    print "check 1: $o_check1\n";
    print "check 2: $o_check2\n";
}

sub help {
    my ($arg) = @_;
    my $tw=$mw->Toplevel(-title => "Hilfe $arg");
    my $mes=$tw->Message(-text => "Hilfe $arg ist nicht aktiv",
                         -width => '10c', -justify => 'center')->
                         pack(-side => 'top');
    my $but=$tw->Button(-text => "Schließen",
                        -command => [$tw => 'destroy'])->
                        pack(-side => 'top');
}

sub about {
    my ($arg) = @_;
    print "about: $arg\n";
}

So siehts aus :

Das Programm scheint auf den ersten Blick durch seine Länge etwas abschreckend. Ist aber im Prinzip simpel und der Allgemeine Vorgang eine Menü aufzubauen. Zuerst erzeugen wir ein Hauptfenster, dann ein Frame. Anschließend erstellen wir mit......

Menubutton()

......die einzelnen Menübuttons. Anschließend erstellen wir mittels..............

$m_file->command(-label => "Neu", -command => [\&file, "neu"]);  

....entsprechende Untermenüs mit dem Label und möglichst auch mit einer Callbackfunktion. Um ein weiteres Untermenü im Untermenü zu erstellen verwenden wir........

$m_help_about = $m_help->cget(-menu)->Menu();

Die einzelnen Callbackfunktionen sind eigentlich Nutzlos und öffnen nur ein neues Fenster mit einer Message die wir mit............

 my $mes=$tw->Message(-text => "Datei $arg ist nicht aktiv",
 -width => '10c', -justify => 'center')->pack(-side => 'top');

.............erzeugt haben.