############################################################################## # # Jarl - Debug Tk Code # # Perl code to handle the interface with the user. # ############################################################################## ############################################################################## # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Jabber # Copyright (C) 1998-1999 The Jabber Team http://jabber.org/ # ############################################################################## ############################################################################## # # jarlDebugIF_AddXML - add the specified XML with the specified type. # ############################################################################## sub jarlDebugIF_AddXML { my ($type,$xml) = @_; return if ($config{showdebug} == 0); if (Exists($GUI{Debug}->{Log}->{Text})) { my $typeTag = lc($type); $typeTag = "error" if ($xml =~ /type\s*\=\s*\'?\"?error\'?\"?/i); $GUI{Debug}->{Log}->{Text}->configure(-state=>"normal"); $GUI{Debug}->{Log}->{Text}-> insert("end","[".&Net::Jabber::GetTimeStamp("local",time,"shortest")."] ",[ "timestamp" ]); $GUI{Debug}->{Log}->{Text}->insert("end","$type: ",[ $typeTag ]); $GUI{Debug}->{Log}->{Text}->insert("end","$xml\n",[ $typeTag ]); my ($top,$bottom) = $GUI{Debug}->{Log}->{Text}->yview(); $GUI{Debug}->{Log}->{Text}->yview("moveto",100) if ($bottom > .9) || ($bottom == $top); $GUI{Debug}->{Log}->{Text}->configure(-state=>"disabled"); } } ############################################################################## # # jarlDebugIF_NewGUI - Create the widgets. # ############################################################################## sub jarlDebugIF_NewGUI { my $logPanelTop = $GUI{Debug}->{top}-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -relief=>"groove", -borderwidth=>2 )->pack(-side=>"top", -fill=>"both", -expand=>1, -padx=>5, -pady=>5); my $logHeaderTop = $logPanelTop-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, )->pack(-side=>"top", -fill=>"x"); $logHeaderTop-> Label(-text=>"Log", -anchor=>"w", -font=>$GUI{fonts}->{header}, -background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, )->pack(-side=>"left", -fill=>"x", -padx=>5); $GUI{Debug}->{LogHeader}->{Clear} = $logHeaderTop-> Button(-image=>$GUI{Icons}->{Clear}, -background=>$GUI{color}->{jarl}->{newmessage}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{newmessage}->{fg}->{dark}, -disabledforeground=>$GUI{color}->{jarl}->{newmessage}->{fg}->{light}, -font=>$GUI{fonts}->{normal}, -command=>sub{ $GUI{Debug}->{Log}->{Text}->configure(-state=>"normal"); $GUI{Debug}->{Log}->{Text}->delete("1.0","end"); $GUI{Debug}->{Log}->{Text}->configure(-state=>"disabled"); } )->pack(-side=>"right", -padx=>5); &jarlMainIF_RegisterIcon($GUI{Debug}->{LogHeader}->{Clear}, "Clear"); $GUI{ToolBar}->{Balloon}-> attach($GUI{Debug}->{LogHeader}->{Clear}, -balloonmsg=>"Clear the Debug Log "); my $logTop = $logPanelTop-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -relief=>"sunken", -borderwidth=>2 )->pack(-side=>"top", -fill=>"both", -expand=>1, -padx=>5, -pady=>5); my $logScrolled = $logTop-> Scrolled("Text", -scrollbars=>"e", -background=>$GUI{color}->{jarl}->{main}->{bg}->{light}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -borderwidth=>0, -highlightthickness=>0, -selectborderwidth=>0, -exportselection=>1, -takefocus=>0, -wrap=>"word", -state=>"disabled", -height=>1, -width=>1, )->pack(-side=>"left", -fill=>"both", -expand=>1, -padx=>0, -pady=>0); $logScrolled->Subwidget("yscrollbar")-> configure(-width=>10, -borderwidth=>1, -relief=>"flat"); $GUI{Debug}->{Log}->{Text} = $logScrolled->Subwidget("text"); $logScrolled->Subwidget("text")->tagConfigure("sent", -foreground=>"blue", -lmargin1=>60, -lmargin2=>60); $logScrolled->Subwidget("text")->tagConfigure("rcvd", -foreground=>"green4", -lmargin1=>60, -lmargin2=>60); $logScrolled->Subwidget("text")->tagConfigure("error", -foreground=>"red", -lmargin1=>60, -lmargin2=>60); $logScrolled->Subwidget("text")->tagConfigure("timestamp", -foreground=>"gray30"); $logScrolled->Subwidget("text")-> bind("", sub{ $logScrolled->Subwidget("text")->yviewScroll(-1,"units"); }); $logScrolled->Subwidget("text")-> bind("", sub{ $logScrolled->Subwidget("text")->yviewScroll(1,"units"); }); my $sendPanelTop = $GUI{Debug}->{top}-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -relief=>"groove", -borderwidth=>2 )->pack(-side=>"top", -fill=>"both", -padx=>5, -pady=>5); my $sendXMLTop = $sendPanelTop-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, )->pack(-side=>"top", -fill=>"x"); $sendXMLTop-> Label(-text=>"Send Raw XML", -anchor=>"w", -font=>$GUI{fonts}->{header}, -background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, )->pack(-side=>"left", -fill=>"x", -padx=>5); my $sendButtonsTop = $sendXMLTop-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, )->pack(-side=>"right", -fill=>"x"); $sendButtonsTop-> Button(-text=>"Send", -background=>$GUI{color}->{bg}->{normal}, -foreground=>$GUI{color}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -command=>sub{ my $xml = $GUI{Debug}->{Send}->{Text}->get("1.0","end"); chomp($xml); &jarlDebug_AddHistory($xml); $GUI{Debug}->{Send}->{Text}->delete("1.0","end"); $jabber{client}->Send($xml); } )->pack(-side=>"right", -pady=>5, -padx=>5); $sendButtonsTop-> Button(-text=>"IQ", -background=>$GUI{color}->{bg}->{normal}, -foreground=>$GUI{color}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -command=>sub{ $GUI{Debug}->{Send}->{Text}->delete("1.0","end"); $GUI{Debug}->{Send}->{Text}->insert("end","\n \n \n"); } )->pack(-side=>"right", -pady=>5, -padx=>5); $sendButtonsTop-> Button(-text=>"Presence", -background=>$GUI{color}->{bg}->{normal}, -foreground=>$GUI{color}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -command=>sub{ $GUI{Debug}->{Send}->{Text}->delete("1.0","end"); $GUI{Debug}->{Send}->{Text}->insert("end","\n \n \n"); } )->pack(-side=>"right", -pady=>5, -padx=>5); $sendButtonsTop-> Button(-text=>"Message", -background=>$GUI{color}->{bg}->{normal}, -foreground=>$GUI{color}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -command=>sub{ $GUI{Debug}->{Send}->{Text}->delete("1.0","end"); $GUI{Debug}->{Send}->{Text}->insert("end","\n \n \n"); } )->pack(-side=>"right", -pady=>5, -padx=>5); my $sendTop = $sendPanelTop-> Frame(-background=>$GUI{color}->{jarl}->{main}->{bg}->{normal}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -relief=>"sunken", -borderwidth=>2 )->pack(-side=>"top", -fill=>"x", -padx=>5, -pady=>5); my $sendScrolled = $sendTop-> Scrolled("Text", -scrollbars=>"e", -background=>$GUI{color}->{jarl}->{main}->{bg}->{light}, -foreground=>$GUI{color}->{jarl}->{main}->{fg}->{dark}, -font=>$GUI{fonts}->{normal}, -borderwidth=>0, -highlightthickness=>0, -selectborderwidth=>0, -exportselection=>1, -takefocus=>0, -wrap=>"word", -height=>4, -width=>1, )->pack(-side=>"top", -fill=>"x", -expand=>1, -padx=>0, -pady=>0); $sendScrolled->Subwidget("yscrollbar")-> configure(-width=>10, -borderwidth=>1, -relief=>"flat"); $GUI{Debug}->{Send}->{Text} = $sendScrolled->Subwidget("text"); $GUI{Debug}->{Send}->{Text}-> bind("", sub{ $GUI{Debug}->{Send}->{Text}->yviewScroll(-1,"units"); }); $GUI{Debug}->{Send}->{Text}-> bind("", sub{ $GUI{Debug}->{Send}->{Text}->yviewScroll(1,"units"); }); $GUI{Debug}->{Send}->{Text}-> bind("", sub{ &jarlDebugIF_CurrentSay(&jarlDebug_HistoryUp()); }); $GUI{Debug}->{Send}->{Text}-> bind("", sub{ &jarlDebugIF_CurrentSay(&jarlDebug_HistoryDown()); }); } ############################################################################## # # jarlDebugIF_CurrentSay - if $value is defined then the Entry contents # are set to $value, otherwise the contents of # the Entry are returned. # ############################################################################## sub jarlDebugIF_CurrentSay { my ($value) = @_; if (defined($value)) { $GUI{Debug}->{Send}->{Text}->delete("1.0","end"); $GUI{Debug}->{Send}->{Text}->insert("end",$value); } return $GUI{Debug}->{Send}->{Text}->get("1.0","end"); } 1;