diff options
Diffstat (limited to 'ds9')
| -rw-r--r-- | ds9/library/cat.tcl | 2 | ||||
| -rw-r--r-- | ds9/library/catdialog.tcl | 258 | ||||
| -rw-r--r-- | ds9/library/catplot.tcl | 8 | ||||
| -rw-r--r-- | ds9/library/catsym.tcl | 10 | ||||
| -rw-r--r-- | ds9/library/debug.tcl | 2 | ||||
| -rw-r--r-- | ds9/library/fp.tcl | 42 | ||||
| -rw-r--r-- | ds9/library/fpdialog.tcl | 39 | ||||
| -rw-r--r-- | ds9/library/table.tcl | 258 | ||||
| -rw-r--r-- | ds9/library/tableflt.tcl (renamed from ds9/library/catflt.tcl) | 11 |
9 files changed, 342 insertions, 288 deletions
diff --git a/ds9/library/cat.tcl b/ds9/library/cat.tcl index b736485..207e9a8 100644 --- a/ds9/library/cat.tcl +++ b/ds9/library/cat.tcl @@ -201,7 +201,7 @@ proc CATTable {varname} { } else { set var(tbldb) ${varname}tbldb global $var(tbldb) - if {![CATFltSort $varname]} { + if {![TBLFltSort $varname $var(catdb) $var(tbldb)]} { Error "[msgcat::mc {Unable to evaluate filter}] $var(filter)" if {[info exists $var(tbldb)]} { unset $var(tbldb) diff --git a/ds9/library/catdialog.tcl b/ds9/library/catdialog.tcl index 09a0e87..6edbf00 100644 --- a/ds9/library/catdialog.tcl +++ b/ds9/library/catdialog.tcl @@ -353,7 +353,7 @@ proc CATDialog {varname format catalog title action} { ttk::label $f.mfilter -text [msgcat::mc {Filter}] ttk::entry $f.filter -textvariable ${varname}(filter) -width 50 ttk::button $f.bfilter -text [msgcat::mc {Edit}] \ - -command [list CATEditDialog $varname filter $var(catdb)] + -command [list TBLEditDialog $varname filter $var(catdb)] ttk::label $f.msort -text [msgcat::mc {Sort}] set var(sortmenu) [ttk::menubutton $f.sort \ @@ -980,262 +980,6 @@ proc CATColsUpdate {varname} { } } -# Edit Dialog - -proc CATEditDialog {varname which db} { - upvar #0 $varname var - global $varname - global ds9 - global ed - - set w ".${varname}edit" - set mb ".${varname}editmb" - - set ed(ok) 0 - set ed(text) $w.param.txt - - DialogCreate $w [msgcat::mc {Edit}] ed(ok) - - $w configure -menu $mb - menu $mb - - # file - $mb add cascade -label [msgcat::mc {File}] -menu $mb.file - menu $mb.file - $mb.file add command -label "[msgcat::mc {Open}]..." \ - -command CATEditLoad - $mb.file add command -label "[msgcat::mc {Save}]..." \ - -command CATEditSave - $mb.file add separator - $mb.file add command -label [msgcat::mc {Apply}] \ - -command {set ed(ok) 1} - $mb.file add command -label [msgcat::mc {Clear}] \ - -command CATEditClear - $mb.file add separator - $mb.file add command -label [msgcat::mc {Cancel}] \ - -command {set ed(ok) 0} - - # edit - $mb add cascade -label [msgcat::mc {Edit}] -menu $mb.edit - menu $mb.edit - $mb.edit add command -label [msgcat::mc {Undo}] \ - -command "$ed(text) edit undo" - $mb.edit add command -label [msgcat::mc {Redo}] \ - -command "$ed(text) edit redo" - $mb.edit add separator - $mb.edit add command -label [msgcat::mc {Cut}] \ - -command "tk_textCut $ed(text)" -accelerator "${ds9(ctrl)}X" - $mb.edit add command -label [msgcat::mc {Copy}] \ - -command "tk_textCopy $ed(text)" -accelerator "${ds9(ctrl)}C" - $mb.edit add command -label [msgcat::mc {Paste}] \ - -command "tk_textPaste $ed(text)" -accelerator "${ds9(ctrl)}V" - - global $db - # column - $mb add cascade -label [msgcat::mc {Column}] -menu $mb.col - if {[info exists $mb.col]} { - destroy $mb.col - } - menu $mb.col - if {[TBLValidDB $db]} { - set cnt -1 - foreach col [starbase_columns $db] { - $mb.col add command -label "$col" \ - -command "$ed(text) insert insert \{\$$col\}" - - # wrap if needed - incr cnt - if {$cnt>=$ds9(menu,size,wrap)} { - set cnt 0 - $mb.col entryconfig $col -columnbreak 1 - } - } - } - - # operator - $mb add cascade -label [msgcat::mc {Operator}] -menu $mb.op - menu $mb.op - $mb.op add command -label {-} \ - -command "$ed(text) insert insert {-}" - $mb.op add command -label {!} \ - -command "$ed(text) insert insert {!}" - $mb.op add command -label {(} \ - -command "$ed(text) insert insert {(}" - $mb.op add command -label {)} \ - -command "$ed(text) insert insert {)}" - $mb.op add separator - $mb.op add command -label {*} \ - -command "$ed(text) insert insert {*}" - $mb.op add command -label {/} \ - -command "$ed(text) insert insert {/}" - $mb.op add command -label {%} \ - -command "$ed(text) insert insert {%}" - $mb.op add command -label {+} \ - -command "$ed(text) insert insert {+}" - $mb.op add command -label {-} \ - -command "$ed(text) insert insert {-}" - $mb.op add separator - $mb.op add command -label {<} \ - -command "$ed(text) insert insert {<}" - $mb.op add command -label {>} \ - -command "$ed(text) insert insert {>}" - $mb.op add command -label {<=} \ - -command "$ed(text) insert insert {<=}" - $mb.op add command -label {>=} \ - -command "$ed(text) insert insert {>=}" - $mb.op add command -label {==} \ - -command "$ed(text) insert insert {==}" - $mb.op add command -label {!=} \ - -command "$ed(text) insert insert {!=}" - $mb.op add separator - $mb.op add command -label {&&} \ - -command "$ed(text) insert insert {&&}" - $mb.op add command -label {||} \ - -command "$ed(text) insert insert {||}" - - # operator - $mb add cascade -label [msgcat::mc {Math Function}] -menu $mb.math - menu $mb.math - $mb.math add command -label {acos} \ - -command "$ed(text) insert insert {acos()}" - $mb.math add command -label {asin} \ - -command "$ed(text) insert insert {asin()}" - $mb.math add command -label {atan} \ - -command "$ed(text) insert insert {atan()}" - $mb.math add command -label {atan2} \ - -command "$ed(text) insert insert {atan2(,)}" - $mb.math add command -label {ceil} \ - -command "$ed(text) insert insert {ceil()}" - $mb.math add command -label {cos} \ - -command "$ed(text) insert insert {cos()}" - $mb.math add command -label {cosh} \ - -command "$ed(text) insert insert {cosh()}" - $mb.math add command -label {exp} \ - -command "$ed(text) insert insert {exp()}" - $mb.math add command -label {floor} \ - -command "$ed(text) insert insert {floor()}" - $mb.math add command -label {fmod} \ - -command "$ed(text) insert insert {fmod(,)}" - $mb.math add command -label {hypot} \ - -command "$ed(text) insert insert {hypot(,)}" - $mb.math add command -label {log} \ - -command "$ed(text) insert insert {log()}" - $mb.math add command -label {log10} \ - -command "$ed(text) insert insert {log10()}" - $mb.math add command -label {pow} \ - -command "$ed(text) insert insert {pow(,)}" - $mb.math add command -label {sin} \ - -command "$ed(text) insert insert {sin()}" - $mb.math add command -label {sinh} \ - -command "$ed(text) insert insert {sinh()}" - $mb.math add command -label {sqrt} \ - -command "$ed(text) insert insert {sqrt()}" - $mb.math add command -label {tan} \ - -command "$ed(text) insert insert {tan()}" - $mb.math add command -label {tanh} \ - -command "$ed(text) insert insert {tanh()}" - $mb.math add command -label {abs} \ - -command "$ed(text) insert insert {abs()}" - $mb.math add command -label {double} \ - -command "$ed(text) insert insert {double()}" - $mb.math add command -label {int} \ - -command "$ed(text) insert insert {int()}" - $mb.math add command -label {round} \ - -command "$ed(text) insert insert {round()}" - - # Text - set f [ttk::frame $w.param] - - text $f.txt \ - -height 10 \ - -width 60 \ - -yscrollcommand "$f.yscroll set" \ - -xscrollcommand "$f.xscroll set" \ - -undo true \ - -wrap none - ttk::scrollbar $f.yscroll -command [list $ed(text) yview] \ - -orient vertical - ttk::scrollbar $f.xscroll -command [list $ed(text) xview] \ - -orient horizontal - - grid $ed(text) $f.yscroll -sticky news - grid $f.xscroll -stick news - grid rowconfigure $f 0 -weight 1 - grid columnconfigure $f 0 -weight 1 - - # Buttons - set f [ttk::frame $w.buttons] - ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \ - -default active - ttk::button $f.clear -text [msgcat::mc {Clear}] -command CATEditClear - ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0} - pack $f.ok $f.clear $f.cancel -side left -expand true -padx 2 -pady 4 - - bind $w <Return> {set ed(ok) 1} - - # Fini - ttk::separator $w.sep -orient horizontal - pack $w.param -side top -fill both -expand true - pack $w.buttons $w.sep -side bottom -fill x - - $ed(text) insert end $var($which) - $ed(text) see end - - DialogCenter $w - DialogWait $w ed(ok) $w.buttons.ok - - if {$ed(ok)} { - set flt [$ed(text) get 1.0 end] - catch {regsub {\n} $flt " " flt} - set var($which) [string trim $flt] - } - - DialogDismiss $w - destroy $mb - - set rr $ed(ok) - unset ed - return $rr -} - -proc CATEditClear {} { - global ed - - $ed(text) delete 1.0 end -} - -proc CATEditSave {} { - global ed - - set fn [SaveFileDialog catfltfbox] - if {$fn != {}} { - if {[catch {open $fn w} fp]} { - Error "[msgcat::mc {Unable to open file}] $fn: $fp" - return - } - set flt [$ed(text) get 1.0 end] - catch {regsub {\n} $flt " " flt} - puts $fp [string trim $flt] - catch {close $fp} - } -} - -proc CATEditLoad {} { - global ed - - set fn [OpenFileDialog catfltfbox] - if {$fn != {}} { - if {[catch {open $fn r} fp]} { - Error "[msgcat::mc {Unable to open file}] $fn: $fp" - return - } - $ed(text) delete 1.0 end - $ed(text) insert end [read -nonewline $fp] - $ed(text) see end - catch {close $fp} - } -} - proc UpdateCATDialog {} { global icat diff --git a/ds9/library/catplot.tcl b/ds9/library/catplot.tcl index fa6d3b3..557b871 100644 --- a/ds9/library/catplot.tcl +++ b/ds9/library/catplot.tcl @@ -175,10 +175,10 @@ proc CATPlotDialog {varname} { ttk::label $f.tx -text {X} ttk::entry $f.x -textvariable ed2(x) -width 21 ttk::button $f.bx -text [msgcat::mc {Edit}] \ - -command "CATEditDialog ed2 x $var(catdb)" + -command "TBLEditDialog ed2 x $var(catdb)" ttk::entry $f.xerr -textvariable ed2(xerr) -width 21 ttk::button $f.bxerr -text [msgcat::mc {Edit}] \ - -command "CATEditDialog ed2 xerr $var(catdb)" + -command "TBLEditDialog ed2 xerr $var(catdb)" ttk::menubutton $f.mx -text {Cols} -menu $f.mx.menu ttk::menubutton $f.mxerr -text {Cols} -menu $f.mxerr.menu @@ -188,10 +188,10 @@ proc CATPlotDialog {varname} { ttk::label $f.ty -text {Y} ttk::entry $f.y -textvariable ed2(y) -width 21 ttk::button $f.by -text [msgcat::mc {Edit}] \ - -command "CATEditDialog ed2 y $var(catdb)" + -command "TBLEditDialog ed2 y $var(catdb)" ttk::entry $f.yerr -textvariable ed2(yerr) -width 21 ttk::button $f.byerr -text [msgcat::mc {Edit}] \ - -command "CATEditDialog ed2 yerr $var(catdb)" + -command "TBLEditDialog ed2 yerr $var(catdb)" ttk::menubutton $f.my -text {Cols} -menu $f.my.menu ttk::menubutton $f.myerr -text {Cols} -menu $f.myerr.menu diff --git a/ds9/library/catsym.tcl b/ds9/library/catsym.tcl index 3a2aa5a..f5ffb04 100644 --- a/ds9/library/catsym.tcl +++ b/ds9/library/catsym.tcl @@ -111,7 +111,7 @@ proc CATSymDialog {parent} { ttk::label $f.tcondition -text [msgcat::mc {If}] ttk::entry $f.condition -textvariable ${varname}(condition) -width 40 ttk::button $f.bcondition -text [msgcat::mc {Edit}] \ - -command "CATEditDialog $varname condition $pvar(catdb)" + -command "TBLEditDialog $varname condition $pvar(catdb)" ttk::label $f.tthen -text [msgcat::mc {Then}] ttk::label $f.tshape -text [msgcat::mc {Shape}] ttk::menubutton $f.shape -textvariable ${varname}(shape) -menu $f.shape.menu @@ -124,15 +124,15 @@ proc CATSymDialog {parent} { ttk::label $f.ttext -text [msgcat::mc {Text}] ttk::entry $f.text -textvariable ${varname}(text) -width 40 ttk::button $f.btext -text [msgcat::mc {Edit}] \ - -command "CATEditDialog $varname text $pvar(catdb)" + -command "TBLEditDialog $varname text $pvar(catdb)" ttk::label $f.tsize -text [msgcat::mc {Size/Radius}] ttk::entry $f.size -textvariable ${varname}(size) -width 40 ttk::button $f.bsize -text [msgcat::mc {Edit}] \ - -command "CATEditDialog $varname size $pvar(catdb)" + -command "TBLEditDialog $varname size $pvar(catdb)" ttk::label $f.tsize2 -text "[msgcat::mc {Size/Radius}] 2" ttk::entry $f.size2 -textvariable ${varname}(size2) -width 40 ttk::button $f.bsize2 -text [msgcat::mc {Edit}] \ - -command "CATEditDialog $varname size2 $pvar(catdb)" + -command "TBLEditDialog $varname size2 $pvar(catdb)" ttk::label $f.tunits -text [msgcat::mc {Units}] tk_optionMenu $f.units ${varname}(units) \ image physical degrees arcmin arcsec @@ -140,7 +140,7 @@ proc CATSymDialog {parent} { ttk::label $f.tangle -text [msgcat::mc {Angle}] ttk::entry $f.angle -textvariable ${varname}(angle) -width 40 ttk::button $f.bangle -text [msgcat::mc {Edit}] \ - -command "CATEditDialog $varname angle $pvar(catdb)" + -command "TBLEditDialog $varname angle $pvar(catdb)" menu $f.shape.menu $f.shape.menu add radiobutton -label [msgcat::mc {Circle}] \ diff --git a/ds9/library/debug.tcl b/ds9/library/debug.tcl index 74cb2e8..7787297 100644 --- a/ds9/library/debug.tcl +++ b/ds9/library/debug.tcl @@ -182,6 +182,7 @@ proc ProcessDebugTclCmd {varname iname} { hv {set debug(tcl,hv) 1} cat {set debug(tcl,cat) 1} sia {set debug(tcl,sia) 1} + fp {set debug(tcl,fp) 1} samp {set debug(tcl,samp) 1} grid {set debug(tcl,grid) 1} restore {set debug(tcl,restore) 1} @@ -260,6 +261,7 @@ proc ProcessDebugCmd {varname iname} { hv - cat - sia - + fp - samp - grid - restore - diff --git a/ds9/library/fp.tcl b/ds9/library/fp.tcl index 675d05d..e750ae1 100644 --- a/ds9/library/fp.tcl +++ b/ds9/library/fp.tcl @@ -116,10 +116,10 @@ proc FPTable {varname} { } } - # filter regions + # concat regions set var(tbldb) ${varname}tbldb global $var(tbldb) - if {![eval $var(proc,flt) $varname]} { + if {![eval $var(proc,reg) $varname $var(catdb) $var(tbldb)]} { Error [msgcat::mc {Internal Parse Error}] if {[info exists $var(tbldb)]} { unset $var(tbldb) @@ -127,6 +127,20 @@ proc FPTable {varname} { set var(tbldb) $var(catdb) } + if {$var(filter) == {} && $var(sort) == {}} { + ; + } else { + set var(tbldb) ${varname}tbldb + global $var(tbldb) + if {![TBLFltSort $varname $var(catdb) $var(tbldb)]} { + Error "[msgcat::mc {Unable to evaluate filter}] $var(filter)" + if {[info exists $var(tbldb)]} { + unset $var(tbldb) + } + set var(tbldb) $var(catdb) + } + } + global $var(tbldb) $var(tbl) configure -variable $var(tbldb) $var(found) configure -textvariable ${var(tbldb)}(Nrows) @@ -157,14 +171,15 @@ proc FPTable {varname} { FPGenerate $varname } -proc FPFltCXC {varname} { +proc FPRegCXC {varname src dest} { upvar #0 $varname var global $varname - global $var(catdb) - global $var(tbldb) - upvar #0 $var(catdb) catsrc - upvar #0 $var(tbldb) catdest + upvar #0 $src catsrc + global $src + + upvar #0 $dest catdest + global $dest # create header set catdest(Header) $catsrc(Header) @@ -245,14 +260,15 @@ proc FPFltCXC {varname} { return 1 } -proc FPFltHLA {varname} { +proc FPRegHLA {varname src dest} { upvar #0 $varname var global $varname - global $var(catdb) - global $var(tbldb) - upvar #0 $var(catdb) catsrc - upvar #0 $var(tbldb) catdest + upvar #0 $src catsrc + global $src + + upvar #0 $dest catdest + global $dest # create header set catdest(Header) $catsrc(Header) @@ -426,6 +442,8 @@ proc FPOff {varname} { } } + set var(filter) {} + set var(sort) {} set var(blink) 0 FPDialogUpdate $varname diff --git a/ds9/library/fpdialog.tcl b/ds9/library/fpdialog.tcl index c5e4815..b8c9a0d 100644 --- a/ds9/library/fpdialog.tcl +++ b/ds9/library/fpdialog.tcl @@ -48,12 +48,12 @@ proc FPDialog {varname title url instr format action} { cxc { set var(colid) ObsId set var(colreg) stcs - set var(proc,flt) FPFltCXC + set var(proc,reg) FPRegCXC } hla { set var(colid) PropID set var(colreg) regionSTCS - set var(proc,flt) FPFltHLA + set var(proc,reg) FPRegHLA } } @@ -89,6 +89,10 @@ proc FPDialog {varname title url instr format action} { set ${varname}(instr,$ll) 1 } + set var(filter) {} + set var(sort) {} + set var(sort,dir) "-increasing" + # create the window set w $var(top) set mb $var(mb) @@ -115,6 +119,11 @@ proc FPDialog {varname title url instr format action} { $mb.file add command -label [msgcat::mc {Clear}] \ -command [list FPOff $varname] $mb.file add separator + $mb.file add command -label [msgcat::mc {Filter}] \ + -command [list FPTable $varname] + $mb.file add command -label [msgcat::mc {Clear}] \ + -command [list FPOff $varname] + $mb.file add separator $mb.file add checkbutton -label [msgcat::mc {Show}] \ -variable ${varname}(show) -command [list FPGenerate $varname] $mb.file add separator @@ -198,10 +207,30 @@ proc FPDialog {varname title url instr format action} { # Param set f [ttk::labelframe $w.param -text [msgcat::mc {Table}] -padding 2] + ttk::label $f.mfilter -text [msgcat::mc {Filter}] + ttk::entry $f.filter -textvariable ${varname}(filter) -width 50 + ttk::button $f.bfilter -text [msgcat::mc {Edit}] \ + -command [list TBLEditDialog $varname filter $var(catdb)] + + ttk::label $f.msort -text [msgcat::mc {Sort}] + set var(sortmenu) [ttk::menubutton $f.sort \ + -textvariable ${varname}(sort) \ + -menu $f.sort.menu -width 14] + ttk::radiobutton $f.isort -text [msgcat::mc {Increase}] \ + -variable ${varname}(sort,dir) -value "-increasing" \ + -command [list FPTable $varname] + ttk::radiobutton $f.dsort -text [msgcat::mc {Decrease}] \ + -variable ${varname}(sort,dir) -value "-decreasing" \ + -command [list FPTable $varname] + ttk::label $f.ftitle -text [msgcat::mc {Found}] set var(found) [ttk::label $f.found \ -width 14 -relief groove -anchor w] + grid $f.mfilter $f.filter - - $f.bfilter \ + -padx 2 -pady 2 -sticky w + grid $f.msort $f.sort $f.isort $f.dsort \ + -padx 2 -pady 2 -sticky w grid $f.ftitle $f.found -padx 2 -pady 2 -sticky w # Table @@ -255,13 +284,15 @@ proc FPDialog {varname title url instr format action} { [msgcat::mc {Cancel}] \ -command [list ARCancel $varname] \ -state disabled] + ttk::button $f.filter -text [msgcat::mc {Filter}] \ + -command [list FPTable $varname] ttk::button $f.clear -text [msgcat::mc {Clear}] \ -command [list FPOff $varname] ttk::button $f.close -text [msgcat::mc {Close}] \ -command [list FPDestroy $varname] - pack $f.apply $f.cancel $f.clear $f.close \ - -side left -expand true -padx 2 -pady 4 + pack $f.apply $f.cancel $f.filter $f.clear $f.close \ + -side left -expand true -padx 2 -pady 4 # Fini ttk::separator $w.stbl -orient horizontal diff --git a/ds9/library/table.tcl b/ds9/library/table.tcl index 673cba5..911419e 100644 --- a/ds9/library/table.tcl +++ b/ds9/library/table.tcl @@ -353,6 +353,264 @@ proc TBLSaveFn {varname fn writer} { ARDone $varname } +# Edit Dialog + +proc TBLEditDialog {varname which db} { + upvar #0 $varname var + global $varname + global ds9 + global ed + + set w ".${varname}edit" + set mb ".${varname}editmb" + + set ed(ok) 0 + set ed(text) $w.param.txt + + DialogCreate $w [msgcat::mc {Edit}] ed(ok) + + $w configure -menu $mb + menu $mb + + # file + $mb add cascade -label [msgcat::mc {File}] -menu $mb.file + menu $mb.file + $mb.file add command -label "[msgcat::mc {Open}]..." \ + -command TBLEditDialogLoad + $mb.file add command -label "[msgcat::mc {Save}]..." \ + -command TBLEditDialogSave + $mb.file add separator + $mb.file add command -label [msgcat::mc {Apply}] \ + -command {set ed(ok) 1} + $mb.file add command -label [msgcat::mc {Clear}] \ + -command TBLEditDialogClear + $mb.file add separator + $mb.file add command -label [msgcat::mc {Cancel}] \ + -command {set ed(ok) 0} + + # edit + $mb add cascade -label [msgcat::mc {Edit}] -menu $mb.edit + menu $mb.edit + $mb.edit add command -label [msgcat::mc {Undo}] \ + -command "$ed(text) edit undo" + $mb.edit add command -label [msgcat::mc {Redo}] \ + -command "$ed(text) edit redo" + $mb.edit add separator + $mb.edit add command -label [msgcat::mc {Cut}] \ + -command "tk_textCut $ed(text)" -accelerator "${ds9(ctrl)}X" + $mb.edit add command -label [msgcat::mc {Copy}] \ + -command "tk_textCopy $ed(text)" -accelerator "${ds9(ctrl)}C" + $mb.edit add command -label [msgcat::mc {Paste}] \ + -command "tk_textPaste $ed(text)" -accelerator "${ds9(ctrl)}V" + + global $db + # column + $mb add cascade -label [msgcat::mc {Column}] -menu $mb.col + if {[info exists $mb.col]} { + destroy $mb.col + } + menu $mb.col + if {[TBLValidDB $db]} { + set cnt -1 + foreach col [starbase_columns $db] { + $mb.col add command -label "$col" \ + -command "$ed(text) insert insert \{\$$col\}" + + # wrap if needed + incr cnt + if {$cnt>=$ds9(menu,size,wrap)} { + set cnt 0 + $mb.col entryconfig $col -columnbreak 1 + } + } + } + + # operator + $mb add cascade -label [msgcat::mc {Operator}] -menu $mb.op + menu $mb.op + $mb.op add command -label {-} \ + -command "$ed(text) insert insert {-}" + $mb.op add command -label {!} \ + -command "$ed(text) insert insert {!}" + $mb.op add command -label {(} \ + -command "$ed(text) insert insert {(}" + $mb.op add command -label {)} \ + -command "$ed(text) insert insert {)}" + $mb.op add separator + $mb.op add command -label {*} \ + -command "$ed(text) insert insert {*}" + $mb.op add command -label {/} \ + -command "$ed(text) insert insert {/}" + $mb.op add command -label {%} \ + -command "$ed(text) insert insert {%}" + $mb.op add command -label {+} \ + -command "$ed(text) insert insert {+}" + $mb.op add command -label {-} \ + -command "$ed(text) insert insert {-}" + $mb.op add separator + $mb.op add command -label {<} \ + -command "$ed(text) insert insert {<}" + $mb.op add command -label {>} \ + -command "$ed(text) insert insert {>}" + $mb.op add command -label {<=} \ + -command "$ed(text) insert insert {<=}" + $mb.op add command -label {>=} \ + -command "$ed(text) insert insert {>=}" + $mb.op add command -label {==} \ + -command "$ed(text) insert insert {==}" + $mb.op add command -label {!=} \ + -command "$ed(text) insert insert {!=}" + $mb.op add separator + $mb.op add command -label {&&} \ + -command "$ed(text) insert insert {&&}" + $mb.op add command -label {||} \ + -command "$ed(text) insert insert {||}" + + # operator + $mb add cascade -label [msgcat::mc {Math Function}] -menu $mb.math + menu $mb.math + $mb.math add command -label {acos} \ + -command "$ed(text) insert insert {acos()}" + $mb.math add command -label {asin} \ + -command "$ed(text) insert insert {asin()}" + $mb.math add command -label {atan} \ + -command "$ed(text) insert insert {atan()}" + $mb.math add command -label {atan2} \ + -command "$ed(text) insert insert {atan2(,)}" + $mb.math add command -label {ceil} \ + -command "$ed(text) insert insert {ceil()}" + $mb.math add command -label {cos} \ + -command "$ed(text) insert insert {cos()}" + $mb.math add command -label {cosh} \ + -command "$ed(text) insert insert {cosh()}" + $mb.math add command -label {exp} \ + -command "$ed(text) insert insert {exp()}" + $mb.math add command -label {floor} \ + -command "$ed(text) insert insert {floor()}" + $mb.math add command -label {fmod} \ + -command "$ed(text) insert insert {fmod(,)}" + $mb.math add command -label {hypot} \ + -command "$ed(text) insert insert {hypot(,)}" + $mb.math add command -label {log} \ + -command "$ed(text) insert insert {log()}" + $mb.math add command -label {log10} \ + -command "$ed(text) insert insert {log10()}" + $mb.math add command -label {pow} \ + -command "$ed(text) insert insert {pow(,)}" + $mb.math add command -label {sin} \ + -command "$ed(text) insert insert {sin()}" + $mb.math add command -label {sinh} \ + -command "$ed(text) insert insert {sinh()}" + $mb.math add command -label {sqrt} \ + -command "$ed(text) insert insert {sqrt()}" + $mb.math add command -label {tan} \ + -command "$ed(text) insert insert {tan()}" + $mb.math add command -label {tanh} \ + -command "$ed(text) insert insert {tanh()}" + $mb.math add command -label {abs} \ + -command "$ed(text) insert insert {abs()}" + $mb.math add command -label {double} \ + -command "$ed(text) insert insert {double()}" + $mb.math add command -label {int} \ + -command "$ed(text) insert insert {int()}" + $mb.math add command -label {round} \ + -command "$ed(text) insert insert {round()}" + + # Text + set f [ttk::frame $w.param] + + text $f.txt \ + -height 10 \ + -width 60 \ + -yscrollcommand "$f.yscroll set" \ + -xscrollcommand "$f.xscroll set" \ + -undo true \ + -wrap none + ttk::scrollbar $f.yscroll -command [list $ed(text) yview] \ + -orient vertical + ttk::scrollbar $f.xscroll -command [list $ed(text) xview] \ + -orient horizontal + + grid $ed(text) $f.yscroll -sticky news + grid $f.xscroll -stick news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + + # Buttons + set f [ttk::frame $w.buttons] + ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \ + -default active + ttk::button $f.clear -text [msgcat::mc {Clear}] -command TBLEditDialogClear + ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0} + pack $f.ok $f.clear $f.cancel -side left -expand true -padx 2 -pady 4 + + bind $w <Return> {set ed(ok) 1} + + # Fini + ttk::separator $w.sep -orient horizontal + pack $w.param -side top -fill both -expand true + pack $w.buttons $w.sep -side bottom -fill x + + $ed(text) insert end $var($which) + $ed(text) see end + + DialogCenter $w + DialogWait $w ed(ok) $w.buttons.ok + + if {$ed(ok)} { + set flt [$ed(text) get 1.0 end] + catch {regsub {\n} $flt " " flt} + set var($which) [string trim $flt] + } + + DialogDismiss $w + destroy $mb + + set rr $ed(ok) + unset ed + return $rr +} + +proc TBLEditDialogClear {} { + global ed + + $ed(text) delete 1.0 end +} + +proc TBLEditDialogSave {} { + global ed + + set fn [SaveFileDialog catfltfbox] + if {$fn != {}} { + if {[catch {open $fn w} fp]} { + Error "[msgcat::mc {Unable to open file}] $fn: $fp" + return + } + set flt [$ed(text) get 1.0 end] + catch {regsub {\n} $flt " " flt} + puts $fp [string trim $flt] + catch {close $fp} + } +} + +proc TBLEditDialogLoad {} { + global ed + + set fn [OpenFileDialog catfltfbox] + if {$fn != {}} { + if {[catch {open $fn r} fp]} { + Error "[msgcat::mc {Unable to open file}] $fn: $fp" + return + } + $ed(text) delete 1.0 end + $ed(text) insert end [read -nonewline $fp] + $ed(text) see end + catch {close $fp} + } +} + +# Cmd + proc TBLCmdSave {fn writer} { global cvarname diff --git a/ds9/library/catflt.tcl b/ds9/library/tableflt.tcl index e3d8e5e..12f274a 100644 --- a/ds9/library/catflt.tcl +++ b/ds9/library/tableflt.tcl @@ -4,14 +4,15 @@ package provide DS9 1.0 -proc CATFltSort {varname} { +proc TBLFltSort {varname src dest} { upvar #0 $varname var global $varname - global $var(catdb) - global $var(tbldb) - upvar #0 $var(catdb) catsrc - upvar #0 $var(tbldb) catdest + upvar #0 $src catsrc + global $src + + upvar #0 $dest catdest + global $dest # create header set catdest(Header) $catsrc(Header) |