[Tkabber-dev] r791 - in trunk/tkabber: . plugins/chat plugins/general plugins/richtext

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 12 15:17:42 MSK 2006


Author: sergei
Date: 2006-11-12 15:17:34 +0300 (Sun, 12 Nov 2006)
New Revision: 791

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/INSTALL
   trunk/tkabber/Makefile
   trunk/tkabber/chats.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/plugins/chat/draw_info.tcl
   trunk/tkabber/plugins/chat/draw_server_message.tcl
   trunk/tkabber/plugins/chat/draw_xhtml_message.tcl
   trunk/tkabber/plugins/chat/me_command.tcl
   trunk/tkabber/plugins/general/headlines.tcl
   trunk/tkabber/plugins/general/message_archive.tcl
   trunk/tkabber/plugins/richtext/chatlog.tcl
   trunk/tkabber/plugins/richtext/emoticons.tcl
   trunk/tkabber/plugins/richtext/highlight.tcl
   trunk/tkabber/plugins/richtext/stylecodes.tcl
   trunk/tkabber/plugins/richtext/urls.tcl
   trunk/tkabber/richtext.tcl
Log:
	* INSTALL: Corrected link to README.

	* Makefile: Fixed installing docs, emoticons, and translations.

	* chats.tcl, messages.tcl, plugins/chat/draw_info.tcl,
	  plugins/chat/draw_server_message.tcl,
	  plugins/chat/draw_xhtml_message.tcl, plugins/chat/me_command.tcl,
	  plugins/general/headlines.tcl,
	  plugins/general/message_archive.tcl, richtext.tcl:
	  Replaced chat::add_emoteiconed_text by richtext::render_message,
	  removed highlightlist arg from richtext::render_message.

	* plugins/richtext/chatlog.tcl, plugins/richtext/emoticons.tcl,
	  plugins/richtext/highlight.tcl, plugins/richtext/stylecodes.tcl,
	  plugins/richtext/urls.tcl, richtext.tcl: Code cleanup.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/ChangeLog	2006-11-12 12:17:34 UTC (rev 791)
@@ -1,3 +1,21 @@
+2006-11-12  Sergei Golovan  <sgolovan at nes.ru>
+
+	* INSTALL: Corrected link to README.
+
+	* Makefile: Fixed installing docs, emoticons, and translations.
+
+	* chats.tcl, messages.tcl, plugins/chat/draw_info.tcl,
+	  plugins/chat/draw_server_message.tcl,
+	  plugins/chat/draw_xhtml_message.tcl, plugins/chat/me_command.tcl,
+	  plugins/general/headlines.tcl,
+	  plugins/general/message_archive.tcl, richtext.tcl:
+	  Replaced chat::add_emoteiconed_text by richtext::render_message,
+	  removed highlightlist arg from richtext::render_message.
+
+	* plugins/richtext/chatlog.tcl, plugins/richtext/emoticons.tcl,
+	  plugins/richtext/highlight.tcl, plugins/richtext/stylecodes.tcl,
+	  plugins/richtext/urls.tcl, richtext.tcl: Code cleanup.
+
 2006-11-10  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/iroster.tcl: Bugfix (thanks to Irek Chmielowiec).

Modified: trunk/tkabber/INSTALL
===================================================================
--- trunk/tkabber/INSTALL	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/INSTALL	2006-11-12 12:17:34 UTC (rev 791)
@@ -1 +1 @@
-See README.html
+See README

Modified: trunk/tkabber/Makefile
===================================================================
--- trunk/tkabber/Makefile	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/Makefile	2006-11-12 12:17:34 UTC (rev 791)
@@ -1,23 +1,29 @@
 # $Id$
 
 PREFIX = /usr/local
+TKABBERDIR = $(PREFIX)/share/tkabber
+DOCDIR = $(PREFIX)/share/doc/tkabber
+BINDIR = $(PREFIX)/bin
 
-SUBDIRS = aniemoteicons     \
-          emoticons-tkabber \
-	  ifacetk           \
-          jabberlib-tclxml  \
-	  mclistbox-1.02    \
-	  msgs		    \
-          pixmaps           \
-          plugins           \
-	  sounds
+SUBDIRS = aniemoteicons   \
+          emoticons       \
+	  ifacetk         \
+          jabberlib-tclxml\
+	  mclistbox-1.02  \
+	  msgs		  \
+          pixmaps         \
+          plugins         \
+	  sounds          \
+	  trans
 
 install:
