[Tkabber-dev] r69 - throwaway/ctcomp2

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Oct 5 05:12:00 MSD 2007


Author: kostix
Date: 2007-10-05 05:12:00 +0400 (Fri, 05 Oct 2007)
New Revision: 69

Modified:
   throwaway/ctcomp2/TODO
   throwaway/ctcomp2/ctcomp.tcl
Log:
ctcomp.tcl:
 * Fixed behaviour regarding entering active mode: now it's entered
   only if there are matches to choose from.
 * Changed behaviour of keystrokes in the active mode: now any key
   besides <<ChatTextCompletionAccept>> accepts the currently
   proposed completion _and_ is inserted into the buffer;
   <<ChatTextCompletionAccept>> explicitly accepts the proposed
   completion but is not inserted into the buffer.
   <<ChatTextCompletionCancel>> explicitly cancels the completion
   mode and that's the only event that does so.
   <<ChatTextCompletionAcceptIns>> event and its processing was
   removed (no longer needed).
 * Colors of the completion submatch are now tunable via Tk options DB.
 * Added emacsish binding <M-/> for <<ChatTextCompletionNext>>.
 * Fixed RE for matching: now proposed completions must include at least
   one extra character compared to the word being completed.
 * Fixed traversing the list of completions in the "next" direction:
   now only proposed completions are shown when traversing the list
   in both directions.

 So now the behaviour pretty closely mimics that of Vim/Emacs
 with the exception that this plugin sorts proposed completions
 in the dictionary order while those editors use the last-typed-in
 order.

TODO: Tasks updated.


Modified: throwaway/ctcomp2/TODO
===================================================================
--- throwaway/ctcomp2/TODO	2007-10-04 00:29:35 UTC (rev 68)
+++ throwaway/ctcomp2/TODO	2007-10-05 01:12:00 UTC (rev 69)
@@ -1,7 +1,10 @@
 $Id$
 
-* Redesign the binding handles to that the "active"
-  mode isn't actually switched on if there's no matches
-  or there's a single match that exactly matches the
-  word being completed.
+* Think about menu mode; also think of "instant menu" option.
 
+* Finding of a word being completed is a bit broken:
+  for the string "mumble ??_" with the cursor denoted by "_"
+  pressing C-n will yield "mumble ??" instead of "??" or "".
+  So probably something needs to be rethought/fine-tuned.
+
+# vim:tw=64:noet

Modified: throwaway/ctcomp2/ctcomp.tcl
===================================================================
--- throwaway/ctcomp2/ctcomp.tcl	2007-10-04 00:29:35 UTC (rev 68)
+++ throwaway/ctcomp2/ctcomp.tcl	2007-10-05 01:12:00 UTC (rev 69)
@@ -4,37 +4,44 @@
 # See "lisence.terms" for distribution details.
 # Consult README for the information and usage guidelines.
 
