Tcl/Tk 烹调书 - 文本编辑器

第 4 步: 建立回调

脚本

译者按：余修改了部分代码。

　

这些过程中的多数可以被添加到 ed.tcl 中。如果你希望可以建立一个独立的脚本文件 procs.tcl 并把的所有这些过程一起放置到这个文件中。如果你这样做了，记住使用 source 命令加载 ed.tcl。

set fileselect(selectedfile) {}
set oldname {}
set types {
	{{Text Files}       {.txt}        }
	{{TCL Scripts}      {.tcl}        }
	{{C Source Files}   {.c}      TEXT}
	{{GIF Files}        {.gif}        }
	{{GIF Files}        {}        GIFF}
	{{All Files}        *             }
} 

proc OpenFile {} {

	global fileselect oldname types

	set fileselect(selectedfile) [tk_getOpenFile -filetypes $types]
	if {$fileselect(selectedfile) == ""} {
		set fileselect(selectedfile) $oldname
		return
	}
	set openf $fileselect(selectedfile)
	set oldname $fileselect(selectedfile)

	.ed delete 1.0 end
	set fid [open $openf r]

	while {![eof $fid]} {
		.ed insert end [read $fid 1000]
	}
	close $fid
	.ed mark set insert 1.0
	
}

proc OpenFile {} {
global fileselect oldname

fileselect
tkwait window .fileSelectWindow
set oldname $fileselect(selectedfile)
set openf $fileselect(selectedfile)
.ed delete 1.0 end
set fid [open $openf r]

while {![eof $fid]} {
	.ed insert end [read $fid 1000]
	}
close $fid
.ed mark set insert 1.0

}

OpenFile 调用文件选择框，它允许用户浏览目录并选择一个文件。选择的文件被存储在全局数组 "fileselect" 中，与它相关联的索引的名字是 "selectedfile"。这个文件以只读权限打开。文本编辑器".ed"清除所有以前的内容并把当前文件的内容显示在".ed"中。关闭文件并且在文本窗口中的插入光标被放置在第一行的第一个字符上。

Tk 文本组件删除、插入和标记

回想 Tk 在建立文本组件".ed"时建立一个唯一的命令 ".ed"。特定于文本组件的动作可以使用这个命令来调用。

.ed delete 接受两个两字符的位置并删除在这两个位置之间的所有文本。特殊的字如"end"、 "lineend"，标记显示的文本的结束或给定行的结束。

命令 .ed mark set insert 1.0 设置一个叫 insert 的特殊的标记/注释(marker/annotation)，这里设置的插入点的位置在第一行的第一个字符开始处(注意 ".ed mark set pos 2.5" 将在第二行的第五个和第六个字符之间的间隙上设置一个叫 pos 的标记)。

回到过程

proc SaveFile {} {
	global fileselect oldname

	if {$fileselect(selectedfile) == "" } {
		tk_messageBox -message "No filename given" -type ok
		set fileselect(selectedfile) $oldname
		return 
	}
	set sts [catch {set f [open $fileselect(selectedfile) w]} \
		errormessage]
	if {$sts == 0} {
		puts $f [.ed get 1.0 end]
		close $f
		set oldname $fileselect(selectedfile)
	} else {
		tk_messageBox -message "can`t open file $fileselect(selectedfile)" -type ok
	}
	
 
}

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"]
		}
 
}

除了要打开一个选择的文件并有要写入许可(在这种情况下覆写它)之外，SaveFile 与 OpenFile 相类似。如果它因某种原因不能打开，则退出并贴出 "No file name is given" 消息。否则把文本组件的内容写入这个文件中。

proc SaveAsFile {} {
	global fileselect types
	
	set fileselect(selectedfile) [tk_getSaveFile -filetypes $types]
	SaveFile
}

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]
		}
 


}

注意在这个 SaveAs 过程中，等待文件选择框弹回(popped down)(被销毁)之后继续处理。如果没有给出新的文件名，显示一个警告消息而且不写下编辑器的当前内容。

如果新文件名与老文件名相同，则显示文件将被覆写的警告(并且通过调用"Savefile"来覆写文件)。

如果给出一个新文件名，编辑器的内容将写入其中。

	
proc CutSelection {} {

global seltxt

set seltxt [selection get STRING]

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

在用户已经做了一个选择的时候调用 CutSelection。(通过在要被剪切的选择(区域)的开始处按下鼠标左键并保持鼠标左键按下，拖动鼠标指针跨越选择(区域)，在选择(区域)的结束处释放按键来做选择)。注意在 Tk 文本组件中这个(选择)绑定是缺省的。

Tk 命令 "selection get" 接受一个目标作为参数并用由 target 指定的形式检索 primary 选择。目标缺省是类型 "STRING"。Tk 只支持 primary 选择，这种选择意味着选择只由在屏幕上的一个窗口拥有。 

    

译者按：Tk 3.6 和更早的版本只支持 PRIMARY 选择，在 Tk 4.0 增加了对 CLIPBOARD (剪贴板)的支持。

Cutselection 把检索到的选择的文本赋予全局变量"seltxt"用于随后的粘贴操作。

调用组件命令 ".ed"来对在由 insert 给出的位置(插入光标所在的那点)和用插入点和在 primary  选择中的字符数计算出来的位置之间的字符进行一次 "delete"操作。

注意用""围起来的部分要被替换和求值。

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

}


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

}

前面已经解释了。

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 接受一个开关(forward 或 backward )和一个字符串，它从当前位置开始在显示的字符串中查找这个字符串，一次查找一行。

　

索引，检索，查找，选择清除和查看

上面的过程是非常初步的而且读者只需要学习下列特定 Tcl/Tk 的命令、标记(marker)，实用工具和记号(notion)。

在 Tk 文本组件中有一个位置指定器(specifier), 它返回 l.c 形式的一个数字，这里的 l 是表示 (denote)行号的整数而 c 是在此行中的字符索引(例如，5.8 参照第五行的第9个字符)。你也可以指定 index @x,y ，它参照在窗口中紧靠着位置 x,y 上的象素的那个字符，这里的 x 和 y 是整数值；索引 last 参照在此行中的最后的位置， first 参照在此行中的第一个字符而索引 end 指示文本的结束。

Tcl 命令 scan 类似于 C 语言的 scanf。它接受一个字符串和一个格式作为参数，它分析这个字符串并把元素赋给相应这个格式的变量。在这个过程中，把当前光标的位置给 scan ，用它提取当前行号并赋给 "cl"。类似的最后的一行的行号被从索引中检索出来并赋给标记显示的文本结束的"end"。 

Tk 文本组件的动作 "search" 接受一个开关(forward 或 backward)，一个选项(查找是精确的还是不区分大小写的)，要查找的字符串和一个查找范围并返回找到的一个匹配的位置。

当调用"selection clear .ed"的时候在选择缓冲中清除这个 primary 选择并且它将不在归这个窗口所有。

如果找到一个匹配，把光标移动到这个位置上并且通过用当前位置作为参数调用".ed see"来这个位置被带到文本组件的可见区域之内。

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
			}
	}
}

所有上述过程基本上重复了上面解释过的特定于 Tk 文本组件的命令和动作。