00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## AllConstraints - manage all constraints. 00013 ## 00014 ## 00015 ## \author Michael Daum (see also AUTHORS and THANKS for more) 00016 ## $Id: allconstraints.tcl,v 1.33 2004/10/11 13:50:05 micha Exp $ 00017 ## ---------------------------------------------------------------------------- 00018 class AllConstraints { 00019 inherit DataBrowser 00020 00021 00022 # public methods 00023 public method init_data {} 00024 00025 ## replaces getconstraint 00026 public method getCData {id}; ## \type TclString 00027 00028 public method refreshrow {row constraint}; ## \type TclNumber, Constraint 00029 00030 public method getAllConstraintIds; ## \type TclList 00031 00032 constructor {args} {}; ## \type TclList 00033 00034 # private methods 00035 private method _init_data {} 00036 private method showbutton_action {} 00037 private method weightbutton_action {} 00038 private method editbutton_action {} 00039 private method usebutton_action {} 00040 private method usegroupbutton_action {} 00041 private method uselevelbutton_action {} 00042 00043 00044 # private variables 00045 00046 ## hash mapping constraint ids to Constraint structures 00047 private variable constraints; ## \type TclArray 00048 }; 00049 00050 ## ---------------------------------------------------------------------------- 00051 ## constructor 00052 ## ---------------------------------------------------------------------------- 00053 body AllConstraints::constructor {args} { 00054 set _idColumnIndex 0 00055 set table $itk_component(table) 00056 $table configure -cols 7 00057 00058 00059 itk_component add editbutton { 00060 button $itk_component(childsite).edit\ 00061 -anchor w \ 00062 -text "Edit" \ 00063 -command [code $this editbutton_action] 00064 } { } 00065 00066 itk_component add showbutton { 00067 button $itk_component(childsite).show\ 00068 -anchor w \ 00069 -text "Show" \ 00070 -command [code $this showbutton_action] 00071 } { } 00072 00073 itk_component add usebutton { 00074 button $itk_component(childsite).use\ 00075 -anchor w \ 00076 -text "Use" \ 00077 -command [code $this usebutton_action] 00078 } { } 00079 00080 itk_component add weightbutton { 00081 button $itk_component(childsite).weight\ 00082 -anchor w \ 00083 -text "Weight" \ 00084 -command [code $this weightbutton_action] 00085 } { } 00086 00087 itk_component add usegroupbutton { 00088 button $itk_component(childsite).usegroup\ 00089 -anchor w \ 00090 -text "Use Group" \ 00091 -command [code $this usegroupbutton_action] 00092 } { } 00093 00094 itk_component add uselevelbutton { 00095 button $itk_component(childsite).uselevel\ 00096 -anchor w \ 00097 -text "Use Level" \ 00098 -command [code $this uselevelbutton_action] 00099 } { } 00100 00101 00102 # packing 00103 pack \ 00104 $itk_component(showbutton) \ 00105 $itk_component(editbutton) \ 00106 $itk_component(weightbutton) \ 00107 $itk_component(usebutton) \ 00108 $itk_component(usegroupbutton) \ 00109 $itk_component(uselevelbutton) \ 00110 -side left -padx 3 00111 00112 # get the initial data 00113 _init_data 00114 00115 # register the helpmessages 00116 .cdgmain help sethelpstr \ 00117 $itk_component(showbutton) "Print a constraint in the shell" \ 00118 $itk_component(editbutton) "Edit the source of the constraint" \ 00119 $itk_component(editbutton) "Change weight of this constraint" \ 00120 $itk_component(usebutton) "(Don't) Use this constraint" \ 00121 $itk_component(usegroupbutton) "(Don't) Use constraints from this group" \ 00122 $itk_component(uselevelbutton) "(Don't) Use constraints from this level" \ 00123 $itk_component(table) \ 00124 "Click selects row, Ctrl-Click selects more rows, NW cell selects all" 00125 00126 00127 eval itk_initialize $args 00128 } 00129 00130 00131 00132 ## ---------------------------------------------------------------------------- 00133 ## call _init_data() if necessary. 00134 ## ---------------------------------------------------------------------------- 00135 body AllConstraints::init_data {} { 00136 00137 if {[InputStruct_xcdgconstraintsToDate_get [inputCurrentGrammar_get]]} { 00138 return 00139 } 00140 00141 .cdgmain busy compute "Init Constraints" [code $this _init_data] 00142 00143 } 00144 00145 ## ---------------------------------------------------------------------------- 00146 ## get data from the cdg tool. 00147 ## ---------------------------------------------------------------------------- 00148 body AllConstraints::_init_data {} { 00149 00150 set table $itk_component(table) 00151 $table configure -state normal 00152 $table clear all 00153 $table delete rows 1 [$table cget -rows] 00154 $table tag config default 00155 $table tag config colored -bg gray80 00156 $table tag config ids -anchor w 00157 $table tag col ids 0 00158 $table width 0 17 1 10 2 12 3 7 4 7 5 5 6 3 00159 00160 # prepare 00161 foreach id [array names constraints] { 00162 unset constraints($id) 00163 } 00164 00165 # import data to Tcl 00166 set h [InputStruct_constraints_get [inputCurrentGrammar_get]] 00167 set m [hashListOfKeys $h] 00168 _setCount [listSize $m] 00169 for {set l $m} { $l != "NULL" } { set l [listNext $l ] } { 00170 set id [listElement $l] 00171 set constraint [hashGet $h $id] 00172 set id [ConstraintStruct_id_get $constraint] 00173 set constraints($id) $constraint 00174 } 00175 listDelete $m 00176 00177 #_setCount [hashSize $h] 00178 $table setCell row 0,0 { "" "File" "Group" "Level1" \ 00179 "Level2" "Penalty" "active" } 00180 00181 set r 1 00182 foreach id [lsort [array names constraints]] { 00183 refreshrow $r $constraints($id) 00184 incr r 00185 if {[expr $r % 100] == 0} { 00186 update 00187 } 00188 } 00189 00190 setSelection 00191 00192 InputStruct_xcdgconstraintsToDate_set [inputCurrentGrammar_get] 1 00193 00194 $table configure -state disabled 00195 } 00196 00197 00198 ## ---------------------------------------------------------------------------- 00199 ## fill a row with the values from a specific constraint. 00200 ## ---------------------------------------------------------------------------- 00201 body AllConstraints::refreshrow {row constraint} { 00202 set table $itk_component(table) 00203 # constraint name 00204 set constraint_id [ConstraintStruct_id_get $constraint] 00205 00206 # base name of defining file 00207 regexp "\[^/\]*$" [ConstraintStruct_filename_get $constraint] basename 00208 00209 # section of constraint 00210 set group [SectionStruct_id_get [ConstraintStruct_section_get $constraint]] 00211 00212 # names of related levels 00213 set i 1 00214 set level1 "---" 00215 set level2 "---" 00216 for {set l [ConstraintStruct_vars_get $constraint] } \ 00217 { $l != "NULL" } \ 00218 { set l [listNext $l ] } \ 00219 { 00220 set varinfo [listElement $l] 00221 set level$i [VarInfoStruct_levelname_get $varinfo] 00222 incr i 00223 } 00224 00225 # constraint penalty 00226 set penalty [ConstraintStruct_penalty_get $constraint] 00227 00228 # variable penalties are just called "variable"... 00229 set term [ConstraintStruct_penaltyTerm_get $constraint] 00230 if { $term != "NULL" } { 00231 set penalty "variable" 00232 00233 # ...but sometimes people just notate a constant in brackets. 00234 # Let's outsmart them! 00235 set type [TermStruct_type_get $term] 00236 if {$type == "10"} { # 10 corresponds to TTNumber 00237 set data [TermStruct_data_get $term] 00238 set penalty [TermStruct_data_number_get $data] 00239 } 00240 } 00241 00242 # usage flag 00243 set active [ConstraintStruct_active_get $constraint] 00244 if { $active == 0 } { set active no } 00245 if { $active == 1 } { set active yes } 00246 00247 $table setCell row $row,0 [list \ 00248 $constraint_id $basename $group $level1 \ 00249 $level2 $penalty $active ] 00250 00251 } 00252 00253 00254 ## ---------------------------------------------------------------------------- 00255 ## toggle usage of groups of selected constraints . 00256 ## ---------------------------------------------------------------------------- 00257 body AllConstraints::usegroupbutton_action {} { 00258 if {$_selection == ""} return 00259 00260 # find all affected groups 00261 foreach id $_selection { 00262 set constraint $constraints($id) 00263 set group [ConstraintStruct_section_get $constraint] 00264 set groups($group) 1 00265 } 00266 00267 # toggle all constraints within them 00268 foreach id [array names constraints] { 00269 set constraint $constraints($id) 00270 set group [ConstraintStruct_section_get $constraint] 00271 if { [info exists groups($group)] } { 00272 commandEval "useconstraint '$id'" 00273 refreshid $id 00274 } 00275 } 00276 00277 } 00278 00279 ## ---------------------------------------------------------------------------- 00280 ## toggle usage of level of selected constraints. 00281 ## ---------------------------------------------------------------------------- 00282 body AllConstraints::uselevelbutton_action {} { 00283 if {$_selection == ""} return 00284 00285 # find all affected levels 00286 foreach id $_selection { 00287 set constraint $constraints($id) 00288 for { set l [ConstraintStruct_vars_get $constraint] } \ 00289 { $l != "NULL" } \ 00290 { set l [listNext $l] } \ 00291 { 00292 set varinfo [listElement $l] 00293 set level [VarInfoStruct_levelname_get $varinfo] 00294 set levels($level) 1 00295 } 00296 } 00297 00298 # toggle all found levels 00299 foreach id [array names levels] { 00300 commandEval "uselevel '$id'" 00301 } 00302 00303 # since this changes nothing in our table, no need to redraw. 00304 # But the levelpage needs refreshing. 00305 .cdgmain levels init_data 00306 00307 } 00308 00309 ## ---------------------------------------------------------------------------- 00310 ## Set new weight for the selected constraint. 00311 ## ---------------------------------------------------------------------------- 00312 body AllConstraints::weightbutton_action {} { 00313 00314 if {$_selection == ""} return 00315 00316 foreach id $_selection { 00317 set constraint $constraints($id) 00318 00319 iwidgets::promptdialog .pd \ 00320 -title "Change Weight" \ 00321 -modality global \ 00322 -labeltext "Weight of constraint $id:" 00323 00324 .pd hide Apply 00325 .pd hide Help 00326 .pd activate 00327 set w [.pd get] 00328 00329 commandEval "weight '$id' $w" 00330 refreshid $id 00331 destroy .pd 00332 00333 } 00334 } 00335 00336 ## ---------------------------------------------------------------------------- 00337 ## toggle usage of selected constraints. 00338 ## ---------------------------------------------------------------------------- 00339 body AllConstraints::usebutton_action {} { 00340 if {$_selection == ""} return 00341 00342 foreach id $_selection { commandEval "useconstraint '$id'" } 00343 foreach id $_selection { refreshid $id } 00344 } 00345 00346 ## ---------------------------------------------------------------------------- 00347 ## call an editor to view the constraint source 00348 ## ---------------------------------------------------------------------------- 00349 body AllConstraints::editbutton_action {} { 00350 if {$_selection == ""} return 00351 00352 # build list of filenames 00353 set target "" 00354 foreach id $_selection { 00355 00356 # I suppose most editors grok "+<linenum> file" nowadays... 00357 set constraint $constraints($id) 00358 set linenum [ConstraintStruct_lineNo_get $constraint] 00359 set filename [ConstraintStruct_filename_get $constraint] 00360 append target "+$linenum $filename " 00361 } 00362 00363 # build command line 00364 regsub -all "%f" "/bin/sh -c \"[.cdgmain cget -editor]\"" $target command 00365 00366 # execute 00367 if {[catch {eval exec $command >/dev/null &} errMsg]} { 00368 ::cmd::Puts "ERROR: $errMsg" 00369 } 00370 } 00371 00372 ## ---------------------------------------------------------------------------- 00373 ## display the constraint in the shell. 00374 ## ---------------------------------------------------------------------------- 00375 body AllConstraints::showbutton_action {} { 00376 foreach id $_selection { 00377 commandEval "constraint '$id'" 00378 } 00379 } 00380 00381 00382 00383 ## ---------------------------------------------------------------------------- 00384 ## get pointer to a constraint_id, cache it in array constraints. 00385 ## ---------------------------------------------------------------------------- 00386 body AllConstraints::getCData {id} { 00387 if {![info exists constraints($id)]} { 00388 set found 0 00389 for {set l [cdgConstraints_get]} \ 00390 {$l != "NULL"} \ 00391 { set l [listNext $l ] } { 00392 00393 set constraint [listElement $l] 00394 set constraint_id [ConstraintStruct_id_get $constraint] 00395 if {$constraint_id == $id} { 00396 incr found 00397 break 00398 } 00399 } 00400 if {!$found} { 00401 return "NULL" 00402 } 00403 set constraints($id) $constraint 00404 #_setCount [listSize [cdgConstraints_get]] 00405 } 00406 return $constraints($id) 00407 } 00408 00409 00410 ## ---------------------------------------------------------------------------- 00411 ## Return list of all constraints' names 00412 ## ---------------------------------------------------------------------------- 00413 body AllConstraints::getAllConstraintIds {} { 00414 init_data 00415 return [array names constraints] 00416 }