[GRASS-SVN] r33672 - grass/branches/develbranch_6/gui/tcltk/gis.m

[svn_grass at osgeo.org]

Author: pkelly
Date: 2008-10-04 15:33:16 -0400 (Sat, 04 Oct 2008)
New Revision: 33672

Modified:
   grass/branches/develbranch_6/gui/tcltk/gis.m/gm.tcl
Log:
Display font full/pretty name instead of filename in selection dialog.
Especially important on Windows where most font filenames are in 8.3 format.


Modified: grass/branches/develbranch_6/gui/tcltk/gis.m/gm.tcl
===================================================================
--- grass/branches/develbranch_6/gui/tcltk/gis.m/gm.tcl	2008-10-04 16:23:02 UTC (rev 33671)
+++ grass/branches/develbranch_6/gui/tcltk/gis.m/gm.tcl	2008-10-04 19:33:16 UTC (rev 33672)
@@ -383,6 +383,7 @@
 # sets default display font
 proc Gm::defaultfont { source } {
 	global env iconpath
+	global fontlist
 	variable dfont
 	variable selectedfont
 	variable encoding
@@ -393,12 +394,16 @@
     toplevel .dispfont
     wm title .dispfont [G_msg "Select GRASS display font"]
     
-    if {[catch {set fontlist [exec d.font --q -l]} error]} {
+    if {[catch {set rawlist [exec d.font --q -L]} error]} {
 	    GmLib::errmsg $error "d.font error"
     }
-    set fontlist [string trim $fontlist]
-    set fontlist [split $fontlist "\n"]
-    set fontlist [lsort -unique $fontlist]
+    set rawlist [split $rawlist "\n"]
+    foreach item $rawlist {
+	set fontinfo [split $item "|"]
+	lappend fontlist $fontinfo
+    }
+    # Case-insensitive search on font long name, removing duplicates
+    set fontlist [lsort -dictionary -unique -index 1 $fontlist]
    
     set row [ frame .dispfont.fontlb ]
     Label $row.a -text [G_msg "Font: "] 
@@ -410,7 +415,7 @@
     	-relief {sunken}
 
     foreach item $fontlist {
-    	$fontlb insert end $item
+    	$fontlb insert end [lindex $item 1]
     }
     # If $Gm::dfont is empty then it hasn't been set by a layer module
     # before calling this procedure, so we should read the current
@@ -423,10 +428,14 @@
     set selectedfont $Gm::dfont
      
     if {$Gm::dfont != ""} {
-    	set fontindex [lsearch $fontlist $Gm::dfont]
-    	if {$fontindex > -1} {
+	set fontindex 0
+	foreach item $fontlist {
+	    if { $Gm::dfont eq [lindex $item 0] } {
     		$fontlb selection set $fontindex
     		$fontlb see $fontindex
+		break
+	    }
+	    incr fontindex
     	}
     }
 
@@ -452,7 +461,7 @@
     pack $row -side bottom -pady 3  -padx 5 -expand 0 -fill x 
     
     bind $fontlb <<ListboxSelect>> {
-    	set Gm::selectedfont [%W get [%W curselection]]
+    	set Gm::selectedfont [lindex [lindex $fontlist [%W curselection]] 0]
     }   
     
 };