[GRASS-SVN] r29646 - grass/trunk/gui/tcltk/gis.m

svn_grass at osgeo.org svn_grass at osgeo.org
Thu Jan 10 00:10:28 EST 2008


Author: cmbarton
Date: 2008-01-10 00:10:27 -0500 (Thu, 10 Jan 2008)
New Revision: 29646

Modified:
   grass/trunk/gui/tcltk/gis.m/barscale.tcl
   grass/trunk/gui/tcltk/gis.m/dtext.tcl
   grass/trunk/gui/tcltk/gis.m/gm.tcl
   grass/trunk/gui/tcltk/gis.m/gmmenu.tcl
   grass/trunk/gui/tcltk/gis.m/gmtool2.tcl
   grass/trunk/gui/tcltk/gis.m/gridline.tcl
   grass/trunk/gui/tcltk/gis.m/histogram.tcl
   grass/trunk/gui/tcltk/gis.m/thematic.tcl
   grass/trunk/gui/tcltk/gis.m/vector.tcl
Log:
Update to use new procedures library

Modified: grass/trunk/gui/tcltk/gis.m/barscale.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/barscale.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/barscale.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -131,7 +131,7 @@
 	if {$GmBarscale::opt($id,1,font) != "" } {
 		set Gm::dfont $GmBarscale::opt($id,1,font)
 	}
-	Gm:DefaultFont dbarscale
+	Gm::defaultfont dbarscale
 	tkwait variable Gm::dfont
 	set GmBarscale::opt($id,1,font) $Gm::dfont
 	set Gm::dfont ""
@@ -288,8 +288,8 @@
     if {$mod} {set opt($id,1,mod) 1}
 
     # set hex colors to rgb         