-	mkdir -p $(DESTDIR)/$(PREFIX)/share/tkabber
-	cp -r *.tcl $(SUBDIRS) $(DESTDIR)/$(PREFIX)/share/tkabber
-	mkdir -p $(DESTDIR)/$(PREFIX)/share/doc/tkabber/
-	cp -r examples $(DESTDIR)/$(PREFIX)/share/doc/tkabber
-	mkdir -p $(DESTDIR)/$(PREFIX)/bin/
-	echo -e "#!/bin/sh\nexec wish $(PREFIX)/share/tkabber/tkabber.tcl -name tkabber \"\$$@\"\n" > $(DESTDIR)/$(PREFIX)/bin/tkabber
-	chmod +x $(DESTDIR)/$(PREFIX)/bin/tkabber
+	mkdir -p $(DESTDIR)/$(TKABBERDIR)
+	cp -r *.tcl $(SUBDIRS) $(DESTDIR)/$(TKABBERDIR)
+	mkdir -p $(DESTDIR)/$(DOCDIR)
+	cp -r examples $(DESTDIR)/$(DOCDIR)
+	cp AUTHORS COPYING ChangeLog README doc/tkabber.html $(DESTDIR)/$(DOCDIR)
+	mkdir -p $(DESTDIR)/$(BINDIR)
+	echo -e "#!/bin/sh\nexec wish $(TKABBERDIR)/tkabber.tcl -name tkabber \"\$$@\"\n" \
+		>$(DESTDIR)/$(BINDIR)/tkabber
+	chmod 755 $(DESTDIR)/$(BINDIR)/tkabber
 

Modified: trunk/tkabber/chats.tcl
===================================================================
--- trunk/tkabber/chats.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/chats.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -836,11 +836,6 @@
     }
 }
 
-proc chat::add_emoteiconed_text {chatw body defaulttag {highlightlist {}}} {
-    # TODO get rid of chat::add_emoteiconed_text
-    richtext::render_message $chatw $body $defaulttag $highlightlist
-}
-
 proc chat::add_open_to_user_menu_item {m connid jid} {
     $m add command -label [::msgcat::mc "Start chat"] \
 	-command [list chat::open_to_user $connid $jid]

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/messages.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -158,7 +158,7 @@
     ScrolledWindow $mw.rsw
     text $mw.rbody -width 60 -height 8 -wrap word
     ::richtext::config $mw.rbody -using {url emoticon stylecode}
-    ::chat::add_emoteiconed_text $mw.rbody $body ""
+    ::richtext::render_message $mw.rbody $body ""
     $mw.rbody configure -state disabled
     pack $mw.rsw -side top -fill both -expand yes -in $mw.frame
     pack $mw.rbody -side top -fill both -expand yes -in $mw.rsw

Modified: trunk/tkabber/plugins/chat/draw_info.tcl
===================================================================
--- trunk/tkabber/plugins/chat/draw_info.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/chat/draw_info.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -3,7 +3,7 @@
 proc handle_info {chatid from type body x} {
 
     if {[cequal $type info]} {
-	chat::add_emoteiconed_text [chat::chat_win $chatid] $body info
+	::richtext::render_message [chat::chat_win $chatid] $body info
 	tab_set_updated [chat::winid $chatid] 1 info
 	return stop
     }

Modified: trunk/tkabber/plugins/chat/draw_server_message.tcl
===================================================================
--- trunk/tkabber/plugins/chat/draw_server_message.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/chat/draw_server_message.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -6,7 +6,7 @@
 	set chatw [chat::chat_win $chatid]
 
 	$chatw insert end --- server_lab " "
-	chat::add_emoteiconed_text [::chat::chat_win $chatid] $body server
+	::richtext::render_message [::chat::chat_win $chatid] $body server
 	set cw [chat::winid $chatid]
 	tab_set_updated $cw 1 server
 	return stop

Modified: trunk/tkabber/plugins/chat/draw_xhtml_message.tcl
===================================================================
--- trunk/tkabber/plugins/chat/draw_xhtml_message.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/chat/draw_xhtml_message.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -64,11 +64,11 @@
 
 	if {[crange $body 0 [expr [clength $mynick] + 1]] == "${mynick}: "} {
 	    $chatw insert end $mynick me
-	    chat::add_emoteiconed_text [::chat::chat_win $chatid] \
+	    ::richtext::render_message [::chat::chat_win $chatid] \
 		[crange $body [clength $mynick] end] ""
 	    tab_set_updated $cw 1 mesg_to_user
 	} else {
-	    chat::add_emoteiconed_text [::chat::chat_win $chatid] $body ""
+	    ::richtext::render_message [::chat::chat_win $chatid] $body ""
 	    tab_set_updated $cw 1 message
 	}
     } else {
@@ -200,7 +200,7 @@
 	}
 
 	li {
-	    chat::add_emoteiconed_text $cw $prefix ""
+	    ::richtext::render_message $cw $prefix ""
 	    set prefix ""
 	    switch -- $state(list_style) {
 		ul {
@@ -214,7 +214,7 @@
 			     $state(list_counter)]
 		}
 	    }
-	    chat::add_emoteiconed_text $cw $item_prefix \
+	    ::richtext::render_message $cw $item_prefix \
 		[concat xhtml_symb [get_tags $cw]]
 	}
 	ul {
@@ -248,8 +248,8 @@
 	set state(afterspace) [expr {[string index $formated end] == " "}]
     }
 
