diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2018-05-29 19:25:11 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2018-05-29 19:25:11 (GMT) |
| commit | 669a10073068cf4c1366befcd2ebb0261eeff529 (patch) | |
| tree | d35dd1c7b8cc5e32b0d49fc8b9740fdc39a2bc1c /ds9/library | |
| parent | 5b631ef2d6903140a9a069c9ae7ca9366b367131 (diff) | |
| parent | 23cb6f670d966903fab6dc53240140bb19a0fd25 (diff) | |
| download | blt-669a10073068cf4c1366befcd2ebb0261eeff529.zip blt-669a10073068cf4c1366befcd2ebb0261eeff529.tar.gz blt-669a10073068cf4c1366befcd2ebb0261eeff529.tar.bz2 | |
Merge branch 'devel'
Diffstat (limited to 'ds9/library')
81 files changed, 3597 insertions, 532 deletions
diff --git a/ds9/library/2mass.tcl b/ds9/library/2mass.tcl index df4004c..aaf315f 100644 --- a/ds9/library/2mass.tcl +++ b/ds9/library/2mass.tcl @@ -132,7 +132,16 @@ proc Process2MASSCmd {varname iname} { upvar $iname i 2MASSDialog - IMGSVRProcessCmd $varname $iname dtwomass + + global debug + if {$debug(tcl,parser)} { + twomass::YY_FLUSH_BUFFER + twomass::yy_scan_string [lrange $var $i end] + twomass::yyparse + incr i [expr $twomass::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dtwomass + } } proc ProcessSend2MASSCmd {proc id param} { diff --git a/ds9/library/3d.tcl b/ds9/library/3d.tcl index 9e9f04a..6dd7fde 100644 --- a/ds9/library/3d.tcl +++ b/ds9/library/3d.tcl @@ -13,8 +13,6 @@ proc 3DDef {} { set ithreed(mb) .threedmb set ithreed(status) 0 - set threed(az) 0 - set threed(el) 0 set threed(scale) 1 set threed(lock) 0 @@ -28,8 +26,9 @@ proc 3DDef {} { set threed(compass,color) green array set pthreed [array get threed] - unset pthreed(az) - unset pthreed(el) + + set threed(az) 0 + set threed(el) 0 } # used by backup @@ -464,10 +463,17 @@ proc Process3DCmd {varname iname} { upvar $varname var upvar $iname i - global threed - 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} @@ -560,6 +566,16 @@ proc Process3DCmd {varname iname} { default {Create3DFrame; incr i -1} } } +} + +proc ThreedCmdSet {which value {cmd {}}} { + global threed + + set threed($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSend3DCmd {proc id param} { global threed diff --git a/ds9/library/analysis.tcl b/ds9/library/analysis.tcl index 7cd9cb9..2312966 100644 --- a/ds9/library/analysis.tcl +++ b/ds9/library/analysis.tcl @@ -7,6 +7,7 @@ package provide DS9 1.0 proc AnalysisDef {} { global ianalysis global panalysis + global analysis global ds9 @@ -19,6 +20,10 @@ proc AnalysisDef {} { set ianalysis(file) ".$ds9(app).ans" set ianalysis(alt) ".$ds9(app).analysis" + # temp + set analysis(load,buf) {} + set analysis(load,fn) {} + # prefs only set panalysis(log) 0 set panalysis(autoload) 1 @@ -1764,6 +1769,18 @@ 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 + + analysis::YY_FLUSH_BUFFER + analysis::yy_scan_string [lrange $var $i end] + analysis::yyparse + incr i [expr $analysis::yycnt-1] + } else { + global ime global ianalysis @@ -1885,6 +1902,7 @@ proc ProcessAnalysisCmd {varname iname buf fn} { } } } +} proc ProcessAnalysisPlotCmd {varname iname buf} { upvar 2 $varname var @@ -1905,6 +1923,77 @@ proc ProcessAnalysisPlotCmd {varname iname buf} { } } +proc AnalysisCmdTask {task} { + global ianalysis + + for {set ii 0} {$ii<$ianalysis(menu,count)} {incr ii} { + if {[string equal -nocase $ianalysis(menu,$ii,item) $task]} { + AnalysisTask $ii menu + } + } +} + +proc AnalysisCmdText {} { + global parse + + if {$parse(buf) != {}} { + AnalysisText apXPA Analysis $parse(buf) append + } elseif {$parse(fn) != {}} { + if {[file exists $parse(fn)]} { + set ch [open $parse(fn) r] + set txt [read $ch] + close $ch + AnalysisText apXPA Analysis $txt append + } + } +} + +proc AnalysisCmdPlotStdin {} { + global iap + global parse + + if {$parse(buf) != {}} { + AnalysisPlotStdin line $iap(tt) {} $parse(buf) + } elseif {$parse(fn) != {}} { + if {[file exists $parse(fn)]} { + set ch [open $parse(fn) r] + set rr [read $ch] + close $ch + AnalysisPlotStdin line $iap(tt) {} $rr + } + } else { + AnalysisPlotStdin line $iap(tt) {} {} + } +} + +proc AnalysisCmdPlotLine {title xaxis yaxis dim} { + global iap + global parse + + if {$parse(buf) != {}} { + PlotLine $iap(tt) Plot $title $xaxis $yaxis $dim $parse(buf) + } elseif {$parse(fn) != {}} { + if {[file exists $parse(fn)]} { + set ch [open $parse(fn) r] + set rr [read $ch] + close $ch + PlotLine $iap(tt) Plot $title $xaxis $yaxis $dim $rr + } + } else { + PlotLine $iap(tt) Plot $title $xaxis $yaxis $dim {} + } +} + +proc AnalysisCmdLoad {} { + global parse + + if {$parse(buf) != {}} { + ProcessAnalysis parse(buf) + } elseif {$parse(fn) != {}} { + ProcessAnalysisFile $parse(fn) + } +} + proc ProcessSendAnalysisCmd {proc id param sock fn} { global ianalysis global ime diff --git a/ds9/library/array.tcl b/ds9/library/array.tcl index 31a1f2e..5ee12a6 100644 --- a/ds9/library/array.tcl +++ b/ds9/library/array.tcl @@ -76,15 +76,23 @@ 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 } - global loadParam - global current - set layer {} - switch -- [string tolower [lindex $var $i]] { new { incr i @@ -117,6 +125,27 @@ proc ProcessArrayCmd {varname iname sock fn} { } FinishLoad } +} + +proc ArrayCmdLoad {param layer} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![ImportArraySocket $parse(sock) $param $layer]} { + InitError xpa + ImportArrayFile $param $layer + } + } else { + # comm + if {$parse(fn) != {}} { + ImportArrayAlloc $parse(fn) $param $layer + } else { + ImportArrayFile $param $layer + } + } + FinishLoad +} proc ProcessSendArrayCmd {proc id param sock fn} { global current diff --git a/ds9/library/backup.tcl b/ds9/library/backup.tcl index c221908..954fa3d 100644 --- a/ds9/library/backup.tcl +++ b/ds9/library/backup.tcl @@ -783,6 +783,14 @@ 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 @@ -791,11 +799,25 @@ proc ProcessBackupCmd {varname iname} { Error [msgcat::mc {Unable to open file}] } } +} + +proc BackupCmd {fn} { + FileLast backupfbox $fn + Backup $fn +} 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 @@ -804,3 +826,11 @@ proc ProcessRestoreCmd {varname iname} { Error [msgcat::mc {Unable to open file}] } } +} + +proc RestoreCmd {fn} { + FileLast backupfbox $fn + Restore $fn +} + + diff --git a/ds9/library/bin.tcl b/ds9/library/bin.tcl index 93ab74a..3cf60bd 100644 --- a/ds9/library/bin.tcl +++ b/ds9/library/bin.tcl @@ -631,9 +631,8 @@ proc BinDestroyDialog {} { if {[winfo exists $ibin(top)]} { destroy $ibin(top) destroy $ibin(mb) + unset dbin } - - unset dbin } proc MatchBinCurrent {} { @@ -724,8 +723,15 @@ proc ProcessBinCmd {varname iname} { upvar $varname var upvar $iname i - global bin + 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} @@ -801,6 +807,16 @@ proc ProcessBinCmd {varname iname} { } } } +} + +proc BinCmdSet {which value {cmd {}}} { + global bin + + set bin($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendBinCmd {proc id param} { global bin diff --git a/ds9/library/block.tcl b/ds9/library/block.tcl index f729e28..8a03620 100644 --- a/ds9/library/block.tcl +++ b/ds9/library/block.tcl @@ -179,9 +179,8 @@ proc BlockDestroyDialog {} { if {[winfo exists $iblock(top)]} { destroy $iblock(top) destroy $iblock(mb) + unset dblock } - - unset dblock } proc UpdateBlockDialog {} { @@ -290,6 +289,14 @@ 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} @@ -339,6 +346,16 @@ proc ProcessBlockCmd {varname iname} { } } } +} + +proc BlockCmdSet {which value {cmd {}}} { + global block + + set block($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendBlockCmd {proc id param} { global block diff --git a/ds9/library/cat.tcl b/ds9/library/cat.tcl index 3bf41bf..5ad5c90 100644 --- a/ds9/library/cat.tcl +++ b/ds9/library/cat.tcl @@ -1132,7 +1132,7 @@ proc CATBackup {ch which fdir rdir} { set rfn $rdir/${varname}.cat catch {file delete -force $fn} - CATSaveFn $varname "$fn" VOTWrite + CATSaveFn $varname $fn VOTWrite puts $ch "CATLoadFn $varname \"$rfn\" VOTRead" } else { # internal var @@ -1236,114 +1236,27 @@ proc PrefsDialogCatalog {} { # Process Cmds -proc CatalogInitCmd {} { - global icat - - set ref [lindex $icat(cats) end] - global cvarname - set cvarname $ref -} - -proc CatalogRefCmd {ref} { - global icat - global cvarname - - # backward compatibility - if {$ref == "cxc"} { - set ref csc - } - - # look for reference in current list - if {[lsearch $icat(cats) cat${ref}] < 0} { - # 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${ref}" == $ww} { - CATDialog $ww $ss $cc $ll sync - set cvarname cat${ref} - return - } - } - - # not a default, assume other name - CATDialog catcds cds $ref $ref sync - } - set cvarname cat${ref} -} - -proc CatalogSymbolLoadCmd {fn} { - global cvarname - global $cvarname - - if {[file exists $fn]} { - starbase_read ${cvarname}(symdb) $fn - CATGenerate $cvarname - } else { - Error "[msgcat::mc {Unable to open file}] $fn" - return - } -} - -proc CatalogSymbolAddCmd {} { - global cvarname - global $cvarname - - set row [expr [starbase_nrows ${cvarname}(symdb)]+1] - starbase_rowins ${cvarname}(symdb) $row - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) shape] $pcat(sym,shape) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) color] $pcat(sym,color) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) width] $pcat(sym,width) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) font] $pcat(sym,font) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) fontsize] \ - $pcat(sym,font,size) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) fontweight] \ - $pcat(sym,font,weight) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) fontslant] \ - $pcat(sym,font,slant) - starbase_set ${cvarname}(symdb) $row \ - [starbase_colnum ${cvarname}(symdb) units] $pcat(sym,units) - CATGenerate ${cvarname}name -} - -proc CatalogSAMPCmd {name} { - global cvarname - global $cvarname - global samp - - 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}] - } -} - proc ProcessCatalogCmd {varname iname} { upvar $varname var upvar $iname i - global icat - # 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} @@ -1502,6 +1415,7 @@ proc ProcessCatalogCmd {varname iname} { } } } +} proc ProcessCatalog {varname iname cvarname} { upvar 2 $varname var @@ -1694,7 +1608,6 @@ proc ProcessCatalog {varname iname cvarname} { samp { global ds9 global samp - incr i switch -- [string tolower [lindex $var $i]] { send { @@ -1769,7 +1682,6 @@ proc ProcessCatalog {varname iname cvarname} { set row [lindex $var $i] incr i } - switch -- [lindex $var $i] { add { set row [expr [starbase_nrows $cvar(symdb)]+1] @@ -1913,6 +1825,339 @@ proc ProcessCatalog {varname iname cvarname} { } } +proc CatalogCmdCheck {} { + global cvarname + upvar #0 $cvarname cvar + + if {![info exists cvar(top)]} { + Error "[msgcat::mc {Unable to find catalog window}] $cvarname" + cat::YYABORT + return + } + if {![winfo exists $cvar(top)]} { + Error "[msgcat:: mc {Unable to find catalog window}] $cvarname" + cat::YYABORT + return + } +} + +proc CatalogCmdRef {ref} { + global icat + global cvarname + + # backward compatibility + if {$ref == "cxc"} { + set ref csc + } + + # look for reference in current list + if {[lsearch $icat(cats) cat${ref}] < 0} { + # 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${ref}" == $ww} { + CATDialog $ww $ss $cc $ll sync + set cvarname cat${ref} + return + } + } + + # not a default, assume other name + CATDialog cat${ref} cds $ref $ref sync + set cvarname cat${ref} + } +} + +proc CatalogCmdIcat {which value} { + global icat + + set icat($which) $value +} + +proc CatalogCmdSet {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value +} + +proc CatalogCmdGenerate {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value + CATGenerate $cvarname +} + +proc CatalogCmdEdit {value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(edit) $value + CATEdit $cvarname +} + +proc CatalogCmdCoord {xx yy skyframe} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(x) $xx + set cvar(y) $yy + set cvar(sky) $skyframe +} + +proc CatalogCmdFilterLoad {fn} { + global cvarname + upvar #0 $cvarname cvar + + if {$fn != {}} { + if {[catch {open $fn r} fp]} { + Error "[msgcat::mc {Unable to open file}] $fn: $fp" + yyerror + } + set flt [read -nonewline $fp] + catch {regsub {\n} $flt " " $flt} + set cvar(filter) [string trim $flt] + catch {close $fp} + } +} + +proc CatalogCmdFilter {filter} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(filter) $filter + CATTable $cvarname +} + +proc CatalogCmdLoad {fn reader} { + global icat + + if {$fn != {}} { + CATDialog cattool {} {} {} none + CATLoadFn [lindex $icat(cats) end] $fn $reader + FileLast catfbox $fn + } +} + +proc CatalogCmdMatch {} { + global icat + + set icat(match1) {} + set icat(match2) {} + set ll [llength $icat(cats)] + if {$ll>1} { + CatalogCmdMatchParams [lindex $icat(cats) [expr $ll-2]] \ + [lindex $icat(cats) [expr $ll-1]] + } +} + +proc CatalogCmdMatchParams {cat1 cat2} { + global icat + global current + + set icat(match1) $cat1 + set icat(match2) $cat2 + if {$current(frame) != {}} { + CATMatch $current(frame) $icat(match1) $icat(match2) + } +} + +proc CatalogCmdMatchError {error eformat} { + global icat + + set icat(error) $error + set icat(eformat) $eformat +} + +proc CatalogCmdPlot {xx yy xerr yerr} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(plot,x) $xx + set cvar(plot,y) $yy + set cvar(plot,xerr) $xerr + set cvar(plot,yerr) $yerr + CATPlotGenerate $cvarname +} + +proc CatalogCmdSAMP {} { + global cvarname + global samp + + if {[info exists samp]} { + SAMPSendTableLoadVotable {} $cvarname + } else { + Error [msgcat::mc {SAMP: not connected}] + } +} + +proc CatalogCmdSAMPSend {name} { + global cvarname + global samp + + 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}] + } +} + +proc CatalogCmdSave {fn writer} { + global cvarname + + if {$fn != {}} { + CATSaveFn $cvarname $fn $writer + FileLast catfbox $fn + } +} + +proc CatalogCmdSize {width height rformat} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(width) $width + set cvar(height) $height + set cvar(rformat) $rformat + set cvar(rformat,msg) $rformat +} + +proc CatalogCmdSkyframe {skyframe} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(sky) $skyframe + CoordMenuButtonCmd $cvarname system sky [list CATWCSMenuUpdate $cvarname] +} + +proc CatalogCmdSystem {sys} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(system) $sys + CoordMenuButtonCmd $cvarname system sky [list CATWCSMenuUpdate $cvarname] +} + +proc CatalogCmdSort {col dir} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(sort) $col + set cvar(sort,dir) $dir + CATTable $cvarname +} + +proc CatalogCmdSymbol {col value} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) $col] $value + CATGenerate $cvarname +} + +proc CatalogCmdSymbolFontStyle {value} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + switch $value { + normal { + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontweight] normal + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontslant] roman + } + bold { + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontweight] bold + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontslant] roman + } + italic { + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontweight] normal + starbase_set $cvar(symdb) $cvar(row) \ + [starbase_colnum $cvar(symdb) fontslant] italic + } + } + CATGenerate $cvarname +} + +proc CatalogCmdSymbolAdd {} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + global pcat + + 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 +} + +proc CatalogCmdSymbolRemove {} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + starbase_rowdel $cvar(symdb) $cvar(row) + CATGenerate $cvarname +} + +proc CatalogCmdSymbolLoad {fn} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + if {[file exists $fn]} { + starbase_read $cvar(symdb) $fn + CATGenerate $cvarname + } else { + Error "[msgcat::mc {Unable to open file}] $fn" + return + } +} + +proc CatalogCmdSymbolSave {fn} { + global cvarname + upvar #0 $cvarname cvar + global $cvar(symdb) + + starbase_write $cvar(symdb) $fn +} + proc ProcessSendCatalogCmd {proc id param sock fn} { global icat diff --git a/ds9/library/catdialog.tcl b/ds9/library/catdialog.tcl index 466b279..0b8f1c9 100644 --- a/ds9/library/catdialog.tcl +++ b/ds9/library/catdialog.tcl @@ -684,6 +684,7 @@ proc CATCrosshair {varname} { proc CATDestroy {varname} { upvar #0 $varname var + global $varname global $var(catdb) global $var(tbldb) @@ -737,6 +738,13 @@ proc CATDestroy {varname} { PlotDestroy $var(plot,var) } + # cat header? + set vvarname ${varname}hdr + global $vvarname + if {[info exists $vvarname]} { + SimpleTextDestroy $vvarname + } + ARDestroy $varname } diff --git a/ds9/library/colorbar.tcl b/ds9/library/colorbar.tcl index ad80cc5..a5ee821 100644 --- a/ds9/library/colorbar.tcl +++ b/ds9/library/colorbar.tcl @@ -912,9 +912,8 @@ proc ColormapDestroyDialog {} { if {[winfo exists $icolorbar(top)]} { destroy $icolorbar(top) destroy $icolorbar(mb) + unset dcolorbar } - - unset dcolorbar } proc ApplyColormap {} { @@ -1186,6 +1185,17 @@ proc ProcessCmapCmd {varname iname} { upvar $varname var upvar $iname i + # 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 @@ -1193,9 +1203,6 @@ proc ProcessCmapCmd {varname iname} { global current global rgb - # we need to be realized - ProcessRealizeDS9 - switch -- [string tolower [lindex $var $i]] { open {ColormapDialog} close {ColormapDestroyDialog} @@ -1290,6 +1297,7 @@ proc ProcessCmapCmd {varname iname} { } } } +} proc CmapCmd {item} { global current @@ -1358,6 +1366,14 @@ 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 @@ -1365,11 +1381,9 @@ proc ProcessColorbarCmd {varname iname} { switch -- $item { match { - # backward compatibility MatchColorCurrent } lock { - # backward compatibility incr i if {!([string range [lindex $var $i] 0 0] == "-")} { set colorbar(lock) [FromYesNo [lindex $var $i]] @@ -1468,6 +1482,39 @@ proc ProcessColorbarCmd {varname iname} { } } } +} + +proc ColorbarCmdSet {which value {cmd {}}} { + global colorbar + + set colorbar($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc ColorbarCmdFontStyle {value {cmd {}}} { + global colorbar + + switch $value { + 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 + } + } + + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendColorbarCmd {proc id param} { global colorbar @@ -1475,7 +1522,6 @@ proc ProcessSendColorbarCmd {proc id param} { switch -- [string tolower [lindex $param 0]] { lock { - #backward compatibility $proc $id [ToYesNo $colorbar(lock)] } orientation {$proc $id "$colorbar(orientation)\n"} @@ -1489,9 +1535,12 @@ proc ProcessSendColorbarCmd {proc id param} { } font {$proc $id "$colorbar(font)\n"} fontsize {$proc $id "$colorbar(font,size)\n"} - fontstyle - fontweight {$proc $id "$colorbar(font,weight)\n"} fontslant {$proc $id "$colorbar(font,slant)\n"} + fontstyle { + # backware compatibily + $proc $id "$colorbar(font,weight)\n" + } size {$proc $id "$colorbar(size)\n"} ticks {$proc $id "$colorbar(ticks)\n"} default {$proc $id [ToYesNo $view(colorbar)]} diff --git a/ds9/library/comm.tcl b/ds9/library/comm.tcl index fd4545b..28c2c15 100644 --- a/ds9/library/comm.tcl +++ b/ds9/library/comm.tcl @@ -66,10 +66,6 @@ proc CommSet {fn paramlist {safemode 0}} { iexam - imexam {} iis {ProcessIISCmd param i} - irafalign { - # backward compatibility - ProcessIRAFAlignCmd param i - } jpg - jpeg {ProcessJPEGCmd param i {} $fn} lock {ProcessLockCmd param i} @@ -268,10 +264,6 @@ proc CommGet {proc id paramlist fn} { iexam - imexam {ProcessSendIExamCmd $proc $id $param} iis {ProcessSendIISCmd $proc $id $param} - irafalign { - # backward compatibility - ProcessSendIRAFAlignCmd $proc $id $param - } jpg - jpeg {ProcessSendJPEGCmd $proc $id $param {} $fn} lock {ProcessSendLockCmd $proc $id $param} diff --git a/ds9/library/command.tcl b/ds9/library/command.tcl index 20afa4b..525c032 100644 --- a/ds9/library/command.tcl +++ b/ds9/library/command.tcl @@ -27,7 +27,10 @@ proc ProcessCommandLineFirst {} { puts "For more information, use --help" QuitDS9 } - -debug {incr i; ProcessDebugTclCmd argv i} + -debug { + incr i + ProcessDebugTclCmd argv i + } -private { # backward compatibility } @@ -47,7 +50,10 @@ proc ProcessCommandLineFirst {} { incr i set pds9(language,dir) [lindex $argv $i] } - -xpa {incr i; ProcessXPAFirstCmd argv i} + -xpa { + incr i + ProcessXPAFirstCmd argv i + } } incr i } @@ -450,17 +456,7 @@ proc ProcessCommand {argv argc} { } -zscale {incr i; ProcessZScaleCmd argv i} -zmax {set scale(mode) zmax; ChangeScaleMode} - -zoom { - incr i; - ProcessZoomCmd argv i - - if {0} { - zoom::YY_FLUSH_BUFFER - zoom::yy_scan_string [lrange $argv $i end] - zoom::yyparse - incr i [expr $zoom::yycnt-1] - } - } + -zoom {incr i; ProcessZoomCmd argv i} default { # allow abc, -, and -[foo] but not -abc @@ -538,11 +534,11 @@ proc CommandLineLoadBase {item argvname iname} { rgbimage { - CreateRGBFrame + MultiLoadRGB LoadRGBImageFile $item } rgbcube { - CreateRGBFrame + MultiLoadRGB LoadRGBCubeFile $item } @@ -578,7 +574,7 @@ proc CommandLineLoadBase {item argvname iname} { } srgbcube { #backward compatibility - CreateRGBFrame + MultiLoadRGB incr i LoadSRGBCubeFile $item [lindex $argv $i] } @@ -596,7 +592,7 @@ proc CommandLineLoadBase {item argvname iname} { ImportArrayFile $item $file(layer) } rgbarray { - CreateRGBFrame + MultiLoadRGB ImportRGBArrayFile $item } nrrd { @@ -717,11 +713,11 @@ proc CommandLineLoad3D {item argvname iname} { } rgbimage { - CreateRGBFrame + MultiLoadRGB LoadRGBImageFile $item } rgbcube { - CreateRGBFrame + MultiLoadRGB LoadRGBCubeFile $item } @@ -757,7 +753,7 @@ proc CommandLineLoad3D {item argvname iname} { } srgbcube { #backward compatibility - CreateRGBFrame + MultiLoadRGB incr i LoadSRGBCubeFile $item [lindex $argv $i] } @@ -775,7 +771,7 @@ proc CommandLineLoad3D {item argvname iname} { ImportArrayFile $item {} } rgbarray { - CreateRGBFrame + MultiLoadRGB ImportRGBArrayFile $item } nrrd { diff --git a/ds9/library/contour.tcl b/ds9/library/contour.tcl index cdbb61a..d55e3c9 100644 --- a/ds9/library/contour.tcl +++ b/ds9/library/contour.tcl @@ -336,9 +336,8 @@ proc ContourDestroyDialog {} { if {[winfo exists $icontour(top)]} { destroy $icontour(top) destroy $icontour(mb) + unset dcontour } - - unset dcontour } proc ContourGenerateDialog {} { @@ -487,8 +486,8 @@ proc ContourCPasteDialog {} { ttk::separator $w.sep -orient horizontal ttk::separator $w.sep2 -orient horizontal pack $w.buttons $w.sep -side bottom -fill x -# pack $w.param1 $w.sep2 $w.param2 -side top -fill both -expand true - pack $w.param -side top -fill both -expand true + pack $w.param1 $w.sep2 $w.param -side top -fill both -expand true +# pack $w.param -side top -fill both -expand true DialogCenter $w DialogWait $w ed(ok) @@ -1052,12 +1051,19 @@ proc ProcessContourCmd {varname iname} { upvar $varname var upvar $iname i - global contour - global current - # 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} @@ -1097,7 +1103,6 @@ proc ProcessContourCmd {varname iname} { } } } - FileLast contourlfbox $fn UpdateContourDialog } @@ -1108,7 +1113,6 @@ proc ProcessContourCmd {varname iname} { set sys [lindex $var $i] incr i set sky [lindex $var $i] - # Backward compatibility incr i set color {} @@ -1117,7 +1121,6 @@ proc ProcessContourCmd {varname iname} { incr i set dash {} incr i [ProcessContourFix sys sky color width dash] - if {$fn != {}} { $current(frame) contour save "\{$fn\}" $sys $sky } @@ -1135,7 +1138,6 @@ proc ProcessContourCmd {varname iname} { incr i ContourSaveLevelsNow [lindex $var $i] } - copy {ContourCCopyDialog} paste { incr i @@ -1150,38 +1152,31 @@ proc ProcessContourCmd {varname iname} { 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 @@ -1189,16 +1184,13 @@ proc ProcessContourCmd {varname iname} { } method { ContourDialog - incr i set contour(method) [lindex $var $i] ContourGenerateDialog UpdateContour } - nlevels { ContourDialog - incr i set contour(numlevel) [lindex $var $i] ContourGenerateDialog @@ -1207,7 +1199,6 @@ proc ProcessContourCmd {varname iname} { scale { set contour(init,scale) 1 ContourDialog - incr i set contour(scale) [string tolower [lindex $var $i]] ContourGenerateDialog @@ -1216,7 +1207,6 @@ proc ProcessContourCmd {varname iname} { log { set contour(init,scale) 1 ContourDialog - incr i switch -- [string tolower [lindex $var $i]] { exp { @@ -1234,7 +1224,6 @@ proc ProcessContourCmd {varname iname} { mode { set contour(init,mode) 1 ContourDialog - incr i set contour(mode) [lindex $var $i] ContourModeDialog @@ -1244,7 +1233,6 @@ proc ProcessContourCmd {varname iname} { scope { set contour(init,scope) 1 ContourDialog - incr i set contour(scope) [lindex $var $i] ContourModeDialog @@ -1254,7 +1242,6 @@ proc ProcessContourCmd {varname iname} { limits { set contour(init,limits) 1 ContourDialog - incr i set contour(min) [lindex $var $i] incr i @@ -1262,24 +1249,19 @@ proc ProcessContourCmd {varname iname} { 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 - @@ -1291,7 +1273,6 @@ proc ProcessContourCmd {varname iname} { set contour(view) [FromYesNo [lindex $var $i]] UpdateContour } - default { set contour(view) 1 UpdateContour @@ -1299,6 +1280,139 @@ proc ProcessContourCmd {varname iname} { } } } +} + +proc ContourCmdLoad {fn} { + global current + + if {$current(frame) != {} && $fn != {}} { + $current(frame) contour load $fn + FileLast contourlfbox $fn + UpdateContourDialog + } +} + +proc ContourCmdLoadOrg {fn sys sky color width dash} { + global current + + if {$current(frame) != {} && $fn != {}} { + $current(frame) contour load $color $width $dash $fn $sys $sky + FileLast contourlfbox $fn + UpdateContourDialog + } +} + +proc ContourCmdSave {fn sys sky} { + global current + + if {$current(frame) != {} && $fn != {}} { + $current(frame) contour save $fn $sys $sky + FileLast contoursfbox $fn + } +} + +proc ContourCmdLoadLevels {fn} { + global current + + ContourDialog + if {$current(frame) != {}} { + ContourLoadLevelsNow $fn + UpdateContour + } +} + +proc ContourCmdSaveLevels {fn} { + global current + + ContourDialog + if {$current(frame) != {}} { + ContourSaveLevelsNow $fn + } +} + +proc ContourCmdPaste {sys sky color width dash} { + global current + global contour + + if {$current(frame) != {} && $contour(copy) != {}} { + set cc [$contour(copy) get contour $sys $sky] + $current(frame) contour paste cc $color $width $dash + } +} + +proc ContourCmdSet {which value} { + global contour + + set contour($which) $value + UpdateContour +} + +proc ContourCmdDialog {which value} { + global contour + + ContourDialog + set contour($which) $value + UpdateContour +} + +proc ContourCmdGenerateDialog {which value} { + global contour + + ContourDialog + set contour($which) $value + ContourGenerateDialog + UpdateContour +} + +proc ContourCmdScale {which value} { + global contour + + set contour(init,scale) 1 + ContourDialog + + set contour($which) $value + ContourGenerateDialog + UpdateContour +} + +proc ContourCmdMode {which value} { + global contour + + set contour(init,$which) 1 + ContourDialog + + set contour($which) $value + ContourModeDialog + ContourGenerateDialog + UpdateContour +} + +proc ContourCmdLimits {min max} { + global contour + + set contour(init,limits) 1 + ContourDialog + + set contour(min) $min + set contour(max) $max + ContourGenerateDialog + UpdateContour +} + +proc ContourCmdLevels {str} { + global dcontour + + ContourDialog + $dcontour(txt) delete 1.0 end + $dcontour(txt) insert end $str + UpdateContour +} + +proc ContourCmdGenerate {} { + ContourDialog + ContourGenerateDialog + UpdateContour +} proc ProcessContourFix {sysname skyname colorname widthname dashname} { upvar $sysname sys diff --git a/ds9/library/crop.tcl b/ds9/library/crop.tcl index 8011954..14a73ba 100644 --- a/ds9/library/crop.tcl +++ b/ds9/library/crop.tcl @@ -181,9 +181,8 @@ proc CropDestroyDialog {} { if {[winfo exists $icrop(top)]} { destroy $icrop(top) destroy $icrop(mb) + unset dcrop } - - unset dcrop } proc UpdateCropMenu {} { @@ -394,6 +393,14 @@ 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]] { @@ -436,6 +443,16 @@ proc ProcessCropCmd {varname iname} { } } } +} + +proc CropCmdSet {which value {cmd {}}} { + global crop + + set crop($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendCropCmd {proc id param} { global crop diff --git a/ds9/library/crosshair.tcl b/ds9/library/crosshair.tcl index 3ed1b24..13264fe 100644 --- a/ds9/library/crosshair.tcl +++ b/ds9/library/crosshair.tcl @@ -70,6 +70,7 @@ proc CrosshairTo {x y sys sky} { } } } + UpdateCrosshairDialog } } @@ -213,9 +214,8 @@ proc CrosshairDestroyDialog {} { if {[winfo exists $icrosshair(top)]} { destroy $icrosshair(top) destroy $icrosshair(mb) + unset dcrosshair } - - unset dcrosshair } proc UpdateCrosshairDialog {} { @@ -263,6 +263,14 @@ 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 @@ -288,6 +296,16 @@ proc ProcessCrosshairCmd {varname iname} { } } } +} + +proc CrosshairCmdSet {which value {cmd {}}} { + global crosshair + + set crosshair($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendCrosshairCmd {proc id param} { global crosshair diff --git a/ds9/library/cube.tcl b/ds9/library/cube.tcl index e29e7a8..e43bc4b 100644 --- a/ds9/library/cube.tcl +++ b/ds9/library/cube.tcl @@ -429,9 +429,8 @@ proc CubeDestroyDialog {} { if {[winfo exists $icube(top)]} { destroy $icube(top) destroy $icube(mb) + unset dcube } - - unset dcube } proc UpdateCubeMenu {} { @@ -706,6 +705,16 @@ proc ProcessCubeCmd {varname iname} { upvar $varname var upvar $iname i + 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 @@ -713,8 +722,6 @@ proc ProcessCubeCmd {varname iname} { global current global rgb - CubeDialog - switch -- [string tolower [lindex $var $i]] { match { incr i @@ -841,6 +848,29 @@ proc ProcessCubeCmd {varname iname} { } } } +} + +proc CubeCmdCoord {ss sys axis} { + global dcube + global cube + + set dcube(wcs,$axis) $ss + set cube(system) $sys + set cube(axis) $axis + if {$cube(axis) < 2} { + set cube(axis) 2 + } + CubeApply $cube(axis) +} + +proc CubeCmdSet {which value {cmd {}}} { + global cube + + set cube($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendCubeCmd {proc id param} { global cube diff --git a/ds9/library/debug.tcl b/ds9/library/debug.tcl index 4ef5c7f..3706199 100644 --- a/ds9/library/debug.tcl +++ b/ds9/library/debug.tcl @@ -23,6 +23,7 @@ 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 @@ -97,6 +98,8 @@ 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) @@ -107,7 +110,7 @@ proc DebugMenu {} { $ds9(mb).debug.tksao add checkbutton -label {Mosaic} \ -variable debug(tksao,mosaic) \ -command "Debug mosaic debug(tksao,mosaic)" - $ds9(mb).debug.tksao add checkbutton -label {Parser} \ + $ds9(mb).debug.tksao add checkbutton -label {TksaoParser} \ -variable debug(tksao,parser) \ -command "Debug parser debug(tksao,parser)" $ds9(mb).debug.tksao add checkbutton -label {Perf} \ @@ -193,6 +196,10 @@ 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 @@ -217,6 +224,7 @@ proc ProcessDebugCmd {varname iname} { set debug(tksao,mosaic) 1 Debug mosaic debug(tksao,mosaic) } + tksaoparser - parser { set debug(tksao,parser) 1 Debug parser debug(tksao,parser) @@ -277,9 +285,21 @@ proc ProcessDebugCmd {varname iname} { xpa - image {} - default { - incr ${iname} -1 + tclparser { + incr i + switch -- [string tolower [lindex $var $i]] { + yes - + true - + on - + 1 - + no - + false - + off - + 0 {} + default {incr i -1} + } } + default {incr i -1} } } diff --git a/ds9/library/ds9.tcl b/ds9/library/ds9.tcl index 168d447..9b3a755 100644 --- a/ds9/library/ds9.tcl +++ b/ds9/library/ds9.tcl @@ -13,7 +13,7 @@ proc DS9Def {} { } # for beta version, MUST have space - set ds9(version) {7.6} + set ds9(version) {8.0 b1} set ds9(top) . set ds9(mb) .mb diff --git a/ds9/library/envi.tcl b/ds9/library/envi.tcl index c03d496..43459b6 100644 --- a/ds9/library/envi.tcl +++ b/ds9/library/envi.tcl @@ -35,10 +35,13 @@ proc ProcessENVICmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current - - set layer {} + 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 { @@ -55,33 +58,15 @@ proc ProcessENVICmd {varname iname sock fn} { } } - if {$sock != {}} { - # xpa - if {0} { - # not supported - } else { - set fn [lindex $var $i] - set fn2 [lindex $var [expr $i+1]] - if {$fn2 == {}} { - set fn2 [FindENVIDataFile $fn] - } - ImportENVIFile $fn $fn2 - } - } else { - # comm - if {0} { - # not supported - } else { - set fn [lindex $var $i] - set fn2 [lindex $var [expr $i+1]] - if {$fn2 == {}} { - set fn2 [FindENVIDataFile $fn] - } - ImportENVIFile $fn $fn2 - } + 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} { set rn [file rootname $fn] diff --git a/ds9/library/error.tcl b/ds9/library/error.tcl index 5bd4bbf..afed4ea 100644 --- a/ds9/library/error.tcl +++ b/ds9/library/error.tcl @@ -52,6 +52,24 @@ proc ProcessMessage {level message} { } } +proc ParserError {msg yycnt yy_current_buffer index_} { + global ds9 + + switch -- $ds9(msg,src) { + xpa - + hv - + samp { + Error "$msg: [lindex $yy_current_buffer [expr $yycnt-1]]" + } + default { + puts stderr "[string range $yy_current_buffer 0 80]" + puts stderr [format "%*s" $index_ ^] + puts stderr "$msg:" + QuitDS9 + } + } +} + # here is where errors from within the canvas widgets # will try to get our attention. # XPA, HV, and SAMP will have already seen any problems diff --git a/ds9/library/eso.tcl b/ds9/library/eso.tcl index 5b92b40..b7b7c6a 100644 --- a/ds9/library/eso.tcl +++ b/ds9/library/eso.tcl @@ -161,7 +161,16 @@ proc ProcessESOCmd {varname iname} { upvar $iname i ESODialog - IMGSVRProcessCmd $varname $iname deso + + global debug + if {$debug(tcl,parser)} { + dsseso::YY_FLUSH_BUFFER + dsseso::yy_scan_string [lrange $var $i end] + dsseso::yyparse + incr i [expr $dsseso::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname deso + } } proc ProcessSendESOCmd {proc id param} { diff --git a/ds9/library/export.tcl b/ds9/library/export.tcl index 4f8c2fa..eff40ea 100644 --- a/ds9/library/export.tcl +++ b/ds9/library/export.tcl @@ -7,9 +7,7 @@ package provide DS9 1.0 proc ExportDef {} { global export - set export(array,endian) native - set export(nrrd,endian) native - set export(envi,endian) native + set export(endian) native set export(jpeg,quality) 75 set export(tiff,compress) none } @@ -18,10 +16,10 @@ proc Export {fn format fn2} { global export switch $format { - array {ExportArrayFile $fn $export(array,endian)} - rgbarray {ExportRGBArrayFile $fn $export(array,endian)} - nrrd {ExportNRRDFile $fn $export(nrrd,endian)} - envi {ExportENVIFile $fn $fn2 $export(envi,endian)} + array {ExportArrayFile $fn $export(endian)} + rgbarray {ExportRGBArrayFile $fn $export(endian)} + nrrd {ExportNRRDFile $fn $export(endian)} + envi {ExportENVIFile $fn $fn2 $export(endian)} gif {ExportPhotoFile $fn $format {}} tiff {ExportPhotoFile $fn $format $export(tiff,compress)} jpeg {ExportPhotoFile $fn $format $export(jpeg,quality)} @@ -38,6 +36,14 @@ 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 {} @@ -86,18 +92,7 @@ proc ProcessExportCmd {varname iname} { set param [string tolower [lindex $var [expr $i+1]]] switch $format { array - - rgbarray { - switch $param { - native - - big - - bigendian - - little - - littleendian { - set export(array,endian) $param - incr i - } - } - } + rgbarray - nrrd { switch $param { native - @@ -105,7 +100,7 @@ proc ProcessExportCmd {varname iname} { bigendian - little - littleendian { - set export(nrrd,endian) $param + set export(endian) $param incr i } } @@ -119,7 +114,7 @@ proc ProcessExportCmd {varname iname} { little - littleendian { set fn2 "[file rootname $fn].bsq" - set export(envi,endian) $param + set export(endian) $param incr i } default { @@ -135,7 +130,7 @@ proc ProcessExportCmd {varname iname} { bigendian - little - littleendian { - set export(envi,endian) $param + set export(endian) $param incr i } } @@ -164,15 +159,33 @@ proc ProcessExportCmd {varname iname} { png {} } - global arrayfbox - global rgbarrayfbox - global giffbox - global jpegfbox - global tifffbox - global pngfbox - global nrrdfbox - global envifbox - global envi2fbox + 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 {}}} { + global export + + set export($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc ExportCmdSave {format fn {fn2 {}}} { switch -- $format { array {FileLast arrayfbox $fn} rgbarray {FileLast rgbarrayfbox $fn} @@ -218,9 +231,9 @@ proc ExportDialog {format} { if {$fn != {}} { set ok 1 switch -- $format { - array {set ok [ArrayExportDialog export(array,endian)]} + array {set ok [ArrayExportDialog export(endian)]} rgbarray {} - nrrd {set ok [ArrayExportDialog export(nrrd,endian)]} + nrrd {set ok [ArrayExportDialog export(endian)]} envi { set fn2 "[file rootname $fn].bsq" SetFileLast envi2 $fn2 @@ -229,7 +242,7 @@ proc ExportDialog {format} { # set ok 0 # } if {$ok} { - set ok [ArrayExportDialog export(envi,endian)] + set ok [ArrayExportDialog export(endian)] } } gif {} diff --git a/ds9/library/fits.tcl b/ds9/library/fits.tcl index 6ceb311..36548cd 100644 --- a/ds9/library/fits.tcl +++ b/ds9/library/fits.tcl @@ -107,12 +107,20 @@ proc ProcessFitsCmd {varname iname sock fn} { return } - global loadParam - global current + 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 @@ -145,6 +153,27 @@ proc ProcessFitsCmd {varname iname sock fn} { } FinishLoad } +} + +proc FitsCmdLoad {param layer mode} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadFitsSocket $parse(sock) $param $layer $mode]} { + InitError xpa + LoadFitsFile $param $layer $mode + } + } else { + # comm + if {$parse(fn) != {}} { + LoadFitsAlloc $parse(fn) $param $layer $mode + } else { + LoadFitsFile $param $layer $mode + } + } + FinishLoad +} proc ProcessSendFitsCmd {proc id param sock fn} { global current diff --git a/ds9/library/frame.tcl b/ds9/library/frame.tcl index 27fc888..2d13398 100644 --- a/ds9/library/frame.tcl +++ b/ds9/library/frame.tcl @@ -1425,13 +1425,13 @@ proc KeyFrame {which K A xx yy} { pan { switch -- $K { Up - - k {Pan 0 1 canvas} + k {PanCanvas 0 1} Down - - j {Pan 0 -1 canvas} + j {PanCanvas 0 -1} Left - - h {Pan 1 0 canvas} + h {PanCanvas 1 0} Right - - l {Pan -1 0 canvas} + l {PanCanvas -1 0} } UpdateMagnifier $which $xx $yy } @@ -2032,9 +2032,8 @@ proc TileDestroyDialog {} { if {[winfo exists $itile(top)]} { destroy $itile(top) destroy $itile(mb) + unset dtile } - - unset dtile } proc TileApplyDialog {} { @@ -2057,6 +2056,14 @@ 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 @@ -2210,6 +2217,25 @@ proc ProcessFrameCmd {varname iname} { } } } +} + +proc ActiveCmdSet {which value {cmd {}}} { + global active + + set active($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc CurrentCmdSet {which value {cmd {}}} { + global current + + set current($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendFrameCmd {proc id param} { global ds9 @@ -2311,6 +2337,14 @@ 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 @@ -2378,6 +2412,16 @@ proc ProcessTileCmd {varname iname} { } DisplayMode } +} + +proc TileCmdSet {which value {cmd {}}} { + global tile + + set tile($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendTileCmd {proc id param} { global current @@ -2407,6 +2451,14 @@ 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 @@ -2436,6 +2488,16 @@ proc ProcessBlinkCmd {varname iname} { } DisplayMode } +} + +proc BlinkCmdSet {which value {cmd {}}} { + global blink + + set blink($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendBlinkCmd {proc id param} { global current @@ -2472,6 +2534,14 @@ proc ProcessLockCmd {varname iname} { # 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 { @@ -2597,6 +2667,7 @@ proc ProcessLockCmd {varname iname} { } } } +} proc ProcessSendLockCmd {proc id param} { global panzoom @@ -2646,6 +2717,14 @@ 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 { @@ -2691,4 +2770,4 @@ proc ProcessMatchCmd {varname iname} { 3d {Match3DCurrent} } } - +} diff --git a/ds9/library/graph.tcl b/ds9/library/graph.tcl index cd32287..edf88e4 100644 --- a/ds9/library/graph.tcl +++ b/ds9/library/graph.tcl @@ -555,8 +555,7 @@ proc GraphDestroyDialog {} { if {[winfo exists $igraph(top)]} { destroy $igraph(top) destroy $igraph(mb) + unset dgraph } - - unset dgraph } diff --git a/ds9/library/grid.tcl b/ds9/library/grid.tcl index 083127d..9816168 100644 --- a/ds9/library/grid.tcl +++ b/ds9/library/grid.tcl @@ -1140,6 +1140,14 @@ 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} @@ -1155,7 +1163,6 @@ proc ProcessGridCmd {varname iname} { set grid(view) [FromYesNo [lindex $var $i]] GridUpdateCurrent } - type { incr i switch -- [string tolower [lindex $var $i]] { @@ -1171,7 +1178,6 @@ proc ProcessGridCmd {varname iname} { } GridUpdateCurrent } - system {incr i; set grid(system) [lindex $var $i]; GridUpdateCurrent} sky {incr i set grid(sky) [string tolower [lindex $var $i]] @@ -1187,13 +1193,16 @@ proc ProcessGridCmd {varname iname} { } 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]} - style {incr i; set grid(grid,style) [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]} @@ -1201,20 +1210,22 @@ proc ProcessGridCmd {varname iname} { } 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]} - style {incr i; set grid(axes,style) [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 @@ -1223,7 +1234,6 @@ proc ProcessGridCmd {varname iname} { incr i; set grid(format2) [lindex $var $i] GridUpdateCurrent } - tickmark - tickmarks - tick { @@ -1231,23 +1241,29 @@ proc ProcessGridCmd {varname iname} { 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]} - style {incr i; set grid(tick,style) [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]} - style {incr i; set grid(border,style) [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 { @@ -1258,6 +1274,7 @@ proc ProcessGridCmd {varname iname} { 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 { @@ -1284,7 +1301,6 @@ proc ProcessGridCmd {varname iname} { } GridUpdateCurrent } - title { incr i switch -- [string tolower [lindex $var $i]] { @@ -1296,6 +1312,7 @@ proc ProcessGridCmd {varname iname} { 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 { @@ -1317,7 +1334,6 @@ proc ProcessGridCmd {varname iname} { } GridUpdateCurrent } - label - labels - textlab { @@ -1334,6 +1350,7 @@ proc ProcessGridCmd {varname iname} { 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 { @@ -1355,7 +1372,6 @@ proc ProcessGridCmd {varname iname} { } GridUpdateCurrent } - view { # backward compatable incr i @@ -1382,20 +1398,17 @@ proc ProcessGridCmd {varname iname} { } 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 { @@ -1405,6 +1418,39 @@ proc ProcessGridCmd {varname iname} { } } } +} + +proc GridCmdSet {which value {cmd {}}} { + global grid + + set grid($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc GridCmdFontStyle {which value {cmd {}}} { + global grid + + switch $value { + normal { + set grid($which,weight) normal + set grid($which,slant) roman + } + bold { + set grid($which,weight) bold + set grid($which,slant) roman + } + italic { + set grid($which,weight) normal + set grid($which,slant) italic + } + } + + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendGridCmd {proc id param} { global grid @@ -1432,7 +1478,11 @@ proc ProcessSendGridCmd {proc id param} { switch -- [lindex $param 1] { color {$proc $id "$grid(grid,color)\n"} width {$proc $id "$grid(grid,width)\n"} - style {$proc $id "$grid(grid,style)\n"} + dash {$proc $id [ToYesNo $grid(grid,style)]} + style { + # backward compatible + $proc $id "$grid(grid,style)\n" + } gap1 {$proc $id "$grid(grid,gap1)\n"} gap2 {$proc $id "$grid(grid,gap2)\n"} gap3 {$proc $id "$grid(grid,gap3)\n"} @@ -1444,7 +1494,11 @@ proc ProcessSendGridCmd {proc id param} { switch -- [lindex $param 1] { color {$proc $id "$grid(axes,color)\n"} width {$proc $id "$grid(axes,width)\n"} - style {$proc $id "$grid(axes,style)\n"} + dash {$proc $id [ToYesNo $grid(axes,style)]} + style { + # backward compatible + $proc $id "$grid(axes,style)\n" + } type {$proc $id "$grid(axes,type)\n"} origin {$proc $id "$grid(axes,origin)\n"} default {$proc $id [ToYesNo $grid(axes)]} @@ -1460,7 +1514,11 @@ proc ProcessSendGridCmd {proc id param} { switch -- [lindex $param 1] { color {$proc $id "$grid(tick,color)\n"} width {$proc $id "$grid(tick,width)\n"} - style {$proc $id "$grid(tick,style)\n"} + dash {$proc $id [ToYesNo $grid(tick,style)]} + style { + # backward compatible + $proc $id "$grid(tick,style)\n" + } default {$proc $id [ToYesNo $grid(tick)]} } } @@ -1469,7 +1527,11 @@ proc ProcessSendGridCmd {proc id param} { switch -- [lindex $param 1] { color {$proc $id "$grid(border,color)\n"} width {$proc $id "$grid(border,width)\n"} - style {$proc $id "$grid(border,style)\n"} + dash {$proc $id [ToYesNo $grid(border,style)]} + style { + # backward compatible + $proc $id "$grid(border,style)\n" + } default {$proc $id [ToYesNo $grid(border)]} } } @@ -1480,9 +1542,12 @@ proc ProcessSendGridCmd {proc id param} { switch -- [lindex $param 1] { font {$proc $id "$grid(numlab,font)\n"} fontsize {$proc $id "$grid(numlab,size)\n"} - fontstyle - fontweight {$proc $id "$grid(numlab,weight)\n"} fontslant {$proc $id "$grid(numlab,slant)\n"} + fontstyle { + # backward compatible + $proc $id "$grid(numlab,weight)\n" + } color {$proc $id "$grid(numlab,color)\n"} gap1 {$proc $id "$grid(numlab,gap1)\n"} gap2 {$proc $id "$grid(numlab,gap2)\n"} @@ -1500,9 +1565,12 @@ proc ProcessSendGridCmd {proc id param} { gap {$proc $id "$grid(title,gap)\n"} font {$proc $id "$grid(title,font)\n"} fontsize {$proc $id "$grid(title,size)\n"} - fontstyle - fontweight {$proc $id "$grid(title,weight)\n"} fontslant {$proc $id "$grid(title,slant)\n"} + fontstyle { + # backward compatible + $proc $id "$grid(title,weight)\n" + } color {$proc $id "$grid(title,color)\n"} default {$proc $id [ToYesNo $grid(title)]} } @@ -1520,9 +1588,12 @@ proc ProcessSendGridCmd {proc id param} { gap2 {$proc $id "$grid(textlab,gap2)\n"} font {$proc $id "$grid(textlab,font)\n"} fontsize {$proc $id "$grid(textlab,size)\n"} - fontstyle - fontweight {$proc $id "$grid(textlab,weight)\n"} fontslant {$proc $id "$grid(textlab,slant)\n"} + fontstyle { + # backward compatible + $proc $id "$grid(textlab,weight)\n" + } color {$proc $id "$grid(textlab,color)\n"} default {$proc $id [ToYesNo $grid(textlab)]} } diff --git a/ds9/library/header.tcl b/ds9/library/header.tcl index a5836db..6762bea 100644 --- a/ds9/library/header.tcl +++ b/ds9/library/header.tcl @@ -77,13 +77,12 @@ proc DisplayHeader {frame id title} { global current set varname "hd-$frame-$id" - upvar #0 $varname var global $varname - SimpleTextDialog $varname $title 80 40 insert top \ [$current(frame) get fits header $id] # create a special text tag for keywords + upvar #0 $varname var $var(text) tag configure keyword -foreground blue # color tag keywords @@ -104,15 +103,12 @@ proc UpdateHeaderDialog {} { for {set id 1} {$id <= $cnt} {incr id} { set varname "hd-$frame-$id" - upvar #0 $varname var global $varname - if {![info exists var(top)]} { - continue - } - if {![winfo exists $var(top)]} { + if {![info exists $varname]} { continue } + upvar #0 $varname var $var(text) delete 1.0 end $var(text) insert end [$frame get fits header $id] @@ -131,15 +127,15 @@ proc DestroyHeader {frame} { } for {set id 1} {$id <= $cnt} {incr id} { - set varname "hd-$frame-$id" - upvar #0 $varname var - global $varname + DestroyHeaderOne $frame $id + } +} - if {[info exists $varname]} { - if {[winfo exists $var(top)]} { - SimpleTextDestroy $varname - } - } +proc DestroyHeaderOne {frame id} { + set varname "hd-$frame-$id" + global $varname + if {[info exists $varname]} { + SimpleTextDestroy $varname } } @@ -147,6 +143,14 @@ 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 - @@ -192,4 +196,29 @@ proc ProcessHeaderCmd {varname iname} { } } } +} + +proc DisplayHeaderCmd {id} { + global current + + DisplayHeader $current(frame) $id [$current(frame) get fits file name $id] +} + +proc CloseHeaderCmd {id} { + global current + DestroyHeaderOne $current(frame) $id +} + +proc SaveHeaderCmd {id fn} { + global current + + 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 $id] + close $ch + } +} diff --git a/ds9/library/help.tcl b/ds9/library/help.tcl index 2e34758..fb9967a 100644 --- a/ds9/library/help.tcl +++ b/ds9/library/help.tcl @@ -12,7 +12,7 @@ proc HelpDef {} { set help(command) "$ds9(root)/doc/ref/command.html" set help(userman) "$ds9(root)/doc/user/index.html" set help(faq) "$ds9(root)/doc/faq.html" - set help(release) "$ds9(root)/doc/release/r7.6.html" + set help(release) "$ds9(root)/doc/release/r8.0.html" set help(helpdesk) "$ds9(root)/doc/helpdesk.html" set help(story) "$ds9(root)/doc/story.html" set help(ack) "$ds9(root)/doc/acknowledgment.html" diff --git a/ds9/library/hv.tcl b/ds9/library/hv.tcl index cd42c57..a197300 100644 --- a/ds9/library/hv.tcl +++ b/ds9/library/hv.tcl @@ -821,14 +821,23 @@ proc HVArchChandraFTP {} { # Process Cmds proc ProcessWebCmd {varname iname} { - global ihv - - set w {hvweb} - upvar $varname var 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 { - # determine which web browser window + set w {hvweb} switch -- [string tolower [lindex $var $i]] { new { incr i @@ -910,6 +919,90 @@ proc ProcessWebCmd {varname iname} { } } } +} + +proc WebCmdCheck {} { + global cvarname + upvar #0 $cvarname cvar + + if {![info exists cvar(top)]} { + Error "[msgcat::mc {Unable to find web window}] $cvarname" + cat::YYABORT + return + } + if {![winfo exists $cvar(top)]} { + Error "[msgcat:: mc {Unable to find web window}] $cvarname" + cat::YYABORT + return + } +} + +proc WebCmdRef {ref} { + global ihv + global cvarname + + # look for reference in current list + if {[lsearch $ihv(windows) $ref] < 0} { + Error "[msgcat::mc {Unable to find web window}] $ref" + plot::YYABORT + return + } + set cvarname $ref + WebCmdCheck +} + +proc WebCmdNew {url {ww {hvweb}}} { + global ihv + global cvarname + upvar #0 $cvarname cvar + + set ii [lsearch $ihv(windows) $ww] + if {$ii>=0} { + append ww $ihv(unique) + incr ihv(unique) + } + + if {[string length $url] == 0} { + HV $ww Web {} {} 1 + } else { + ParseURL $url rr + switch -- $rr(scheme) { + {} { + # append 'http://' if needed + if {[string range $rr(path) 0 0] == "/"} { + set url "http:/$url" + } else { + set url "http://$url" + } + } + } + HV $ww Web $url {} 1 + } +} + +proc WebCmdClick {id} { + global cvarname + upvar #0 $cvarname cvar + + if {![info exists cvar(widget)]} { + return + } + + set tokens [$cvar(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 $cvarname [$cvar(widget) resolve $url] + break; + } + } + } +} proc ProcessSendWebCmd {proc id param} { global ihv diff --git a/ds9/library/hvsup.tcl b/ds9/library/hvsup.tcl index 0aca788..7e2a8da 100644 --- a/ds9/library/hvsup.tcl +++ b/ds9/library/hvsup.tcl @@ -1194,7 +1194,7 @@ proc HVParseImg {varname} { } switch -- $var(frame) { - new {MultiLoadBase} + new {MultiLoad} current {} } @@ -1231,7 +1231,7 @@ proc HVParseFITS {varname} { } switch -- $var(frame) { - new {MultiLoadBase} + new {MultiLoad} current {} } diff --git a/ds9/library/iis.tcl b/ds9/library/iis.tcl index 5bc8554..54b6ed6 100644 --- a/ds9/library/iis.tcl +++ b/ds9/library/iis.tcl @@ -362,8 +362,15 @@ proc ProcessIISCmd {varname iname} { upvar $varname var upvar $iname i - global current + 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]]]} { @@ -381,6 +388,13 @@ proc ProcessIISCmd {varname iname} { } } } +} + +proc IISCmd {filename {which {}}} { + global current + + $current(frame) iis set file name $filename $which +} proc ProcessSendIISCmd {proc id param} { global current diff --git a/ds9/library/imgsvr.tcl b/ds9/library/imgsvr.tcl index 1144069..2375731 100644 --- a/ds9/library/imgsvr.tcl +++ b/ds9/library/imgsvr.tcl @@ -427,7 +427,7 @@ proc IMGSVRParse {varname} { } switch -- $var(mode) { - new {MultiLoadBase} + new {MultiLoad} current {} } @@ -568,6 +568,68 @@ proc IMGSVRProcessCmd {varname iname vvarname} { } } +proc IMGSVRCmd {varname which value} { + upvar #0 $varname var + global $varname + + set var($which) $value +} + +proc IMGSVRCmdName {varname value} { + upvar #0 $varname var + global $varname + + set var(name) $value + if {$var(name) != {}} { + IMGSVRApply $varname 1 + } +} + +proc IMGSVRCmdCoord {varname xx yy skyformat} { + upvar #0 $varname var + global $varname + + set var(x) $xx + set var(y) $yy + set var(skyformat) $skyformat + set var(skyformat,msg) $skyformat + IMGSVRApply $varname 1 +} + +proc IMGSVRCmdSize {varname ww hh rformat} { + upvar #0 $varname var + global $varname + + set var(width) $ww + set var(height) $hh + set var(rformat) $rformat + set var(rformat,msg) $rformat +} + +proc IMGSVRCmdPixels {varname ww hh} { + upvar #0 $varname var + global $varname + + set var(width,pixels) $ww + set var(height,pixels) $hh +} + +proc IMGSVRCmdUpdate {varname} { + upvar #0 $varname var + global $varname + + IMGSVRUpdate $varname + IMGSVRApply $varname 1 +} + +proc IMGSVRCmdCrosshair {varname} { + upvar #0 $varname var + global $varname + + IMGSVRCrosshair $varname + IMGSVRApply $varname 1 +} + proc IMGSVRProcessSendCmd {proc id param vvarname} { upvar #0 $vvarname vvar diff --git a/ds9/library/layout.tcl b/ds9/library/layout.tcl index 4912673..f026b52 100644 --- a/ds9/library/layout.tcl +++ b/ds9/library/layout.tcl @@ -810,6 +810,15 @@ proc ViewVertCmd {} { # Process Cmds +proc CanvasCmdSet {which value {cmd {}}} { + global canvas + + set canvas($which) $value + if {$cmd != {}} { + eval $cmd + } +} + proc ProcessHeightCmd {varname iname} { upvar $varname var upvar $iname i @@ -818,10 +827,19 @@ 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 } +} proc ProcessSendHeightCmd {proc id param} { global canvas @@ -836,10 +854,19 @@ 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 } +} proc ProcessSendWidthCmd {proc id param} { global canvas @@ -850,10 +877,16 @@ 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 - global canvas - global icanvas set item [string tolower [lindex $var $i]] @@ -1018,6 +1051,16 @@ proc ProcessViewCmd {varname iname} { } } } +} + +proc ViewCmdSet {which value {cmd {}}} { + global view + + set view($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendViewCmd {proc id param} { global view diff --git a/ds9/library/load.tcl b/ds9/library/load.tcl index dc6d385..cc10f10 100644 --- a/ds9/library/load.tcl +++ b/ds9/library/load.tcl @@ -13,18 +13,19 @@ proc MultiLoad {{layer {}} {mode {}}} { puts stderr "MultiLoad" } - if {$layer != {} || $mode != {}} { - return - } - if {$current(frame) != {}} { - if {![$current(frame) has fits]} { - return - } switch -- [$current(frame) get type] { base - - 3d {CreateFrame} - rgb {} + 3d { + if {$layer != {} || $mode != {}} { + return + } + if {![$current(frame) has fits]} { + return + } + CreateFrame + } + rgb {CreateFrame} } } else { CreateFrame @@ -39,33 +40,6 @@ proc MultiLoad {{layer {}} {mode {}}} { } } -proc MultiLoadBase {} { - global ds9 - global current - - global debug - if {$debug(tcl,layout)} { - puts stderr "MultiLoadBase" - } - - if {$current(frame) != {}} { - if {![$current(frame) has fits]} { - return - } - CreateFrame - } else { - CreateFrame - return - } - - # go into tile mode if more than one - set cnt [llength $ds9(frames)] - if {$cnt > 1 && $current(display) != "tile"} { - set current(display) tile - DisplayMode - } -} - proc MultiLoadRGB {} { global ds9 global current @@ -76,10 +50,16 @@ proc MultiLoadRGB {} { } if {$current(frame) != {}} { - if {![$current(frame) has fits]} { - return + switch -- [$current(frame) get type] { + base - + 3d {CreateRGBFrame} + rgb { + if {![$current(frame) has fits]} { + return + } + CreateRGBFrame + } } - CreateRGBFrame } else { CreateRGBFrame return @@ -434,6 +414,14 @@ 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 @@ -453,6 +441,7 @@ proc ProcessPreserveCmd {varname iname} { } } } +} proc ProcessSendPreserveCmd {proc id param} { global scale @@ -475,6 +464,14 @@ 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 @@ -521,3 +518,22 @@ proc ProcessUpdateCmd {varname iname} { incr i -1 } } +} + +proc UpdateCmd {{which {}} {x1 {}} {y1 {}} {x2 {}} {y2 {}}} { + global current + + if {$current(frame) == {}} { + return + } + $current(frame) update $which $x1 $y1 $x2 $y2 +} + +proc UpdateCmdNow {{which {}} {x1 {}} {y1 {}} {x2 {}} {y2 {}}} { + global current + + if {$current(frame) == {}} { + return + } + $current(frame) update now $which $x1 $y1 $x2 $y2 +} diff --git a/ds9/library/magnifier.tcl b/ds9/library/magnifier.tcl index 21b1aa3..25fa9ed 100644 --- a/ds9/library/magnifier.tcl +++ b/ds9/library/magnifier.tcl @@ -140,6 +140,14 @@ 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 @@ -172,6 +180,16 @@ proc ProcessMagnifierCmd {varname iname} { } } } +} + +proc PmagnifierCmdSet {which value {cmd {}}} { + global pmagnifier + + set pmagnifier($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendMagnifierCmd {proc id param} { global pmagnifier diff --git a/ds9/library/marker.tcl b/ds9/library/marker.tcl index 28d14ca..5ecd893 100644 --- a/ds9/library/marker.tcl +++ b/ds9/library/marker.tcl @@ -49,27 +49,27 @@ proc MarkerDef {} { set marker(plot3d) 0 set marker(stats) 0 + set marker(format) ds9 + + # these are only used for save/load/list and + # are set from current wcs values + array set pmarker [array get marker] + set marker(copy) {} set marker(copy,system) {} set marker(maxdialog) 48 set marker(load) current - set marker(format) ds9 - # these are only used for save/load/list and are set from current wcs values set marker(system) physical set marker(sky) fk5 set marker(skyformat) degrees set marker(strip) 0 - array set pmarker [array get marker] - unset pmarker(copy) - unset pmarker(copy,system) - unset pmarker(maxdialog) - unset pmarker(load) - unset pmarker(system) - unset pmarker(sky) - unset pmarker(skyformat) - unset pmarker(strip) + # temp + set marker(load,format) $marker(format) + set marker(load,system) $marker(system) + set marker(load,sky) $marker(sky) + set marker(tag) {} set pmarker(epsilon) 3 set pmarker(dformat) degrees @@ -1391,15 +1391,32 @@ proc MarkerBackup {ch which fdir rdir} { proc ProcessRegionsCmd {varname iname sock fn} { upvar $varname var upvar $iname i - - global ds9 - global current global marker - global pmarker # 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 @@ -1944,6 +1961,178 @@ proc ProcessRegionsCmd {varname iname sock fn} { } } } +} + +proc MarkerCmdSet {which value {cmd {}}} { + global marker + + set marker($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc PmarkerCmdSet {which value {cmd {}}} { + global pmarker + + set pmarker($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc RegionCmdLoad {} { + global marker + global current + global parse + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + if {$parse(sock) != {}} { + # xpa path + # fits regions files not supported + $current(frame) marker load $marker(load,format) \ + $parse(sock) $marker(load,system) $marker(load,sky) + UpdateGroupDialog + } elseif {$parse(fn) != {}} { + # samp path + MarkerLoadFrames $fn $current(frame) \ + $marker(load,format) $marker(load,system) $marker(load,sky) + } +} + +proc RegionCmdLoadFn {fn {all {0}}} { + global marker + global ds9 + global current + + if {$all} { + set frames $ds9(frames) + } else { + set frames $current(frame) + } + MarkerLoadFrames $fn $frames \ + $marker(load,format) $marker(load,system) $marker(load,sky) +} + +proc RegionCmdSave {fn} { + global marker + global current + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker save $fn $marker(format) \ + $marker(system) $marker(sky) $marker(skyformat) $marker(strip) + FileLast markerfbox $fn +} + +proc RegionCmdList {} { + global marker + global current + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + SimpleTextDialog markertxt [msgcat::mc {Region}] 80 20 insert top \ + [$current(frame) marker list $marker(format) $marker(system) \ + $marker(sky) $marker(skyformat) $marker(strip)] +} + +proc RegionCmdGroup {cmd {val1 {}} {val2 {}}} { + global current + global marker + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker "\{$marker(tag)\}" $cmd $val1 $val2 + UpdateGroupDialog +} + +proc RegionCmdGroupTag {tag} { + global marker + + set marker(tag) $tag +} + +proc RegionCmdGroupNew {} { + global current + global marker + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + set tag $marker(tag) + if {$tag == {}} { + set tag [$current(frame) get marker tag default name] + } + $current(frame) marker tag "\{$tag\}" + UpdateGroupDialog +} + +proc RegionCmdGroupUpdate {} { + global current + global marker + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker tag update "\{$marker(tag)\}" + UpdateGroupDialog +} + +proc RegionCmdGroupFont {value} { + global current + global marker + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker "\{$marker(tag)\}" font "\{$value\}" + UpdateGroupDialog +} + +proc RegionCmdTemplate {fn} { + LoadTemplateMarker $fn + FileLast templatefbox $fn +} + +proc RegionCmdTemplateAt {fn ra dec sys sky} { + LoadTemplateMarkerAt $fn $ra $dec $sys $sky + FileLast templatefbox $fn +} + +proc RegionCmdTemplateSave {fn} { + global marker + global current + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker save template $fn + FileLast templatefbox $fn +} + +proc RegionCmdCommand {cmd} { + global marker + global current + + if {$current(frame) == {} || ![$current(frame) has fits]} { + return + } + + $current(frame) marker command $marker(format) "\{$cmd\}" +} proc ProcessSendRegionsCmd {proc id param sock fn} { global current diff --git a/ds9/library/mask.tcl b/ds9/library/mask.tcl index 802315b..a6ba7d9 100644 --- a/ds9/library/mask.tcl +++ b/ds9/library/mask.tcl @@ -19,6 +19,24 @@ proc MaskDef {} { array set pmask [array get mask] } +proc MaskMark {} { + global mask + global current + + if {$current(frame) != {}} { + $current(frame) mask mark $mask(mark) + } +} + +proc MaskColor {} { + global mask + global current + + if {$current(frame) != {}} { + $current(frame) mask color $mask(color) + } +} + proc MaskTransparency {} { global mask global current @@ -243,10 +261,22 @@ proc ProcessMaskCmd {varname iname} { upvar $iname i global mask - global current - set rr {} + 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} @@ -284,6 +314,16 @@ proc ProcessMaskCmd {varname iname} { return $rr } +} + +proc MaskCmdSet {which value {cmd {}}} { + global mask + + set mask($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendMaskCmd {proc id param} { global mask diff --git a/ds9/library/mecube.tcl b/ds9/library/mecube.tcl index 4523239..426ca81 100644 --- a/ds9/library/mecube.tcl +++ b/ds9/library/mecube.tcl @@ -81,6 +81,18 @@ 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 @@ -113,6 +125,27 @@ proc ProcessMECubeCmd {varname iname sock fn} { } FinishLoad } +} + +proc MECubeCmdLoad {param} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadMECubeSocket $parse(sock) $param]} { + InitError xpa + LoadMECubeFile $param + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMECubeAlloc $parse(fn) $param + } else { + LoadMECubeFile $param + } + } + FinishLoad +} proc ProcessSendMECubeCmd {proc id param sock fn} { global current diff --git a/ds9/library/mosaicimageiraf.tcl b/ds9/library/mosaicimageiraf.tcl index 4cf0ce4..f12db74 100644 --- a/ds9/library/mosaicimageiraf.tcl +++ b/ds9/library/mosaicimageiraf.tcl @@ -47,11 +47,19 @@ proc ProcessMosaicImageIRAFCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + global debug + if {$debug(tcl,parser)} { + global parse + set parse(sock) $sock + set parse(fn) $fn - set layer {} + 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 @@ -84,3 +92,24 @@ proc ProcessMosaicImageIRAFCmd {varname iname sock fn} { } FinishLoad } +} + +proc MosaicImageIRAFCmdLoad {param layer} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadMosaicImageIRAFSocket $parse(sock) $param $layer]} { + InitError xpa + LoadMosaicImageIRAFFile $param $layer + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMosaicImageIRAFAlloc $parse(fn) $param $layer + } else { + LoadMosaicImageIRAFFile $param $layer + } + } + FinishLoad +} diff --git a/ds9/library/mosaicimagewcs.tcl b/ds9/library/mosaicimagewcs.tcl index 3f59eb6..e6b4a19 100644 --- a/ds9/library/mosaicimagewcs.tcl +++ b/ds9/library/mosaicimagewcs.tcl @@ -75,11 +75,19 @@ proc ProcessMosaicImageWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -119,6 +127,27 @@ proc ProcessMosaicImageWCSCmd {varname iname sock fn} { } FinishLoad } +} + +proc MosaicImageWCSCmdLoad {param layer sys} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadMosaicImageWCSSocket $parse(sock) $param $layer $sys]} { + InitError xpa + LoadMosaicImageWCSFile $param $layer $sys + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMosaicImageWCSAlloc $parse(fn) $param $layer $sys + } else { + LoadMosaicImageWCSFile $param $layer $sys + } + } + FinishLoad +} proc ProcessSendMosaicImageWCSCmd {proc id param sock fn} { global current diff --git a/ds9/library/mosaicimagewfpc2.tcl b/ds9/library/mosaicimagewfpc2.tcl index 1fe23fc..ac59f98 100644 --- a/ds9/library/mosaicimagewfpc2.tcl +++ b/ds9/library/mosaicimagewfpc2.tcl @@ -53,8 +53,17 @@ proc ProcessMosaicImageWFPC2Cmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 { @@ -88,5 +97,24 @@ proc ProcessMosaicImageWFPC2Cmd {varname iname sock fn} { } FinishLoad } +} +proc MosaicImageWFPC2CmdLoad {param} { + global parse + if {$parse(sock) != {}} { + # xpa + if {![LoadMosaicImageWFPC2Socket $parse(sock) $param]} { + InitError xpa + LoadMosaicImageWFPC2File $param + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMosaicImageWFPC2Alloc $parse(fn) $param + } else { + LoadMosaicImageWFPC2File $param + } + } + FinishLoad +} diff --git a/ds9/library/mosaiciraf.tcl b/ds9/library/mosaiciraf.tcl index be91595..c2a3656 100644 --- a/ds9/library/mosaiciraf.tcl +++ b/ds9/library/mosaiciraf.tcl @@ -47,11 +47,19 @@ proc ProcessMosaicIRAFCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + global debug + if {$debug(tcl,parser)} { + global parse + set parse(sock) $sock + set parse(fn) $fn - set layer {} + 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 @@ -84,3 +92,24 @@ proc ProcessMosaicIRAFCmd {varname iname sock fn} { } FinishLoad } +} + +proc MosaicIRAFCmdLoad {param layer} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadMosaicIRAFSocket $parse(sock) $param $layer]} { + InitError xpa + LoadMosaicIRAFFile $param $layer + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMosaicIRAFAlloc $parse(fn) $param $layer + } else { + LoadMosaicIRAFFile $param $layer + } + } + FinishLoad +} diff --git a/ds9/library/mosaicwcs.tcl b/ds9/library/mosaicwcs.tcl index 3e4b604..65e16b0 100644 --- a/ds9/library/mosaicwcs.tcl +++ b/ds9/library/mosaicwcs.tcl @@ -83,11 +83,19 @@ proc ProcessMosaicWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -127,6 +135,27 @@ proc ProcessMosaicWCSCmd {varname iname sock fn} { } FinishLoad } +} + +proc MosaicWCSCmdLoad {param layer sys} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadMosaicWCSSocket $parse(sock) $param $layer $sys]} { + InitError xpa + LoadMosaicWCSFile $param $layer $sys + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMosaicWCSAlloc $parse(fn) $param $layer $sys + } else { + LoadMosaicWCSFile $param $layer $sys + } + } + FinishLoad +} proc ProcessSendMosaicWCSCmd {proc id param sock fn} { global current diff --git a/ds9/library/movie.tcl b/ds9/library/movie.tcl index 1036199..a6d33c0 100644 --- a/ds9/library/movie.tcl +++ b/ds9/library/movie.tcl @@ -456,12 +456,19 @@ proc ProcessMovieCmd {varname iname} { upvar $varname var upvar $iname i - global movie - # we need to be realized # 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 - @@ -530,5 +537,14 @@ proc ProcessMovieCmd {varname iname} { Movie $fn } +} + +proc MovieCmdSet {which value {cmd {}}} { + global movie + set movie($which) $value + if {$cmd != {}} { + eval $cmd + } +} diff --git a/ds9/library/multiframe.tcl b/ds9/library/multiframe.tcl index 666d81e..cc5a9bc 100644 --- a/ds9/library/multiframe.tcl +++ b/ds9/library/multiframe.tcl @@ -79,17 +79,18 @@ proc LoadMultiFrameAlloc {path fn} { } # ProcessLoad will clear loadParam each time + # can be gz, so use allocgz set loadParam(file,type) fits set loadParam(file,mode) {} + set loadParam(load,type) allocgz + set loadParam(load,layer) {} if {$path != {}} { - set loadParam(load,type) allocgz set loadParam(file,name) "stdin\[$ext\]" set loadParam(file,fn) "$path\[$ext\]" } else { - set loadParam(load,type) mmapincr set loadParam(file,name) "$fn\[$ext\]" + set loadParam(file,fn) "$fn\[$ext\]" } - set loadParam(load,layer) {} if {![ProcessLoad 0]} { if {$ext} { @@ -135,6 +136,18 @@ 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 @@ -175,4 +188,32 @@ proc ProcessMultiFrameCmd {varname iname sock fn} { } FinishLoad } +} + +proc MultiframeCmdLoad {param} { + global parse + if {$parse(sock) != {}} { + # xpa + global tcl_platform + switch $tcl_platform(os) { + Linux - + Darwin - + SunOS { + if {![LoadMultiFrameSocket $parse(sock) $param]} { + InitError xpa + LoadMultiFrameFile $param + } + } + {Windows NT} {LoadMultiFrameFile $param} + } + } else { + # comm + if {$parse(fn) != {}} { + LoadMultiFrameAlloc $parse(fn) $param + } else { + LoadMultiFrameFile $param + } + } + FinishLoad +} diff --git a/ds9/library/nameres.tcl b/ds9/library/nameres.tcl index 075dfa0..8af9383 100644 --- a/ds9/library/nameres.tcl +++ b/ds9/library/nameres.tcl @@ -184,6 +184,19 @@ proc ProcessNRESCmd {varname iname} { upvar $varname var upvar $iname i + 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 @@ -191,8 +204,6 @@ proc ProcessNRESCmd {varname iname} { global nres global pnres - NRESDialog - switch -- [string tolower [lindex $var $i]] { {} - open {} @@ -230,6 +241,22 @@ proc ProcessNRESCmd {varname iname} { } } } +} + +proc NRESCmdSet {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value +} + +proc NRESCmdName {value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(name) $value + NRESApply $cvarname 1 +} proc ProcessSendNRESCmd {proc id param} { global nres diff --git a/ds9/library/nrrd.tcl b/ds9/library/nrrd.tcl index 512ec7c..1193eb1 100644 --- a/ds9/library/nrrd.tcl +++ b/ds9/library/nrrd.tcl @@ -84,11 +84,19 @@ proc ProcessNRRDCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -121,6 +129,27 @@ proc ProcessNRRDCmd {varname iname sock fn} { } FinishLoad } +} + +proc NRRDCmdLoad {param layer} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![ImportNRRDSocket $parse(sock) $param $layer]} { + InitError xpa + ImportNRRDFile $param $layer + } + } else { + # comm + if {$parse(fn) != {}} { + ImportNRRDAlloc $parse(fn) $param $layer + } else { + ImportNRRDFile $param $layer + } + } + FinishLoad +} proc ProcessSendNRRDCmd {proc id param sock fn} { global current diff --git a/ds9/library/nvss.tcl b/ds9/library/nvss.tcl index e572899..ba2c019 100644 --- a/ds9/library/nvss.tcl +++ b/ds9/library/nvss.tcl @@ -153,7 +153,16 @@ proc ProcessNVSSCmd {varname iname} { upvar $iname i NVSSDialog - IMGSVRProcessCmd $varname $iname dnvss + + global debug + if {$debug(tcl,parser)} { + nvss::YY_FLUSH_BUFFER + nvss::yy_scan_string [lrange $var $i end] + nvss::yyparse + incr i [expr $nvss::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dnvss + } } proc ProcessSendNVSSCmd {proc id param} { diff --git a/ds9/library/pagesetup.tcl b/ds9/library/pagesetup.tcl index 75f64db..e88982a 100644 --- a/ds9/library/pagesetup.tcl +++ b/ds9/library/pagesetup.tcl @@ -181,6 +181,14 @@ 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]] { @@ -192,6 +200,7 @@ proc ProcessPSPageSetupCmd {varname iname} { size {incr i; set ps(size) [string tolower [lindex $var $i]] } } } +} proc ProcessSendPSPageSetupCmd {proc id param} { global ps diff --git a/ds9/library/panzoom.tcl b/ds9/library/panzoom.tcl index e890236..ae3de93 100644 --- a/ds9/library/panzoom.tcl +++ b/ds9/library/panzoom.tcl @@ -66,15 +66,20 @@ proc CenterFrame {which} { } } -proc Pan {x y sys {sky {}}} { +proc PanCanvas {x y} { global current if {$current(frame) != {}} { - switch -- $sys { - canvas {$current(frame) pan $x $y} - default {$current(frame) pan $sys $sky $x $y} - } + $current(frame) pan $x $y + UpdatePan $current(frame) + } +} +proc Pan {x y sys sky} { + global current + + if {$current(frame) != {}} { + $current(frame) pan $sys $sky $x $y UpdatePan $current(frame) } } @@ -219,6 +224,13 @@ proc ChangeZoom {} { } } +proc ZoomTo {zx zy} { + global current + + set current(zoom) "$zx $zy" + ChangeZoom +} + proc Zoom {zx zy} { global current @@ -496,9 +508,8 @@ proc PanZoomDestroyDialog {} { if {[winfo exists $ipanzoom(top)]} { destroy $ipanzoom(top) destroy $ipanzoom(mb) + unset dpanzoom } - - unset dpanzoom } proc UpdatePanZoomMenu {} { @@ -666,6 +677,15 @@ proc PanZoomBackup {ch which} { # Process Cmds +proc PanZoomCmdSet {which value {cmd {}}} { + global panzoom + + set panzoom($which) $value + if {$cmd != {}} { + eval $cmd + } +} + proc ProcessPanCmd {varname iname} { upvar $varname var upvar $iname i @@ -673,6 +693,14 @@ 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} @@ -700,6 +728,7 @@ proc ProcessPanCmd {varname iname} { } } } +} proc ProcessSendPanCmd {proc id param} { global current @@ -721,6 +750,14 @@ 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} @@ -759,6 +796,7 @@ proc ProcessZoomCmd {varname iname} { } } } +} proc ProcessSendZoomCmd {proc id param} { global current @@ -779,6 +817,14 @@ 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} @@ -789,6 +835,7 @@ proc ProcessOrientCmd {varname iname} { } } } +} proc ProcessSendOrientCmd {proc id param} { global current @@ -802,6 +849,14 @@ 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} @@ -814,6 +869,7 @@ proc ProcessRotateCmd {varname iname} { default {Rotate [lindex $var $i]} } } +} proc ProcessSendRotateCmd {proc id param} { global current diff --git a/ds9/library/photo.tcl b/ds9/library/photo.tcl index 60d5557..0bdaaaf 100644 --- a/ds9/library/photo.tcl +++ b/ds9/library/photo.tcl @@ -203,11 +203,19 @@ proc ProcessPhotoCmd {varname iname ch fn} { upvar 2 $varname var upvar 2 $iname i - global loadParam - global current + 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 @@ -248,28 +256,49 @@ proc ProcessPhotoCmd {varname iname ch fn} { } FinishLoad } +} -proc ProcessSendGIFCmd {proc id param ch fn} { - global current +proc PhotoCmdLoad {param mode} { + global parse + if {$parse(ch) != {}} { + # xpa + global tcl_platform + switch $tcl_platform(os) { + Linux - + Darwin - + SunOS { + if {![ImportPhotoSocket $parse(ch) $param $mode]} { + InitError xpa + ImportPhotoFile $param $mode + } + } + {Windows NT} {ImportPhotoFile $param $mode} + } + } else { + # comm + if {$parse(fn) != {}} { + ImportPhotoAlloc $parse(fn) $param $mode + } else { + ImportPhotoFile $param $mode + } + } + FinishLoad +} + +proc ProcessSendGIFCmd {proc id param ch fn} { ProcessSendPhotoCmd gif $proc $id $param $ch $fn } proc ProcessSendJPEGCmd {proc id param ch fn} { - global current - ProcessSendPhotoCmd jpeg $proc $id $param $ch $fn } proc ProcessSendPNGCmd {proc id param ch fn} { - global current - ProcessSendPhotoCmd png $proc $id $param $ch $fn } proc ProcessSendTIFFCmd {proc id param ch fn} { - global current - ProcessSendPhotoCmd tiff $proc $id $param $ch $fn } diff --git a/ds9/library/pixel.tcl b/ds9/library/pixel.tcl index c16d1ae..5445841 100644 --- a/ds9/library/pixel.tcl +++ b/ds9/library/pixel.tcl @@ -122,9 +122,6 @@ proc PixelTableDestroyDialog {} { if {[winfo exists $ipixel(top)]} { destroy $ipixel(top) destroy $ipixel(mb) - } - - if {[info exists dpixel]} { unset dpixel } } @@ -269,6 +266,14 @@ 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 - @@ -288,6 +293,15 @@ proc ProcessPixelTableCmd {varname iname} { } } } +} + +proc PixelTableCmd {which} { + if {$which} { + PixelTableDialog + } else { + PixelTableDestroyDialog + } +} proc ProcessSendPixelTableCmd {proc id param sock fn} { PixelTableDialog diff --git a/ds9/library/plotprocess.tcl b/ds9/library/plotprocess.tcl index b4dcd6b..c62f767 100644 --- a/ds9/library/plotprocess.tcl +++ b/ds9/library/plotprocess.tcl @@ -102,8 +102,24 @@ proc PrefsDialogPlot {} { proc ProcessPlotCmd {xarname iname buf fn} { upvar $xarname xar 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 @@ -433,6 +449,7 @@ proc ProcessPlotCmd {xarname iname buf fn} { # force update update idletasks } +} proc ProcessPlotNew {varname xarname iname buf} { upvar #0 $varname var @@ -516,8 +533,8 @@ proc ProcessPlotNewOne {which varname xarname iname buf} { } proc ProcessPlotData {varname xarname iname buf} { - upvar #0 $varname var global $varname + upvar #0 $varname var upvar 2 $xarname xar upvar 2 $iname i @@ -529,6 +546,201 @@ proc ProcessPlotData {varname xarname iname buf} { PlotList $varname } +proc PlotCmdCheck {} { + global cvarname + upvar #0 $cvarname cvar + + if {![info exists cvar(top)]} { + Error "[msgcat::mc {Unable to find plot window}] $cvarname" + plot::YYABORT + return + } + if {![winfo exists $cvar(top)]} { + Error "[msgcat::mc {Unable to find plot window}] $cvarname" + plot::YYABORT + return + } +} + +proc PlotCmdRef {ref} { + global iap + global cvarname + + # look for reference in current list + if {[lsearch $iap(windows) $ref] < 0} { + Error "[msgcat::mc {Unable to find plot window}] $ref" + plot::YYABORT + return + } + set cvarname $ref + PlotCmdCheck +} + +proc PlotCmdNew {name} { + global parse + + if {$name != {}} { + set parse(tt) $name + } + + if {$parse(buf) != {}} { + return + } elseif {$parse(fn) != {}} { + if {[file exists $parse(fn)]} { + set ch [open $parse(fn) r] + set parse(buf) [read $ch] + close $ch + return + } + } + set parse(buf) {} +} + +proc PlotCmdLine {title xaxis yaxis dim} { + global parse + PlotLine $parse(tt) {} $title $xaxis $yaxis $dim $parse(buf) +} + +proc PlotCmdBar {title xaxis yaxis dim} { + global parse + PlotBar $parse(tt) {} $title $xaxis $yaxis $dim $parse(buf) +} + +proc PlotCmdScatter {title xaxis yaxis dim} { + global parse + PlotScatter $parse(tt) {} $title $xaxis $yaxis $dim $parse(buf) +} + +proc PlotCmdAnalysisPlotStdin {which} { + global parse + AnalysisPlotStdin $which $parse(tt) {} $parse(buf) +} + +proc PlotCmdData {dim} { + global parse + global cvarname + upvar #0 $cvarname cvar + + if {$parse(buf) == {}} { + if {$parse(fn) != {}} { + if {[file exists $parse(fn)]} { + set ch [open $parse(fn) r] + set parse(buf) [read $ch] + close $ch + } + } + if {$parse(buf) == {}} { + Error "[msgcat::mc {Unable to load plot data}] $fn" + plot::YYABORT + return + } + } + + PlotRaise $cvarname + PlotDataSet $cvarname $dim $parse(buf) + $cvar(proc,updategraph) $cvarname + PlotStats $cvarname + PlotList $cvarname +} + +proc PlotCmdLoad {fn dim} { + global cvarname + + if {$fn != {}} { + PlotLoadDataFile $cvarname $fn $dim + FileLast apdatafbox $fn + } +} + +proc PlotCmdSave {fn} { + global cvarname + + if {$fn != {}} { + PlotSaveDataFile $cvarname $fn + FileLast apdatafbox $fn + } +} + +proc PlotCmdLoadConfig {fn} { + global cvarname + + if {$fn != {}} { + PlotLoadConfigFile $cvarname $fn + FileLast apconfigfbox $fn + } +} + +proc PlotCmdSaveConfig {fn} { + global cvarname + + if {$fn != {}} { + PlotSaveConfigFile $cvarname $fn + FileLast apconfigfbox $fn + } +} + +proc PlotCmdSet {which value {cmd {}}} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value + if {$cmd != {}} { + eval $cmd $cvarname + } +} + +proc PlotCmdPrint {} { + global cvarname + + PlotPostScript $cvarname +} + +proc PlotCmdUpdateGraph {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value + $cvar(proc,updategraph) $cvarname +} + +proc PlotCmdUpdateElement {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value + $cvar(proc,updateelement) $cvarname +} + +proc PlotCmdFontStyle {which value} { + global cvarname + upvar #0 $cvarname cvar + + switch $value { + normal { + set cvar($which,weight) normal + set cvar($which,slant) roman + } + bold { + set cvar($which,weight) bold + set cvar($which,slant) roman + } + italic { + set cvar($which,weight) normal + set cvar($which,slant) italic + } + } + + $cvar(proc,updategraph) $cvarname +} + +proc PlotCmdSelect {value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(data,current) $value + PlotCurrentData $cvarname +} + # File Menu proc ProcessPlotPrint {varname xarname iname} { upvar #0 $varname var @@ -639,6 +851,7 @@ proc ProcessPlotFont {varname xarname iname} { weight {incr i; set var(graph,title,weight) [lindex $xar $i]} slant {incr i; set var(graph,title,slant) [lindex $xar $i]} style { + # backward compatibility incr i switch [string tolower [lindex $xar $i]] { normal { @@ -667,6 +880,7 @@ proc ProcessPlotFont {varname xarname iname} { weight {incr i; set var(axis,title,weight) [lindex $xar $i]} slant {incr i; set var(axis,title,slant) [lindex $xar $i]} style { + # backward compatibility incr i switch [string tolower [lindex $xar $i]] { normal { @@ -695,6 +909,7 @@ proc ProcessPlotFont {varname xarname iname} { weight {incr i; set var(axis,font,weight) [lindex $xar $i]} slant {incr i; set var(axis,font,slant) [lindex $xar $i]} style { + # backward compatibility incr i switch [string tolower [lindex $xar $i]] { normal { @@ -721,6 +936,24 @@ proc ProcessPlotFont {varname xarname iname} { size {incr i; set var(legend,title,size) [lindex $xar $i]} weight {incr i; set var(legend,title,weight) [lindex $xar $i]} slant {incr i; set var(legend,title,slant) [lindex $xar $i]} + style { + # backward compatibility + incr i + switch [string tolower [lindex $xar $i]] { + normal { + set var(legend,title,weight) normal + set var(legend,title,slant) roman + } + bold { + set var(legend,title,weight) bold + set var(legend,title,slant) roman + } + italic { + set var(legend,title,weight) normal + set var(legend,title,slant) italic + } + } + } } } legend { @@ -731,6 +964,24 @@ proc ProcessPlotFont {varname xarname iname} { size {incr i; set var(legend,font,size) [lindex $xar $i]} weight {incr i; set var(legend,font,weight) [lindex $xar $i]} slant {incr i; set var(legend,font,slant) [lindex $xar $i]} + style { + # backward compatibility + incr i + switch [string tolower [lindex $xar $i]] { + normal { + set var(legend,font,weight) normal + set var(legend,font,slant) roman + } + bold { + set var(legend,font,weight) bold + set var(legend,font,slant) roman + } + italic { + set var(legend,font,weight) normal + set var(legend,font,slant) italic + } + } + } } } } @@ -1125,6 +1376,10 @@ proc ProcessSendPlotCmd {proc id param} { size {$proc $id "$var(graph,title,size)\n"} weight {$proc $id "$var(graph,title,weight)\n"} slant {$proc $id "$var(graph,title,slant)\n"} + style { + # backward compatibility + $proc $id "$var(graph,title,weight)\n" + } } } axestitle - @@ -1136,6 +1391,10 @@ proc ProcessSendPlotCmd {proc id param} { size {$proc $id "$var(axis,title,size)\n"} weight {$proc $id "$var(axis,title,weight)\n"} slant {$proc $id "$var(axis,title,slant)\n"} + style { + # backward compatibility + $proc $id "$var(axis,title,weight)\n" + } } } axesnumbers - @@ -1147,6 +1406,10 @@ proc ProcessSendPlotCmd {proc id param} { size {$proc $id "$var(axis,font,size)\n"} weight {$proc $id "$var(axis,font,weight)\n"} slant {$proc $id "$var(axis,font,slant)\n"} + style { + # backward compatibility + $proc $id "$var(axis,font,weight)\n" + } } } legendtitle { @@ -1157,6 +1420,10 @@ proc ProcessSendPlotCmd {proc id param} { size {$proc $id "$var(legend,title,size)\n"} weight {$proc $id "$var(legend,title,weight)\n"} slant {$proc $id "$var(legend,title,slant)\n"} + style { + # backward compatibility + $proc $id "$var(legend,title,weight)\n" + } } } legend { @@ -1167,6 +1434,10 @@ proc ProcessSendPlotCmd {proc id param} { size {$proc $id "$var(legend,font,size)\n"} weight {$proc $id "$var(legend,font,weight)\n"} slant {$proc $id "$var(legend,font,slant)\n"} + style { + # backward compatibility + $proc $id "$var(legend,font,weight)\n" + } } } } diff --git a/ds9/library/print.tcl b/ds9/library/print.tcl index c0dcebb..5496cee 100644 --- a/ds9/library/print.tcl +++ b/ds9/library/print.tcl @@ -556,6 +556,7 @@ proc PrefsDialogPrint {} { proc ProcessPrintCmd {varname iname} { upvar $varname var upvar $iname i + global ds9 switch $ds9(wm) { @@ -579,6 +580,14 @@ 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]] { @@ -595,6 +604,16 @@ proc ProcessPSPrintCmd {varname iname} { default {incr i -1; PostScript} } } +} + +proc PSCmdSet {which value {cmd {}}} { + global ps + + set ps($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendPSPrintCmd {proc id param} { global ps diff --git a/ds9/library/rgb.tcl b/ds9/library/rgb.tcl index fa26dc0..bb4cb40 100644 --- a/ds9/library/rgb.tcl +++ b/ds9/library/rgb.tcl @@ -262,11 +262,19 @@ proc ProcessRGBCmd {varname iname} { upvar $varname var upvar $iname i + 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 - RGBDialog - switch -- [string tolower [lindex $var $i]] { open {} close {RGBDestroyDialog} @@ -329,6 +337,16 @@ proc ProcessRGBCmd {varname iname} { } } } +} + +proc RGBCmdSet {which value {cmd {}}} { + global rgb + + set rgb($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendRGBCmd {proc id param} { global current diff --git a/ds9/library/rgbarray.tcl b/ds9/library/rgbarray.tcl index 44054bb..aff77a0 100644 --- a/ds9/library/rgbarray.tcl +++ b/ds9/library/rgbarray.tcl @@ -127,8 +127,17 @@ proc ProcessRGBArrayCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 { @@ -162,6 +171,27 @@ proc ProcessRGBArrayCmd {varname iname sock fn} { } FinishLoad } +} + +proc RGBArrayCmdLoad {param} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![ImportRGBArraySocket $parse(sock) $param]} { + InitError xpa + ImportRGBArrayFile $param + } + } else { + # comm + if {$parse(fn) != {}} { + ImportRGBArrayAlloc $parse(fn) $param + } else { + ImportRGBArrayFile $param + } + } + FinishLoad +} proc ProcessSendRGBArrayCmd {proc id param sock fn} { global current diff --git a/ds9/library/rgbcube.tcl b/ds9/library/rgbcube.tcl index dfd2e2f..94252ca 100644 --- a/ds9/library/rgbcube.tcl +++ b/ds9/library/rgbcube.tcl @@ -111,6 +111,18 @@ 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 @@ -143,6 +155,27 @@ proc ProcessRGBCubeCmd {varname iname sock fn} { } FinishLoad } +} + +proc RGBCubeCmdLoad {param} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadRGBCubeSocket $parse(sock) $param]} { + InitError xpa + LoadRGBCubeFile $param + } + } else { + # comm + if {$parse(fn) != {}} { + LoadRGBCubeAlloc $parse(fn) $param + } else { + LoadRGBCubeFile $param + } + } + FinishLoad +} proc ProcessSendRGBCubeCmd {proc id param sock fn} { global current diff --git a/ds9/library/rgbimage.tcl b/ds9/library/rgbimage.tcl index 4f40c32..58b1144 100644 --- a/ds9/library/rgbimage.tcl +++ b/ds9/library/rgbimage.tcl @@ -129,6 +129,18 @@ 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 @@ -161,6 +173,27 @@ proc ProcessRGBImageCmd {varname iname sock fn} { } FinishLoad } +} + +proc RGBImageCmdLoad {param} { + global parse + + if {$parse(sock) != {}} { + # xpa + if {![LoadRGBImageSocket $parse(sock) $param]} { + InitError xpa + LoadRGBImageFile $param + } + } else { + # comm + if {$parse(fn) != {}} { + LoadRGBImageAlloc $parse(fn) $param + } else { + LoadRGBImageFile $param + } + } + FinishLoad +} proc ProcessSendRGBImageCmd {proc id param sock fn} { global current diff --git a/ds9/library/samp.tcl b/ds9/library/samp.tcl index 63f7085..9af0e1d 100644 --- a/ds9/library/samp.tcl +++ b/ds9/library/samp.tcl @@ -36,7 +36,9 @@ proc SAMPConnect {{verbose 1}} { } # reset samp array - catch {unset samp} + if {[info exists samp]} { + unset samp + } set samp(apps,image) {} set samp(apps,table) {} set samp(apps,votable) {} @@ -54,7 +56,9 @@ proc SAMPConnect {{verbose 1}} { if {$verbose} { Error "SAMP: [msgcat::mc {unable to locate HUB}]" } - catch {unset samp} + if {[info exists samp]} { + unset samp + } return } @@ -65,7 +69,9 @@ proc SAMPConnect {{verbose 1}} { if {$verbose} { Error "SAMP: [msgcat::mc {internal error}] $rr" } - catch {unset samp} + if {[info exists samp]} { + unset samp + } return } set rr [lindex $rr 1] @@ -100,7 +106,9 @@ proc SAMPConnect {{verbose 1}} { if {$verbose} { Error "SAMP: [msgcat::mc {internal error}] $rr" } - catch {unset samp} + if {[info exists samp]} { + unset samp + } return } @@ -117,7 +125,9 @@ proc SAMPConnect {{verbose 1}} { if {$verbose} { Error "SAMP: [msgcat::mc {internal error}] $rr" } - catch {unset samp} + if {[info exists samp]} { + unset samp + } return } @@ -162,7 +172,9 @@ proc SAMPConnect {{verbose 1}} { if {$verbose} { Error "SAMP: [msgcat::mc {internal error}] $rr" } - catch {unset samp} + if {[info exists samp]} { + unset samp + } return } @@ -645,7 +657,9 @@ proc SAMPShutdown {} { UpdateCATDialog # unset samp array - catch {unset samp} + if {[info exists samp]} { + unset samp + } } proc SAMPUpdate {} { @@ -1691,15 +1705,22 @@ proc ProcessSAMPCmd {varname iname} { upvar $varname var upvar $iname i - global samp - global ds9 - global env - # 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 @@ -1775,3 +1796,38 @@ proc ProcessSAMPCmd {varname iname} { } } } +} + +proc SAMPCmdSendImage {name} { + global samp + + 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}]" + } +} + +proc SAMPCmdSendTable {name} { + global samp + + 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}]" + } +} diff --git a/ds9/library/sao.tcl b/ds9/library/sao.tcl index d813598..ebb79fe 100644 --- a/ds9/library/sao.tcl +++ b/ds9/library/sao.tcl @@ -148,7 +148,16 @@ proc ProcessSAOCmd {varname iname} { upvar $iname i SAODialog - IMGSVRProcessCmd $varname $iname dsao + + global debug + if {$debug(tcl,parser)} { + dsssao::YY_FLUSH_BUFFER + dsssao::yy_scan_string [lrange $var $i end] + dsssao::yyparse + incr i [expr $dsssao::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dsao + } } proc ProcessSendSAOCmd {proc id param} { diff --git a/ds9/library/save.tcl b/ds9/library/save.tcl index 45999cf..a3fdad7 100644 --- a/ds9/library/save.tcl +++ b/ds9/library/save.tcl @@ -43,6 +43,14 @@ 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 == {}} { @@ -121,6 +129,21 @@ proc ProcessSaveCmd {varname iname} { FileLast savefitsfbox $fn Save $format $fn } +} + +proc SaveCmdLoad {format fn} { + FileLast savefitsfbox $fn + Save $format $fn +} + +proc SavefitsCmdSet {which value {cmd {}}} { + global savefits + + set savefits($which) $value + if {$cmd != {}} { + eval $cmd + } +} # Support diff --git a/ds9/library/saveimage.tcl b/ds9/library/saveimage.tcl index 324f232..45ac769 100644 --- a/ds9/library/saveimage.tcl +++ b/ds9/library/saveimage.tcl @@ -45,6 +45,7 @@ proc SaveImageDialog {format} { global tifffbox global pngfbox + puts "a:[array get tifffbox]" switch -- $format { fits {set fn [SaveFileDialog fitsfbox]} eps {set fn [SaveFileDialog epsfbox]} @@ -153,6 +154,14 @@ 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] @@ -252,12 +261,6 @@ proc ProcessSaveImageCmd {varname iname} { } } - global fitsfbox - global epsfbox - global giffbox - global jpegfbox - global tifffbox - global pngfbox switch -- $format { fits {FileLast fitsfbox $fn} eps {FileLast epsfbox $fn} @@ -268,4 +271,32 @@ proc ProcessSaveImageCmd {varname iname} { } SaveImage $fn $format } +} + +proc SaveimageCmdSet {which value {cmd {}}} { + global saveimage + + set saveimage($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc SaveimageCmdLoad {format fn} { + 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 +} + +proc SaveimageCmdMPEG {fn na} { + global movie + set movie(action) slice + Movie $fn +} diff --git a/ds9/library/scale.tcl b/ds9/library/scale.tcl index a890329..8fd0575 100644 --- a/ds9/library/scale.tcl +++ b/ds9/library/scale.tcl @@ -393,10 +393,9 @@ proc ScaleDestroyDialog {} { if {[winfo exists $iscale(top)]} { destroy $iscale(top) destroy $iscale(mb) + blt::vector destroy $dscale(xdata) $dscale(ydata) + unset dscale } - - blt::vector destroy $dscale(xdata) $dscale(ydata) - unset dscale } proc ScaleMotionDialog {x y varname} { @@ -828,8 +827,15 @@ proc ProcessScaleCmd {varname iname} { upvar $varname var upvar $iname i - global scale + 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 @@ -933,6 +939,16 @@ proc ProcessScaleCmd {varname iname} { } } } +} + +proc ScaleCmdSet {which value {cmd {}}} { + global scale + + set scale($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendScaleCmd {proc id param} { global current @@ -960,9 +976,16 @@ 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 @@ -994,6 +1017,16 @@ proc ProcessMinMaxCmd {varname iname} { } } } +} + +proc MinmaxCmdSet {which value {cmd {}}} { + global minmax + + set minmax($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendMinMaxCmd {proc id param} { global minmax @@ -1012,6 +1045,14 @@ 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 @@ -1039,6 +1080,16 @@ proc ProcessZScaleCmd {varname iname} { } } } +} + +proc ZscaleCmdSet {which value {cmd {}}} { + global zscale + + set zscale($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendZScaleCmd {proc id param} { global zscale diff --git a/ds9/library/sfits.tcl b/ds9/library/sfits.tcl index e976e20..d2cfdca 100644 --- a/ds9/library/sfits.tcl +++ b/ds9/library/sfits.tcl @@ -21,12 +21,16 @@ proc ProcessSFitsCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -61,3 +65,4 @@ proc ProcessSFitsCmd {varname iname sock fn} { } FinishLoad } +} diff --git a/ds9/library/shm.tcl b/ds9/library/shm.tcl index bd95bc8..7bf5249 100644 --- a/ds9/library/shm.tcl +++ b/ds9/library/shm.tcl @@ -7,10 +7,18 @@ package provide DS9 1.0 proc ProcessShmCmd {varname iname ml} { upvar $varname var upvar $iname i - global loadParam - global current - global ds9 + + global debug + if {$debug(tcl,parser)} { + 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} { @@ -161,7 +169,7 @@ proc ProcessShmCmd {varname iname ml} { rgbcube { if {$ml} { - CreateRGBFrame + MultiLoadRGB } set loadParam(file,mode) {rgb cube} set loadParam(shared,idtype) [lindex $var [expr $i+1]] @@ -171,7 +179,7 @@ proc ProcessShmCmd {varname iname ml} { } srgbcube { if {$ml} { - CreateRGBFrame + MultiLoadRGB } set loadParam(load,type) sshared set loadParam(file,mode) {rgb cube} @@ -183,7 +191,7 @@ proc ProcessShmCmd {varname iname ml} { } rgbimage { if {$ml} { - CreateRGBFrame + MultiLoadRGB } set loadParam(file,mode) {rgb image} set loadParam(shared,idtype) [lindex $var [expr $i+1]] @@ -193,7 +201,7 @@ proc ProcessShmCmd {varname iname ml} { } rgbarray { if {$ml} { - CreateRGBFrame + MultiLoadRGB } set loadParam(file,type) array set loadParam(file,mode) {rgb cube} @@ -239,6 +247,24 @@ proc ProcessShmCmd {varname iname ml} { } FinishLoad } +} + +proc ShmCmdSet {loadtype filetype filemode sharedidtype sharedid filename {sharedhdr {}}} { + + global loadparam + set loadparam(load,type) $loadtype + set loadparam(file,type) $filetype + set loadparam(file,mode) $filemode + set loadparam(shared,idtype) $sharedidtype + set loadparam(shared,id) $sharedid + set loadparam(file,name) $filename + set loadparam(shared,hdr) $sharedhdr + + # mask not supported + set loadParam(load,layer) {} + + ProcessLoad +} proc ProcessSendShmCmd {proc id param} { global current diff --git a/ds9/library/sia.tcl b/ds9/library/sia.tcl index 43637a8..33f8570 100644 --- a/ds9/library/sia.tcl +++ b/ds9/library/sia.tcl @@ -292,7 +292,7 @@ proc SIATable {varname} { puts stderr "SIATable $varname" } - if {![CATValidDB $var(tbldb)]} { + if {![SIAValidDB $var(tbldb)]} { return } @@ -325,6 +325,38 @@ proc SIATable {varname} { } } +proc SIAValidDB {varname} { + upvar #0 $varname var + global $varname + + if {[info exists var(Nrows)] && + [info exists var(Ncols)] && + [info exists var(HLines)] && + [info exists var(Header)]} { + return 1 + } else { + return 0 + } +} + +proc SIASaveFn {varname fn writer} { + upvar #0 $varname var + global $varname + global $var(tbldb) + + if {$fn == {}} { + return + } + + # do we have a db? + if {![SIAValidDB $var(tbldb)]} { + return + } + + $writer $var(tbldb) $fn + ARDone $varname +} + # Process Cmds proc ProcessSIACmd {varname iname} { @@ -332,10 +364,21 @@ proc ProcessSIACmd {varname iname} { upvar $iname i global isia - # 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 - @@ -402,6 +445,7 @@ proc ProcessSIACmd {varname iname} { } } } +} proc ProcessSIA {varname iname cvarname} { upvar 2 $varname var @@ -453,8 +497,8 @@ proc ProcessSIA {varname iname cvarname} { } set fn [lindex $var $i] - CATSaveFn $cvarname $fn $writer - FileLast catfbox $fn + SIASaveFn $cvarname $fn $writer + FileLast siafbox $fn } name { incr i @@ -492,6 +536,95 @@ proc ProcessSIA {varname iname cvarname} { } } +proc SIACmdCheck {} { + global cvarname + upvar #0 $cvarname cvar + + if {![info exists cvar(top)]} { + Error "[msgcat::mc {Unable to find SIAP window}] $cvarname" + cat::YYABORT + return + } + if {![winfo exists $cvar(top)]} { + Error "[msgcat:: mc {Unable to find SIAP window}] $cvarname" + cat::YYABORT + return + } +} + +proc SIACmdRef {ref} { + global isia + global cvarname + + # look for reference in current list + if {[lsearch $isia(sias) sia${ref}] < 0} { + # 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${ref}" == $vars} { + SIADialog $vars $title $url $opts $method sync + set cvarname sia${ref} + } + } + } +} + +proc SIACmdSet {which value} { + global cvarname + upvar #0 $cvarname cvar + + set cvar($which) $value +} + +proc SIACmdCoord {xx yy sky} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(x) $xx + set cvar(y) $yy + set cvar(sky) $sky +} + +proc SIACmdSave {fn writer} { + global cvarname + + if {$fn != {}} { + SIASaveFn $cvarname $fn $writer + FileLast siafbox $fn + } +} + +proc SIACmdSize {width height rformat} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(width) $width + set cvar(height) $height + set cvar(rformat) $rformat + set cvar(rformat,msg) $rformat +} + +proc SIACmdSkyframe {skyframe} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(sky) $skyframe + CoordMenuButtonCmd $cvarname system sky [list SIAWCSMenuUpdate $cvarname] +} + +proc SIACmdSystem {sys} { + global cvarname + upvar #0 $cvarname cvar + + set cvar(system) $sys + CoordMenuButtonCmd $cvarname system sky [list SIAWCSMenuUpdate $cvarname] +} + proc ProcessSendSIACmd {proc id param sock fn} { global isia diff --git a/ds9/library/skyview.tcl b/ds9/library/skyview.tcl index da48406..ecfe17c 100644 --- a/ds9/library/skyview.tcl +++ b/ds9/library/skyview.tcl @@ -604,13 +604,21 @@ Maintained by: Laura McDonald lmm@skyview.gsfc.nasa.gov # Process Cmds - proc ProcessSkyViewCmd {varname iname} { upvar $varname var upvar $iname i SkyViewDialog - IMGSVRProcessCmd $varname $iname dskyview + + global debug + if {$debug(tcl,parser)} { + skyview::YY_FLUSH_BUFFER + skyview::yy_scan_string [lrange $var $i end] + skyview::yyparse + incr i [expr $skyview::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dskyview + } } proc ProcessSendSkyViewCmd {proc id param} { diff --git a/ds9/library/smooth.tcl b/ds9/library/smooth.tcl index d1d3b74..a5fd735 100644 --- a/ds9/library/smooth.tcl +++ b/ds9/library/smooth.tcl @@ -345,6 +345,14 @@ 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]] { @@ -410,6 +418,16 @@ proc ProcessSmoothCmd {varname iname} { } } } +} + +proc SmoothCmdSet {which value {cmd {}}} { + global smooth + + set smooth($which) $value + if {$cmd != {}} { + eval $cmd + } +} proc ProcessSendSmoothCmd {proc id param} { global smooth diff --git a/ds9/library/smosaiciraf.tcl b/ds9/library/smosaiciraf.tcl index 18d92c5..bf5cde2 100644 --- a/ds9/library/smosaiciraf.tcl +++ b/ds9/library/smosaiciraf.tcl @@ -21,11 +21,15 @@ proc ProcessSMosaicIRAFCmd {varname iname sock fn layer} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -41,20 +45,13 @@ proc ProcessSMosaicIRAFCmd {varname iname sock fn layer} { } } - set opt [lindex $var $i] - if {$opt != {}} { - incr i - } else { - set opt wcs - } - if {$sock != {}} { # xpa if {0} { # not supported } else { LoadSMosaicIRAFFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $opt + $layer } } else { # comm @@ -62,8 +59,9 @@ proc ProcessSMosaicIRAFCmd {varname iname sock fn layer} { # not supported } else { LoadSMosaicIRAFFile [lindex $var $i] [lindex $var [expr $i+1]] \ - $layer $opt + $layer } } FinishLoad } +} diff --git a/ds9/library/smosaicwcs.tcl b/ds9/library/smosaicwcs.tcl index 6bee0e2..6e7a492 100644 --- a/ds9/library/smosaicwcs.tcl +++ b/ds9/library/smosaicwcs.tcl @@ -21,11 +21,15 @@ proc ProcessSMosaicWCSCmd {varname iname sock fn} { upvar $varname var upvar $iname i - global loadParam - global current + 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 @@ -67,3 +71,4 @@ proc ProcessSMosaicWCSCmd {varname iname sock fn} { } FinishLoad } +} diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl index 48bd469..9b358c5 100644 --- a/ds9/library/source.tcl +++ b/ds9/library/source.tcl @@ -188,6 +188,195 @@ source $ds9(root)/library/xmfbox.tcl source $ds9(root)/library/xmlrpc.tcl source $ds9(root)/library/xpa.tcl +source $ds9(root)/library/alignparser.tcl +source $ds9(root)/library/alignlex.tcl +source $ds9(root)/library/analysisparser.tcl +source $ds9(root)/library/analysislex.tcl +source $ds9(root)/library/arrayparser.tcl +source $ds9(root)/library/arraylex.tcl +source $ds9(root)/library/backupparser.tcl +source $ds9(root)/library/backuplex.tcl +source $ds9(root)/library/binparser.tcl +source $ds9(root)/library/binlex.tcl +source $ds9(root)/library/bgparser.tcl +source $ds9(root)/library/bglex.tcl +source $ds9(root)/library/blinkparser.tcl +source $ds9(root)/library/blinklex.tcl +source $ds9(root)/library/blockparser.tcl +source $ds9(root)/library/blocklex.tcl +source $ds9(root)/library/catparser.tcl +source $ds9(root)/library/catlex.tcl +source $ds9(root)/library/cmapparser.tcl +source $ds9(root)/library/cmaplex.tcl +source $ds9(root)/library/colorbarparser.tcl +source $ds9(root)/library/colorbarlex.tcl +source $ds9(root)/library/contourparser.tcl +source $ds9(root)/library/contourlex.tcl +source $ds9(root)/library/cropparser.tcl +source $ds9(root)/library/croplex.tcl +source $ds9(root)/library/crosshairparser.tcl +source $ds9(root)/library/crosshairlex.tcl +source $ds9(root)/library/cubeparser.tcl +source $ds9(root)/library/cubelex.tcl +source $ds9(root)/library/cursorparser.tcl +source $ds9(root)/library/cursorlex.tcl +source $ds9(root)/library/dssesoparser.tcl +source $ds9(root)/library/dssesolex.tcl +source $ds9(root)/library/dsssaoparser.tcl +source $ds9(root)/library/dsssaolex.tcl +source $ds9(root)/library/dssstsciparser.tcl +source $ds9(root)/library/dssstscilex.tcl +source $ds9(root)/library/enviparser.tcl +source $ds9(root)/library/envilex.tcl +source $ds9(root)/library/exportparser.tcl +source $ds9(root)/library/exportlex.tcl +source $ds9(root)/library/fitsparser.tcl +source $ds9(root)/library/fitslex.tcl +source $ds9(root)/library/frameparser.tcl +source $ds9(root)/library/framelex.tcl +source $ds9(root)/library/gridparser.tcl +source $ds9(root)/library/gridlex.tcl +source $ds9(root)/library/headerparser.tcl +source $ds9(root)/library/headerlex.tcl +source $ds9(root)/library/heightparser.tcl +source $ds9(root)/library/heightlex.tcl +source $ds9(root)/library/iconifyparser.tcl +source $ds9(root)/library/iconifylex.tcl +source $ds9(root)/library/iisparser.tcl +source $ds9(root)/library/iislex.tcl +source $ds9(root)/library/lockparser.tcl +source $ds9(root)/library/locklex.tcl +source $ds9(root)/library/magnifierparser.tcl +source $ds9(root)/library/magnifierlex.tcl +source $ds9(root)/library/maskparser.tcl +source $ds9(root)/library/masklex.tcl +source $ds9(root)/library/matchparser.tcl +source $ds9(root)/library/matchlex.tcl +source $ds9(root)/library/mecubeparser.tcl +source $ds9(root)/library/mecubelex.tcl +source $ds9(root)/library/minmaxparser.tcl +source $ds9(root)/library/minmaxlex.tcl +source $ds9(root)/library/modeparser.tcl +source $ds9(root)/library/modelex.tcl +source $ds9(root)/library/mosaicwcsparser.tcl +source $ds9(root)/library/mosaicwcslex.tcl +source $ds9(root)/library/mosaicirafparser.tcl +source $ds9(root)/library/mosaiciraflex.tcl +source $ds9(root)/library/mosaicimageirafparser.tcl +source $ds9(root)/library/mosaicimageiraflex.tcl +source $ds9(root)/library/mosaicimagewcsparser.tcl +source $ds9(root)/library/mosaicimagewcslex.tcl +source $ds9(root)/library/mosaicimagewfpc2parser.tcl +source $ds9(root)/library/mosaicimagewfpc2lex.tcl +source $ds9(root)/library/movieparser.tcl +source $ds9(root)/library/movielex.tcl +source $ds9(root)/library/multiframeparser.tcl +source $ds9(root)/library/multiframelex.tcl +source $ds9(root)/library/nanparser.tcl +source $ds9(root)/library/nanlex.tcl +source $ds9(root)/library/nresparser.tcl +source $ds9(root)/library/nreslex.tcl +source $ds9(root)/library/nrrdparser.tcl +source $ds9(root)/library/nrrdlex.tcl +source $ds9(root)/library/nvssparser.tcl +source $ds9(root)/library/nvsslex.tcl +source $ds9(root)/library/orientparser.tcl +source $ds9(root)/library/orientlex.tcl +source $ds9(root)/library/rotateparser.tcl +source $ds9(root)/library/rotatelex.tcl +source $ds9(root)/library/pagesetupparser.tcl +source $ds9(root)/library/pagesetuplex.tcl +source $ds9(root)/library/panparser.tcl +source $ds9(root)/library/panlex.tcl +source $ds9(root)/library/photoparser.tcl +source $ds9(root)/library/photolex.tcl +source $ds9(root)/library/pixeltableparser.tcl +source $ds9(root)/library/pixeltablelex.tcl +source $ds9(root)/library/plotparser.tcl +source $ds9(root)/library/plotlex.tcl +source $ds9(root)/library/precisionparser.tcl +source $ds9(root)/library/precisionlex.tcl +source $ds9(root)/library/prefsparser.tcl +source $ds9(root)/library/prefslex.tcl +source $ds9(root)/library/preserveparser.tcl +source $ds9(root)/library/preservelex.tcl +source $ds9(root)/library/psparser.tcl +source $ds9(root)/library/pslex.tcl +source $ds9(root)/library/regionparser.tcl +source $ds9(root)/library/regionlex.tcl +source $ds9(root)/library/restoreparser.tcl +source $ds9(root)/library/restorelex.tcl +source $ds9(root)/library/rgbparser.tcl +source $ds9(root)/library/rgblex.tcl +source $ds9(root)/library/rgbarrayparser.tcl +source $ds9(root)/library/rgbarraylex.tcl +source $ds9(root)/library/rgbcubeparser.tcl +source $ds9(root)/library/rgbcubelex.tcl +source $ds9(root)/library/rgbimageparser.tcl +source $ds9(root)/library/rgbimagelex.tcl +source $ds9(root)/library/sampparser.tcl +source $ds9(root)/library/samplex.tcl +source $ds9(root)/library/saveparser.tcl +source $ds9(root)/library/savelex.tcl +source $ds9(root)/library/saveimageparser.tcl +source $ds9(root)/library/saveimagelex.tcl +source $ds9(root)/library/scaleparser.tcl +source $ds9(root)/library/scalelex.tcl +source $ds9(root)/library/sfitsparser.tcl +source $ds9(root)/library/sfitslex.tcl +source $ds9(root)/library/shmparser.tcl +source $ds9(root)/library/shmlex.tcl +source $ds9(root)/library/siaparser.tcl +source $ds9(root)/library/sialex.tcl +source $ds9(root)/library/skyviewparser.tcl +source $ds9(root)/library/skyviewlex.tcl +source $ds9(root)/library/sleepparser.tcl +source $ds9(root)/library/sleeplex.tcl +source $ds9(root)/library/smoothparser.tcl +source $ds9(root)/library/smoothlex.tcl +source $ds9(root)/library/smosaicirafparser.tcl +source $ds9(root)/library/smosaiciraflex.tcl +source $ds9(root)/library/smosaicwcsparser.tcl +source $ds9(root)/library/smosaicwcslex.tcl +source $ds9(root)/library/sourceparser.tcl +source $ds9(root)/library/sourcelex.tcl +source $ds9(root)/library/srgbcubeparser.tcl +source $ds9(root)/library/srgbcubelex.tcl +source $ds9(root)/library/threadsparser.tcl +source $ds9(root)/library/threadslex.tcl +source $ds9(root)/library/threedparser.tcl +source $ds9(root)/library/threedlex.tcl +source $ds9(root)/library/tileparser.tcl +source $ds9(root)/library/tilelex.tcl +source $ds9(root)/library/twomassparser.tcl +source $ds9(root)/library/twomasslex.tcl +source $ds9(root)/library/updateparser.tcl +source $ds9(root)/library/updatelex.tcl +source $ds9(root)/library/urlfitsparser.tcl +source $ds9(root)/library/urlfitslex.tcl +source $ds9(root)/library/viewparser.tcl +source $ds9(root)/library/viewlex.tcl +source $ds9(root)/library/vlaparser.tcl +source $ds9(root)/library/vlalex.tcl +source $ds9(root)/library/vlssparser.tcl +source $ds9(root)/library/vlsslex.tcl +source $ds9(root)/library/voparser.tcl +source $ds9(root)/library/volex.tcl +source $ds9(root)/library/wcsparser.tcl +source $ds9(root)/library/wcslex.tcl +source $ds9(root)/library/webparser.tcl +source $ds9(root)/library/weblex.tcl +source $ds9(root)/library/widthparser.tcl +source $ds9(root)/library/widthlex.tcl +source $ds9(root)/library/xpaparser.tcl +source $ds9(root)/library/xpalex.tcl +source $ds9(root)/library/xpafirstparser.tcl +source $ds9(root)/library/xpafirstlex.tcl +source $ds9(root)/library/zscaleparser.tcl +source $ds9(root)/library/zscalelex.tcl +source $ds9(root)/library/zoomparser.tcl +source $ds9(root)/library/zoomlex.tcl + switch [tk windowingsystem] { x11 {} aqua {source $ds9(root)/library/macosx.tcl} diff --git a/ds9/library/srgbcube.tcl b/ds9/library/srgbcube.tcl index 28902fb..ac8f448 100644 --- a/ds9/library/srgbcube.tcl +++ b/ds9/library/srgbcube.tcl @@ -33,6 +33,14 @@ 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 @@ -65,3 +73,4 @@ proc ProcessSRGBCubeCmd {varname iname sock fn} { } FinishLoad } +} diff --git a/ds9/library/stdfbox.tcl b/ds9/library/stdfbox.tcl index 4caa67c..a7998d8 100644 --- a/ds9/library/stdfbox.tcl +++ b/ds9/library/stdfbox.tcl @@ -268,6 +268,13 @@ proc InitDialogBox {} { [list {CDS} {*.cds}] \ ] + global siafbox + set siafbox(file) {ds9.sia} + set siafbox(dir) {} + set siafbox(types) [list \ + [list [::msgcat::mc {Simple Image Access}] {*.sia}] \ + ] + global analysisfbox set analysisfbox(file) {ds9.ans} set analysisfbox(dir) {} diff --git a/ds9/library/stsci.tcl b/ds9/library/stsci.tcl index 96d5ed6..c42e362 100644 --- a/ds9/library/stsci.tcl +++ b/ds9/library/stsci.tcl @@ -30,7 +30,7 @@ proc STSCIDialog {} { return } - set varname dstscii + set varname dstsci upvar #0 $varname var global $varname @@ -173,10 +173,19 @@ proc ProcessSTSCICmd {varname iname} { upvar $iname i STSCIDialog - IMGSVRProcessCmd $varname $iname dstscii + + global debug + if {$debug(tcl,parser)} { + dssstsci::YY_FLUSH_BUFFER + dssstsci::yy_scan_string [lrange $var $i end] + dssstsci::yyparse + incr i [expr $dssstsci::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dstsci + } } proc ProcessSendSTSCICmd {proc id param} { STSCIDialog - IMGSVRProcessSendCmd $proc $id $param dstscii + IMGSVRProcessSendCmd $proc $id $param dstsci } diff --git a/ds9/library/url.tcl b/ds9/library/url.tcl index 2643e32..8a65ab7 100644 --- a/ds9/library/url.tcl +++ b/ds9/library/url.tcl @@ -313,9 +313,16 @@ 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 @@ -333,4 +340,5 @@ proc ProcessURLFitsCmd {varname iname} { LoadURLFits [lindex $var $i] $layer $mode } +} diff --git a/ds9/library/util.tcl b/ds9/library/util.tcl index cac8702..fb24c38 100644 --- a/ds9/library/util.tcl +++ b/ds9/library/util.tcl @@ -1175,10 +1175,36 @@ proc DS9Backup {ch which} { # Process Cmds +proc ds9CmdSet {which value {cmd {}}} { + global ds9 + + set ds9($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc pds9CmdSet {which value {cmd {}}} { + global pds9 + + set pds9($which) $value + if {$cmd != {}} { + eval $cmd + } +} + 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 @@ -1224,6 +1250,7 @@ proc ProcessPrefsCmd {varname iname} { } } } +} proc ProcessSendPrefsCmd {proc id param} { global pds9 @@ -1243,6 +1270,14 @@ 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 @@ -1257,6 +1292,7 @@ proc ProcessPrecisionCmd {varname iname} { set pds9(prec,arcsec) [lindex $var $i] PrefsPrecision } +} proc ProcessSendPrecisionCmd {proc id param} { global pds9 @@ -1268,10 +1304,19 @@ 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 } +} proc ProcessSendBgCmd {proc id param} { global pds9 @@ -1283,10 +1328,19 @@ 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 } +} proc ProcessSendNanCmd {proc id param} { global pds9 @@ -1298,10 +1352,19 @@ 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 } +} proc ProcessSendThreadsCmd {proc id param} { global ds9 @@ -1309,15 +1372,6 @@ proc ProcessSendThreadsCmd {proc id param} { $proc $id "$ds9(threads)\n" } -proc ProcessIRAFAlignCmd {varname iname} { - upvar $varname var - upvar $iname i - - global pds9 - set pds9(iraf) [FromYesNo [lindex $var $i]] - PrefsIRAFAlign -} - proc ProcessSendIRAFAlignCmd {proc id param} { global pds9 @@ -1350,6 +1404,14 @@ 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) != {}} { @@ -1364,7 +1426,7 @@ proc ProcessCursorCmd {varname iname} { catalog {MarkerArrowKey $current(frame) $x $y} crosshair {CrosshairArrowKey $current(frame) $x $y} colorbar {} - pan {Pan $x $y canvas} + pan {PanCanvas $x $y} zoom - rotate - crop {} @@ -1374,26 +1436,29 @@ proc ProcessCursorCmd {varname iname} { } } } +} proc CursorCmd {x y} { global current - if {$current(frame) != {}} { - 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 {Pan $x $y canvas} - zoom - - rotate - - crop {} - analysis {IMEArrowKey $current(frame) $x $y} - examine - - iexam {} - } + if {$current(frame) == {}} { + return + } + + 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 {} } } @@ -1458,8 +1523,15 @@ proc ProcessIconifyCmd {varname iname} { upvar $varname var upvar $iname i - global ds9 + 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 - @@ -1477,6 +1549,17 @@ proc ProcessIconifyCmd {varname iname} { } } } +} + +proc IconifyCmd {which} { + global ds9 + + if {$which} { + wm iconify $ds9(top) + } else { + wm deiconify $ds9(top) + } +} proc ProcessSendIconifyCmd {proc id param} { global ds9 @@ -1499,8 +1582,15 @@ proc ProcessModeCmd {varname iname} { upvar $varname var upvar $iname i - global current + 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) { @@ -1508,6 +1598,7 @@ proc ProcessModeCmd {varname iname} { } ChangeMode } +} proc ProcessQuitCmd {varname iname} { upvar $varname var @@ -1538,6 +1629,14 @@ 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] @@ -1546,17 +1645,29 @@ proc ProcessSleepCmd {varname iname} { } after [expr int($sec*1000)] } +} proc ProcessSourceCmd {varname iname} { upvar $varname var upvar $iname i - SourceCmd [lindex $var $i] -} -proc SourceCmd {fn} { # we need to be realized # 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]" +} +} + +proc SourceCmd {fn} { uplevel #0 "source $fn" } diff --git a/ds9/library/vla.tcl b/ds9/library/vla.tcl index 034dfef..d568a20 100644 --- a/ds9/library/vla.tcl +++ b/ds9/library/vla.tcl @@ -164,7 +164,16 @@ proc ProcessVLACmd {varname iname} { upvar $iname i VLADialog - IMGSVRProcessCmd $varname $iname dvla + + global debug + if {$debug(tcl,parser)} { + vla::YY_FLUSH_BUFFER + vla::yy_scan_string [lrange $var $i end] + vla::yyparse + incr i [expr $vla::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dvla + } } proc ProcessSendVLACmd {proc id param} { diff --git a/ds9/library/vlss.tcl b/ds9/library/vlss.tcl index ac1093c..e0e45d6 100644 --- a/ds9/library/vlss.tcl +++ b/ds9/library/vlss.tcl @@ -123,7 +123,16 @@ proc ProcessVLSSCmd {varname iname} { upvar $iname i VLSSDialog - IMGSVRProcessCmd $varname $iname dvlss + + global debug + if {$debug(tcl,parser)} { + vlss::YY_FLUSH_BUFFER + vlss::yy_scan_string [lrange $var $i end] + vlss::yyparse + incr i [expr $vlss::yycnt-1] + } else { + IMGSVRProcessCmd $varname $iname dvlss + } } proc ProcessSendVLSSCmd {proc id param} { diff --git a/ds9/library/vo.tcl b/ds9/library/vo.tcl index d865c17..c96c597 100644 --- a/ds9/library/vo.tcl +++ b/ds9/library/vo.tcl @@ -466,6 +466,14 @@ 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 @@ -528,6 +536,41 @@ proc ProcessVOCmd {varname iname} { } } } +} + +proc VOCmdSet {which value} { + global pvo + + set pvo($which) $value +} + +proc VOCmdConnect {str} { + global voi + global ivo + + VODialog + + # find best match + set ii [lsearch $ivo(server,url) "*$str*"] + if {$ii>=0} { + set ivo(b$ii) 1 + VOCheck voi $ii + } +} + +proc VOCmdDisconnect {str} { + global voi + global ivo + + VODialog + + # find best match + set ii [lsearch $ivo(server,url) "*$str*"] + if {$ii>=0} { + set ivo(b$ii) 0 + VOCheck voi $ii + } +} proc ProcessSendVOCmd {proc id param} { global ivo diff --git a/ds9/library/wcs.tcl b/ds9/library/wcs.tcl index 2a98b6a..bc4c4cb 100644 --- a/ds9/library/wcs.tcl +++ b/ds9/library/wcs.tcl @@ -16,7 +16,15 @@ proc WCSDef {} { set wcs(sky) fk5 set wcs(skyformat) sexagesimal + # temp + set wcs(load,sock) {} + set wcs(load,fn) {} + array set pwcs [array get wcs] + + # temp + set wcs(load,sock) {} + set wcs(load,fn) {} } proc UpdateWCS {} { @@ -440,9 +448,8 @@ proc WCSDestroyDialog {} { if {[winfo exists $iwcs(top)]} { destroy $iwcs(top) destroy $iwcs(mb) + unset dwcs } - - unset dwcs } proc WCSSaveDialog {} { @@ -1127,6 +1134,18 @@ 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 @@ -1248,16 +1267,59 @@ proc ProcessWCSCmd {varname iname sock fn} { } } } +} -proc WCSResetCmd {ext} { - global current +proc WCSCmdSet {which value {cmd {}}} { + global wcs + + set wcs($which) $value + if {$cmd != {}} { + eval $cmd + } +} + +proc WCSCmdReset {ext} { global rgb + global current + + if {$current(frame) == {}} { + return + } RGBEvalLock rgb(lock,wcs) $current(frame) \ [list $current(frame) wcs reset $ext] UpdateWCS } +proc WCSCmdLoad {cmd ext} { + global current + global rgb + global parse + + if {$current(frame) == {}} { + return + } + + if {$parse(sock) != {}} { + RGBEvalLock rgb(lock,wcs) $current(frame) [list $current(frame) wcs $cmd $ext $parse(sock)] + } elseif {$parse(fn) != {}} { + RGBEvalLock rgb(lock,wcs) $current(frame) "$current(frame) wcs $cmd $ext \{\{$parse(fn)\}\}" + UpdateWCS + } +} + +proc WCSCmdLoadFn {cmd ext fn} { + global current + global rgb + + if {$current(frame) == {}} { + return + } + + RGBEvalLock rgb(lock,wcs) $current(frame) "$current(frame) wcs $cmd $ext \{\{$fn\}\}" + UpdateWCS +} + proc ProcessSendWCSCmd {proc id param} { global current global wcs @@ -1277,6 +1339,14 @@ 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 - @@ -1297,6 +1367,7 @@ proc ProcessAlignCmd {varname iname} { } } } +} proc ProcessSendAlignCmd {proc id param} { global current diff --git a/ds9/library/xpa.tcl b/ds9/library/xpa.tcl index 6052eca..dc34a39 100644 --- a/ds9/library/xpa.tcl +++ b/ds9/library/xpa.tcl @@ -2205,6 +2205,14 @@ 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 @@ -2226,11 +2234,20 @@ proc ProcessXPAFirstCmd {varname iname} { 0 {set pds9(xpa) [FromYesNo [lindex $var $i]]} } } +} 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 @@ -2245,6 +2262,13 @@ proc ProcessXPACmd {varname iname} { info {XPAInfo} } } +} + +proc XPACmdSet {varname which value} { + upvar #0 $varname var + + set var($which) $value +} proc ProcessSendXPACmd {proc id param} { switch -- [string tolower [lindex $param 0]] { |