[GRASS-dev] gis.m broken in 6.2.0rc3 for Tcl/Tk 8.3
Hamish
hamish_nospam at yahoo.com
Sun Oct 29 00:40:58 EDT 2006
Hamish wrote:
> > As the subject says, gis.m is fully broken in 6.2 for Tcl/Tk's
> > wish8.3, as -offrelief, -overrelief, and -compound are unknown to
> > it.
Michael Barton wrote:
> -compound can be deleted because it is turned off anyway
ok.
> The -offrelief and -overrelief make the radio buttons in the tool bar
> look consistent with the non-radio buttons. In this sense they are
> cosmetic. However, the enormous part of the TclTk code is 'cosmetic'
> in that it gives a particular appearance to the user interface.
>
> IMHO, taking out these commands will degrade the presentation of the
> GUI somewhat in a very heavily used area (as opposed to the digitizing
> panel in the earlier issue). Is this worth making the GUI compatible
> with TclTk 8.3? I'm not sure. If this is a significant issue and the
> only one that keeps GRASS from being available to a large segment of
> the user community, it probably is worth it.
I hope the attached patches will take care of any further debate. I've
tested this with both wish8.3 and wish8.4 on Debian/Stable (sarge), and
it works as expected, but as I hope for this to be in the 6.2 release
I'd like some external conformation/feedback before applying it to the
6.2 CVS branch.
basically:
global env tk_version
if {$tk_version < 8.4} {
[...]
} else {
[...] -overrelief -offrelief
}
I generally don't like these sorts of version tests as they can get out
of control and make long term maintenance a problem, but in this case
I'm not too concerned with muddying up the TclTk GUI code slightly as
wxPython is just around the corner.
(sorry if the .diff is problematic, I'm having some connection problems
with the CVS server today)
> If it is something that affects a few people who could update their
> TclTk if they wanted to do so, then I think it is not.
"could update their TclTk if they wanted to do so"
The problem as I see it is that this is not necessarily true.
People using older systems are either doing so because a) they don't
have the technical ability to upgrade, b) they don't have administer
rights on the system to do so (mainframe), or c) they just don't want to
(compatibility with other critical software on their machine precludes
it, or it's not worth the risk/bother to damage a working system).
> The same kind of issue is already popping up with wxPython.
I think that is different, with TclTk we are taking something away which
we used to offer- backwards compatibility with older systems. With
wxPython we have never released anything that worked with an older
version, so have no duty to support that and can declare whatever
required version we want. In addition, I expect older versions of
wxPython too be much less mature than older versions of tcltk.
Also I hate to force people onto the "constant upgrade bandwagon".
Hamish
-------------- next part --------------
--- grass-6.2.0RC3/gui/tcltk/gis.m/maptool.tcl 2006-09-19 00:38:39.000000000 +1200
+++ grass63/gui/tcltk/gis.m/maptool.tcl 2006-10-29 16:48:31.000000000 +1300
@@ -20,7 +20,7 @@
proc MapToolBar::create { tb } {
global bgcolor
global mon
- global env
+ global env tk_version
global iconpath
variable toolbar
variable maptools
@@ -65,43 +65,84 @@
set sep1 [Separator $toolbar.sep1 -orient vertical -background $bgcolor ]
pack $sep1 -side left -fill y -padx 5 -anchor w
+
# DISPLAY TOOLS
- # pointer
- set pointer [radiobutton $tb.pointer \
+ # -offrelief and -overrelief only exist in Tcl8.4+
+ if {$tk_version < 8.4} {
+ # pointer
+ set pointer [radiobutton $tb.pointer \
+ -image [image create photo -file "$iconpath/gui-pointer.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::pointer $mon" \
+ -variable maptools($mon) -value pointer -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $pointer balloon [G_msg "Pointer"]
+
+ # zoom in
+ set zoomin [radiobutton $tb.zoomin \
+ -image [image create photo -file "$iconpath/gui-zoom_in.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::zoombind $mon 1" \
+ -variable maptools($mon) -value zoomin -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
+
+ #zoom out
+ set zoomout [radiobutton $tb.zoomout \
+ -image [image create photo -file "$iconpath/gui-zoom_out.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::zoombind $mon -1" \
+ -variable maptools($mon) -value zoomout -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
+
+ # pan
+ set pan [radiobutton $tb.pan \
+ -image [image create photo -file "$iconpath/gui-pan.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::panbind $mon" \
+ -variable maptools($mon) -value pan -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $pan balloon [G_msg "Pan"]
+
+ } else {
+ # pointer
+ set pointer [radiobutton $tb.pointer \
-image [image create photo -file "$iconpath/gui-pointer.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::pointer $mon" \
-variable maptools($mon) -value pointer -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $pointer balloon [G_msg "Pointer"]
+ DynamicHelp::register $pointer balloon [G_msg "Pointer"]
- # zoom in
- set zoomin [radiobutton $tb.zoomin \
+ # zoom in
+ set zoomin [radiobutton $tb.zoomin \
-image [image create photo -file "$iconpath/gui-zoom_in.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::zoombind $mon 1" \
-variable maptools($mon) -value zoomin -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
+ DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
- #zoom out
- set zoomout [radiobutton $tb.zoomout \
+ #zoom out
+ set zoomout [radiobutton $tb.zoomout \
-image [image create photo -file "$iconpath/gui-zoom_out.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::zoombind $mon -1" \
-variable maptools($mon) -value zoomout -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
+ DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
- # pan
- set pan [radiobutton $tb.pan \
+ # pan
+ set pan [radiobutton $tb.pan \
-image [image create photo -file "$iconpath/gui-pan.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::panbind $mon" \
-variable maptools($mon) -value pan -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $pan balloon [G_msg "Pan"]
+ DynamicHelp::register $pan balloon [G_msg "Pan"]
+ }
pack $pointer $zoomin $zoomout $pan -side left -anchor w
@@ -133,27 +174,21 @@
set zdimg [image create photo -file "$iconpath/gui-zoom_default.gif"]
$zoommenu add command \
- -compound top \
-label {Zoom to selected map} \
-command {MapCanvas::zoom_map $mon}
$zoommenu add command \
- -compound right \
-label {Zoom to saved region} \
-command {MapCanvas::zoom_region $mon}
$zoommenu add command \
- -compound center \
-label {Save display geometry to named region} \
-command {MapCanvas::save_region $mon}
$zoommenu add command \
- -compound center \
-label {Zoom to current region (set with g.region)} \
-command {MapCanvas::zoom_current $mon}
$zoommenu add command \
- -compound center \
-label {Zoom to default region} \
-command {MapCanvas::zoom_default $mon}
$zoommenu add command \
- -compound center \
-label {Set current region (WIND file) to match display} \
-command {MapCanvas::set_wind $mon "" 0}
@@ -166,23 +201,46 @@
set sep3 [Separator $toolbar.sep3 -orient vertical -background $bgcolor ]
pack $sep3 -side left -fill y -padx 5 -anchor w
- # query
- set query [radiobutton $tb.query \
+
+ # -offrelief and -overrelief only exist in Tcl8.4+
+ if {$tk_version < 8.4} {
+ # query
+ set query [radiobutton $tb.query \
+ -image [image create photo -file "$iconpath/gui-query.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::querybind $mon" \
+ -variable maptools($mon) -value query -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $query balloon [G_msg "Query"]
+
+ # measure
+ set measure [radiobutton $tb.measure \
+ -image [image create photo -file "$iconpath/gui-measure.gif"] \
+ -command "MapCanvas::stoptool $mon; MapCanvas::measurebind $mon"\
+ -variable maptools($mon) -value measure -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $measure balloon [G_msg "Measure"]
+
+ } else {
+ # query
+ set query [radiobutton $tb.query \
-image [image create photo -file "$iconpath/gui-query.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::querybind $mon" \
-variable maptools($mon) -value query -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $query balloon [G_msg "Query"]
+ DynamicHelp::register $query balloon [G_msg "Query"]
- # measure
- set measure [radiobutton $tb.measure \
+ # measure
+ set measure [radiobutton $tb.measure \
-image [image create photo -file "$iconpath/gui-measure.gif"] \
-command "MapCanvas::stoptool $mon; MapCanvas::measurebind $mon"\
-variable maptools($mon) -value measure -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $measure balloon [G_msg "Measure"]
+ DynamicHelp::register $measure balloon [G_msg "Measure"]
+ }
set bbox3 [ButtonBox $toolbar.bbox3 -spacing 0 ]
$bbox3 add -image [image create photo -file "$iconpath/gui-profile.gif"] \
@@ -243,29 +301,54 @@
set sep5 [Separator $toolbar.sep5 -orient vertical ]
pack $sep5 -side left -fill y -padx 5 -anchor w
+
# Render modes
- # Strict render mode
- # Uses previous resolution and exact boundaries
- set strictdraw [radiobutton $tb.strictdraw \
+ # -offrelief and -overrelief only exist in Tcl8.4+
+ if {$tk_version < 8.4} {
+ # Strict render mode
+ # Uses previous resolution and exact boundaries
+ set strictdraw [radiobutton $tb.strictdraw \
+ -command "MapCanvas::exploremode $mon 0" \
+ -variable MapToolBar::explore($mon) -value strict -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $strictdraw balloon [G_msg "Constrain map to region geometry"]
+ icon_configure $strictdraw drawmode strict
+
+ # Explore render mode
+ # Uses resolution to match display and expanded boundaries to fill display
+ set exploredraw [radiobutton $tb.strictzoom \
+ -command "MapCanvas::exploremode $mon 1" \
+ -variable MapToolBar::explore($mon) -value explore -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $exploredraw balloon [G_msg "Map fills display window"]
+ icon_configure $exploredraw drawmode explore
+
+ } else {
+ # Strict render mode
+ # Uses previous resolution and exact boundaries
+ set strictdraw [radiobutton $tb.strictdraw \
-command "MapCanvas::exploremode $mon 0" \
-variable MapToolBar::explore($mon) -value strict \
-relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $strictdraw balloon [G_msg "Constrain map to region geometry"]
- icon_configure $strictdraw drawmode strict
+ DynamicHelp::register $strictdraw balloon [G_msg "Constrain map to region geometry"]
+ icon_configure $strictdraw drawmode strict
- # Explore render mode
- # Uses resolution to match display and expanded boundaries to fill display
- set exploredraw [radiobutton $tb.strictzoom \
+ # Explore render mode
+ # Uses resolution to match display and expanded boundaries to fill display
+ set exploredraw [radiobutton $tb.strictzoom \
-command "MapCanvas::exploremode $mon 1" \
-variable MapToolBar::explore($mon) -value explore \
-relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selclr \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $exploredraw balloon [G_msg "Map fills display window"]
- icon_configure $exploredraw drawmode explore
+ DynamicHelp::register $exploredraw balloon [G_msg "Map fills display window"]
+ icon_configure $exploredraw drawmode explore
+ }
# This does not actually set the mode
# it just starts visually in sync with the default
-------------- next part --------------
--- grass-6.2.0RC3/gui/tcltk/gis.m/georecttool.tcl 2006-09-10 01:28:12.000000000 +1200
+++ grass63/gui/tcltk/gis.m/georecttool.tcl 2006-10-29 17:22:41.000000000 +1300
@@ -23,70 +23,113 @@
global gmpath
global bgcolor
global iconpath
-
+ global env tk_version
+
set selcolor #88aa88
set grmaptools "selector"
set toolbar $tb
# DISPLAY AND MONITOR SELECTION
set bbox1 [ButtonBox $toolbar.bbox1 -spacing 0 ]
-
+
# display
$bbox1 add -image [image create photo -file "$iconpath/gui-display.gif"] \
- -command "GRMap::request_redraw 1" \
- -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
- -highlightbackground $bgcolor -activebackground $bgcolor\
- -helptext [G_msg "Display active layers"]
+ -command "GRMap::request_redraw 1" \
+ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
+ -highlightbackground $bgcolor -activebackground $bgcolor\
+ -helptext [G_msg "Display active layers"]
# erase
$bbox1 add -image [image create photo -file "$iconpath/gui-erase.gif"] \
- -command "GRMap::erase" \
- -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
- -highlightbackground $bgcolor -activebackground $bgcolor\
- -helptext [G_msg "Erase to white"]
+ -command "GRMap::erase" \
+ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
+ -highlightbackground $bgcolor -activebackground $bgcolor\
+ -helptext [G_msg "Erase to white"]
pack $bbox1 -side left -anchor w
set sep1 [Separator $toolbar.sep1 -orient vertical -background $bgcolor ]
pack $sep1 -side left -fill y -padx 5 -anchor w
-
+
+
# DISPLAY TOOLS
- # selector
- set selector [radiobutton $tb.selector \
- -image [image create photo -file "$iconpath/gui-gcpset.gif"] \
- -command "GRMap::stoptool; GRMap::selector" \
+ # -offrelief and -overrelief only exist in Tcl8.4+
+ if {$tk_version < 8.4} {
+ # selector
+ set selector [radiobutton $tb.selector \
+ -image [image create photo -file "$iconpath/gui-gcpset.gif"] \
+ -command "GRMap::stoptool; GRMap::selector" \
+ -variable grmaptools -value selector -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $selector balloon [G_msg "Set ground control points"]
+
+ # zoom in
+ set zoomin [radiobutton $tb.zoomin \
+ -image [image create photo -file "$iconpath/gui-zoom_in.gif"] \
+ -command "GRMap::stoptool; GRMap::zoombind 1" \
+ -variable grmaptools -value zoomin -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
+
+ #zoom out
+ set zoomout [radiobutton $tb.zoomout \
+ -image [image create photo -file "$iconpath/gui-zoom_out.gif"] \
+ -command "GRMap::stoptool; GRMap::zoombind -1" \
+ -variable grmaptools -value zoomout -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
+
+ # pan
+ set pan [radiobutton $tb.pan \
+ -image [image create photo -file "$iconpath/gui-pan.gif"] \
+ -command "GRMap::stoptool; GRMap::panbind" \
+ -variable grmaptools -value pan -relief flat \
+ -borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
+ -activebackground $bgcolor -highlightbackground $bgcolor ]
+ DynamicHelp::register $pan balloon [G_msg "Pan"]
+
+ } else {
+ # selector
+ set selector [radiobutton $tb.selector \
+ -image [image create photo -file "$iconpath/gui-gcpset.gif"] \
+ -command "GRMap::stoptool; GRMap::selector" \
-variable grmaptools -value selector -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $selector balloon [G_msg "Set ground control points"]
+ DynamicHelp::register $selector balloon [G_msg "Set ground control points"]
- # zoom in
- set zoomin [radiobutton $tb.zoomin \
- -image [image create photo -file "$iconpath/gui-zoom_in.gif"] \
- -command "GRMap::stoptool; GRMap::zoombind 1" \
+ # zoom in
+ set zoomin [radiobutton $tb.zoomin \
+ -image [image create photo -file "$iconpath/gui-zoom_in.gif"] \
+ -command "GRMap::stoptool; GRMap::zoombind 1" \
-variable grmaptools -value zoomin -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
-
- #zoom out
- set zoomout [radiobutton $tb.zoomout \
+ DynamicHelp::register $zoomin balloon [G_msg "Zoom In"]
+
+ #zoom out
+ set zoomout [radiobutton $tb.zoomout \
-image [image create photo -file "$iconpath/gui-zoom_out.gif"] \
- -command "GRMap::stoptool; GRMap::zoombind -1" \
+ -command "GRMap::stoptool; GRMap::zoombind -1" \
-variable grmaptools -value zoomout -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
+ DynamicHelp::register $zoomout balloon [G_msg "Zoom Out"]
- # pan
- set pan [radiobutton $tb.pan \
+ # pan
+ set pan [radiobutton $tb.pan \
-image [image create photo -file "$iconpath/gui-pan.gif"] \
- -command "GRMap::stoptool; GRMap::panbind" \
+ -command "GRMap::stoptool; GRMap::panbind" \
-variable grmaptools -value pan -relief flat -offrelief flat -overrelief raised \
-borderwidth 1 -indicatoron false -bg $bgcolor -selectcolor $selcolor \
-activebackground $bgcolor -highlightbackground $bgcolor ]
- DynamicHelp::register $pan balloon [G_msg "Pan"]
+ DynamicHelp::register $pan balloon [G_msg "Pan"]
+ }
+
pack $selector $zoomin $zoomout $pan -side left -anchor w
@@ -97,17 +140,17 @@
# zoom.back
$bbox2 add -image [image create photo -file "$iconpath/gui-zoom_back.gif"] \
- -command "GRMap::zoom_back" \
- -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1\
- -highlightbackground $bgcolor -activebackground $bgcolor \
- -helptext [G_msg "Return to previous zoom"]
+ -command "GRMap::zoom_back" \
+ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1\
+ -highlightbackground $bgcolor -activebackground $bgcolor \
+ -helptext [G_msg "Return to previous zoom"]
# zoom to map
$bbox2 add -image [image create photo -file "$iconpath/gui-zoom_map.gif"] \
- -command {GRMap::zoom_map} \
- -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1\
- -highlightbackground $bgcolor -activebackground $bgcolor \
- -helptext [G_msg "Zoom to map"]
+ -command {GRMap::zoom_map} \
+ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1\
+ -highlightbackground $bgcolor -activebackground $bgcolor \
+ -helptext [G_msg "Zoom to map"]
pack $bbox2 -side left -anchor w
}
More information about the grass-dev
mailing list