#
# $Header: /home/rockware/cvs-main/operator/tcl/opTopLevel.tcl,v 1.39 1995/03/02 23:41:39 erez Exp $
# Written by: Erez Strauss (C) All Rights Reserved 1994, 1995.
#
#  5. General top level windows support
#
# The OpTopLevel
# The binding to the widget destroy, calls the most specific delete function
# for the instance, also for derived classes.

itcl_class OpTopLevel {
    # No inherit, will be used as base for others.
    # constructor / destructor
    constructor config {
        catch {destroy $this}
        #
        #  Create a window with the same name as this object
        #
        set class [$this info class]
        ::rename $this $this-tmp-
        toplevel $this -class $class
        # ::frame $this -class $class
        ::rename $this $this-win-
        ::rename $this-tmp- $this

        set cmd "catch {$this delete}"
        set e <Destroy>
        bind $this $e "+$cmd"
        bind $this $e +[bind [winfo class $this] $e]
        # bind $this $e "+puts {TopLevel bind destructor}"
        # Window manager handling.

        wm protocol $this WM_DELETE_WINDOW "$this delete"

        if {$title != {}} { wm title $this $title }
        if {$iconname != {}} { wm iconname $this $iconname }
        if {$iconbitmap != {}} {
            set f [opNameToFile $iconbitmap bitmap]
            if {$f != {}} {
                wm iconbitmap $this @$f
            }
        }
        wm minsize $this 1 1
        # Frames creation: title, menu, info, buttons.
        frame $this.title
        frame $this.info
        if {$title_flag == {}} {set title_flag $default_title_flag}
        # Window Title.
        label $this.title.label -text $name
        if {"$name" != {}} {
            ::pack $this.title.label -fill x -expand on
        }
        # Buttons creation and mapping.
        regsub -all THIS $buttons $this this_buttons
        set buttonsbox [OpButtonsBox $this.buttons -buttons $this_buttons]
        if {$btn_config != {}} {$buttonsbox config $btn_config}

        # Menus
        regsub -all THIS $menus $this this_menus
        if {$this_menus != {}} {
            foreach m $this_menus {
                mm_Menu [string range $this[lindex $m 0] 1 end] [lindex $m 1]
            }
        }
        regsub -all THIS $menu_bar $this this_menu_bar
        if {$this_menu_bar != {}} {
            # create the menu bar items list.
            set mbit {}
            foreach b $this_menu_bar {
                lappend mbit [lreplace $b 2 2 [string range $this[lindex $b 2] 1 end]]
            }
            mm_MenuBar $this.menu $mbit
        } {
            frame $this.menu
        }
        # Active help Setting.
        if {"$active_help" != {}} {
            opActiveHelpBind $this $active_help
        }
        if {"$balloon_help" != {}} {
            # tixAddBalloon $this $balloon_help
            # tixAddBalloon $this.title.label $balloon_help
            opBalloonHelp $this $balloon_help
            opBalloonHelp $this.title.label $balloon_help
        }
        set work_space $this.info
        set after_constructor 1
        pack
    }
    destructor {
        if {$buttonsbox != {}} {$buttonsbox delete}
        ::rename $this-win- {}
        catch "destroy $this"
    }
    method config config {return {}}

    # There are 8 packing configuration. The title is at the top (if it
    # is packed). Then there are 6 ways to arrange the Menus, Buttons and Info.
    # The other two options has the menu at the top (after the title) and the
    # Buttons and Info side by side.
    # MBI, MIB, BMI, BIM, IMB, IBM, M(BI), M(IB)
    # The packing order is first the top part, and last the info.

    method pack {} {
        if !$title_flag "::pack forget $this.title"
        if {$pack_option < 0 || $pack_option > 7} {set pack_option 0}
        catch "::pack forget [::pack slaves $this]"
        switch $pack_option {
            0   {
                # MBI
                $buttonsbox config -direction lr
                ::pack $this.menu    -side top    -fill x
                ::pack $this.buttons -side top    -fill [$buttonsbox fill_d]
                ::pack $this.info    -side bottom -fill both -expand on -padx 4 -pady 4
            }
            1   {
                # MIB
                $buttonsbox config -direction lr
                ::pack $this.menu    -side top    -fill x
                ::pack $this.buttons -side bottom -fill [$buttonsbox fill_d]
                ::pack $this.info    -side top    -fill both -expand on -padx 4 -pady 4
            }
            2   {
                # BMI
                $buttonsbox config -direction lr
                ::pack $this.buttons -side top    -fill [$buttonsbox fill_d]
                ::pack $this.menu    -side top    -fill x
                ::pack $this.info    -side bottom -fill both -expand on -padx 4 -pady 4
            }
            3   {
                # BIM
                $buttonsbox config -direction lr
                ::pack $this.buttons -side top    -fill [$buttonsbox fill_d]
                ::pack $this.menu    -side bottom -fill x
                ::pack $this.info    -side top    -fill both -expand on -padx 4 -pady 4
            }
            4   {
                # IMB
                $buttonsbox config -direction lr
                ::pack $this.buttons -side bottom -fill [$buttonsbox fill_d]
                ::pack $this.menu    -side bottom -fill x
                ::pack $this.info    -side top    -fill both -expand on -padx 4 -pady 4
            }
            5   {
                # IBM
                $buttonsbox config -direction lr
                ::pack $this.menu    -side bottom -fill x
                ::pack $this.buttons -side bottom -fill [$buttonsbox fill_d]
                ::pack $this.info    -side top    -fill both -expand on -padx 4 -pady 4
            }
            6   {
                # M(BI)
                $buttonsbox config -direction ud
                ::pack $this.menu    -side top    -fill x
                ::pack $this.buttons -side left   -fill [$buttonsbox fill_d]
                ::pack $this.info    -side right  -fill both -expand on -padx 4 -pady 4
            }
            7   {
                # M(IB)
                $buttonsbox config -direction ud
                ::pack $this.menu    -side top    -fill x
                ::pack $this.buttons -side right  -fill [$buttonsbox fill_d]
                ::pack $this.info    -side left   -fill both -expand on -padx 4 -pady 4
            }
        }
        if $title_flag {
            set s [::pack slaves $this]
            if {$s != {}} {
                set s [lindex $s 0]
                ::pack $this.title -side top -fill x -before $s
            }
        }
    }
    method raise {} {
        # check the blt_raise command.
        wm geometry  $this [wm geometry $this]
        wm withdraw  $this
        wm deiconify $this
    }
    method iconify {} {
        wm iconify $this
    }
    method deiconify {} {
        wm deiconify $this
    }
    method move_out {{part menu}} {
        toplevel $this.out$part
        wm trans $this.out$part
        ::pack forget $this.$part
        ::pack $this.$part -in $this.out$part
    }
    method move_in {{part menu}} {
        ::pack forget $this.$part
        ::pack $this.$part -expand on -fill both
        destroy $this.out$part
    }
    # information about the internal widgets.
    method win     {} {return $this}
    method inf     {} {return $this.info}
    method work_space {} {return $this.info}
    method title   {} {return $this.title}
    method menu    {} {return $this.menu}
    method button  {} {return $this.button}

    proc cursor_all {{c {}}} {
        foreach w [itcl_info objects -isa OpTopLevel] {
            $w-win- config -cursor $c
        }
    }
    proc bind_all {e c} {
        foreach w [itcl_info objects -isa OpTopLevel] {
            bind $w $e $c
        }
    }
    proc title_flag_all {{val 1}} {
        set default_title_flag $val
        foreach w [itcl_info objects -isa OpTopLevel] {
            $w config -title_flag $val
        }
    }
    
    # name - the name of the window in the title label
    public name {} {
        if $after_constructor {
            $this.title.label config -text $name
            if {$name != {}} {
                ::pack $this.title.label -fill x -expand on
            } {
                ::pack forget $this.title.label
            }   
        }
    }
    
    # title is the title that appears in the Window manager.
    public title      {} {if $after_constructor {wm title $this $title}}
    # title_flag - indicate, to pack the title label sub window.
    public title_flag {} {if $after_constructor pack}
    public iconname   {} {if $after_constructor {wm iconname $this $iconname}}
    public iconbitmap {} {if $after_constructor {wm iconbitmap $this @[opNameToFile $iconbitmap bitmap]}}
    # update the menus and the menubar, not supported
    public menus      {} {if $after_constructor {error {OpTopLevel: Can't change menus.}}}
    public menu_bar   {} {}      ;# ...
    public buttons    {} {if $after_constructor $buttonsbox config -buttons $buttons}
    public pack_option 0 {if $after_constructor pack}
    public active_help {} {}       ;# update the active help bindings
    public balloon_help {} {}  ;# Ballon help
    public btn_config {} {if $after_constructor {$buttonsbox configure $btn_config}}

    public cursor {} {if $after_constructor {$this-win- config -cursor $cursor}}
    # The protected members
    protected work_space {}
    protected buttonsbox {}
    protected after_constructor 0
    # common default_title_flag 1
    common default_title_flag 0
    common tl_menus {
        {tl_help {
            {menu help_index -label {Help Subjects}}
            {command -label {How to use help...} -command {opHelp {help system}} -underline 0}
            {checkbutton -label {Active Balloons} -onvalue 1 -offvalue 0 -variable OPBalloonHelp(active)}
            {checkbutton -state disabled -label {Help Messages} -onvalue 1 -offvalue 0 -variable OPBalloonsFlag -command {global OPAtiveHelp ; OpControl :: active_help $OPAtiveHelp}}
            {label -label {Operator Tutorial...} -command {opHelpTutorial} -underline 10}
            {separator}
            {label -label {Keyboard bindings...} -command {opHelp Bindings}}
            {label -label {Mouse control...} -command {opHelp mcontrol}}
            {label -label {windows types...} -command {opHelp wintypes THIS}}
            {separator}
            {command -label {Ordering Information...} -command {opHelp order} -underline 0}
            {separator}
            {command -label {About Operator} -command {opHelp {About Operator}} -underline 0}}
        }
        {tl_wins {
            {command -label Control -underline 0 -command {.control raise}}
            {command -label Applications... -command {OpAppGroup :: display_top} -underline 0}
            {command -label View  -underline 0 -command {OpDirView :: show_one OpDirView}}
            {command -label Tree  -underline 0 -command {OpDirTree :: show_one OpDirTree}}
            {command -label Icons -underline 0 -command {OpDirIcons :: show_one OpDirIcons}}
            {command -label XTerm -underline 0 -command {after 2 {OpXTerm :: new}}}
            {command -label Clock -underline 0 -command opClockOpen}}
        }
        {tl_help_lists {
            {command -label {Keyboard bindings...} -command {opHelp Bindings}}
            {command -label {Mouse control...} -command {opHelp mcontrol}}
            {command -label {windows types...} -command {opHelp wintypes}}}
        }
    }
}

# End of General top level windows support
