/usr/local/CPAN/X11-Motif/X11/Motif/URLChooser.pm

• package X11::Motif::URLChooser
  • add_storage_type
  • new
  • popup
  • popdown
  • destroy
  • choose
  • _shutdown
  • set_filter
  • filter
  • cvt_glob_to_regex
  • complete_partial_name
  • reload
  • redisplay
  • switch_to
  • switch_to_storage
  • switch_to_host
  • switch_to_dir
  • do_change_storage
  • do_change_host
  • do_change_filter
  • do_complete_partial_name
  • do_ok
  • do_cancel
  • do_choose_dir
  • do_choose_file
  • do_maybe_choose_file
  • create_dialog
• EOF

package X11::Motif::URLChooser;

use Cwd;
use Net::Domain qw(hostfqdn);
use X11::Motif;

use strict;
use vars qw($VERSION @ISA);

$VERSION = 1.0;
@ISA = qw();

my %StorageTypes = ();

sub add_storage_type {
    my($type, $class) = @_;
    my $impl = {};

    bless $impl, $class;
    $StorageTypes{$type} = $impl;
}

sub new {
    my $self = shift;
    my $class = ref($self) || $self;
    my($location, $pattern) = @_;

    $self = {
	'hide_dots' => 1,
	'hide_emacs' => 1,
	'done' => 0,

	'glob' => undef,
	'filter' => undef,
	'selection' => undef,

	'host' => hostfqdn(),
	'dir' => getcwd(),

	'inactive_storage' => {},
	'storage' => undef,

	'active_pos' => 0,
	'visible_history' => [],
	'visible_file_list' => [],
	'filtered_file_list' => [],
	'visible_dir_list' => [],
	'filtered_dir_list' => [],

	'dialog_shell' => undef
    };

    bless $self, $class;

    $self->switch_to($location);
    $self->set_filter($pattern);
    $self->reload();

    $self;
}

sub popup {
    my $self = shift;
    my $shell = $self->{'dialog_shell'};

    if (!defined $shell) {
	my($toplevel, $dialog_title, $arg);

	while (defined($arg = shift)) {
	    if (X::Toolkit::Widget::IsWidget($arg)) {
		$toplevel = $arg;
	    }
	    else {
		$dialog_title = $arg;
	    }
	}

	$toplevel = X::Toolkit::toplevel() if (!defined $toplevel);
	$dialog_title = "Choose a File" if (!defined $dialog_title);

	my $dialog = $self->create_dialog($toplevel, $dialog_title);

	$dialog->ManageChild();
	$shell = $dialog->Parent();
    }

    $shell->Popup(X::Toolkit::GrabNonexclusive);
    $self->redisplay();

    $self->{'done'} = 0;

    $shell;
}

sub popdown {
    my $self = shift;
    my $shell = $self->{'dialog_shell'};

    if (defined $shell) {
	$shell->Popdown();
    }

    $self->{'done'} = -1;
}

sub destroy {
    my $self = shift;
    my $shell = $self->{'dialog_shell'};

    if (defined $shell) {
	$shell->DestroyWidget();
	$self->{'dialog_shell'} = undef;
    }

    $self->{'done'} = -1;
}

sub choose {
    my $self = shift;

    my $shell = $self->popup(@_);
    my $context = $shell->WidgetToApplicationContext();
    my $event;

    X::Motif::XmProcessTraversal($self->{'dialog_file'}, X::Motif::XmTRAVERSE_CURRENT);

    while ($self->{'done'} == 0) {
	$event = $context->AppNextEvent();
	X::Toolkit::DispatchEvent($event);
    }

    my $selection;

    if ($self->{'done'} > 0) {
	if ($self->{'done'} == 1) {
	    $selection = $self->{'storage'}->format($self);
	}
	$self->popdown();
    }

    $self->_shutdown();

    $selection;
}

sub _shutdown {
    my $self = shift;

    foreach my $storage (values %{$self->{'inactive_storage'}}) {
	$storage->shutdown($self);
    }
}

sub set_filter {
    my $self = shift;
    my($pattern) = @_;

    my $dialog_filter = $self->{'dialog_filter'};

    if (defined $dialog_filter) {
	if (!defined $pattern) {
	    $pattern = X::Motif::XmTextFieldGetString($dialog_filter);
	}
	else {
	    X::Motif::XmTextFieldSetString($dialog_filter, $pattern);
	    X::Motif::XmTextFieldSetString($self->{'dialog_file'}, '');
	}
    }

    $pattern = '*' if (!defined $pattern);

    $self->{'glob'} = $pattern;
    $self->{'filter'} = cvt_glob_to_regex($pattern);

    $self->filter();
}

