You can not select more than 25 topics
			Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
		
		
		
		
		
			
		
			
				
					
					
						
							119 lines
						
					
					
						
							2.6 KiB
						
					
					
				
			
		
		
	
	
							119 lines
						
					
					
						
							2.6 KiB
						
					
					
				| # milkbone - profile dialog | |
|  | |
| package Milkbone::Profile; | |
|  | |
| use Milkbone; | |
|  | |
| our $VERSION = '1.0'; | |
|  | |
| use Tk::widgets qw(Frame Browser); | |
| use base qw(Tk::Toplevel); | |
| use strict; | |
| use warnings; | |
|  | |
| Construct Tk::Widget 'MBProfile'; | |
|  | |
| sub ClassInit | |
| { | |
| 	my ($class, $mw) = @_; | |
| 	$class->SUPER::ClassInit($mw); | |
| } | |
|  | |
| sub Populate | |
| { | |
| 	my ($self, $args) = @_; | |
| 	$self->SUPER::Populate($args); | |
|  | |
| 	$self->ConfigSpecs('DEFAULT' => ['SELF']); | |
| } | |
|  | |
| sub on_receive_away | |
| { | |
| 	my ($self, $away) = @_; | |
| 	$away = $self->process($away); | |
| 		 | |
| 	$self->{text}->insertHTML('0.0', "\n-------------------------\n"); | |
| 	$self->{text}->insertHTML('0.0', $away); | |
| 	$self->{close}->focus; | |
| } | |
|  | |
| sub on_receive_prof | |
| { | |
| 	my ($self, $prof) = @_; | |
| 	$prof = $self->process($prof); | |
| 	 | |
| 	$self->{text}->insertHTML('end', $prof); | |
| 	$self->{close}->focus; | |
| } | |
|  | |
| sub on_destroy | |
| { | |
| 	my ($self) = @_; | |
|  | |
| 	$self->{destroyed} = 1; | |
|  | |
| 	hook("remove_profile", -who => $self->{who}); | |
| } | |
|  | |
| sub set_buddy | |
| { | |
| 	my ($self, $buddy) = @_; | |
| 	$self->{buddy} = $buddy; | |
| } | |
|  | |
| sub process | |
| { | |
| 	my ($self, $str) = @_; | |
| 	 | |
| 	$str =~ s/\%n/data("me")/eg; | |
|  | |
| 	return $str; | |
| } | |
|  | |
| sub init | |
| { | |
| 	my ($self, $who) = @_; | |
| 	my ($mins, $hrs, $days); | |
|  | |
| 	$self->{who} = $who; | |
|  | |
| 	my $on_time = time - hook("protocol_on_since", -who => $who); | |
| 	(undef, $mins, $hrs, $days, undef, undef, undef) = gmtime($on_time); | |
| 	$days--; | |
|  | |
| 	$self->Label(-text => "$who has been online for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); | |
|  | |
| 	if(hook("protocol_idle_since", -who => $who)) | |
| 	{ | |
|             use integer; | |
|  | |
|             my $idle_time = hook("protocol_idle_since", -who => $who); | |
| 	     | |
|             my ($mins, $hrs, $days); | |
|             $mins = $idle_time / 60; | |
|              | |
|             $hrs = $mins / 60; | |
|             $mins %= 60; | |
|              | |
|             $days = $hrs / 24; | |
|             $hrs %= 24; | |
|                  | |
|             $self->Label(-text => "$who has been idle for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); | |
| 	} | |
|  | |
| 	$self->Label(-text => "Profile Text:", -font => 'arial 9 bold')->pack(-ipady => 1, -anchor => 'w'); | |
|  | |
| 	$self->{text} = $self->Frame->pack(-expand => 1, -fill => 'both')-> | |
| 		Scrolled("Browser", -scrollbars => 'oe', -background => 'white', -wrap => 'word')-> | |
| 		pack(-expand => 1, -fill => 'both'); | |
|  | |
| 	$self->{text}->tagConfigure('away', -foreground => 'blue', -font => 'arial 10 bold'); | |
| 	$self->{text}->tagConfigure('prof', -foreground => 'black', -font => 'arial 10 bold'); | |
| 	$self->{close} = $self->Button(-text => "Close", -command => [$self, "destroy"])->pack; | |
|  | |
| 	hook("tk_bindwheel", -window => $self->{text}); | |
|  | |
| 	$self->OnDestroy([\&on_destroy, $self]); | |
| 	$self->bind("<Escape>", [$self, "destroy"]); | |
| 	hook("tk_seticon", -wnd => $self); | |
| }
 | |
| 
 |