summaryrefslogtreecommitdiff
path: root/lib/lib/innerwindow.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/lib/innerwindow.tcl')
-rwxr-xr-xlib/lib/innerwindow.tcl360
1 files changed, 360 insertions, 0 deletions
diff --git a/lib/lib/innerwindow.tcl b/lib/lib/innerwindow.tcl
new file mode 100755
index 0000000..f1d2505
--- /dev/null
+++ b/lib/lib/innerwindow.tcl
@@ -0,0 +1,360 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+# Copyright (C) 2007-2009 by Martin Ošmera #
+# martin.osmera@gmail.com #
+# #
+# This program 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 of the License, or #
+# (at your option) any later version. #
+# #
+# This program 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 this program; if not, write to the #
+# Free Software Foundation, Inc., #
+# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
+############################################################################
+
+
+# --------------------------------------------------------------------------
+# DESCRIPTION
+# Implements tool for creating application inner windows. That means windows
+# which are enclosed in the main window. And which are not managed by window
+# manager but by their own implementation. These windows are inside the main
+# window and cannot be dragged outside.
+#
+# REQUIREMENTS:
+# Librararies: "Incr TCL", "BWidget", "Tk"
+# This class also requires this: "namespace import ::itcl::*"
+# --------------------------------------------------------------------------
+
+class InnerWindow {
+ ## COMMON
+ common active_titclr {#AAAAFF} ;# Color: Active background color
+ common inactive_titclr {#DDDDDD} ;# Color: Inactive background color
+ common title_bar_height 10 ;# Int: Height of the titlebar in pixels
+
+ # List: Title bar popup menu
+ common MENU {
+ {command "Shade/Unshade" "" 0 {collapse_expand}
+ {}}
+ {command "Close" "" 0 {close_window}
+ {}}
+ }
+
+ ## PRIVATE
+ private variable win_height
+ private variable max_X ;# Int: Auxiliary variable for storing max. allowed position
+ private variable max_Y ;# Int: Auxiliary variable for storing max. allowed position
+ private variable click_X ;# Int: Auxiliary variable for storing last position
+ private variable click_Y ;# Int: Auxiliary variable for storing last position
+
+ private variable close_cmd
+ private variable title_bar ;# Widget: Window title bar
+ private variable title_label ;# Widget: Label containg text "Scribble notepad"
+ private variable close_button ;# Widget: Close button
+ private variable coll_exp_but ;# Widget: Shade button
+ private variable win
+ private variable main_frame ;# Widget: Main window frame
+ private variable minim_flag 0 ;# Bool: Shaded or not
+ private variable allow_raise_win 1 ;# Bool: Allows to use command
+
+ private variable menu ;# Widget: Title bar popup menu
+ private variable menu_created 0 ;# Bool: Title bar popup menu created
+
+ private variable close_window_in_progress 0 ;# Bool: Close procedure is in progress
+
+ ## Object constructor
+ # @parm Widget path - Window path (e.g. ".window_agent_007")
+ # @parm List geometry - {W H X Y} (Coordinates are raltive to the transient window)
+ # @parm String title - Window title
+ # @parm Image icon - Window icon, {} means no icon
+ # @parm String _close_cmd - Command to execute on close in the root namespace (stack frame #0)
+ constructor {path geometry title icon _close_cmd} {
+
+ # Configure specific ttk styles
+ ttk::style configure InnerWindow_Active.TButton \
+ -background $active_titclr \
+ -padding 0 \
+ -borderwidth 1 \
+ -relief flat
+ ttk::style map InnerWindow_Active.TButton \
+ -background [list active $active_titclr] \
+ -relief [list active raised]
+
+ ttk::style configure InnerWindow_Inactive.TButton \
+ -background $inactive_titclr \
+ -padding 0 \
+ -borderwidth 1 \
+ -relief flat
+ ttk::style map InnerWindow_Inactive.TButton \
+ -background [list active $inactive_titclr] \
+ -relief [list active raised]
+
+ # Set object variables
+ set max_X 1000
+ set max_Y 1000
+ set close_cmd $_close_cmd
+
+ # Create window GUI components
+ set win [frame $path -bd 1 -relief raised -bg $active_titclr -padx 2 -pady 2]
+ set main_frame [frame $win.main_frame]
+ set menu $win.menu
+
+ ## Create title bar
+ # - Title bar frame
+ set title_bar [frame $win.title_bar \
+ -bg $active_titclr \
+ -height $title_bar_height \
+ ]
+ set title_label [label $title_bar.text \
+ -bg $active_titclr -pady 0 \
+ -compound left -text $title \
+ -cursor left_ptr \
+ ]
+ if {$icon != {}} {
+ $title_label configure -image $icon -padx 5
+ }
+ # - Button "Close"
+ set close_button [ttk::button $title_bar.close_but \
+ -style InnerWindow_Active.TButton \
+ -command "$this close_window" \
+ -image ::ICONS::16::button_cancel \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $close_button -text [mc "Close"]
+ setStatusTip -widget $close_button -text [mc "Close"]
+ # - Button "Shade"
+ set coll_exp_but [ttk::button $title_bar.col_exp_but \
+ -style InnerWindow_Flat.TButton \
+ -command "$this collapse_expand" \
+ -image ::ICONS::16::_1uparrow \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $coll_exp_but -text [mc "Shade"]
+ setStatusTip -widget $coll_exp_but -text [mc "Shade"]
+ # Pack buttons
+ pack $coll_exp_but -padx 5 -side left -pady 0 -ipady 0
+ pack $close_button -side right -pady 0 -ipady 0 -padx 3
+ pack $title_label -side left -fill x -pady 0 -ipady 0 -expand 1
+ raise $close_button
+ # Set title bar event bindings
+ bind $title_label <Double-1> "$this collapse_expand; break"
+ bind $title_label <Button-1> "$this title_B1 %X %Y"
+ bind $title_label <B1-Motion> "$this title_B1_motion %X %Y; break"
+ bind $title_label <ButtonRelease-1> "$this title_B1_release; break"
+ bind $title_label <ButtonRelease-3> "$this title_B3_release %X %Y; break"
+
+
+ pack $title_bar -fill x
+ pack $main_frame -fill both -expand 1
+
+ # Show the window
+ set win_height [lindex $geometry 1]
+ bind $win <Destroy> "catch {delete object $this}"
+ bind $main_frame <Destroy> "catch {delete object $this}"
+ bind $win <Visibility> "$this raise_win"
+ bind $win <FocusIn> "$this focusin"
+ bind $win <FocusOut> "$this focusout"
+ place $win \
+ -width [lindex $geometry 0] \
+ -height [lindex $geometry 1] \
+ -x [lindex $geometry 2] \
+ -y [lindex $geometry 3] \
+ -anchor nw
+ raise $win
+ }
+
+ ## Object destructor
+ destructor {
+ close_window
+ }
+
+ ## Withdraw the window
+ # Note: Window can be taken back to visible state using method "geometry"
+ # @see geometry
+ # @return
+ public method withdraw {} {
+ place forget $win
+ }
+
+ ## Close the window
+ # @return void
+ public method close_window {} {
+ if {$close_window_in_progress} {return}
+ set close_window_in_progress 1
+
+ uplevel #0 $close_cmd
+ destroy $win
+ }
+
+ ## Get window inner frame where to map widgets in the window
+ # @return Widget - Inner frame
+ public method get_frame {} {
+ return $main_frame
+ }
+
+ ## Get and/or set window geometry including frame and title bar
+ # @parm Int = {} - Width
+ # @parm Int = {} - Height
+ # @parm Int = {} - Relative position -- X
+ # @parm Int = {} - Relative position -- Y
+ # Note: If you want to set only certain attributes then set others as {}
+ # @return Current window geometry {W H X Y}
+ public method geometry args {
+ # Set geometry
+ if {[llength $args]} {
+ if {[string length [lindex $args 0]]} {
+ place $win -width [lindex $args 0]
+ }
+ if {[string length [lindex $args 1]]} {
+ place $win -height [lindex $args 1]
+ set win_height [lindex $args 1]
+ }
+ if {[string length [lindex $args 2]]} {
+ place $win -x [lindex $args 2]
+ }
+ if {[string length [lindex $args 3]]} {
+ place $win -y [lindex $args 3]
+ }
+ update
+ }
+
+ # Get geometry
+ return [list \
+ [winfo width $win] \
+ [winfo height $win] \
+ [winfo x $win] \
+ [winfo y $win] \
+ ]
+ }
+
+ ## Event handler: window frame <FocusIn>
+ # @return void
+ public method focusin {} {
+ update
+ foreach widget [list $title_bar $title_label $win] {
+ $widget configure -bg $active_titclr
+ }
+ foreach widget [list $close_button $coll_exp_but] {
+ $widget configure -style InnerWindow_Active.TButton
+ }
+
+ update
+ }
+
+ ## Event handler: window frame <FocusOut>
+ # @return void
+ public method focusout {} {
+ update
+ foreach widget [list $title_bar $title_label $win] {
+ $widget configure -bg $inactive_titclr
+ }
+ foreach widget [list $close_button $coll_exp_but] {
+ $widget configure -style InnerWindow_Inactive.TButton
+ }
+
+ update
+ }
+
+ ## (Un)Shade window
+ # @return void
+ public method collapse_expand {} {
+ # Object variables
+ set minim_flag [expr {!$minim_flag}]
+
+ # Shade
+ if {$minim_flag} {
+ set image _1downarrow
+ pack forget $main_frame
+ place $win -height [expr {[winfo height $win.title_bar] + 4}]
+ # Unshade
+ } {
+ set image _1uparrow
+ pack $main_frame -fill both -expand 1
+ place $win -height $win_height
+ }
+ $coll_exp_but configure -image ::ICONS::16::$image
+ }
+
+ ## Determinate whether the window is shaded or not
+ # @return Bool - 1 == Shaded; 0 == Not shaded
+ public method get_minim_flag {} {
+ return $minim_flag
+ }
+
+ ## Insure window visibility
+ # @return void
+ public method raise_win {} {
+ if {!$allow_raise_win} {return}
+ set allow_raise_win 0
+ after 1000 "catch {$this set_allow_raise_win}"
+ raise $win
+ }
+
+ ## @see raise_win
+ # @return void
+ public method set_allow_raise_win {} {
+ set allow_raise_win 1
+ }
+
+ ## Event handler: title bar <Button-1>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B1 {x y} {
+ set click_X [expr {[winfo x $win] - $x}]
+ set click_Y [expr {[winfo y $win] - $y}]
+
+ set max_X [winfo width .]
+ set max_Y [winfo height .]
+ incr max_X -70
+ incr max_Y -70
+
+ focus $win
+ $title_label configure -cursor fleur
+ }
+
+ ## Event handler: title bar <ButtonRelease-1>
+ # @return void
+ public method title_B1_release {} {
+ $title_label configure -cursor left_ptr
+ }
+
+ ## Event handler: title bar <ButtonRelease-3>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B3_release {X Y} {
+ focus $win
+
+ if {!$menu_created} {
+ menuFactory $MENU $menu 0 "$this " 0 {}
+ set menu_created 1
+ }
+
+ tk_popup $menu $X $Y
+ }
+
+ ## Event handler: title bar <B1-Motion>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B1_motion {x y} {
+ incr x $click_X
+ incr y $click_Y
+
+ if {$x > 0 && $x < $max_X} {
+ place $win -x $x
+ }
+ if {$y > 0 && $y < $max_Y} {
+ place $win -y $y
+ }
+ }
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-26 14:15:13 +0000