sub filter {
    my $self = shift;

    my $dialog_file_list = $self->{'dialog_file_list'};

    if (defined $dialog_file_list) {
	my $hide_emacs = $self->{'hide_emacs'};
	my $hide_dots = $self->{'hide_dots'};
	my $filter = $self->{'filter'};

	my $row = 1;
	my @filtered_file_list = ();

	$dialog_file_list->Unmanage();
	X::Motif::XmListDeleteAllItems($dialog_file_list);

	my $i = 0;
	foreach my $item (@{$self->{'visible_file_list'}}) {
	    next if ($hide_emacs && ($item =~ /^\#/ || $item =~ /~$/));
	    next if ($hide_dots && $item =~ /^\./);

	    next if (!&{$filter}($item));

	    X::Motif::XmListAddItemUnselected($dialog_file_list, $item, $row);
	    push @filtered_file_list, $i;

	    ++$row;
	}
	continue {
	    ++$i;
	}

	X::Motif::XmListSetPos($dialog_file_list, 1);
	$dialog_file_list->Manage();

	@{$self->{'filtered_file_list'}} = @filtered_file_list;
    }
}

my %remembered_globs = ();

sub cvt_glob_to_regex {
    my($glob) = @_;

    $glob = '*' if (!defined $glob);
    my $regex = $remembered_globs{$glob};

    if (!defined $regex) {
	$regex = $glob;

	$regex =~ s|\\||g;
	$regex =~ s|^\s+||;
	$regex =~ s|\s+$||;

	$regex =~ s|([^\w\s-])|\\$1|g;
	$regex =~ s|\s+|\\s+|g;

	$regex =~ s|\\\001|.|g;
	$regex =~ s|\\\?|.|g;
	$regex =~ s|\\\*|.*|g;

	$regex .= '.*' if ($regex !~ m|\.\*|);

	$regex = "^".$regex."\$";

	$regex = eval qq(sub { \$_[0] =~ m\001$regex\001i });
	$remembered_globs{$glob} = $regex;
    }

    return $regex;
}

sub complete_partial_name {
    my $self = shift;
    my($partial, $w) = @_;

    if ($partial =~ m|(.*)/([^/]*)|) {
	my $dir = ($1 eq '') ? '/' : $1;
	$partial = $2;
	$self->switch_to_dir($dir);
	$self->reload();
    }

    if ($partial ne '') {
	my $dialog_dir_list = $self->{'dialog_dir_list'};
	my $dialog_file_list = $self->{'dialog_file_list'};

	my @matches = ();
	my $row;
	my $dir_row;
	my $file_row;

	$row = scalar(@{$self->{'visible_history'}}) + 1;
	foreach my $i (@{$self->{'filtered_dir_list'}}) {
	    my $item = $self->{'visible_dir_list'}[$i];
	    if ($item =~ /^\Q$partial\E/i) {
		push @matches, $item;
		if (!defined $dir_row) {
		    $dir_row = $row;
		}
	    }
	    ++$row;
	}

	$row = 1;
	foreach my $i (@{$self->{'filtered_file_list'}}) {
	    my $item = $self->{'visible_file_list'}[$i];
	    if ($item =~ /^\Q$partial\E/i) {
		push @matches, $item;
		if (!defined $file_row) {
		    $file_row = $row;
		}
	    }
	    ++$row;
	}

	if (@matches == 0) {
	    X::Bell($w->Display(), 100);
	}
	elsif (@matches == 1) {
	    $partial = $matches[0];
	    if (defined $dir_row) {
		$partial .= '/';
	    }
	}
	else {
	    my $start = length($partial);
	    my $test_start = $start;
	    my $test_match = pop @matches;
	    my $test_prefix;

	    undef $partial;

	    do {
		$test_prefix = substr($test_match, $test_start, 1);
		foreach (@matches) {
		    if (substr($_, $test_start, 1) ne $test_prefix) {
			$partial = substr($test_match, 0, $test_start);
			last;
		    }
		}
		++$test_start;
	    }
	    while (!defined $partial);
	}

	if (defined $dir_row) {
	    X::Motif::XmListSetPos($dialog_dir_list, $dir_row);
	}

	if (defined $file_row) {
	    X::Motif::XmListSetPos($dialog_file_list, $file_row);
	}
    }

    X::Motif::XmTextFieldSetString($w, $partial);
    X::Motif::XmTextFieldSetInsertionPosition($w, X::Motif::XmTextFieldGetLastPosition($w));
}

sub reload {
    my $self = shift;

    $self->{'storage'}->reload($self);
    $self->redisplay();
}

sub redisplay {
    my $self = shift;

    my $dialog_dir_list = $self->{'dialog_dir_list'};

    if (defined $dialog_dir_list) {
	$dialog_dir_list->Unmanage();
	X::Motif::XmListDeleteAllItems($dialog_dir_list);

	my $row = 1;

	foreach my $item (@{$self->{'visible_history'}}) {
	    my $visible_item = (' ' x ($row - 1)) . $item . "     ";
	    X::Motif::XmListAddItemUnselected($dialog_dir_list, $visible_item, $row);
	    ++$row;
	}

	my $selected_row = $row - 1 || $row;
	my $hide_dots = $self->{'hide_dots'};

	++$row;

	my $pad = ' ' x $row;
	my @filtered_dir_list = ();

	my $i = 0;
	foreach my $item (@{$self->{'visible_dir_list'}}) {
	    next if ($hide_dots && $item =~ /^\./);

	    X::Motif::XmListAddItemUnselected($dialog_dir_list, $pad . $item . "     ", $row);
	    push @filtered_dir_list, $i;

	    ++$row;
	}
	continue {
	    ++$i;
	}

	$self->{'active_pos'} = $selected_row - 1;
	@{$self->{'filtered_dir_list'}} = @filtered_dir_list;

	my $last_row = $selected_row + query $dialog_dir_list -visibleItemCount;

	while ($row <= $last_row) {
	    X::Motif::XmListAddItemUnselected($dialog_dir_list, '', $row);
	    ++$row;
	}

	X::Motif::XmListSelectPos($dialog_dir_list, $selected_row, X::False);
	X::Motif::XmListSetPos($dialog_dir_list, $selected_row - 1 || $selected_row);
	$dialog_dir_list->Manage();
    }

    my $dialog_dir = $self->{'dialog_dir'};

    if (defined $dialog_dir) {
	change $dialog_dir -text => $self->{'dir'};
    }

    my $dialog_host = $self->{'dialog_host'};

    if (defined $dialog_host) {
	X::Motif::XmTextFieldSetString($dialog_host, $self->{'host'});
    }

    $self->filter();
}

sub switch_to {
    my $self = shift;
    my($location) = @_;

    return if (!defined $location);

    my($def_type, $def_host, $def_port);

    if (!defined $self->{'storage'}) {
	$def_type = 'file';
    }

    if ($location =~ s|^(\w+):||) {
	if (defined $StorageTypes{$1}) {
	    $def_type = $1;
	}
    }

    if ($location =~ s|^//([^/]+)||) {
	$def_host = $1;
	if ($def_host =~ s|:(\d+)$||) {
	    $def_port = $1;
	}
    }

    $self->switch_to_storage($def_type) if (defined $def_type);
    $self->switch_to_host($def_host, $def_port) if (defined $def_host);
    $self->switch_to_dir($location);
}

sub switch_to_storage {
    my $self = shift;
    my($new_storage, $skip_update_display) = @_;

    if (defined $new_storage && defined $StorageTypes{$new_storage}) {
	my $storage = $self->{'storage'};

	if (defined $storage) {
	    $storage->deactivate($self);
	    $storage = $self->{'inactive_storage'}{$new_storage};

	    if (!defined $storage) {
		$StorageTypes{$new_storage}->new($self);
		$self->{'storage'}->switch_to_host($self);
		$self->{'storage'}->switch_to_dir($self);
	    }
	    else {
		$self->{'storage'} = $storage;
		$storage->activate($self);
	    }
	}
	else {
	    $StorageTypes{$new_storage}->new($self);
	}

	if (!defined $skip_update_display) {
	    my $dialog_storage = $self->{'dialog_storage'};
	    if (defined $dialog_storage) {
		change $dialog_storage -menuHistory => $self->{'storage_options'}{$new_storage};
	    }
	}
    }
}

sub switch_to_host {
    my $self = shift;
    my($new_host, $new_port) = @_;

    my $dialog_host = $self->{'dialog_host'};

    if (defined $dialog_host) {
	if (!defined $new_host) {
	    $new_host = X::Motif::XmTextFieldGetString($dialog_host);
	}
	else {
	    X::Motif::XmTextFieldSetString($dialog_host, $new_host);
	}
    }

    if (defined $new_host) {
	$self->{'storage'}->switch_to_host($self, $new_host, $new_port);
    }
}

sub switch_to_dir {
    my $self = shift;
    my($new_dir) = @_;

    if (defined $new_dir) {
	$self->{'storage'}->switch_to_dir($self, $new_dir);
    }
}

sub do_change_storage {
    my($w, $user, $call) = @_;
    $user->[0]->switch_to_storage($user->[1], 1);
    $user->[0]->reload();
}

sub do_change_host {
    my($w, $user, $call) = @_;
    $user->switch_to_host();
    $user->reload();
}

sub do_change_filter {
    my($w, $user, $call) = @_;
    $user->set_filter();
}

sub do_complete_partial_name {
    my($w, $user, $call) = @_;

    my $change = $call->text;

    if (defined $change && ref($call->event) eq 'X::Event::KeyEvent') {
	if ($change eq " ") {
	    $call->deny_change;
	    $user->complete_partial_name(X::Motif::XmTextFieldGetString($w), $w);
	}
    }
}

sub do_ok {
    my($w, $user, $call) = @_;

    $user->{'selection'} = X::Motif::XmTextFieldGetString($user->{'dialog_file'});
    $user->{'done'} = 1;
}

sub do_cancel {
    my($w, $user, $call) = @_;

    $user->{'done'} = 2;
}

sub do_choose_dir {
    my($w, $user, $call) = @_;

    my $pos = $call->item_position() - 1;
    my $active_pos = $user->{'active_pos'};

    if ($pos != $active_pos) {
	if ($pos < $active_pos) {
	    $user->{'storage'}->go_back($user, $pos);
	}
	else {
	    my $raw_pos = $user->{'filtered_dir_list'}[$pos - $active_pos - 1];
	    if (defined $raw_pos) {
		$user->{'storage'}->go_forward($user, $raw_pos);
	    }
	}

	$user->reload();
    }
}

sub do_choose_file {
    my($w, $user, $call) = @_;

    $user->{'selection'} = $call->item()->plain();
    $user->{'done'} = 1;
}

sub do_maybe_choose_file {
    my($w, $user, $call) = @_;

    my $file = $call->item()->plain();
    X::Motif::XmTextFieldSetString($user->{'dialog_file'}, $file);
}

sub create_dialog {
    my $self = shift;
    my($parent, $dialog_title) = @_;

    my $shell = give $parent -Transient,
			-resizable => X::True,
			-title => $dialog_title;

    my $form = give $shell -Form, -managed => X::False, -name => 'top_form',
			-resizePolicy => X::Motif::XmRESIZE_GROW,
			-horizontalSpacing => 5,
			-verticalSpacing => 5;

    my($storage, $menu) = give $form -OptionMenu,
			-traversalOn => X::False,
			-label => 'Storage System: ';

	my $storage_options = {};
	foreach (sort { $a->[1] cmp $b->[1] }
		 map { [$_->menu_name,
			$_->menu_order,
			$_->storage_name] } values %StorageTypes) {
	    $storage_options->{$_->[2]} = give $menu -Button, -text => $_->[0],
					    -command => [\&do_change_storage, [$self, $_->[2]]];
	}

    if (defined $self->{'storage'}) {
	change $storage -menuHistory => $storage_options->{$self->{'storage'}->storage_name()};
    }

    my $spacer_1 = give $form -Spacer;

    my $dir_form = give $form -Form, -name => 'dir_form',
			-resizePolicy => X::Motif::XmRESIZE_GROW,
			-verticalSpacing => 5;
	my $host_label = give $dir_form -Label, -text => 'Computer:';
	my $host = give $dir_form -Field, -text => $self->{'host'},
			-sensitive => X::True,
			-command => [\&do_change_host, $self];
	my $dir_list_label = give $dir_form -Label, -text => 'Folders:';
	my $dir_view = give $dir_form -ScrolledWindow;
	my $dir_list = give $dir_view -List,
			-traversalOn => X::False,
			-visibleItemCount => 7,
			-scrollBarDisplayPolicy => X::Motif::XmSTATIC,
			-selectionPolicy => X::Motif::XmBROWSE_SELECT,
			-listSizePolicy => X::Motif::XmVARIABLE;
	$dir_list->AddCallback(X::Motif::XmNdefaultActionCallback, \&do_choose_dir, $self);

	constrain $host_label -top => -form, -left => -form, -right => -form;
	constrain $host -top => $host_label, -left => -form, -right => -form;
	constrain $dir_list_label -top => $host, -left => -form, -right => -form;
	constrain $dir_view -top => $dir_list_label, -left => -form, -right => -form, -bottom => -form;

    my $file_form = give $form -Form, -name => 'file_form',
			-resizePolicy => X::Motif::XmRESIZE_GROW,
			-verticalSpacing => 5;
	my $filter_label = give $file_form -Label, -text => 'Show Files Like:';
	my $filter = give $file_form -Field, -text => $self->{'glob'};
	$filter->AddCallback(X::Motif::XmNvalueChangedCallback, \&do_change_filter, $self);
	my $file_list_label = give $file_form -Label, -text => 'Files:';
	my $file_view = give $file_form -ScrolledWindow;
	my $file_list = give $file_view -List,
			-visibleItemCount => 7,
			-scrollBarDisplayPolicy => X::Motif::XmSTATIC,
			-selectionPolicy => X::Motif::XmBROWSE_SELECT,
			-listSizePolicy => X::Motif::XmVARIABLE;
	$file_list->AddCallback(X::Motif::XmNdefaultActionCallback, \&do_choose_file, $self);
	$file_list->AddCallback(X::Motif::XmNbrowseSelectionCallback, \&do_maybe_choose_file, $self);

	constrain $filter_label -top => -form, -left => -form, -right => -form;
	constrain $filter -top => $filter_label, -left => -form, -right => -form;
	constrain $file_list_label -top => $filter, -left => -form, -right => -form;
	constrain $file_view -top => $file_list_label, -left => -form, -right => -form, -bottom => -form;

    my $dir_label = give $form -Label, -text => 'Folder: ',
			-alignment => X::Motif::XmALIGNMENT_END;
    my $dir = give $form -Label, -text => $self->{'dir'},
			-resizable => X::False;
    my $file_label = give $form -Label, -text => 'File: ',
			-alignment => X::Motif::XmALIGNMENT_END,
			-width => (query $dir_label -width);
    my $file = give $form -Field, -verifyBell => X::False;
    $file->AddCallback(X::Motif::XmNmodifyVerifyCallback, \&do_complete_partial_name, $self);
    $file->AddCallback(X::Motif::XmNactivateCallback, \&do_ok, $self);

    my $spacer_3 = give $form -Spacer;
    my $ok = give $form -Button, -text => 'OK', -command => [\&do_ok, $self];
    my $cancel = give $form -Button, -text => 'Cancel', -command => [\&do_cancel, $self];

    constrain $storage -top => -form, -left => -form;
    constrain $spacer_1 -left => $storage, -right => -form;
    constrain $dir_form -top => $storage, -left => -form, -bottom => $dir;
    constrain $file_form -top => $storage, -left => $dir_form, -right => -form, -bottom => $dir;
    constrain $dir_label -left => -form, -bottom => $file;
    constrain $dir -left => $dir_label, -right => -form, -bottom => $file;
    constrain $file_label -left => -form, -bottom => $cancel;
    constrain $file -left => $file_label, -right => -form, -bottom => $cancel;
    constrain $cancel -right => -form, -bottom => -form;
    constrain $ok -right => $cancel, -bottom => -form;
    constrain $spacer_3 -left => -form, -right => $ok;

    $self->{'dialog_shell'} = $shell;
    $self->{'dialog_form'} = $form;
    $self->{'dialog_dir'} = $dir;
    $self->{'dialog_file'} = $file;
    $self->{'dialog_host'} = $host;
    $self->{'dialog_storage'} = $storage;
    $self->{'dialog_filter'} = $filter;
    $self->{'dialog_dir_list'} = $dir_list;
    $self->{'dialog_file_list'} = $file_list;

    $self->{'storage_options'} = $storage_options;

    foreach my $w ($file, $filter, $file_list) {
	X::Motif::XmAddTabGroup($w);
    }

    return $form;
}

1;