Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Namespace Members | Class Members | File Members | Related Pages

xcdg.tcl

00001 #!/bin/sh 00002 #\ 00003 exec wish "$0" "$@" # ---------------------------------------------------------------------------- # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> # # This file is free software; as a special exception the author gives # unlimited permission to copy and/or distribute it, with or without # modifications, as long as this notice is preserved. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # ---------------------------------------------------------------------------- ## ---------------------------------------------------------------------------- ## \mainpage The XCDG Reference Manual ## \image html xcdg.gif ## \author Michael Daum, Kilian A. Foth, Dietmar Fünning ## ## $Id: xcdg.tcl,v 1.92 2004/10/11 15:23:31 micha Exp $ ## ## \section Overview Overview ## This is the programmers reference manual of XCDG, that is a documentation ## of the implementation. For a detailed usage overview please consult the ## Xcdg User Manual. ## ## \section Copyright Copyright ## Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> ## ## \verbatim ## XCDG is licensed under the GPL. ## ## This application is free software; as a special exception the author gives ## unlimited permission to copy and/or distribute it, with or without ## modifications, as long as this notice is preserved. ## ## This program is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY, to the extent permitted by law; without even the ## implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ## \endverbatim ## ## ---------------------------------------------------------------------------- ## \comment if {![info exists env(XCDG_LIB)]} { set env(XCDG_LIB) {.} } if {![file exists $env(XCDG_LIB)]} { puts "ERROR: can't locate xcdg-directory, please set XCDG_LIB" 00004 exit 00005 } 00006 00007 set env(XCDG_LIB) [glob $env(XCDG_LIB)] 00008 lappend auto_path $env(XCDG_LIB) 00009 00010 # load some libraries: 00011 00012 # XML parsing for tcl 00013 package require tdom 00014 00015 # Itcl -- object-oriented extensions to Tcl 00016 package require Iwidgets 00017 00018 # required so we can just write "class foo {...}" 00019 namespace import -force itcl::* 00020 00021 # otherwise we would have to write "itcl::class foo {...}" 00022 00023 # a better table widget than the standard one 00024 package require Tktable 00025 00026 # libcdg calls 00027 load $env(CDG_BINDINGS) 00028 00029 # get compatibility hacks 00030 source $env(XCDG_LIB)/compat.tcl 00031 00032 # display the startup-screen 00033 wm withdraw . 00034 set st [StartUp .startup -title "Xcdg - Splash"] 00035 00036 # this kind of statement updates the startup-screen's progress bar 00037 $st step 2 00038 00039 ## ---------------------------------------------------------------------------- 00040 ## called by the flush-hook 00041 ## ---------------------------------------------------------------------------- 00042 proc cdgFlush {} { 00043 global cdgFlushClock 00044 00045 set now [clock clicks] 00046 set duration [expr abs($now - $cdgFlushClock)] 00047 if {$duration > 150000} { 00048 update 00049 set cdgFlushClock $now 00050 } 00051 } 00052 00053 ## ---------------------------------------------------------------------------- 00054 ## process the command line options given to xcdg etc. 00055 ## ---------------------------------------------------------------------------- 00056 proc init_xcdg {} { 00057 global argv 00058 00059 # standard values 00060 set noinit 0 00061 set userFlag 0 00062 set execFiles "" 00063 00064 cdgXCDG_set 1 00065 00066 # parse parameters - set values 00067 foreach {flag value} $argv { 00068 switch -- $flag { 00069 -i { 00070 if {"$value" == "noinit" || "$value" == "none" || "$value" == "NULL"} { 00071 set noinit 1 00072 } else { 00073 lappend execFiles $value 00074 } 00075 } 00076 -grammarpath { 00077 .cdgmain configure -grammarpath $value 00078 } 00079 -noinit { 00080 set noinit 1 00081 } 00082 default { 00083 puts stderr "unknown option `$flag'" 00084 puts stderr "usage: xcdg \[-i <scriptfile\]* \n\ 00085 \t\[-grammarpath <path-to-grammars>\] \n\ 00086 \t\[-noinit\]" 00087 exit 1 00088 } 00089 } 00090 } 00091 00092 00093 # execute actions specified in .xcdgrc 00094 if {$noinit == 0 && "$execFiles" == ""} { 00095 if {[file exists ./.xcdgrc]} { 00096 .cdgmain shell safeSource ./.xcdgrc 00097 } else { 00098 if {[file exists ~/.xcdgrc]} { 00099 .cdgmain shell safeSource ~/.xcdgrc 00100 } 00101 } 00102 } 00103 00104 # reset shell 00105 .cdgmain shell resetCmd 00106 00107 # execute collected files 00108 foreach file $execFiles { 00109 if {$file == "stdin"} { 00110 while {![eof stdin]} { 00111 .cdgmain shell safeEval [read stdin] 00112 } 00113 } else { 00114 if {[file exists $file]} { 00115 .cdgmain shell safeSource $file 00116 } else { 00117 ::cmd::Puts "ERROR: can't find file \"$file\"" 00118 } 00119 } 00120 } 00121 00122 } 00123 00124 # ---------------------------------------------------------------------------- 00125 # ---------------------------------------------------------------------------- 00126 # initial steps 00127 00128 . configure -highlightthickness 0 00129 tk_focusFollowsMouse 00130 if {[catch { option readfile $env(XCDG_LIB)/Cdgrc userDefault } errMsg]} { 00131 puts "error in reading Cdgrc: " 00132 puts $errMsg 00133 exit 1 00134 } 00135 00136 00137 00138 # set the hooks 00139 setHookCmd flush "cdgFlush" 00140 setHookCmd printf "::cmd::Puts -nonewline" 00141 setHookCmd gets ".cdgmain shell fgets" 00142 setHookCmd progress ".cdgmain help showstr" 00143 setHookCmd partialresult ".cdgmain parses handlePartialResult" 00144 setHookCmd "IC interaction" ".cdgmain parses handleICinteraction" 00145 setHookCmd reset ".cdgmain parses reset" 00146 00147 set cdgFlushClock 0 00148 commandEval "hook flush on" 00149 commandEval "hook printf on" 00150 00151 # build the application 00152 CdgMain .cdgmain 00153 pack .cdgmain -fill both -expand 1 00154 destroy $st 00155 scan [wm maxsize .] "%d %d" maxx maxy 00156 set maxy [expr $maxy - 50] 00157 wm geometry . ${maxx}x${maxy}+0+0 00158 wm minsize . 800 600 00159 wm title . "Xcdg - Main" 00160 wm deiconify . 00161 update idletask 00162 00163 # source bugfixes: don't rely on autoload 00164 source $env(XCDG_LIB)/bugfix.tcl 00165 00166 # print some ugly messages 00167 set xcdg_version {$Id: xcdg.tcl,v 1.92 2004/10/11 15:23:31 micha Exp $} 00168 00169 ::cmd::Puts " 00170 INFO: \[X\]CDG parser v[lindex $xcdg_version 2], [lindex $xcdg_version 3] 00171 For more information see 00172 http://nats-www.informatik.uni-hamburg.de/view/Papa 00173 The CDG Team can be contacted at 00174 cdg@nats.informatik.uni-hamburg.de 00175 " 00176 00177 init_xcdg 00178 00179 ## \endcomment 00180

XCDG 0.95 (20 Oct 2004)