remove gtcltk library (no TCL/TK dependency in G7)

git-svn-id: https://svn.osgeo.org/grass/grass/trunk@53752 15284696-431f-4ddb-bdfa-cd5b030d7da7

lib/Makefile

@@ -21,7 +21,6 @@ SUBDIRS = \
 	display \
 	db \
 	fonts \
-	gtcltk \
 	proj \
 	vector \
 	imagery \

lib/gtcltk/Makefile

@@ -1,17 +0,0 @@
-MODULE_TOPDIR = ../..
-
-PGM=grocat
-include $(MODULE_TOPDIR)/include/Make/Etc.make
-include $(MODULE_TOPDIR)/include/Make/NoHtml.make
-
-TCLSRC := $(wildcard *.tcl)
-TCLDST := $(patsubst %.tcl,$(ETC)/gtcltk/%.tcl,$(TCLSRC))
-
-default: etc $(TCLDST)
-
-$(ETC)/gtcltk/%.tcl: %.tcl | $(ETC)/gtcltk
-	$(INSTALL_DATA) $< $@
-
-$(ETC)/gtcltk:
-	$(MKDIR) $@
-

lib/gtcltk/gmsg.tcl

@@ -1,27 +0,0 @@
-#############################################################################
-#
-# gmsg.tcl
-#
-# MODULE:   	Grass Tcl/Tk I18n wrapper
-# AUTHOR(S):	Alex Shevlakov alex@motivation.ru
-# PURPOSE:  	I18N Tcl-Tk based GUI text strings wrapper procedure
-#
-# COPYRIGHT:    (C) 2000 by the GRASS Development Team
-#
-#               This program is free software under the GNU General Public
-#   	    	License (>=v2). Read the file COPYING that comes with GRASS
-#   	    	for details.
-#
-#############################################################################
-
-
-if [catch {package require msgcat}] {
-	proc G_msg {message} {
-		return $message
-	}
-} else {
-	::msgcat::mcload $env(GISBASE)/etc/msgs
-	proc G_msg {message} {
-		return [::msgcat::mc $message]
-	}
-}

lib/gtcltk/grocat.c

@@ -1,50 +0,0 @@
-
-/****************************************************************************
- *
- * MODULE:       grocat
- * AUTHOR(S):    Paul Kelly
- * PURPOSE:      Copies stdin to stdout in line-buffered mode until end
- *               of file is received.
- *               Used with Tcl/Tk gronsole system to merge stdout and
- *               stderr streams to be caught by Tcl "open" command.
- * COPYRIGHT:    (C) 2006 by the GRASS Development Team
- *
- *               This program is free software under the GNU General Public
- *               License (>=v2). Read the file COPYING that comes with GRASS
- *               for details.
- *
- *****************************************************************************/
-
-#include <stdio.h>
-#include <stdlib.h>
-
-int main(void)
-{
-    int inchar, outchar;
-    char inbuff[1024], outbuff[1024];
-
-    /* stdin and stdout both line-buffered */
-    if (setvbuf(stdin, inbuff, _IOLBF, sizeof(inbuff))) {
-	fprintf(stderr, "grocat: Can't set stdin to line-buffered mode!\n");
-	exit(EXIT_FAILURE);
-    }
-    if (setvbuf(stdout, outbuff, _IOLBF, sizeof(outbuff))) {
-	fprintf(stderr, "grocat: Can't set stdout to line-buffered mode!\n");
-	exit(EXIT_FAILURE);
-    }
-
-    while ((inchar = getc(stdin)) != EOF) {
-	/* Read a character at a time from stdin until EOF
-	 * and copy to stdout */
-	outchar = putc(inchar, stdout);
-	if (outchar != inchar) {
-	    fprintf(stderr, "grocat: Error writing to stdout!\n");
-	    exit(EXIT_FAILURE);
-	}
-    }
-
-    /* Flush in case last line wasn't terminated properly or something */
-    fflush(stdout);
-
-    exit(EXIT_SUCCESS);
-}

lib/gtcltk/gronsole.tcl

