#!/usr/bin/tclsh # findlex - corpus search script # Copyright (C) 2004-2007 Richard Moot (Richard.Moot@labri.fr) # Copyright (C) 2004-2007 CNRS (http://www.cnrs.fr) # Copyright (C) 2004-2007 INRIA (http://www.inria.fr) # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # This library 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 # Lesser General Public License for more details. # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # findlex finds a sequence of words in the lexicon files # for example # # findlex "de-*-vakken" filenames # # will find occurrences of the word "de" followed by an arbitrary # other word followed by "vakken. set total 0 set forms 1 if {[llength $argv] < 2} { puts "Usage: findlex PATTERN FILENAMES" exit 1 } else { set pattern [lindex $argv 0] set items [split $pattern "-"] # puts stderr $items set n 0 set e [llength $items] set lines(0) 0 foreach file [lrange $argv 1 end] { set fh [open $file r] puts stderr "$file" while {[gets $fh line] >= 0} { if {[regexp {^lex\(\"(.*)\"\, (.*)\, (.*)\, (.*)\, (.*)\, (.*)\, (.*)\, (.*)\, (.*)\)} $line all pros form sem file sent wrdn trig big uni]} { # puts stderr "[lindex $items $n] $pros" if {[string match [lindex $items $n] $pros]} { set lines($n) $line incr n if {$n == $e} { foreach i [lsort -integer [array names lines]] { puts $lines($i) } puts "---" array unset lines set n 0 } } else { # matching failed, reset counters array unset lines set n 0 } } } close $fh } }