KGRKJGETMRETU895U-589TY5MIGM5JGB5SDFESFREWTGR54TY
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 :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : /domains/mandarintools/cgi-bin/data/tagger.tcl
#!/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

Anon7 - 2021