Tk::PathEntry::Dialog - File dialog using Tk::PathEntry

Tk-PathEntry documentation Contained in the Tk-PathEntry distribution.

Index

Code Index:

NAME

Top

Tk::PathEntry::Dialog - File dialog using Tk::PathEntry

SYNOPSIS

Top

Using as a replacement for getOpenFile and getSaveFile:

    use Tk::PathEntry::Dialog qw(as_default);
    $filename = $mw->getOpenFile;

Using as a normal module:

    use Tk::PathEntry::Dialog;
    $filename = $mw->PathEntryDialog(-autocomplete => 1)->Show;

DESCRIPTION

Top

This module provides a dialog window with a Tk::PathEntry widget, an OK button and a Cancel button.

With this module, the Tk::PathEntry can also be used as a standard Tk file dialog. You are allowed to select a directory.

OPTIONS

Top

Options of getOpenFile and getSaveFile

You cannot use the options -filetypes, -defaultextension, and -multiple. So the only remaining options are -initialdir, -initialfile, and -title.

Options of PathEntryDialog

PathEntryDialog supports all options of Tk::PathEntry. The additional options are:

-title

Sets the window title.

-create

If this is set to a true value, you will be warned when you select an existing file.

NOTES

Top

Surprisingly this module also works on Microsoft Windows.

BUGS

Top

The following bug is known for PathEntryDialog on Microsoft Windows: Directly after klicking on a choice in the choices listbox which displays below the PathEntryDialog window, the OK and Cancel buttons don't respond to mouse clicks. Workaround: Move the mouse cursor out of the button and back. Or use the Enter resp. Escape keys in place of the buttons.

The following bug is known for PathEntryDialog on Knoppix: PathEntryDialog will often abort immediately with the error message

	*** glibc detected *** malloc(): memory corruption: 0x08495514 ***

Workaround: Do something that causes PathEntryDialog to start at a different memory location, e. g. open or close a Konqueror window (beleave me, this may help).

SEE ALSO

Top

Tk::PathEntry (3), Tk::getOpenFile (3) (Tk::getOpenFile).

AUTHOR

Top

Slaven Rezic <srezic@cpan.org>

COPYRIGHT

Top

Copyright (c) 2001 Slaven Rezic. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Tk-PathEntry documentation Contained in the Tk-PathEntry distribution. 
# -*- perl -*-

#
# $Id: Dialog.pm,v 1.11 2007/09/19 18:58:17 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2001,2005 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: srezic@cpan.org
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

package Tk::PathEntry::Dialog;
use Tk::PathEntry;
use base qw(Tk::DialogBox);
use strict;
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);

Construct Tk::Widget 'PathEntryDialog';

sub import {
    if (defined $_[1] and $_[1] eq 'as_default') {
	local $^W = 0;
	package # hide from PAUSE indexer
	    Tk;
	if ($Tk::VERSION < 804) {
	    *FDialog      = \&Tk::PathEntry::Dialog::FDialog;
	    *MotifFDialog = \&Tk::PathEntry::Dialog::FDialog;
	} else {
            *tk_getOpenFile = sub {
                Tk::PathEntry::Dialog::FDialog("tk_getOpenFile", @_);
            };
            *tk_getSaveFile = sub {
                Tk::PathEntry::Dialog::FDialog("tk_getSaveFile", @_);
            };
	}
    }
}

sub Populate {
    my($w, $args) = @_;

    $args->{-buttons} = ["OK", "Cancel"];
    # Disable default button feature of Tk::DialogBox
    $args->{-default_button} = 'none';
    $args->{-title}  ||=  'Select path';   # default window title
    $w->SUPER::Populate($args);

    my $pe = $w->add('PathEntry',
		     -textvariable => \$w->{PathName},
		    )->pack(-expand => 1, -fill => 'x');
    $w->Advertise("PathEntry" => $pe);
    $args->{-focus} = $pe;

    $pe->bind("<Return>" => sub {
		  $w->Subwidget("B_OK")->Invoke;
	      });
    $w->bind("<Escape>" => sub {
		 $w->Subwidget("B_Cancel")->Invoke;
	     });

    $w->ConfigSpecs
	(-create => ['PASSIVE', undef, undef, 0],
	 'DEFAULT' => [$pe],
	);
}

sub Show {
    my $w = shift;
    my @args = @_;

    my $pathname;
    my $pe = $w->Subwidget("PathEntry");

    while (1) {
	undef $pathname;

	my $r = $w->SUPER::Show(@args);
	$pathname = $w->{PathName} if $r =~ /ok/i;
	$pe->Finish;

	if (defined $pathname && $w->cget(-create) && -f $pathname) {

	    # Disable default button feature of Tk::DialogBox
	    # (invalid option and not required for Windows)
	    my $noDefault = $Tk::platform eq 'MSWin32' ? '' :
                               "-default_button => 'none'";
	    my $reply = $w->messageBox
		(-icon => 'warning',
		 -type => 'YesNo',
		 eval {split(' => ', $noDefault)},
		 -message => "File \"$pathname\" already exists.\nDo you want to overwrite it?");
	    redo unless (lc($reply) eq 'yes');
	}
	last;
    }

    $pathname;
}

sub FDialog
{
 my($cmd, %args) = @_;

 $args{-create} = !!($cmd =~ /Save/);

 delete $args{-filetypes};
 delete $args{-defaultextension};
 delete $args{-force};

 Tk::DialogWrapper('PathEntryDialog',$cmd, %args);
}

1;

__END__