+option add *Chat.textCompletionForeground    black   widgetDefault
+option add *Chat.textCompletionBackground    pink    widgetDefault
+
 namespace eval ctcomp {
 	variable options
 
-	set options(pattern) {\m%s\w*\M}
+	set options(pattern) {\m%s\w+\M}
 
-	event add <<ChatTextCompNext>>      <Control-n>
-	event add <<ChatTextCompPrev>>      <Control-p>
-	event add <<ChatTextCompAccept>>    <Return>
-	event add <<ChatTextCompAcceptIns>> <space>
-	event add <<ChatTextCompAcceptIns>> <Tab>
-	event add <<ChatTextCompCancel>>    <Escape>
+	event add <<ChatTextCompNext>>    <Control-n>
+	event add <<ChatTextCompNext>>    <Alt-slash>
+	event add <<ChatTextCompNext>>    <Meta-slash>
+	event add <<ChatTextCompPrev>>    <Control-p>
+	event add <<ChatTextCompAccept>>  <Return>
+	event add <<ChatTextCompCancel>>  <Escape>
 
 	bind ChatTextCompInactive <<ChatTextCompNext>> [namespace code {
-		hook::run chat_text_completion_start_hook
-		activate %W
-		match next in %W
+		if {[matches in %W]} {
+			hook::run chat_text_completion_start_hook
+			activate %W
+			match first next in %W
+		}
 		break
 	}]
 	bind ChatTextCompInactive <<ChatTextCompPrev>> [namespace code {
-		hook::run chat_text_completion_start_hook
-		activate %W
-		match prev in %W
+		if {[matches in %W]} {
+			hook::run chat_text_completion_start_hook
+			activate %W
+			match first prev in %W
+		}
 		break
 	}]
 
 	bind ChatTextCompActive <<ChatTextCompNext>> [namespace code {
-		match next in %W
+		match next next in %W
 		break
 	}]
 	bind ChatTextCompActive <<ChatTextCompPrev>> [namespace code {
-		match prev in %W
+		match next prev in %W
 		break
 	}]
 	bind ChatTextCompActive <<ChatTextCompAccept>> [namespace code {
@@ -43,11 +50,6 @@
 		hook::run chat_text_completion_end_hook
 		break
 	}]
-	bind ChatTextCompActive <<ChatTextCompAcceptIns>> [namespace code {
-		accept %W
-		deactivate %W
-		hook::run chat_text_completion_end_hook
-	}]
 	bind ChatTextCompActive <<ChatTextCompCancel>> [namespace code {
 		cancel %W
 		deactivate %W
@@ -55,29 +57,31 @@
 		break
 	}]
 	bind ChatTextCompActive <Key> [namespace code {
-		cancel %W
+		accept %W
 		deactivate %W
 		hook::run chat_text_completion_end_hook
 	}]
 }
 
-# TODO remove in production:
+#### Glue code: TODO remove in production:
 namespace eval chat {
-	proc input_win chatid { return .iw }
-	proc chat_win  chatid { return .cw }
+	proc input_win chatid { return .f.iw }
+	proc chat_win  chatid { return .f.cw }
 	proc get_jid   chatid { return foo at bar.biz }
 	proc add_message {chatid jid type msg x} {
-		.cw config -state normal
-		.cw insert end $msg\n $type
-		.cw config -state disabled
+		.f.cw config -state normal
+		.f.cw insert end $msg\n $type
+		.f.cw config -state disabled
+		.f.cw see end
 	}
+	proc winid chatid { return .f }
 }
 namespace eval hook {
 	proc add args {}
 	proc run args {}
 }
 
