FAQ | This is a LIVE service | Changelog

Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • ssb22/gradint
  • st822/gradint
2 results
Show changes
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 448 additions and 7915 deletions
charlearn/charlearn.py 0 → 100755
View file @ 10a6ad67
#!/usr/bin/env python
# (should work in either Python 2 or Python 3)
# Character-learning support program
# (C) 2006-2013, 2020 Silas S. Brown. Version 0.3.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# Where to find history:
# on GitHub at https://github.com/ssb22/gradint
# and on GitLab at https://gitlab.com/ssb22/gradint
# and on BitBucket https://bitbucket.org/ssb22/gradint
# and at https://gitlab.developers.cam.ac.uk/ssb22/gradint
# and in China: https://gitee.com/ssb22/gradint
listenAddr='127.0.0.1'
firstPortNo=9876
tableFile = "characters.txt" # for first-time setup
knownFile = "known-chars.txt" # ditto
dumpFile = "charlearn-data" # for saving progress
reviseFile = "revise.txt" # for requesting more revision next time (will be deleted after integration into progress)
import sys,os.path
if sys.argv[-1].startswith("--"): gradint = None # (don't need to speak if we're processing options, see at end)
elif os.path.isfile("gradint.py"): import gradint
else: gradint = None # won't speak characters
import random,os,time,socket
try: from subprocess import getoutput
except: from commands import getoutput
try: from cPickle import Pickler,Unpickler
except: from pickle import Pickler,Unpickler
try: from BaseHTTPServer import BaseHTTPRequestHandler, HTTPServer
except: from http.server import BaseHTTPRequestHandler, HTTPServer
try: import thread
except: import _thread as thread
def byPriority(a): return a.priority
priorityIfGotWrong = -10
priorityOfOtherCharWrong = -4
priorityOfGroupWrong = 0
maxShowInGroup = 5 ; priorityBreakGroup = 10
initSessionLen = sessionLen = 2 ; maxSessionLen = 10 ; sampleConst = 1.5
def updateSessionLen():
global sessionLen
sessionLen = min(max(sessionLen,int(thechars.countKnown()[1]+0.95)),maxSessionLen)
# did have /sampleConst after countKnown()[1] but doesn't seem necessary
already_spoken = {}
gradint_busy = 0
def speak_bkg():
gradint.just_synthesize()
global gradint_busy
gradint_busy = 0
class SingleChar:
def __init__(self,hanzi,pinyin):
self.hanzi = hanzi ; self.pinyin = pinyin
self.priority = 0 ; self.similarityGroup = None
self.supposedToKnow = 0
def formatPinyin(self): return self.pinyin.replace("\n","<BR>") # (could make it into actual tone marks also)
def htmlString(self,parent,step=1,left=0):
self.supposedToKnow = 1
r=u'<html><head><title>hanzi</title><meta http-equiv="Content-Type" content="text/html; charset=%s"></head><body><h1>%s</h1>' % (parent.charset,self.hanzi)
if step==1: r+=self.yesno('Do you know what this is? (%d remaining)' % left,2,0)
else:
r += self.formatPinyin() + "<HR>"
if step<=0:
if self.similarityGroup:
l = []
for c in parent.chars:
if c.similarityGroup == self.similarityGroup and not id(c)==id(self): l.append(c)
l.sort(key=byPriority)
r+="Not to be confused with:"
for c in l[:maxShowInGroup-1]: r+='<h1>%s</h1>%s' % (c.hanzi,c.formatPinyin())
r += '<hr>'
if parent.thisSession:
r+='<A HREF="/%s">Next character</A>' % str(random.random())
if step==-1:
# got it right - might as well take that link automatically
r=parent.processRequest("/").decode(parent.charset).replace('</body></html>','')
else:
updateSessionLen()
r+='<A HREF="/quit">Quit</A> | <A HREF="/%s">Another %d</A>' % (str(random.random()),sessionLen)
if step==0:
self.priority=priorityIfGotWrong
self.speak(parent.charset)
else:
# knew it
self.priority += 1
if self.priority > 0:
if self.priority < 25000: self.priority *= 2 # give new characters a chance
else: self.priority = 50000 # level off
else: self.priority /= 2 # TRY this for a while - will make chars got-wrong recover more quickly (again to give new chars a chance)
parent.save()
elif step==2:
r+=self.yesno('Did you get it right?',-1,3)
self.speak(parent.charset)
elif step==3:
r+='What did you think it was?<P>'
toOut = [] # (pinyin,hanzi,id,is-in-same-group)
for c in parent.chars:
if c.similarityGroup and c.similarityGroup==self.similarityGroup: sameGrp=True
else: sameGrp=False # need to do it this way because Python sometimes returns 'None' from that expression
if c.supposedToKnow and not id(c)==id(self): toOut.append((c.pinyin,c.hanzi,id(c),sameGrp)) # NOT formatPinyin, because may want to i-search it
toOut.sort()
if len(toOut) > 20: r+="(Hint: On some browsers you can use find-as-you-type)<P>"
for outSameGroup in [True,False]:
oldL=len(r)
for p,hanzi,val,sameGrp in toOut:
if sameGrp==outSameGroup: r+='%s <A HREF="/%d_%d">%s</A><BR>' % (hanzi,id(self),val,p)
if len(r)>oldL and outSameGroup: r += '<HR>' # between chars in same group and others
r+='<A HREF="/%d=0">None of the above</A>' % id(self)
if not parent.thisSession:
global already_spoken ; already_spoken = {} # reset it so "Another N" does speak them
return r + '</body></html>'
def speak(self,charset):
if self.hanzi in already_spoken: return
already_spoken[self.hanzi] = 1 # don't set a self. attribute - it'll get pickled for next session
if gradint:
gradint.justSynthesize = self.hanzi.decode(charset).encode('utf-8')
global gradint_busy
while gradint_busy: time.sleep(0.5)
gradint_busy = 1
thread.start_new_thread(speak_bkg,())
def yesno(self,question,ifyes,ifno): return question+'<P><A ID="y" HREF="/%d=%d">Yes</A><SCRIPT>document.getElementById("y").focus()</SCRIPT> | <A HREF="/%d=%d">No</A>' % (id(self),ifyes,id(self),ifno) # (don't use the js anywhere except yes/no, because 'next character' etc may have too much on the screen and we don't want the focus() to scroll)
the_speaker_process = None
def terminate_server():
# portable signal.alarm(1)
time.sleep(1); os.abort()
def B(s):
if type(u"")==type(""): return s.encode('utf-8')
else: return s
def S(s):
if type(u"")==type("") and not type(s)==type(""): return s.decode('utf-8')
else: return s
class CharDbase:
def __init__(self):
self.counter = 0 ; self.nextPriority = 0
self.similarityGroups = 0
self.chars = [] ; self.thisSession = []
self.readTable() ; self.readKnown() ; self.readRevise()
def debug_printKnown(self):
print ("-*- coding: %s -*-" % (self.charset,))
for c in self.chars:
if c.supposedToKnow: print ("%s %s" % (c.priority,c.hanzi))
def readTable(self):
addingTo = 0
if self.chars: addingTo = 1
lines=open(tableFile,'rb').readlines()
if lines[0].startswith(B("charset:")):
self.charset = S(lines[0].split()[-1])
lines = lines[1:]
else: self.charset = "iso-8859-1"
for line in lines: self.addCharFromFreqTable(line.decode(self.charset),addingTo)
def readKnown(self):
try:
o=open(knownFile)
except IOError: return
for line in o.readlines(): self.makeCharKnown(line.split()[0])
def readRevise(self):
try:
o=open(reviseFile)
except IOError: return
for line in o.readlines(): self.makeCharRevise(line.split()[0])
def makeCharKnown(self,hanzi):
if not hanzi: return # blank lines etc
for c in self.chars:
if c.hanzi==hanzi:
if not c.supposedToKnow:
c.supposedToKnow = 1
c.priority = priorityOfGroupWrong # just to check
return
print ("WARNING: character '%s' in %s was not in %s - ignoring" % (repr(hanzi),knownFile,tableFile))
def makeCharRevise(self,hanzi):
if not hanzi: return # blank lines etc
for c in self.chars:
if c.hanzi==hanzi:
c.supposedToKnow = 1
c.priority = priorityIfGotWrong
return
print ("WARNING: character '%s' in %s was not in %s - ignoring" % (repr(hanzi),reviseFile,tableFile))
def addCharFromFreqTable(self,line,checkAlreadyThere):
hanzi,pinyin = line.split(None,1)
c=SingleChar(hanzi,pinyin.replace("\\n","\n"))
c.priority = self.nextPriority ; self.nextPriority += 1
if checkAlreadyThere:
for c2 in self.chars:
if c2.hanzi == hanzi: return
self.chars.append(c)
def charIdToChar(self,charId):
char = None
for c in self.chars:
if id(c)==charId:
char = c ; break
assert char ; return char
def processRequest(self,path):
if '=' in path:
charId,step = map(lambda x:int(x),path[1:].split('='))
char = self.charIdToChar(charId)
elif '_' in path: # grouping
char,char2 = map(lambda x:self.charIdToChar(int(x)),path[1:].split('_'))
if not char.similarityGroup and not char2.similarityGroup: # new group:
self.similarityGroups += 1
char.similarityGroup = char2.similarityGroup = self.similarityGroups
elif not char.similarityGroup: char.similarityGroup = char2.similarityGroup
elif not char2.similarityGroup: char2.similarityGroup = char.similarityGroup
elif not char.similarityGroup == char2.similarityGroup: # merge 2 different groups:
for c in self.chars:
if c.similarityGroup == char2.similarityGroup: c.similarityGroup = char.similarityGroup
step = 0 # normal got-wrong for this character
char.priority = priorityIfGotWrong # here also, for the loop below
char2.priority = min(char2.priority,priorityOfOtherCharWrong)
for c in self.chars:
if c.similarityGroup == char.similarityGroup:
if c.priority >= priorityBreakGroup: c.similarityGroup=None
elif c.priority > priorityOfGroupWrong: c.priority = priorityOfGroupWrong
elif path=="/status":
self.chars.sort(key=byPriority)
cp=self.chars[:] ; r='<html><head><title>Current Status</title><meta http-equiv="Content-Type" content="text/html; charset=%s"></head><body><h2>Current Status</h2>(score/priority number is shown to the left of each item)<br>' % (self.charset,)
while cp:
if not cp[0].supposedToKnow:
del cp[0] ; continue
if cp[0].priority >= priorityBreakGroup: thisGrp=[0]
else: thisGrp=list(filter(lambda x:x==0 or (cp[x].similarityGroup and cp[x].similarityGroup==cp[0].similarityGroup and cp[x].priority < priorityBreakGroup),range(len(cp))))
if len(thisGrp)>1 and not r.endswith("<hr>"): r+="<hr>"
if len(thisGrp)>1: r+="<em>"+str(len(thisGrp))+" similar items:</em><br>"
for g in thisGrp: r += str(cp[g].priority)+": "+cp[g].hanzi+" "+cp[g].pinyin+"<br>"
if len(thisGrp)>1: r+="<hr>"
thisGrp.reverse()
for toDel in thisGrp: del cp[toDel]
return (r+"</body></html>").encode(self.charset)
else:
if path=="/checkallknown": self.thisSession = list(filter(lambda x:x.supposedToKnow,self.chars)) # TODO: Document this URL
char,step = self.chooseChar(),1
return char.htmlString(self,step,len(self.thisSession)).encode(self.charset)
def chooseChar(self):
if not self.thisSession:
self.chars.sort(key=byPriority)
if sessionLen==initSessionLen:
self.thisSession = self.chars[:sessionLen] # introduce in order the first time (especially if the second one is just a straight line ("yi1"), as one beginner thought the program had gone wrong when he saw this)
self.thisSession.reverse() # because taken out by pop()
else: self.thisSession = random.sample(self.chars[:int(sessionLen*sampleConst)],sessionLen) # TODO need a better way than that. NB high priority should be VERY likely, but others should have a chance. try as-is for now
return self.thisSession.pop()
def save(self): Pickler(open(dumpFile,"wb"),-1).dump(self)
def countKnown(self):
charsSeen = sessnLen = charsSecure = newChars = 0
secure=[] ; insecure=[]
self.chars.sort(key=byPriority)
for c in self.chars:
if c.supposedToKnow:
charsSeen += 1
if c.priority>0: secure.append(c.hanzi)
else: insecure.append(c.hanzi)
else: newChars += 1
if newChars == 2: sessnLen = charsSeen
return charsSeen,sessnLen,secure,insecure
try:
dumped = open(dumpFile,"rb")
except IOError: dumped = None
if dumped:
thechars = Unpickler(dumped).load()
dumped.close()
thechars.thisSession = []
if os.stat(tableFile).st_mtime > os.stat(dumpFile).st_mtime: thechars.readTable()
try:
if os.stat(knownFile).st_mtime > os.stat(dumpFile).st_mtime: thechars.readKnown()
except OSError: pass
try:
if os.stat(reviseFile).st_mtime > os.stat(dumpFile).st_mtime: thechars.readRevise()
except OSError: pass
updateSessionLen()
else:
thechars=CharDbase()
class RequestHandler(BaseHTTPRequestHandler):
def do_GET(self):
if self.path.startswith("/fav"):
self.send_response(404) ; self.end_headers() ; return
self.send_response(200)
self.send_header("Content-type","text/html; charset="+thechars.charset)
self.end_headers()
if self.path.startswith("/quit"):
r=thechars.processRequest("/status").decode(thechars.charset)
r=r[:r.index("<body>")+6]+"Server terminating."+r[r.index("<body>")+6:]
self.wfile.write(r.encode(thechars.charset))
thread.start_new_thread(terminate_server,()) # can terminate the server after this request
else: self.wfile.write(thechars.processRequest(self.path))
self.wfile.close() # needed or will wait for bkg speaking processes etc
def do_session():
portNo = firstPortNo ; server = None
while portNo < firstPortNo+100:
try:
server = HTTPServer((listenAddr,portNo),RequestHandler)
break
except socket.error: portNo += 1
assert server, "Couldn't find a port to run the server on"
if ("win" not in sys.platform) and getoutput("which x-www-browser 2>/dev/null"): # (try to find x-www-browser, but not on windows/cygwin/darwin)
os.system("x-www-browser http://localhost:%d/%s &" % (portNo,str(random.random()))) # shouldn't need a sleep as should take a while to start anyway
else:
try:
import webbrowser
webbrowser.open_new("http://localhost:%d/%s" % (portNo,str(random.random())))
except ImportError: pass # fall through to command-line message
# Do this as well, in case that command failed:
print ("") ; print ("") ; print ("")
print ("Server running. If a web browser does not appear automatically,")
print ("please start one yourself and go to")
print ("http://localhost:%d/%d" % (portNo,random.randint(1,99999)))
print ("") ; print ("") ; print ("")
server.serve_forever()
if sys.argv[-1]=='--count':
x,y,sec,insec=thechars.countKnown()
print ("%d (of which %d seem secure)" % (x,len(sec)))
elif sys.argv[-1]=='--show-secure':
x,y,sec,insec=thechars.countKnown()
print (" ".join(sec))
elif sys.argv[-1]=='--show-wfx':
# the result of this might need charset conversion
# (and the conversion of charlearn scores to Wenlin histories is only approximate)
print ("""<?xml version='1.0'?>
<!-- Wenlin Flashcard XML file -->
<stack owner='Anonymous' reward='points'>""")
thechars.chars.sort(key=byPriority)
for c in thechars.chars:
print ("<card type='d'><question>"+c.hanzi+"</question>")
trials = "" ; score = 0
if c.supposedToKnow:
if c.priority < 0:
trials += "n"
p = priorityIfGotWrong
while p < c.priority:
trials += "y" ; score += 1
p /= 2
p = 1
while p < c.priority:
trials += "y" ; score += 1
p *= 2
print ("<history score='%d' trials='%d' recent='%s'></history></card>" % (score,len(trials),trials))
print ("</stack>")
else: do_session()
charlearn/jp/characters.txt 0 → 100644
View file @ 10a6ad67
charset: euc-jp
あ a
い i
う u
え e
お o
か ka
き ki
く ku
け ke
こ ko
さ sa
し shi
す su
せ se
そ so
た ta
ち chi
つ tsu
て te
と to
な na
に ni
ぬ nu
ね ne
の no
は ha
ひ hi
ふ fu
へ he
ほ ho
ま ma
み mi
む mu
め me
も mo
や ya
ゆ yu
よ yo
ら ra
り ri
る ru
れ re
ろ ro
わ wa
を wo
ん n
ア a
イ i
ウ u
エ e
オ o
カ ka
キ ki
ク ku
ケ ke
コ ko
サ sa
シ shi
ス su
セ se
ソ so
タ ta
チ chi
ツ tsu
テ te
ト to
ナ na
ニ ni
ヌ nu
ネ ne
ノ no
ハ ha
ヒ hi
フ fu
ヘ he
ホ ho
マ ma
ミ mi
ム mu
メ me
モ mo
ヤ ya
ユ yu
ヨ yo
ラ ra
リ ri
ル ru
レ re
ロ ro
ワ wa
ヲ wo
ン n
gradint-build/INSTALL.txt deleted 100644 → 0
View file @ 14df51ec
Installing Gradint on Linux systems
-----------------------------------
Gradint does not need to be installed, it can
just run from the current directory.
If you do want to make a system-wide installation
(for example if you want to make a package for a
Linux distribution), I suggest doing the following
as root:
mkdir /usr/share/gradint
cp gradint.py /usr/share/gradint/
cd samples/utils
for F in *.py *.sh; do
export DestFile=/usr/bin/gradint-$(echo $F|sed -e 's/\..*//')
cp $F $DestFile
chmod +x $DestFile
done
cd ../.. ; rm -rf samples/utils
tar -zcf /usr/share/gradint/new-user.tgz \
advanced.txt settings.txt vocab.txt samples
cat > /usr/bin/gradint <<EOF
#!/bin/bash
if ! test -e "$HOME/gradint"; then
echo "You will need some prompts and samples in your home directory."
echo "Is it OK to unpack an example into $HOME/gradint ?"
echo "Ctrl-C to quit or Enter to continue"
read
echo -n "Unpacking... "
mkdir "$HOME/gradint"
cd "$HOME/gradint"
tar -zxf /usr/share/gradint/new-user.tgz
echo "done."
echo "Please check the contents of $HOME/gradint"
echo "especially the README files."
echo "Then you can run gradint again."
exit
fi
cd "$HOME/gradint"
python /usr/share/gradint/gradint.py $@
EOF
chmod +x /usr/bin/gradint
For a distribution you might also have to write
man pages and tidy up the help text etc.
Depends: python + a sound player (e.g. alsa-utils)
Recommends: python-tk python-tksnack sox libsox-fmt-all madplay
gradint-build/PocketPC/Program Files/lib/tcl8.4/auto.tcl deleted 100644 → 0
View file @ 14df51ec
# auto.tcl --
#
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
# RCS: @(#) $Id: auto.tcl,v 1.12 2002/10/28 16:34:25 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# auto_reset --
#
# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any procedures that are listed in the auto-load index
# except those defined in this file.
#
# Arguments:
# None.
proc auto_reset {} {
global auto_execs auto_index auto_oldpath
foreach p [info procs] {
if {[info exists auto_index($p)] && ![string match auto_* $p]
&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
tcl_findLibrary pkg_compareExtension
tclPkgUnknown tcl::MacOSXPkgUnknown
tcl::MacPkgUnknown} $p] < 0)} {
rename $p {}
}
}
catch {unset auto_execs}
catch {unset auto_index}
catch {unset auto_oldpath}
}
# tcl_findLibrary --
#
# This is a utility for extensions that searches for a library directory
# using a canonical searching algorithm. A side effect is to source
# the initialization script and set a global library variable.
#
# Arguments:
# basename Prefix of the directory name, (e.g., "tk")
# version Version number of the package, (e.g., "8.0")
# patch Patchlevel of the package, (e.g., "8.0.3")
# initScript Initialization script to source (e.g., tk.tcl)
# enVarName environment variable to honor (e.g., TK_LIBRARY)
# varName Global variable to set when done (e.g., tk_library)
proc tcl_findLibrary {basename version patch initScript enVarName varName} {
upvar #0 $varName the_library
global env errorInfo
set dirs {}
set errors {}
# The C application may have hardwired a path, which we honor
set variableSet [info exists the_library]
if {$variableSet && [string compare $the_library {}]} {
lappend dirs $the_library
} else {
# Do the canonical search
# 1. From an environment variable, if it exists
if {[info exists env($enVarName)]} {
lappend dirs $env($enVarName)
}
# 2. Relative to the Tcl library
lappend dirs [file join [file dirname [info library]] \
$basename$version]
# 3. Various locations relative to the executable
# ../lib/foo1.0 (From bin directory in install hierarchy)
# ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
# ../library (From unix directory in build hierarchy)
# ../../library (From unix/arch directory in build hierarchy)
# ../../foo1.0.1/library
# (From unix directory in parallel build hierarchy)
# ../../../foo1.0.1/library
# (From unix/arch directory in parallel build hierarchy)
set parentDir [file dirname [file dirname [info nameofexecutable]]]
set grandParentDir [file dirname $parentDir]
lappend dirs [file join $parentDir lib $basename$version]
lappend dirs [file join $grandParentDir lib $basename$version]
lappend dirs [file join $parentDir library]
lappend dirs [file join $grandParentDir library]
lappend dirs [file join $grandParentDir $basename$patch library]
lappend dirs [file join [file dirname $grandParentDir] \
$basename$patch library]
# 4. On MacOSX, check the directories in the tcl_pkgPath
if {[string equal $::tcl_platform(platform) "unix"] && \
[string equal $::tcl_platform(os) "Darwin"]} {
foreach d $::tcl_pkgPath {
lappend dirs [file join $d $basename$version]
lappend dirs [file join $d $basename$version Resources Scripts]
}
}
}
foreach i $dirs {
set the_library $i
set file [file join $i $initScript]
# source everything when in a safe interpreter because
# we have a source command, but no file exists command
if {[interp issafe] || [file exists $file]} {
if {![catch {uplevel #0 [list source $file]} msg]} {
return
} else {
append errors "$file: $msg\n$errorInfo\n"
}
}
}
if {!$variableSet} {
unset the_library
}
set msg "Can't find a usable $initScript in the following directories: \n"
append msg " $dirs\n\n"
append msg "$errors\n\n"
append msg "This probably means that $basename wasn't installed properly.\n"
error $msg
}
# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
# The following procedures are used to generate the tclIndex file
# from Tcl source files. They use a special safe interpreter to
# parse Tcl source files, writing out index entries as "proc"
# commands are encountered. This implementation won't work in a
# safe interpreter, since a safe interpreter can't create the
# special parser and mess with its commands.
if {[interp issafe]} {
return ;# Stop sourcing the file here
}
# auto_mkindex --
# Regenerate a tclIndex file from Tcl source files. Takes as argument
# the name of the directory in which the tclIndex file is to be placed,
# followed by any number of glob patterns to use in that directory to
# locate all of the relevant files.
#
# Arguments:
# dir - Name of the directory in which to create an index.
# args - Any number of additional arguments giving the
# names of files within dir. If no additional
# are given auto_mkindex will look for *.tcl.
proc auto_mkindex {dir args} {
global errorCode errorInfo
if {[interp issafe]} {
error "can't generate index within safe interpreter"
}
set oldDir [pwd]
cd $dir
set dir [pwd]
append index "# Tcl autoload index file, version 2.0\n"
append index "# This file is generated by the \"auto_mkindex\" command\n"
append index "# and sourced to set up indexing information for one or\n"
append index "# more commands. Typically each line is a command that\n"
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
if {$args == ""} {
set args *.tcl
}
auto_mkindex_parser::init
foreach file [eval glob $args] {
if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
append index $msg
} else {
set code $errorCode
set info $errorInfo
cd $oldDir
error $msg $info $code
}
}
auto_mkindex_parser::cleanup
set fid [open "tclIndex" w]
puts -nonewline $fid $index
close $fid
cd $oldDir
}
# Original version of auto_mkindex that just searches the source
# code for "proc" at the beginning of the line.
proc auto_mkindex_old {dir args} {
global errorCode errorInfo
set oldDir [pwd]
cd $dir
set dir [pwd]
append index "# Tcl autoload index file, version 2.0\n"
append index "# This file is generated by the \"auto_mkindex\" command\n"
append index "# and sourced to set up indexing information for one or\n"
append index "# more commands. Typically each line is a command that\n"
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
if {[string equal $args ""]} {
set args *.tcl
}
foreach file [eval glob $args] {
set f ""
set error [catch {
set f [open $file]
while {[gets $f line] >= 0} {
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
set procName [lindex [auto_qualify $procName "::"] 0]
append index "set [list auto_index($procName)]"
append index " \[list source \[file join \$dir [list $file]\]\]\n"
}
}
close $f
} msg]
if {$error} {
set code $errorCode
set info $errorInfo
catch {close $f}
cd $oldDir
error $msg $info $code
}
}
set f ""
set error [catch {
set f [open tclIndex w]
puts -nonewline $f $index
close $f
cd $oldDir
} msg]
if {$error} {
set code $errorCode
set info $errorInfo
catch {close $f}
cd $oldDir
error $msg $info $code
}
}
# Create a safe interpreter that can be used to parse Tcl source files
# generate a tclIndex file for autoloading. This interp contains
# commands for things that need index entries. Each time a command
# is executed, it writes an entry out to the index file.
namespace eval auto_mkindex_parser {
variable parser "" ;# parser used to build index
variable index "" ;# maintains index as it is built
variable scriptFile "" ;# name of file being processed
variable contextStack "" ;# stack of namespace scopes
variable imports "" ;# keeps track of all imported cmds
variable initCommands "" ;# list of commands that create aliases
proc init {} {
variable parser
variable initCommands
if {![interp issafe]} {
set parser [interp create -safe]
$parser hide info
$parser hide rename
$parser hide proc
$parser hide namespace
$parser hide eval
$parser hide puts
$parser invokehidden namespace delete ::
$parser invokehidden proc unknown {args} {}
# We'll need access to the "namespace" command within the
# interp. Put it back, but move it out of the way.
$parser expose namespace
$parser invokehidden rename namespace _%@namespace
$parser expose eval
$parser invokehidden rename eval _%@eval
# Install all the registered psuedo-command implementations
foreach cmd $initCommands {
eval $cmd
}
}
}
proc cleanup {} {
variable parser
interp delete $parser
unset parser
}
}
# auto_mkindex_parser::mkindex --
#
# Used by the "auto_mkindex" command to create a "tclIndex" file for
# the given Tcl source file. Executes the commands in the file, and
# handles things like the "proc" command by adding an entry for the
# index file. Returns a string that represents the index file.
#
# Arguments:
# file Name of Tcl source file to be indexed.
proc auto_mkindex_parser::mkindex {file} {
variable parser
variable index
variable scriptFile
variable contextStack
variable imports
set scriptFile $file
set fid [open $file]
set contents [read $fid]
close $fid
# There is one problem with sourcing files into the safe
# interpreter: references like "$x" will fail since code is not
# really being executed and variables do not really exist.
# To avoid this, we replace all $ with \0 (literally, the null char)
# later, when getting proc names we will have to reverse this replacement,
# in case there were any $ in the proc name. This will cause a problem
# if somebody actually tries to have a \0 in their proc name. Too bad
# for them.
regsub -all {\$} $contents "\0" contents
set index ""
set contextStack ""
set imports ""
$parser eval $contents
foreach name $imports {
catch {$parser eval [list _%@namespace forget $name]}
}
return $index
}
# auto_mkindex_parser::hook command
#
# Registers a Tcl command to evaluate when initializing the
# slave interpreter used by the mkindex parser.
# The command is evaluated in the master interpreter, and can
# use the variable auto_mkindex_parser::parser to get to the slave
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
lappend initCommands $cmd
}
# auto_mkindex_parser::slavehook command
#
# Registers a Tcl command to evaluate when initializing the
# slave interpreter used by the mkindex parser.
# The command is evaluated in the slave interpreter.
proc auto_mkindex_parser::slavehook {cmd} {
variable initCommands
# The $parser variable is defined to be the name of the
# slave interpreter when this command is used later.
lappend initCommands "\$parser eval [list $cmd]"
}
# auto_mkindex_parser::command --
#
# Registers a new command with the "auto_mkindex_parser" interpreter
# that parses Tcl files. These commands are fake versions of things
# like the "proc" command. When you execute them, they simply write
# out an entry to a "tclIndex" file for auto-loading.
#
# This procedure allows extensions to register their own commands
# with the auto_mkindex facility. For example, a package like
# [incr Tcl] might register a "class" command so that class definitions
# could be added to a "tclIndex" file for auto-loading.
#
# Arguments:
# name Name of command recognized in Tcl files.
# arglist Argument list for command.
# body Implementation of command to handle indexing.
proc auto_mkindex_parser::command {name arglist body} {
hook [list auto_mkindex_parser::commandInit $name $arglist $body]
}
# auto_mkindex_parser::commandInit --
#
# This does the actual work set up by auto_mkindex_parser::command
# This is called when the interpreter used by the parser is created.
#
# Arguments:
# name Name of command recognized in Tcl files.
# arglist Argument list for command.
# body Implementation of command to handle indexing.
proc auto_mkindex_parser::commandInit {name arglist body} {
variable parser
set ns [namespace qualifiers $name]
set tail [namespace tail $name]
if {[string equal $ns ""]} {
set fakeName "[namespace current]::_%@fake_$tail"
} else {
set fakeName "_%@fake_$name"
regsub -all {::} $fakeName "_" fakeName
set fakeName "[namespace current]::$fakeName"
}
proc $fakeName $arglist $body
# YUK! Tcl won't let us alias fully qualified command names,
# so we can't handle names like "::itcl::class". Instead,
# we have to build procs with the fully qualified names, and
# have the procs point to the aliases.
if {[regexp {::} $name]} {
set exportCmd [list _%@namespace export [namespace tail $name]]
$parser eval [list _%@namespace eval $ns $exportCmd]
# The following proc definition does not work if you
# want to tolerate space or something else diabolical
# in the procedure name, (i.e., space in $alias)
# The following does not work:
# "_%@eval {$alias} \$args"
# because $alias gets concat'ed to $args.
# The following does not work because $cmd is somehow undefined
# "set cmd {$alias} \; _%@eval {\$cmd} \$args"
# A gold star to someone that can make test
# autoMkindex-3.3 work properly
set alias [namespace tail $fakeName]
$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
$parser alias $alias $fakeName
} else {
$parser alias $name $fakeName
}
return
}
# auto_mkindex_parser::fullname --
# Used by commands like "proc" within the auto_mkindex parser.
# Returns the qualified namespace name for the "name" argument.
# If the "name" does not start with "::", elements are added from
# the current namespace stack to produce a qualified name. Then,
# the name is examined to see whether or not it should really be
# qualified. If the name has more than the leading "::", it is
# returned as a fully qualified name. Otherwise, it is returned
# as a simple name. That way, the Tcl autoloader will recognize
# it properly.
#
# Arguments:
# name - Name that is being added to index.
proc auto_mkindex_parser::fullname {name} {
variable contextStack
if {![string match ::* $name]} {
foreach ns $contextStack {
set name "${ns}::$name"
if {[string match ::* $name]} {
break
}
}
}
if {[string equal [namespace qualifiers $name] ""]} {
set name [namespace tail $name]
} elseif {![string match ::* $name]} {
set name "::$name"
}
# Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
# that replacement.
regsub -all "\0" $name "\$" name
return $name
}
# Register all of the procedures for the auto_mkindex parser that
# will build the "tclIndex" file.
# AUTO MKINDEX: proc name arglist body
# Adds an entry to the auto index list for the given procedure name.
auto_mkindex_parser::command proc {name args} {
variable index
variable scriptFile
# Do some fancy reformatting on the "source" call to handle platform
# differences with respect to pathnames. Use format just so that the
# command is a little easier to read (otherwise it'd be full of
# backslashed dollar signs, etc.
append index [list set auto_index([fullname $name])] \
[format { [list source [file join $dir %s]]} \
[file split $scriptFile]] "\n"
}
# Conditionally add support for Tcl byte code files. There are some
# tricky details here. First, we need to get the tbcload library
# initialized in the current interpreter. We cannot load tbcload into the
# slave until we have done so because it needs access to the tcl_patchLevel
# variable. Second, because the package index file may defer loading the
# library until we invoke a command, we need to explicitly invoke auto_load
# to force it to be loaded. This should be a noop if the package has
# already been loaded
auto_mkindex_parser::hook {
if {![catch {package require tbcload}]} {
if {[llength [info commands tbcload::bcproc]] == 0} {
auto_load tbcload::bcproc
}
load {} tbcload $auto_mkindex_parser::parser
# AUTO MKINDEX: tbcload::bcproc name arglist body
# Adds an entry to the auto index list for the given pre-compiled
# procedure name.
auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
variable index
variable scriptFile
# Do some nice reformatting of the "source" call, to get around
# path differences on different platforms. We use the format
# command just so that the code is a little easier to read.
append index [list set auto_index([fullname $name])] \
[format { [list source [file join $dir %s]]} \
[file split $scriptFile]] "\n"
}
}
}
# AUTO MKINDEX: namespace eval name command ?arg arg...?
# Adds the namespace name onto the context stack and evaluates the
# associated body of commands.
#
# AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
# Performs the "import" action in the parser interpreter. This is
# important for any commands contained in a namespace that affect
# the index. For example, a script may say "itcl::class ...",
# or it may import "itcl::*" and then say "class ...". This
# procedure does the import operation, but keeps track of imported
# patterns so we can remove the imports later.
auto_mkindex_parser::command namespace {op args} {
switch -- $op {
eval {
variable parser
variable contextStack
set name [lindex $args 0]
set args [lrange $args 1 end]
set contextStack [linsert $contextStack 0 $name]
$parser eval [list _%@namespace eval $name] $args
set contextStack [lrange $contextStack 1 end]
}
import {
variable parser
variable imports
foreach pattern $args {
if {[string compare $pattern "-force"]} {
lappend imports $pattern
}
}
catch {$parser eval "_%@namespace import $args"}
}
}
}
return
gradint-build/PocketPC/Program Files/lib/tcl8.4/ldAout.tcl deleted 100644 → 0
View file @ 14df51ec
# ldAout.tcl --
#
# This "tclldAout" procedure in this script acts as a replacement
# for the "ld" command when linking an object file that will be
# loaded dynamically into Tcl or Tk using pseudo-static linking.
#
# Parameters:
# The arguments to the script are the command line options for
# an "ld" command.
#
# Results:
# The "ld" command is parsed, and the "-o" option determines the
# module name. ".a" and ".o" options are accumulated.
# The input archives and object files are examined with the "nm"
# command to determine whether the modules initialization
# entry and safe initialization entry are present. A trivial
# C function that locates the entries is composed, compiled, and
# its .o file placed before all others in the command; then
# "ld" is executed to bind the objects together.
#
# RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $
#
# Copyright (c) 1995, by General Electric Company. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# This work was supported in part by the ARPA Manufacturing Automation
# and Design Engineering (MADE) Initiative through ARPA contract
# F33615-94-C-4400.
proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
global env
global argv
if {[string equal $cc ""]} {
set cc $env(CC)
}
# if only two parameters are supplied there is assumed that the
# only shlib_suffix is missing. This parameter is anyway available
# as "info sharedlibextension" too, so there is no need to transfer
# 3 parameters to the function tclLdAout. For compatibility, this
# function now accepts both 2 and 3 parameters.
if {[string equal $shlib_suffix ""]} {
set shlib_cflags $env(SHLIB_CFLAGS)
} elseif {[string equal $shlib_cflags "none"]} {
set shlib_cflags $shlib_suffix
}
# seenDotO is nonzero if a .o or .a file has been seen
set seenDotO 0
# minusO is nonzero if the last command line argument was "-o".
set minusO 0
# head has command line arguments up to but not including the first
# .o or .a file. tail has the rest of the arguments.
set head {}
set tail {}
# nmCommand is the "nm" command that lists global symbols from the
# object files.
set nmCommand {|nm -g}
# entryProtos is the table of _Init and _SafeInit prototypes found in the
# module.
set entryProtos {}
# entryPoints is the table of _Init and _SafeInit entries found in the
# module.
set entryPoints {}
# libraries is the list of -L and -l flags to the linker.
set libraries {}
set libdirs {}
# Process command line arguments
foreach a $argv {
if {!$minusO && [regexp {\.[ao]$} $a]} {
set seenDotO 1
lappend nmCommand $a
}
if {$minusO} {
set outputFile $a
set minusO 0
} elseif {![string compare $a -o]} {
set minusO 1
}
if {[regexp {^-[lL]} $a]} {
lappend libraries $a
if {[regexp {^-L} $a]} {
lappend libdirs [string range $a 2 end]
}
} elseif {$seenDotO} {
lappend tail $a
} else {
lappend head $a
}
}
lappend libdirs /lib /usr/lib
# MIPS -- If there are corresponding G0 libraries, replace the
# ordinary ones with the G0 ones.
set libs {}
foreach lib $libraries {
if {[regexp {^-l} $lib]} {
set lname [string range $lib 2 end]
foreach dir $libdirs {
if {[file exists [file join $dir lib${lname}_G0.a]]} {
set lname ${lname}_G0
break
}
}
lappend libs -l$lname
} else {
lappend libs $lib
}
}
set libraries $libs
# Extract the module name from the "-o" option
if {![info exists outputFile]} {
error "-o option must be supplied to link a Tcl load module"
}
set m [file tail $outputFile]
if {[regexp {\.a$} $outputFile]} {
set shlib_suffix .a
} else {
set shlib_suffix ""
}
if {[regexp {\..*$} $outputFile match]} {
set l [expr {[string length $m] - [string length $match]}]
} else {
error "Output file does not appear to have a suffix"
}
set modName [string tolower $m 0 [expr {$l-1}]]
if {[regexp {^lib} $modName]} {
set modName [string range $modName 3 end]
}
if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
}
set modName [string totitle $modName]
# Catalog initialization entry points found in the module
set f [open $nmCommand r]
while {[gets $f l] >= 0} {
if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
set s $symbol
}
append entryProtos {extern int } $symbol { (); } \n
append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
}
}
close $f
if {[string equal $entryPoints ""]} {
error "No entry point found in objects"
}
# Compose a C function that resolves the initialization entry points and
# embeds the required libraries in the object code.
set C {#include <string.h>}
append C \n
append C {char TclLoadLibraries_} $modName { [] =} \n
append C { "@LIBS: } $libraries {";} \n
append C $entryProtos
append C {static struct } \{ \n
append C { char * name;} \n
append C { int (*value)();} \n
append C \} {dictionary [] = } \{ \n
append C $entryPoints
append C { 0, 0 } \n \} \; \n
append C {typedef struct Tcl_Interp Tcl_Interp;} \n
append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
append C {Tcl_PackageInitProc *} \n
append C TclLoadDictionary_ $modName { (symbol)} \n
append C { CONST char * symbol;} \n
append C {
{
int i;
for (i = 0; dictionary [i] . name != 0; ++i) {
if (!strcmp (symbol, dictionary [i] . name)) {
return dictionary [i].value;
}
}
return 0;
}
}
append C \n
# Write the C module and compile it
set cFile tcl$modName.c
set f [open $cFile w]
puts -nonewline $f $C
close $f
set ccCommand "$cc -c $shlib_cflags $cFile"
puts stderr $ccCommand
eval exec $ccCommand
# Now compose and execute the ld command that packages the module
if {[string equal $shlib_suffix ".a"]} {
set ldCommand "ar cr $outputFile"
regsub { -o} $tail {} tail
} else {
set ldCommand ld
foreach item $head {
lappend ldCommand $item
}
}
lappend ldCommand tcl$modName.o
foreach item $tail {
lappend ldCommand $item
}
puts stderr $ldCommand
eval exec $ldCommand
if {[string equal $shlib_suffix ".a"]} {
exec ranlib $outputFile
}
# Clean up working files
exec /bin/rm $cFile [file rootname $cFile].o
}
gradint-build/PocketPC/Program Files/lib/tcl8.4/parray.tcl deleted 100644 → 0
View file @ 14df51ec
# parray:
# Print the contents of a global array on stdout.
#
# RCS: @(#) $Id: parray.tcl,v 1.3 1998/09/14 18:40:03 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
proc parray {a {pattern *}} {
upvar 1 $a array
if {![array exists array]} {
error "\"$a\" isn't an array"
}
set maxl 0
foreach name [lsort [array names array $pattern]] {
if {[string length $name] > $maxl} {
set maxl [string length $name]
}
}
set maxl [expr {$maxl + [string length $a] + 2}]
foreach name [lsort [array names array $pattern]] {
set nameString [format %s(%s) $a $name]
puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
}
}