From 41505b4129a005e96c6afc3344ccf61097884fbd Mon Sep 17 00:00:00 2001 From: William Joye Date: Tue, 29 May 2018 16:21:39 -0400 Subject: cleanup ProcessCmd code --- ds9/library/3d.tcl | 105 +-------- ds9/library/array.tcl | 84 +------ ds9/library/bin.tcl | 88 +------ ds9/library/block.tcl | 61 +---- ds9/library/colorbar.tcl | 233 +------------------ ds9/library/contour.tcl | 230 +----------------- ds9/library/crop.tcl | 54 +---- ds9/library/crosshair.tcl | 37 +-- ds9/library/cube.tcl | 145 +----------- ds9/library/grid.tcl | 282 +---------------------- ds9/library/header.tcl | 57 +---- ds9/library/hv.tcl | 100 +------- ds9/library/marker.tcl | 576 +--------------------------------------------- ds9/library/mask.tcl | 58 +---- ds9/library/nameres.tcl | 60 +---- ds9/library/nrrd.tcl | 51 +--- ds9/library/panzoom.tcl | 135 ++--------- ds9/library/photo.tcl | 59 +---- ds9/library/pixel.tcl | 31 +-- ds9/library/rgb.tcl | 77 +------ ds9/library/sia.tcl | 84 +------ ds9/library/smooth.tcl | 77 +------ ds9/library/url.tcl | 31 +-- ds9/library/util.tcl | 251 ++++---------------- ds9/library/vo.tcl | 74 +----- ds9/library/wcs.tcl | 171 +------------- 26 files changed, 191 insertions(+), 3020 deletions(-) diff --git a/ds9/library/3d.tcl b/ds9/library/3d.tcl index 6dd7fde..78a6c2a 100644 --- a/ds9/library/3d.tcl +++ b/ds9/library/3d.tcl @@ -465,107 +465,10 @@ proc Process3DCmd {varname iname} { 3DDialog - global debug - if {$debug(tcl,parser)} { - threed::YY_FLUSH_BUFFER - threed::yy_scan_string [lrange $var $i end] - threed::yyparse - incr i [expr $threed::yycnt-1] - } else { - - global threed - switch -- [string tolower [lindex $var $i]] { - open {} - close {3DDestroyDialog} - az { - incr i - set threed(az) [lindex $var $i] - 3DViewPoint - } - el { - incr i - set threed(el) [lindex $var $i] - 3DViewPoint - } - view - - vp { - incr i - set threed(az) [lindex $var $i] - incr i - set threed(el) [lindex $var $i] - 3DViewPoint - } - scale { - incr i - set threed(scale) [lindex $var $i] - 3DScale - } - method { - incr i - set threed(method) [lindex $var $i] - 3DRenderMethod - } - background { - incr i - set threed(background) [lindex $var $i] - 3DBackground - } - highlite { - incr i - switch [string tolower [lindex $var $i]] { - color { - incr i - set threed(highlite,color) [lindex $var $i] - 3DHighliteColor - } - default { - set threed(highlite) [FromYesNo [lindex $var $i]] - 3DHighlite - } - } - } - border { - incr i - switch [string tolower [lindex $var $i]] { - color { - incr i - set threed(border,color) [lindex $var $i] - 3DBorderColor - } - default { - set threed(border) [FromYesNo [lindex $var $i]] - 3DBorder - } - } - } - compass { - incr i - switch [string tolower [lindex $var $i]] { - color { - incr i - set threed(compass,color) [lindex $var $i] - 3DCompassColor - } - default { - set threed(compass) [FromYesNo [lindex $var $i]] - 3DCompass - } - } - } - match {Match3DCurrent} - lock { - 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 - } - default {Create3DFrame; incr i -1} - } -} + threed::YY_FLUSH_BUFFER + threed::yy_scan_string [lrange $var $i end] + threed::yyparse + incr i [expr $threed::yycnt-1] } proc ThreedCmdSet {which value {cmd {}}} { diff --git a/ds9/library/array.tcl b/ds9/library/array.tcl index 5ee12a6..6b02983 100644 --- a/ds9/library/array.tcl +++ b/ds9/library/array.tcl @@ -76,55 +76,14 @@ proc ProcessArrayCmd {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 - - array::YY_FLUSH_BUFFER - array::yy_scan_string [lrange $var $i end] - array::yyparse - incr i [expr $array::yycnt-1] - } else { - - if {[ProcessArrayBackwardCmd $varname $iname $sock $fn]} { - return - } - - set layer {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - set layer mask - } - slice { - incr i - # not suppported - } - } - set param [lindex $var $i] + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa - if {![ImportArraySocket $sock $param $layer]} { - InitError xpa - ImportArrayFile $param $layer - } - } else { - # comm - if {$fn != {}} { - ImportArrayAlloc $fn $param $layer - } else { - ImportArrayFile $param $layer - } - } - FinishLoad -} + array::YY_FLUSH_BUFFER + array::yy_scan_string [lrange $var $i end] + array::yyparse + incr i [expr $array::yycnt-1] } proc ArrayCmdLoad {param layer} { @@ -164,32 +123,3 @@ proc ProcessSendArrayCmd {proc id param sock fn} { $proc $id {} $fn } } - -# backward compatibility -proc ProcessArrayBackwardCmd {varname iname sock fn} { - upvar 2 $varname var - upvar 2 $iname i - - set vvar $var - set ii $i - - switch -- [string tolower [lindex $var $i]] { - rgb { - set vvar [lreplace $var 0 0] - ProcessRGBArrayCmd vvar ii $sock $fn - return 1 - } - new { - switch -- [string tolower [lindex $var [expr $i+1]]] { - rgb { - set vvar [lreplace $var 1 1] - ProcessRGBArrayCmd vvar ii $sock $fn - return 1 - } - } - } - } - - return 0 -} - diff --git a/ds9/library/bin.tcl b/ds9/library/bin.tcl index 3cf60bd..d8dfd42 100644 --- a/ds9/library/bin.tcl +++ b/ds9/library/bin.tcl @@ -723,90 +723,10 @@ proc ProcessBinCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - bin::YY_FLUSH_BUFFER - bin::yy_scan_string [lrange $var $i end] - bin::yyparse - incr i [expr $bin::yycnt-1] - } else { - - global bin - switch -- [string tolower [lindex $var $i]] { - close {BinDestroyDialog} - open {BinDialog} - match {MatchBinCurrent} - lock { - 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 - } - about { - incr i - switch [lindex $var $i] { - center { - BinAboutCenter - } - default { - BinAbout [lindex $var [expr $i+0]] [lindex $var [expr $i+1]] - incr i - } - } - } - buffersize { - incr i - set bin(buffersize) [lindex $var $i] - ChangeBinBufferSize - } - cols { - BinCols \"[lindex $var [expr $i+1]]\" \"[lindex $var [expr $i+2]]\" \"\" - incr i 2 - } - colsz { - BinCols \"[lindex $var [expr $i+1]]\" \"[lindex $var [expr $i+2]]\" \"[lindex $var [expr $i+3]]\" - incr i 3 - } - factor { - incr i - set bx [lindex $var $i] - set by [lindex $var [expr $i+1]] - # note: the spaces are needed so that the menus are in sync - if {$by != {} && [string is double $by]} { - set bin(factor) "$bx $by" - incr i - } else { - set bin(factor) "$bx $bx" - } - ChangeBinFactor - } - depth { - incr i - set bin(depth) [lindex $var $i] - ChangeBinDepth - } - filter { - incr i - BinFilter [lindex $var $i] - } - function { - incr i - set bin(function) [string tolower [lindex $var $i]] - ChangeBinFunction - } - in {Bin .5 .5} - out {Bin 2 2} - to { - # eat the 'fit' - incr i - BinToFit - } - } -} + bin::YY_FLUSH_BUFFER + bin::yy_scan_string [lrange $var $i end] + bin::yyparse + incr i [expr $bin::yycnt-1] } proc BinCmdSet {which value {cmd {}}} { diff --git a/ds9/library/block.tcl b/ds9/library/block.tcl index 8a03620..214604c 100644 --- a/ds9/library/block.tcl +++ b/ds9/library/block.tcl @@ -289,63 +289,10 @@ proc ProcessBlockCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - block::YY_FLUSH_BUFFER - block::yy_scan_string [lrange $var $i end] - block::yyparse - incr i [expr $block::yycnt-1] - } else { - - global block - switch -- [string tolower [lindex $var $i]] { - open {BlockDialog} - close {BlockDestroyDialog} - match {MatchBlockCurrent} - lock { - 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 - } - in {Block .5 .5} - out {Block 2 2} - to { - switch -- [string tolower [lindex $var [expr $i+1]]] { - fit { - BlockToFit - incr i - } - default { - set b1 [lindex $var [expr $i+1]] - set b2 [lindex $var [expr $i+2]] - if {[string is double $b2] && $b2 != {}} { - set block(factor) "$b1 $b2" - incr i 2 - } else { - set block(factor) "$b1 $b1" - incr i - } - ChangeBlock - } - } - } - default { - set b1 [lindex $var $i] - set b2 [lindex $var [expr $i+1]] - if {[string is double $b2] && $b2 != {}} { - Block $b1 $b2 - incr i - } else { - Block $b1 $b1 - } - } - } -} + block::YY_FLUSH_BUFFER + block::yy_scan_string [lrange $var $i end] + block::yyparse + incr i [expr $block::yycnt-1] } proc BlockCmdSet {which value {cmd {}}} { diff --git a/ds9/library/colorbar.tcl b/ds9/library/colorbar.tcl index a5ee821..8575336 100644 --- a/ds9/library/colorbar.tcl +++ b/ds9/library/colorbar.tcl @@ -1188,115 +1188,10 @@ proc ProcessCmapCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - cmap::YY_FLUSH_BUFFER - cmap::yy_scan_string [lrange $var $i end] - cmap::yyparse - incr i [expr $cmap::yycnt-1] - } else { - - global colorbar - global current - - global ds9 - global current - global rgb - - switch -- [string tolower [lindex $var $i]] { - open {ColormapDialog} - close {ColormapDestroyDialog} - match { - # backward compatibility - MatchColorCurrent - } - lock { - # backward compatibility - 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 - } - load - - file { - incr i - set fn [lindex $var $i] - LoadColormapFile $fn - FileLast colormapfbox $fn - } - save { - incr i - set fn [lindex $var $i] - SaveColormapFile $fn - FileLast colormapfbox $fn - } - invert { - incr i - set colorbar(invert) [FromYesNo [lindex $var $i]] - InvertColorbar - } - tag { - incr i - set item [string tolower [lindex $var $i]] - switch $item { - load {incr i; LoadColorTag [lindex $var $i]} - save {incr i; $current(colorbar) tag save [lindex $var $i]} - delete {DeleteColorTag} - } - } - value { - incr i - set c [lindex $var $i] - incr i - set b [lindex $var $i] - if {$current(frame) != {}} { - RGBEvalLockColorbar [list $current(colorbar) adjust $c $b] - RGBEvalLockCurrent rgb(lock,colorbar) [list $current(frame) colormap begin] - RGBEvalLockCurrent rgb(lock,colorbar) [list $current(frame) colormap motion [$current(colorbar) get colormap]] - RGBEvalLockCurrent rgb(lock,colorbar) [list $current(frame) colormap end] - } - LockColorCurrent - UpdateColorDialog - } - default { - switch -- [$current(frame) get type] { - base - - 3d { - set cmap [lindex $var $i] - # common variants on spellings - switch -- [string tolower $cmap] { - gray {set cmap grey} - } - - set id [colorbar list id] - set found 0 - foreach ii $id { - set title [colorbar get name $ii] - if {[string equal -nocase $title $cmap]} { - set colorbar(map) $title - colorbar map "{$colorbar(map)}" - $current(frame) colormap [colorbar get colormap] - set colorbar(invert) [colorbar get invert] - - set found 1 - break - } - } - if {!$found} { - Error "[msgcat::mc {Unknown Colormap}] $cmap" - } - } - rgb {} - } - LockColorCurrent - UpdateColorDialog - } - } -} + cmap::YY_FLUSH_BUFFER + cmap::yy_scan_string [lrange $var $i end] + cmap::yyparse + incr i [expr $cmap::yycnt-1] } proc CmapCmd {item} { @@ -1366,122 +1261,10 @@ proc ProcessColorbarCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - colorbar::YY_FLUSH_BUFFER - colorbar::yy_scan_string [lrange $var $i end] - colorbar::yyparse - incr i [expr $colorbar::yycnt-1] - } else { - - global colorbar - global view - - set item [string tolower [lindex $var $i]] - - switch -- $item { - match { - MatchColorCurrent - } - lock { - 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 - } - numerics { - incr i - set yesno [string tolower [lindex $var $i]] - set colorbar(numerics) [FromYesNo $yesno] - UpdateView - } - space { - incr i - switch -- [string tolower [lindex $var $i]] { - value {set item 1} - default {set item 0} - } - set colorbar(space) $item - UpdateView - } - font { - incr i - set item [string tolower [lindex $var $i]] - set colorbar(font) $item - UpdateView - } - fontsize { - incr i - set item [lindex $var $i] - set colorbar(font,size) $item - UpdateView - } - fontweight { - incr i - set item [string tolower [lindex $var $i]] - set colorbar(font,weight) $item - UpdateView - } - fontslant { - incr i - set item [string tolower [lindex $var $i]] - set colorbar(font,slant) $item - UpdateView - } - fontstyle { - # backward compatibility - incr i - set item [string tolower [lindex $var $i]] - switch $item { - normal { - set colorbar(font,weight) normal - set colorbar(font,slant) roman - } - bold { - set colorbar(font,weight) bold - set colorbar(font,slant) roman - } - italic { - set colorbar(font,weight) normal - set colorbar(font,slant) italic - } - } - UpdateView - } - orientation { - incr i - set item [string tolower [lindex $var $i]] - set colorbar(orientation) $item - UpdateView - } - vertical - - horizontal { - set colorbar(orientation) $item - UpdateView - } - size { - incr i - set item [lindex $var $i] - set colorbar(size) $item - UpdateView - } - ticks { - incr i - set item [lindex $var $i] - set colorbar(ticks) $item - UpdateView - } - default { - set yesno [string tolower [lindex $var $i]] - set view(colorbar) [FromYesNo $yesno] - UpdateView - } - } -} + colorbar::YY_FLUSH_BUFFER + colorbar::yy_scan_string [lrange $var $i end] + colorbar::yyparse + incr i [expr $colorbar::yycnt-1] } proc ColorbarCmdSet {which value {cmd {}}} { diff --git a/ds9/library/contour.tcl b/ds9/library/contour.tcl index d55e3c9..2e23cee 100644 --- a/ds9/library/contour.tcl +++ b/ds9/library/contour.tcl @@ -1054,232 +1054,10 @@ proc ProcessContourCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - contour::YY_FLUSH_BUFFER - contour::yy_scan_string [lrange $var $i end] - contour::yyparse - incr i [expr $contour::yycnt-1] - } else { - - global contour - global current - switch -- [string tolower [lindex $var $i]] { - open {ContourDialog} - close {ContourDestroyDialog} - clear {ContourOffDialog} - load { - incr i - set fn [lindex $var $i] - if {$fn != {}} { - if {[file extension $fn] == {.con}} { - # backward compatibility - incr i - set sys [lindex $var $i] - incr i - set sky [lindex $var $i] - incr i - set color [lindex $var $i] - incr i - set width [lindex $var $i] - incr i - set dash [lindex $var $i] - incr i [ProcessContourFix sys sky color width dash] - $current(frame) contour load $color $width $dash \ - "\{$fn\}" $sys $sky - } else { - incr i - set color [lindex $var $i] - if {$color == {} || [string range $color 0 0] == "-"} { - $current(frame) contour load "\{$fn\}" - incr i -1 - } else { - incr i - set width [lindex $var $i] - incr i - set dash [FromYesNo [lindex $var $i]] - $current(frame) contour load "\{$fn\}" \ - $color $width $dash - } - } - } - FileLast contourlfbox $fn - UpdateContourDialog - } - save { - incr i - set fn [lindex $var $i] - incr i - set sys [lindex $var $i] - incr i - set sky [lindex $var $i] - # Backward compatibility - incr i - set color {} - incr i - set width {} - incr i - set dash {} - incr i [ProcessContourFix sys sky color width dash] - if {$fn != {}} { - $current(frame) contour save "\{$fn\}" $sys $sky - } - FileLast contoursfbox $fn - } - convert {Contour2Polygons} - loadlevels { - ContourDialog - incr i - ContourLoadLevelsNow [lindex $var $i] - UpdateContour - } - savelevels { - ContourDialog - incr i - ContourSaveLevelsNow [lindex $var $i] - } - copy {ContourCCopyDialog} - paste { - incr i - set sys [lindex $var $i] - incr i - set sky [lindex $var $i] - incr i - # backward compatibility - set color [lindex $var $i] - incr i - set width [lindex $var $i] - incr i - set dash [lindex $var $i] - incr i [ProcessContourFix sys sky color width dash] - if {$current(frame) != {} && $contour(copy) != {}} { - set cc [$contour(copy) get contour $sys $sky] - $current(frame) contour paste cc $color $width $dash - } - } - color { - ContourDialog - incr i - set contour(color) [lindex $var $i] - UpdateContour - } - width { - ContourDialog - incr i - set contour(width) [lindex $var $i] - UpdateContour - } - dash { - ContourDialog - incr i - set contour(dash) [FromYesNo [lindex $var $i]] - UpdateContour - } - smooth { - ContourDialog - incr i - set contour(smooth) [lindex $var $i] - ContourGenerateDialog - UpdateContour - } - method { - ContourDialog - incr i - set contour(method) [lindex $var $i] - ContourGenerateDialog - UpdateContour - } - nlevels { - ContourDialog - incr i - set contour(numlevel) [lindex $var $i] - ContourGenerateDialog - UpdateContour - } - scale { - set contour(init,scale) 1 - ContourDialog - incr i - set contour(scale) [string tolower [lindex $var $i]] - ContourGenerateDialog - UpdateContour - } - log { - set contour(init,scale) 1 - ContourDialog - incr i - switch -- [string tolower [lindex $var $i]] { - exp { - incr i - set contour(log) [string tolower [lindex $var $i]] - } - default { - incr i -1 - set contour(log) [string tolower [lindex $var $i]] - } - } - ContourGenerateDialog - UpdateContour - } - mode { - set contour(init,mode) 1 - ContourDialog - incr i - set contour(mode) [lindex $var $i] - ContourModeDialog - ContourGenerateDialog - UpdateContour - } - scope { - set contour(init,scope) 1 - ContourDialog - incr i - set contour(scope) [lindex $var $i] - ContourModeDialog - ContourGenerateDialog - UpdateContour - } - limits { - set contour(init,limits) 1 - ContourDialog - incr i - set contour(min) [lindex $var $i] - incr i - set contour(max) [lindex $var $i] - ContourGenerateDialog - UpdateContour - } - levels { - ContourDialog - global dcontour - $dcontour(txt) delete 1.0 end - incr i - $dcontour(txt) insert end [lindex $var $i] - UpdateContour - } - generate { - ContourDialog - ContourGenerateDialog - UpdateContour - } - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - set contour(view) [FromYesNo [lindex $var $i]] - UpdateContour - } - default { - set contour(view) 1 - UpdateContour - incr i -1 - } - } -} + contour::YY_FLUSH_BUFFER + contour::yy_scan_string [lrange $var $i end] + contour::yyparse + incr i [expr $contour::yycnt-1] } proc ContourCmdLoad {fn} { diff --git a/ds9/library/crop.tcl b/ds9/library/crop.tcl index 14a73ba..e4a2c01 100644 --- a/ds9/library/crop.tcl +++ b/ds9/library/crop.tcl @@ -393,56 +393,10 @@ proc ProcessCropCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - crop::YY_FLUSH_BUFFER - crop::yy_scan_string [lrange $var $i end] - crop::yyparse - incr i [expr $crop::yycnt-1] - } else { - - global crop - global current - switch -- [string tolower [lindex $var $i]] { - match { - incr i - MatchCropCurrent [lindex $var $i] - } - lock { - incr i - set crop(lock) [lindex $var $i] - LockCropCurrent - } - open {CropDialog} - close {CropDestroyDialog} - reset {CropReset} - 3d { - incr i 1 - set zmin [lindex $var [expr $i+0]] - set zmax [lindex $var [expr $i+1]] - set sys [lindex $var [expr $i+2]] - - incr i 1 - incr i [FixSpecSystem sys physical] - - $current(frame) crop 3d $zmin $zmax $sys - } - default { - set x [lindex $var [expr $i+0]] - set y [lindex $var [expr $i+1]] - set w [lindex $var [expr $i+2]] - set h [lindex $var [expr $i+3]] - set sys [lindex $var [expr $i+4]] - set sky [lindex $var [expr $i+5]] - set dformat [lindex $var [expr $i+6]] - - incr i 3 - incr i [FixSpec sys sky dformat physical fk5 degrees] - - $current(frame) crop center $x $y $sys $sky $w $h $sys $dformat - } - } -} + crop::YY_FLUSH_BUFFER + crop::yy_scan_string [lrange $var $i end] + crop::yyparse + incr i [expr $crop::yycnt-1] } proc CropCmdSet {which value {cmd {}}} { diff --git a/ds9/library/crosshair.tcl b/ds9/library/crosshair.tcl index 13264fe..18c9466 100644 --- a/ds9/library/crosshair.tcl +++ b/ds9/library/crosshair.tcl @@ -263,39 +263,10 @@ proc ProcessCrosshairCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - crosshair::YY_FLUSH_BUFFER - crosshair::yy_scan_string [lrange $var $i end] - crosshair::yyparse - incr i [expr $crosshair::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - match { - incr i - MatchCrosshairCurrent [lindex $var $i] - } - lock { - incr i - set crosshair(lock) [lindex $var $i] - LockCrosshairCurrent - } - default { - set x [lindex $var [expr $i+0]] - set y [lindex $var [expr $i+1]] - set sys [lindex $var [expr $i+2]] - set sky [lindex $var [expr $i+3]] - set format {} - - incr i 1 - incr i [FixSpec sys sky format physical fk5 degrees] - - CrosshairTo $x $y $sys $sky - UpdateCrosshairDialog - } - } -} + crosshair::YY_FLUSH_BUFFER + crosshair::yy_scan_string [lrange $var $i end] + crosshair::yyparse + incr i [expr $crosshair::yycnt-1] } proc CrosshairCmdSet {which value {cmd {}}} { diff --git a/ds9/library/cube.tcl b/ds9/library/cube.tcl index e43bc4b..6fe09ec 100644 --- a/ds9/library/cube.tcl +++ b/ds9/library/cube.tcl @@ -707,147 +707,10 @@ proc ProcessCubeCmd {varname iname} { CubeDialog - global debug - if {$debug(tcl,parser)} { - cube::YY_FLUSH_BUFFER - cube::yy_scan_string [lrange $var $i end] - cube::yyparse - incr i [expr $cube::yycnt-1] - } else { - - global cube - global dcube - - global blink - global current - global rgb - - switch -- [string tolower [lindex $var $i]] { - match { - 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 - } - } - lock { - 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 - } - open {} - close {CubeDestroyDialog} - play {CubePlay} - stop {CubeStop} - next {CubeNext} - prev {CubePrev} - first {CubeFirst} - last {CubeLast} - interval { - incr i - set blink(interval) [expr int([lindex $var $i]*1000)] - } - axis { - incr i; - set item [lindex $var $i] - if {[string is integer $item]} { - set cube(axis) [expr $item-1] - if {$cube(axis) < 2} { - set cube(axis) 2 - } - } - } - axes - - order { - incr i; - switch -- [string tolower [lindex $var $i]] { - lock { - 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 - } - default { - set cube(axes) [lindex $var $i] - CubeAxes - } - } - } - default { - # defaults - set ss 1 - set sys image - set axis 2 - - # slice - set item [lindex $var $i] - if {$item != {}} { - if {!([string range $item 0 0] == "-")} { - if {[string is double $item]} { - set ss $item - } else { - set sys $item - } - - # sys - set item [lindex $var [expr $i+1]] - if {$item != {}} { - if {!([string range $item 0 0] == "-")} { - incr i - if {[string is integer $item]} { - set axis [expr $item-1] - } else { - set sys $item - } - - # axis - set item [lindex $var [expr $i+1]] - if {$item != {}} { - if {!([string range $item 0 0] == "-")} { - incr i - if {[string is integer $item]} { - set axis [expr $item-1] - } - } - } - } - } - } else { - incr i -1 - } - } - - set dcube(wcs,$axis) $ss - set cube(system) $sys - set cube(axis) $axis - if {$cube(axis) < 2} { - set cube(axis) 2 - } - CubeApply $cube(axis) - } - } -} + cube::YY_FLUSH_BUFFER + cube::yy_scan_string [lrange $var $i end] + cube::yyparse + incr i [expr $cube::yycnt-1] } proc CubeCmdCoord {ss sys axis} { diff --git a/ds9/library/grid.tcl b/ds9/library/grid.tcl index 9816168..3333e84 100644 --- a/ds9/library/grid.tcl +++ b/ds9/library/grid.tcl @@ -1140,284 +1140,10 @@ proc ProcessGridCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - grid::YY_FLUSH_BUFFER - grid::yy_scan_string [lrange $var $i end] - grid::yyparse - incr i [expr $grid::yycnt-1] - } else { - - global grid - switch -- [string tolower [lindex $var $i]] { - open {GridDialog} - close {GridDestroyDialog} - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - set grid(view) [FromYesNo [lindex $var $i]] - GridUpdateCurrent - } - type { - incr i - switch -- [string tolower [lindex $var $i]] { - axes { - # backward compatible - incr i; set grid(axes,type) [lindex $var $i] - } - numerics { - # backward compatible - incr i; set grid(numlab,type) [lindex $var $i] - } - default {set grid(type) [lindex $var $i]} - } - GridUpdateCurrent - } - system {incr i; set grid(system) [lindex $var $i]; GridUpdateCurrent} - sky {incr i - set grid(sky) [string tolower [lindex $var $i]] - GridUpdateCurrent - } - skyformat { - incr i - switch -- [string tolower [lindex $var $i]] { - deg - - degree - - degrees {set grid(skyformat) degrees} - default {set grid(skyformat) [string tolower [lindex $var $i]]} - } - GridUpdateCurrent - } - grid { - incr i - switch -- [string tolower [lindex $var $i]] { - color {incr i; set grid(grid,color) [lindex $var $i]} - width {incr i; set grid(grid,width) [lindex $var $i]} - dash {incr i; set grid(grid,style) [FromYesNo [lindex $var $i]]} - style { - # backward compatibility - incr i; set grid(grid,style) [lindex $var $i] - } - gap1 {incr i; set grid(grid,gap1) [lindex $var $i]} - gap2 {incr i; set grid(grid,gap2) [lindex $var $i]} - gap3 {incr i; set grid(grid,gap3) [lindex $var $i]} - default {set grid(grid) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - axes { - incr i - switch -- [string tolower [lindex $var $i]] { - color {incr i; set grid(axes,color) [lindex $var $i]} - width {incr i; set grid(axes,width) [lindex $var $i]} - dash {incr i; set grid(axes,style) [FromYesNo [lindex $var $i]]} - style { - # backward compatibility - incr i; set grid(axes,style) [lindex $var $i] - } - type {incr i; set grid(axes,type) [lindex $var $i]} - origin {incr i; set grid(axes,origin) [lindex $var $i]} - default {set grid(axes) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - format1 { - incr i; set grid(format1) [lindex $var $i] - GridUpdateCurrent - } - format2 { - incr i; set grid(format2) [lindex $var $i] - GridUpdateCurrent - } - tickmark - - tickmarks - - tick { - incr i - switch -- [string tolower [lindex $var $i]] { - color {incr i; set grid(tick,color) [lindex $var $i]} - width {incr i; set grid(tick,width) [lindex $var $i]} - dash {incr i; set grid(tick,style) [FromYesNo [lindex $var $i]]} - style { - # backward compatibility - incr i; set grid(tick,style) [lindex $var $i] - } - default {set grid(tick) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - border { - incr i - switch -- [string tolower [lindex $var $i]] { - color {incr i; set grid(border,color) [lindex $var $i]} - width {incr i; set grid(border,width) [lindex $var $i]} - dash {incr i; set grid(border,style) [FromYesNo [lindex $var $i]]} - style { - # backward compatibility - incr i; set grid(border,style) [lindex $var $i] - } - default {set grid(border) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - numeric - - numerics - - numlab { - incr i - switch -- [string tolower [lindex $var $i]] { - font {incr i; set grid(numlab,font) [lindex $var $i]} - fontsize {incr i; set grid(numlab,size) [lindex $var $i]} - fontweight {incr i; set grid(numlab,weight) [lindex $var $i]} - fontslant {incr i; set grid(numlab,slant) [lindex $var $i]} - fontstyle { - # backward compatibility - incr i - switch [lindex $var $i] { - normal { - set grid(numlab,weight) normal - set grid(numlab,slant) roman - } - bold { - set grid(numlab,weight) bold - set grid(numlab,slant) roman - } - italic { - set grid(numlab,weight) normal - set grid(numlab,slant) italic - } - } - } - color {incr i; set grid(numlab,color) [lindex $var $i]} - gap1 {incr i; set grid(numlab,gap1) [lindex $var $i]} - gap2 {incr i; set grid(numlab,gap2) [lindex $var $i]} - gap3 {incr i; set grid(numlab,gap3) [lindex $var $i]} - type {incr i; set grid(numlab,type) [lindex $var $i]} - vertical {incr i; set grid(numlab,vertical) [FromYesNo [lindex $var $i]]} - default {set grid(numlab) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - title { - incr i - switch -- [string tolower [lindex $var $i]] { - text {incr i; set grid(title,text) [lindex $var $i]} - def {incr i; set grid(title,def) [FromYesNo [lindex $var $i]]} - gap {incr i; set grid(title,gap) [lindex $var $i]} - font {incr i; set grid(title,font) [lindex $var $i]} - fontsize {incr i; set grid(title,size) [lindex $var $i]} - fontweight {incr i; set grid(title,weight) [lindex $var $i]} - fontslant {incr i; set grid(title,slant) [lindex $var $i]} - fontstyle { - # backward compatibility - incr i - switch [lindex $var $i] { - normal { - set grid(title,weight) normal - set grid(title,slant) roman - } - bold { - set grid(title,weight) bold - set grid(title,slant) roman - } - italic { - set grid(title,weight) normal - set grid(title,slant) italic - } - } - } - color {incr i; set grid(title,color) [lindex $var $i]} - default {set grid(title) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - label - - labels - - textlab { - incr i - switch -- [string tolower [lindex $var $i]] { - text1 {incr i; set grid(textlab,text1) [lindex $var $i]} - text2 {incr i; set grid(textlab,text2) [lindex $var $i]} - def1 {incr i; set grid(textlab,def1) [FromYesNo [lindex $var $i]]} - def2 {incr i; set grid(textlab,def2) [FromYesNo [lindex $var $i]]} - gap1 {incr i; set grid(textlab,gap1) [lindex $var $i]} - gap2 {incr i; set grid(textlab,gap2) [lindex $var $i]} - font {incr i; set grid(textlab,font) [lindex $var $i]} - fontsize {incr i; set grid(textlab,size) [lindex $var $i]} - fontweight {incr i; set grid(textlab,weight) [lindex $var $i]} - fontslant {incr i; set grid(textlab,slant) [lindex $var $i]} - fontstyle { - # backward compatibility - incr i - switch [lindex $var $i] { - normal { - set grid(textlab,weight) normal - set grid(textlab,slant) roman - } - bold { - set grid(textlab,weight) bold - set grid(textlab,slant) roman - } - italic { - set grid(textlab,weight) normal - set grid(textlab,slant) italic - } - } - } - color {incr i; set grid(textlab,color) [lindex $var $i]} - default {set grid(textlab) [FromYesNo [lindex $var $i]]} - } - GridUpdateCurrent - } - view { - # backward compatable - incr i - switch -- [string tolower [lindex $var $i]] { - grid {incr i; set grid(grid) [FromYesNo [lindex $var $i]]} - axes { - incr i - switch -- [string tolower [lindex $var $i]] { - numbers {incr i; set grid(numlab) \ - [FromYesNo [lindex $var $i]]} - tickmarks {incr i; set grid(tick) \ - [FromYesNo [lindex $var $i]]} - label {incr i; set grid(textlab) \ - [FromYesNo [lindex $var $i]]} - default {set grid(axes) [FromYesNo [lindex $var $i]]} - } - } - title {incr i; set grid(title) [FromYesNo [lindex $var $i]]} - border {incr i; set grid(border) [FromYesNo [lindex $var $i]]} - vertical { - incr i - set grid(numlab,vertical) [FromYesNo [lindex $var $i]] - } - } - GridUpdateCurrent - } - reset {GridResetDialog} - load { - incr i - set fn [lindex $var $i] - FileLast gridfbox $fn - GridLoad $fn - } - save { - incr i - set fn [lindex $var $i] - FileLast gridfbox $fn - GridSave $fn - } - default { - set grid(view) 1 - GridUpdateCurrent - incr i -1 - } - } -} + grid::YY_FLUSH_BUFFER + grid::yy_scan_string [lrange $var $i end] + grid::yyparse + incr i [expr $grid::yycnt-1] } proc GridCmdSet {which value {cmd {}}} { diff --git a/ds9/library/header.tcl b/ds9/library/header.tcl index 6762bea..110f912 100644 --- a/ds9/library/header.tcl +++ b/ds9/library/header.tcl @@ -143,59 +143,10 @@ proc ProcessHeaderCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - header::YY_FLUSH_BUFFER - header::yy_scan_string [lrange $var $i end] - header::yyparse - incr i [expr $header::yycnt-1] - } else { - - set item [string tolower [lindex $var $i]] - switch -- $item { - close - - save {incr i} - } - - if {[lindex $var $i] != {} && [string is integer [lindex $var $i]]} { - set jj [lindex $var $i] - incr i - } else { - set jj 1 - } - - global current - if {$current(frame) != {}} { - switch -- $item { - close { - set vvarname "hd[string range $current(frame) end end]-$jj" - upvar #0 $vvarname vvar - global $vvarname - - if {[info exists vvar(top)]} { - SimpleTextDestroy $vvarname - } - incr i -1 - } - save { - set fn [lindex $var $i] - if {$fn != {}} { - if {[catch {set ch [open "| cat > \"$fn\"" w]}]} { - Error [msgcat::mc {An error has occurred while saving}] - return - } - puts -nonewline $ch [$current(frame) get fits header $jj] - close $ch - } - } - default { - catch {DisplayHeader $current(frame) $jj \ - [$current(frame) get fits file name $jj]} - incr i -1 - } - } - } -} + header::YY_FLUSH_BUFFER + header::yy_scan_string [lrange $var $i end] + header::yyparse + incr i [expr $header::yycnt-1] } proc DisplayHeaderCmd {id} { diff --git a/ds9/library/hv.tcl b/ds9/library/hv.tcl index a197300..a7defb7 100644 --- a/ds9/library/hv.tcl +++ b/ds9/library/hv.tcl @@ -825,100 +825,14 @@ proc ProcessWebCmd {varname iname} { upvar $iname i global ihv - global debug - if {$debug(tcl,parser)} { - set ref [lindex $ihv(windows) end] - global cvarname - set cvarname $ref - - web::YY_FLUSH_BUFFER - web::yy_scan_string [lrange $var $i end] - web::yyparse - incr i [expr $web::yycnt-1] - } else { - - set w {hvweb} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - set ii [lsearch $ihv(windows) $w] - if {$ii>=0} { - append w $ihv(unique) - incr ihv(unique) - } - } - close - - clear - - click {set w [lindex $ihv(windows) end]} - - default { - set ii [lsearch $ihv(windows) [lindex $var $i]] - if {$ii>=0} { - set w [lindex $var $i] - incr i - } - } - } + set ref [lindex $ihv(windows) end] + global cvarname + set cvarname $ref - switch -- [string tolower [lindex $var $i]] { - close {HVDestroy $w} - clear {HVClearCmd $w} - click { - set vvarname $w - upvar #0 $vvarname vvar - global $vvarname - - incr i - switch -- [string tolower [lindex $var $i]] { - back {HVBackCmd $vvarname} - forward {HVForwardCmd $vvarname} - stop {HVStopCmd $vvarname} - reload {HVReloadCmd $vvarname} - default { - set id [lindex $var $i] - - if {![info exists vvar(widget)]} { - return - } - - set tokens [$vvar(widget) token list 1.0 end] - set cnt 0 - for {set ii 0} {$ii<[llength $tokens]} {incr ii} { - set tok [lindex $tokens $ii] - if {[string tolower [lindex $tok 0]] == "markup" && - [string tolower [lindex $tok 2]] == "href"} { - set url [lindex $tok 3] - incr cnt - if {$cnt == $id} { - HVResolveURL $vvarname [$vvar(widget) resolve $url] - break; - } - } - } - } - } - } - default { - set url [lindex $var $i] - if {[string length $url] == 0} { - HV $w Web {} {} 1 - } else { - ParseURL $url r - switch -- $r(scheme) { - {} { - # append 'http://' if needed - if {[string range $r(path) 0 0] == "/"} { - set url "http:/$url" - } else { - set url "http://$url" - } - } - } - HV $w Web $url {} 1 - } - } - } -} + web::YY_FLUSH_BUFFER + web::yy_scan_string [lrange $var $i end] + web::yyparse + incr i [expr $web::yycnt-1] } proc WebCmdCheck {} { diff --git a/ds9/library/marker.tcl b/ds9/library/marker.tcl index 5ecd893..8f2a384 100644 --- a/ds9/library/marker.tcl +++ b/ds9/library/marker.tcl @@ -1396,571 +1396,19 @@ proc ProcessRegionsCmd {varname iname sock fn} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - global parse - set parse(sock) $sock - set parse(fn) $fn - - set marker(load,format) $marker(format) - set marker(load,system) $marker(system) - set marker(load,sky) $marker(sky) - set marker(tag) {} - - region::YY_FLUSH_BUFFER - region::yy_scan_string [lrange $var $i end] - region::yyparse - incr i [expr $region::yycnt-1] - } else { - - global ds9 - global current - global pmarker - - switch -- [string tolower [lindex $var $i]] { - epsilon { - incr i - set pmarker(epsilon) [lindex $var $i] - MarkerEpsilon - } - show { - incr i - set marker(show) [FromYesNo [lindex $var $i]] - MarkerShow - } - showtext { - incr i - set marker(show,text) [FromYesNo [lindex $var $i]] - MarkerShowText - } - getinfo {MarkerInfo} - centroid { - incr i - switch -- [string tolower [lindex $var $i]] { - auto { - incr i - set marker(centroid,auto) [FromYesNo [lindex $var $i]] - MarkerCentroidAuto - } - radius { - incr i - set marker(centroid,radius) [lindex $var $i] - MarkerCentroidRadius - } - iteration { - incr i - set marker(centroid,iteration) [lindex $var $i] - MarkerCentroidIteration - } - default { - incr i -1 - MarkerCentroid - } - } - } - autocentroid { - # backward compatibilty - incr i - set marker(centroid,auto) [FromYesNo [lindex $var $i]] - MarkerCentroidAuto - } - movefront {MarkerFront} - moveback {MarkerBack} - move { - incr i - switch -- [string tolower [lindex $var $i]] { - front {MarkerFront} - back {MarkerBack} - } - } - - selectall {MarkerSelectAll} - selectnone {MarkerUnselectAll} - select { - incr i - switch -- [string tolower [lindex $var $i]] { - group { - # backward compatibility, use group <> select - incr i - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker "\{[lindex $var $i]\}" select - } - } - } - all {MarkerSelectAll} - none {MarkerUnselectAll} - invert {MarkerSelectInvert} - } - } - - deleteall {MarkerDeleteAll} - delete { - incr i - switch -- [string tolower [lindex $var $i]] { - select {MarkerDeleteSelect} - all {MarkerDeleteAll} - } - } - - format { - incr i - set marker(format) [string tolower [lindex $var $i]] - } - coord - - system { - # for backward compatibility - incr i - switch -- [string tolower [lindex $var $i]] { - fk4 - - b1950 - - fk5 - - j2000 - - icrs - - galactic - - ecliptic { - incr i - set marker(system) wcs - set marker(sky) [string tolower [lindex $var $i]] - } - - default {set marker(system) [string tolower [lindex $var $i]]} - } - } - sky { - incr i - set marker(sky) [string tolower [lindex $var $i]] - } - coordformat - - skyformat { - incr i - switch -- [string tolower [lindex $var $i]] { - deg - - degree - - degrees {set marker(skyformat) degrees} - default { - set marker(skyformat) [string tolower [lindex $var $i]] - } - } - } - strip { - incr i - set marker(strip) [FromYesNo [lindex $var $i]] - } - delim { - incr i - if {[lindex $var $i] != "nl"} { - set marker(strip) 1 - } else { - set marker(strip) 0 - } - } - shape { - incr i - set marker(shape) [string tolower [lindex $var $i]] - } - color { - incr i - set marker(color) [string tolower [lindex $var $i]] - MarkerColor - } - width { - incr i - set marker(width) [lindex $var $i] - MarkerWidth - } - - fixed { - incr i - set marker(fixed) [FromYesNo [lindex $var $i]] - MarkerProp fixed - } - edit { - incr i - set marker(edit) [FromYesNo [lindex $var $i]] - MarkerProp edit - } - rotate { - incr i - set marker(rotate) [FromYesNo [lindex $var $i]] - MarkerProp rotate - } - delete { - incr i - set marker(delete) [FromYesNo [lindex $var $i]] - MarkerProp delete - } - include { - set marker(include) 1 - MarkerProp include - } - exclude { - set marker(include) 0 - MarkerProp include - } - source { - set marker(source) 1 - MarkerProp source - } - background { - set marker(source) 0 - MarkerProp source - } - - tag - - tags - - group - - groups { - incr i - - if {[string tolower [lindex $var $i]] == {new}} { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - set name [$current(frame) get marker tag default name] - $current(frame) marker tag "\{$name\}" - UpdateGroupDialog - } - } - } else { - set tag "\{[lindex $var $i]\}" - incr i - switch -- [string tolower [lindex $var $i]] { - new { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker tag $tag - UpdateGroupDialog - } - } - } - update { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker tag update $tag - UpdateGroupDialog - } - } - } - delete { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag delete - UpdateGroupDialog - } - } - } - select { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag select - } - } - } - color { - incr i - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag color \ - [string tolower [lindex $var $i]] - } - } - } - copy { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag copy - } - } - } - cut { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag cut - } - } - } - font { - incr i - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag font \ - "\{[lindex $var $i]\}" - } - } - } - move { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag move \ - [lindex $var [expr $i+1]] \ - [lindex $var [expr $i+2]] - } - } - incr i 2 - } - movefront { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag move front - } - } - } - moveback { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag move back - } - } - } - property { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker $tag property \ - [lindex $var [expr $i+1]] \ - [lindex $var [expr $i+2]] - } - } - incr i 2 - } - } - } - } - - copy {MarkerCopy} - cut {MarkerCut} - paste { - set marker(paste,system) [string tolower [lindex $var [expr $i+1]]] - switch -- $marker(paste,system) { - image - - physical - - detector - - amplifier - - 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 {} - default {set marker(paste,system) wcs} - } - -# backward compatibility - if {[string range [lindex $var [expr $i+2]] 0 0] == {-}} { - incr i 1 - } else { - incr i 2 - } - - MarkerPaste - } - undo {MarkerUndo} - - composite {CompositeCreate} - desolve - - dissove {CompositeDelete} - - template { - incr i - set ff [lindex $var $i] - incr i - switch -- [string tolower [lindex $var $i]] { - at { - incr i - set ra [lindex $var $i] - incr i - set dec [lindex $var $i] - incr i - set sys [string tolower [lindex $var $i]] - incr i - set sky [string tolower [lindex $var $i]] - switch -- $sys { - fk4 - - fk5 - - icrs - - galatic - - ecliptic { - set sky $sys - set sys wcs - incr i -1 - } - } - LoadTemplateMarkerAt $ff $ra $dec $sys $sky - FileLast templatefbox $ff - } - default { - LoadTemplateMarker $ff - FileLast templatefbox $ff - incr i -1 - } - } - } - savetemplate { - incr i - set ff [lindex $var $i] - if {$ff != {}} { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker save template "\{$ff\}" - } - } - FileLast templatefbox $ff - } - } - - command { - incr i - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker command $marker(format) \ - "\{[lindex $var $i]\}" - } - } - UpdateGroupDialog - } - - list { - incr i - switch -- [string tolower [lindex $var $i]] { - close {SimpleTextDestroy markertxt} - default { - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - SimpleTextDialog markertxt [msgcat::mc {Region}] \ - 80 20 insert top \ - [$current(frame) marker list $marker(format) \ - $marker(system) $marker(sky) \ - $marker(skyformat) $marker(strip)] - } - } - incr i -1 - } - } - } - save { - incr i - set ff [lindex $var $i] - if {$ff == {}} { - return - } - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker save "\{$ff\}" \ - $marker(format) $marker(system) $marker(sky) \ - $marker(skyformat) $marker(strip) - } - } - FileLast markerfbox $ff - } - - file - - load { - incr i - switch -- [string tolower [lindex $var $i]] { - all { - incr i - set frames $ds9(frames) - } - default { - set frames $current(frame) - } - } - MarkerLoadFrames [lindex $var $i] $frames \ - $marker(format) $marker(system) $marker(sky) - } - default { - set format $marker(format) - set sys $marker(system) - set sky $marker(sky) - - while {[string range [lindex $var $i] 0 0] == "-"} { - switch -- [string tolower [lindex $var $i]] { - -format { - incr i - set format [lindex $var $i] - } - -sys - - -coord - - -system { - incr i - # for backward compatibility - switch -- [lindex $var $i] { - fk4 - - fk5 - - icrs - - galactic - - ecliptic { - set sys wcs - set sky [lindex $var $i] - } - default { - set sys [lindex $var $i] - } - } - } - -sky { - incr i - set sky [lindex $var $i] - } - default { - Error "Illegal option: [lindex $var $i]" - return - } - } - incr i - } + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - # xpa path - if {[lindex $var $i] != {}} { - MarkerLoadFrames [lindex $var $i] $current(frame) \ - $format $sys $sky - } else { - # fits regions files not supported - if {$current(frame) != {}} { - if {[$current(frame) has fits]} { - $current(frame) marker load $format $sock $sys $sky - } - } - UpdateGroupDialog - } - } elseif {$fn != {}} { - # samp path - if {[lindex $var $i] != {}} { - MarkerLoadFrames [lindex $var $i] $current(frame) \ - $format $sys $sky - } else { - MarkerLoadFrames $fn $current(frame) \ - $format $sys $sky - } - } else { - # this will open a fits regions file - MarkerLoadFrames [lindex $var $i] $current(frame) \ - $format $sys $sky - } - } - } -} + set marker(load,format) $marker(format) + set marker(load,system) $marker(system) + set marker(load,sky) $marker(sky) + set marker(tag) {} + + region::YY_FLUSH_BUFFER + region::yy_scan_string [lrange $var $i end] + region::yyparse + incr i [expr $region::yycnt-1] } proc MarkerCmdSet {which value {cmd {}}} { diff --git a/ds9/library/mask.tcl b/ds9/library/mask.tcl index a6ba7d9..d5128d9 100644 --- a/ds9/library/mask.tcl +++ b/ds9/library/mask.tcl @@ -261,59 +261,15 @@ proc ProcessMaskCmd {varname iname} { upvar $iname i global mask + global parse + set parse(result) {} - global debug - if {$debug(tcl,parser)} { - global parse - set parse(result) {} - - mask::YY_FLUSH_BUFFER - mask::yy_scan_string [lrange $var $i end] - mask::yyparse - incr i [expr $mask::yycnt-1] - - return $parse(result) - } else { - - set rr {} - global current - switch -- [string tolower [lindex $var $i]] { - open {MaskDialog} - close {MaskDestroyDialog} - color { - incr i - set mask(color) [lindex $var $i] - if {$current(frame) != {}} { - $current(frame) mask color $mask(color) - } - } - mark { - incr i - set mask(mark) [lindex $var $i] - if {$current(frame) != {}} { - $current(frame) mask mark $mask(mark) - } - } - transparency { - incr i - set mask(transparency) [lindex $var $i] - if {$current(frame) != {}} { - $current(frame) mask transparency $mask(transparency) - } - MaskTransparency - } - clear { - MaskClear - } + mask::YY_FLUSH_BUFFER + mask::yy_scan_string [lrange $var $i end] + mask::yyparse + incr i [expr $mask::yycnt-1] - default { - set rr mask - incr i -1 - } - } - - return $rr -} + return $parse(result) } proc MaskCmdSet {which value {cmd {}}} { diff --git a/ds9/library/nameres.tcl b/ds9/library/nameres.tcl index 8af9383..8acb236 100644 --- a/ds9/library/nameres.tcl +++ b/ds9/library/nameres.tcl @@ -186,61 +186,13 @@ proc ProcessNRESCmd {varname iname} { NRESDialog - global debug - if {$debug(tcl,parser)} { - global cvarname - set cvarname dnres - - nres::YY_FLUSH_BUFFER - nres::yy_scan_string [lrange $var $i end] - nres::yyparse - incr i [expr $nres::yycnt-1] - } else { - - set vvarname dnres - upvar #0 $vvarname vvar - global $vvarname - - global nres - global pnres + global cvarname + set cvarname dnres - switch -- [string tolower [lindex $var $i]] { - {} - - open {} - close {ARDestroy $vvarname} - server { - incr i - set pnres(server) [lindex $var $i] - } - pan {NRESPan $vvarname} - crosshair {NRESCrosshair $vvarname} - format - - skyformat { - incr i - switch -- [string tolower [lindex $var $i]] { - deg - - degree - - degrees { - set vvar(skyformat) degrees - set vvar(skyformat,msg) $vvar(skyformat) - } - default { - set vvar(skyformat) [string tolower [lindex $var $i]] - set vvar(skyformat,msg) $vvar(skyformat) - } - } - } - name { - incr i - set vvar(name) [lindex $var $i] - NRESApply $vvarname 1 - } - default { - set vvar(name) [lindex $var $i] - NRESApply $vvarname 1 - } - } -} + nres::YY_FLUSH_BUFFER + nres::yy_scan_string [lrange $var $i end] + nres::yyparse + incr i [expr $nres::yycnt-1] } proc NRESCmdSet {which value} { diff --git a/ds9/library/nrrd.tcl b/ds9/library/nrrd.tcl index 1193eb1..8307b53 100644 --- a/ds9/library/nrrd.tcl +++ b/ds9/library/nrrd.tcl @@ -84,51 +84,14 @@ proc ProcessNRRDCmd {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 - - nrrd::YY_FLUSH_BUFFER - nrrd::yy_scan_string [lrange $var $i end] - nrrd::yyparse - incr i [expr $nrrd::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 {![ImportNRRDSocket $sock $param $layer]} { - InitError xpa - ImportNRRDFile $param $layer - } - } else { - # comm - if {$fn != {}} { - ImportNRRDAlloc $fn $param $layer - } else { - ImportNRRDFile $param $layer - } - } - FinishLoad -} + nrrd::YY_FLUSH_BUFFER + nrrd::yy_scan_string [lrange $var $i end] + nrrd::yyparse + incr i [expr $nrrd::yycnt-1] } proc NRRDCmdLoad {param layer} { diff --git a/ds9/library/panzoom.tcl b/ds9/library/panzoom.tcl index ae3de93..0c0fd67 100644 --- a/ds9/library/panzoom.tcl +++ b/ds9/library/panzoom.tcl @@ -693,41 +693,10 @@ proc ProcessPanCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - pan::YY_FLUSH_BUFFER - pan::yy_scan_string [lrange $var $i end] - pan::yyparse - incr i [expr $pan::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - open {PanZoomDialog} - close {PanZoomDestroyDialog} - to { - set x [lindex $var [expr $i+1]] - set y [lindex $var [expr $i+2]] - set sys [lindex $var [expr $i+3]] - set sky [lindex $var [expr $i+4]] - set format {} - - incr i 2 - incr i [FixSpec sys sky format physical fk5 degrees] - PanTo $x $y $sys $sky - } - default { - set x [lindex $var [expr $i+0]] - set y [lindex $var [expr $i+1]] - set sys [lindex $var [expr $i+2]] - set sky [lindex $var [expr $i+3]] - set format {} - - incr i 1 - incr i [FixSpec sys sky format physical fk5 degrees] - Pan $x $y $sys $sky - } - } -} + pan::YY_FLUSH_BUFFER + pan::yy_scan_string [lrange $var $i end] + pan::yyparse + incr i [expr $pan::yycnt-1] } proc ProcessSendPanCmd {proc id param} { @@ -750,52 +719,10 @@ proc ProcessZoomCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - zoom::YY_FLUSH_BUFFER - zoom::yy_scan_string [lrange $var $i end] - zoom::yyparse - incr i [expr $zoom::yycnt-1] - } else { - - global current - switch -- [string tolower [lindex $var $i]] { - open {PanZoomDialog} - close {PanZoomDestroyDialog} - in {Zoom 2 2} - out {Zoom .5 .5} - to { - switch -- [string tolower [lindex $var [expr $i+1]]] { - fit { - ZoomToFit - incr i - } - default { - set z1 [lindex $var [expr $i+1]] - set z2 [lindex $var [expr $i+2]] - if {[string is double $z2] && $z2 != {}} { - set current(zoom) "$z1 $z2" - incr i 2 - } else { - set current(zoom) "$z1 $z1" - incr i - } - ChangeZoom - } - } - } - default { - set z1 [lindex $var $i] - set z2 [lindex $var [expr $i+1]] - if {[string is double $z2] && $z2 != {}} { - Zoom $z1 $z2 - incr i - } else { - Zoom $z1 $z1 - } - } - } -} + zoom::YY_FLUSH_BUFFER + zoom::yy_scan_string [lrange $var $i end] + zoom::yyparse + incr i [expr $zoom::yycnt-1] } proc ProcessSendZoomCmd {proc id param} { @@ -817,24 +744,10 @@ proc ProcessOrientCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - orient::YY_FLUSH_BUFFER - orient::yy_scan_string [lrange $var $i end] - orient::yyparse - incr i [expr $orient::yycnt-1] - } else { - - global current - switch -- [string tolower [lindex $var $i]] { - open {PanZoomDialog} - close {PanZoomDestroyDialog} - default { - set current(orient) [string tolower [lindex $var $i]] - ChangeOrient - } - } -} + orient::YY_FLUSH_BUFFER + orient::yy_scan_string [lrange $var $i end] + orient::yyparse + incr i [expr $orient::yycnt-1] } proc ProcessSendOrientCmd {proc id param} { @@ -849,26 +762,10 @@ proc ProcessRotateCmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - rotate::YY_FLUSH_BUFFER - rotate::yy_scan_string [lrange $var $i end] - rotate::yyparse - incr i [expr $rotate::yycnt-1] - } else { - - global current - switch -- [string tolower [lindex $var $i]] { - open {PanZoomDialog} - close {PanZoomDestroyDialog} - to { - set current(rotate) [lindex $var [expr $i+1]] - ChangeRotate - incr i - } - default {Rotate [lindex $var $i]} - } -} + rotate::YY_FLUSH_BUFFER + rotate::yy_scan_string [lrange $var $i end] + rotate::yyparse + incr i [expr $rotate::yycnt-1] } proc ProcessSendRotateCmd {proc id param} { diff --git a/ds9/library/photo.tcl b/ds9/library/photo.tcl index 0bdaaaf..dad5534 100644 --- a/ds9/library/photo.tcl +++ b/ds9/library/photo.tcl @@ -203,59 +203,14 @@ proc ProcessPhotoCmd {varname iname ch fn} { upvar 2 $varname var upvar 2 $iname i - global debug - if {$debug(tcl,parser)} { - global parse - set parse(ch) $ch - set parse(fn) $fn - - photo::YY_FLUSH_BUFFER - photo::yy_scan_string [lrange $var $i end] - photo::yyparse - incr i [expr $photo::yycnt-1] - } else { - - set mode {} - switch -- [string tolower [lindex $var $i]] { - new { - incr i - CreateFrame - } - mask { - incr i - # not supported - } - slice { - incr i - set mode slice - } - } - set param [lindex $var $i] + global parse + set parse(ch) $ch + set parse(fn) $fn - if {$ch != {}} { - # xpa - global tcl_platform - switch $tcl_platform(os) { - Linux - - Darwin - - SunOS { - if {![ImportPhotoSocket $ch $param $mode]} { - InitError xpa - ImportPhotoFile $param $mode - } - } - {Windows NT} {ImportPhotoFile $param $mode} - } - } else { - # comm - if {$fn != {}} { - ImportPhotoAlloc $fn $param $mode - } else { - ImportPhotoFile $param $mode - } - } - FinishLoad -} + photo::YY_FLUSH_BUFFER + photo::yy_scan_string [lrange $var $i end] + photo::yyparse + incr i [expr $photo::yycnt-1] } proc PhotoCmdLoad {param mode} { diff --git a/ds9/library/pixel.tcl b/ds9/library/pixel.tcl index 5445841..475b846 100644 --- a/ds9/library/pixel.tcl +++ b/ds9/library/pixel.tcl @@ -266,33 +266,10 @@ proc ProcessPixelTableCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - pixeltable::YY_FLUSH_BUFFER - pixeltable::yy_scan_string [lrange $var $i end] - pixeltable::yyparse - incr i [expr $pixeltable::yycnt-1] - } else { - - switch -- [string tolower [lindex $var $i]] { - open - - yes - - true - - on - - 1 {PixelTableDialog} - - close - - no - - false - - off - - 0 {PixelTableDestroyDialog} - - default { - PixelTableDialog - incr i -1 - } - } -} + pixeltable::YY_FLUSH_BUFFER + pixeltable::yy_scan_string [lrange $var $i end] + pixeltable::yyparse + incr i [expr $pixeltable::yycnt-1] } proc PixelTableCmd {which} { diff --git a/ds9/library/rgb.tcl b/ds9/library/rgb.tcl index bb4cb40..b028384 100644 --- a/ds9/library/rgb.tcl +++ b/ds9/library/rgb.tcl @@ -264,79 +264,10 @@ proc ProcessRGBCmd {varname iname} { RGBDialog - global debug - if {$debug(tcl,parser)} { - rgb::YY_FLUSH_BUFFER - rgb::yy_scan_string [lrange $var $i end] - rgb::yyparse - incr i [expr $rgb::yycnt-1] - } else { - - global current - global rgb - - switch -- [string tolower [lindex $var $i]] { - open {} - close {RGBDestroyDialog} - red - - green - - blue { - set current(rgb) [string tolower [lindex $var $i]] - RGBChannel - } - channel { - incr i - set current(rgb) [string tolower [lindex $var $i]] - RGBChannel - } - lock { - incr i - set item [string tolower [lindex $var $i]] - incr i - if {!([string range [lindex $var $i] 0 0] == "-")} { - set rr [FromYesNo [lindex $var $i]] - } else { - set rr 1 - incr i -1 - } - switch -- $item { - wcs {set rgb(lock,wcs) $rr} - crop {set rgb(lock,crop) $rr} - slice {set rgb(lock,slice) $rr} - bin {set rgb(lock,bin) $rr} - axes - - order {set rgb(lock,axes) $rr} - scale {set rgb(lock,scale) $rr} - limits - - scalelimits {set rgb(lock,scalelimits) $rr} - color - - colormap - - colorbar {set rgb(lock,colorbar) $rr} - block {set rgb(lock,block) $rr} - smooth {set rgb(lock,smooth) $rr} - } - } - system { - incr i - set rgb(system) [string tolower [lindex $var $i]] - RGBSystem - } - view { - set w [lindex $var [expr $i+1]] - set yesno [lindex $var [expr $i+2]] - switch -- [string tolower $w] { - red {set rgb(red) [FromYesNo $yesno]; RGBView} - green {set rgb(green) [FromYesNo $yesno]; RGBView} - blue {set rgb(blue) [FromYesNo $yesno]; RGBView} - } - incr i 2 - } - default { - CreateRGBFrame - incr i -1 - } - } -} + rgb::YY_FLUSH_BUFFER + rgb::yy_scan_string [lrange $var $i end] + rgb::yyparse + incr i [expr $rgb::yycnt-1] } proc RGBCmdSet {which value {cmd {}}} { diff --git a/ds9/library/sia.tcl b/ds9/library/sia.tcl index 33f8570..0b577ad 100644 --- a/ds9/library/sia.tcl +++ b/ds9/library/sia.tcl @@ -367,84 +367,14 @@ proc ProcessSIACmd {varname iname} { # we need to be realized ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - set ref [lindex $isia(sias) end] - global cvarname - set cvarname $ref - - sia::YY_FLUSH_BUFFER - sia::yy_scan_string [lrange $var $i end] - sia::yyparse - incr i [expr $sia::yycnt-1] - } else { - - set item [string tolower [lindex $var $i]] - switch -- $item { - cancel - - clear - - close - - coordinate - - crosshair - - export - - name - - print - - retreive - - retrieve - - save - - size - - sky - - skyformat - - system - - update {ProcessSIA $varname $iname [lindex $isia(sias) end]} - - default { - # existing sia or load new one? - set ref $item + set ref [lindex $isia(sias) end] + global cvarname + set cvarname $ref - incr i - set item [string tolower [lindex $var $i]] - switch -- $item { - cancel - - clear - - close - - coordinate - - crosshair - - export - - name - - print - - retreive - - retrieve - - save - - size - - sky - - skyformat - - system - - update {ProcessSIA $varname $iname sia${ref}} - - default { - # ok, new sia - incr i -1 - set item [string tolower [lindex $var $i]] - - # see if its from our list of sias - foreach mm $isia(def) { - set title [lindex $mm 0] - set vars [lindex $mm 1] - set url [lindex $mm 2] - set opts [lindex $mm 3] - set method [lindex $mm 4] - - if {$title != {-} && "sia${item}" == $vars} { - SIADialog $vars $title $url $opts $method sync - return - } - } - } - } - } - } -} + sia::YY_FLUSH_BUFFER + sia::yy_scan_string [lrange $var $i end] + sia::yyparse + incr i [expr $sia::yycnt-1] } proc ProcessSIA {varname iname cvarname} { diff --git a/ds9/library/smooth.tcl b/ds9/library/smooth.tcl index a5fd735..24e9ed9 100644 --- a/ds9/library/smooth.tcl +++ b/ds9/library/smooth.tcl @@ -345,79 +345,10 @@ proc ProcessSmoothCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - smooth::YY_FLUSH_BUFFER - smooth::yy_scan_string [lrange $var $i end] - smooth::yyparse - incr i [expr $smooth::yycnt-1] - } else { - - global smooth - - switch -- [string tolower [lindex $var $i]] { - open {SmoothDialog} - close {SmoothDestroyDialog} - match {MatchSmoothCurrent} - lock { - 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 - } - function { - incr i - set smooth(function) [lindex $var $i] - SmoothUpdate - } - radius { - incr i - set smooth(radius) [lindex $var $i] - SmoothUpdate - } - radiusminor { - incr i - set smooth(radius,minor) [lindex $var $i] - SmoothUpdate - } - sigma { - incr i - set smooth(sigma) [lindex $var $i] - SmoothUpdate - } - sigmaminor { - incr i - set smooth(sigma,minor) [lindex $var $i] - SmoothUpdate - } - angle { - incr i - set smooth(angle) [lindex $var $i] - SmoothUpdate - } - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - set smooth(view) [FromYesNo [lindex $var $i]] - SmoothUpdate - } - - default { - set smooth(view) 1 - SmoothUpdate - incr i -1 - } - } -} + smooth::YY_FLUSH_BUFFER + smooth::yy_scan_string [lrange $var $i end] + smooth::yyparse + incr i [expr $smooth::yycnt-1] } proc SmoothCmdSet {which value {cmd {}}} { diff --git a/ds9/library/url.tcl b/ds9/library/url.tcl index 8a65ab7..3d30abc 100644 --- a/ds9/library/url.tcl +++ b/ds9/library/url.tcl @@ -313,32 +313,9 @@ proc ProcessURLFitsCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - urlfits::YY_FLUSH_BUFFER - urlfits::yy_scan_string [lrange $var $i end] - urlfits::yyparse - incr i [expr $urlfits::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 - } - } - - LoadURLFits [lindex $var $i] $layer $mode -} + urlfits::YY_FLUSH_BUFFER + urlfits::yy_scan_string [lrange $var $i end] + urlfits::yyparse + incr i [expr $urlfits::yycnt-1] } diff --git a/ds9/library/util.tcl b/ds9/library/util.tcl index fb24c38..b581c09 100644 --- a/ds9/library/util.tcl +++ b/ds9/library/util.tcl @@ -1197,59 +1197,10 @@ proc ProcessPrefsCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - prefs::YY_FLUSH_BUFFER - prefs::yy_scan_string [lrange $var $i end] - prefs::yyparse - incr i [expr $prefs::yycnt-1] - } else { - - global pds9 - global ds9 - - switch -- [string tolower [lindex $var $i]] { - clear {ClearPrefs} - precision { - incr i - set pds9(prec,linear) [lindex $var $i] - incr i - set pds9(prec,deg) [lindex $var $i] - incr i - set pds9(prec,hms) [lindex $var $i] - incr i - set pds9(prec,dms) [lindex $var $i] - incr i - set pds9(prec,arcmin) [lindex $var $i] - incr i - set pds9(prec,arcsec) [lindex $var $i] - PrefsPrecision - } - bgcolor { - # backward compatibility - incr i - set pds9(bg) [lindex $var $i] - PrefsBgColor - } - nancolor { - # backward compatibility - incr i - set pds9(nan) [lindex $var $i] - PrefsNanColor - } - threads { - # backward compatibility - incr i - set ds9(threads) [lindex $var $i] - ChangeThreads - } - irafalign { - incr i - set pds9(iraf) [FromYesNo [lindex $var $i]] - PrefsIRAFAlign - } - } -} + prefs::YY_FLUSH_BUFFER + prefs::yy_scan_string [lrange $var $i end] + prefs::yyparse + incr i [expr $prefs::yycnt-1] } proc ProcessSendPrefsCmd {proc id param} { @@ -1270,28 +1221,10 @@ proc ProcessPrecisionCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - precision::YY_FLUSH_BUFFER - precision::yy_scan_string [lrange $var $i end] - precision::yyparse - incr i [expr $precision::yycnt-1] - } else { - - global pds9 - set pds9(prec,linear) [lindex $var $i] - incr i - set pds9(prec,deg) [lindex $var $i] - incr i - set pds9(prec,hms) [lindex $var $i] - incr i - set pds9(prec,dms) [lindex $var $i] - incr i - set pds9(prec,arcmin) [lindex $var $i] - incr i - set pds9(prec,arcsec) [lindex $var $i] - PrefsPrecision -} + precision::YY_FLUSH_BUFFER + precision::yy_scan_string [lrange $var $i end] + precision::yyparse + incr i [expr $precision::yycnt-1] } proc ProcessSendPrecisionCmd {proc id param} { @@ -1304,18 +1237,10 @@ proc ProcessBgCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - bg::YY_FLUSH_BUFFER - bg::yy_scan_string [lrange $var $i end] - bg::yyparse - incr i [expr $bg::yycnt-1] - } else { - - global pds9 - set pds9(bg) [lindex $var $i] - PrefsBgColor -} + bg::YY_FLUSH_BUFFER + bg::yy_scan_string [lrange $var $i end] + bg::yyparse + incr i [expr $bg::yycnt-1] } proc ProcessSendBgCmd {proc id param} { @@ -1328,18 +1253,10 @@ proc ProcessNanCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - nan::YY_FLUSH_BUFFER - nan::yy_scan_string [lrange $var $i end] - nan::yyparse - incr i [expr $nan::yycnt-1] - } else { - - global pds9 - set pds9(nan) [lindex $var $i] - PrefsNanColor -} + nan::YY_FLUSH_BUFFER + nan::yy_scan_string [lrange $var $i end] + nan::yyparse + incr i [expr $nan::yycnt-1] } proc ProcessSendNanCmd {proc id param} { @@ -1352,18 +1269,10 @@ proc ProcessThreadsCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - threads::YY_FLUSH_BUFFER - threads::yy_scan_string [lrange $var $i end] - threads::yyparse - incr i [expr $threads::yycnt-1] - } else { - - global ds9 - set ds9(threads) [lindex $var $i] - ChangeThreads -} + threads::YY_FLUSH_BUFFER + threads::yy_scan_string [lrange $var $i end] + threads::yyparse + incr i [expr $threads::yycnt-1] } proc ProcessSendThreadsCmd {proc id param} { @@ -1404,38 +1313,10 @@ proc ProcessCursorCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - cursor::YY_FLUSH_BUFFER - cursor::yy_scan_string [lrange $var $i end] - cursor::yyparse - incr i [expr $cursor::yycnt-1] - } else { - - global current - - if {$current(frame) != {}} { - set x [lindex $var $i] - incr i - set y [lindex $var $i] - - switch -- $current(mode) { - none {$current(frame) warp $x $y} - pointer - - region {MarkerArrowKey $current(frame) $x $y} - catalog {MarkerArrowKey $current(frame) $x $y} - crosshair {CrosshairArrowKey $current(frame) $x $y} - colorbar {} - pan {PanCanvas $x $y} - zoom - - rotate - - crop {} - analysis {IMEArrowKey $current(frame) $x $y} - examine - - iexam {} - } - } -} + cursor::YY_FLUSH_BUFFER + cursor::yy_scan_string [lrange $var $i end] + cursor::yyparse + incr i [expr $cursor::yycnt-1] } proc CursorCmd {x y} { @@ -1523,32 +1404,10 @@ proc ProcessIconifyCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - iconify::YY_FLUSH_BUFFER - iconify::yy_scan_string [lrange $var $i end] - iconify::yyparse - incr i [expr $iconify::yycnt-1] - } else { - - global ds9 - switch -- [string tolower [lindex $var $i]] { - yes - - true - - on - - 1 {wm iconify $ds9(top)} - - no - - false - - off - - 0 {wm deiconify $ds9(top)} - - default { - wm iconify $ds9(top) - incr i -1 - } - } -} + iconify::YY_FLUSH_BUFFER + iconify::yy_scan_string [lrange $var $i end] + iconify::yyparse + incr i [expr $iconify::yycnt-1] } proc IconifyCmd {which} { @@ -1582,22 +1441,10 @@ proc ProcessModeCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - mode::YY_FLUSH_BUFFER - mode::yy_scan_string [lrange $var $i end] - mode::yyparse - incr i [expr $mode::yycnt-1] - } else { - - global current - set current(mode) [string tolower [lindex $var $i]] - # backward compatibility - switch $current(mode) { - pointer {set current(mode) region} - } - ChangeMode -} + mode::YY_FLUSH_BUFFER + mode::yy_scan_string [lrange $var $i end] + mode::yyparse + incr i [expr $mode::yycnt-1] } proc ProcessQuitCmd {varname iname} { @@ -1629,22 +1476,10 @@ proc ProcessSleepCmd {varname iname} { UpdateDS9 RealizeDS9 - global debug - if {$debug(tcl,parser)} { - sleep::YY_FLUSH_BUFFER - sleep::yy_scan_string [lrange $var $i end] - sleep::yyparse - incr i [expr $sleep::yycnt-1] - } else { - - set sec 1 - if {[lindex $var $i] != {} && [string range [lindex $var $i] 0 0] != {-}} { - set sec [lindex $var $i] - } else { - incr i -1 - } - after [expr int($sec*1000)] -} + sleep::YY_FLUSH_BUFFER + sleep::yy_scan_string [lrange $var $i end] + sleep::yyparse + incr i [expr $sleep::yycnt-1] } proc ProcessSourceCmd {varname iname} { @@ -1655,16 +1490,10 @@ proc ProcessSourceCmd {varname iname} { # you never know what someone will try to do ProcessRealizeDS9 - global debug - if {$debug(tcl,parser)} { - source::YY_FLUSH_BUFFER - source::yy_scan_string [lrange $var $i end] - source::yyparse - incr i [expr $source::yycnt-1] - } else { - - uplevel #0 "source [lindex $var $i]" -} + source::YY_FLUSH_BUFFER + source::yy_scan_string [lrange $var $i end] + source::yyparse + incr i [expr $source::yycnt-1] } proc SourceCmd {fn} { diff --git a/ds9/library/vo.tcl b/ds9/library/vo.tcl index c96c597..10ff0fb 100644 --- a/ds9/library/vo.tcl +++ b/ds9/library/vo.tcl @@ -466,76 +466,10 @@ proc ProcessVOCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - vo::YY_FLUSH_BUFFER - vo::yy_scan_string [lrange $var $i end] - vo::yyparse - incr i [expr $vo::yycnt-1] - } else { - - set vvarname voi - upvar #0 $vvarname vvar - global $vvarname - - global ivo - global pvo - - switch -- [string tolower [lindex $var $i]] { - open {VODialog} - close {VODestroy $vvarname} - method { - incr i - set pvo(method) [lindex $var $i] - } - server { - incr i - set pvo(server) [lindex $var $i] - } - internal { - incr i - set pvo(hv) [FromYesNo [lindex $var $i]] - } - delay { - incr i - set pvo(delay) [lindex $var $i] - } - connect { - incr i - - VODialog - - # find best match - set ii [lsearch $ivo(server,url) "*[lindex $var $i]*"] - if {$ii>=0} { - set ivo(b$ii) 1 - VOCheck $vvarname $ii - } - } - disconnect { - incr i - - VODialog - - # find best match - set ii [lsearch $ivo(server,url) "*[lindex $var $i]*"] - if {$ii>=0} { - set ivo(b$ii) 0 - VOCheck $vvarname $ii - } - } - default { - VODialog - - # find best match - set ii [lsearch $ivo(server,url) "*[lindex $var $i]*"] - if {$ii>=0} { - set ivo(b$ii) 1 - VOCheck $vvarname $ii - } - } - } -} + vo::YY_FLUSH_BUFFER + vo::yy_scan_string [lrange $var $i end] + vo::yyparse + incr i [expr $vo::yycnt-1] } proc VOCmdSet {which value} { diff --git a/ds9/library/wcs.tcl b/ds9/library/wcs.tcl index bc4c4cb..53f1171 100644 --- a/ds9/library/wcs.tcl +++ b/ds9/library/wcs.tcl @@ -1134,139 +1134,14 @@ proc ProcessWCSCmd {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 - - wcs::YY_FLUSH_BUFFER - wcs::yy_scan_string [lrange $var $i end] - wcs::yyparse - incr i [expr $wcs::yycnt-1] - } else { - - global wcs - global current - global rgb - - set item [string tolower [lindex $var $i]] - switch -- $item { - open {WCSDialog} - close {WCSDestroyDialog} - system { - incr i - set wcs(system) [string tolower [lindex $var $i]] - UpdateWCS - } - sky { - incr i - set wcs(sky) [string tolower [lindex $var $i]] - UpdateWCS - } - format - - skyformat { - incr i - switch -- [string tolower [lindex $var $i]] { - deg - - degree - - degrees {set wcs(skyformat) degrees} - default {set wcs(skyformat) [string tolower [lindex $var $i]]} - } - UpdateWCS - } - align { - incr i - set current(align) [FromYesNo [lindex $var $i]] - AlignWCSFrame - } - reset { - set ext 1 - set nn [lindex $var [expr $i+1]] - if {[string is integer -strict $nn]} { - incr i - set ext $nn - } - - RGBEvalLock rgb(lock,wcs) $current(frame) [list $current(frame) wcs reset $ext] - UpdateWCS - } - replace - - append { - set ext 1 - set nn [lindex $var [expr $i+1]] - if {[string is integer -strict $nn]} { - incr i - set ext $nn - } + global parse + set parse(sock) $sock + set parse(fn) $fn - if {$sock != {}} { - incr i - if {[lindex $var $i] == {}} { - RGBEvalLock rgb(lock,wcs) $current(frame) [list $current(frame) wcs $item $ext $sock] - incr i -1 - } else { - RGBEvalLock rgb(lock,wcs) $current(frame) "$current(frame) wcs $item $ext \{\{[lindex $var $i]\}\}" - } - } elseif {$fn != {}} { - RGBEvalLock rgb(lock,wcs) $current(frame) "$current(frame) wcs $item $ext \{\{$fn\}\}" - } else { - incr i - if {[lindex $var $i] == "file"} { - incr i - } - RGBEvalLock rgb(lock,wcs) $current(frame) "$current(frame) wcs $item $ext \{\{[lindex $var $i]\}\}" - } - UpdateWCS - } - - fk4 - - fk5 - - icrs - - galactic - - ecliptic { - set wcs(sky) $item - UpdateWCS - } - - degrees - - sexagesimal { - set wcs(skyformat) $item - UpdateWCS - } - - 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 { - set wcs(system) $item - UpdateWCS - } - } -} + wcs::YY_FLUSH_BUFFER + wcs::yy_scan_string [lrange $var $i end] + wcs::yyparse + incr i [expr $wcs::yycnt-1] } proc WCSCmdSet {which value {cmd {}}} { @@ -1339,34 +1214,10 @@ proc ProcessAlignCmd {varname iname} { upvar $varname var upvar $iname i - global debug - if {$debug(tcl,parser)} { - align::YY_FLUSH_BUFFER - align::yy_scan_string [lrange $var $i end] - align::yyparse - incr i [expr $align::yycnt-1] - } else { - - global current - switch -- [string tolower [lindex $var $i]] { - yes - - true - - on - - 1 - - no - - false - - off - - 0 { - set current(align) [FromYesNo [lindex $var $i]] - AlignWCSFrame - } - default { - set current(align) 1 - AlignWCSFrame - incr i -1 - } - } -} + align::YY_FLUSH_BUFFER + align::yy_scan_string [lrange $var $i end] + align::yyparse + incr i [expr $align::yycnt-1] } proc ProcessSendAlignCmd {proc id param} { -- cgit v0.12