- 论坛徽章:
- 0
|
谁能用perl TK 做unix下的通用菜单?
下面是一部分主要代码
注释能写的都写上了
$menu_ini_filename = 'menu.ini'; # menu 设置文件的位置名称
$ql_ini_filename = 'ql.ini'; # quick launch 设置文件的位置名称
$multi_language_filename = 'language.ini'; # 多语言支持的 文件位置名称
$menu_font_style = '-adobe-helvetica-normal-r-narrow--14-120-55-55-p-70-iso8859';# menu 字体设置
$text_font_style = '-adobe-verdana-normal-r-narrow--14-120-55-55-p-70-iso8859';# text 字体设置
$doc_n = 1; # Document 栏的起始标号
$MAX_DOC = $doc_n+5; # Document 栏的最大标号 , $doc_n + N , N 为想限制的最大document数目
$menu_tearoff = 1; # menu 下可扩展 是否要
%language = ( 'english'=>;0 , 'chinese'=>;1 );
$language = $language{'english'}; # 默认语言选择
@opened_file = undef; # 打开的文件
use Tk;
use Tk::Balloon;
use Tk::NoteBook;
require "me_func.pl"; # 该文件是 函数库
$main_window = MainWindow->;new( '-title'=>;'manEditor!' ); # 设置title
$main_window->;geometry("+0+0" # 调整窗口到 n w
create_ui(); # 调用函数 create_ui
MainLoop; # tk 循环
# create_ui = create user-interface
# 此函数创建了 窗口的个个widget
# 详细介绍见内
sub create_ui {
# 调用 create_frame 可创造几个 frame,整个窗口设计都是用frame来构件的
# create_frame 用法 ： create_frame( frame_name , pack_arg );
# 函数直接建立起来几个frame, 并建立了全局变量，就是个个 $frame_name
create_frame(
['menu_frame',q{'-side'=>;'top' , '-expand'=>;0 , '-fill'=>;'x'}],
['ql_frame',q{'-side'=>;'top' , '-expand'=>;0 , '-fill'=>;'x'}],
['doc_frame',q{'-side'=>;'top' , '-expand'=>;1 , '-fill'=>;'both'}],
['status_frame',q{'-side'=>;'bottom' , '-expand'=>;0 , '-fill'=>;'x'}]
);
# 调用函数 get_menu_ini , 格式 : get_menu_ini ( file_name );
# 是读取 file_name 中的内容，然后分析，并返回一个 array ref, 里面有相关数据
$ra_menu = get_menu_ini($menu_ini_filename);
# 调用函数 get_multi_language_support ( file_name );
# 类似get_menu_ini,返回 hash ref
$rh_language = get_multi_language_support($multi_language_filename);
# 建立 menu_bar
$menubar = $menu_frame->;Menu( '-type'=>;'menubar' );
$main_window->;configure( '-menu' =>; $menubar);
# 从这里是建立 menu
my $last_menu; # 此值是保存上次循环中的 menu 名称 ， 供下次循环中 menu 下的各个元素使用
my $last_cascade; # 此值是保存上次 menu 下某一可扩展元素，即 cascade 的值，供下次循环中其 cascade 中的元素使用
foreach my $menu_tmp (@$ra_menu) { # 进入循环
unless (ref($menu_tmp)) { # 若该值不是一个 ref , 那么开始写主 menu
$last_menu=$menu_tmp; # 保存此 menu name , 供下一循环中元素使用
if (defined $$rh_language{$menu_tmp}[$language]) { # 判断看 language.ini 中时候有匹配内容
${$menu_tmp} = $menubar->;cascade( '-label'=>;$$rh_language{$menu_tmp}[$language] , '-tearoff'=>;$menu_tearoff ); # 若有，则按照language.ini的设置来显示
} else {
${$menu_tmp} = $menubar->;cascade( '-label'=>;$menu_tmp , '-tearoff'=>;$menu_tearoff ); # 若无，则直接显示其 关键字
}
} else { # 若该值是一个 ref
foreach my $menu_cascade_tmp (@$menu_tmp) { # 开始循环此 ref 指向的匿名 array
unless (ref $menu_cascade_tmp) { # 若ref 指向的匿名 array 中的一个元素不是 ref
if ($menu_cascade_tmp !~ /\t/) { # 若在 此循环中的元素 中找不到\t，就是说 此行不符合 格式规定，那么那就是一个 作用行，即只能有 可显示的内容，但无实际作用
if ($menu_cascade_tmp eq "___" { # 若 此 内容 为 ___
${$last_menu}->;separator(); # 则在 menu 内画一个分隔符
} else {
$last_cascade=$menu_cascade_tmp; # 否则 这是一个新的 cascade 的开始
if (defined $$rh_language{$menu_cascade_tmp}[$language]) { # 还是 language.ini 判断
${$last_menu}{$last_cascade} = ${$last_menu}->;cascade( '-label'=>;$$rh_language{$menu_cascade_tmp}[$language] , '-tearoff'=>;0 , '-font'=>;$menu_font_style );
} else {
${$last_menu}{$last_cascade} = ${$last_menu}->;cascade( '-label'=>;$menu_cascade_tmp , '-tearoff'=>;0 , '-font'=>;$menu_font_style );
}
}
} else { # 若在 此循环中的元素 中找到了\t,那么理论上说这个行是符合 command.radiobutton etc.的设计要求的
my($label,$class,$func)=split(/\t/,$menu_cascade_tmp); # 分割此行,分别赋值 $labe=要显示的关键字,$class=此行的类别(command,radiobutton),$func=此命令指向的函数 or radiobuttn 设定的值
if (defined $$rh_language{$label}[$language]) { # language.ini 分析
eval q{${$last_menu}{$label} = ${$last_menu}->;command( '-label'=>;$$rh_language{$label}[$language] , '-font'=>;$menu_font_style , '-command'=>;}.$func.q{ ) if $class eq "cmd";};
} else {
eval q{${$last_menu}{$label} = ${$last_menu}->;command( '-label'=>;$label , '-font'=>;$menu_font_style , '-command'=>;}.$func.q{ ) if $class eq "cmd";};
}
print "Error: $@ \n" if $@ and $DEBUG;
# 此处 的 radiobutton 还没有写好，回头完成
#if ($class eq "radio" {
#${$last_menu}->;radiobutton( '-label'=>;$label , '-variable'=>;\${$last_menu}{$label} );
#}
# 到此处
}
} else { # 若ref 指向的匿名array 中的元素是 ref
foreach my $cascade_tmp (@{$menu_cascade_tmp}) { #开始循环读取其中的数据
my($label,$class,$func)=split(/\t/,$cascade_tmp); # 因为设置最多有两层，所以此处不在分析是否是 ref,而直接分析其内容，赋值给 $label,$class,$func
if (defined $$rh_language{$label}[$language]) { # language.ini 分析
eval q{${$last_cascade.'_'.$last_menu}{$label} = ${$last_menu}{$last_cascade}->;command( '-label'=>;$$rh_language{$label}[$language] , '-font'=>;$menu_font_style , '-command'=>;}.$func.q{ ) if $class eq "cmd";};
} else {
eval q{${$last_cascade.'_'.$last_menu}{$label} = ${$last_menu}{$last_cascade}->;command( '-label'=>;$label , '-font'=>;$menu_font_style , '-command'=>;}.$func.q{ ) if $class eq "cmd";};
}
print "Error: $@ \n" if $@ and $DEBUG;
# 此处
#if ($class eq "radio" {
#${$last_cascade}->;radiobutton( '-label'=>;$label , '-variable'=>;\${$last_cascade}{$label} );
#}
# 到此处
}
}
}
}
}
# 这里是建立 status 栏
$help_status = $status_frame->;Label( '-relief'=>;'flat' , '-width'=>;30 , '-anchor'=>;'w' )->;pack( '-side'=>;'left' , '-expand'=>;1 , '-fill'=>;'x' ); # 帮助信息
$time_status = $status_frame->;Label( '-text'=>;''.localtime , '-relief'=>;'groove' )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' ); # 时间
$ir_status = $status_frame->;Label( '-text'=>;'In/Re' , '-width'=>;6 , '-relief'=>;'groove' )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' ); # inesrt or replace
$rc_status = $status_frame->;Label( '-text'=>;'R,C: x,y' , '-width'=>;10 , '-relief'=>;'groove' )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' ); # row? col?
$file_status = $status_frame->;Label( '-relief'=>;'groove' , '-anchor'=>;'w' , '-width'=>;16 )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' ); # file info
$ql_frame->;configure( '-relief'=>;'groove' , '-borderwidth'=>;2 ); # config quicklaunch_frame , add attributes : relief , borderwidth
# 调用函数 get_ql_ini ( file_name );返回一个 array ref
$ra_ql = get_ql_ini($ql_ini_filename);
# 下面开始用模块 balloon 做帮助信息
$balloon = $main_window->;Balloon( '-statusbar'=>;$help_status ); # 把状态显示，帮助信息显示 bind 到 status中
# 开始做 balloon , 从 $ra_ql 中得数据
foreach my $r_ql (@$ra_ql) {
if (ref $r_ql) {
my $msg = $$rh_language{$$r_ql[2]}[$language];
$main_window-> hoto( 'ql_image_'.$$r_ql[2] , '-file'=>;$$r_ql[0] ); # 引入一个图片，作为 quick launch 的图标
eval q{$ql_button_}.$$r_ql[2].q{ = $ql_frame->;Button( '-image'=>;'ql_image_'.$$r_ql[2] , '-command'=>;$$r_ql[1] , '-height'=>;24 , '-width'=>;24 )->;pack( '-side'=>;'left' , '-fill'=>;'x' ); # 制作一个 quick launch button
$balloon->;attach($ql_button_}.$$r_ql[2].q{, '-balloonmsg'=>;$msg , '-statusmsg'=>;$msg , '-initwait'=>;1000 );}; # 用 balloon :: attach method 来 bind 到 quick launch button 上
print "Error: $@ \n" if $@ and $DEBUG;
} elsif ($r_ql eq "separator" { # 分析，若是特殊的 separator , 即 分隔符 信息的话 ， 则执行分割操作
$ql_frame->;Label( '-relief'=>;'groove' )->;pack( '-side'=>;'left' , '-expand'=>;0 ); # 建立一个 label 形式的分隔符 ，*有待改进*
}
}
# 这里开始制作 n.o.p 三个 button
$pre_msg = "preview";
$nor_msg = "normal";
$org_msg = "original";
# 因为 $pre_msg,$nor_msg,$org_msg 在后面的 me_func.pl 的 change_language() 中还要用到其原始值，所以后面要做一个新的程序块
{
my $pre_msg = $$rh_language{$pre_msg}[$language] if defined $$rh_language{$pre_msg}[$language];
my $nor_msg = $$rh_language{$nor_msg}[$language] if defined $$rh_language{$nor_msg}[$language];
my $org_msg = $$rh_language{$org_msg}[$language] if defined $$rh_language{$org_msg}[$language];
$pre_button = $ql_frame->;Button( '-text'=>;$pre_msg )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' );
$nor_button = $ql_frame->;Button( '-text'=>;$nor_msg )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' );
$org_button = $ql_frame->;Button( '-text'=>;$org_msg )->;pack( '-side'=>;'right' , '-expand'=>;0 , '-fill'=>;'x' );
}
# 为三个 button 做 bind
$balloon->;attach($pre_button, '-statusmsg'=>;'Preview man Page' , '-initwait'=>;10 );
$balloon->;attach($nor_button, '-statusmsg'=>;'View Normal man Page' , '-initwait'=>;10 );
$balloon->;attach($org_button, '-statusmsg'=>;'View Origional man Page' , '-initwait'=>;10 );
$doc_frame->;configure( '-borderwidth'=>;2 ); # config $doc_frame , Document Frame
$document = $doc_frame->;NoteBook()->;pack( '-side'=>;'top' , '-expand'=>;1 , '-fill'=>;'both' ); # 建立一个 NoteBook
# 用 eval 的方法，可以建立一个新的 document , 并用到了 $doc_n 来作为 doc 标记号码
# 具体实现如下 : $doc1 = $document->;add('doc1','-label'=>;'...');
# 然后添加一个 Scrolled 的 Text 物件 : $doc1->;Scrolled('Text', '-arg'=>;'set' );
eval q{$doc}.$doc_n.q{ = $document->;add('doc}.$doc_n.q{' , '-label'=>;'Untitled }.$doc_n.q{');
$doc}.$doc_n.q{_text = $doc}.$doc_n.q{->;Scrolled('Text', '-scrollbars'=>;'se' , '-font'=>;$text_font_style )->;pack( '-side'=>;'top' , '-expand'=>;1 , '-fill'=>;'both' );};
print "Error: $@ \n" if $@ and $DEBUG;
$main_window->;OnDestroy(sub { $balloon->;destroy; }); # 若窗口关闭，则消除 Balloon
};
sub get_menu_ini {
# 从 文件 中读信息，转换为 array 数据
my $file = pop;
my @menu;
open(MENU,"<$file"
while(<MENU> {
chomp;next if /^#/;next if /^\s+/;next if /^$/; # 若为#开头，空行则读下一行
if (/^\[([\w\s]+)\]$/) { # 若以 [] 为标记的内容 ， 则确认为一个新 menu 的开始
my $menu_title = $1; # 设置 menu_title 为 []中匹配的值
$menu[@menu]=$menu_title; # @menu为现在 array @menu的长度，$menu[@menu] 则为 @menu 中的下一元素 , 赋 $menu_title , 功效同 push(@menu,$menu_title);
while (<MENU> { # 进入设置 menu 中第一层元素
chomp;next if /^#/;next if /^\s+/;next if /^$/;
last if /^\[\/$menu_title\]/; # 若以[/..]开头，则返回
if (/^\(([\w\s]+)\)$/) { # 若以 () 为标记内容，则确认为一个 menu 中新的一层的开始
my $cascade_title = $1; # 把新层名定为 $cascade_title , 为 () 中匹配内容
$menu[@menu][0]=$cascade_title; # 设置 array @menu 中 一个新的元素 为一个array,这个@$menu[n]中，n = @menu中最后一个元素 , 在这个基础 再加深一层关系
while (<MENU> { # 进入到 menu 中新一层的新一层
chomp;next if /^#/;next if /^\s+/;next if /^$/;
last if /^\(\/$cascade_title\)$/; # 若(/..) 返回
$menu[@menu][0][0]=$_; # 这次加深了两层关系 ， @menu 一直都在增长，因此不会出现重复的
}
next;
}
$menu[@menu][0]=$_; # 这里是 menu 的基本元素
}
}
}
return \@menu; # 返回 array ref
};
sub get_ql_ini {
my $file = pop;
my @quicklaunch;
my $length=@quicklaunch;
open(MENU,"<$file");
while (<MENU>;) {
chomp;
next if /^#/;
next if /^\s+/;
next if /^$/;
if (/^separator/) {
$quicklaunch[$length] = $_;
} else {
($quicklaunch[$length][0],$quicklaunch[$length][1],$quicklaunch[$length][2]) = split(/\t/);
}
$length++;
}
return \@quicklaunch;
};
sub get_multi_language_support {
my $file = pop;
my %language;
open(DATA,"<$file");
while (<DATA>;) {
chomp;
next if /^#/;
next if /^\s+/;
next if /^$/;
my($root,@lang) = split(/\t/);
my $i=0;
foreach my $tmp (@lang) {
$language{$root}[$i++] = $tmp;
}
}
close(DATA);
return \%language;
};
sub create_frame {
foreach my $arg_frame (@_) {
${$$arg_frame[0]} = $main_window->;Frame( '-width'=>;600 );
eval '$'.$$arg_frame[0].'->;pack('.$$arg_frame[1].');';
print "Error: $@ \n" if $@ and $DEBUG;
}
};
|
|
免费注册
发表于 2001-12-08 10:19
