summaryrefslogtreecommitdiffstats
path: root/ds9/library/cat.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'ds9/library/cat.tcl')
-rw-r--r--ds9/library/cat.tcl585
1 files changed, 7 insertions, 578 deletions
diff --git a/ds9/library/cat.tcl b/ds9/library/cat.tcl
index 5ad5c90..0d30632 100644
--- a/ds9/library/cat.tcl
+++ b/ds9/library/cat.tcl
@@ -1243,586 +1243,15 @@ proc ProcessCatalogCmd {varname iname} {
# we need to be realized
ProcessRealizeDS9
- global debug
- if {$debug(tcl,parser)} {
- global icat
- set ref [lindex $icat(cats) end]
- global cvarname
- set cvarname $ref
-
- cat::YY_FLUSH_BUFFER
- cat::yy_scan_string [lrange $var $i end]
- cat::yyparse
- incr i [expr $cat::yycnt-1]
- } else {
-
global icat
- set item [string tolower [lindex $var $i]]
- switch -- $item {
- {} {CATTool}
-
- file -
- import -
- load {
- incr i
- set reader VOTRead
- switch -- [lindex $var $i] {
- xml -
- vot {incr i; set reader VOTRead}
- sb -
- starbase {incr i; set reader starbase_read}
- csv -
- tsv {incr i; set reader TSVRead}
- }
-
- set fn [lindex $var $i]
- if {$fn != {}} {
- CATDialog cattool {} {} {} none
- CATLoadFn [lindex $icat(cats) end] $fn $reader
- FileLast catfbox $fn
- }
- }
-
- allcols -
- allrows -
- cancel -
- clear -
- close -
- coordinate -
- crosshair -
- dec -
- edit -
- export -
- filter -
- header -
- hide -
- location -
- match -
- maxrows -
- name -
- panto -
- plot -
- print -
- psky -
- psystem -
- ra -
- regions -
- retrieve -
- samp -
- save -
- server -
- show -
- size -
- sky -
- skyformat -
- sort -
- symbol -
- system -
- update -
- x -
- y {ProcessCatalog $varname $iname [lindex $icat(cats) end]}
-
- default {
- # another command
- if {[string range $item 0 0] == "-"} {
- CATTool
- incr i -1
- return
- }
-
- # existing cat or load new one?
- set ref $item
-
- # backward compatibility
- if {[string range $ref 0 2] == {cat}} {
- set ref [string range $ref 3 end]
- }
-
- incr i
- set item [string tolower [lindex $var $i]]
- switch -- $item {
- file -
- import -
- load {incr i -1}
-
- allcols -
- allrows -
- cancel -
- clear -
- close -
- coordinate -
- crosshair -
- dec -
- edit -
- export -
- filter -
- header -
- hide -
- location -
- match -
- maxrows -
- name -
- panto -
- plot -
- print -
- psky -
- psystem -
- ra -
- regions -
- retrieve -
- samp -
- save -
- server -
- show -
- size -
- sky -
- skyformat -
- sort -
- symbol -
- system -
- update -
- x -
- y {ProcessCatalog $varname $iname cat${ref}}
-
- default {
- # ok, new catalog
- incr i -1
- set item [string tolower [lindex $var $i]]
-
- # backward compatibility
- switch $item {
- cds {incr i; set item [string tolower [lindex $var $i]]}
- cxc {set item csc}
- }
-
- # see if its from our list of cats
- foreach mm $icat(def) {
- set ll [lindex $mm 0]
- set ww [lindex $mm 1]
- set ss [lindex $mm 2]
- set cc [lindex $mm 3]
-
- if {$ll != {-} && "cat${item}" == $ww} {
- CATDialog $ww $ss $cc $ll sync
- return
- }
- }
-
- # not a default, assume other name
- CATDialog catcds cds $item $item sync
- }
- }
- }
- }
-}
-}
-
-proc ProcessCatalog {varname iname cvarname} {
- upvar 2 $varname var
- upvar 2 $iname i
-
- global icat
- global pcat
- global current
-
- # we should have a catalog now
- global $cvarname
- upvar #0 $cvarname cvar
-
- if {![info exists cvar(top)]} {
- Error "[msgcat::mc {Unable to find catalog window}] $cvarname"
- return
- }
- if {![winfo exists $cvar(top)]} {
- Error "[msgcat:: mc {Unable to find catalog window}] $cvarname"
- return
- }
-
- # now, process it
- set item [string tolower [lindex $var $i]]
- switch -- $item {
- allrows {set cvar(allrows) 1}
- allcols {set cvar(allcols) 1}
- cancel {ARCancel $cvarname}
- clear {CATOff $cvarname}
- close {CATDestroy $cvarname}
- coordinate {
- incr i
- set cvar(x) [lindex $var $i]
- incr i
- set cvar(y) [lindex $var $i]
- incr i
- set cvar(sky) [lindex $var $i]
- }
- crosshair {CATCrosshair $cvarname}
- edit {
- incr i
- set cvar(edit) [FromYesNo [lindex $var $i]]
- CATEdit $cvarname
- }
- export -
- save {
- incr i
- set writer VOTWrite
- switch -- [lindex $var $i] {
- xml -
- vot {incr i; set writer VOTWrite}
- sb -
- starbase {incr i; set writer starbase_write}
- csv -
- tsv {incr i; set writer TSVWrite}
- }
+ set ref [lindex $icat(cats) end]
+ global cvarname
+ set cvarname $ref
- set fn [lindex $var $i]
- CATSaveFn $cvarname $fn $writer
- FileLast catfbox $fn
- }
- filter {
- incr i
- set item [lindex $var $i]
- switch -- $item {
- load {
- incr i
- set fn [lindex $var $i]
- if {[catch {open $fn r} fp]} {
- Error "[msgcat::mc {Unable to open file}] $fn: $fp"
- return
- }
- set flt [read -nonewline $fp]
- catch {regsub {\n} $flt " " $flt}
- set cvar(filter) [string trim $flt]
- catch {close $fp}
- }
- default {
- set cvar(filter) $item
- }
- }
- CATTable $cvarname
- }
- header {CATHeader $cvarname}
- hide {
- set cvar(show) 0
- CATGenerate $cvarname
- }
- location {
- incr i
- set cvar(loc) [lindex $var $i]
- CATGenerate $cvarname
- }
- match {
- incr i
- set item [lindex $var $i]
- switch -- $item {
- error {
- incr i
- set icat(error) [lindex $var $i]
- incr i
- set icat(eformat) [lindex $var $i]
- }
- function {incr i; set icat(function) [lindex $var $i]}
- unique {incr i; set icat(unique) [FromYesNo [lindex $var $i]]}
- return {incr i; set icat(return) [lindex $var $i]}
- default {
- set icat(match1) {}
- set icat(match2) {}
- set m1 [lindex $var $i]
- set m2 [lindex $var [expr $i+1]]
- if {$m1 != {}} {
- if {[string range $m1 0 0] != {-}} {
- if {$m2 != {}} {
- if {[string range $m2 0 0] != {-}} {
- incr i
- set icat(match1) "cat$m1"
- set icat(match2) "cat$m2"
- CATMatch $current(frame) \
- $icat(match1) $icat(match2)
- return
- }
- } else {
- # error
- return
- }
- }
- }
- incr i -1
- # find them
- set ll [llength $icat(cats)]
- if {$ll>1} {
- set icat(match1) [lindex $icat(cats) [expr $ll-2]]
- set icat(match2) [lindex $icat(cats) [expr $ll-1]]
- CATMatch $current(frame) $icat(match1) $icat(match2)
- } else {
- # error
- }
- }
- }
- }
- maxrows {
- incr i
- set cvar(max) [lindex $var $i]
- }
- name {
- incr i
- set cvar(name) [lindex $var $i]
- }
- panto {
- incr i
- set cvar(panto) [FromYesNo [lindex $var $i]]
- }
- plot {
- incr i
- set cvar(plot,x) [lindex $var $i]
- incr i
- set cvar(plot,y) [lindex $var $i]
- set cvar(plot,xerr) {}
- set cvar(plot,yerr) {}
- set xerr [lindex $var [expr $i+1]]
- set yerr [lindex $var [expr $i+2]]
- if {$xerr != {}} {
- if {[string range $xerr 0 0 ] != {-}} {
- incr i
- set cvar(plot,xerr) $xerr
- if {$yerr != {}} {
- if {[string range $yerr 0 0 ] != {-}} {
- incr i
- set cvar(plot,yerr) $yerr
- }
- }
- }
- }
- CATPlotGenerate $cvarname
- }
- print {CATPrint $cvarname}
- psky {
- incr i
- set cvar(psky) [lindex $var $i]
- CATGenerate $cvarname
- }
- psystem {
- incr i
- set cvar(psystem) [lindex $var $i]
- CATGenerate $cvarname
- }
- regions {CATGenerateRegions $cvarname}
- retrieve {CATApply $cvarname 1}
- samp {
- global ds9
- global samp
- incr i
- switch -- [string tolower [lindex $var $i]] {
- send {
- incr i
- set name [string tolower [lindex $var $i]]
- if {[info exists samp]} {
- foreach arg $samp(apps,votable) {
- foreach {key val} $arg {
- if {[string tolower $val] == $name} {
- SAMPSendTableLoadVotable $key $cvarname
- break
- }
- }
- }
- } else {
- Error [msgcat::mc {SAMP: not connected}]
- }
- }
- broadcast {SAMPSendTableLoadVotable {} $cvarname}
- default {
- SAMPSendTableLoadVotable {} $cvarname
- incr i -1
- }
- }
- }
- server {
- incr i
- set cvar(server) [lindex $var $i]
- }
- size {
- incr i
- set cvar(width) [lindex $var $i]
- incr i
- set cvar(height) [lindex $var $i]
- incr i
- set cvar(rformat) [lindex $var $i]
- set cvar(rformat,msg) $cvar(rformat)
- }
- show {
- set cvar(show) 1
- CATGenerate $cvarname
- }
- sky {
- incr i
- set cvar(sky) [lindex $var $i]
- CoordMenuButtonCmd $cvarname system sky \
- [list CATWCSMenuUpdate $cvarname]
- }
- skyformat {
- incr i
- set cvar(skyformat) [lindex $var $i]
- }
- sort {
- incr i
- set cvar(sort) [lindex $var $i]
- incr i
- switch -- [lindex $var $i] {
- incr {
- set cvar(sort,dir) "-increasing"
- }
- decr {
- set cvar(sort,dir) "-decreasing"
- }
- }
- CATTable $cvarname
- }
- symbol {
- global $cvar(symdb)
- set row 1
- incr i
- if {[string is integer [lindex $var $i]]} {
- set row [lindex $var $i]
- incr i
- }
- switch -- [lindex $var $i] {
- add {
- set row [expr [starbase_nrows $cvar(symdb)]+1]
- starbase_rowins $cvar(symdb) $row
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) shape] $pcat(sym,shape)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) color] $pcat(sym,color)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) width] $pcat(sym,width)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) font] $pcat(sym,font)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontsize] \
- $pcat(sym,font,size)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontweight] \
- $pcat(sym,font,weight)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontslant] \
- $pcat(sym,font,slant)
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) units] $pcat(sym,units)
- CATGenerate $cvarname
- }
- angle {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) angle] [lindex $var $i]
- CATGenerate $cvarname
- }
- color {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) color] [lindex $var $i]
- CATGenerate $cvarname
- }
- condition {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) condition] \
- [lindex $var $i]
- CATGenerate $cvarname
- }
- font {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) font] [lindex $var $i]
- CATGenerate $cvarname
- }
- fontsize {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontsize] [lindex $var $i]
- CATGenerate $cvarname
- }
- fontweight {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontweight] \
- [lindex $var $i]
- CATGenerate $cvarname
- }
- fontslant {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) fontslant] \
- [lindex $var $i]
- CATGenerate $cvarname
- }
- load {
- incr i
- set fn [lindex $var $i]
- if {[file exists $fn]} {
- starbase_read $cvar(symdb) $fn
- CATGenerate $cvarname
- } else {
- Error "[msgcat::mc {Unable to open file}] $fn"
- return
- }
- }
- remove {
- starbase_rowdel $cvar(symdb) $row
- CATGenerate $cvarname
- }
- save {
- incr i
- starbase_write $cvar(symdb) [lindex $var $i]
- }
- size {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) size] [lindex $var $i]
- CATGenerate $cvarname
- }
- size2 {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) size2] [lindex $var $i]
- CATGenerate $cvarname
- }
- shape {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) shape] [lindex $var $i]
- CATGenerate $cvarname
- }
- text {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) text] [lindex $var $i]
- CATGenerate $cvarname
- }
- units {
- incr i
- starbase_set $cvar(symdb) $row \
- [starbase_colnum $cvar(symdb) units] [lindex $var $i]
- CATGenerate $cvarname
- }
- }
- }
- system {
- incr i
- set cvar(system) [lindex $var $i]
- CoordMenuButtonCmd $cvarname system sky \
- [list CATWCSMenuUpdate $cvarname]
- }
- update {CATUpdate $cvarname}
- x -
- ra {
- incr i
- set cvar(colx) [lindex $var $i]
- CATGenerate $cvarname
- }
- y -
- dec {
- incr i
- set cvar(coly) [lindex $var $i]
- CATGenerate $cvarname
- }
- }
+ cat::YY_FLUSH_BUFFER
+ cat::yy_scan_string [lrange $var $i end]
+ cat::yyparse
+ incr i [expr $cat::yycnt-1]
}
proc CatalogCmdCheck {} {
generated by cgit v0.12 at 2024-10-14 10:17:08 (GMT)