Tk Library Source Code

Artifact [e7d68bdf39]
Login

Artifact e7d68bdf39d89ff706ac9de8be3765dbcc725162:

Attachment "word.tcl" to ticket [2890743fff] added by andreas_kupries 2009-11-03 05:05:07.
proc Word0 {dv} {
    upvar 1 $dv data

    # data
    #
    # The string we expect to be either a full well-formed list, or a
    # well-formed list until the end of the first word in the list,
    # with non-wellformed data following after, i.e. an incomplete
    # list with a complete first word.

    if {[regexp -indices "^\\s*(\{)" $data -> bracerange]} {
	# The word is brace-quoted, starting at index 'lindex
	# bracerange 0'. We now have to find the closing brace,
	# counting inner braces, ignoring quoted braces. We fail if
	# there is no proper closing brace.

	foreach {s e} $bracerange break
	incr s ; # index of the first char after the brace.
	incr e ; # same. but this is our running index.

	set level 1
	set max [string length $data]

	while {$level} {
	    # We are looking for the first regular or backslash-quoted
	    # opening or closing brace in the string. If none is found
	    # then the word is not complete, and we abort our search.

	    if {![regexp -indices -start $e {(([{}])|(\\[{}]))} $data -> any regular quoted]} {
		#                            ^^      ^
		#                            |regular \quoted
		#                            any
		return -code error "no complete word found/1"
	    }

	    foreach {qs qe} $quoted break
	    foreach {rs re} $regular break

	    if {$qs >= 0} {
		# Skip quoted braces ...
		set e $qe
		incr e
		continue
	    } elseif {$rs >= 0} {
		# Step one nesting level in or out.
		if {[string index $data $rs] eq "\{"} {
		    incr level
		} else {
		    incr level -1
		}
		set  e $re
		incr e
		#puts @$e
		continue
	    } else {
		return -code error "internal error"
	    }
	}

	incr e -2 ; # index of character just before the brace.
	return [list $s $e 2]

    } elseif {[regexp -indices {^\s*(\S+)\s} $data -> wordrange]} {
	# The word is a simple literal which ends at the next
	# whitespace character. Note that there has to be a whitespace
	# for us to recognize a word, for while there is no whitespace
	# behind it in the buffer the word itself may be incomplete.

	return [linsert $wordrange end 1]
    }

    return -code error "no complete word found/2"
}