- Updated GumTree support for most recent versions

mcstas/dmc/DataNumber

@@ -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

mcstas/dmc/gumibatch.tcl

@@ -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]
+}
+

mcstas/dmc/gumxml.tcl

@@ -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"

mcstas/dmc/vdmc.tcl

@@ -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
+hmake /instrument/commands spy none
-hcommand /commands/count count
+hcommand /instrument/commands/count count
-hsetprop /commands/count type command
+hsetprop /instrument/commands/count type command
-hsetprop /commands/count priv user
+hsetprop /instrument/commands/count priv user
-hmake /commands/count/mode user text
+hmake /instrument/commands/count/mode user text
-hsetprop /commands/count/mode values "monitor,timer"
+hsetprop /instrument/commands/count/mode values "monitor,timer"
-hmake /commands/count/preset user float
+hmake /instrument/commands/count/preset user float
-hset /commands/count/preset 60000
+hset /instrument/commands/count/preset 60000
-hset /commands/count/mode monitor
+hset /instrument/commands/count/mode monitor
-hcommand /commands/killfile killfile
+hcommand /instrument/commands/killfile killfile
-hsetprop /commands/killfile type command
+hsetprop /instrument/commands/killfile type command
-hsetprop /commands/killfile priv manager
+hsetprop /instrument/commands/killfile priv manager
 
 #------------- scan command
-hcommand /commands/scan hdbscan
+hcommand /instrument/commands/scan hdbscan
-hsetprop /commands/scan type command
+hsetprop /instrument/commands/scan type command
-hsetprop /commands/scan priv user
+hsetprop /instrument/commands/scan priv user
-hmake /commands/scan/scan_variables user text
+hsetprop /instrument/commands/scan viewer mountaingumui.ScanEditor
-hsetprop /commands/scan/scan_variables argtype drivable
+hmake /instrument/commands/scan/scan_variables user text
-hmake /commands/scan/scan_start user text
+hsetprop /instrument/commands/scan/scan_variables argtype drivable
-hmake /commands/scan/scan_increments user text
+hmake /instrument/commands/scan/scan_start user text
-hmake /commands/scan/NP user int
+hmake /instrument/commands/scan/scan_increments user text
-hmake /commands/scan/mode user text
+hmake /instrument/commands/scan/NP user int
-hsetprop /commands/scan/mode values "timer,monitor"
+hmake /instrument/commands/scan/mode user text
-hmake /commands/scan/preset user float
+hsetprop /instrument/commands/scan/mode values "timer,monitor"
-hset /commands/scan/mode timer
+hmake /instrument/commands/scan/preset user float
-hset /commands/scan/scan_start 2.
+hset /instrument/commands/scan/mode timer
-hset /commands/scan/scan_increments .3
+hset /instrument/commands/scan/scan_start 2.
-hset /commands/scan/NP 25
+hset /instrument/commands/scan/scan_increments .3
-hset /commands/scan/preset 2
+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
 

mcstas/dmc/vdmccom.tcl

@@ -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 ,]
+}
+#-----------------------------------------------------------------------

mcstas/dmc/vdmcstatus.tcl

@@ -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