-    set tcolor [Gm::color $opt($id,1,tcolor)]
-    set bcolor [Gm::color $opt($id,1,bcolor)]
+    set tcolor [GmLib::color $opt($id,1,tcolor)]
+    set bcolor [GmLib::color $opt($id,1,bcolor)]
 
     # no background color
     if { $opt($id,1,bcolor_none) == 1 } { 

Modified: grass/trunk/gui/tcltk/gis.m/dtext.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/dtext.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/dtext.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -114,7 +114,7 @@
 	if {$GmDtext::opt($id,1,font) != "" } {
 		set Gm::dfont $GmDtext::opt($id,1,font)
 	}
-	Gm:DefaultFont dtext
+	Gm::defaultfont dtext
 	tkwait variable Gm::dfont
 	set GmDtext::opt($id,1,font) $Gm::dfont
 	set Gm::dfont ""
@@ -280,7 +280,7 @@
     if {$mod} {set opt($id,1,mod) 1}
 
     # set hex colors to rgb         
-    set color [Gm::color $opt($id,1,color)]
+    set color [GmLib::color $opt($id,1,color)]
     
 
     if { ! ( $opt($id,1,_check) ) } { return } 

Modified: grass/trunk/gui/tcltk/gis.m/gm.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/gm.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/gm.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -28,28 +28,32 @@
 lappend auto_path $env(GISBASE)/etc/gm
 package require -exact GisM 1.0
 
+# path to GIS Manager files
+set gmpath $env(GISBASE)/etc/gm
+
+# Load common procedure library
+source $gmpath/gmlib.tcl
+
 if {[catch {set env(GISDBASE) [exec g.gisenv get=GISDBASE]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 if {[catch {set env(LOCATION_NAME) [exec g.gisenv get=LOCATION_NAME]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 if {[catch {set env(MAPSET) [exec g.gisenv get=MAPSET]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 
 if {[catch {set gisdbase [exec g.gisenv get=GISDBASE]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 if {[catch {set location_name [exec g.gisenv get=LOCATION_NAME]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 if {[catch {set mapset [exec g.gisenv get=MAPSET]} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 
-# path to GIS Manager files
-set gmpath $env(GISBASE)/etc/gm
 
 # path to icons for GIS Manager
 set iconpath $env(GISBASE)/etc/gui/icons
@@ -100,7 +104,7 @@
 set GRASSVERSION [read -nonewline $fp]
 
 if {[catch {close $fp} error]} {
-	GmLib::errmsg $error
+	Gm::errmsg $error
 }
 
 
@@ -115,16 +119,16 @@
 source $gmpath/runandoutput.tcl
 
 namespace eval Gm {
-    variable gm_mainframe
-    variable status
-    variable array tree # mon
-    variable rcfile
-    variable moncount
-    variable prgtext
-    variable mainwindow
-    variable dfont 
-    variable selectedfont
-    variable encoding
+	variable gm_mainframe
+	variable status
+	variable array tree # mon
+	variable rcfile
+	variable moncount
+	variable prgtext
+	variable mainwindow
+	variable dfont 
+	variable selectedfont
+	variable encoding
 	global array filename # mon
 
 }
@@ -136,30 +140,11 @@
 
 set max_prgindic 20
 
-
-###############################################################################
-
 append regexp .* $env(GISBASE) {[^:]*}
 regsub -- $regexp $env(PATH) "&:$env(GISBASE)/etc/gui/scripts" env(PATH)
 
 
 ###############################################################################
-
-#read_moncap
-
-proc Gm::color { color } {
-
-    regexp -- {#(..)(..)(..)} $color x r g b
-
-    set r [expr 0x$r ]
-    set g [expr 0x$g ]
-    set b [expr 0x$b ]
-
-    return "$r:$g:$b"
-}
-
-
-###############################################################################
 # Deprecated
 # Use guarantee_xmon and any run command instead.
 
@@ -176,101 +161,89 @@
 }
 
 ###############################################################################
-# Determine if an element already exists
 
-proc Gm::element_exists {elem name} {
-	global devnull
-	set exists 1
-	
-	set failure [catch {exec g.findfile element=$elem file=$name >& $devnull}]
 
-	return [expr {! $failure}]
-}
-
-###############################################################################
-
-
 proc Gm::create { } {
-    variable mainwindow
-    variable prgtext
-    variable gm_mainframe
-    variable tree
+	variable mainwindow
+	variable prgtext
+	variable gm_mainframe
+	variable tree
 	variable moncount
 	variable dfont
 	variable ecoding
-    global gmpath
-    global mon
-    global tree_pane
-    global options
-    global pgs
-    global prgindic
-    global keycontrol
-    global env
-    
-    # set display rendering environment for PNG/PPM output
-    set env(GRASS_RENDER_IMMEDIATE) "TRUE"
-    
-    # set default font
-    if {[catch {set env(GRASS_FONT)}]} {set env(GRASS_FONT) "romans"}
+	global gmpath
+	global mon
+	global tree_pane
+	global options
+	global pgs
+	global prgindic
+	global keycontrol
+	global env
+	
+	# set display rendering environment for PNG/PPM output
+	set env(GRASS_RENDER_IMMEDIATE) "TRUE"
+	
+	# set default font
+	if {[catch {set env(GRASS_FONT)}]} {set env(GRASS_FONT) "romans"}
 	set Gm::dfont ""
 	set Gm::encoding "ISO-8859-1"
 
 	set moncount 1
 
-    set Gm::prgtext [G_msg "Loading GIS Manager"]
-    set prgindic -1
-    _create_intro
-    update
+	set Gm::prgtext [G_msg "Loading GIS Manager"]
+	set prgindic -1
+	_create_intro
+	update
 
 	source $gmpath/gmmenu.tcl
 
-    set Gm::prgtext [G_msg "Creating MainFrame..."]
-
-    set gm_mainframe [MainFrame .mainframe \
+	set Gm::prgtext [G_msg "Creating MainFrame..."]
+    
+	set gm_mainframe [MainFrame .mainframe \
 		       -menu $descmenu \
 		       -textvariable Gm::status \
 		       -progressvar  Gm::prgindic ]
 
-    set mainwindow [$gm_mainframe getframe]
+	set mainwindow [$gm_mainframe getframe]
+    
+	# toolbar 1 & 2 creation
+	set tb1  [$gm_mainframe addtoolbar]
+	GmToolBar1::create $tb1
+	set tb2  [$gm_mainframe addtoolbar]
+	GmToolBar2::create $tb2
+	set pw1 [PanedWindow $mainwindow.pw1 -side left -pad 0 -width 10 ]
+    
+	# tree
+	set treemon [expr {$mon + 1}]
+	set tree_pane  [$pw1 add  -minsize 50 -weight 1]
+	    set pgs [PagesManager $tree_pane.pgs]
+    
+    
+	    pack $pgs -expand yes -fill both
+    
+    
+	# options
+	set options_pane  [$pw1 add -minsize 50 -weight 1]
+	set options_sw [ScrolledWindow $options_pane.sw -relief flat -borderwidth 1]
+	set options_sf [ScrollableFrame $options_sw.sf]
+	$options_sf configure -height 145 -width 460
+	$options_sw setwidget $options_sf
+	set options [$options_sf getframe]
+	pack $options_sw -fill both -expand yes
+    
+	# Scroll the options window with the mouse
+	bind_scroll $options_sf
+    
+	pack $pw1 -side top -expand yes -fill both -anchor n
+    
+	    # finish up
+	set Gm::prgtext [G_msg "Done"]
+    
+	set Gm::status [G_msg "Welcome to GRASS GIS"]
+	$gm_mainframe showstatusbar status
+    
+	pack $gm_mainframe -fill both -expand yes
 
-    # toolbar 1 & 2 creation
-    set tb1  [$gm_mainframe addtoolbar]
-    GmToolBar1::create $tb1
-    set tb2  [$gm_mainframe addtoolbar]
-    GmToolBar2::create $tb2
-    set pw1 [PanedWindow $mainwindow.pw1 -side left -pad 0 -width 10 ]
-
-    # tree
-    set treemon [expr {$mon + 1}]
-    set tree_pane  [$pw1 add  -minsize 50 -weight 1]
-	set pgs [PagesManager $tree_pane.pgs]
-
-
-	pack $pgs -expand yes -fill both
-
-
-    # options
-    set options_pane  [$pw1 add -minsize 50 -weight 1]
-    set options_sw [ScrolledWindow $options_pane.sw -relief flat -borderwidth 1]
-    set options_sf [ScrollableFrame $options_sw.sf]
-    $options_sf configure -height 145 -width 460
-    $options_sw setwidget $options_sf
-    set options [$options_sf getframe]
-    pack $options_sw -fill both -expand yes
-
-    # Scroll the options window with the mouse
-    bind_scroll $options_sf
-
-    pack $pw1 -side top -expand yes -fill both -anchor n
-
-	# finish up
-    set Gm::prgtext [G_msg "Done"]
-
-    set Gm::status [G_msg "Welcome to GRASS GIS"]
-    $gm_mainframe showstatusbar status
-
-    pack $gm_mainframe -fill both -expand yes
-
 	Gm::startmon
 
 	bind .mainframe <Destroy> {
@@ -387,59 +360,8 @@
 }
 
 ###############################################################################
-
-#open dialog box
-proc Gm::OpenFileBox { } {
-    variable mainwindow
-    global filename
-    global mon
-
-# thanks for brace tip to suchenwi from #tcl at freenode
-    set types [list \
-	    [list [G_msg "Map Resource File"] [list ".dm" ".dmrc" ".grc"]] \
-	    [list [G_msg "All Files"] "*"] \
-    ]
-
-	set filename_new [tk_getOpenFile -parent $mainwindow -filetypes $types \
-		-title [G_msg "Open File"] ]
-	if { $filename_new == "" } { return}
-	set filename($mon) $filename_new
-	GmTree::load $filename($mon)
-
-};
-
-###############################################################################
-
-#save dialog box
-proc Gm::SaveFileBox { } {
-    variable mainwindow
-    global filename
-    global mon
-
-    catch {
-        if {[ regexp -- {^Untitled_} $filename($mon) r]} {
-            set filename($mon) ""
-        }
-    }
-
-    if { $filename($mon) != "" } {
-    	GmTree::save $filename($mon)
-    } else {
-        set types [list \
-            [list [G_msg "Map Resource File"] {.grc}] \
-            [list [G_msg "DM Resource File"] [list {.dm} {.dmrc}]] \
-            [list [G_msg "All Files"] "*"] \
-        ]
-        set filename($mon) [tk_getSaveFile -parent $mainwindow -filetypes $types \
-            -title [G_msg "Save File"] -defaultextension .grc]
-	    if { $filename($mon) == "" } { return}
-	    GmTree::save $filename($mon)
-    }
-};
-
-###############################################################################
 # sets default display font
-proc Gm:DefaultFont { source } {
+proc Gm::defaultfont { source } {
 	global env iconpath
 	variable dfont
 	variable selectedfont
@@ -452,7 +374,7 @@
     wm title .dispfont [G_msg "Select GRASS display font"]
     
     if {[catch {set fontlist [exec d.font --q -l]} error]} {
-	    GmLib::errmsg $error "d.font error"
+	    Gm::errmsg $error "d.font error"
     }
     set fontlist [string trim $fontlist]
     set fontlist [split $fontlist "\n"]
@@ -502,7 +424,7 @@
     
 	set row [ frame .dispfont.buttons ]
 	Button $row.ok -text [G_msg "OK"] -width 8 -bd 1 \
-			-command "Gm::SetFont $source; destroy .dispfont"
+			-command "Gm::setfont $source; destroy .dispfont"
     pack $row.ok -side left -fill x -expand 0
     button $row.cancel -text [G_msg "Cancel"] -width 8 -bd 1 \
     	-command "destroy .dispfont"
@@ -516,7 +438,7 @@
 };
 
 
-proc Gm::SetFont { source } {
+proc Gm::setfont { source } {
 	global env
 	variable dfont
 	variable selectedfont
@@ -529,7 +451,7 @@
 		set env(GRASS_ENCODING) $encoding
 	}
 
-    set dfont $selectedfont
+	set dfont $selectedfont
     
 	if { $source == "menu" && $dfont != "" } {
 		set env(GRASS_FONT) $dfont
@@ -540,24 +462,6 @@
 
 ###############################################################################
 
-proc Gm::errmsg { error args } {
-    # send error report and optional message (args) to tk_messageBox
-    
-    set message ""
-    
-    if { $args != ""} { 
-        set message [join $args]
-        append message ": " 
-     }
-
-    tk_messageBox -type ok -icon error -title [G_msg "Error"] \
-        -message "$message[G_msg $error]"
-    uplevel 1 return
-     
-};
-
-###############################################################################
-
 proc Gm::cleanup { } {
 	global mon
 	global tmpdir

Modified: grass/trunk/gui/tcltk/gis.m/gmmenu.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/gmmenu.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/gmmenu.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -84,9 +84,9 @@
 set descmenu [subst  {
  {[G_msg "&File"]} all file $tmenu {
 	{cascad {[G_msg "Workspace"]} {} "" $tmenu {			
-		{command {[G_msg "Open..."]} {} "Open gis.m workspace file" {} -accelerator $keyctrl-O -command { Gm::OpenFileBox }}
-		{command {[G_msg "Save"]} {} "Save gis.m workspace file" {} -accelerator $keyctrl-S -command { Gm::SaveFileBox }}
-		{command {[G_msg "Save as..."]} {} "Save gis.m workspace file as new name" {} -command { set filename($mon) "" ; Gm::SaveFileBox }}
+		{command {[G_msg "Open..."]} {} "Open gis.m workspace file" {} -accelerator $keyctrl-O -command { GmLib::OpenFileBox }}
+		{command {[G_msg "Save"]} {} "Save gis.m workspace file" {} -accelerator $keyctrl-S -command { GmLib::SaveFileBox }}
+		{command {[G_msg "Save as..."]} {} "Save gis.m workspace file as new name" {} -command { set filename($mon) "" ; GmLib::SaveFileBox }}
 		{command {[G_msg "Close"]} {} "Close gis.m workspace" {} -accelerator $keyctrl-W -command { GmTree::FileClose {}}}
 	}}
 	{separator}
@@ -217,7 +217,7 @@
 		{separator}
 		{command {[G_msg "Convert coordinates"]} {} "m.proj: Convert coordinates from one projection to another" {} -command {execute m.proj }}
 	}}
-	{command {[G_msg "Display font"]} {} "Set default display font" {} -command {Gm:DefaultFont "menu" }}
+	{command {[G_msg "Display font"]} {} "Set default display font" {} -command {Gm::defaultfont "menu" }}
  } 
  {[G_msg "&Raster"]} all options $tmenu {
 	{cascad {[G_msg "Develop map"]} {} "" $tmenu {			

Modified: grass/trunk/gui/tcltk/gis.m/gmtool2.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/gmtool2.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/gmtool2.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -84,13 +84,13 @@
         -helptext [G_msg "Create new workspace file (erase current workspace settings first)"]
 
     $bbox3 add -image [image create photo -file "$iconpath/file-open.gif"] \
-    	-command "Gm::OpenFileBox"\
+    	-command "GmLib::OpenFileBox"\
         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 \
         -highlightbackground $bgcolor -activebackground $bgcolor \
         -helptext [G_msg "Open existing workspace file"]
 
     $bbox3 add -image [image create photo -file "$iconpath/file-save.gif"]  \
-    	-command "Gm::SaveFileBox"\
+    	-command "GmLib::SaveFileBox"\
         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1  \
         -highlightbackground $bgcolor -activebackground $bgcolor \
         -helptext [G_msg "Save workspace file"]

Modified: grass/trunk/gui/tcltk/gis.m/gridline.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/gridline.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/gridline.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -120,7 +120,7 @@
 	if {$GmGridline::opt($id,1,font) != "" } {
 		set Gm::dfont $GmGridline::opt($id,1,font)
 	}
-	Gm:DefaultFont dgrid
+	Gm::defaultfont dgrid
 	tkwait variable Gm::dfont
 	set GmGridline::opt($id,1,font) $Gm::dfont
 	set Gm::dfont ""
@@ -299,9 +299,9 @@
     if { ! ( $opt($id,1,_check) ) } { return } 
     
     # set hex colors to rgb         
-    set gridcolor [Gm::color $opt($id,1,gridcolor)]
-    set gridborder [Gm::color $opt($id,1,gridborder)]
-    set txtcolor [Gm::color $opt($id,1,textcolor)]
+    set gridcolor [GmLib::color $opt($id,1,gridcolor)]
+    set gridborder [GmLib::color $opt($id,1,gridborder)]
+    set txtcolor [GmLib::color $opt($id,1,textcolor)]
 
     
     # d.grid command

Modified: grass/trunk/gui/tcltk/gis.m/histogram.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/histogram.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/histogram.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -118,7 +118,7 @@
 	if {$GmHist::opt($id,1,font) != "" } {
 		set Gm::dfont $GmHist::opt($id,1,font)
 	}
-	Gm:DefaultFont dhist
+	Gm::defaultfont dhist
 	tkwait variable Gm::dfont
 	set GmHist::opt($id,1,font) $Gm::dfont
 	set Gm::dfont ""
@@ -239,8 +239,8 @@
 
     if { $opt($id,1,map) == "" } { return } 
     
-	set color [Gm::color $opt($id,1,color)]
-    set bgcolor [Gm::color $opt($id,1,bgcolor)]
+	set color [GmLib::color $opt($id,1,color)]
+    set bgcolor [GmLib::color $opt($id,1,bgcolor)]
 
     # transparent background color
     if { $opt($id,1,bgcolor_none) == 1 } { 

Modified: grass/trunk/gui/tcltk/gis.m/thematic.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/thematic.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/thematic.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -484,10 +484,10 @@
     if { $opt($id,1,column) == "" } { return }
 
     # set hex colors to rgb         
-    set pointcolor [Gm::color $opt($id,1,pointcolor)]
-    set linecolor [Gm::color $opt($id,1,linecolor)]
-    set startcolor [Gm::color $opt($id,1,startcolor)]
-    set endcolor [Gm::color $opt($id,1,endcolor)]
+    set pointcolor [GmLib::color $opt($id,1,pointcolor)]
+    set linecolor [GmLib::color $opt($id,1,linecolor)]
+    set startcolor [GmLib::color $opt($id,1,startcolor)]
+    set endcolor [GmLib::color $opt($id,1,endcolor)]
     
     # turn off x11 display
     set monitor "none"

Modified: grass/trunk/gui/tcltk/gis.m/vector.tcl
===================================================================
--- grass/trunk/gui/tcltk/gis.m/vector.tcl	2008-01-10 05:09:09 UTC (rev 29645)
+++ grass/trunk/gui/tcltk/gis.m/vector.tcl	2008-01-10 05:10:27 UTC (rev 29646)
@@ -627,9 +627,9 @@
     # color
     if { $opt($id,1,rdmcolor) } { append cmd " -c" }
     if { $opt($id,1,sqlcolor) } { append cmd " -a" }
-    set color [Gm::color $opt($id,1,color)]
-    set fcolor [Gm::color $opt($id,1,fcolor)]
-    set lcolor [Gm::color $opt($id,1,lcolor)]
+    set color [GmLib::color $opt($id,1,color)]
+    set fcolor [GmLib::color $opt($id,1,fcolor)]
+    set lcolor [GmLib::color $opt($id,1,lcolor)]
 
     if { $opt($id,1,_use_color) } { append cmd " color=$color" } { append cmd " color=none" }
     append cmd " lcolor=$lcolor" 
@@ -739,7 +739,7 @@
 
     if { $opt($id,1,vect) == "" } { return } 
     
-    if {[Gm::element_exists "vector" $opt($id,1,vect)]} {
+    if {[GmLib::element_exists "vector" $opt($id,1,vect)]} {
         set cmd [list v.digit "map=$opt($id,1,vect)"]
     } else { 
         set cmd [list v.digit -n "map=$opt($id,1,vect)"]



More information about the grass-commit mailing list