|
Server : Apache/2.4.62 System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64 User : www ( 80) PHP Version : 8.3.8 Disable Function : NONE Directory : /domains/mandarintools/cgi-bin/data/ |
Upload File : |
#!/usr/local/bin/wish8.1
if {[llength $argv] == 0} {
set filename "texts/dec14b.sgm"
} else {
set filename [lindex $argv 0]
}
wm title . $filename
set mytags(1LOCATION) "</ENAMEX>"
set mytags(0LOCATION) "<ENAMEX TYPE=\"LOCATION\">"
set mytags(1PERSON) "</ENAMEX>"
set mytags(0PERSON) "<ENAMEX TYPE=\"PERSON\">"
set mytags(1ORG) "</ENAMEX>"
set mytags(0ORG) "<ENAMEX TYPE=\"ORGANIZATION\">"
set mytags(1DATE) "</TIMEX>"
set mytags(0DATE) "<TIMEX TYPE=\"DATE\">"
set mytags(1TIME) "</TIMEX>"
set mytags(0TIME) "<TIMEX TYPE=\"TIME\">"
set mytags(1MONEY) "</NUMEX>"
set mytags(0MONEY) "<NUMEX TYPE=\"MONEY\">"
set mytags(1PERCENT) "</NUMEX>"
set mytags(0PERCENT) "<NUMEX TYPE=\"PERCENT\">"
scrollbar .yscroll -command { .txt yview } -orient vertical
text .txt -font {courier 16} -yscrollcommand {.yscroll set}
.txt tag configure tagged
.txt tag configure tagstart(LOCATION) -background orange
.txt tag configure tagbody(LOCATION) -background orange
.txt tag configure tagend(LOCATION) -background orange
.txt tag configure tagstart(PERSON) -background red
.txt tag configure tagbody(PERSON) -background red
.txt tag configure tagend(PERSON) -background red
.txt tag configure tagstart(ORG) -background gold
.txt tag configure tagbody(ORG) -background gold
.txt tag configure tagend(ORG) -background gold
.txt tag configure tagstart(DATE) -background purple
.txt tag configure tagbody(DATE) -background purple
.txt tag configure tagend(DATE) -background purple
.txt tag configure tagstart(TIME) -background blue
.txt tag configure tagbody(TIME) -background blue
.txt tag configure tagend(TIME) -background blue
.txt tag configure tagstart(MONEY) -background green
.txt tag configure tagbody(MONEY) -background green
.txt tag configure tagend(MONEY) -background green
.txt tag configure tagstart(PERCENT) -background brown
.txt tag configure tagbody(PERCENT) -background brown
.txt tag configure tagend(PERCENT) -background brown
proc addmuc { tagtype } {
global mytags
set tagrange [ .txt tag nextrange sel 1.0 ]
if {[string match $tagrange ""] == 1} {
return
}
set tagstart [lindex [split $tagrange { }] 0]
set tagend [lindex [split $tagrange { }] 1]
.txt tag add tagbody($tagtype) $tagstart $tagend
.txt tag add tagged $tagstart $tagend
.txt insert $tagend $mytags(1$tagtype) "tagend($tagtype) tagged"
.txt insert $tagstart $mytags(0$tagtype) "tagstart($tagtype) tagged"
.txt tag remove sel 1.0 end
}
proc delmuc {} {
set txttags [.txt tag names insert]
set tmpindex [.txt index insert]
set txttags [.txt tag names $tmpindex]
#Move the index to the beginning of the tag
if [string match *tagstart* $txttags] { ;# Click on start tag
while {[string match *tagstart* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
} elseif {[string match *tagbody* $txttags] == 1} { ;# Clicked on tag body
while {[string match *tagbody* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
while {[string match *tagstart* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
} elseif {[string match *tagend* $txttags] == 1} { ;# Clicked on tag end
while {[string match *tagend* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
while {[string match *tagbody* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
while {[string match *tagstart* $txttags] == 1 } {
if {[.txt compare "1.0" == $tmpindex]} { break }
set tmpindex [.txt index "$tmpindex -1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
} else { ;# didn't click on a tag, return
return
}
set ts0 [.txt index "$tmpindex +1 chars"]
set txttags [.txt tag names $ts0]
while {[string match *tagstart* $txttags] == 1 } {
set tmpindex [.txt index "$tmpindex +1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
set ts1 $tmpindex
set tb0 $tmpindex
while {[string match *tagbody* $txttags] == 1} {
set tmpindex [.txt index "$tmpindex +1 chars"]
regexp {(tagbody\([A-Z]*\))} $txttags tbtype
update
set txttags [.txt tag names $tmpindex]
}
set tb1 $tmpindex
set te0 $tmpindex
while {[string match *tagend* $txttags] == 1} {
set tmpindex [.txt index "$tmpindex +1 chars"]
update
set txttags [.txt tag names $tmpindex]
}
set te1 $tmpindex
.txt tag remove tagged $ts0 $te1
.txt tag remove $tbtype $tb0 $tb1
.txt delete $te0 $te1
.txt delete $ts0 $ts1
}
frame .types -width 120
button .types.loc -text "LOCATION" -bg "orange" -anchor w -command {addmuc LOCATION}
button .types.pers -text "PERSON" -bg "red" -anchor w -command {addmuc PERSON}
button .types.org -text "ORG" -bg "gold" -anchor w -command {addmuc ORG}
button .types.date -text "DATE" -bg "purple" -anchor w -command {addmuc DATE}
button .types.time -text "TIME" -bg "blue" -anchor w -command {addmuc TIME}
button .types.money -text "MONEY" -bg "green" -anchor w -command {addmuc MONEY}
button .types.perc -text "PERCENT" -bg "brown" -anchor w -command {addmuc PERCENT}
button .types.delete -text "Delete Tag" -anchor w -command {delmuc}
button .types.save -text "Save File" -command {save_file}
button .types.quit -text "Exit" -command { destroy . }
pack .types.loc .types.pers .types.org .types.date .types.time .types.money .types.perc .types.save \
.types.delete .types.quit -fill both -side top -expand 1
pack .types -side left -expand 1 -fill x
pack .txt -side left -expand 1 -fill both
pack .yscroll -side left -fill y
#bind .txt <ButtonRelease> { tagaction }
proc load_file {} {
global argv
global filename
global mytags
set fileId [open $filename r]
fconfigure $fileId -encoding "cp936"
while {[gets $fileId line] >= 0} {
.txt insert end $line
.txt insert end "\n"
}
close $fileId
foreach value {LOCATION ORG PERSON DATE TIME MONEY PERCENT} {
set ts0 [.txt search -count cnt $mytags(0$value) 1.0 end]
while {[string length $ts0] != 0} {
set ts1 [.txt index "$ts0 +$cnt chars"]
set te0 [.txt search -count cnt $mytags(1$value) $ts1 end]
set te1 [.txt index "$te0 +$cnt chars"]
.txt tag add tagged($value) $ts0 $te1
.txt tag add tagstart($value) $ts0 $ts1
.txt tag add tagbody($value) $ts1 $te0
.txt tag add tagend($value) $te0 $te1
set ts0 [.txt search -count cnt $mytags(0$value) $te1 end]
}
}
}
proc save_file {} {
global filename
if {[string match [file extension $filename] "sgm"] != 1} {
set filename [file rootname $filename].sgm
}
set fileId [open $filename w]
fconfigure $fileId -encoding "cp936"
puts $fileId [.txt get 1.0 end]
close $fileId
}
load_file