window.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# Copyright (c) 2000, 2001, 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.
# 
# window.tcl - Toplevel replacement and routines for handling
#              and creating windows?
# Copyright (C) 1998 Cygnus Solutions.

#FIXME:
# This Window class is based on the old pre itcl1.5 code
# from Toplevel&.  Most of the methods need a big tidy up.


namespace eval sourcenav {}
 
itcl::class sourcenav::Window {

    inherit itk::Toplevel

    constructor {args} {
        global sn_options

        # We need extra options from itk::Toplevel.
        itk_option add hull.menu hull.relief hull.borderwidth

# FIXME : Why would itk::Toplevel not do this by default?
        #close
        on_close "itcl::delete object ${this}"

        # What is this leader stuff???
        # configure -leader

        # Make sure that the tag class "Toplevel" is included
        # in the event tag list, also "all", but Toplevel
        # must be placed before all
        sn_add_tags $itk_component(hull) {Toplevel all} end

	wm protocol $itk_component(hull) WM_TAKE_FOCUS \
            [itcl::code $this CheckTakeFocus $itk_component(hull)]

        eval itk_initialize $args

    }

    destructor {
# FIXME: Remove this grab stuff, it should be in Dialog class only!
        if {${old_grab} != ""} {
            if {[catch {${old_grab} grab}]} {
                ::grab set ${old_grab}
                # It might be not a Toplevel& object.
            }
        }
        bind_tk <Unmap> { }

        sn_input_check_in_window $itk_component(hull) 0

        if {[winfo exists ${leader}] && [winfo toplevel ${leader}] ==\
          ${leader}} {
            wm deiconify ${leader}
        }

        if {[winfo exists ${leader}]} {
            bind ${leader} <Map> {}
            bind ${leader} <Unmap> {}
            bind ${leader} <Destroy> {}
        }
    }

    # Widget Tk-methods.

    # Used only to query the current geometry since
    # itcl/itk does not support a cget query method.
    public method geometry {} {
       return [wm geometry $itk_component(hull)]
    }


    public method aspect {args} {
        return [eval wm aspect $itk_component(hull) ${args}]
    }

    public method centerOnScreen {} {
        global tcl_platform

	update idletasks

	# Use reqwidth/reqheight unless user explicitly set
	# a width and height for the window via -geometry.
	if {$explicit_width != -1} {
	    set wd $explicit_width
	    set explicit_width -1
	} else {
	    set wd [winfo reqwidth $itk_component(hull)]
	}
	if {$explicit_height != -1} {
	    set ht $explicit_height
	    set explicit_height -1
	} else {
	    set ht [winfo reqheight $itk_component(hull)]
	}
        set sw [winfo screenwidth $itk_component(hull)]
        set sh [winfo screenheight $itk_component(hull)]
	set x [expr {($sw-$wd)/2}]
	set y [expr {($sh-$ht)/2}]
	wm geometry $itk_component(hull) +$x+$y
    }

    public method client args {
        return [eval wm client $itk_component(hull) ${args}]
    }

    public method colormapwindows args {
        return [eval wm colormapwindows $itk_component(hull) ${args}]
    }

    public method command args {
        return [eval wm command $itk_component(hull) ${args}]
    }

    public method config_tk args {
        return [::eval $itk_component(hull) configure ${args}]
    }

    public method deiconify {} {
        return [wm deiconify $itk_component(hull)]
    }

    public method focusmodel args {
        return [eval wm focusmodel $itk_component(hull) ${args}]
    }

    # we cannot used the method name 'frame' because it would
    # conflict with the 'frame' command in Tk.
    public method frame_tk {} {
        return [wm frame $itk_component(hull)]
    }

    public method __grid args {
        return [eval wm grid $itk_component(hull) ${args}]
    }

    public method group args {
        return [eval wm group $itk_component(hull) ${args}]
    }

    public method iconify {} {
        return [eval wm iconify $itk_component(hull)]
    }

    public method iconposition args {
        return [eval wm iconposition $itk_component(hull) ${args}]
    }

    public method icontwindow args {
        return [eval wm icontwindow $itk_component(hull) ${args}]
    }

    public method maxsize args {
        return [eval wm maxsize $itk_component(hull) ${args}]
    }

    public method minsize args {
        return [eval wm minsize $itk_component(hull) ${args}]
    }

    public method overrideredirect args {
        return [eval wm overrideredirect $itk_component(hull) ${args}]
    }

    public method positionfrom args {
        return [eval wm positionfrom $itk_component(hull) ${args}]
    }

    public method protocol args {
        return [eval wm protocol $itk_component(hull) ${args}]
    }

    public method resizable args {
        return [eval wm resizable $itk_component(hull) ${args}]
    }

    public method sizefrom args {
        return [eval wm sizefrom $itk_component(hull) ${args}]
    }

    public method state {} {
        return [wm state $itk_component(hull)]
    }

    # FIXME : Can't we remove this completely and just use -title?
    public method title {{argl ""} {umlaut_map ""}} {
        set argl [join ${argl}]

        # FIXME: should this be != "" ?
        if {${umlaut_map} == ""} {
            set argl [map_umlauts ${argl}]
        }

        if {[string compare ${argl} ""] == 0} {
            #return [set itk_option(-title)]
	    return [wm title $itk_component(hull)]
        } else {
            #return [set itk_option(-title) ${argl}]
            return [wm title $itk_component(hull) ${argl}]
        }
    }

    public method transient {{window ""}} {
        global tcl_platform

        if {${window} == {}} {
            return [wm transient $itk_component(hull)]
        } else {
            if {! [winfo exists ${window}]} {
                error "window ${window} does not exist!"
            }
            # If the window is not a toplevel, find
            # the toplevel it lives in.
            set toplevel [winfo toplevel ${window}]
 
            # A bug in Tk 8.1 will remap a withdrawn
            # window when it becomes a transient.
            # We work around it here by unmapping
            # the window again. It is fixed in 8.3.

            if {$tcl_platform(platform) == "windows"} {
                set ismapped [winfo ismapped $itk_component(hull)]
            }

            wm transient $itk_component(hull) ${toplevel}

            if {$tcl_platform(platform) == "windows"
                    && !$ismapped} {
                ${this} withdraw

                # This update call is required under
                # windows, otherwise the window
                # will appear for a split second
                # before being withdrawn.
                update
            }
        }
    }

    public method withdraw {} {
        return [wm withdraw $itk_component(hull)]
    }

    # This function is useful to replace umlauts in window titles, because
    # the window managers (normaly) do not use iso8859-1 fonts.

    public proc map_umlauts {str} {
        regsub -all "\xfc" ${str} "ue" str
        regsub -all "\xe4" ${str} "ae" str
        regsub -all "\xf6" ${str} "oe" str
        regsub -all "\xdc" ${str} "Ue" str
        regsub -all "\xc4" ${str} "Ae" str
        regsub -all "\xd6" ${str} "Oe" str

        return ${str}
    }

    public method grab {args} {
        if {${args} == "set"} {
            set old_grab [lindex [::grab current] 0]
            ${this} bind_tk <1> "if {\"%W\" == \"$itk_component(hull)\"} {
					${this} move_to_mouse 0
					${this} raise
					bell -displayof %W
				}
				break
				"
            ${this} bind_tk <2> [${this} bind_tk <1>]
            ${this} bind_tk <3> [${this} bind_tk <1>]
        }\
        elseif {${args} == "release"} {
            ${this} bind_tk <1> { }
            ${this} bind_tk <2> [${this} bind_tk <1>]
            ${this} bind_tk <3> [${this} bind_tk <1>]
        }
        # FIXME: This seems to generate the error "grab failed: window not viewable"
        return [eval ::grab ${args} $itk_component(hull)]
    }

    public method raise {args} {
        global sn_force_flag tcl_platform

        if {[state] != "normal"} {
            set ret [deiconify]
        } else {
            #don't steal focus on UNIX
            if {$tcl_platform(platform) == "windows"} {
                set wdg [::focus -lastfor $itk_component(hull)]
                eval focus ${sn_force_flag} $itk_component(hull)
                focus ${wdg}
            }
            set ret [eval ::raise $itk_component(hull) ${args}]
        }
        return ${ret}
    }

    public method take_focus {{wdg ""}} {
        ::take_focus $itk_component(hull) ${wdg}
    }

    #bind Escape and WM-close hint to the window
    public method on_close {{cmd ""}} {
        global tcl_platform

        if {${cmd} == ""} {
            set cmd [list itcl::delete object ${this}]
        }

        ::wm protocol $itk_component(hull) WM_DELETE_WINDOW ${cmd}
        bind $itk_component(hull) <Escape> ${cmd}

        #on windows Alt-F4 closes window
        if {$tcl_platform(platform) == "windows"} {
            bind $itk_component(hull) <Alt-F4> ${cmd}
        }