开发者

Perl TK open folder

开发者 https://www.devze.com 2023-03-11 18:37 出处:网络
Say we are having entry box and a button. When user press the button, it should ta开发者_如何学编程ke path from entry box and open the corresponding folder. How can I do it using Perl/TK? Thanks in ad

Say we are having entry box and a button. When user press the button, it should ta开发者_如何学编程ke path from entry box and open the corresponding folder. How can I do it using Perl/TK? Thanks in advance


You might make a system call to the command line process that opens the file browser. On windows this is apparently the start command, on Linux something like gnome-open or nautilus would work.

sub open_directory {
  my $directory = shift;

  if ($^O eq 'MSWin32') {
    exec "start $directory";
  } elsif ($^O = 'linux') {
    exec "gnome-open $directory" or
    exec "kde-open $directory";
  # test for more OS cases
  } else {
    die "cannot open folder on your system: $^O";
  }
} 


You may want to try a widget like the Tk::DirTree widget.

#!/usr/bin/perl
use strict;
use warnings;

use Tk;
use Tk::DirTree;

my $mw = MainWindow->new;
$mw->title("Type path of directory and click OK");
$mw->geometry('400x300+'.int(($mw->screenwidth-400)/2).'+'.int(($mw->screenheight-300)/2));

my $dir = $mw->Entry( -text       => '',
                        -width      => 20, 
                        -font       => 'Courier 12 bold',
                        -background => 'Orange',
)->pack( -ipadx => 35 );

$dir->focus();

$mw->Button( -text       => 'Ok',
             -font       => 'Courier 12 bold',
             -background => 'Orange',
             -command    => sub{ dirwindow($dir) },
  )->pack(   -side       => 'left',
             -ipadx      => 40
);

$mw->Button( -text       => 'Exit',
             -font       => 'Courier 12 bold',
             -background => 'Orange',
             -command    => sub { exit }
  )->pack(   -side       => 'right',
             -ipadx      => 40
);

MainLoop;

sub dirwindow {
    my $d = shift;
    my $dir_val = $d->get;
    my $dl = $mw->DirTree(-directory => $dir_val)->pack(-fill => 'both', -expand => 1);
}
0

精彩评论

暂无评论...
验证码 换一张
取 消