- Updated GumTree support for most recent versions
This commit is contained in:
koennecke
@ -1,3 +1,3 @@
|
||||
223
|
||||
225
|
||||
NEVER, EVER modify or delete this file
|
||||
You'll risk eternal damnation and a reincarnation as a cockroach!|n
|
||||
159
mcstas/dmc/gumibatch.tcl
Normal file
159
mcstas/dmc/gumibatch.tcl
Normal file
@ -0,0 +1,159 @@
|
||||
#-------------------------------------------------------------
|
||||
# This is a set of Tcl procedures which try to convert an old
|
||||
# batch file into a batch file suitable for Mountaingum.
|
||||
#
|
||||
# copyright: GPL
|
||||
#
|
||||
# Mark Koennecke, February 2008
|
||||
#-------------------------------------------------------------
|
||||
if {[string first tmp $home] < 0} {
|
||||
set tmppath $home/tmp
|
||||
} else {
|
||||
set tmppath $home
|
||||
}
|
||||
#-------------------------------------------------------------
|
||||
proc searchPathForDrivable {name} {
|
||||
set path [string trim [hmatchprop / sicsdev $name]]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
return $path
|
||||
}
|
||||
set txt [findalias $name]
|
||||
if {[string compare $txt NONE] == 0} {
|
||||
return NONE
|
||||
}
|
||||
set l1 [split $txt =]
|
||||
set l [split [lindex $l1 1] ,]
|
||||
foreach alias $l {
|
||||
set alias [string trim $alias]
|
||||
set path [string trim [hmatchprop / sicsdev $alias]]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
return $path
|
||||
}
|
||||
}
|
||||
return NONE
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc searchForCommand {name} {
|
||||
return [string trim [hmatchprop / sicscommand $name]]
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc treatsscan {scanpath command out} {
|
||||
set l [split $command]
|
||||
set len [llength $l]
|
||||
set noVar [expr ($len-2)/3]
|
||||
set np [lindex $l [expr $len -2]]
|
||||
set preset [lindex $l [expr $len -1]]
|
||||
for {set i 0} {$i < $noVar} {incr i} {
|
||||
set start [expr $i * 3]
|
||||
set scanVar [lindex $l [expr 1 + $start]]
|
||||
set scanStart [lindex $l [expr 2 + $start]]
|
||||
set scanEnd [lindex $l [expr 3 + $start]]
|
||||
set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.]
|
||||
append hdbVar $scanVar ,
|
||||
append hdbStart $scanStart ,
|
||||
append hdbStep $scanStep ,
|
||||
}
|
||||
set hdbVar [string trim $hdbVar ,]
|
||||
set hdbStart [string trim $hdbStart ,]
|
||||
set hdbStep [string trim $hdbStep ,]
|
||||
puts $out "\#NODE: $scanpath"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc treatcscan {scanpath command out} {
|
||||
set l [split $command]
|
||||
set scanVar [lindex $l 1]
|
||||
set scanCenter [lindex $l 2]
|
||||
set scanStep [lindex $l 3]
|
||||
set np [lindex $l 4]
|
||||
set preset [lindex $l 5]
|
||||
set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0]
|
||||
puts $out "\#NODE: $scanpath"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc translateCommand {command out} {
|
||||
set drivelist [list drive dr run]
|
||||
# clientput "Translating: $command"
|
||||
set command [string trim $command]
|
||||
if {[string length $command] < 2} {
|
||||
return
|
||||
}
|
||||
set l [split $command]
|
||||
set obj [string trim [lindex $l 0]]
|
||||
#------- check for drive commands
|
||||
set idx [lsearch $drivelist $obj]
|
||||
if {$idx > 0} {
|
||||
set dev [lindex $l 1]
|
||||
set path [searchPathForDrivable $dev]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
puts $out "\#NODE: $path"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out $command
|
||||
return
|
||||
}
|
||||
}
|
||||
#--------- check for simple commands
|
||||
set path [searchForCommand $command]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
puts $out "\#NODE: $path"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out $command
|
||||
return
|
||||
}
|
||||
set scancom [searchForCommand hdbscan]
|
||||
#---------- deal with scans
|
||||
if {[string first sscan $obj] >= 0} {
|
||||
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||
return
|
||||
}
|
||||
}
|
||||
if {[string first cscan $obj] >= 0} {
|
||||
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||
return
|
||||
}
|
||||
}
|
||||
#--------- give up: output as a text node
|
||||
puts $out "\#NODE: /batch/commandtext"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
set buffer [string map {\n @nl@} $command]
|
||||
puts $out "hset /batch/commandtext $buffer"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc mgbatch {filename} {
|
||||
global tmppath
|
||||
set f [open $filename r]
|
||||
gets $f line
|
||||
close $f
|
||||
if {[string first MOUNTAINBATCH $line] > 0} {
|
||||
#--------- This is a mountaingum batch file which does not need
|
||||
# to be massaged
|
||||
return $filename
|
||||
}
|
||||
set f [open $filename r]
|
||||
set realfilename [file tail $filename]
|
||||
set out [open $tmppath/$realfilename w]
|
||||
puts $out \#MOUNTAINBATCH
|
||||
while {[gets $f line] >= 0} {
|
||||
append buffer $line
|
||||
if {[info complete $buffer] == 1} {
|
||||
translateCommand $buffer $out
|
||||
unset buffer
|
||||
} else {
|
||||
append buffer \n
|
||||
}
|
||||
}
|
||||
close $out
|
||||
return $tmppath/$realfilename
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc loadmgbatch {filename} {
|
||||
set txt [exe fullpath $filename]
|
||||
set l [split $txt =]
|
||||
set realf [lindex $l 1]
|
||||
set realf [mgbatch $realf]
|
||||
return [exe print $realf]
|
||||
}
|
||||
|
||||
@ -2,12 +2,14 @@ proc getdataType {path} {
|
||||
return [lindex [split [hinfo $path] ,] 0]
|
||||
}
|
||||
|
||||
|
||||
proc make_nodes {path result indent} {
|
||||
set nodename [file tail $path];
|
||||
set type [getdataType $path]
|
||||
set prefix [string repeat " " $indent]
|
||||
set newIndent [expr $indent + 2]
|
||||
array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
||||
#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
||||
set prop_list(control) true
|
||||
set we_have_control [info exists prop_list(control)]
|
||||
if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
|
||||
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
|
||||
@ -22,7 +24,7 @@ array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
||||
return $result
|
||||
}
|
||||
|
||||
proc property_elements {path indent} {
|
||||
proc property_elements_old {path indent} {
|
||||
set prefix [string repeat " " $indent]
|
||||
foreach {key value} [string map {= " "} [hlistprop $path]] {
|
||||
if {[string compare -nocase $key "control"] == 0} {continue}
|
||||
@ -36,6 +38,24 @@ proc property_elements {path indent} {
|
||||
if [info exists proplist] {return $proplist}
|
||||
}
|
||||
|
||||
proc property_elements {path indent} {
|
||||
set prefix [string repeat " " $indent]
|
||||
set data [hlistprop $path]
|
||||
set propList [split $data \n]
|
||||
foreach prop $propList {
|
||||
set pl [split $prop =]
|
||||
set key [string trim [lindex $pl 0]]
|
||||
set value [string trim [lindex $pl 1]]
|
||||
if {[string length $key] < 1} {
|
||||
continue
|
||||
}
|
||||
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
||||
lappend proplist "$prefix</property>\n"
|
||||
}
|
||||
if [info exists proplist] {return $proplist}
|
||||
}
|
||||
|
||||
proc getgumtreexml {path} {
|
||||
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
|
||||
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
|
||||
|
||||
11390
mcstas/dmc/samenv/tomato/07-20.log
Normal file
11390
mcstas/dmc/samenv/tomato/07-20.log
Normal file
File diff suppressed because it is too large
Load Diff
@ -12,6 +12,7 @@ if {$wwwMode == 1} {
|
||||
set datahome /home/lnswww/www/vinstrument
|
||||
} else {
|
||||
set home $env(HOME)/src/workspace/sics/mcstas/dmc
|
||||
ServerOption LoggerDir $env(HOME)/src/workspace/sics/mcstas/dmc/samenv
|
||||
}
|
||||
#--------------------------------- first all the server options are set
|
||||
#ServerOption RedirectFile $home/stdcdmc
|
||||
@ -254,36 +255,37 @@ sicspoll add /instrument/detector/countmode hdb 30
|
||||
hmake /instrument/detector/count_time internal float
|
||||
hattach /instrument/detector/count_time counter -1
|
||||
#------------ commands
|
||||
hmake /commands spy none
|
||||
hcommand /commands/count count
|
||||
hsetprop /commands/count type command
|
||||
hsetprop /commands/count priv user
|
||||
hmake /commands/count/mode user text
|
||||
hsetprop /commands/count/mode values "monitor,timer"
|
||||
hmake /commands/count/preset user float
|
||||
hset /commands/count/preset 60000
|
||||
hset /commands/count/mode monitor
|
||||
hcommand /commands/killfile killfile
|
||||
hsetprop /commands/killfile type command
|
||||
hsetprop /commands/killfile priv manager
|
||||
hmake /instrument/commands spy none
|
||||
hcommand /instrument/commands/count count
|
||||
hsetprop /instrument/commands/count type command
|
||||
hsetprop /instrument/commands/count priv user
|
||||
hmake /instrument/commands/count/mode user text
|
||||
hsetprop /instrument/commands/count/mode values "monitor,timer"
|
||||
hmake /instrument/commands/count/preset user float
|
||||
hset /instrument/commands/count/preset 60000
|
||||
hset /instrument/commands/count/mode monitor
|
||||
hcommand /instrument/commands/killfile killfile
|
||||
hsetprop /instrument/commands/killfile type command
|
||||
hsetprop /instrument/commands/killfile priv manager
|
||||
|
||||
#------------- scan command
|
||||
hcommand /commands/scan hdbscan
|
||||
hsetprop /commands/scan type command
|
||||
hsetprop /commands/scan priv user
|
||||
hmake /commands/scan/scan_variables user text
|
||||
hsetprop /commands/scan/scan_variables argtype drivable
|
||||
hmake /commands/scan/scan_start user text
|
||||
hmake /commands/scan/scan_increments user text
|
||||
hmake /commands/scan/NP user int
|
||||
hmake /commands/scan/mode user text
|
||||
hsetprop /commands/scan/mode values "timer,monitor"
|
||||
hmake /commands/scan/preset user float
|
||||
hset /commands/scan/mode timer
|
||||
hset /commands/scan/scan_start 2.
|
||||
hset /commands/scan/scan_increments .3
|
||||
hset /commands/scan/NP 25
|
||||
hset /commands/scan/preset 2
|
||||
hcommand /instrument/commands/scan hdbscan
|
||||
hsetprop /instrument/commands/scan type command
|
||||
hsetprop /instrument/commands/scan priv user
|
||||
hsetprop /instrument/commands/scan viewer mountaingumui.ScanEditor
|
||||
hmake /instrument/commands/scan/scan_variables user text
|
||||
hsetprop /instrument/commands/scan/scan_variables argtype drivable
|
||||
hmake /instrument/commands/scan/scan_start user text
|
||||
hmake /instrument/commands/scan/scan_increments user text
|
||||
hmake /instrument/commands/scan/NP user int
|
||||
hmake /instrument/commands/scan/mode user text
|
||||
hsetprop /instrument/commands/scan/mode values "timer,monitor"
|
||||
hmake /instrument/commands/scan/preset user float
|
||||
hset /instrument/commands/scan/mode timer
|
||||
hset /instrument/commands/scan/scan_start 2.
|
||||
hset /instrument/commands/scan/scan_increments .3
|
||||
hset /instrument/commands/scan/NP 25
|
||||
hset /instrument/commands/scan/preset 2
|
||||
|
||||
#---------------- graphics
|
||||
hmake /graphics spy none
|
||||
@ -323,11 +325,44 @@ hsetprop /graphics/scan_data/counts type data
|
||||
hsetprop /graphics/scan_data/counts transfer zip
|
||||
hsetprop /graphics/scan_data/counts priv internal
|
||||
|
||||
hlink / hdbqueue batch
|
||||
hmake /graphics/samenv spy none
|
||||
hsetprop /graphics/samenv type graphdata
|
||||
hsetprop /graphics/samenv viewer mountaingumui.TimeSeries
|
||||
hmake /graphics/samenv/vars user text
|
||||
hset /graphics/samenv/vars tomato
|
||||
hmake /graphics/samenv/rank user int
|
||||
hset /graphics/samenv/rank 1
|
||||
hmake /graphics/samenv/dim user intar 1
|
||||
hset /graphics/samenv/dim 300
|
||||
hmake /graphics/samenv/getdata user text
|
||||
hsetprop /graphics/samenv/getdata type logcommand
|
||||
hmake /graphics/samenv/getdata/starttime spy text
|
||||
hmake /graphics/samenv/getdata/endtime spy text
|
||||
|
||||
hmake /batch spy none
|
||||
hmakescript /batch/bufferlist listbatchfiles hdbReadOnly text
|
||||
sicspoll add /batch/bufferlist hdb 30
|
||||
hmake /batch/commandtext spy text
|
||||
hsetprop /batch/commandtext viewer mountaingumui.TextEdit
|
||||
hsetprop /batch/commandtext commandtext true
|
||||
|
||||
|
||||
hmake /gui spy none
|
||||
hmake /gui/status internal text
|
||||
status hdbinterest /gui/status
|
||||
|
||||
proc makeQuickPar {name path} {
|
||||
hmake /quickview/$name mugger text
|
||||
hset /quickview/$name $path
|
||||
}
|
||||
|
||||
hmake /quickview spy none
|
||||
makeQuickPar title /instrument/title
|
||||
makeQuickPar sample /instrument/sample/name
|
||||
makeQuickPar lambda /instrument/monochromator/wavelength
|
||||
makeQuickPar two-theta /instrument/detector/two_theta
|
||||
makeQuickPar preset /instrument/detector/preset
|
||||
makeQuickPar monitor /instrument/sample/monitor
|
||||
|
||||
restore
|
||||
|
||||
|
||||
@ -21,11 +21,14 @@ if { [info exists vdmcinit] == 0 } {
|
||||
Publish hdbscan User
|
||||
Publish hdbprepare User
|
||||
Publish hdbcollect User
|
||||
Publish mgbatch Spy
|
||||
Publish listbatchfiles Spy
|
||||
}
|
||||
source $home/log.tcl
|
||||
source $home/nxsupport.tcl
|
||||
source $home/nxdmc.tcl
|
||||
source $home/gumxml.tcl
|
||||
source $home/gumibatch.tcl
|
||||
#------------------------------------------------------------------------
|
||||
proc SplitReply { text } {
|
||||
set l [split $text =]
|
||||
@ -470,4 +473,31 @@ proc gethdbscancounts {} {
|
||||
return "0 0 0"
|
||||
}
|
||||
}
|
||||
|
||||
#================= helper to get the list of batch files =================
|
||||
proc listbatchfiles {} {
|
||||
set ext [list *.tcl *.job]
|
||||
set txt [SplitReply [exe batchpath]]
|
||||
set dirlist [split $txt :]
|
||||
set txt [SplitReply [exe syspath]]
|
||||
set dirlist [concat $dirlist [split $txt :]]
|
||||
set result [list ""]
|
||||
foreach dir $dirlist {
|
||||
foreach e $ext {
|
||||
set status [catch {glob [string trim $dir]/$e} filetxt]
|
||||
if {$status == 0} {
|
||||
set filelist [split $filetxt]
|
||||
foreach f $filelist {
|
||||
set nam [file tail $f]
|
||||
if { [lsearch $result $nam] < 0} {
|
||||
lappend result $nam
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach bf $result {
|
||||
append resulttxt $bf ,
|
||||
}
|
||||
return [string trim $resulttxt ,]
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
|
||||
@ -1,5 +1,9 @@
|
||||
exe batchpath ./
|
||||
exe syspath ./
|
||||
|
||||
#--- BEGIN (commands producing errors on last restore)
|
||||
#--- END (commands producing errors on last restore)
|
||||
|
||||
# Motor omegam
|
||||
omegam sign 1.000000
|
||||
omegam SoftZero 0.000000
|
||||
@ -253,7 +257,7 @@ comment2 UNKNOWN
|
||||
comment2 setAccess 2
|
||||
comment3 UNKNOWN
|
||||
comment3 setAccess 2
|
||||
starttime 2007-09-07 11:09:21
|
||||
starttime 2008-03-03 11:10:28
|
||||
starttime setAccess 2
|
||||
adress 2223 Luketown, 33 Luke Drive
|
||||
adress setAccess 2
|
||||
@ -265,7 +269,7 @@ email Luke@luke.ch
|
||||
email setAccess 2
|
||||
sample_mur 0.000000
|
||||
sample_mur setAccess 2
|
||||
lastdatafile /afs/psi.ch/user/k/koennecke/src/workspace/sics/mcstas/dmc/000/vdmc2007n000223.xml
|
||||
lastdatafile /afs/psi.ch/user/k/koennecke/src/workspace/sics/mcstas/dmc/000/vdmc2008n000225.xml
|
||||
lastdatafile setAccess 2
|
||||
lastscancommand unknown scan
|
||||
lastscancommand setAccess 2
|
||||
|
||||
Reference in New Issue
Block a user