diff options
37 files changed, 220 insertions, 3744 deletions
diff --git a/ds9/library/analysis.tcl b/ds9/library/analysis.tcl index 2312966..eaba1fb 100644 --- a/ds9/library/analysis.tcl +++ b/ds9/library/analysis.tcl @@ -1769,8 +1769,6 @@ proc ProcessAnalysisCmd {varname iname buf fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { global parse set parse(buf) $buf set parse(fn) $fn @@ -1779,148 +1777,6 @@ proc ProcessAnalysisCmd {varname iname buf fn} { analysis::yy_scan_string [lrange $var $i end] analysis::yyparse incr i [expr $analysis::yycnt-1] - } else { - - global ime - global ianalysis - - switch -- [string tolower [lindex $var $i]] { - message { - incr i - switch [string tolower [lindex $var $i]] { - ok - - okcancel - - retrycancel - - yesno - - yesnocancel { - AnalysisMessage [lindex $var $i] [lindex $var [expr $i+1]] - incr i - } - default { - AnalysisMessage ok [lindex $var $i] - } - } - } - text { - if {$buf != {}} { - AnalysisText apXPA Analysis $buf append - } elseif {$fn != {}} { - if {[file exists $fn]} { - set ch [open $fn r] - set txt [read $ch] - close $ch - AnalysisText apXPA Analysis $txt append - } - } else { - incr i - AnalysisText apXPA Analysis [lindex $var $i] append - } - } - plot { - # for backward compatibility - # used by chandra-ed - # use xpa plot instead - - incr i - if {$buf != {}} { - ProcessAnalysisPlotCmd $varname $iname $buf - } elseif {$fn != {}} { - if {[file exists $fn]} { - set ch [open $fn r] - set rr [read $ch] - close $ch - ProcessAnalysisPlotCmd $varname $iname $rr - } - } else { - ProcessAnalysisPlotCmd $varname $iname {} - } - } - load { - if {$buf != {}} { - ProcessAnalysis buf - } elseif {$fn != {}} { - ProcessAnalysisFile $fn - } else { - incr i - ProcessAnalysisFile [lindex $var $i] - } - } - clear { - ClearAnalysis - incr i - switch -- [lindex $var $i] { - load { - if {$buf != {}} { - ProcessAnalysis buf - } elseif {$fn != {}} { - ProcessAnalysisFile $fn - } else { - incr i - ProcessAnalysisFile [lindex $var $i] - } - } - default {incr i -1} - } - } - mode { - incr i - switch -- [lindex $var $i] { - stats - - statistics {set ime(task) stats} - hist - - histogram {set ime(task) hist} - radial - - radialprofile {set ime(task) radial} - 2d - - plot2d {set ime(task) plot2d} - 3d - - plot3d {set ime(task) plot3d} - } - - ProcessRealizeDS9 - IMEChangeTask - } - task { - incr i - if {[string is integer [lindex $var $i]]} { - AnalysisTask [lindex $var $i] menu - } else { - # invoke by name - for {set ii 0} {$ii<$ianalysis(menu,count)} {incr ii} { - if {[string equal -nocase $ianalysis(menu,$ii,item) [lindex $var $i]]} { - AnalysisTask $ii menu - } - } - } - } - default { - if {[string is integer [lindex $var $i]]} { - AnalysisTask [lindex $var $i] menu - } else { - ProcessAnalysisFile [lindex $var $i] - } - } - } -} -} - -proc ProcessAnalysisPlotCmd {varname iname buf} { - upvar 2 $varname var - upvar 2 $iname i - - global iap - switch -- [string tolower [lindex $var $i]] { - stdin {AnalysisPlotStdin line $iap(tt) {} $buf} - default { - PlotLine $iap(tt) Plot \ - [lindex $var [expr $i+0]] \ - [lindex $var [expr $i+1]] \ - [lindex $var [expr $i+2]] \ - [lindex $var [expr $i+3]] \ - $buf - incr i 3 - } - } } proc AnalysisCmdTask {task} { diff --git a/ds9/library/backup.tcl b/ds9/library/backup.tcl index 954fa3d..3ad1c27 100644 --- a/ds9/library/backup.tcl +++ b/ds9/library/backup.tcl @@ -783,22 +783,10 @@ proc ProcessBackupCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - backup::YY_FLUSH_BUFFER - backup::yy_scan_string [lrange $var $i end] - backup::yyparse - incr i [expr $backup::yycnt-1] - } else { - - set fn [lindex $var $i] - if {$fn != {}} { - FileLast backupfbox $fn - Backup $fn - } else { - Error [msgcat::mc {Unable to open file}] - } -} + backup::YY_FLUSH_BUFFER + backup::yy_scan_string [lrange $var $i end] + backup::yyparse + incr i [expr $backup::yycnt-1] } proc BackupCmd {fn} { @@ -810,22 +798,10 @@ proc ProcessRestoreCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - restore::YY_FLUSH_BUFFER - restore::yy_scan_string [lrange $var $i end] - restore::yyparse - incr i [expr $restore::yycnt-1] - } else { - - set fn [lindex $var $i] - if {$fn != {}} { - FileLast backupfbox $fn - Restore $fn - } else { - Error [msgcat::mc {Unable to open file}] - } -} + restore::YY_FLUSH_BUFFER + restore::yy_scan_string [lrange $var $i end] + restore::yyparse + incr i [expr $restore::yycnt-1] } proc RestoreCmd {fn} { diff --git a/ds9/library/cat.tcl b/ds9/library/cat.tcl index 5ad5c90..0d30632 100644 --- a/ds9/library/cat.tcl +++ b/ds9/library/cat.tcl @@ -1243,586 +1243,15 @@ proc ProcessCatalogCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - global icat - set ref [lindex $icat(cats) end] - global cvarname - set cvarname $ref - - cat::YY_FLUSH_BUFFER - cat::yy_scan_string [lrange $var $i end] - cat::yyparse - incr i [expr $cat::yycnt-1] - } else { - global icat - set item [string tolower [lindex $var $i]] - switch -- $item { - {} {CATTool} - - file - - import - - load { - incr i - set reader VOTRead - switch -- [lindex $var $i] { - xml - - vot {incr i; set reader VOTRead} - sb - - starbase {incr i; set reader starbase_read} - csv - - tsv {incr i; set reader TSVRead} - } - - set fn [lindex $var $i] - if {$fn != {}} { - CATDialog cattool {} {} {} none - CATLoadFn [lindex $icat(cats) end] $fn $reader - FileLast catfbox $fn - } - } - - allcols - - allrows - - cancel - - clear - - close - - coordinate - - crosshair - - dec - - edit - - export - - filter - - header - - hide - - location - - match - - maxrows - - name - - panto - - plot - - print - - psky - - psystem - - ra - - regions - - retrieve - - samp - - save - - server - - show - - size - - sky - - skyformat - - sort - - symbol - - system - - update - - x - - y {ProcessCatalog $varname $iname [lindex $icat(cats) end]} - - default { - # another command - if {[string range $item 0 0] == "-"} { - CATTool - incr i -1 - return - } - - # existing cat or load new one? - set ref $item - - # backward compatibility - if {[string range $ref 0 2] == {cat}} { - set ref [string range $ref 3 end] - } - - incr i - set item [string tolower [lindex $var $i]] - switch -- $item { - file - - import - - load {incr i -1} - - allcols - - allrows - - cancel - - clear - - close - - coordinate - - crosshair - - dec - - edit - - export - - filter - - header - - hide - - location - - match - - maxrows - - name - - panto - - plot - - print - - psky - - psystem - - ra - - regions - - retrieve - - samp - - save - - server - - show - - size - - sky - - skyformat - - sort - - symbol - - system - - update - - x - - y {ProcessCatalog $varname $iname cat${ref}} - - default { - # ok, new catalog - incr i -1 - set item [string tolower [lindex $var $i]] - - # backward compatibility - switch $item { - cds {incr i; set item [string tolower [lindex $var $i]]} - cxc {set item csc} - } - - # see if its from our list of cats - foreach mm $icat(def) { - set ll [lindex $mm 0] - set ww [lindex $mm 1] - set ss [lindex $mm 2] - set cc [lindex $mm 3] - - if {$ll != {-} && "cat${item}" == $ww} { - CATDialog $ww $ss $cc $ll sync - return - } - } - - # not a default, assume other name - CATDialog catcds cds $item $item sync - } - } - } - } -} -} - -proc ProcessCatalog {varname iname cvarname} { - upvar 2 $varname var - upvar 2 $iname i - - global icat - global pcat - global current - - # we should have a catalog now - global $cvarname - upvar #0 $cvarname cvar - - if {![info exists cvar(top)]} { - Error "[msgcat::mc {Unable to find catalog window}] $cvarname" - return - } - if {![winfo exists $cvar(top)]} { - Error "[msgcat:: mc {Unable to find catalog window}] $cvarname" - return - } - - # now, process it - set item [string tolower [lindex $var $i]] - switch -- $item { - allrows {set cvar(allrows) 1} - allcols {set cvar(allcols) 1} - cancel {ARCancel $cvarname} - clear {CATOff $cvarname} - close {CATDestroy $cvarname} - coordinate { - incr i - set cvar(x) [lindex $var $i] - incr i - set cvar(y) [lindex $var $i] - incr i - set cvar(sky) [lindex $var $i] - } - crosshair {CATCrosshair $cvarname} - edit { - incr i - set cvar(edit) [FromYesNo [lindex $var $i]] - CATEdit $cvarname - } - export - - save { - incr i - set writer VOTWrite - switch -- [lindex $var $i] { - xml - - vot {incr i; set writer VOTWrite} - sb - - starbase {incr i; set writer starbase_write} - csv - - tsv {incr i; set writer TSVWrite} - } + set ref [lindex $icat(cats) end] + global cvarname + set cvarname $ref - set fn [lindex $var $i] - CATSaveFn $cvarname $fn $writer - FileLast catfbox $fn - } - filter { - incr i - set item [lindex $var $i] - switch -- $item { - load { - incr i - set fn [lindex $var $i] - if {[catch {open $fn r} fp]} { - Error "[msgcat::mc {Unable to open file}] $fn: $fp" - return - } - set flt [read -nonewline $fp] - catch {regsub {\n} $flt " " $flt} - set cvar(filter) [string trim $flt] - catch {close $fp} - } - default { - set cvar(filter) $item - } - } - CATTable $cvarname - } - header {CATHeader $cvarname} - hide { - set cvar(show) 0 - CATGenerate $cvarname - } - location { - incr i - set cvar(loc) [lindex $var $i] - CATGenerate $cvarname - } - match { - incr i - set item [lindex $var $i] - switch -- $item { - error { - incr i - set icat(error) [lindex $var $i] - incr i - set icat(eformat) [lindex $var $i] - } - function {incr i; set icat(function) [lindex $var $i]} - unique {incr i; set icat(unique) [FromYesNo [lindex $var $i]]} - return {incr i; set icat(return) [lindex $var $i]} - default { - set icat(match1) {} - set icat(match2) {} - set m1 [lindex $var $i] - set m2 [lindex $var [expr $i+1]] - if {$m1 != {}} { - if {[string range $m1 0 0] != {-}} { - if {$m2 != {}} { - if {[string range $m2 0 0] != {-}} { - incr i - set icat(match1) "cat$m1" - set icat(match2) "cat$m2" - CATMatch $current(frame) \ - $icat(match1) $icat(match2) - return - } - } else { - # error - return - } - } - } - incr i -1 - # find them - set ll [llength $icat(cats)] - if {$ll>1} { - set icat(match1) [lindex $icat(cats) [expr $ll-2]] - set icat(match2) [lindex $icat(cats) [expr $ll-1]] - CATMatch $current(frame) $icat(match1) $icat(match2) - } else { - # error - } - } - } - } - maxrows { - incr i - set cvar(max) [lindex $var $i] - } - name { - incr i - set cvar(name) [lindex $var $i] - } - panto { - incr i - set cvar(panto) [FromYesNo [lindex $var $i]] - } - plot { - incr i - set cvar(plot,x) [lindex $var $i] - incr i - set cvar(plot,y) [lindex $var $i] - set cvar(plot,xerr) {} - set cvar(plot,yerr) {} - set xerr [lindex $var [expr $i+1]] - set yerr [lindex $var [expr $i+2]] - if {$xerr != {}} { - if {[string range $xerr 0 0 ] != {-}} { - incr i - set cvar(plot,xerr) $xerr - if {$yerr != {}} { - if {[string range $yerr 0 0 ] != {-}} { - incr i - set cvar(plot,yerr) $yerr - } - } - } - } - CATPlotGenerate $cvarname - } - print {CATPrint $cvarname} - psky { - incr i - set cvar(psky) [lindex $var $i] - CATGenerate $cvarname - } - psystem { - incr i - set cvar(psystem) [lindex $var $i] - CATGenerate $cvarname - } - regions {CATGenerateRegions $cvarname} - retrieve {CATApply $cvarname 1} - samp { - global ds9 - global samp - incr i - switch -- [string tolower [lindex $var $i]] { - send { - incr i - set name [string tolower [lindex $var $i]] - if {[info exists samp]} { - foreach arg $samp(apps,votable) { - foreach {key val} $arg { - if {[string tolower $val] == $name} { - SAMPSendTableLoadVotable $key $cvarname - break - } - } - } - } else { - Error [msgcat::mc {SAMP: not connected}] - } - } - broadcast {SAMPSendTableLoadVotable {} $cvarname} - default { - SAMPSendTableLoadVotable {} $cvarname - incr i -1 - } - } - } - server { - incr i - set cvar(server) [lindex $var $i] - } - size { - incr i - set cvar(width) [lindex $var $i] - incr i - set cvar(height) [lindex $var $i] - incr i - set cvar(rformat) [lindex $var $i] - set cvar(rformat,msg) $cvar(rformat) - } - show { - set cvar(show) 1 - CATGenerate $cvarname - } - sky { - incr i - set cvar(sky) [lindex $var $i] - CoordMenuButtonCmd $cvarname system sky \ - [list CATWCSMenuUpdate $cvarname] - } - skyformat { - incr i - set cvar(skyformat) [lindex $var $i] - } - sort { - incr i - set cvar(sort) [lindex $var $i] - incr i - switch -- [lindex $var $i] { - incr { - set cvar(sort,dir) "-increasing" - } - decr { - set cvar(sort,dir) "-decreasing" - } - } - CATTable $cvarname - } - symbol { - global $cvar(symdb) - set row 1 - incr i - if {[string is integer [lindex $var $i]]} { - set row [lindex $var $i] - incr i - } - switch -- [lindex $var $i] { - add { - set row [expr [starbase_nrows $cvar(symdb)]+1] - starbase_rowins $cvar(symdb) $row - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) shape] $pcat(sym,shape) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) color] $pcat(sym,color) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) width] $pcat(sym,width) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) font] $pcat(sym,font) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontsize] \ - $pcat(sym,font,size) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontweight] \ - $pcat(sym,font,weight) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontslant] \ - $pcat(sym,font,slant) - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) units] $pcat(sym,units) - CATGenerate $cvarname - } - angle { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) angle] [lindex $var $i] - CATGenerate $cvarname - } - color { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) color] [lindex $var $i] - CATGenerate $cvarname - } - condition { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) condition] \ - [lindex $var $i] - CATGenerate $cvarname - } - font { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) font] [lindex $var $i] - CATGenerate $cvarname - } - fontsize { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontsize] [lindex $var $i] - CATGenerate $cvarname - } - fontweight { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontweight] \ - [lindex $var $i] - CATGenerate $cvarname - } - fontslant { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) fontslant] \ - [lindex $var $i] - CATGenerate $cvarname - } - load { - incr i - set fn [lindex $var $i] - if {[file exists $fn]} { - starbase_read $cvar(symdb) $fn - CATGenerate $cvarname - } else { - Error "[msgcat::mc {Unable to open file}] $fn" - return - } - } - remove { - starbase_rowdel $cvar(symdb) $row - CATGenerate $cvarname - } - save { - incr i - starbase_write $cvar(symdb) [lindex $var $i] - } - size { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) size] [lindex $var $i] - CATGenerate $cvarname - } - size2 { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) size2] [lindex $var $i] - CATGenerate $cvarname - } - shape { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) shape] [lindex $var $i] - CATGenerate $cvarname - } - text { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) text] [lindex $var $i] - CATGenerate $cvarname - } - units { - incr i - starbase_set $cvar(symdb) $row \ - [starbase_colnum $cvar(symdb) units] [lindex $var $i] - CATGenerate $cvarname - } - } - } - system { - incr i - set cvar(system) [lindex $var $i] - CoordMenuButtonCmd $cvarname system sky \ - [list CATWCSMenuUpdate $cvarname] - } - update {CATUpdate $cvarname} - x - - ra { - incr i - set cvar(colx) [lindex $var $i] - CATGenerate $cvarname - } - y - - dec { - incr i - set cvar(coly) [lindex $var $i] - CATGenerate $cvarname - } - } + cat::YY_FLUSH_BUFFER + cat::yy_scan_string [lrange $var $i end] + cat::yyparse + incr i [expr $cat::yycnt-1] } proc CatalogCmdCheck {} { diff --git a/ds9/library/debug.tcl b/ds9/library/debug.tcl index 3706199..4ee3892 100644 --- a/ds9/library/debug.tcl +++ b/ds9/library/debug.tcl @@ -23,7 +23,6 @@ proc DebugDef {} { set debug(tcl,http) 0 set debug(tcl,ftp) 0 set debug(tcl,xpa) 0 - set debug(tcl,parser) 1 set debug(tcl,image) 0 set debug(tksao,ast) 0 @@ -98,8 +97,6 @@ proc DebugMenu {} { -variable debug(tcl,ftp) $ds9(mb).debug.tcl add checkbutton -label {XPA} \ -variable debug(tcl,xpa) - $ds9(mb).debug.tcl add checkbutton -label {TclParser} \ - -variable debug(tcl,parser) $ds9(mb).debug.tcl add checkbutton -label {IMAGE} \ -variable debug(tcl,image) @@ -196,10 +193,6 @@ proc ProcessDebugTclCmd {varname iname} { http {set debug(tcl,http) 1} ftp {set debug(tcl,ftp) 1} xpa {set debug(tcl,xpa) 1} - tclparser { - incr i - set debug(tcl,parser) [FromYesNo [lindex $var $i]] - } image { set debug(tcl,hv) 1 set debug(tcl,http) 1 diff --git a/ds9/library/envi.tcl b/ds9/library/envi.tcl index 43459b6..1f3d755 100644 --- a/ds9/library/envi.tcl +++ b/ds9/library/envi.tcl @@ -35,37 +35,10 @@ proc ProcessENVICmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { envi::YY_FLUSH_BUFFER envi::yy_scan_string [lrange $var $i end] envi::yyparse incr i [expr $envi::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - - set fn [lindex $var $i] - set fn2 [lindex $var [expr $i+1]] - if {$fn2 == {}} { - set fn2 [FindENVIDataFile $fn] - } - ImportENVIFile $fn $fn2 - FinishLoad -} } proc FindENVIDataFile {fn} { diff --git a/ds9/library/export.tcl b/ds9/library/export.tcl index eff40ea..0188f1e 100644 --- a/ds9/library/export.tcl +++ b/ds9/library/export.tcl @@ -36,144 +36,10 @@ proc ProcessExportCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { export::YY_FLUSH_BUFFER export::yy_scan_string [lrange $var $i end] export::yyparse incr i [expr $export::yycnt-1] - } else { - - set format {} - set fn [lindex $var $i] - set fn2 {} - if {$fn == {}} { - return - } - - switch -- $fn { - array - - rgbarray - - nrrd - - envi - - gif - - tiff - - jpeg - - png { - set format $fn - set fn {} - incr i - } - jpg { - set format jpeg - set fn {} - incr i - } - tif { - set format tiff - set fn {} - incr i - } - } - - # one last time - if {$fn == {}} { - set fn [lindex $var $i] - if {$fn == {}} { - return - } - } - - if {$format == {}} { - set format [ExtToFormat $fn] - } - - global export - set param [string tolower [lindex $var [expr $i+1]]] - switch $format { - array - - rgbarray - - nrrd { - switch $param { - native - - big - - bigendian - - little - - littleendian { - set export(endian) $param - incr i - } - } - } - envi { - switch $param { - {} {set fn2 "[file rootname $fn].bsq"} - native - - big - - bigendian - - little - - littleendian { - set fn2 "[file rootname $fn].bsq" - set export(endian) $param - incr i - } - default { - if {[string range $param 0 0] == {-}} { - set fn2 "[file rootname $fn].bsq" - } else { - set fn2 $param - incr i - set param [string tolower [lindex $var [expr $i+1]]] - switch $param { - native - - big - - bigendian - - little - - littleendian { - set export(endian) $param - incr i - } - } - } - } - } - } - gif {} - jpeg { - if {$param != {} && [string is integer $param]} { - set export(jpeg,quality) $param - incr i - } - } - tiff { - switch $param { - none - - jpeg - - packbits - - deflate { - set export(tiff,compress) $param - incr i - } - } - } - png {} - } - - switch -- $format { - array {FileLast arrayfbox $fn} - rgbarray {FileLast rgbarrayfbox $fn} - nrrd {FileLast nrrdfbox $fn} - envi { - FileLast envifbox $fn - FileLast envi2fbox $fn2 - } - gif {FileLast giffbox $fn} - jpeg {FileLast jpegfbox $fn} - tiff {FileLast tifffbox $fn} - png {FileLast pngfbox $fn} - } - Export $fn $format $fn2 -} } proc ExportCmdSet {which value {cmd {}}} { diff --git a/ds9/library/fits.tcl b/ds9/library/fits.tcl index 36548cd..86f02a3 100644 --- a/ds9/library/fits.tcl +++ b/ds9/library/fits.tcl @@ -107,52 +107,14 @@ proc ProcessFitsCmd {varname iname sock fn} { return } - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - fits::YY_FLUSH_BUFFER - fits::yy_scan_string [lrange $var $i end] - fits::yyparse - incr i [expr $fits::yycnt-1] - } else { - - set layer {} - set mode {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - set mode slice - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadFitsSocket $sock $param $layer $mode]} { - InitError xpa - LoadFitsFile $param $layer $mode - } - } else { - # comm - if {$fn != {}} { - LoadFitsAlloc $fn $param $layer $mode - } else { - LoadFitsFile $param $layer $mode - } - } - FinishLoad -} + fits::YY_FLUSH_BUFFER + fits::yy_scan_string [lrange $var $i end] + fits::yyparse + incr i [expr $fits::yycnt-1] } proc FitsCmdLoad {param layer mode} { diff --git a/ds9/library/frame.tcl b/ds9/library/frame.tcl index 2d13398..2bbbe91 100644 --- a/ds9/library/frame.tcl +++ b/ds9/library/frame.tcl @@ -2056,167 +2056,10 @@ proc ProcessFrameCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - frame::YY_FLUSH_BUFFER - frame::yy_scan_string [lrange $var $i end] - frame::yyparse - incr i [expr $frame::yycnt-1] - } else { - - global current - global active - global panzoom - - catch { - switch -- [string tolower [lindex $var $i]] { - match { - incr i - MatchFrameCurrent [lindex $var $i] - } - lock { - incr i - set panzoom(lock) [lindex $var $i] - LockFrameCurrent - } - center { - incr i - switch -- [lindex $var $i] { - all {CenterAllFrame} - {} {CenterCurrentFrame; incr i -1} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - CenterFrame $f - } else { - CenterCurrentFrame; incr i -1 - } - } - } - } - clear { - incr i - switch -- [lindex $var $i] { - all {ClearAllFrame} - {} {ClearCurrentFrame; incr i -1} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - ClearFrame $f - } else { - ClearCurrentFrame; incr i -1 - } - } - } - } - delete { - incr i - switch -- [lindex $var $i] { - all {DeleteAllFrames} - {} {DeleteCurrentFrame; incr i -1} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - DeleteSingleFrame $f - } else { - DeleteCurrentFrame; incr i -1 - } - } - } - } - new { - incr i - switch -- [lindex $var $i] { - rgb {CreateRGBFrame} - 3d {Create3DFrame} - default {CreateFrame; incr i -1} - } - } - reset { - incr i - switch -- [lindex $var $i] { - all {ResetAllFrame} - {} {ResetCurrentFrame; incr i -1} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - ResetFrame $f - } else { - ResetCurrentFrame; incr i -1 - } - } - } - } - refresh { - incr i - switch -- [lindex $var $i] { - all {UpdateAllFrame} - {} {UpdateCurrentFrame; incr i -1} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - UpdateFrame $f - } else { - UpdateCurrentFrame; incr i -1 - } - } - } - } - hide { - incr i - switch -- [lindex $var $i] { - all {ActiveFrameNone} - {} { - set active($current(frame)) 0 - UpdateActiveFrames - incr i -1 - } - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - set active($f) 0 - UpdateActiveFrames - } else { - set active($current(frame)) 0 - UpdateActiveFrames - incr i -1 - } - } - } - } - show { - incr i - switch -- [lindex $var $i] { - all {ActiveFrameAll} - default { - if {[string is integer [lindex $var $i]]} { - set f "Frame[lindex $var $i]" - set active($f) 1 - UpdateActiveFrames - } else { - incr i -1 - } - } - } - } - move { - incr i - switch -- [lindex $var $i] { - first {MoveFirstFrame} - back {MovePrevFrame} - forward {MoveNextFrame} - last {MoveLastFrame} - } - } - first {FirstFrame} - prev {PrevFrame} - next {NextFrame} - last {LastFrame} - frameno {incr i; CreateGotoFrame [lindex $var $i] base} - default {CreateGotoFrame [lindex $var $i] base} - } - } -} + frame::YY_FLUSH_BUFFER + frame::yy_scan_string [lrange $var $i end] + frame::yyparse + incr i [expr $frame::yycnt-1] } proc ActiveCmdSet {which value {cmd {}}} { @@ -2337,81 +2180,10 @@ proc ProcessTileCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - tile::YY_FLUSH_BUFFER - tile::yy_scan_string [lrange $var $i end] - tile::yyparse - incr i [expr $tile::yycnt-1] - } else { - - global current - global tile - - switch -- [string tolower [lindex $var $i]] { - mode { - incr i - set tile(mode) [lindex $var $i] - } - grid { - incr i - switch -- [string tolower [lindex $var $i]] { - mode { - incr i - set tile(grid,mode) [lindex $var $i] - } - direction { - incr i - set tile(grid,dir) [lindex $var $i] - } - layout { - incr i - set tile(grid,col) [lindex $var $i] - incr i - set tile(grid,row) [lindex $var $i] - set tile(grid,mode) {manual} - } - gap { - incr i - set tile(grid,gap) [lindex $var $i] - } - default { - if {[string range [lindex $var $i] 0 0] != {-}} { - set tile(mode) grid - } else { - incr i -1 - } - } - } - } - column { - set tile(mode) column - } - row { - set tile(mode) row - } - - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - if {[FromYesNo [lindex $var $i]]} { - set current(display) tile - } else { - set current(display) single - } - } - default { - set current(display) tile - incr i -1 - } - } - DisplayMode -} + tile::YY_FLUSH_BUFFER + tile::yy_scan_string [lrange $var $i end] + tile::yyparse + incr i [expr $tile::yycnt-1] } proc TileCmdSet {which value {cmd {}}} { @@ -2451,43 +2223,10 @@ proc ProcessBlinkCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - blink::YY_FLUSH_BUFFER - blink::yy_scan_string [lrange $var $i end] - blink::yyparse - incr i [expr $blink::yycnt-1] - } else { - - global current - global blink - - switch -- [string tolower [lindex $var $i]] { - interval { - incr i - set blink(interval) [expr int([lindex $var $i]*1000)] - } - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - if {[FromYesNo [lindex $var $i]]} { - set current(display) blink - } else { - set current(display) single - } - } - default { - set current(display) blink - incr i -1 - } - } - DisplayMode -} + blink::YY_FLUSH_BUFFER + blink::yy_scan_string [lrange $var $i end] + blink::yyparse + incr i [expr $blink::yycnt-1] } proc BlinkCmdSet {which value {cmd {}}} { @@ -2519,154 +2258,13 @@ proc ProcessLockCmd {varname iname} { upvar $varname var upvar $iname i - global panzoom - global crop - global crosshair - global cube - global ime - global bin - global scale - global colorbar - global block - global smooth - global threed - # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - lock::YY_FLUSH_BUFFER - lock::yy_scan_string [lrange $var $i end] - lock::yyparse - incr i [expr $lock::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - frame - - frames { - incr i - set panzoom(lock) [lindex $var $i] - LockFrameCurrent - } - crosshair - - crosshairs { - incr i - set crosshair(lock) [lindex $var $i] - LockCrosshairCurrent - } - crop { - incr i - set crop(lock) [lindex $var $i] - LockCropCurrent - } - slice - - cube - - datacube { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - switch -- [lindex $var $i] { - {} - - yes - - 1 {set cube(lock) image} - no - - 0 {set cube(lock) none} - default {set cube(lock) [lindex $var $i]} - } - } else { - set cube(lock) image - incr i -1 - } - LockCubeCurrent - } - bin { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set bin(lock) [FromYesNo [lindex $var $i]] - } else { - set bin(lock) 1 - incr i -1 - } - LockBinCurrent - } - axes - - order { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set cube(lock,axes) [FromYesNo [lindex $var $i]] - } else { - set cube(lock,axes) 1 - incr i -1 - } - LockAxesCurrent - } - scale - - scales { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set scale(lock) [FromYesNo [lindex $var $i]] - } else { - set scale(lock) 1 - incr i -1 - } - LockScaleCurrent - } - limits - - scalelimits { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set scale(lock,limits) [FromYesNo [lindex $var $i]] - } else { - set scale(lock,limits) 1 - incr i -1 - } - LockScaleLimitsCurrent - } - color - - colormap - - colorbar - - colorbars { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set colorbar(lock) [FromYesNo [lindex $var $i]] - } else { - set colorbar(lock) 1 - incr i -1 - } - LockColorCurrent - } - block { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set block(lock) [FromYesNo [lindex $var $i]] - } else { - set block(lock) 1 - incr i -1 - } - LockBlockCurrent - } - smooth { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set smooth(lock) [FromYesNo [lindex $var $i]] - } else { - set smooth(lock) 1 - incr i -1 - } - LockSmoothCurrent - } - 3d { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set threed(lock) [FromYesNo [lindex $var $i]] - } else { - set threed(lock) 1 - incr i -1 - } - Lock3DCurrent - } - } -} + lock::YY_FLUSH_BUFFER + lock::yy_scan_string [lrange $var $i end] + lock::yyparse + incr i [expr $lock::yycnt-1] } proc ProcessSendLockCmd {proc id param} { @@ -2717,57 +2315,8 @@ proc ProcessMatchCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - match::YY_FLUSH_BUFFER - match::yy_scan_string [lrange $var $i end] - match::yyparse - incr i [expr $match::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - frame - - frames { - incr i - MatchFrameCurrent [lindex $var $i] - } - crosshair - - crosshairs { - incr i - MatchCrosshairCurrent [lindex $var $i] - } - crop { - incr i - MatchCropCurrent [lindex $var $i] - } - slice - - cube - - datacube { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - switch -- [lindex $var $i] { - {} {MatchCubeCurrent image} - default {MatchCubeCurrent [lindex $var $i]} - } - } else { - MatchCubeCurrent image - incr i -1 - } - } - bin {MatchBinCurrent} - axes - - order {MatchAxesCurrent} - scale - - scales {MatchScaleCurrent} - limits - - scalelimits {MatchScaleLimitsCurrent} - color - - colormap - - colorbar - - colorbars {MatchColorCurrent} - block {MatchBlockCurrent} - smooth {MatchSmoothCurrent} - 3d {Match3DCurrent} - } -} + match::YY_FLUSH_BUFFER + match::yy_scan_string [lrange $var $i end] + match::yyparse + incr i [expr $match::yycnt-1] } diff --git a/ds9/library/iis.tcl b/ds9/library/iis.tcl index 54b6ed6..1cda226 100644 --- a/ds9/library/iis.tcl +++ b/ds9/library/iis.tcl @@ -362,32 +362,10 @@ proc ProcessIISCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - iis::YY_FLUSH_BUFFER - iis::yy_scan_string [lrange $var $i end] - iis::yyparse - incr i [expr $iis::yycnt-1] - } else { - - global current - switch -- [string tolower [lindex $var $i]] { - filename { - if {[string is integer [lindex $var [expr $i+2]]]} { - if {$current(frame) != {}} { - $current(frame) iis set file name \ - [lindex $var [expr $i+1]] [lindex $var [expr $i+2]] - } - incr i 2 - } else { - if {$current(frame) != {}} { - $current(frame) iis set file name [lindex $var [expr $i+1]] - } - incr i - } - } - } -} + iis::YY_FLUSH_BUFFER + iis::yy_scan_string [lrange $var $i end] + iis::yyparse + incr i [expr $iis::yycnt-1] } proc IISCmd {filename {which {}}} { diff --git a/ds9/library/layout.tcl b/ds9/library/layout.tcl index f026b52..99661c7 100644 --- a/ds9/library/layout.tcl +++ b/ds9/library/layout.tcl @@ -827,18 +827,10 @@ proc ProcessHeightCmd {varname iname} { # can't use ProcessRealize RealizeDS9 - global debug - if {$debug(tcl,parser)} { - height::YY_FLUSH_BUFFER - height::yy_scan_string [lrange $var $i end] - height::yyparse - incr i [expr $height::yycnt-1] - } else { - - global canvas - set canvas(height) [lindex $var $i] - UpdateView -} + height::YY_FLUSH_BUFFER + height::yy_scan_string [lrange $var $i end] + height::yyparse + incr i [expr $height::yycnt-1] } proc ProcessSendHeightCmd {proc id param} { @@ -854,18 +846,10 @@ proc ProcessWidthCmd {varname iname} { # can't use ProcessRealize RealizeDS9 - global debug - if {$debug(tcl,parser)} { - width::YY_FLUSH_BUFFER - width::yy_scan_string [lrange $var $i end] - width::yyparse - incr i [expr $width::yycnt-1] - } else { - - global canvas - set canvas(width) [lindex $var $i] - UpdateView -} + width::YY_FLUSH_BUFFER + width::yy_scan_string [lrange $var $i end] + width::yyparse + incr i [expr $width::yycnt-1] } proc ProcessSendWidthCmd {proc id param} { @@ -877,180 +861,10 @@ proc ProcessViewCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - view::YY_FLUSH_BUFFER - view::yy_scan_string [lrange $var $i end] - view::yyparse - incr i [expr $view::yycnt-1] - } else { - - global view - global rgb - - set item [string tolower [lindex $var $i]] - - switch -- $item { - layout { - incr i - set item [string tolower [lindex $var $i]] - switch -- $item { - horz - - horizontal { - set view(layout) horizontal - ViewHorzCmd - } - vert - - vertical { - set view(layout) verical - ViewVertCmd - } - } - } - keyvalue { - incr i - set view(info,keyvalue) [lindex $var $i] - } - horz - - horizontal { - # backward compatibility - set view(layout) horizontal - ViewHorzCmd - } - vert - - vertical { - # backward compatibility - set view(layout) vertical - ViewVertCmd - } - - default { - set yesno [lindex $var [expr $i+1]] - switch -- $yesno { - 1 - - 0 - - yes - - no - - on - - off - - true - - false {incr i} - default { - set yesno 1 - } - } - - switch -- $item { - info - - panner - - magnifier - - buttons - - colorbar {set view($item) [FromYesNo $yesno]} - - colorbarnumerics { - # backward compatibility - set colorbar(numerics) [FromYesNo $yesno] - } - graph { - incr i - set item [string tolower [lindex $var $i]] - switch -- $item { - horz - - horizontal { - set yesno [lindex $var [expr $i+1]] - switch -- $yesno { - 1 - - 0 - - yes - - no - - on - - off - - true - - false {incr i} - default { - set yesno 1 - } - } - set view(graph,horz) [FromYesNo $yesno] - } - vert - - vertical { - set yesno [lindex $var [expr $i+1]] - switch -- $yesno { - 1 - - 0 - - yes - - no - - on - - off - - true - - false {incr i} - default { - set yesno 1 - } - } - set view(graph,vert) [FromYesNo $yesno] - } - } - } - horzgraph { - # backward compatibility - set view(graph,horz) [FromYesNo $yesno] - } - vertgraph { - # backward compatibility - set view(graph,vert) [FromYesNo $yesno] - } - - filename - - object - - keyword - - minmax - - lowhigh - - units - - - detector - - amplifier - - physical - - image - - wcs - - wcsa - - wcsb - - wcsc - - wcsd - - wcse - - wcsf - - wcsg - - wcsh - - wcsi - - wcsj - - wcsk - - wcsl - - wcsm - - wcsn - - wcso - - wcsp - - wcsq - - wcsr - - wcss - - wcst - - wcsu - - wcsv - - wcsw - - wcsx - - wcsy - - wcsz - - - frame {set view(info,$item) [FromYesNo $yesno]} - - red - - green - - blue {set rgb($item) [FromYesNo $yesno]; RGBView} - } - UpdateView - } - } -} + view::YY_FLUSH_BUFFER + view::yy_scan_string [lrange $var $i end] + view::yyparse + incr i [expr $view::yycnt-1] } proc ViewCmdSet {which value {cmd {}}} { diff --git a/ds9/library/load.tcl b/ds9/library/load.tcl index cc10f10..dd49c0f 100644 --- a/ds9/library/load.tcl +++ b/ds9/library/load.tcl @@ -414,33 +414,10 @@ proc ProcessPreserveCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - preserve::YY_FLUSH_BUFFER - preserve::yy_scan_string [lrange $var $i end] - preserve::yyparse - incr i [expr $preserve::yycnt-1] - } else { - - global ds9 - global scale - global panzoom - global marker - - switch -- [string tolower [lindex $var $i]] { - pan { - incr i - set panzoom(preserve) [FromYesNo [lindex $var $i]] - PreservePan - } - marker - - regions { - incr i - set marker(preserve) [FromYesNo [lindex $var $i]] - MarkerPreserve - } - } -} + preserve::YY_FLUSH_BUFFER + preserve::yy_scan_string [lrange $var $i end] + preserve::yyparse + incr i [expr $preserve::yycnt-1] } proc ProcessSendPreserveCmd {proc id param} { @@ -464,60 +441,10 @@ proc ProcessUpdateCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - update::YY_FLUSH_BUFFER - update::yy_scan_string [lrange $var $i end] - update::yyparse - incr i [expr $update::yycnt-1] - } else { - - global current - global ds9 - - if {$current(frame) == {}} { - return - } - - if {[lindex $var $i] != {} && [string range [lindex $var $i] 0 0] != {-}} { - switch -- [string tolower [lindex $var $i]] { - on - - yes - - no - - off { - # backward compatibility - } - - now { - if {[string is integer [lindex $var [expr $i+1]]]} { - $current(frame) update now \ - [lindex $var [expr $i+1]] \ - [lindex $var [expr $i+2]] [lindex $var [expr $i+3]] \ - [lindex $var [expr $i+4]] [lindex $var [expr $i+5]] - - incr i 5 - } else { - $current(frame) update now - } - } - {} { - $current(frame) update - incr i -1 - } - - default { - $current(frame) update \ - [lindex $var $i] \ - [lindex $var [expr $i+1]] [lindex $var [expr $i+2]] \ - [lindex $var [expr $i+3]] [lindex $var [expr $i+4]] - incr i 4 - } - } - } else { - $current(frame) update - incr i -1 - } -} + update::YY_FLUSH_BUFFER + update::yy_scan_string [lrange $var $i end] + update::yyparse + incr i [expr $update::yycnt-1] } proc UpdateCmd {{which {}} {x1 {}} {y1 {}} {x2 {}} {y2 {}}} { diff --git a/ds9/library/magnifier.tcl b/ds9/library/magnifier.tcl index 25fa9ed..80379d8 100644 --- a/ds9/library/magnifier.tcl +++ b/ds9/library/magnifier.tcl @@ -140,46 +140,10 @@ proc ProcessMagnifierCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - magnifier::YY_FLUSH_BUFFER - magnifier::yy_scan_string [lrange $var $i end] - magnifier::yyparse - incr i [expr $magnifier::yycnt-1] - } else { - - global pmagnifier - global view - - switch -- [string tolower [lindex $var $i]] { - color { - incr i - set pmagnifier(color) [lindex $var $i] - MagnifierColor - } - zoom { - incr i - set pmagnifier(zoom) [lindex $var $i] - MagnifierZoom - } - cursor { - incr i - set pmagnifier(cursor) [FromYesNo [lindex $var $i]] - MagnifierCursor - } - region { - incr i - set pmagnifier(region) [FromYesNo [lindex $var $i]] - MagnifierRegion - } - default { - # backward compatibility - set view(magnifier) 1 - UpdateView - incr i -1 - } - } -} + magnifier::YY_FLUSH_BUFFER + magnifier::yy_scan_string [lrange $var $i end] + magnifier::yyparse + incr i [expr $magnifier::yycnt-1] } proc PmagnifierCmdSet {which value {cmd {}}} { diff --git a/ds9/library/mecube.tcl b/ds9/library/mecube.tcl index 426ca81..a052ab9 100644 --- a/ds9/library/mecube.tcl +++ b/ds9/library/mecube.tcl @@ -81,50 +81,14 @@ proc ProcessMECubeCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mecube::YY_FLUSH_BUFFER - mecube::yy_scan_string [lrange $var $i end] - mecube::yyparse - incr i [expr $mecube::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMECubeSocket $sock $param]} { - InitError xpa - LoadMECubeFile $param - } - } else { - # comm - if {$fn != {}} { - LoadMECubeAlloc $fn $param - } else { - LoadMECubeFile $param - } - } - FinishLoad -} + mecube::YY_FLUSH_BUFFER + mecube::yy_scan_string [lrange $var $i end] + mecube::yyparse + incr i [expr $mecube::yycnt-1] } proc MECubeCmdLoad {param} { diff --git a/ds9/library/mosaicimageiraf.tcl b/ds9/library/mosaicimageiraf.tcl index f12db74..c6deea7 100644 --- a/ds9/library/mosaicimageiraf.tcl +++ b/ds9/library/mosaicimageiraf.tcl @@ -47,51 +47,14 @@ proc ProcessMosaicImageIRAFCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mosaicimageiraf::YY_FLUSH_BUFFER - mosaicimageiraf::yy_scan_string [lrange $var $i end] - mosaicimageiraf::yyparse - incr i [expr $mosaicimageiraf::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMosaicImageIRAFSocket $sock $param $layer]} { - InitError xpa - LoadMosaicImageIRAFFile $param $layer - } - } else { - # comm - if {$fn != {}} { - LoadMosaicImageIRAFAlloc $fn $param $layer - } else { - LoadMosaicImageIRAFFile $param $layer - } - } - FinishLoad -} + mosaicimageiraf::YY_FLUSH_BUFFER + mosaicimageiraf::yy_scan_string [lrange $var $i end] + mosaicimageiraf::yyparse + incr i [expr $mosaicimageiraf::yycnt-1] } proc MosaicImageIRAFCmdLoad {param layer} { diff --git a/ds9/library/mosaicimagewcs.tcl b/ds9/library/mosaicimagewcs.tcl index e6b4a19..a543fa8 100644 --- a/ds9/library/mosaicimagewcs.tcl +++ b/ds9/library/mosaicimagewcs.tcl @@ -75,58 +75,14 @@ proc ProcessMosaicImageWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mosaicimagewcs::YY_FLUSH_BUFFER - mosaicimagewcs::yy_scan_string [lrange $var $i end] - mosaicimagewcs::yyparse - incr i [expr $mosaicimagewcs::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - - if {[string range [lindex $var $i] 0 2] == {wcs}} { - set opt [lindex $var $i] - incr i - } else { - set opt wcs - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMosaicImageWCSSocket $sock $param $layer $opt]} { - InitError xpa - LoadMosaicImageWCSFile $param $layer $opt - } - } else { - # comm - if {$fn != {}} { - LoadMosaicImageWCSAlloc $fn $param $layer $opt - } else { - LoadMosaicImageWCSFile $param $layer $opt - } - } - FinishLoad -} + mosaicimagewcs::YY_FLUSH_BUFFER + mosaicimagewcs::yy_scan_string [lrange $var $i end] + mosaicimagewcs::yyparse + incr i [expr $mosaicimagewcs::yycnt-1] } proc MosaicImageWCSCmdLoad {param layer sys} { diff --git a/ds9/library/mosaicimagewfpc2.tcl b/ds9/library/mosaicimagewfpc2.tcl index ac59f98..fcedc97 100644 --- a/ds9/library/mosaicimagewfpc2.tcl +++ b/ds9/library/mosaicimagewfpc2.tcl @@ -53,50 +53,14 @@ proc ProcessMosaicImageWFPC2Cmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mosaicimagewfpc2::YY_FLUSH_BUFFER - mosaicimagewfpc2::yy_scan_string [lrange $var $i end] - mosaicimagewfpc2::yyparse - incr i [expr $mosaicimagewfpc2::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMosaicImageWFPC2Socket $sock $param]} { - InitError xpa - LoadMosaicImageWFPC2File $param - } - } else { - # comm - if {$fn != {}} { - LoadMosaicImageWFPC2Alloc $fn $param - } else { - LoadMosaicImageWFPC2File $param - } - } - FinishLoad -} + mosaicimagewfpc2::YY_FLUSH_BUFFER + mosaicimagewfpc2::yy_scan_string [lrange $var $i end] + mosaicimagewfpc2::yyparse + incr i [expr $mosaicimagewfpc2::yycnt-1] } proc MosaicImageWFPC2CmdLoad {param} { diff --git a/ds9/library/mosaiciraf.tcl b/ds9/library/mosaiciraf.tcl index c2a3656..d091fad 100644 --- a/ds9/library/mosaiciraf.tcl +++ b/ds9/library/mosaiciraf.tcl @@ -47,51 +47,14 @@ proc ProcessMosaicIRAFCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mosaiciraf::YY_FLUSH_BUFFER - mosaiciraf::yy_scan_string [lrange $var $i end] - mosaiciraf::yyparse - incr i [expr $mosaiciraf::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMosaicIRAFSocket $sock $param $layer]} { - InitError xpa - LoadMosaicIRAFFile $param $layer - } - } else { - # comm - if {$fn != {}} { - LoadMosaicIRAFAlloc $fn $param $layer - } else { - LoadMosaicIRAFFile $param $layer - } - } - FinishLoad -} + mosaiciraf::YY_FLUSH_BUFFER + mosaiciraf::yy_scan_string [lrange $var $i end] + mosaiciraf::yyparse + incr i [expr $mosaiciraf::yycnt-1] } proc MosaicIRAFCmdLoad {param layer} { diff --git a/ds9/library/mosaicwcs.tcl b/ds9/library/mosaicwcs.tcl index 65e16b0..d46b6dc 100644 --- a/ds9/library/mosaicwcs.tcl +++ b/ds9/library/mosaicwcs.tcl @@ -83,58 +83,14 @@ proc ProcessMosaicWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - mosaicwcs::YY_FLUSH_BUFFER - mosaicwcs::yy_scan_string [lrange $var $i end] - mosaicwcs::yyparse - incr i [expr $mosaicwcs::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - - if {[string range [lindex $var $i] 0 2] == {wcs}} { - set opt [lindex $var $i] - incr i - } else { - set opt wcs - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadMosaicWCSSocket $sock $param $layer $opt]} { - InitError xpa - LoadMosaicWCSFile $param $layer $opt - } - } else { - # comm - if {$fn != {}} { - LoadMosaicWCSAlloc $fn $param $layer $opt - } else { - LoadMosaicWCSFile $param $layer $opt - } - } - FinishLoad -} + mosaicwcs::YY_FLUSH_BUFFER + mosaicwcs::yy_scan_string [lrange $var $i end] + mosaicwcs::yyparse + incr i [expr $mosaicwcs::yycnt-1] } proc MosaicWCSCmdLoad {param layer sys} { diff --git a/ds9/library/movie.tcl b/ds9/library/movie.tcl index a6d33c0..55d55e7 100644 --- a/ds9/library/movie.tcl +++ b/ds9/library/movie.tcl @@ -460,83 +460,10 @@ proc ProcessMovieCmd {varname iname} { # already implemented # ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - movie::YY_FLUSH_BUFFER - movie::yy_scan_string [lrange $var $i end] - movie::yyparse - incr i [expr $movie::yycnt-1] - } else { - - global movie - set item [string tolower [lindex $var $i]] - switch -- $item { - slice - - frame - - 3d { - set movie(action) $item - incr i - } - default { - # backward compatibility - set movie(action) frame - } - } - - set fn [lindex $var $i] - - set go 1 - while {$go} { - incr i - set item [string tolower [lindex $var $i]] - switch -- $item { - number { - incr i - set movie(num) [lindex $var $i] - } - azfrom { - incr i - set movie(az,from) [lindex $var $i] - } - azto { - incr i - set movie(az,to) [lindex $var $i] - } - elfrom { - incr i - set movie(el,from) [lindex $var $i] - } - elto { - incr i - set movie(el,to) [lindex $var $i] - } - slfrom { - incr i - set movie(sl,from) [lindex $var $i] - } - slto { - incr i - set movie(sl,to) [lindex $var $i] - } - oscillate { - incr i - set movie(repeat) oscillate - set movie(repeat,num) [lindex $var $i] - } - repeat { - incr i - set movie(repeat) repeat - set movie(repeat,num) [lindex $var $i] - } - default { - incr i -1 - set go 0 - } - } - } - - Movie $fn -} + movie::YY_FLUSH_BUFFER + movie::yy_scan_string [lrange $var $i end] + movie::yyparse + incr i [expr $movie::yycnt-1] } proc MovieCmdSet {which value {cmd {}}} { diff --git a/ds9/library/multiframe.tcl b/ds9/library/multiframe.tcl index cc5a9bc..9f2318c 100644 --- a/ds9/library/multiframe.tcl +++ b/ds9/library/multiframe.tcl @@ -136,58 +136,14 @@ proc ProcessMultiFrameCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - multiframe::YY_FLUSH_BUFFER - multiframe::yy_scan_string [lrange $var $i end] - multiframe::yyparse - incr i [expr $multiframe::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - # not supported - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - global tcl_platform - switch $tcl_platform(os) { - Linux - - Darwin - - SunOS { - if {![LoadMultiFrameSocket $sock $param]} { - InitError xpa - LoadMultiFrameFile $param - } - } - {Windows NT} {LoadMultiFrameFile $param} - } - } else { - # comm - if {$fn != {}} { - LoadMultiFrameAlloc $fn $param - } else { - LoadMultiFrameFile $param - } - } - FinishLoad -} + multiframe::YY_FLUSH_BUFFER + multiframe::yy_scan_string [lrange $var $i end] + multiframe::yyparse + incr i [expr $multiframe::yycnt-1] } proc MultiframeCmdLoad {param} { diff --git a/ds9/library/pagesetup.tcl b/ds9/library/pagesetup.tcl index e88982a..3c03050 100644 --- a/ds9/library/pagesetup.tcl +++ b/ds9/library/pagesetup.tcl @@ -181,25 +181,10 @@ proc ProcessPSPageSetupCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - pagesetup::YY_FLUSH_BUFFER - pagesetup::yy_scan_string [lrange $var $i end] - pagesetup::yyparse - incr i [expr $pagesetup::yycnt-1] - } else { - - global ps - - switch -- [string tolower [lindex $var $i]] { - orientation - - orient {incr i; set ps(orient) [string tolower [lindex $var $i]]} - pagescale - - scale {incr i; set ps(scale) [lindex $var $i]} - pagesize - - size {incr i; set ps(size) [string tolower [lindex $var $i]] } - } -} + pagesetup::YY_FLUSH_BUFFER + pagesetup::yy_scan_string [lrange $var $i end] + pagesetup::yyparse + incr i [expr $pagesetup::yycnt-1] } proc ProcessSendPSPageSetupCmd {proc id param} { diff --git a/ds9/library/plotprocess.tcl b/ds9/library/plotprocess.tcl index c62f767..410520a 100644 --- a/ds9/library/plotprocess.tcl +++ b/ds9/library/plotprocess.tcl @@ -104,446 +104,18 @@ proc ProcessPlotCmd {xarname iname buf fn} { upvar $iname i global iap - global debug - if {$debug(tcl,parser)} { - set ref [lindex $iap(windows) end] - global cvarname - set cvarname $ref - global parse - set parse(buf) $buf - set parse(fn) $fn - set parse(tt) $iap(tt) - - plot::YY_FLUSH_BUFFER - plot::yy_scan_string [lrange $xar $i end] - plot::yyparse - incr i [expr $plot::yycnt-1] - } else { - - set varname $iap(tt) - set id 0 - - # check for next command line option - if {[string range [lindex $xar $i] 0 0] != {-}} { - - # determine which plot - switch -- [string tolower [lindex $xar $i]] { - {} - - bar - - scatter - - new {} - - data - - load - - save - - clear - - dup - - duplicate - - stats - - statistics - - list - - loadconfig - - saveconfig - - page - - pagesetup - - print - - close - - - mode - - axis - - legend - - font - - title - - show - - color - - fill - - fillcolor - - error - - errorbar - - barmode - - name - - shape - - relief - - smooth - - width - - dash - - dataset - - select - - - graph - - line - - view { - set varname [lindex $iap(windows) end] - set id [lsearch $iap(windows) $varname] - } - - default { - set varname [lindex $xar $i] - set id [lsearch $iap(windows) $varname] - incr i - } - } - } - - # we better have a tt by now - if {$id == -1} { - Error "[msgcat::mc {Unable to find plot window}] $varname" - return - } - - upvar #0 $varname var - global $varname - - # check for next command line option - if {[string range [lindex $xar $i] 0 0] != {-}} { - - # now, process plot command - switch -- [string tolower [lindex $xar $i]] { - {} - - bar - - scatter { - if {$buf != {}} { - ProcessPlotNew $varname $xarname $iname $buf - } elseif {$fn != {}} { - if {[file exists $fn]} { - set ch [open $fn r] - set txt [read $ch] - close $ch - ProcessPlotNew $varname $xarname $iname $txt - } - } else { - ProcessPlotNew $varname $xarname $iname {} - } - } - new { - incr i - switch -- [lindex $xar $i] { - name { - set varname [lindex $xar [expr $i+1]] - incr i 2 - } - } - if {$buf != {}} { - ProcessPlotNew $varname $xarname $iname $buf - } elseif {$fn != {}} { - if {[file exists $fn]} { - set ch [open $fn r] - set txt [read $ch] - close $ch - ProcessPlotNew $varname $xarname $iname $txt - } - } else { - ProcessPlotNew $varname $xarname $iname {} - } - } - data { - incr i - if {$buf != {}} { - ProcessPlotData $varname $xarname $iname $buf - } elseif {$fn != {}} { - if {[file exists $fn]} { - set ch [open $fn r] - set txt [read $ch] - close $ch - ProcessPlotData $varname $xarname $iname $txt - } - } - } - - load { - # File Menu - set ff [lindex $xar [expr $i+1]] - set dim [lindex $xar [expr $i+2]] - incr i 2 - PlotLoadDataFile $varname $ff $dim - FileLast apdatafbox $ff - } - save { - # File Menu - incr i - set ff [lindex $xar $i] - PlotSaveDataFile $varname $ff - FileLast apdatafbox $ff - } - clear { - # File Menu - PlotClearData $varname - } - dup - - duplicate { - # File Menu - incr i - set mm [lindex $xar $i] - if {$mm == {}} { - set mm 1 - } elseif {![string is integer $mm]} { - set mm 1 - incr i -1 - } - PlotDupData $varname $mm - } - stats - - statistics { - # File Menu - set var(stats) 1 - PlotStats $varname - } - list { - # File Menu - set var(list) 1 - PlotList $varname - } - loadconfig { - # File Menu - incr i - set ff [lindex $xar $i] - PlotLoadConfigFile $varname $ff - FileLast apconfigfbox $ff - } - saveconfig { - # File Menu - incr i - set ff [lindex $xar $i] - PlotSaveConfigFile $varname $ff - FileLast apconfigfbox $ff - } - page - - pagesetup { - # File Menu - incr i - ProcessPlotPageSetup $varname $xarname $iname - } - print { - # File Menu - incr i - ProcessPlotPrint $varname $xarname $iname - } - close { - # File Menu - PlotDestroy $varname - } - - mode { - # Edit Menu - incr i - set var(mode) [lindex $xar $i] - PlotChangeMode $varname - } - - axis { - # Graph Menu - incr i - ProcessPlotAxis $varname $xarname $iname - } - legend { - # Graph Menu - incr i - ProcessPlotLegend $varname $xarname $iname - } - font { - # Graph Menu - incr i - ProcessPlotFont $varname $xarname $iname - } - title { - # Graph Menu - incr i - ProcessPlotTitle $varname $xarname $iname - } - barmode { - incr i - set var(bar,mode) [lindex $xar $i] - $var(proc,updategraph) $varname - } - - show { - # Dataset Menu - incr i - set var(show) [FromYesNo [lindex $xar $i]] - $var(proc,updateelement) $varname - } - color { - incr i - ProcessPlotColor $varname $xarname $iname - } - fill { - incr i - set var(fill) [FromYesNo [lindex $xar $i]] - $var(proc,updateelement) $varname - } - fillcolor { - incr i - set var(fill,color) [lindex $xar $i] - $var(proc,updateelement) $varname - } - error - - errorbar { - # Dataset Menu - incr i - ProcessPlotErrorBar $varname $xarname $iname - } - name { - # Dataset Menu - incr i - set var(name) [lindex $xar $i] - $var(proc,updateelement) $varname - } - shape { - # Dataset Line Menu - incr i - ProcessPlotShape $varname $xarname $iname - } - relief { - # Dataset Bar Menu - incr i - set var(bar,relief) [lindex $xar $i] - $var(proc,updateelement) $varname - } - smooth { - # Dataset Line Menu - incr i - set var(smooth) [lindex $xar $i] - $var(proc,updateelement) $varname - } - width { - # Dataset Line Menu - incr i - set var(width) [lindex $xar $i] - $var(proc,updateelement) $varname - } - dash { - # Dataset Line Menu - incr i - set var(dash) [FromYesNo [lindex $xar $i]] - $var(proc,updateelement) $varname - } - - dataset - - select { - # Select Menu - incr i - set var(data,current) [lindex $xar $i] - PlotCurrentData $varname - } - - graph { - # backward compatibility - incr i - ProcessPlotGraph $varname $xarname $iname - } - line { - # backward compatibility - incr i - ProcessPlotLine $varname $xarname $iname - } - view { - # backward compatibility - incr i - ProcessPlotView $varname $xarname $iname - } - } - } else { - ProcessPlotNew $varname $xarname $iname {} - } - - # force update - update idletasks -} -} - -proc ProcessPlotNew {varname xarname iname buf} { - upvar #0 $varname var - global $varname - - upvar 2 $xarname xar - upvar 2 $iname i - - # check for next command line option - if {[string range [lindex $xar $i] 0 0] != {-}} { - switch -- [string tolower [lindex $xar $i]] { - line {incr i; ProcessPlotNewOne line $varname $xarname $iname $buf} - bar {incr i;ProcessPlotNewOne bar $varname $xarname $iname $buf} - scatter { - incr i - ProcessPlotNewOne scatter $varname $xarname $iname $buf - } - default {ProcessPlotNewOne line $varname $xarname $iname $buf} - } - } else { - PlotLine $varname {} {} {} {} xy $buf - incr i -1 - } -} - -proc ProcessPlotNewOne {which varname xarname iname buf} { - upvar #0 $varname var - global $varname - - upvar 3 $xarname xar - upvar 3 $iname i - - if {[string range [lindex $xar $i] 0 0] != {-}} { - switch -- [string tolower [lindex $xar $i]] { - stdin {incr i; AnalysisPlotStdin $which $varname {} $buf} - {} { - switch $which { - line {PlotLine $varname {} {} {} {} xy $buf} - bar {PlotBar $varname {} {} {} {} xy $buf} - scatter {PlotScatter $varname {} {} {} {} xy $buf} - } - } - default { - switch $which { - line { - PlotLine $varname {} \ - [lindex $xar $i] \ - [lindex $xar [expr $i+1]] \ - [lindex $xar [expr $i+2]] \ - [lindex $xar [expr $i+3]] \ - $buf - } - bar { - PlotBar $varname {} \ - [lindex $xar $i] \ - [lindex $xar [expr $i+1]] \ - [lindex $xar [expr $i+2]] \ - [lindex $xar [expr $i+3]] \ - $buf - } - scatter { - PlotScatter $varname {} \ - [lindex $xar $i] \ - [lindex $xar [expr $i+1]] \ - [lindex $xar [expr $i+2]] \ - [lindex $xar [expr $i+3]] \ - $buf - } - } - incr i 3 - } - } - } else { - switch $which { - line {PlotLine $varname {} {} {} {} xy $buf} - bar {PlotBar $varname {} {} {} {} xy $buf} - scatter {PlotScatter $varname {} {} {} {} xy $buf} - } - incr i -1 - } -} - -proc ProcessPlotData {varname xarname iname buf} { - global $varname - upvar #0 $varname var - - upvar 2 $xarname xar - upvar 2 $iname i - - PlotRaise $varname - PlotDataSet $varname [lindex $xar $i] $buf - $var(proc,updategraph) $varname - PlotStats $varname - PlotList $varname + set ref [lindex $iap(windows) end] + global cvarname + set cvarname $ref + global parse + set parse(buf) $buf + set parse(fn) $fn + set parse(tt) $iap(tt) + + plot::YY_FLUSH_BUFFER + plot::yy_scan_string [lrange $xar $i end] + plot::yyparse + incr i [expr $plot::yycnt-1] } proc PlotCmdCheck {} { diff --git a/ds9/library/print.tcl b/ds9/library/print.tcl index 5496cee..933dbf8 100644 --- a/ds9/library/print.tcl +++ b/ds9/library/print.tcl @@ -580,30 +580,10 @@ proc ProcessPSPrintCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - ps::YY_FLUSH_BUFFER - ps::yy_scan_string [lrange $var $i end] - ps::yyparse - incr i [expr $ps::yycnt-1] - } else { - - global ps - - switch -- [string tolower [lindex $var $i]] { - destination {incr i; set ps(dest) [lindex $var $i]} - command {incr i; set ps(cmd) [lindex $var $i]} - filename {incr i; set ps(filename) [lindex $var $i]} - palette - - color {incr i; set ps(color) [lindex $var $i]} - level {incr i; set ps(level) [lindex $var $i]} - interpolate {incr i} - resolution {incr i; set ps(resolution) [lindex $var $i]} - - {} {PostScript} - default {incr i -1; PostScript} - } -} + ps::YY_FLUSH_BUFFER + ps::yy_scan_string [lrange $var $i end] + ps::yyparse + incr i [expr $ps::yycnt-1] } proc PSCmdSet {which value {cmd {}}} { diff --git a/ds9/library/rgbarray.tcl b/ds9/library/rgbarray.tcl index aff77a0..74239df 100644 --- a/ds9/library/rgbarray.tcl +++ b/ds9/library/rgbarray.tcl @@ -127,50 +127,14 @@ proc ProcessRGBArrayCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - rgbarray::YY_FLUSH_BUFFER - rgbarray::yy_scan_string [lrange $var $i end] - rgbarray::yyparse - incr i [expr $rgbarray::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateRGBFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![ImportRGBArraySocket $sock $param]} { - InitError xpa - ImportRGBArrayFile $param - } - } else { - # comm - if {$fn != {}} { - ImportRGBArrayAlloc $fn $param - } else { - ImportRGBArrayFile $param - } - } - FinishLoad -} + rgbarray::YY_FLUSH_BUFFER + rgbarray::yy_scan_string [lrange $var $i end] + rgbarray::yyparse + incr i [expr $rgbarray::yycnt-1] } proc RGBArrayCmdLoad {param} { diff --git a/ds9/library/rgbcube.tcl b/ds9/library/rgbcube.tcl index 94252ca..6bd3789 100644 --- a/ds9/library/rgbcube.tcl +++ b/ds9/library/rgbcube.tcl @@ -111,50 +111,14 @@ proc ProcessRGBCubeCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - rgbcube::YY_FLUSH_BUFFER - rgbcube::yy_scan_string [lrange $var $i end] - rgbcube::yyparse - incr i [expr $rgbcube::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateRGBFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadRGBCubeSocket $sock $param]} { - InitError xpa - LoadRGBCubeFile $param - } - } else { - # comm - if {$fn != {}} { - LoadRGBCubeAlloc $fn $param - } else { - LoadRGBCubeFile $param - } - } - FinishLoad -} + rgbcube::YY_FLUSH_BUFFER + rgbcube::yy_scan_string [lrange $var $i end] + rgbcube::yyparse + incr i [expr $rgbcube::yycnt-1] } proc RGBCubeCmdLoad {param} { diff --git a/ds9/library/rgbimage.tcl b/ds9/library/rgbimage.tcl index 58b1144..460b556 100644 --- a/ds9/library/rgbimage.tcl +++ b/ds9/library/rgbimage.tcl @@ -129,50 +129,14 @@ proc ProcessRGBImageCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - rgbimage::YY_FLUSH_BUFFER - rgbimage::yy_scan_string [lrange $var $i end] - rgbimage::yyparse - incr i [expr $rgbimage::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateRGBFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![LoadRGBImageSocket $sock $param]} { - InitError xpa - LoadRGBImageFile $param - } - } else { - # comm - if {$fn != {}} { - LoadRGBImageAlloc $fn $param - } else { - LoadRGBImageFile $param - } - } - FinishLoad -} + rgbimage::YY_FLUSH_BUFFER + rgbimage::yy_scan_string [lrange $var $i end] + rgbimage::yyparse + incr i [expr $rgbimage::yycnt-1] } proc RGBImageCmdLoad {param} { diff --git a/ds9/library/samp.tcl b/ds9/library/samp.tcl index 9af0e1d..d126c02 100644 --- a/ds9/library/samp.tcl +++ b/ds9/library/samp.tcl @@ -1707,95 +1707,12 @@ proc ProcessSAMPCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - SAMPUpdate - global debug - if {$debug(tcl,parser)} { - samp::YY_FLUSH_BUFFER - samp::yy_scan_string [lrange $var $i end] - samp::yyparse - incr i [expr $samp::yycnt-1] - } else { - - global samp - global ds9 - global env - switch -- [string tolower [lindex $var $i]] { - send { - incr i - switch -- [string tolower [lindex $var $i]] { - image { - incr i - set name [string tolower [lindex $var $i]] - if {[info exists samp]} { - foreach arg $samp(apps,image) { - foreach {key val} $arg { - if {[string tolower $val] == $name} { - SAMPSendImageLoadFits $key - break - } - } - } - } else { - Error "SAMP: [msgcat::mc {not connected}]" - } - } - table { - incr i - set name [string tolower [lindex $var $i]] - if {[info exists samp]} { - foreach arg $samp(apps,table) { - foreach {key val} $arg { - if {[string tolower $val] == $name} { - SAMPSendTableLoadFits $key - break - } - } - } - } else { - Error "SAMP: [msgcat::mc {not connected}]" - } - } - default { - set name [string tolower [lindex $var $i]] - if {[info exists samp]} { - foreach arg $samp(apps,image) { - foreach {key val} $arg { - if {[string tolower $val] == $name} { - SAMPSendImageLoadFits $key - break - } - } - } - } else { - Error "SAMP: [msgcat::mc {not connected}]" - } - } - } - } - broadcast { - incr i - switch -- [string tolower [lindex $var $i]] { - image {SAMPSendImageLoadFits {}} - table {SAMPSendTableLoadFits {}} - default { - incr i -1 - SAMPSendImageLoadFits {} - } - } - } - connect {SAMPConnect} - disconnect {SAMPDisconnect} - default { - if {[FromYesNo [lindex $var $i]]} { - SAMPConnect - } else { - SAMPDisconnect - } - } - } -} + samp::YY_FLUSH_BUFFER + samp::yy_scan_string [lrange $var $i end] + samp::yyparse + incr i [expr $samp::yycnt-1] } proc SAMPCmdSendImage {name} { diff --git a/ds9/library/save.tcl b/ds9/library/save.tcl index a3fdad7..97af246 100644 --- a/ds9/library/save.tcl +++ b/ds9/library/save.tcl @@ -43,92 +43,10 @@ proc ProcessSaveCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - save::YY_FLUSH_BUFFER - save::yy_scan_string [lrange $var $i end] - save::yyparse - incr i [expr $save::yycnt-1] - } else { - - set format {} - set fn [lindex $var $i] - if {$fn == {}} { - return - } - - switch -- $fn { - fits - - sfits - - rgbimage - - rgbcube - - srgbcube - - mecube - - multiframe - - mosaicimagewcs - - mosaicimageiraf - - mosaicimagewfpc - - mosaicwcs - - mosaiciraf - - smosaicwcs - - smosaiciraf { - set format $fn - set fn {} - incr i - } - mosaicimage - - mosaic { - set format $fn - set fn {} - incr i - - # eat any wcs - if {[string range [lindex $var $i] 0 2] == {wcs}} { - incr i - } - } - } - - # one last time - if {$fn == {}} { - set fn [lindex $var $i] - if {$fn == {}} { - return - } - } - - if {$format == {}} { - set format [ExtToFormat $fn] - } - - global savefits - set param [string tolower [lindex $var [expr $i+1]]] - switch $format { - fits { - switch $param { - slice - - image - - table { - set savefits(type) $param - incr i - } - default {set savefits(type) image} - } - } - mosaic - - mosaiciraf - - mosaicwcs { - if {[string is integer -strict $param]} { - set savefits(mosaic) $param - incr i - } - } - } - - global savefitsfbox - FileLast savefitsfbox $fn - Save $format $fn -} + save::YY_FLUSH_BUFFER + save::yy_scan_string [lrange $var $i end] + save::yyparse + incr i [expr $save::yycnt-1] } proc SaveCmdLoad {format fn} { diff --git a/ds9/library/saveimage.tcl b/ds9/library/saveimage.tcl index 45ac769..4729deb 100644 --- a/ds9/library/saveimage.tcl +++ b/ds9/library/saveimage.tcl @@ -154,123 +154,10 @@ proc ProcessSaveImageCmd {varname iname} { UpdateDS9 RealizeDS9 - global debug - if {$debug(tcl,parser)} { - saveimage::YY_FLUSH_BUFFER - saveimage::yy_scan_string [lrange $var $i end] - saveimage::yyparse - incr i [expr $saveimage::yycnt-1] - } else { - - set format {} - set param {} - set fn [lindex $var $i] - if {$fn == {}} { - return - } - - # backward compatibility - switch $fn { - fits - - eps - - gif - - tiff - - jpeg - - png { - set format $fn - set fn {} - incr i - } - jpg { - set format jpeg - set fn {} - incr i - } - tif { - set format tiff - set fn {} - incr i - } - mpeg { - # backward compatibility - global movie - incr i - set fn [lindex $var $i] - if {[string is integer -strict $fn]} { - incr i - set fn [lindex $var $i] - } - set movie(action) slice - Movie $fn - } - } - - # try again - if {$fn == {}} { - set fn [lindex $var $i] - if {$fn == {}} { - return - } - - if {[string is integer -strict $fn] || - $fn == {none} || $fn == {jpeg} || - $fn == {backbits} || $fn == {deflate}} { - set param $fn - set fn {} - incr i - } - } - - # one last time - if {$fn == {}} { - set fn [lindex $var $i] - if {$fn == {}} { - return - } - } - - global saveimage - if {$format == {}} { - set format [ExtToFormat $fn] - } - - if {$param == {}} { - set param [string tolower [lindex $var [expr $i+1]]] - switch $format { - fits - - eps - - gif - - png {} - jpeg { - if {[string is integer -strict $param]} { - set saveimage(jpeg,quality) $param - incr i - } - } - tiff { - switch $param { - none - - jpeg - - packbits - - deflate { - set saveimage(tiff,compress) $param - incr i - } - } - } - } - } - - switch -- $format { - fits {FileLast fitsfbox $fn} - eps {FileLast epsfbox $fn} - gif {FileLast giffbox $fn} - jpeg {FileLast jpegfbox $fn} - tiff {FileLast tifffbox $fn} - png {FileLast pngfbox $fn} - } - SaveImage $fn $format -} + saveimage::YY_FLUSH_BUFFER + saveimage::yy_scan_string [lrange $var $i end] + saveimage::yyparse + incr i [expr $saveimage::yycnt-1] } proc SaveimageCmdSet {which value {cmd {}}} { diff --git a/ds9/library/scale.tcl b/ds9/library/scale.tcl index 8fd0575..3555d47 100644 --- a/ds9/library/scale.tcl +++ b/ds9/library/scale.tcl @@ -827,118 +827,10 @@ proc ProcessScaleCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - scale::YY_FLUSH_BUFFER - scale::yy_scan_string [lrange $var $i end] - scale::yyparse - incr i [expr $scale::yycnt-1] - } else { - - global scale - switch -- [string tolower [lindex $var $i]] { - match { - incr i - switch -- [string tolower [lindex $var $i]] { - limits - - scalelimits { - MatchScaleLimitsCurrent - } - default { - incr i -1 - MatchScaleCurrent - } - } - } - lock { - incr i - switch -- [string tolower [lindex $var $i]] { - limits - - scalelimits { - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set scale(lock,limits) [FromYesNo [lindex $var $i]] - } else { - set scale(lock,limits) 1 - incr i -1 - } - LockScaleLimitsCurrent - } - default { - if {!([string range [lindex $var $i] 0 0] == "-")} { - set scale(lock) [FromYesNo [lindex $var $i]] - } else { - set scale(lock) 1 - incr i -1 - } - LockScaleCurrent - } - } - } - open {ScaleDialog} - close {ScaleDestroyDialog} - linear - - pow - - sqrt - - squared - - asinh - - sinh - - histequ { - set scale(type) [string tolower [lindex $var $i]] - ChangeScale - } - log { - incr i - switch -- [string tolower [lindex $var $i]] { - exp { - incr i - set scale(log) [string tolower [lindex $var $i]] - ChangeScale - } - default { - incr i -1 - set scale(type) [string tolower [lindex $var $i]] - ChangeScale - } - } - } - datasec { - incr i - set scale(datasec) [FromYesNo [lindex $var $i]] - ChangeDATASEC - } - limits - - scalelimits { - incr i - set scale(min) [lindex $var $i] - incr i - set scale(max) [lindex $var $i] - ChangeScaleLimit - } - minmax - - zscale - - zmax - - user { - set scale(mode) [string tolower [lindex $var $i]] - ChangeScaleMode - } - mode { - incr i - set scale(mode) [string tolower [lindex $var $i]] - ChangeScaleMode - } - local - - global { - set scale(scope) [string tolower [lindex $var $i]] - ChangeScaleScope - } - scope { - incr i - set scale(scope) [string tolower [lindex $var $i]] - ChangeScaleScope - } - } -} + scale::YY_FLUSH_BUFFER + scale::yy_scan_string [lrange $var $i end] + scale::yyparse + incr i [expr $scale::yycnt-1] } proc ScaleCmdSet {which value {cmd {}}} { @@ -976,47 +868,10 @@ proc ProcessMinMaxCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - minmax::YY_FLUSH_BUFFER - minmax::yy_scan_string [lrange $var $i end] - minmax::yyparse - incr i [expr $minmax::yycnt-1] - } else { - - global minmax - global scale - switch -- [string tolower [lindex $var $i]] { - auto { - # backward compatibility - set minmax(mode) scan - ChangeMinMax - } - scan - - sample - - datamin - - irafmin { - set minmax(mode) [string tolower [lindex $var $i]] - ChangeMinMax - } - mode { - incr i - set minmax(mode) [string tolower [lindex $var $i]] - ChangeMinMax - } - interval { - incr i - set minmax(sample) [lindex $var $i] - ChangeMinMax - } - default { - # for backward compatibility - set scale(mode) minmax - ChangeScaleMode - incr i -1 - } - } -} + minmax::YY_FLUSH_BUFFER + minmax::yy_scan_string [lrange $var $i end] + minmax::yyparse + incr i [expr $minmax::yycnt-1] } proc MinmaxCmdSet {which value {cmd {}}} { @@ -1045,41 +900,10 @@ proc ProcessZScaleCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - zscale::YY_FLUSH_BUFFER - zscale::yy_scan_string [lrange $var $i end] - zscale::yyparse - incr i [expr $zscale::yycnt-1] - } else { - - global zscale - global scale - - switch -- [string tolower [lindex $var $i]] { - contrast { - incr i - set zscale(contrast) [lindex $var $i] - ChangeZScale - } - sample { - incr i - set zscale(sample) [lindex $var $i] - ChangeZScale - } - line { - incr i - set zscale(line) [lindex $var $i] - ChangeZScale - } - default { - # for backward compatibility - set scale(mode) zscale - ChangeScaleMode - incr i -1 - } - } -} + zscale::YY_FLUSH_BUFFER + zscale::yy_scan_string [lrange $var $i end] + zscale::yyparse + incr i [expr $zscale::yycnt-1] } proc ZscaleCmdSet {which value {cmd {}}} { diff --git a/ds9/library/sfits.tcl b/ds9/library/sfits.tcl index d2cfdca..753706e 100644 --- a/ds9/library/sfits.tcl +++ b/ds9/library/sfits.tcl @@ -21,48 +21,8 @@ proc ProcessSFitsCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - sfits::YY_FLUSH_BUFFER - sfits::yy_scan_string [lrange $var $i end] - sfits::yyparse - incr i [expr $sfits::yycnt-1] - } else { - - set layer {} - set mode {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - set mode slice - } - } - - if {$sock != {}} { - # xpa - if {0} { - # not supported - } else { - LoadSFitsFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $mode - } - } else { - # comm - if {0} { - # not supported - } else { - LoadSFitsFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $mode - } - } - FinishLoad -} + sfits::YY_FLUSH_BUFFER + sfits::yy_scan_string [lrange $var $i end] + sfits::yyparse + incr i [expr $sfits::yycnt-1] } diff --git a/ds9/library/shm.tcl b/ds9/library/shm.tcl index 7bf5249..d67002d 100644 --- a/ds9/library/shm.tcl +++ b/ds9/library/shm.tcl @@ -7,246 +7,14 @@ package provide DS9 1.0 proc ProcessShmCmd {varname iname ml} { upvar $varname var upvar $iname i - global loadParam - global debug - if {$debug(tcl,parser)} { - global parse - set parse(ml) $ml + global parse + set parse(ml) $ml - shm::YY_FLUSH_BUFFER - shm::yy_scan_string [lrange $var $i end] - shm::yyparse - incr i [expr $shm::yycnt-1] - } else { - - set done 0 - while {!$done} { - - # defaults - set loadParam(load,type) shared - set loadParam(file,type) fits - set loadParam(file,mode) {} - - # mask not supported - set loadParam(load,layer) {} - - set nn [lindex $var [expr $i+4]] - if {$nn == {} || [string range $nn 0 0] == "-"} { - set def 1 - } else { - set def 0 - } - - switch -- [lindex $var $i] { - key - - shmid { - if {$ml} { - MultiLoad - } - set loadParam(shared,idtype) [lindex $var $i] - set loadParam(shared,id) [lindex $var [expr $i+1]] - set loadParam(file,name) [lindex $var [expr $i+2]] - incr i 2 - } - - fits { - if {$ml} { - MultiLoad - } - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - sfits { - if {$ml} { - MultiLoad - } - set loadParam(load,type) sshared - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,hdr) [lindex $var [expr $i+2]] - set loadParam(shared,id) [lindex $var [expr $i+3]] - set loadParam(file,name) [lindex $var [expr $i+4]] - incr i 4 - } - - mosaicimage { - if {$ml} { - MultiLoad - } - if {$def} { - set loadParam(file,mode) {mosaic image iraf} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } else { - set loadParam(file,mode) \ - [list mosaic image [lindex $var [expr $i+1]]] - set loadParam(shared,idtype) [lindex $var [expr $i+2]] - set loadParam(shared,id) [lindex $var [expr $i+3]] - set loadParam(file,name) [lindex $var [expr $i+4]] - incr i 4 - } - } - mosaic { - if {$def} { - set loadParam(file,mode) {mosaic iraf} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } else { - set loadParam(file,mode) \ - [list mosaic [lindex $var [expr $i+1]]] - set loadParam(shared,idtype) [lindex $var [expr $i+2]] - set loadParam(shared,id) [lindex $var [expr $i+3]] - set loadParam(file,name) [lindex $var [expr $i+4]] - incr i 4 - } - } - smosaic { - set loadParam(load,type) sshared - set loadParam(file,mode) \ - [list mosaic [lindex $var [expr $i+1]]] - set loadParam(shared,idtype) [lindex $var [expr $i+2]] - set loadParam(shared,hdr) [lindex $var [expr $i+3]] - set loadParam(shared,id) [lindex $var [expr $i+4]] - set loadParam(file,name) [lindex $var [expr $i+5]] - incr i 5 - } - - mosaicimageiraf { - # backward compatibility - if {$ml} { - MultiLoad - } - set loadParam(file,mode) {mosaic image iraf} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - mosaiciraf { - # backward compatibility - set loadParam(file,mode) {mosaic iraf} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - mosaicimagewcs { - # backward compatibility - if {$ml} { - MultiLoad - } - set loadParam(file,mode) {mosaic image wcs} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - mosaicwcs { - # backward compatibility - set loadParam(file,mode) {mosaic wcs} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - mosaicimagewfpc2 { - # backward compatibility - if {$ml} { - MultiLoad - } - set loadParam(file,mode) {mosaic image wfpc2} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - - rgbcube { - if {$ml} { - MultiLoadRGB - } - set loadParam(file,mode) {rgb cube} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - srgbcube { - if {$ml} { - MultiLoadRGB - } - set loadParam(load,type) sshared - set loadParam(file,mode) {rgb cube} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,hdr) [lindex $var [expr $i+2]] - set loadParam(shared,id) [lindex $var [expr $i+3]] - set loadParam(file,name) [lindex $var [expr $i+4]] - incr i 4 - } - rgbimage { - if {$ml} { - MultiLoadRGB - } - set loadParam(file,mode) {rgb image} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - rgbarray { - if {$ml} { - MultiLoadRGB - } - set loadParam(file,type) array - set loadParam(file,mode) {rgb cube} - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - array { - if {$ml} { - MultiLoad - } - set loadParam(file,type) array - set loadParam(shared,idtype) [lindex $var [expr $i+1]] - set loadParam(shared,id) [lindex $var [expr $i+2]] - set loadParam(file,name) [lindex $var [expr $i+3]] - incr i 3 - } - - default { - if {$ml} { - MultiLoad - } - set loadParam(shared,idtype) key - set loadParam(shared,id) [lindex $var $i] - set loadParam(file,name) [lindex $var [expr $i+1]] - incr i 1 - } - } - - ProcessLoad - - # more to come? - incr i - if {([lindex $var $i] == "-shm") || - ([lindex $var $i] == "shm")} { - set done 0 - incr i - } else { - set done 1 - incr i -1 - } - } - FinishLoad -} + shm::YY_FLUSH_BUFFER + shm::yy_scan_string [lrange $var $i end] + shm::yyparse + incr i [expr $shm::yycnt-1] } proc ShmCmdSet {loadtype filetype filemode sharedidtype sharedid filename {sharedhdr {}}} { diff --git a/ds9/library/smosaiciraf.tcl b/ds9/library/smosaiciraf.tcl index bf5cde2..8334e54 100644 --- a/ds9/library/smosaiciraf.tcl +++ b/ds9/library/smosaiciraf.tcl @@ -21,47 +21,8 @@ proc ProcessSMosaicIRAFCmd {varname iname sock fn layer} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - smosaiciraf::YY_FLUSH_BUFFER - smosaiciraf::yy_scan_string [lrange $var $i end] - smosaiciraf::yyparse - incr i [expr $smosaiciraf::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - - if {$sock != {}} { - # xpa - if {0} { - # not supported - } else { - LoadSMosaicIRAFFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer - } - } else { - # comm - if {0} { - # not supported - } else { - LoadSMosaicIRAFFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer - } - } - FinishLoad -} + smosaiciraf::YY_FLUSH_BUFFER + smosaiciraf::yy_scan_string [lrange $var $i end] + smosaiciraf::yyparse + incr i [expr $smosaiciraf::yycnt-1] } diff --git a/ds9/library/smosaicwcs.tcl b/ds9/library/smosaicwcs.tcl index 6e7a492..4d15461 100644 --- a/ds9/library/smosaicwcs.tcl +++ b/ds9/library/smosaicwcs.tcl @@ -21,54 +21,8 @@ proc ProcessSMosaicWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - smosaicwcs::YY_FLUSH_BUFFER - smosaicwcs::yy_scan_string [lrange $var $i end] - smosaicwcs::yyparse - incr i [expr $smosaicwcs::yycnt-1] - } else { - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not supported - } - } - - set opt [lindex $var $i] - if {$opt != {}} { - incr i - } else { - set opt wcs - } - - if {$sock != {}} { - # xpa - if {0} { - # not supported - } else { - LoadSMosaicWCSFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $opt - } - } else { - # comm - if {0} { - # not supported - } else { - LoadSMosaicWCSFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $opt - } - } - FinishLoad -} + smosaicwcs::YY_FLUSH_BUFFER + smosaicwcs::yy_scan_string [lrange $var $i end] + smosaicwcs::yyparse + incr i [expr $smosaicwcs::yycnt-1] } diff --git a/ds9/library/srgbcube.tcl b/ds9/library/srgbcube.tcl index ac8f448..f4a36f6 100644 --- a/ds9/library/srgbcube.tcl +++ b/ds9/library/srgbcube.tcl @@ -33,44 +33,8 @@ proc ProcessSRGBCubeCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - srgbcube::YY_FLUSH_BUFFER - srgbcube::yy_scan_string [lrange $var $i end] - srgbcube::yyparse - incr i [expr $srgbcube::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateRGBFrame - } - mask { - incr i - # not supported - } - slice { - incr i - # not supported - } - } - - if {$sock != {}} { - # xpa - if {0} { - # not supported - } else { - LoadSRGBCubeFile [lindex $var $i] [lindex $var [expr $i+1]] - } - } else { - # comm - if {0} { - # not supported - } else { - LoadSRGBCubeFile [lindex $var $i] [lindex $var [expr $i+1]] - } - } - FinishLoad -} + srgbcube::YY_FLUSH_BUFFER + srgbcube::yy_scan_string [lrange $var $i end] + srgbcube::yyparse + incr i [expr $srgbcube::yycnt-1] } diff --git a/ds9/library/xpa.tcl b/ds9/library/xpa.tcl index dc34a39..e4f6d70 100644 --- a/ds9/library/xpa.tcl +++ b/ds9/library/xpa.tcl @@ -2205,63 +2205,20 @@ proc ProcessXPAFirstCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - xpafirst::YY_FLUSH_BUFFER - xpafirst::yy_scan_string [lrange $var $i end] - xpafirst::yyparse - incr i [expr $xpafirst::yycnt-1] - } else { - - global ds9 - global pds9 - global env - - switch -- [string tolower [lindex $var $i]] { - unix - - inet - - local - - localhost {set env(XPA_METHOD) [lindex $var $i]} - noxpans {set env(XPA_NSREGISTER) false} - - yes - - true - - on - - 1 - - no - - false - - off - - 0 {set pds9(xpa) [FromYesNo [lindex $var $i]]} - } -} + xpafirst::YY_FLUSH_BUFFER + xpafirst::yy_scan_string [lrange $var $i end] + xpafirst::yyparse + incr i [expr $xpafirst::yycnt-1] } proc ProcessXPACmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - xpa::YY_FLUSH_BUFFER - xpa::yy_scan_string [lrange $var $i end] - xpa::yyparse - incr i [expr $xpa::yycnt-1] - } else { - - global ds9 - global pds9 - - switch -- [string tolower [lindex $var $i]] { - tcl { - # backward compatibility - incr i - } - - connect {XPAConnect} - disconnect {XPADisconnect} - info {XPAInfo} - } -} + xpa::YY_FLUSH_BUFFER + xpa::yy_scan_string [lrange $var $i end] + xpa::yyparse + incr i [expr $xpa::yycnt-1] } proc XPACmdSet {varname which value} { diff --git a/ds9/parsers/matchlock.trl b/ds9/parsers/matchlock.trl index 4fe6ad1..9a2affc 100644 --- a/ds9/parsers/matchlock.trl +++ b/ds9/parsers/matchlock.trl @@ -3,7 +3,8 @@ lock : coordsys {set _ $1} | NONE_ {set _ none} ; -lockslice : IMAGE_ {set _ image} +lockslice : {set _ image} + | IMAGE_ {set _ image} | wcssys {set _ $1} | NONE_ {set _ none} ; |