# # Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Created by Dmitry Karasik # # $Id: ComboBox.pm,v 1.39 2008/04/04 10:28:14 dk Exp $ # combo styles package cs; use constant Simple => 0; use constant DropDown => 1; use constant DropDownList => 2; use strict; package Prima::ComboBox; use vars qw(@ISA %listProps %editProps %listDynas $capture_mode); use Prima qw( InputLine Lists Utils StdBitmap); @ISA = qw(Prima::Widget); use constant DefButtonX => 17; # these are properties, methods and dynas of encapsulated widgets, edit and list %editProps = map { $_ => 1 } qw( alignment autoScroll text select_all charOffset maxLen insertMode firstChar selection selStart selEnd writeOnly copy cut delete paste wordDelimiters readOnly passwordChar focus ); %listProps = map { $_ => 1 } qw( autoHeight focusedItem hScroll integralHeight items itemHeight topItem vScroll gridColor multiColumn offset autoHScroll autoVScroll ); %listDynas = map { $_ => 1} qw(onDrawItem onSelectItem); for ( keys %editProps) { eval < {edit}-> $_(\@_); } sub Prima::ComboBox::DummyEdit::$_ {} GENPROC } for (keys %listProps) { eval < {list}-> $_(\@_); } sub Prima::ComboBox::DummyList::$_ {} GENPROC } $capture_mode = (Prima::Application-> get_system_info-> {apc} == apc::Unix); sub profile_default { my $f = $_[ 0]-> get_default_font; return { %{Prima::InputLine-> profile_default}, %{Prima::ListBox-> profile_default}, %{$_[ 0]-> SUPER::profile_default}, style => cs::Simple, caseSensitive => 0, autoHScroll => 0, autoVScroll => 1, listVisible => 0, editHeight => $f-> {height} + 2, listHeight => 100, ownerBackColor => 1, selectable => 0, literal => 1, scaleChildren => 0, autoEnableChildren => 1, editClass => 'Prima::InputLine', listClass => 'Prima::ListBox', buttonClass => 'Prima::Widget', editProfile => {}, listProfile => {}, buttonProfile => {}, listDelegations => [qw(Leave SelectItem MouseUp Click KeyDown)], editDelegations => [qw(FontChanged Create Setup KeyDown KeyUp Change Leave MouseWheel)], buttonDelegations => [qw(ColorChanged FontChanged MouseDown MouseClick MouseUp MouseMove Paint Enable Disable)], } } sub profile_check_in { my ( $self, $p, $default) = @_; $self-> SUPER::profile_check_in( $p, $default); my $style = exists $p-> {style} ? $p-> {style} : $default-> {style}; if ( $style != cs::Simple) { $p-> { editHeight } = exists $p-> {height} ? $p-> {height} : $default-> {height} unless exists $p-> { editHeight }; } else { my $fh = exists $p-> {font}-> {height} ? $p-> {font}-> {height} : $default-> {font}-> {height}; $p-> { editHeight } = $fh + 2 unless exists $p-> {editHeight }; } $p-> {autoHScroll} = 0 if exists $p-> {hScroll}; $p-> {autoVScroll} = 0 if exists $p-> {vScroll}; } sub init { my $self = shift; my %profile = @_; my $visible = $profile{visible}; $profile{visible} = 0; $self-> {edit} = bless [], q\Prima::ComboBox::DummyEdit\; $self-> {list} = bless [], q\Prima::ComboBox::DummyList\; %profile = $self-> SUPER::init(%profile); my ( $w, $h) = ( $self-> size); $self-> {style} = $profile{style}; $self-> {listVisible} = $profile{style} != cs::Simple; $self-> {caseSensitive}= $profile{caseSensitive}; $self-> {literal} = $profile{literal}; my $eh = $self-> {editHeight } = $profile{editHeight }; $self-> {listHeight} = $profile{listHeight}; $self-> {edit} = $self-> insert( $profile{editClass} => name => 'InputLine', origin => [ 0, $h - $eh], size => [ $w - (( $self-> {style} == cs::Simple) ? 0 : DefButtonX), $eh], growMode => gm::GrowHiX | gm::GrowLoY, selectable => 1, tabStop => 1, current => 1, delegations => $profile{editDelegations}, (map { $_ => $profile{$_}} keys %editProps), %{$profile{editProfile}}, ); my %lp = %listProps; delete $lp{hScroll} if $profile{autoHScroll}; delete $lp{vScroll} if $profile{autoVScroll}; $self-> {list} = $self-> insert( $profile{listClass} => name => 'List', origin => [ 0, 0], selectable => $capture_mode ? 0 : 1, width => $w, height => ( $self-> {style} == cs::Simple) ? ( $h - $eh) : $self-> {listHeight}, growMode => gm::Client, tabStop => 0, multiSelect => 0, clipOwner => $self-> {style} == cs::Simple, visible => $self-> {style} == cs::Simple, delegations => $profile{listDelegations}, (map { $_ => $profile{$_}} grep { exists $profile{$_} ? 1 : 0} keys %listDynas), (map { $_ => $profile{$_}} keys %lp), %{$profile{listProfile}}, ); $self-> {button} = $self-> insert( $profile{buttonClass} => ownerBackColor => 1, name => 'Button', origin => [ $w - DefButtonX, $h - $eh], size => [ DefButtonX, $eh], visible => $self-> {style} != cs::Simple, growMode => gm::GrowLoX | gm::GrowLoY, tabStop => 0, ownerFont => 0, selectable => 0, delegations => $profile{buttonDelegations}, %{$profile{buttonProfile}}, ); $self-> visible( $visible); return %profile; } sub on_create { my $self = $_[0]; $self-> InputLine_Change( $self-> {edit}) if $self-> {style} == cs::DropDownList; } sub on_size { $_[0]-> listVisible(0); } sub on_move { $_[0]-> listVisible(0); } sub on_hide { $_[0]-> listVisible(0); } sub List_Leave { $_[0]-> listVisible( 0) if $_[0]-> {style} != cs::Simple; } sub List_SelectItem { return if defined $_[1]-> {interaction}; $_[0]-> {edit}-> {interaction} = 1; $_[0]-> {edit}-> text($_[1]-> get_item_text( $_[1]-> focusedItem)); $_[0]-> {edit}-> {interaction} = undef; $_[0]-> notify( q(Change)) if $_[0]-> {style} == cs::Simple; } sub List_MouseUp { return unless $_[2] == mb::Left || $_[1]-> capture; $_[0]-> listVisible(0) if $_[0]-> {style} != cs::Simple; $_[0]-> notify( q(Change)) if $_[0]-> {style} != cs::Simple; } sub List_Click { my ( $self, $list) = @_; $self-> {edit}-> {interaction} = 1; $self-> {edit}-> text( $list-> get_item_text( $list-> focusedItem)); $self-> {edit}-> {interaction} = undef; $self-> listVisible(0); $self-> notify( q(Change)); } sub List_KeyDown { my ( $self, $list, $code, $key, $mod) = @_; if ( $key == kb::Esc) { $self-> listVisible(0); $list-> clear_event; } elsif ( $key == kb::Enter) { $list-> notify(q(Click)); $list-> clear_event; } } sub Button_ColorChanged { my $self = shift; if ( $self-> {style} != cs::Simple) { $self-> {list}-> color( $self-> {button}-> color); $self-> {list}-> backColor( $self-> {button}-> backColor); } } sub Button_FontChanged { my $self = shift; if ( $self-> {style} != cs::Simple) { my $f = $self-> {button}-> font; $self-> {list}-> font($f); } } sub Button_MouseDown { $_[0]-> listVisible( !$_[0]-> {list}-> visible); $_[1]-> clear_event; return if !$_[0]-> {list}-> visible; $_[1]-> capture(1); } sub Button_MouseClick { return unless $_[-1]; $_[0]-> listVisible( !$_[0]-> {list}-> visible); $_[1]-> clear_event; return if !$_[0]-> {list}-> visible; $_[1]-> capture(1); } sub Button_MouseMove { $_[1]-> clear_event; if ($_[1]-> capture) { my ($x,$y,$W,$H) = ($_[3],$_[4],$_[1]-> size); return unless ($x < 0) || ($y < 0) || ($x >= $W) || ($y >= $H); $_[1]-> capture(0); $_[0]-> {list}-> mouse_down( mb::Left, 0, 5, $_[0]-> {list}-> height - 5, 1) if ($_[0]-> {list}-> visible); } } sub Button_MouseUp { $_[1]-> capture(0); } sub Button_Paint { my ( $owner, $self, $canvas) = @_; my ( $w, $h) = $canvas-> size; my $ena = $self-> enabled; my @clr = $ena ? ( $self-> color, $self-> backColor) : ( $self-> disabledColor, $self-> disabledBackColor); my $lv = $owner-> listVisible; my ( $rc, $lc) = ( $self-> light3DColor, $self-> dark3DColor); ( $rc, $lc) = ( $lc, $rc) if $lv; $canvas-> rect3d( 0, 0, $w-1, $h-1, 1, $rc, $lc, $clr[1]); if ( $ena) { $canvas-> color( $rc); $canvas-> fillpoly([ 5, $h * 0.6 - 1, $w - 4, $h * 0.6 - 1, $w/2 + 1, $h * 0.4 - 1]); } $canvas-> color( $clr[0]); $canvas-> fillpoly([ 4, $h * 0.6, $w - 5, $h * 0.6, $w/2, $h * 0.4]); } sub Button_Enable { $_[1]-> repaint } sub Button_Disable { $_[1]-> repaint } sub InputLine_Leave { $_[0]-> listVisible( 0) if $capture_mode and $_[0]-> {style} != cs::Simple; } sub InputLine_FontChanged { $_[0]-> editHeight ( $_[1]-> font-> height + $_[1]-> borderWidth * 2); } sub InputLine_Create { $_[1]-> {incline} = ''; } sub InputLine_KeyDown { my ( $self, $edit, $code, $key, $mod, $repeat) = @_; if ( $self-> listVisible) { $self-> {list}-> notify(q(KeyDown), $code, $key, $mod, $repeat); $edit-> clear_event; return; } return if $mod & km::DeadKey; if ( ( $key & 0xFF00) && ( $key != kb::NoKey) && ( $key != kb::Space) && ( $key != kb::Backspace) ) { return if $key == kb::Tab || $key == kb::BackTab || $key == kb::NoKey; $edit-> {incline} = ''; $self-> listVisible(1), $edit-> clear_event if $key == kb::Down && $_[0]-> {style} != cs::Simple; $_[0]-> notify( q(Change)), $edit-> clear_event if $key == kb::Enter && $_[0]-> {style} == cs::DropDownList; return; } else { return unless $code; return unless $_[0]-> {literal}; return if $_[0]-> {style} != cs::DropDownList; return if $mod & ( km::Alt|km::Ctrl); $edit-> {keyDown} = 1; if ( $key == kb::Backspace) { chop $edit-> {incline}; } else { $code = chr ( $code); $code = uc $code unless $self-> caseSensitive; $edit-> {incline} .= $code; } my ($ftc,$i,$txt,$t); $ftc = quotemeta $edit-> {incline}; for ( $i = 0; $i < $_[0]-> {list}-> count; $i++) { $txt = $_[0]-> {list}-> get_item_text($i); $t = $txt; $t = uc $t unless $self-> caseSensitive; last if $t =~ /^$ftc/; } if ( $i < $_[0]-> {list}-> count) { $edit-> text( $txt); } else { chop $edit-> {incline}; } $edit-> selection( 0, length $edit-> {incline}); } $edit-> clear_event if $_[0]-> {style} == cs::DropDownList; } sub InputLine_KeyUp { $_[1]-> {keyDown} = undef; } sub InputLine_Setup { my $self = shift; $self-> InputLine_Change(@_) if $self-> {style} == cs::DropDownList; } sub InputLine_Change { return if defined $_[0]-> {edit}-> {interaction}; return unless $_[0]-> {literal}; $_[0]-> notify(q(Change)) if $_[0]-> {style} != cs::DropDownList; $_[0]-> {list}-> {interaction} = 1; my ( $self, $style, $list, $edit) = ($_[0], $_[0]-> {style}, $_[0]-> {list}, $_[1]); my $i; my $found = 0; my $cap = $edit-> text; $cap = uc $cap unless $self-> caseSensitive; my @matchArray; my @texts; my $maxMatch = 0; my $matchId = -1; # filling list for ( $i = 0; $i < $list-> count; $i++) { my $t = $list-> get_item_text($i); $t = uc $t unless $self-> caseSensitive; push ( @texts, $t); } # trying to find exact match for ( $i = 0; $i < scalar @texts; $i++) { if ( $texts[$i] eq $cap) { $matchId = $i; last; } } if ( ( $style == cs::DropDown) && ( $matchId < 0) && defined $edit-> {keyDown} ) { my ($t,$txt); for ( $i = 0; $i < scalar @texts; $i++) { $txt = $t = $list-> get_item_text($i); $t = uc $t unless $self-> caseSensitive; last if $t =~ /^\Q$cap\E/; } # netscape 4 combo behavior if ( $i < scalar @texts) { $edit-> {interaction} = 1; $edit-> text( $txt); $edit-> {interaction} = undef; $t =~ /^\Q$cap\E/; $edit-> selection( length $cap, length $t); $list-> focusedItem( $i); return; } } # or unexact match if ( $matchId < 0) { for ( $i = 0; $i < scalar @texts; $i++) { my $l = 0; $l++ while $l < length($texts[$i]) && $l < length($cap) && substr( $texts[$i], $l, 1) eq substr( $cap, $l, 1); if ( $l >= $maxMatch) { @matchArray = () if $l > $maxMatch; $maxMatch = $l; push @matchArray, $i; } } $matchId = $matchArray[0] if $matchId < 0; } $matchId = 0 unless defined $matchId; $list-> focusedItem( $matchId); if ( $style == cs::DropDownList) { $edit-> {interaction} = 1; $edit-> text( $list-> get_item_text( $matchId)); $edit-> {interaction} = undef; } $list-> {interaction} = undef; } sub InputLine_MouseWheel { my ( $self, $edit, $mod, $x, $y, $z) = @_; my $f = $self-> {list}-> focusedItem; $f += (($z > 0) ? -1 : 1); return if $f < 0; $self-> {list}-> focusedItem($f); $self-> notify(q(Change)); $edit-> clear_event; } sub set_style { my ( $self, $style) = @_; return if $self-> {style} == $style; my $decr = (( $self-> {style} == cs::Simple) || ( $style == cs::Simple)) ? 1 : 0; $self-> {style} = $style; if ( $style == cs::Simple) { $self-> set( height=> $self-> height + $self-> listHeight, bottom=> $self-> bottom - $self-> listHeight, ); $self-> {list}-> set( visible => 1, origin => [ 0, 0], width => $self-> width, height => $self-> height - $self-> editHeight , clipOwner => 1, ); } elsif ( $decr) { $self-> set( height => $self-> height - $self-> listHeight, bottom => $self-> bottom + $self-> listHeight, ); $self-> { list}-> set( visible => 0, height => $self-> {listHeight}, clipOwner=> 0, ); $self-> listVisible( 0); } $self-> {edit}-> set( bottom => $self-> height - $self-> editHeight , width => $self-> { edit}-> width + DefButtonX * $decr * (( $style == cs::Simple) ? 1 : -1), height => $self-> editHeight , ); $self-> {button}-> set( bottom => $self-> height - $self-> editHeight , height => $self-> editHeight , visible=> $style != cs::Simple, ); if ( $style == cs::DropDownList) { $self-> {edit}-> insertMode(1); $self-> {edit}-> text( $self-> {edit}-> text); } } sub set_list_visible { my ( $self, $nlv) = @_; return if ( $self-> {list}-> visible == $nlv) || ( $self-> {style} == cs::Simple) || ( !$self-> visible && $nlv); my ( $list, $edit) = ( $self-> {list}, $self-> {edit}); if ( $nlv) { my @gp = $edit-> client_to_screen( 0, -$list-> height); $gp[1] += $edit-> height + $list-> height if $gp[1] < 0; $list-> origin( @gp); } $list-> bring_to_front if $nlv; $list-> visible( $nlv); $self-> {button}-> repaint; if ( $capture_mode) { $list-> capture( $nlv ? 1 : 0); $edit-> focus; } else { $nlv ? $list-> focus : $edit-> focus; } } sub set_edit_height { my ( $self, $edit, $list, $btn, $h, $new) = ($_[0], $_[0]-> {edit}, $_[0]-> {list}, $_[0]-> {button}, $_[0]-> height, $_[1]); if ( $self-> style != cs::Simple) { $self-> height( $new); $edit-> set( bottom => 0, height => $new ); $btn-> set( bottom => 0, height => $new ); $list-> height( $self-> {listHeight}); } else { $edit-> set( bottom => $h - $new, height => $new ); $btn-> set( bottom => $h - $new, height => $new ); $list-> height( $h - $new); } $self-> {editHeight} = $new; } sub set_list_height { my ( $self, $hei) = @_; if ( $self-> style == cs::Simple) { $self-> height( $self-> height + $hei - $self-> {listHeight}); } else { $self-> {list}-> height($hei); } $self-> {listHeight} = $hei; } sub get_style { return $_[0]-> {style}} sub get_list_visible{ return $_[0]-> {list} ? $_[0]-> {list}-> visible : 0} sub get_edit_height { return $_[0]-> {edit} ? $_[0]-> {edit}-> height : 0} sub get_list_height { return $_[0]-> {list} ? $_[0]-> {list}-> height : 0} sub caseSensitive{($#_)?$_[0]-> {caseSensitive}=$_[1]:return $_[0]-> {caseSensitive};} sub listVisible {($#_)?$_[0]-> set_list_visible($_[1]):return $_[0]-> get_list_visible;} sub style {($#_)?$_[0]-> set_style ($_[1]):return $_[0]-> get_style; } sub editHeight {($#_)?$_[0]-> set_edit_height($_[1]):return $_[0]-> get_edit_height;} sub listHeight {($#_)?$_[0]-> set_list_height ($_[1]):return $_[0]-> get_list_height;} sub literal {($#_)?$_[0]-> {literal} = $_[1] :return $_[0]-> {literal} } 1; __DATA__ =pod =head1 NAME Prima::ComboBox - standard combo box widget =head1 SYNOPSIS use Prima::ComboBox; my $combo = Prima::ComboBox-> create( style => cs::DropDown, items => [ 1 .. 10 ]); $combo-> style( cs::DropDownList ); print $combo-> text; =head1 DESCRIPTION Provides a combo box widget which consists of an input line, list box of possible selections and eventual drop-down button. The combo box can be either in form with a drop-down selection list, that is shown by the command of the user, or in form when the selection list is always visible. The combo box is a grouping widget, and contains neither painting nor user-input code. All such functionality is delegated into the children widgets: input line, list box and button. C exports a fixed list of methods and properties from namespaces of L and L. Since, however, it is possible to tweak the C ( using its L and L create-only properties ) so the input line and list box would be other classes, it is not necessarily that all default functionality would work. The list of exported names is stored in package variables %listProps, %editProps and %listDynas. These also described in L section. The module defines C package for the constants used by L