popup.tcl

很不错的tcl编程实例

# Copyright 1996


# Authors

# Lakshmi Sastry
# Computing and Information Systems Department
# Rutherford Appleton Laboratory, Chilton, Didcot. OX11 0QX
# [e-mail]

#                         and

# Venkat VSS Sastry
# Department of Applied Mathematics and Operational Research
# Cranfield University, RMCS Shrivenham, Swindon, SN6 8LA
# [e-mail]

# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.
  
# The authors, RAL, RMCS Shrivenham, Cranfield University and AGOCG
# make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty. Likewise they accept no responsibility
# whatsoever for any public domain software modules used (which are
# hereby acknowledged) in this software 



proc FindPopup {} {

	global seltxt repltxt

	toplevel .fpop -width 10c -height 4c

	grab .fpop
	wm title .fpop "Find Text"


	label .fpop.lab1 -text "Find :           " 
	place .fpop.lab1 -in .fpop -x 2 -y 6
	entry .fpop.en1 -width 20 -relief sunken -textvariable seltxt
	place .fpop.en1 -in .fpop -x 72  -y 6

	label .fpop.lab2 -text "Replace :        "
	place .fpop.lab2 -in .fpop -x 2 -y 50
	entry .fpop.en2 -width 20 -relief sunken -textvariable repltxt
	place .fpop.en2 -in .fpop -x 72 -y 50

	menubutton .fpop.finb -text Find -menu .fpop.finb.menu
	place .fpop.finb -in .fpop -x 2 -y 90
	menu .fpop.finb.menu 
	.fpop.finb.menu add command -label Forward -com {FindWord  -forwards $seltxt}
	.fpop.finb.menu add command -label Backward -com {FindWord -backwards $seltxt}

	menubutton .fpop.finrb -text "Find and Replace" -menu .fpop.finrb.menu
	place .fpop.finrb -in .fpop -x 38 -y 90
	menu .fpop.finrb.menu
	.fpop.finrb.menu add command -label Forward  -com {ReplaceSelection -forwards}
	.fpop.finrb.menu add command -label Backward -com {ReplaceSelection -backwards}

	button .fpop.repall -text "Replace All" -com {ReplaceAll}
	place .fpop.repall -in .fpop -x 150 -y 90

	button .fpop.tagall -text "Tag All" -com {TagAll}
	place .fpop.tagall -in .fpop -x 250 -y 36

	button .fpop.dismis -text Dismiss -com {destroy .fpop}
	place .fpop.dismis -in .fpop -x 250 -y 90

	#setkbd focus to entry widget 1

	focus .fpop.en1
}

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

proc TagAll {} {
	global seltxt 
	set l1 [string length $seltxt]
	scan [.ed index end] %d nl
	set curpos [.ed index insert]
	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
			scan [.ed index "insert + $l1 chars"] %f pos
			.ed tag add $seltxt $curpos $pos
			.ed tag configure $seltxt -background Bisque3
			.ed mark set insert "insert + $l1 chars"
			set curpos $pos
		} else {
			set curpos $lpos
		}
	}
}