-    chat::add_emoteiconed_text $cw $prefix $tag
-    chat::add_emoteiconed_text $cw $formated $tag
+    ::richtext::render_message $cw $prefix $tag
+    ::richtext::render_message $cw $formated $tag
 
     if {$formated != ""} {
 	set state(lastnl) 0
@@ -268,7 +268,7 @@
 	    set state(afterspace) [expr {[string index $formated end] == " "}]
 	}
 
-	chat::add_emoteiconed_text $cw $formated $tag
+	::richtext::render_message $cw $formated $tag
 	if {$formated != ""} {
 	    set state(lastnl) 0
 	}
@@ -284,13 +284,13 @@
 	}
     }
     if {$suffix == "\n\n"} {
-	chat::add_emoteiconed_text $cw \
+	::richtext::render_message $cw \
 	    [string repeat "\n" [expr {2 - $state(lastnl)}]] ""
     } elseif {$suffix == "\n"} {
-	chat::add_emoteiconed_text $cw \
+	::richtext::render_message $cw \
 	    [string repeat "\n" [expr {1 - $state(lastnl)}]] ""
     } else {
-	chat::add_emoteiconed_text $cw $suffix $tag
+	::richtext::render_message $cw $suffix $tag
     }
     set state(lastnl) 0
     if {[$cw get "end - 2c"] == "\n"} {

Modified: trunk/tkabber/plugins/chat/me_command.tcl
===================================================================
--- trunk/tkabber/plugins/chat/me_command.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/chat/me_command.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -33,7 +33,8 @@
 		tab_set_updated $cw 1 message
 	    }
 	} else {
-	    chat::add_emoteiconed_text $chatw $body $tag
+	    ::richtext::render_message $chatw $body $tag
+
 	    tab_set_updated $cw 1 mesg_to_user
 	}
 

Modified: trunk/tkabber/plugins/general/headlines.tcl
===================================================================
--- trunk/tkabber/plugins/general/headlines.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/general/headlines.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -291,7 +291,7 @@
     
     $wbody configure -state normal
     $wbody delete 0.0 end
-    chat::add_emoteiconed_text $wbody "$body\n\n" ""
+    ::richtext::render_message $wbody "$body\n\n" ""
     if {$url != ""} {
         ::plugins::urls::render_url $wbody url $url {} \
             -command [list [namespace code action] markseen \

Modified: trunk/tkabber/plugins/general/message_archive.tcl
===================================================================
--- trunk/tkabber/plugins/general/message_archive.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/general/message_archive.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -288,6 +288,6 @@
     $w.sw.body configure -state normal
     $w.sw.body delete 0.0 end
     #$w.sw.body insert end $messages($id,body)
-    ::chat::add_emoteiconed_text $w.sw.body $messages($id,body) ""
+    ::richtext::render_message $w.sw.body $messages($id,body) ""
     $w.sw.body configure -state disabled
 }

Modified: trunk/tkabber/plugins/richtext/chatlog.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/chatlog.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/richtext/chatlog.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -51,7 +51,8 @@
 		$w tag configure highlight -foreground $val
 	    }
 	    default {
-		error "Unknown option: $opt"
+		return -code error "[namespace current]::config:\
+				    Unknown option: $opt"
 	    }
 	}
     }