-#### New code:
+#### Real code:
 
 proc ctcomp::initialize iw {
 	set btags [bindtags $iw]
@@ -115,9 +119,6 @@
 
 	# Kind of destructor for per-chat state:
 	bind $iw <Destroy> +[list [namespace current]::cleanup $iw %W]
-
-	# TODO the color must be tweakable via option DB:
-	$iw tag configure ctcomp/submatch -background pink
 }
 
 proc ctcomp::cleanup {w1 w2} {
@@ -151,11 +152,40 @@
 
 proc ctcomp::pattern what {
 	variable options
-	# TODO must escape RE magic chars after [format]ting:
-	format $options(pattern) $what
+
+	format $options(pattern) [string map {
+		\\  \\\\
+		[   \\[
+		\{  \\\{
+		(   \\(
+		$   \\$
+		.   \\.
+		*   \\*
+		?   \\?
+	} $what]
 }
 
-proc ctcomp::yield {"from" t} {
+proc ctcomp::matches {"in" iw} {
+	variable $iw
+	upvar 0 $iw state
+	upvar 0 state(chatid)  chatid
+	upvar 0 state(what)    what
+	upvar 0 state(matches) matches
+	upvar 0 state(last)    last
+
+	set what [word from $iw]
+	if {[string length $what] == 0} { return false }
+
+	set matches [get_matches for $what in $iw]
+	if {[llength $matches] == 0} {
+		show info $iw "No match for $what"
+		return false
+	}
+
+	return true
+}
+
+proc ctcomp::word {"from" t} {
 	set from [tk::TextPrevPos $t insert tcl_startOfPreviousWord]
 	$t get $from insert
 }
@@ -169,7 +199,7 @@
 		set seen($item) {}
 	}
 
-	set t [chat::chat_win $state(chatid)]
+	set t [chat::chat_win $chatid]
 	set pos 1.0
 
 	while 1 {
@@ -185,182 +215,113 @@
 	lsort -dictionary [array names seen]
 }
 
-proc ctcomp::wraparound {"in" iw} {
-	show info $iw "Wrapped around"
+proc ctcomp::last L {
+	expr {[llength $L] - 1}
 }
 
-proc ctcomp::advance {"to" where "in" iw} {
+proc ctcomp::getopt {iw opt} {
 	variable $iw
 	upvar 0 $iw state
-	upvar 0 state(last) last
 
-	switch -- $where {
-		next {
-			incr last
-			if {$last > [llength $state(matches)]} {
-				set last 0
-				wraparound in $iw
-			}
-		}
-		prev {
-			incr last -1
-			if {$last < 0} {
-				set last [expr {[llength $state(matches)] - 1}]
-				wraparound in $iw
-			}
-		}
-		default {
-			return -code error "Bad match \"$match\":\
-				should be next or prev"
-		}
-	}
+	option get [chat::winid $state(chatid)] $opt Chat
 }
 
-proc ctcomp::match {dir "in" iw} {
+proc ctcomp::match {seq dir "in" iw} {
 	variable $iw
 	upvar 0 $iw state
-	upvar 0 state(chatid)  chatid
 	upvar 0 state(what)    what
 	upvar 0 state(matches) matches
 	upvar 0 state(last)    last
 
-	set cw [chat::chat_win $chatid]
-
-	if {!$state(active)} {
-		set what [yield from $iw]
-		if {[string length $what] == 0} return
-
-		set state(matches) [get_matches for $what in $iw]
-		if {[llength $matches] == 0} {
-			show info $iw "No match for $what"
-			return
+	switch -- $seq {
+		first {
+			switch -- $dir {
+				next { set last 0 }
+				prev { set last [last $matches] }
+			}
+			$iw mark set comp_start insert
+			$iw mark gravity comp_start left
 		}
-
-		set last 0
-	} else {
-		advance to $dir in $iw
+		next {
+			advance to $dir in $iw
+			$iw delete comp_start comp_end
+		}
 	}
 
 	set match [lindex $matches $last]
 	set submatch [string range $match [string length $what] end]
 
-	if {$state(active)} {
-		$iw delete comp_start comp_end
-	} else {
-		$iw mark set comp_start insert
-		$iw mark gravity comp_start left
-	}
+	$iw tag configure ctcomp/submatch \
+		-foreground [getopt $iw textCompletionForeground] \
+		-background [getopt $iw textCompletionBackground]
+
 	$iw insert comp_start $submatch ctcomp/submatch
 	$iw mark set comp_end insert
 	$iw mark gravity comp_end right
-
-	set state(active) 1
 }
 
-# $type should be either "info" or "error"
-proc ctcomp::show {type token msg} {
-	variable $token
-	upvar 0 ${token}(chatid) chatid
+proc ctcomp::advance {"to" where "in" iw} {
+	variable $iw
+	upvar 0 $iw state
+	upvar 0 state(last)    last
+	upvar 0 state(matches) matches
 
-	set jid [chat::get_jid $chatid]
-	set cw [chat::chat_win $chatid]
+	set end [last $matches]
 
-	chat::add_message $chatid $jid $type $msg {}
-}
-
-#### Handling of bindtags (not currently used):
-
-proc ctcomp::btags {w op args} {
-	switch -- $op {
-		insert {
-			eval [list BindtagsInsert $w] $args
+	switch -- $where {
+		next {
+			incr last
+			if {$last > $end} {
+				set last 0
+				wraparound in $iw
+			}
 		}
-		delete {
-			if {[llength $args] != 1]} {
-				return -code error "Wrong # args: should be\
-					\"btags window delete tag\""
+		prev {
+			incr last -1
+			if {$last < 0} {
+				set last $end
+				wraparound in $iw
 			}
-			set btags [bindtags $w]
-			set ix [lsearch -exact $btags [lindex $args 0]]
-			if {$ix >= 0} {
-				bindtags $win [lreplace $btags $ix $ix]
-			}
-			bindtags $win
 		}
-		replace {
-		}
 		default {
-			return -code error "Bad operation \"$op\":\
-				must be insert or delete"
+			return -code error "Bad match \"$match\":\
+				should be next or prev"
 		}
 	}
 }
 
-proc ctcomp::BindtagsInsert {win tag args} {
-	set ix -1
-
-	foreach {opt val} $args {
-		switch -- $opt {
-			-before {
-				set ix [lsearch -exact [bindtags $win] $val]
-				incr ix -1
-			}
-			-after {
-				set ix [lsearch -exact [bindtags $win] $val]
-				incr ix 1
-			}
-			-at {
-				set ix $val
-			}
-			default {
-				return -code error "Bad option \"$opt\":\
-					must be one of -before, -after or -at"
-			}
-		}
-	}
+proc ctcomp::wraparound {"in" iw} {
+	show info $iw "Wrapped around"
 }
 
-#### Unneeded reference code:
-
-proc ctcomp::keypress_space token {
-	variable options
+# $type should be either "info" or "error"
+proc ctcomp::show {type token msg} {
 	variable $token
-	upvar 0 $token state
-	
-	if {!$state(active)} return
+	upvar 0 ${token}(chatid) chatid
 
-	if {$options(space_cancels_completion)} {
-		cancel $token
-	} else {
-		commit $token
-	}
-}
+	set jid [chat::get_jid $chatid]
+	set cw [chat::chat_win $chatid]
 
-proc ctcomp::keypress_return token {
-	variable $token
-	upvar 0 $token state
-	
-	if {!$state(active)} return
-
-	commit $token
-
-	return -code break
+	chat::add_message $chatid $jid $type $msg {}
 }
 
 #### Action:
 
 wm geometry . 417x280
 
-text .cw
-text .iw -height 3
+frame .f -class Chat
+pack .f -fill both -expand true
 
-grid .cw -column 0 -row 0 -sticky news
-grid .iw -column 0 -row 1 -sticky news
+text .f.cw
+text .f.iw -height 3
 
-grid rowconfigure . 0 -weight 1
-grid rowconfigure . 1 -weight 0
-grid columnconfigure . 0 -weight 1
+grid .f.cw -column 0 -row 0 -sticky news
+grid .f.iw -column 0 -row 1 -sticky news
 
+grid rowconfigure .f 0 -weight 1
+grid rowconfigure .f 1 -weight 0
+grid columnconfigure .f 0 -weight 1
+
 if {[string equal $tcl_platform(platform) windows]} {
 	console eval { wm protocol . WM_DELETE_WINDOW exit }
 	console show
@@ -375,17 +336,20 @@
 	foobargrill
 	grill
 	grille pitch
+	$environmental
+	[delete quux]
+	????
 }] \n] {
-	.cw insert end [string trim $line]\n
+	.f.cw insert end [string trim $line]\n
 }
 
-.cw tag config info -foreground blue
-.cw tag config error -foreground red
+.f.cw tag config info -foreground blue
+.f.cw tag config error -foreground red
 #.cw config -state disabled
 
-bind .iw <Escape> { destroy . }
+bind .f.iw <Escape> { destroy . }
 
 ctcomp::prepare {1 foo at bar.biz} chat
 
-focus -force .iw
+focus -force .f.iw
 



More information about the Tkabber-dev mailing list