window.tcl

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

    }

    public method bind_tk args {
        return [eval bind  $itk_component(hull) ${args}]
    }

    public method focus_tk {{args ""}} {
        return [eval focus ${args}  $itk_component(hull)]
    }

    public proc next_window_name {} {
        set wn "${internal_name}${seq}"
        incr seq
        return ${wn}
    }

    public method window_name {} {
        return $itk_component(hull)
    }

    public method move_to_mouse {{swap 1}} {
        #we never move the window to the mouse location
        after idle "[itcl::code ${this} centerOnScreen]; ${this} deiconify ; ${this} take_focus"
    }

    # This procedure checks to make sure it's not stealing
    # focus from a modal dialog.
    public method CheckTakeFocus {window} {

	set focusHolder [$this TopModalStack]

	if {$focusHolder == $window} {
	    return
	}

	if {$focusHolder == "" || ![winfo exists $focusHolder]} {
	    # Remove bogus entry from stack.
	    $this PopModalStack
	    return
	}

	# Get the last widget focus.
	set widgetfocus [::focus -lastfor $focusHolder]

	::focus -force $focusHolder

	# Raise focus holder window.
	::raise $focusHolder
	bell -displayof $focusHolder

	# Raise focus holder window again, after idle
	# so that if we lost focus we can get it back
	# after everything has settled down.
	after idle "::raise $focusHolder"

	# Set focus to the last widget that was active.
	::focus $widgetfocus
    }

    public method PopModalStack {} {

	if {$modalstack == ""} {
	    return
	}
	return [lvarpop modalstack]
    }

    public method PushModalStack {window} {
	lvarpush modalstack $window
    }

    public method TopModalStack {} {
	if {$modalstack != ""} {
	    return [lindex $modalstack 0]
	}
    }

    itk_option define -leader leader Leader "" {
        global tcl_platform

        if {$tcl_platform(platform) == "windows"} {
            set leader ""
        }
        if {${leader} != "" && [winfo exists ${leader}]} {
            set leader [winfo toplevel ${leader}]
        }
        if {${leader} != "" && [winfo exists ${leader}] && [winfo exists\
          $itk_component(hull)]} {
            bind ${leader} <Map> "catch {${this} deiconify}"
            bind ${leader} <Unmap> "catch {${this} withdraw}"
# FIXME: This <Destroy> would not work, and it really should not be used since
# itk does a Destroy binding for us.
            #bind ${leader} <Destroy> "catch {${this} delete}"
        }
    }

    itk_option define -input_check input_check Input_Check "1" {
        sn_input_check_in_window $itk_component(hull) $itk_option(-input_check)
    }

    itk_option define -iconbitmap iconbitmap IconBitmap "" {
        wm iconbitmap $itk_component(hull) $itk_option(-iconbitmap)
    }

    itk_option define -geometry geometry Geometry "" {
        # Full: 200x200+144+144
        # Short: 200x200
        # XY:    +144+144 (ignore)
        set geom $itk_option(-geometry)
        if {[regexp {([0-9]+)x([0-9]+)} $geom whole width height]} {
            set explicit_width $width
            set explicit_height $height
        }
        wm geometry $itk_component(hull) $geom
    }

    itk_option define -iconmask iconmask IconMask "" {
        wm iconmask $itk_component(hull) $itk_option(-iconmask)
    }

    itk_option define -iconname iconname IconName "" {
        wm iconname $itk_component(hull) $itk_option(-iconname)
    }

# FIXME: The -width and -height options don't work
# because the Toplevel class does not keep them.

    itk::usual Window {
        keep -background -bd -bg -borderwidth -container
        keep -colormap -cursor -height -menu -relief -title
        keep -screen -use -visual -width
    }

    protected variable leader ""

    protected variable old_grab ""

    protected variable explicit_width -1
    protected variable explicit_height -1

    common modalstack ""

    common internal_name .sn_

    # Currenltly, wm iconbitmap only support xbm. Either we need a b&w
    # version of the ide icon, or we need to add xpm support.

    set iconfile paf.xbm

    global sn_path
    common iconbitmap @[file join $sn_path(bitmapdir) ${iconfile}]

    common seq 0
}

proc take_focus {win {wdg ""}} {
    global sn_force_flag tcl_platform
    if {![winfo exists ${win}]} {
        return -1
    }
    if {$tcl_platform(platform) == "windows"} {
        eval focus ${sn_force_flag} [winfo toplevel ${win}]
    }
    if {${wdg} != "" && [winfo exists ${wdg}] && [winfo toplevel ${wdg}] !=\
      ${wdg}} {
        eval focus ${sn_force_flag} ${wdg}
    }
    return 0
}

proc window_configure {win {cmd normal} {focus_wdg ""}} {
    if {![winfo exists ${win}]} {
        return
    }
    switch -- ${cmd} {
        "normal" -
        "deiconify" {
                global sn_force_flag
                eval focus ${sn_force_flag} [focus -lastfor ${win}]
                wm deiconify ${win}
                eval focus ${sn_force_flag} [focus -lastfor ${win}]
                raise ${win}
                if {${focus_wdg} != ""} {
                    focus ${focus_wdg}
                }
            }
        "withdraw" {
                wm withdraw ${win}
            }
        default {
                error "unrecognized key: ${cmd}"
            }
    }
}