@@ -1,540 +0,0 @@
-
-############################################################################
-#
-# LIBRARY:      Gronsole program run and output widget
-# AUTHOR(S):    Cedric Shock (cedricgrass AT shockfamily.net)
-#               Based on lib/gis/gui.tcl
-# PURPOSE:      Runs programs, displays output
-# COPYRIGHT:    (C) 2006 Grass Development Team
-#
-#               This program is free software under the GNU General Public
-#               License (>=v2). Read the file COPYING that comes with GRASS
-#               for details.
-#
-#############################################################################
-
-namespace eval Gronsole {
-	variable _data
-	variable _options
-
-	set _options [list [list -clickcmd clickCmd ClickCmd {} {}]]
-
-	proc ::Gronsole { path args } { return [eval Gronsole::create $path $args] }
-	proc use {} {}
-}
-
-proc Gronsole::dooptions {path args init} {
-	variable _data
-	variable _options
-	
-	foreach opt $_options {
-		set sw [lindex $opt 0]
-		set db [lindex $opt 1]
-		set def [lindex $opt 4]
-		if {[set idx [lsearch -exact $args $sw]] != -1} {
-			set _data($path,$db) [lindex $args [expr $idx + 1]]
-			set args [concat [lrange $args 0 [expr $idx - 1]] [lrange $args [expr $idx + 2] end]]
-		} elseif {$init} {
-			set _data($path,$db) $def
-		}
-	}
-}
-
-proc Gronsole::create {path args} {
-	global keycontrol
-	global bgcolor
-	variable _data
-
-	set args [Gronsole::dooptions $path $args 1]
-
-	set gronsolewin [ScrolledWindow $path -relief flat -borderwidth 1 -auto horizontal]
-	set gronsole [eval text $gronsolewin.text $args]
-	$gronsolewin setwidget $gronsole	
-
-
-	set _data($path,count) 0
-
-	bind $path.text <Destroy>   "Gronsole::_destroy $path"
-	bind $path.text <$keycontrol-c> "tk_textCopy %W"
-	bind $path.text <$keycontrol-v> "tk_textPaste %W"
-	bind $path.text <$keycontrol-x> "tk_textCut %W"
-
-	rename $path ::$path:scrollwin
-	proc ::$path { cmd args } "return \[eval Gronsole::\$cmd $path \$args\]"
-	return $path
-}
-
-proc Gronsole::configure { path args } {
-	variable _options
-	variable _data
-	if {$args == {}} {
-		set res {}
-		foreach opt $_options {
-			set sw [lindex $opt 0]
-			set db [lindex $opt 1]
-			set title [lindex $opt 2]
-			lappend res [list $sw $db $title $_data($path,$db) $_data($path,$db)]
-		}
-		return [concat $res [$path.text configure]]
-	}
-
-	set args [Gronsole::dooptions $path $args 0]
-	
-	$path.text configure $args
-
-	return
-}
-
-
-proc Gronsole::cget { path option } {
-    variable _options
-    variable _data
-    if {[lsearch -exact $_options $option] != -1} {
-        set res $_data($path,$option)
-    } else {
-        set res [$path.text cget $option]
-    }
-    return $res
-}
-
-proc Gronsole::_destroy { path } {
-    variable _data
-
-    array unset _data "$path,*"
-
-    catch {rename $path {}}
-}
-
-##########################################################################
-# Public contents management
-
-proc Gronsole::clear {path} {
-	variable _data
-
-	$path.text delete 1.0 end
-}
-
-
-# save text in output window
-proc Gronsole::save {path} {
-	global env
-
-	set dtxt $path.text
-
-	if ![catch {$dtxt get sel.first}] {
-		set svtxt [$dtxt get sel.first sel.last]
-	} else {
-		set svtxt [$dtxt get 1.0 end]
-	} 
-	
-	set types {
-     {{TXT} {.txt}}
-	}
-
-	if { [info exists HOME] } {
-		set dir $env(HOME)
-		set path [tk_getSaveFile -initialdir $dir -filetypes $types \
-			-defaultextension ".txt"]
-	} else {
-		set path [tk_getSaveFile -filetypes $types \
-			-defaultextension ".txt"]
-	}
-
-	if { $path == "" } { return }
-
-	set txtfile [open $path w]
-	puts $txtfile $svtxt
-	close $txtfile
-	return
-}
-
-proc Gronsole::destroy_command {path ci} {
-	variable _data
-
-	catch {close $_data($path,$ci,fh)} 
-
-	if {[info exists _data($path,$ci,donecmd)] && $_data($path,$ci,donecmd) != {}} {
-		eval $_data($path,$ci,donecmd)
-	}
-
-	set textarea $path.text
-	set frame $_data($path,$ci,frame)
-
-	set indices [$textarea tag ranges cmd$ci]
-
-	eval $textarea delete $indices
-
-	destroy $frame
-
-	array unset _data "$path,$ci,*"
-}
-
-##########################################################################
-# Private
-
-proc Gronsole::do_click {path ci} {
-	variable _data
-
-	# Use this commands click command if it exists
-	if {[info exists _data($path,$ci,clickCmd)]} {
-		set cc $_data($path,$ci,clickCmd)
-	} else {
-		set cc $_data($path,clickCmd)
-	}
-	if {$cc != {}} {
-		eval $cc $ci [list $_data($path,$ci,cmd)]
-	}
-}
-
-proc Gronsole::create_command {path cmd} {
-	variable _data
-	set textarea $path.text
-
-	incr _data($path,count)
-	set ci $_data($path,count)
-	set _data($path,$ci,cmd) $cmd
-	
-	set module [lindex $cmd 0]
-	set icon [icon module $module]
-
-	set frame $textarea.cmd$ci
-
-	set _data($path,$ci,frame) $frame
-	
-	frame $frame 
-	frame $frame.cmdline
-	set tagframe [frame $frame.cmdline.tags]
-	set cmdlabel [label $frame.cmdline.cmd -textvariable Gronsole::_data($path,$ci,cmd) -anchor nw]
-	bind $cmdlabel <Button-1> "Gronsole::do_click $path $ci"
-	# set cmdlabel [text $frame.cmdline.cmd -height 1 -width 10]
-	# $cmdlabel insert end $cmd
-	set ex [button $frame.cmdline.eX -text "X" -command "Gronsole::destroy_command $path $ci"]
-	pack $ex -side right
-	pack $frame.cmdline.tags -side right
-	set iconwidth ""
-	if {$icon != 0} {
-		set iconwidth " - \[winfo width $frame.cmdline.icon\]"
-		button $frame.cmdline.icon -image $icon -anchor n -command "Gronsole::do_click $path $ci"
-		pack $frame.cmdline.icon -side left
-	}
-	pack $frame.cmdline.cmd -side left -expand yes -fill x
-	pack $frame.cmdline -side top -expand yes -fill x
-	set pbar [ProgressBar $frame.progress -fg green -bg white -height 20 -relief raised \
-		-maximum 100 -variable Gronsole::_data($path,$ci,progress)] 
-	pack $pbar -side left
-	set _data($path,$ci,progress) -1
-	set _data($path,$ci,progressbar) $pbar
-	set _data($path,$ci,tags) {}
-
-	$textarea insert end "\n" [list cmd$ci e1]
-	$textarea insert end "\n" [list cmd$ci e2]
-	$textarea mark set cmdinsert$ci "end - 2 char"
-
-	$textarea window create cmdinsert$ci -window $frame
-	$textarea tag add cmd$ci $frame
-	$textarea insert cmdinsert$ci "$cmd\n" [list cmd$ci e2]
-	# $textarea tag add cmd$ci "cmdinsert$ci - 1 char"
-	# $textarea tag add e2 "cmdinsert$ci - 1 char"
-
-	$textarea tag configure e1 -elide 1
-	$textarea tag configure e2 -elide 1
-
-
-	set pspace 12
-	$pbar configure -width [expr [winfo width $textarea] - $pspace]
-#	$pbar configure -width [expr [winfo width $textarea] - $pspace] -height 20
-
-	bind $textarea <Configure> "+catch {$pbar configure -width \[expr \[winfo width $textarea\] - $pspace\]}"
-
-
-	bind $textarea <Configure> "+catch {$cmdlabel configure -wraplength \[expr \[winfo width $textarea\] - $pspace - \[winfo width $tagframe\] - \[winfo width $ex\] $iconwidth\]}"
-
-	# bind $cmdlabel <Configure> "$cmdlabel configure -wraplength \[winfo width $cmdlabel\]"
-
-	return $ci
-}
-
-##########################################################################
-# Public tag management. add_data_tag is private
-
-proc Gronsole::set_click_command {path ci cmd} {
-	variable _data
-	set _data($path,$ci,clickCmd) $cmd
-}
-
-proc Gronsole::show_hide_tag_data {path ci tag} {
-	variable _data
-	set textarea $path.text
-	
-	set e [$textarea tag cget cmd$ci-$tag -elide]
-	if {$e == {}} {
-		$textarea tag configure cmd$ci-$tag -elide 1
-	} else {
-		$textarea tag configure cmd$ci-$tag -elide {}
-	}
-}
-
-proc Gronsole::add_tag {path ci tag} {
-	variable _data
-	set textarea $path.text
-	set frame $_data($path,$ci,frame)
-	if {[lsearch -exact $_data($path,$ci,tags) $tag] != -1} {
-		return
-	}
-	lappend _data($path,$ci,tags) $tag
-	button $frame.cmdline.tags.tag$tag -text $tag -relief flat
-	set icon [icon status $tag]
-	if {$icon != 0} {
-		$frame.cmdline.tags.tag$tag configure -image $icon
-	}
-	pack $frame.cmdline.tags.tag$tag -side right
-}
-
-# This is private:
-proc Gronsole::add_data_tag {path ci tag} {
-	variable _data
-	set textarea $path.text
-	set frame $_data($path,$ci,frame)
-	if {[lsearch -exact $_data($path,$ci,tags) $tag] != -1} {
-		return
-	}
-	Gronsole::add_tag $path $ci $tag
-	$frame.cmdline.tags.tag$tag configure -relief raised -command "Gronsole::show_hide_tag_data $path $ci $tag"
-}
-
-proc Gronsole::remove_tag {path ci tag} {
-	variable _data
-	set frame $_data($path,$ci,frame)
-	pack forget $frame.cmdline.tags.tag$tag
-	# destroy $frame.cmdline.tags.tag$tag	
-}
-
-
-##########################################################################
-# Private (stuff done when commands are run)
-
-# This procedure doesn't really seem necessary. I've left it in
-# in case there is something I'm missing (M. Barton 29 April 2007)
-proc Gronsole::progress {path ci percent} {
-	variable _data
-
-	if {[info exists _data($path,$ci,progress)]} {
-		set _data($path,$ci,progress) $percent
-	}
-	if {[info exists _data($path,$ci,progressbar)]} {
-		set pbar $_data($path,$ci,progressbar)
-	}
-
-	if {$percent == -1} {
-		$pbar configure -height 1
-	} else {
-		$pbar configure -height 20
-	}
-	# it seems that there is a bug in ProgressBar and it is not always updated ->
-	$pbar _modify
-}
-
-proc Gronsole::output_to_gronsole {path mark ci tags str} {
-	set outtext $path.text
-
-	set tagbase cmd$ci
-	# Back out backspaces:
-	if {0} {
-	while {[set idx [string first "\b" $str]] != -1} {
-		set last [expr $idx - 1]
-		set str1 [string range $str 1 $last]
-		set first [expr $idx + 1]
-		set str [string range $str $first end]
-		set pos [$outtext index "$mark - 1 chars"]
-		$outtext delete $pos
-		$outtext insert $mark $str1 $tags
-	}
-	}
-	if { [regexp -- {^GRASS_INFO_([^(]+)\(([0-9]+),([0-9]+)\): (.+)$} $str match key message_pid message_id val rest] } {
-		set lkey [string tolower $key]
-		Gronsole::add_tag $path $ci $lkey
-		set icon [icon status $lkey]
-		if {$icon != 0} {
-			$outtext image create $mark -image $icon
-			# $outtext tag add $tagbase "$mark -1 char"
-		}
-		$outtext insert $mark $val $tagbase
-	} elseif { [regexp -- {^GRASS_INFO_PERCENT: (.+)$} $str match val rest] } {
-		if { $val > 0 && $val < 100} { 
-			set Gronsole::_data($path,$ci,progress) $val
-#			Gronsole::progress $path $ci $val
-		} else {
-#			Gronsole::progress $path $ci -1
-			set Gronsole::_data($path,$ci,progress) -1
-			$outtext insert $mark "\n" $tags
-		}
-	} elseif { [regexp -- {^GRASS_INFO_END.+} $str match key rest] } {
-		# nothing
-	} else {
-		$outtext insert $mark $str $tags
-	}
-}
-
-proc Gronsole::readeof {path ci mark fh} {
-	variable _data
-	# This doesn't actually get the result
-	set result [catch {close $fh} error_text]
-	set _data($path,$ci,result) $result
-	# if {$result == 0} {
-		# Gronsole::add_tag $path $ci success
-		# set donecmd $_data($path,$ci,successcmd)
-	#} else {
-		# Gronsole::add_tag $path $ci failure
-		# set donecmd $_data($path,$ci,failurecmd)
-	#}
-	Gronsole::remove_tag $path $ci running
-}
-
-proc Gronsole::readout {path ci mark fh} {
-
-#	global mingw
-
-	set lines {}
-	
-	while {[gets $fh line] >= 0} {
-		lappend lines $line
-	}
-	
-	if {[llength $lines] != 0} {
-		Gronsole::add_data_tag $path $ci out
-#		if { $mingw == "1" } {
-		    # FIXME bug #606
-#		    Gronsole::output_to_gronsole $path $mark $ci [list cmd$ci cmd$ci-out] "\n"
-#		}
-	}
-	foreach line $lines {
-		Gronsole::output_to_gronsole $path $mark $ci [list cmd$ci cmd$ci-out] "$line\n"
-	}
-	$path.text see $mark
-}
-
-proc Gronsole::done_command {path ci} {
-	variable _data
-
-	if {[info exists _data($path,$ci,donecmd)] && $_data($path,$ci,donecmd) != {}} {
-		set donecmd $_data($path,$ci,donecmd)
-		set _data($path,$ci,donecmd) {}
-	}
-
-	if {[info exists donecmd] && $donecmd != {}} {
-		eval $donecmd
-	}
-}
-
-proc Gronsole::file_callback {path ci mark fh} {
-	if [eof $fh] {
-		Gronsole::readeof $path $ci $mark $fh
-		Gronsole::done_command $path $ci
-	} else {
-		Gronsole::readout $path $ci $mark $fh
-	}
-}
-
-proc Gronsole::execbg {path ci mark fh} {
-	fconfigure $fh -blocking 0
-	fileevent $fh readable [list Gronsole::file_callback $path $ci $mark $fh]
-}
-
-proc Gronsole::execwait {path ci mark fh} {
-	while {! [eof $fh]} {
-		Gronsole::readout $path $ci $mark $fh
-		update
-	}
-	Gronsole::readeof $path $ci $mark $fh
-	update
-}
-
-proc Gronsole::execout {path cmd ci execcmd} {
-	global env
-
-	set mark cmdinsert$ci
-
-	# Actually run the program
-	# |& grocat merges stdout and stderr because Tcl treats
-	# anything written to stderr as an error condition
-	set cmd [concat | $cmd |& $env(GISBASE)/etc/grocat]
-
-	set message_env [exec g.gisenv get=GRASS_MESSAGE_FORMAT]
-        set env(GRASS_MESSAGE_FORMAT) gui
-	set ret [catch {open $cmd r} fh]
-        set env(GRASS_MESSAGE_FORMAT) $message_env
-
-	set _data($path,$ci,fh) $fh
-
-	if { $ret } {
-		Gronsole::remove_tag $path $ci running
-		Gronsole::add_tag $path $ci error
-		catch {close $fh}
-		Gronsole::done_command $path $ci
-	} {
-		$execcmd $path $ci $mark $fh
-	}
-	update idletasks
-}
-
-##########################################################################
-# Public interface for running commands
-
-proc Gronsole::annotate {path cmd tags} {
-	variable _data
-
-	set ci [Gronsole::create_command $path $cmd]
-
-	foreach tag $tags {
-		Gronsole::add_tag $path $ci $tag
-	}
-
-	$path.text yview end
-	
-	return $ci
-}
-
-proc Gronsole::annotate_text {path ci text} {
-	Gronsole::output_to_gronsole $path cmdinsert$ci $ci [list cmd$ci cmd$ci-out] $text
-	$path.text see cmdinsert$ci
-}
-
-proc Gronsole::run {path cmd tags donecmd} {
-	variable _data
-	
-	set tags [concat running $tags]
-
-	set ci [Gronsole::annotate $path $cmd $tags]
-
-	set _data($path,$ci,donecmd) $donecmd
-
-	Gronsole::execout $path $cmd $ci Gronsole::execbg
-
-	return $ci
-}
-
-proc Gronsole::run_wait {path cmd tags} {
-	set tags [concat running $tags]
-
-	set ci [Gronsole::annotate $path $cmd $tags]
-
-	Gronsole::execout $path $cmd $ci Gronsole::execwait
-}
-
-proc Gronsole::run_xterm {path cmd tags} {
-	global env
-	global mingw
-
-	Gronsole::annotate $path $cmd [concat xterm $tags]
-
-	if { $mingw == "1" } {
-	    eval [list exec -- cmd.exe /c start \
-	    	$env(GISBASE)/etc/grass-run.bat ] $cmd &
-	} else {
-	    eval [list exec -- $env(GISBASE)/etc/grass-xterm-wrapper \
-		-name xterm-grass -e $env(GISBASE)/etc/grass-run.sh ] \
-		$cmd &
-	}
-
-	update idletasks
-}

lib/gtcltk/options.tcl

@@ -1,115 +0,0 @@
-############################################################################
-#
-# LIBRARY:      options.tcl gui options
-# AUTHOR(S):    Cedric Shock (cedricgrass AT shockfamily.net)
-# PURPOSE:      Default options and load user options
-# COPYRIGHT:    (C) 2006 GRASS Development Team
-#
-#               This program is free software under the GNU General Public
-#               License (>=v2). Read the file COPYING that comes with GRASS
-#               for details.
-#
-############################################################################
-
-lappend auto_path $env(GISBASE)/bwidget
-package require -exact BWidget 1.2.1
-
-# set background color and help font
-# These globals are still used in a few places by things in gis.m
-set bgcolor HoneyDew2
-
-##############################################################################
-# Create fonts
-
-proc fontcreate {font args} {
-	if {[lsearch [font names] $font] == -1} {
-		eval font create $font $args
-	} else {
-		eval font configure $font $args
-	}
-}
-
-fontcreate balloon-help -family Helvetica -size -12
-fontcreate default -family Helvetica -size -12
-fontcreate textfont -family Courier -size -12
-fontcreate bolddefault -family Helvetica -size 12 -weight bold
-fontcreate introfont -family Helvetica -size 14 -weight bold
-
-global bolddefault
-global introfont
-global textfont
-global default
-
-##############################################################################
-# Configure balloon help:
-
-DynamicHelp::configure -font balloon-help -fg black -bg "#FFFF77"
-
-##############################################################################
-# Configure almost everything using the options database
-
-# Font to use everywhere
-option add *font default
-# Font in labelframes of labels in bwidgets is prefixed with label:
-option add *labelfont default
-
-# Various background colors
-option add *background #dddddd
-option add *activeBackground #dddddd
-option add *highlightBackground #dddddd
-option add *ButtonBox.background HoneyDew2
-option add *ButtonBox*add.highlightBackground HoneyDew2
-option add *MainFrame.background HoneyDew2
-option add *PanedWindow.background HoneyDew2
-option add *Menu.background HoneyDew2
-option add *listbox.background white
-option add *addindicator.background white
-
-# Things that are selected:
-option add *selectBackground #ffff9b
-option add *selectForeground black
-
-# Menus use active instead of selected
-option add *Menu.activeBackground #ffff9b
-option add *Menu.activeForeground black
-
-# Scrollbar trough color
-option add *troughColor HoneyDew3
-
-# Entry widgets and text widgets should have a white background
-option add *Entry.background white
-option add *entry.background white
-option add *Entry.highlightbackground #dddddd
-option add *entrybg white
-option add *Text.background white
-option add *Entry.font textfont
-option add *Text.font textfont
-
-# Options for map canvases
-option add *mapcanvas.background #eeeeee
-option add *mapcanvas.insertbackground black
-option add *mapcanvas.selectbackground #c4c4c4
-option add *mapcanvas.selectforeground black
-
-
-##############################################################################
-# Platform specific default settings:
-# keycontrol is control key used in copy-paste bindings
-
-set keycontrol "Control"
-
-if {[info exists env(osxaqua)]} {
-    set osxaqua $env(osxaqua)
-} else {
-    set osxaqua "0"
-}
-
-if { $osxaqua == "1"} {
-    set keycontrol "Command"
-}
-
-if {[info exists env(OS)] && $env(OS) == "Windows_NT"} {
-    set mingw "1"
-} else {
-    set mingw "0"
-}

lib/gtcltk/select.tcl

@@ -1,316 +0,0 @@
-##########################################################################
-#
-# select.tcl
-#
-# tree/listbox control for interactive selection of GRASS GIS elements
-#
-# Author: Unknown. Possibly Jacques Bouchard, author of tcltkgrass for
-#   GRASS 5. Subsequent modifications by members of the GRASS Development
-#   team.
-#
-# Last update: September 2007
-#
-# COPYRIGHT:	(C) 1999 - 2007 by the GRASS Development Team
-#
-#		This program is free software under the GNU General Public
-#		License (>=v2). Read the file COPYING that comes with GRASS
-#		for details.
-#
-##########################################################################
-# Frame scrolling that works:
-# Scroll if the window exists AND
-# the window is mapped AND
-# This window's parent's descendant has the focus (keyboard or mouse pointer in)
-# We use the parent because the scrollbars are in the parent, and two scrollable
-# Things shouldn't have the same parent.
-
-set bind_scroll_list {}
-
-proc handle_scroll {ammount} {
-    global bind_scroll_list
-
-    foreach {x y} {-1 -1} {}
-
-    set window_gone 0
-
-    foreach window $bind_scroll_list {
-        if {![winfo exists $window]} {
-            set window_gone 1
-            continue
-        } 
-        if {![winfo ismapped $window]} continue
-        set parent [winfo parent $window]
-        set keyboard_focus [focus -displayof $window]
-        foreach {x y} [winfo pointerxy $window] {break}
-        set mouse_focus [winfo containing -displayof $window $x $y]
-		set l [string length $parent]
-        if {[string equal -length $l $parent $keyboard_focus] || \
-            [string equal -length $l $parent $mouse_focus]} {
-            $window yview scroll [expr {-$ammount/120}] units
-        }
-    }
-
-    # We should thin out windows that don't exist anymore if we find them
-    if {$window_gone} {
-        set new_bind_scroll_list {}
-        foreach window $bind_scroll_list {
-            if {[winfo exists $window]} {
-                lappend new_bind_scroll_list $window
-            }
-        }
-        set bind_scroll_list $new_bind_scroll_list
-    }
-}
-
-proc bind_scroll {frame} {
-    global bind_scroll_list
-
-    lappend bind_scroll_list $frame
-}
-
-bind all <MouseWheel> "handle_scroll %D"
-bind all <Button-4> "handle_scroll 120"
-bind all <Button-5> "handle_scroll -120"
-
-##############################################################
-
-proc GSelect { element args } {
-    # startup procedure 
-
-    set sel [eval [linsert $args 0 GSelect_::create $element]]
-    return $sel
-
-}
-
-namespace eval GSelect_ {
-    variable count 1
-    variable dblclick
-    variable array selwin
-}
-
-proc GSelect_::create { element args } {
-    # main procedure for creating and managing selection window, which a tree
-    # within a scrolling window.
-
-    global env id
-    variable selwin
-    variable count
-    
-    incr count
-    set id $count
-    
-    set selwin($id,self) selwin
-    set title [G_msg "Select item"]
-    set selwin($id,selected) {}
-    
-    if {[lsearch -exact $args "title"] > -1} {
-	append title " - [lindex $args [expr [lsearch -exact $args title]+1]]"
-    }
-    
-    # Leave selection on top of caller window till it's closed
-    set parentwin "."
-    if {[lsearch -exact $args "parent"] > -1} {
-    	set parentwin [lindex $args [expr [lsearch -exact $args "parent"]+1]]
-    	if { [string length $parentwin] > 1 } {
-    		set selwin($id,self) [regsub -all {[[:space:]]|[[:punct:]]} ".selwin[string range $parentwin 1 [string length $parentwin]]" ""]
-    	} elseif {[lsearch -exact $args "title"] > -1} { set selwin($id,self) [regsub -all {[[:space:]]|[[:punct:]]} ".selwin$title" ""] }
-    } 
-    set selwin($id,self) ".$selwin($id,self)"
-    set selftop "$selwin($id,self)top"
-
-    # Do not create another select window, if one already exists.
-    if {[winfo exists $selwin($id,self)]} {
-    	raise $selwin($id,self) 
-    	focus $selwin($id,self) 
-    	return
-    }
-
-    toplevel $selwin($id,self) -width 300 -height 400 
-    set sw    [ScrolledWindow $selwin($id,self).sw -relief sunken -borderwidth 2 ]
-    
-    wm title $selwin($id,self) $title
-    wm transient $selwin($id,self) $parentwin
-
-    set tree  [Tree $sw.tree \
-                   -relief flat -borderwidth 0 -width 15 -highlightthickness 0\
-		   -redraw 1 -dropenabled 1 -dragenabled 1 \
-                   -opencmd   "GSelect_::moddir 1 $sw.tree" \
-                   -closecmd  "GSelect_::moddir 0 $sw.tree"] 
-
-    $sw setwidget $tree
-    bind_scroll $tree
-
-    regexp -- {(.+)x(.+)([+-].+)([+-].+)} [wm geometry .] g w h x y
-    #set w [expr int(2*$w/3)]
-    set w 300
-    set h 400
-    wm geometry $selwin($id,self) ${w}x$h$x$y
-
-    pack $sw    -side top  -expand yes -fill both
-    pack $tree  -side top -expand yes -fill both 
-
-    $tree bindText  <ButtonPress-1>        "GSelect_::select $id $tree"
-    $tree bindImage <ButtonPress-1>        "GSelect_::select $id $tree"
-    $tree bindText  <Double-ButtonPress-1> "GSelect_::selectclose $id $tree"
-    $tree bindImage <Double-ButtonPress-1> "GSelect_::selectclose $id $tree"
-    if {[lsearch $args "multiple"] >= 0} {
-    	$tree bindText  <Control-ButtonPress-1> "GSelect_::select_toggle $id $tree"
-    } else {
-    	$tree bindText  <Control-ButtonPress-1> "GSelect_::select $id $tree"
-    }
-    
-    set location_path "$env(GISDBASE)/$env(LOCATION_NAME)/"
-    set current_mapset "$env(MAPSET)"
-    set sympath "$env(GISBASE)/etc/symbol/"
-    
-    # main selection subroutine
-    if {$element != "symbol"} {
-        foreach dir [exec g.mapsets -p] {
-            set windfile "$location_path/$dir/WIND"
-            if { ! [ file exists $windfile ] } { continue }
-            if { $dir == $current_mapset } {
-                $tree insert end root ms_$dir -text $dir -data $dir -open 1 \
-                -image [Bitmap::get openfold] -drawcross auto
-            } else {
-                $tree insert end root ms_$dir -text $dir -data $dir -open 0 \
-                -image [Bitmap::get folder] -drawcross auto
-            }
-            set path "$location_path/$dir/$element/"
-            foreach fp [ lsort [glob -nocomplain $path/*] ]  {
-            set file [file tail $fp]
-            $tree insert end ms_$dir $file@$dir -text $file -data $file \
-                -image [Bitmap::get file] -drawcross never
-            }
-        }
-    }
-
-    # vector symbol selection subroutine
-    if {$element == "symbol"} {
-        $tree insert end root ms_$sympath -text SYMBOLS -data $sympath -open 1 \
-            -image [Bitmap::get openfold] -drawcross auto
-        
-        foreach ic_dir [ lsort [glob -nocomplain $sympath/*] ]  {
-            set dir_tail [file tail $ic_dir]
-            $tree insert end ms_$sympath ms_$dir_tail  -text $dir_tail -data $dir_tail \
-                -image [Bitmap::get folder] -drawcross auto
-    
-            foreach ic_file [ lsort [glob -nocomplain $sympath/$dir_tail/*] ]  {
-                set file [file tail $ic_file]
-                $tree insert end ms_$dir_tail $dir_tail/$file -text $file -data $file \
-                    -image [Bitmap::get file] -drawcross never
-            }
-        }
-    }
-
-    $tree configure -redraw 1
-
-    # buttons
-    button $selwin($id,self).ok -text [G_msg "Ok"] -command "destroy $selwin($id,self)"
-    button $selwin($id,self).cancel -text [G_msg "Cancel"] -command "GSelect_::terminate $id"
-
-    pack $selwin($id,self).ok $selwin($id,self).cancel -side left -expand yes
-
-
-    # ScrollView
-    toplevel $selftop -relief raised -borderwidth 2
-    wm protocol $selftop WM_DELETE_WINDOW {
-        # don't kill me
-    }
-    wm overrideredirect $selftop 1
-    wm withdraw $selftop
-    wm transient $selftop $selwin($id,self)
-    ScrollView $selftop.sv -window $tree -fill black
-    pack $selftop.sv -fill both -expand yes
-
-    wm protocol $selwin($id,self) WM_DELETE_WINDOW "GSelect_::terminate $id"
-    tkwait window $selwin($id,self)
-
-    destroy $selftop 
-
-    # return selected elements -- separated by commas if there are > 1 elements
-    if { $selwin($id,selected) != "" } {
-        set ret ""
-        set len [llength $selwin($id,selected)]
-        foreach elem $selwin($id,selected) {
-            append ret $elem
-            if {[lsearch $selwin($id,selected) $elem] != -1  && \
-                [lsearch $selwin($id,selected) $elem] < [expr $len-1]} {
-                append ret ","
-            }
-        }
-        return $ret
-    }
-
-    return ""
-}
-
-
-proc GSelect_::select { id tree node } {
-    # Single selection (default). Clicking an item will select it and 
-    # deselect any other item selected
-    variable selwin
- 
-    set parent [$tree parent $node]
-    if { $parent == "root" } { return }
- 
-    $tree selection set $node
-    update
-    set selwin($id,selected) $node
-}
-
-proc GSelect_::select_toggle { id tree node} {
-    # Multiple selections. Ctrl-1 will toggle an item as selected or not selected
-    # and add it to a list of selected items
-    variable selwin
- 
-    set parent [$tree parent $node]
-    if { $parent == "root" } { return }
- 
-    if {[lsearch -exact [$tree selection get] $node] >= 0} {
-        $tree selection remove $node
-        update
-        set nodeindex [lsearch $selwin($id,selected) $node]
-        if {$nodeindex != -1} {
-            set selwin($id,selected) [lreplace $selwin($id,selected) $nodeindex $nodeindex]
-        }
-    } else {
-        $tree selection add $node
-        update
-        lappend selwin($id,selected) $node
-    }
-     
-    #$tree selection add $node
-#     set selwin($id,selected) [string trim $selwin($id,selected) ,]
-}
-
-proc GSelect_::selectclose { id tree node } {
-    # return selection and close window (OK button)
-    variable selwin
-
-    GSelect_::select $id $tree $node
-    destroy $selwin($id,self)
-}
-
-
-proc GSelect_::terminate { id } {
-    # close window without returning selection (cancel)
-	variable selwin
-	
-	set selwin($id,selected) {}
-	destroy $selwin($id,self)
-}
-
-proc GSelect_::moddir { idx tree node } {
-    if { $idx && [$tree itemcget $node -drawcross] == "always" } {
-        getdir $tree $node [$tree itemcget $node -data]
-        if { [llength [$tree nodes $node]] } {
-            $tree itemconfigure $node -image [Bitmap::get openfold]
-        } else {
-            $tree itemconfigure $node -image [Bitmap::get folder]
-        }
-    } else {
-        $tree itemconfigure $node -image [Bitmap::get [lindex {folder openfold} $idx]]
-    }
-}
-
-