Ｔｋｘでリストボックス

Ｐｅｒｌの５．２６から＠ＩＮＣにカレントディレクトリ「．」を含まないそうです。ウチのＡｃｔｉｖｅＰｅｒｌ（５．２０）は含んでいます。という訳で＠ＩＮＣを表示してみましょう。コンソールに出すのはつまらないのでリストボックスに入れるとこんな感じ。

#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;
use open IO => ":utf8";

use Encode::Locale;
use File::Basename;
use Tkx;
use Tkx::Scrolled;

use menu_build;

binmode STDOUT, ":encoding(cp932)";

$| = 1;

# リストボックス内の文字を等幅にするため一律でフォントを指定
Tkx::option_add("*Listbox.font", "System");

my $mw = Tkx::widget->new(".");
menu_build($mw, [
	[ "ファイル", "F", [
		[ "終了", "X", \&wm_delete_window, ],
	], ],
]);

$mw->g_wm_title("＠ＩＮＣを表示");
$mw->g_wm_minsize(200, 0);
$mw->g_wm_protocol(WM_DELETE_WINDOW => \&wm_delete_window);
$mw->g_wm_resizable(0, 0);

my $dialog_width = 40;
my $inc_lbx = $mw->new_tkx_Scrolled(
	"listbox",
	-selectmode => "extended",
	-scrollbars => "e",
	-width => $dialog_width,
	-height => 10,
	-activestyle => "none",
);
$inc_lbx->g_pack(-anchor => "w");

for (@INC) {
	$inc_lbx->insert("end", $_);
}

Tkx::MainLoop();

exit;



sub wm_delete_window {
	$mw->g_destroy;
}

上のスクリプトのmenu_buildは別モジュールにしてありファイル名はmenu_build.pmです。

sub menu_build {
	my ($mainwindow, $tree) = @_;
	my $top = $mainwindow->new_menu;

	for (@$tree) {
		my $second = $top->new_menu( -tearoff => 0, );
		$top->add_cascade(
			-label => "${$_}[0](${$_}[1])",
			-underline => 1 + length ${$_}[0],
			-menu => $second,
		);
		for (@{${$_}[2]}) {
			my $label = ${$_}[0];
			my $label_after = "";
			my $underline = 1 + length ${$_}[0];
			if ($label =~ /\.\.\.$/) {
				$label =~ s/\.\.\.$//;
				$label_after = "...";
				$underline -= 3;
			}
			$label .= "(${$_}[1])$label_after";
			if ("CODE" eq ref ${$_}[2]) {
				$second->add_command(
					-label => $label,
					-underline => $underline,
					-command => ${$_}[2],
 				);
			} elsif ("SCALAR" eq ref ${$_}[2]) {
				$second->add_checkbutton(
					-label => $label,
					-underline => $underline,
					-variable => ${$_}[2],
					-offvalue => 0,
					-onvalue => 1,
 				);
			}
		}
	}

	$mainwindow->configure(-menu => $top);
}

1;