#bind Escape and WM-close hint to the window
proc on_close {w {cmd ""}} {
    if {${cmd} == ""} {
        set cmd "${this} delete"
    }
    wm protocol ${w} WM_DELETE_WINDOW ${cmd}
    bind ${w} <Escape> ${cmd}
}

proc sn_create_window {w {add_msg 1}} {
    global sn_options
    global sn_path sn_product_name sn_ide

    set m ${w}.menu
    set exp ${w}.exp
    set date ${w}.status.date
    set bitpath $sn_path(bitmapdir)

    if {![winfo exists ${w}]} {
        sourcenav::Window ${w} -menu ${m}
    } else {
        # FIXME: this should be part of the snavigator::Window class?
        set iconfile paf.xbm
        ${w} configure -iconbitmap @[file join ${bitpath} ${iconfile}]
        ${w} configure -menu ${m}
    }
    ${w} minsize 20 1

    menu ${m} -tearoff 0

    ## File menu
    ####################
    menu ${m}.file -tearoff 0 -postcommand "ProjectMenuEntries_post ${m}.file\
      subwindow"
    ${m} add cascade -label [get_indep String EditFile] -menu ${m}.file\
      -underline [get_indep Pos EditFile]

    #project menu entries
    AddProjectMenuEntries ${m}.file ${w}

    ${m}.file add separator

    #close window
    ${m}.file add command -command " eval \[wm protocol ${w}\
      WM_DELETE_WINDOW\] " -label [get_indep String WindowsClose]\
      -underline [get_indep Pos WindowsClose]

    ${m}.file add command -label [get_indep String Exit] -underline\
      [get_indep Pos Exit] -command " sn_exit "

    ## Edit menu
    menu ${m}.edit -tearoff 0

    ${m} add cascade -label [get_indep String EditEdit] -menu ${m}.edit\
      -underline [get_indep Pos EditEdit]

    #project preferences
    ${m}.edit add command -label [get_indep String ProjectPreferencesMenu]\
      -underline [get_indep Pos ProjectPreferencesMenu]\
      -command sn_project_preferences

    ## History
    AddHistMenu ${m}

    ##Windows
    AddWindowsMenu ${m} ${w}

    ##Help
    AddHelpMenu ${m} ${w}
    ${w} config -menu ${m}

    frame ${exp} -relief groove -bd 2

    pack ${exp} -side top -fill x

    frame ${w}.status
    pack ${w}.status -side bottom -fill x

    global ${w}.reusable
    set ${w}.reusable 1
    checkbutton ${w}.status.reuse -relief groove -text [get_indep String\
      Reuse] -variable ${w}.reusable -font $sn_options(def,layout-font)

    pack ${w}.status.reuse -side left

    if {${add_msg}} {
        set info ${w}.status.msg
        pack [label ${info} -font $sn_options(def,layout-font) -anchor w\
          -relief groove -bd 2] -side left -anchor w -fill both -expand y
        pack propagate ${info} 0
    }
}

proc sn_window_add_icons {w buttons} {
    set exp ${w}.exp

    #Hierarchy
    if {[lsearch -exact ${buttons} "ctree"] != -1} {
        button ${exp}.tree -takefocus 0 -image tree_image -command "sn_classtree" -state disabled
        bind_history ${exp}.tree tree
        balloon_bind_info ${exp}.tree [get_indep String INFOHierarchy]
        pack ${exp}.tree -side left
    }

    #Class
    if {[lsearch -exact ${buttons} "class"] != -1} {
        button ${exp}.class -takefocus 0 -image watch_image -command "sn_classbrowser" -state disabled
        bind_history ${exp}.class browse
        balloon_bind_info ${exp}.class [get_indep String INFOStartClassBrw]
        pack ${exp}.class -side left
    }

    #Xref
    if {[lsearch -exact ${buttons} "xref"] != -1} {
        button ${exp}.cross -takefocus 0 -image crossref_image -command "sn_xref"
        bind_history ${exp}.cross xref
        balloon_bind_info ${exp}.cross [get_indep String PafCrossRef]
        pack ${exp}.cross -side left
    }

    #Include
    if {[lsearch -exact ${buttons} "inc"] != -1} {
        button ${exp}.inc -takefocus 0 -image include_image -command "sn_include"
        bind_history ${exp}.inc xref
        balloon_bind_info ${exp}.inc [get_indep String IncludeLaunch]
        pack ${exp}.inc -side left
    }
}

proc sn_window_append_print {w cmd} {
    set m ${w}.menu
    set exp ${w}.exp
    set info ${w}.status.msg

    ${m}.edit insert 0 separator
    ${m}.edit insert 0 command -label [get_indep String Print]\
      -underline [get_indep Pos Print] -command ${cmd}
}