# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
itcl_class List_Text& {
	constructor {config} {
		global sn_options
		global tcl_platform

		@@rename $this $this-tmp-

		if {![winfo exists $this] || [winfo toplevel $this] != $this} {
			frame $this
			@@rename $this $this-frame
		}
		if {$header != ""} {
			set cls "-class Showdata_mono"
		} else {
			set cls ""
		}
		set lframe $this.list_text
		eval frame $lframe $cls

		@@rename $this-tmp- $this

		set widget $lframe.list

		set cmd "$widget_class $widget -setgrid $setgrid\
			-borderwidth 1 -relief sunken -height $height\
			-yscrollcommand \"$lframe.y set\"\
			-xscrollcommand \"$lframe.x set\""

		if {$font == ""} {
			set font $sn_options(def,default-font)
		}
		append cmd " -font [list $font]"

		if {$header != ""} {
			append cmd " -borderwidth 1"
		}

		if {[string compare $width ""] != 0} {
			append cmd " -width $width"
		}

		eval $cmd "-selectmode $selectmode"

		foreach attr $config {
			config -$attr [virtual set $attr]
		}

		if {$header != ""} {
			set header $lframe.header

			set bg Black
			set fg White
			set cmd "$widget_class $header\
				-height 1\
				-borderwidth 1\
				-relief sunken\
				-background $bg\
				-foreground $fg"

			append cmd " -font [list $font]"

			eval $cmd
			@@bind $header <1> {break}
			@@bind $header <B1-Leave> {break}
			@@bind $header <ButtonRelease-1> {break}
			@@bind $header <Double-1> {break}
			@@bind $header <Control-1> {break}
			@@bind $header <Shift-1> {break}
			@@bind $header <B1-Motion> {break}
		}
		scrollbar $lframe.x -orient horiz\
				-command "[info class] @@ hscroll {$header} $widget"

		scrollbar $lframe.y -command "$widget yview"

		if {$header != ""} {
			pack $header -side top -fill x -expand no
		}
		pack $widget -side top -fill both -expand y
		pack $lframe -side top -fill both -expand y

		$this config -active_focus $active_focus

		if {$tcl_platform(platform) != "windows"} {
			$this bind <Control-p> "$this print_dialog_box"
		}
		if {$bind_config} {
			@@bind $widget <Configure> "[info class] @@ resize_widget %W"
		}
	}

	public bind_config 1

	destructor {
		if {[winfo exists $print_dialog]} {
			$print_dialog delete
			catch {uplevel #0 unset $print_dialog-ptarget}
			catch {uplevel #0 unset $print_dialog-cmd}
		}
		catch {destroy $lframe}
		catch {@@rename $this-frame {}}
	}

	method config {config} {
	}

# Widget Tk-methods.

	method bbox {args} {
		return [eval $widget bbox $args]
	}

	method cget {args} {
		return [eval $widget cget $args]
	}

	method delete_tk {args} {
		if {$bind_config} {
			resize_widget $widget
		}

		return [eval $widget delete $args]
	}

	method get {args} {
		return [eval $widget get $args]
	}

	method index {args} {
		return [eval $widget index $args]
	}

	method insert {args} {
		if {$bind_config} {
			resize_widget $widget
		}

		return [eval $widget insert $args]
	}

	method scan {args} {
		return [eval $widget scan $args]
	}

	method see {args} {
		return [eval $widget see $args]
	}

	method xview {args} {
		return [eval $widget xview $args]
	}

	method yview {args} {
		return [eval $widget yview $args]
	}

# Widget public properties for Tk methods.
	public background {} {
		config_tk -background $background
	}

	public bg {} {
		config_tk -bg $bg
	}

	public borderwidth {} {
		config_tk -borderwidth $borderwidth
	}

	public cursor {} {
		config_tk -cursor $cursor
	}

	public exportselection {1} {
		config_tk -exportselection $exportselection
	}

	public font {} {
		config_tk -font $font
	}

	public fg {} {
		config_tk -fg $fg
	}

	public foreground {} {
		config_tk -foreground $foreground
	}

	global tcl_platform
	if {$tcl_platform(platform) == "windows"} {
		public height {10} {
			config_tk -height $height
		}
	} else {
		public height {15} {
			config_tk -height $height
		}
	}

	public highlightbackground {} {
		config_tk -highlightbackground $highlightbackground
	}

	public highlightcolor {} {
		config_tk -highlightcolor $highlightcolor
	}

	public highlightthickness {} {
		config_tk -highlightthickness $highlightthickness
	}

	public relief {} {
		config_tk -relief $relief
	}

	public selectbackground {} {
		config_tk -selectbackground $selectbackground
	}

	public selectborderwidth {} {
		config_tk -selectborderwidth $selectborderwidth
	}

	public selectforeground {} {
		config_tk -selectforeground $selectforeground
	}

	public selectmode {browse} {
		config_tk -selectmode $selectmode
	}

	public setgrid 0 {
		config_tk -setgrid $setgrid
	}

	public takefocus {} {
		config_tk -takefocus $takefocus
	}

	public width {} {
		config_tk -width $width
	}

	public xscrollcommand {} {
		config_tk -xscrollcommand $xscrollcommand
	}

	public yscrollcommand {} {
		config_tk -yscrollcommand $yscrollcommand
	}
# End of widget public properties for Tk methods.

	proc hscroll {h l args} {
		if {$h != ""} {
			eval $h xview $args
		}
		eval $l xview $args
	}

	method bind {args} {
		return [@@eval bind $widget $args]
	}

	method config_tk {args} {
		if {[winfo exists $widget]} {
			return [eval $widget config $args]
		}
	}

	method focus {} {
		return [@@focus $widget]
	}

	method header {args} {
		if {[winfo exists $header]} {
			return [eval $header $args]
		}
	}

	common field_separator "|"
	common paste_field_separator "\t"

	method selection_triger {off max} {
		if {$off == "0"} {
			set clipboard ""
			switch $field_separator {
			"|" -
			"\\" -
			"*" -
			"\[" -
			"\]" -
			"." -
			"$" {set sep "\\$field_separator"}
			default {set sep $field_separator}
			}

			set sel [$this curselection]
			if {[llength $sel] > 1} {
				set app_newline 1
			} else {
				set app_newline 0
			}
			foreach i $sel {
				set rec [$this get $i]
				regsub -all "\[\n\t\]+" $rec " " rec
				regsub -all "\[ \]*$sep\[ \]*" $rec \
					$paste_field_separator rec
				append clipboard $rec
				if {$app_newline} {
					append clipboard "\n"
				}
			}
		}
		return [string range $clipboard $off [expr $off+$max-1]]
	}
	
# X Selection !
	method selection {cmd args} {
		if {[catch {set sel [@@eval selection $cmd $widget $args]}]} {
			return ""
		} else {
			return $sel
		}
	}

	method list_window_name {} {
		return $widget
	}

	protected print_dialog {}

	method print_dialog_box {{sub_tit ""}} {
		global sn_options

		if {[winfo exists $print_dialog]} {
			$print_dialog raise
			return
		}
		set toplw [winfo toplevel $this]

		set print_dialog [Toplevel& [Toplevel& @@ next_window_name]\
			-leader $toplw]

		$print_dialog transient $toplw

		sn_motif_buttons $print_dialog bottom 0 [get_indep String ok]\
				[get_indep String cancel]
		$print_dialog.button_0 config -command "$this print_it"
		$print_dialog.button_1 config -command "$print_dialog delete"

		global $print_dialog-ptarget $print_dialog-cmd
		@@set $print_dialog-ptarget "all"
		
		set tit [wm title $toplw]
		if {[string compare $sub_tit ""] != 0} {
			append tit " " $sub_tit
		}
		@@set $print_dialog-cmd [format $sn_options(def,ascii-print-command) $tit]
		$print_dialog title [list [get_indep String Print] $tit]

		frame $print_dialog.command
		label $print_dialog.command.prompt\
			-text [get_indep String SQLPprintercmd]

		entry $print_dialog.command.cmd -width 70\
			-textvariable $print_dialog-cmd

		@@bind $print_dialog.command.cmd <Any-Return> \
			"$print_dialog.button_0 invoke"
	
		pack $print_dialog.command.prompt -side left
		pack $print_dialog.command.cmd -side left -padx 10 -fill x -expand y
		pack $print_dialog.command -fill x -expand y

		radiobutton $print_dialog.marked -text [get_indep String Marked]\
			-variable $print_dialog-ptarget -value marked

		radiobutton $print_dialog.all -text [get_indep String All]\
			-variable $print_dialog-ptarget -value all

		radiobutton $print_dialog.view -text [get_indep String View]\
			-variable $print_dialog-ptarget -value view

		pack $print_dialog.marked -anchor w -padx 60
		pack $print_dialog.all -anchor w -padx 60
		pack $print_dialog.view -anchor w -padx 60

		$print_dialog move_to_mouse
		catch {$print_dialog resizable 1 0}
		
		$print_dialog take_focus $print_dialog.command.cmd
		
		$print_dialog take_focus
	}

	method print_it {} {
		global $print_dialog-ptarget $print_dialog-cmd

		set lst ""
		switch -- [@@set $print_dialog-ptarget] {
		"all" {
				set lst [$this get 0 end]
			}
		"marked" {
				foreach s [$this curselection] {
					lappend lst [$this get $s]
				}
			}
		"view" -
		default {
			set lst [$this get [$this nearest 0]\
				[$this nearest [winfo height $this]]]
			}
		}
		
		$print_dialog delete
		eval exec -- [@@set $print_dialog-cmd] << {[join $lst "\n"]}
		set print_dialog ""
		catch {unset $print_dialog-ptarget}
		catch {unset $print_dialog-cmd}
	}

	proc rebind_config {} {
		if {[info exists resizing]} {
			foreach w [array names resizing] {
				catch {@@bind $w <Configure> "[info class] @@ resize_widget %W"}
			}
			catch {unset resizing}
		}
	}

	proc exec_resize {} {
		foreach W [array names resizing] {
			if {[catch {set f [winfo parent $W]}]} {
				catch {unset resizing($W)}
				continue
			}
			if {[catch {set f [winfo parent $W]}]} {
				return
			}

			if {[$W yview] == "0 1"} {
				set bef $W
				if {[lsearch -exact [pack slaves $f] $f.y] != -1} {
					pack forget $f.y
				}
			} else {
				set bef $f.y
				pack $f.y -side right -fill y -before $W
			}

			if {[$W xview] == "0 1"} {
				if {[lsearch -exact [pack slaves $f] $f.x] != -1} {
					pack forget $f.x
				}
			} else {
				pack $f.x -side bottom -fill x -before $bef
			}

			if {[winfo ismapped $W]} {
				pack propagate $f 0
			}
		}
		after idle "[info class] @@ rebind_config"
	}

	common resizing

	proc resize_widget {W}  {
		if {![info exists resizing]} {
			after idle "[info class] @@ exec_resize"

		}
		set resizing($W) 1
		@@bind $W <Configure> { }
	}

	public header {}
	public scroll {default} {
		global sn_scroll_pos

		if {$header != ""} {
			set defstr "right bottom"
		} else {
			set defstr "right"
		}
		catch {set defstr $sn_scroll_pos}

		regsub "default" $scroll $defstr scroll
	}

	public active_focus 1 {
		if {$active_focus} {
			#bind_focus_enter $widget {focus %W}
			$this focus
		} else {
			$this bind <Enter> { }
		}
	}

	public widget_class {listbox}

	protected clipboard {}
	protected lframe
	protected widget {}
	protected xscrolling
}

itcl_class Listbox& {
	inherit	List_Text&

	constructor {args} {
		eval List_Text&@@constructor $args

		if {$editable} {
			bind <Delete> "$this cut"
			bind <Control-d> [bind <Delete>]
			bind <Control-x> "$this cut paste"
			bind <Any-F20> [bind <Control-x>];	# Sun Cut
			bind <Control-v> "$this paste"
			bind <Any-F18> [bind <Control-v>];	# Sun Paste
		}
		bind <Control-c> [bind <F16>]

		config -roll $roll
	}

	method activate {args} {
		return [eval $widget activate $args]
	}

	method curselection {args} {
		return [eval $widget curselection $args]
	}

	method nearest {args} {
		return [eval $widget nearest $args]
	}

	method selection {args} {
		return [eval $widget selection $args]
	}

	method size {args} {
		return [eval $widget size $args]
	}

	proc exchange_mark {w} {
		set sel [$w curselection]

		set exchange ""
		foreach s [$w curselection] {
			lappend exchange [$w get $s]
		}
	}

# It is a 'proc' because the performance is better.
	proc exchange {w y} {
		set sel [$w curselection]
		if {$sel == "" || [string compare $exchange ""] == 0} {
			return
		}

		set y [@@$w nearest $y]

		set len [expr [llength $sel] -1]
		set first [lindex $sel 0]
		set last  [lindex $sel $len]

		if {$y >= $first && $y <= $last} {
			return
		}

		if {$first <= $y} {
			set y [expr $y - $len]
		}
		if {$y < 0} {
			return
		}
		@@$w delete $first $last
		eval @@$w insert $y $exchange
		@@$w selection clear 0 end
		@@$w selection set $y [expr $y + $len]
	}

	method copy {} {
		set sel [$this curselection]
		if {$sel == ""} {
			return
		}

		set cut_buf ""

		foreach s $sel {
			set str [$this get $s]
			regsub -all "\n" $str "" str
			lappend cut_buf $str
		}
	}

	method cut {{func ""}} {
		set sel [$this curselection]
		if {$sel == ""} {
			return ""
		}

		if {$func == "paste"} {
			$this copy

			catch {blt_cutbuffer set [join $cut_buf "\n"] 0}
		}
		set len [expr [llength $sel] -1]
		$this delete_tk [lindex $sel 0] [lindex $sel $len]
	}

	method paste {{y ""}} {
		if {[string compare $cut_buf ""] == 0} {
			return -1
		}

		if {[string compare $y ""] == 0} {
			set y [$this index active]
			if {[string compare $y ""] == 0} {
				return
			}
		}
		if {$y == [expr [$this size] -1]} {
			set y end
		}
		eval $this insert $y $cut_buf

		return $y
	}

	public roll 0 {
		if {[winfo exists $this]} {
			if {$roll} {
				bind <3> "[info class] @@ exchange_mark %W"
				bind <B3-Motion> "[info class] @@ exchange %W %y; break"
			} else {
				bind <3> [$this bind <1>]
				bind <B3-Motion> [$this bind <B1-Motion>]
			}
		}
	}

	public editable 0

	protected cut_buf ""

	common exchange {}
}

itcl_class Text& {
	inherit	List_Text&

	constructor {args} {
		eval List_Text&@@constructor -widget_class text $args
	}

	method compare {args} {
		return [eval $widget compare $args]
	}

	method index {args} {
		return [eval $widget index $args]
	}

	method mark {args} {
		return [eval $widget mark $args]
	}

	method tag {args} {
		return [eval $widget tag $args]
	}

	public insertbackground {} {
		config_tk -insertbackground $insertbackground
	}

	public insertborderwidth {} {
		config_tk -insertborderwidth $insertborderwidth
	}

	public insertofftime {} {
		config_tk -insertofftime $insertofftime
	}

	public insertontime {} {
		config_tk -insertontime $insertontime
	}

	public insertwidth {} {
		config_tk -insertwidth $insertwidth
	}

	public padx {} {
		config_tk -padx $padx
	}

	public pady {} {
		config_tk -pady $pady
	}

	public state {} {
		config_tk -state $state
	}

	public wrap {} {
		config_tk -wrap $wrap
	}
}

