Annotation of palm/Palm-Keyring/test3.pl, Revision 1.2
1.1 andrew 1: #!/usr/bin/perl
1.2 ! andrew 2: # $RedRiver: palmkeyring-tk,v 1.1 2006/01/31 23:03:39 andrew Exp $
1.1 andrew 3: ########################################################################
4: # palmkeyring-tk *** A GUI for 'Keyring for PalmOS' written in perl
5: #
6: # 2006.01.31 #*#*# andrew fresh <andrew@mad-techies.org>
7: ########################################################################
8: use strict;
9: use warnings;
10:
1.2 ! andrew 11: use Tk 8.0;
! 12: use Tk::widgets qw/ Dialog BrowseEntry ROText ProgressBar /;
1.1 andrew 13:
1.2 ! andrew 14: use lib 'lib';
! 15: use Palm::Keyring;
! 16:
! 17: my $File = "Keys-Gtkr.PDB";
! 18: my $Keyring = _do_open($File);
! 19:
! 20: my $NAME = 'Palm Keyring';
! 21:
! 22: my $lock_when = 0;
! 23: my $unlocked = time; # Change this to 0 when I get more stuff filled out
! 24: my $lock_timeout = 30;
! 25:
! 26: my $MW = MainWindow->new();
! 27: $MW->optionAdd('*BorderWidth' => 1);
! 28:
! 29: my $pane = $MW->Panedwindow(
! 30: Name => 'main',
! 31: -showhandle => 1,
! 32: -orient => 'horizontal'
! 33: )->pack(-fill => 'both', -expand => 1);
! 34:
! 35: my $lists_frame = $pane->Frame(Name => 'lists')
! 36: ->pack(-side=>'top',-anchor=>'nw',-fill=>'x');
! 37: my $right_frame = $pane->Frame(Name => 'right',-relief=>'sunken')
! 38: ->pack(-side=>'top',-anchor=>'ne',-fill=>'both',-expand=>1);
! 39:
! 40: my $account_frame = $right_frame->Frame(Name => 'account')
! 41: ->pack(-side=>'top',-anchor=>'nw',-fill=>'both',-expand=>1);
! 42: my $lock_frame = $right_frame->Frame(Name => 'lock',-relief=>'raised')
! 43: ->pack(-side=>'bottom',-fill=>'x');
! 44:
! 45: $pane->add('.main.lists');
! 46: $pane->add('.main.right');
! 47:
! 48: # Lists
! 49: my $category_list = $lists_frame->BrowseEntry()->pack(-side=>'top',-fill=>'x');
! 50: $category_list->insert(-1, 'All');
! 51: my $accounts_list = $lists_frame->Scrolled('Listbox', -scrollbars => 'e')
! 52: ->pack(-side=>'top',-fill=>'both',-expand=>1);
! 53:
! 54:
! 55: # Account
! 56: my %account_entry;
! 57: foreach my $label (qw/Category Name Account Password/) {
! 58: $account_entry{$label} = $account_frame->LabEntry(-state=>'readonly',
! 59: -labelWidth => 10,
! 60: -labelPack => [-side => 'left', -anchor => 'w'],
! 61: -label=>$label . ': ', -text => 'my' . $label)
! 62: ->pack(-side=>'top',-anchor=>'nw',-fill=>'x');
! 63: }
! 64:
! 65: $account_entry{'Details'} = $account_frame->ROText(-wrap => 'word',-height=>5,-width=>30)
! 66: ->pack(-side=>'top',-anchor=>'nw',-fill=>'both',-expand=>1);
! 67: $account_entry{'Details'}->insert('1.0',"This is a test\nThis is only a test");
! 68:
! 69:
! 70: # Lock
! 71: my $lock_button = $lock_frame->Button(-text => 'Lock', -command => \&Lock)
! 72: ->pack(-side=>'left');
! 73: my $lock_progress = $lock_frame->ProgressBar(
! 74: -variable=>\$lock_when,
! 75: -blocks => $lock_timeout,
! 76: -from => $lock_timeout,
! 77: -to => 0,
! 78: -gap => 0,
! 79: )->pack(-side=>'right',-fill=>'x',-expand=>1,-padx=>5);
! 80:
! 81: $lock_progress->repeat(500,\&Lock_Timeout);
! 82:
! 83: my $menubar = build_menubar($MW);
! 84:
! 85: _populate_lists($Keyring, $category_list, $accounts_list);
! 86:
! 87: my $VERSION = 0.01;
! 88:
! 89: MainLoop;
! 90:
! 91:
! 92: sub build_menubar {
! 93:
! 94: # Create the menubar and File and Quit menubuttons. Note
! 95: # that the cascade's menu widget is automatically created.
! 96:
! 97: my $menubar = $MW->Menu;
! 98: $MW->configure(-menu => $menubar);
! 99: my $file = $menubar->cascade(-label => '~File', -tearoff => 0);
! 100: my $help = $menubar->cascade(-label => '~Help', -tearoff => 0);
! 101:
! 102: # Create the menuitems for each menu. First, the File menu item.
! 103:
! 104: $file->command(-label => "Open", -command => \&Open);
! 105: $file->command(-label => "Close", -command => \&Close);
! 106: $file->command(-label => "Quit", -command => \&exit);
! 107:
! 108: # Finally, the Help menuitems.
! 109:
! 110: $help->command(-label => 'Version');
! 111: $help->separator;
! 112: $help->command(-label => 'About');
! 113:
! 114: my $ver_dialog = $MW->Dialog(-title => $NAME . ' Version',
! 115: -text => "$NAME\n\nVersion $VERSION",
! 116: -buttons => ['OK'],
! 117: -bitmap => 'info');
! 118: my $about_dialog = $MW->Dialog(-title => 'About ' . $NAME,
! 119: -text => 'About ' . $NAME . "\n" .
! 120: '© Copyright 2006 Andrew Fresh <andrew@mad-techies.org>',
! 121: -buttons => ['OK']);
! 122: my $menu = $help->cget('-menu');
! 123: $menu->entryconfigure('Version', -command => [$ver_dialog => 'Show']);
! 124: $menu->entryconfigure('About', -command => [$about_dialog => 'Show']);
! 125:
! 126: $menubar; # return the menubar
! 127:
! 128: }
! 129:
! 130: sub Lock
! 131: {
! 132: $unlocked = time;
! 133: }
! 134:
! 135: sub Lock_Timeout
! 136: {
! 137: #return unless $unlocked;
! 138: my $diff = time - $unlocked;
! 139: if ($diff > $lock_timeout) {
! 140: print "Timed out!";
! 141: Tk::exit();
! 142: } else {
! 143: $lock_when = $diff;
! 144: }
! 145: }
! 146:
! 147: sub Open
! 148: {
! 149: }
! 150:
! 151: sub Close
! 152: {
! 153: }
! 154:
! 155: sub _do_open
! 156: {
! 157: my $file = shift;
! 158: my $pdb = Palm::Keyring->new;
! 159: $pdb->Load($file) || die "Couldn't load '$file'";
! 160: return $pdb;
! 161: }
! 162:
! 163: sub _do_close
! 164: {
! 165: }
! 166:
! 167: sub _do_lock
! 168: {
! 169: }
! 170:
! 171: sub _populate_lists
! 172: {
! 173: my $pdb = shift;
! 174: my $cat = shift;
! 175: my $acct = shift;
! 176: foreach my $category (@{ $pdb->{'appinfo'}->{'categories'} }) {
! 177: next unless $category->{'name'};
! 178: $cat->insert( $category->{'id'}, $category->{'name'});
! 179: }
! 180: foreach my $account (@{ $pdb->{'records'} }) {
! 181: next unless $account->{'plaintext'}->{'name'};
! 182: $acct->insert('end', $account->{'plaintext'}->{'name'});
! 183: }
! 184:
! 185: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test3.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / palm / Palm-Keyring