From 879251bf98982283a4e80e068c2cda9822b0b895 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sat, 21 Jun 2008 00:04:52 +0100 Subject: [PATCH] history: test version now loads correctly into chat view --- bin/bf_irc.tcl | 10 ++++++++-- bin/bf_xmpp.tcl | 29 ++++++++++++++--------------- bin/history.tcl | 27 ++++++++++++++++++++++----- bin/message.tcl | 3 +++ 4 files changed, 47 insertions(+), 22 deletions(-) diff --git a/bin/bf_irc.tcl b/bin/bf_irc.tcl index 4be8638..235fab1 100644 --- a/bin/bf_irc.tcl +++ b/bin/bf_irc.tcl @@ -1,7 +1,13 @@ -# bf_irc.tcl -- Copyright (C) 2008 Pat Thoyts +# bf_irc.tcl -- # -# Handle the IRC transport (using picoirc) +# The Bullfrog IRC transport. This hooks up the Bullfrog GUI +# to an IRC connection using the picoirc library from tcllib. +# It can support multiple IRC connections and multiple channels. # +# Copyright (C) 2007-2008 Pat Thoyts +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # package require picoirc 0.5; # tcllib diff --git a/bin/bf_xmpp.tcl b/bin/bf_xmpp.tcl index 2b28c0b..fb080f5 100644 --- a/bin/bf_xmpp.tcl +++ b/bin/bf_xmpp.tcl @@ -1,22 +1,21 @@ -# Present a callback interface akin to the picoirc callback. -# The idea is to have the picoirc application be able to use multiple transports -# with only the callback being the comms interface. +# bf_xmpp.tcl - # +# The Bullfrog XMPP transport. This file ties up our GUI to the +# jabberlib library. It presents a callback interface similar +# to the callback used with picoirc. +# +# Copyright (C) 2007-2008 Pat Thoyts +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # # TODO: # -# One-to-one chats should show the nick name - either from the -# additional elements in the message stanza, or the resource if from a -# groupchat source or just the node. -# They also don't need a names window. -# We must echo our own messages in such a window. -# -# :) -# -# +# * One-to-one chats should show the nick name - either from the +# additional elements in the message stanza, or the resource if +# from a groupchat source or just the node. +# * login profiles (persistent) +# * message store (tied to the message view) # package require jlib package require jlib::connect diff --git a/bin/history.tcl b/bin/history.tcl index 6cc87a1..4578cc4 100644 --- a/bin/history.tcl +++ b/bin/history.tcl @@ -168,20 +168,37 @@ proc ::tclers.tk::Test {} { proc ::tclers.tk::TestX {room chatwidget} { proc ::tclers.tk::HistoryMessage {w when nick msg {opts ""} args} { + if {$nick eq {}} {return} + if {$nick eq "ijchain" && [string match {\*\*\* *} $msg]} { return } if {[catch {clock scan $when -format "%Y-%m-%dT%H:%M:%S%Z" -gmt 1} time]} { set time [clock scan $when -format "%Y%m%dT%H:%M:%S" -gmt 1] } if {$opts ne ""} {puts stderr "OPTS: '$opts'"} - #$w insert history "$ts " TIMESTAMP "$nick\t$msg\n" [list NICK-$nick MSG] - $w message $msg -mark history -nick $nick -time $time ;#-type $type + set type normal + if {$nick eq "ijchain"} { + if {![regexp {^(<.*?>) (.*)$} $msg -> nick msg]} { + if {[regexp {^\* ([^ ]+) (.*)$} $msg -> nick msg]} { + set type action + set nick <${nick}> + } + } + } elseif {[string match "/me *" $msg]} { + set msg [string range $msg 4 end] + set type action + } + + $w chat configure -state normal + $w message $msg -mark history -nick $nick -time $time -type $type -tags HISTORY + $w chat configure -state normal } $chatwidget chat configure -state normal + $chatwidget chat tag configure HISTORYMARK -background black -foreground white + $chatwidget chat tag configure HISTORY -background "#eee" catch {$chatwidget chat delete 1.0 "history + 1 line"} + $chatwidget chat insert 1.0 \ + "+++++++++++++++++++++ Loading History +++++++++++++++++++++\n" HISTORYMARK $chatwidget chat mark set history 1.0 - $chatwidget chat mark gravity history left - $chatwidget chat insert history "--- end of history ---\n" HISTORYMARK - $chatwidget chat mark gravity history right $chatwidget chat configure -state disabled gethistory $room \ -progress [namespace code [list TestProgress .htest.f.status.progress]] \ diff --git a/bin/message.tcl b/bin/message.tcl index a7ab287..74a859a 100644 --- a/bin/message.tcl +++ b/bin/message.tcl @@ -6,6 +6,9 @@ # message and clicking a message triggers the display in the lower # section # +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# # ------------------------------------------------------------------------- # TODO: # - delete -- 2.23.0