Tcl/Tk Cookbook - Text Editor

Recall that Tk creates a unique command ".ed" when it created the text widget ".ed". The text widget specific actions can be invoked using this command.

.ed delete takes two two character positions and deletes all the text between these two positions. Special words such as "end", "lineend", marks the end of the displayed text or the end of a given line.

The command .ed mark set insert sets a special marker/annotation named insert, the insertion point at the set position, here at the beginning of the first character of the first line. (Note that ".ed mark set pos 2.5" will set a marker named pos which points to the gap between the fifth and sixth character in secondline).

proc SaveFile {} {
global fileselect
set sts [catch {set f [open $fileselect(selectedfile) w]} \
	errormessage]
if {$sts == 0} {
	puts $f [.ed get 1.0 end]
	} else {
		set ok [showMessage "No filename given"]
		}
 
}

The SaveFile is similar to OpenFile but tries to open a selected file with write (overwrite in this case) permission. If it cannot open the file for any reason quits with the message that "No file name is given". Otherwise it writes the contents of the text widget into the file.

proc SaveAsFile {} {
global fileselect oldname
fileselect
tkwait window .fileSelectWindow
if {$fileselect(selectedfile) == "" } {
	set ok [showMessage "No filename given"]
		return }
if {[string compare $fileselect(selectedfile) $oldname] == 0 } {
	set ok [showMessage "File will be over written"]
	
	tkwait window .messpop
	if {$ok == 0} {
		SaveFile
		} 
	} else {
		set openf $fileselect(selectedfile)
		set f [open $openf w]
		puts $f [.ed get 1.0 end]
		}
 


}

note that in this SaveAs procedure, the processing waits for the fileselectionbox to be popped down (destroyed). If no new filename is given, the warning message is showed and the contents of the editor are not written.

If the new filename is the same as the old one, then the warning that the file will be overwritten is displayed (and the file will be overwritten by a call to "Savefile").

If a new filename is given, the editor contents are written into this file.

	
proc CutSelection {} {

global seltxt

set seltxt [selection get STRING]

.ed delete insert "insert + [string length $seltxt] chars"
}

CutSelection is called when the user has made a selection (by pressing the left mouse button at the beginning of the selection to be cut and dragging the mouse pointer across the selection while holding the left mouse button down and releasing the button at the end of the selection). Note that this binding is the default in the Tk text widget.

The Tk command "selection get" takes a target as argument and retrieves the primary selection in the form specified by target. Target defaults to type "STRING". Tk supports only primary selection which means selection is owned in only one window on the screen.

Cutselection assigns the retrieved selected text to the global variable "seltxt" for subsequent paste operation.

The widget command ".ed" is invoked to carry out a "delete" operation of the characters between the position given by insert (point where the insertion cursor is) and a position computed insertion position and the number of characters in the primary selection.

Note that the enclosure in "" is substituted and evaluated.

proc PasteSelection {} {
global seltxt
.ed insert insert $seltxt

}


proc CopySelection {} {
global seltxt
set seltxt [selection get STRING]

}

Already explained.

proc FindWord {swit seltxt} {
global found
set l1 [string length $seltxt]
scan [.ed index end] %d nl
scan [.ed index insert] %d cl
if {[string compare $swit "-forwards"] == 0 } {
set curpos [.ed index "insert + $l1 chars"]

for {set i $cl} {$i < $nl} {incr i} {
		
	#.ed mark set first $i.0
	.ed mark set last  $i.end ;#another way "first lineend"
	set lpos [.ed index last]
	set curpos [.ed search $swit -exact $seltxt $curpos $lpos]
	if {$curpos != ""} {
		selection clear .ed 
		.ed mark set insert "$curpos + $l1 chars "
		.ed see $curpos
		set found 1
		break
		} else {
		set curpos $lpos
		set found 0
			}
	}
} else {
	set curpos [.ed index insert]
	set i $cl
	.ed mark set first $i.0
	while  {$i >= 1} {
		
		set fpos [.ed index first]
		set i [expr $i-1]
		
		set curpos [.ed search $swit -exact $seltxt $curpos $fpos]
		if {$curpos != ""} {
			selection clear .ed
			.ed mark set insert $curpos
			.ed see $curpos
			set found 1
			break
			} else {
				.ed mark set first $i.0
				.ed mark set last "first lineend"
				set curpos [.ed index last]
				set found 0
			}
		
	}
}
}

FindWord takes a switch (forward or backward and a string and searches for the string in the displayed string from the current position, searching one line at a time.

The above procedure is pretty rudimentary and the reader only need to learn the following Tcl/Tk specific commands, markers, utilities and notions.

In Tk text widget is a position specifier which returns a number of the form l.c where l is the integer that denotes the line number and c the character index in that line (e.g., 5.8 refers to 9th character in fifth line). You can also specify index @x,y which refers to the character closest to the pixel at position x,y in the window where x and y are integer values; index last refers to the last position in the line, first to first character in the line and index end point to end of the text.

The Tcl command scan is similar to scanf in C. It takes as argument a string and a format and parses the string and assigns the elements to variables according to that format. In this procedure scan is given the current cursor position from which the current line is extracted and assigned to "cl". similarly the number of the last line is retrived from indexing into ""end" which marks end of displayed text.

The Tk text widget action "search" takes a switch (forward or backward), an option (whether the search is exact or nocase), the string to search for and a serach range and returns the position if a match is found.

The primary selection is cleared in the selection buffer and it is no longer owned by the window when the call to "selection clear .ed" is made.

If a match is found, the cursor is moved to that position and that position is brought within the visible region of the text widget by a call to ".ed see" with current position as argument.

proc FindSelection {swit} {

global seltxt GotSelection
if {$GotSelection == 0} {
	set seltxt [selection get STRING]
	set GotSelection 1
	} 
FindWord $swit $seltxt
}

proc FindValue {} {

FindPopup
}

proc TagSelection {} {
global seltxt GotSelection
if {$GotSelection == 0} {
	set seltxt [selection get STRING]
	set GotSelection 1
	} 
TagAll 
}

proc ReplaceSelection {swit} {
global repltxt seltxt found
set l1 [string length $seltxt]
FindWord $swit $seltxt
if {$found == 1} {
	.ed delete insert "insert + $l1 chars"
	.ed insert insert $repltxt
	}
}

proc ReplaceAll {} {
global seltxt repltxt
set l1 [string length $seltxt]
set l2 [string length $repltxt]
scan [.ed index end] %d nl
set curpos [.ed index 1.0]
for {set i 1} {$i < $nl} {incr i} {
	.ed mark set last $i.end
	set lpos [.ed index last]
	set curpos [.ed search -forwards -exact $seltxt $curpos $lpos]
	
	if {$curpos != ""} {
		.ed mark set insert $curpos
		.ed delete insert "insert + $l1 chars"
		.ed insert insert $repltxt
		.ed mark set insert "insert + $l2 chars"
		set curpos [.ed index insert]
		} else {
			set curpos $lpos
			}
	}
}

All the above procedures essentially repeat all the Tk text widget specific commands and actions that have already been explained.