Modified: trunk/tkabber/plugins/richtext/emoticons.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/emoticons.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/richtext/emoticons.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -209,7 +209,7 @@
     variable txtlabels
     variable images
 
-    lappend faces
+    set faces {}
     set txtdefault ""
     set graphic ""
     foreach item $items {
@@ -399,8 +399,7 @@
 proc emoticons::process_emoticons {atLevel accName} {
     upvar #$atLevel $accName chunks
 
-    lappend out
-
+    set out {}
     foreach {s type tags} $chunks {
 	if {$type != "text"} {
 	    # pass through
@@ -409,7 +408,6 @@
 	}
 
 	set ix 0; set fs 0; set fe 0
-
 	while {[spot_face $s $ix fs fe]} {
 	    if {$fs - $ix > 0} {
 		# dump chunk before emoticon:
@@ -549,6 +547,7 @@
     variable options
     variable themes
 
+    set values {}
     array unset themes *
 
     enumerate_available_themes

Modified: trunk/tkabber/plugins/richtext/highlight.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/highlight.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/richtext/highlight.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -43,7 +43,7 @@
 	lappend subs [::richtext::property_get mynick]
     }
 
-    lappend out
+    set out {}
 
     foreach {s type tags} $chunks {
 	if {$type != "text"} {
@@ -81,7 +81,7 @@
 
     set ind_end 0
     set stop_ind [string length $s]
-    lappend ranges
+    set ranges {}
     set found 1
     while {$found && $ind_end < $stop_ind} {
 	set found 0

Modified: trunk/tkabber/plugins/richtext/stylecodes.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/stylecodes.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/richtext/stylecodes.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -23,7 +23,7 @@
 proc stylecodes::process_stylecodes {atLevel accName} {
     upvar #$atLevel $accName chunks
 
-    lappend out
+    set out {}
 
     foreach {s type tags} $chunks {
 	if {$type != "text"} {
@@ -45,8 +45,7 @@
 proc stylecodes::scan_stylecodes {what type tags stylecodes} {
     set len [string length $what]
 
-    lappend out
-
+    set out {}
     set si 0
 
     for {set ix 0} {$ix < $len} {incr ix} {
@@ -56,7 +55,7 @@
 
 	if {$sc == {}} continue
 
-	foreach {ls le ms me rs re pat} $sc break
+	lassign $sc ls le ms me rs re pat
 
 	if {$ls - $si > 0} {
 	    # dump the text before opening stylecode block:
@@ -90,7 +89,7 @@
     upvar 1 $ixVar ix $startOKVar startOK
 
     set ls $ix
-    lappend pattern
+    set pattern {}
 
     while {[eat_stylecode $what $ix stylecodes pattern startOK]} {
 	incr ix
@@ -170,6 +169,7 @@
 }
 
 proc stylecodes::stylecodes->tags {pattern} {
+    set out {}
     array set tags {* bold
 		    / italic
 		    _ underlined}

Modified: trunk/tkabber/plugins/richtext/urls.tcl
===================================================================
--- trunk/tkabber/plugins/richtext/urls.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/plugins/richtext/urls.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -60,7 +60,7 @@
 proc urls::process_urls {atLevel accName} {
     upvar #$atLevel $accName chunks
 
-    lappend out
+    set out {}
 
     foreach {s type tags} $chunks {
 	if {$type != "text"} {
@@ -102,7 +102,7 @@
     if {!$matched} { return false }
 
     upvar 1 $startVar us $endVar ue
-    foreach {us ue} $bounds break
+    lassign $bounds us ue
     return true
 }
 
@@ -164,15 +164,13 @@
 #   any number of commands can be assotiated with a URL this way.
 
 proc urls::config_url {w tag args} {
-    array set config $args
-
-    foreach opt [array names config] {
-	switch -- $opt {
+    foreach {key val} $args {
+	switch -- $key {
 	    -command {
-		$w tag bind $tag <Button-1> $config($opt)
+		$w tag bind $tag <Button-1> $val
 	    }
 	    -add-command {
-		$w tag bind $tag <Button-1> +$config($opt)
+		$w tag bind $tag <Button-1> +$val
 	    }
 	}
     }
@@ -191,8 +189,7 @@
 
 # Returns a URL containing the $x,$y point in the text widget $w:
 proc urls::get_url {w x y} {
-    foreach {a b} [$w tag prevrange url "@$x,$y + 1 char"] break
-
+    lassign [$w tag prevrange url "@$x,$y + 1 char"] a b
     $w get $a $b
 }
 

Modified: trunk/tkabber/richtext.tcl
===================================================================
--- trunk/tkabber/richtext.tcl	2006-11-10 21:06:07 UTC (rev 790)
+++ trunk/tkabber/richtext.tcl	2006-11-12 12:17:34 UTC (rev 791)
@@ -11,8 +11,10 @@
     variable entities
     variable state
     variable texts {}
-    variable msgprops ;# free-form properties for processing of current message
 
+    # free-form properties for processing of current message
+    variable msgprops
+
     ::custom::defgroup {Rich Text} \
 	[::msgcat::mc "Settings of rich text facility which is used\
 		       to render chat messages and logs."] \
@@ -44,7 +46,8 @@
 		set entities($type,priority) $val
 	    }
 	    default {
-		error "unknown option $opt"
+		return -code error "[namespace current]::register_entity:\
+				    Unknown option $opt"
 	    }
 	}
     }
@@ -57,12 +60,10 @@
     array unset entities $type,*
 }
 
-proc richtext::entity_state {args} {
+proc richtext::entity_state {type {val ""}} {
     variable entities
 
-    foreach {type val} $args break
-
-    if {$val == {}} {
+    if {$val == ""} {
 	set entities($type,enabled)
     } else {
 	set entities($type,enabled) $val
@@ -100,7 +101,8 @@
 		set using $val
 	    }
 	    default {
-		error "Unknown option: $opt"
+		return -code error "[namespace current]::config:\
+				    Unknown option: $opt"
 	    }
 	}
     }
@@ -150,14 +152,14 @@
     $w configure -state disabled
 }
 
-# TODO get rid of "deftag" and "highlightlist"
-proc richtext::render_message {w body deftag {highlightlist {}}} {
+# TODO get rid of "deftag"
+proc richtext::render_message {w body deftag} {
     variable entities
     variable state
     variable msgprops
 
     # Parse the message text with rich text entity parsers:
-    set chunks [process_highlights $body $deftag $highlightlist]
+    set chunks [list $body text $deftag]
     foreach type $state($w,types) {
 	if {$entities($type,enabled) && [info exists entities($type,parser)]} {
 	    $entities($type,parser) [info level] chunks
@@ -169,8 +171,9 @@
 	#puts "(draw) piece: $piece; type: $type; tags: $tags"
 
 	if {! [info exists entities($type,renderer)]} {
+	    # Fallback
 	    debugmsg richtext "Got piece with unknown type $type"
-	    set type text ;# fallback
+	    set type text
 	}
 
 	$entities($type,renderer) $w $type $piece $tags
@@ -182,25 +185,6 @@
     array unset msgprops *
 }
 
-# TODO suppress empty chunks
-# TODO move searching for highlights into rich text plugin
-#      (see plugin/chat/me_command.tcl)
-proc richtext::process_highlights {body deftag {highlightlist {}}} {
-    if {[llength $highlightlist] == 0} {
-	lappend chunks $body text $deftag
-    } else {
-	set ind 0
-	foreach {i1 i2} $highlightlist {
-	    lappend chunks [crange $body $ind [expr {$i1 - 1}]] text $deftag
-	    lappend chunks [crange $body $i1 [expr {$i2 - 1}]] text highlight
-	    set ind $i2
-	}
-	lappend chunks [crange $body $ind end] text $deftag
-    }
-
-    return $chunks
-}
-
 proc richtext::fixup_tags {tags tgroups} {
     foreach t $tags {
 	set thash($t) 0
@@ -228,7 +212,6 @@
     set thash($t) 0
 }
 
-# TODO get rid of [puts]
 proc richtext::reconstruct_text {w first last} {
     #puts "in [info level 0]"
     if {[catch {$w dump -text -tag $first $last} dump]} {
@@ -336,7 +319,8 @@
 	set found 1
 	foreach list [lrange $args 1 end] {
 	    if {[lsearch -exact $list $element] < 0} {
-		set found 0; break
+		set found 0
+		break
 	    }
 	}
 	if {$found} {lappend res $element}
@@ -407,7 +391,8 @@
     variable msgprops
 
     if {[info exists msgprops(name)]} {
-	error "Attempted to overwrite message property: $name"
+	return -code error "[namespace current]::property_add:\
+			    Attempted to overwrite message property: $name"
     }
 
     set msgprops($name) $value



More information about the Tkabber-dev mailing list