#	------------------------------------------------------------
#   Copyright (c) 2012-2020
#	Q.W.Page Associates Inc.
#	www.qwpage.com
#	All rights reserved.
#	------------------------------------------------------------

::namespace eval ::qw::winutil {};
#	------------------------------------------------------------
#  	::qw::winutil::bbox_from_widget
#	------------------------------------------------------------
::proc ::qw::winutil::bbox_from_widget {sargs} {
    /* {
	::qw::dialog::bbox .widget .xxx;

	Given an widget, returns its bounding box. Generally used to help place an
    edit assist widget.

    Bounding box is of form [::list x y width height];

    This should be a more generally available method.

	This is compatible tk widget but beware the objects in a canvas use a different
    bounding box (x1 y1 x2 y2).
    */ }
    ::set Widget [::sargs::get $sargs .widget];
    ::if {![::winfo exists $Widget]} {
        ::return "";
    }
    ::set x1 [::winfo rootx $Widget];
    ::set y1 [::winfo rooty $Widget];
    ::set Width [::winfo reqwidth $Widget];
    ::set Height [::winfo reqheight $Widget];
    ::set Result [::list $x1 $y1 $Width $Height];
    ::return $Result;
}
#	------------------------------------------------------------
#  	::qw::winutil::edit_assist_position_toplevel
#	------------------------------------------------------------
::proc ::qw::winutil::edit_assist_position_toplevel {sargs} {
	/* {
	Positions a toplevel around a widget for purpose of edit assist. Caller
    can supply a bbox and the supplied toplevel will placed around it
    where appropriate, or else can supplie the widget whose bbox we want
    to use. If both a bbox and a widget are supplied, the bbox will be used.

	::qw::winutil::position_toplevel .toplevel $Toplevel .widget $EntryWidget;

    or

	::qw::winutil::position_toplevel .toplevel $Toplevel .widget $EntryWidget;

	bbox is in form x y width height

	Positions a toplevel around a bbox. By default we position the toplevel,
    usually a modal dialog box, under the bbox but if it doesn't fit we position
    it elsewhere until it does.

	Notes on bbox.
		canvas item -> x1 y1 x2 y2
    	entry -> x y w h
    	list item -> x y w h
    	spinbox -> x y w h
    	text -> x y w h
    	grid -> x y w h
    	tktable cell -> x y w h

    */ }
	::set BBox [::sargs::get $sargs .bbox];
	::switch -- [::llength $BBox] {
		0 {
			/* {
			If there is no BBox, is there a widget. If so, use it's bbox. If not
            do nothing and get out.
            */ }
            ::set Widget [::sargs::get $sargs .widget];
            ::if {![::winfo exists $Widget]} {
				#2.27.3
				/* {
				If a bbox or widget was not specified then we will position near the
                dot widget, i.e. the main application window.
                */ }
/* {
				::if {[::winfo exists .]} {
                    ::set Toplevel [::sargs::get $sargs .toplevel];
                    ::if {![::winfo exists $Toplevel]} {
                        ::return;
                    }
	                ::set x [::expr {[::winfo rootx .]+100}];
                    ::set y [::expr {[::winfo rooty .]+100}];
	                ::wm geometry $Toplevel +$x+$y;
#	                ::wm geometry $Toplevel +[::expr {[::winfo rootx .]+50}]+[::expr {[::winfo rooty .]+50}];
				}
*/ }
                ::return;
            }
            ::set BBox [$Widget bbox];
        }
		4 {
        }
		default {
            ::qw::throw "[::qw::methodname] - invalid bbox \"$BBox\".";
        }
    }
	::set Toplevel [::sargs::get $sargs .toplevel];
	::if {![::winfo exists $Toplevel]} {
    	::return;
    }
    ::set ulx [::lindex $BBox 0];
    ::set uly [::lindex $BBox 1];
    ::set lrx [::expr {$ulx+[::lindex $BBox 2]}];
    ::set lry [::expr {$uly+[::lindex $BBox 3]}];
    ::set DialogX $ulx;
    ::set DialogY $lry;
	#nv2.28.3 (bug fix) - ::qw::dialog::position - replaced [::winfo screenwidth $Path] with [::lindex [::wm maxsize $Path] 0] - for dual and multiple monitor
	#::set ScreenWidth [::winfo screenwidth $Toplevel];
	#::set ScreenHeight [::winfo screenheight $Toplevel];
	::set ScreenWidth [::lindex [::wm maxsize $Toplevel] 0];
    ::set ScreenHeight [::lindex [::wm maxsize $Toplevel] 1];
    ::set DialogWidth [::winfo reqwidth $Toplevel];
    ::set DialogHeight [::winfo reqheight $Toplevel];
    ::if {[::expr {$DialogX+$DialogWidth}]>$ScreenWidth} {
        /* {
        Kludge Alert: Need to add the border width but don't have it.
        */ }
        ::set DialogX [::expr $ScreenWidth-$DialogWidth-15]
    }
    ::if {$DialogX<0} {
        ::set DialogX 0;
    }
    ::if {[::expr {$DialogY+$DialogHeight}]>$ScreenHeight} {
        /* {
        Kludge Alert: Need to add the title height but don't have it.
        */ }
        ::set DialogY [::expr $uly-$DialogHeight-27]
    }
    ::if {$DialogY<0} {
        ::set DialogY 0;
    }
    ::wm geometry $Toplevel +$DialogX+$DialogY;
}
::proc ::qw::winutil::file_type_from_pattern {sargs} {
	/* {
	tk_getOpenFile/tk_getSaveFile use a list of "filetypes" that consist of a description
    and the extension. To keep things consistent we perfom the mapping here and let
    the various calls share the same mappings.

	2.24.1 - added .csv
    */ }
	::set Pattern [::sargs::get $sargs .pattern];
    ::switch -- [::string tolower $Pattern] {
		*.gif {
            ::return [::list "Graphic Interchange Format" $Pattern];
        }
        *.jpeg -
        *.jpg {
            ::return [::list "Photograph" $Pattern];
        }
        *.xls {
            ::return [::list "Microsoft Excel Workbook" $Pattern];
        }
        *.xlt {
            ::return [::list "Microsoft Excel Template" $Pattern];
        }
		*.xlsx {
            ::return [::list "Microsoft Excel Workbook (XML)" $Pattern];
        }
        *.xltx {
            ::return [::list "Microsoft Excel Template (XML)" $Pattern];
        }
        *.doc {
            ::return [::list "Microsoft Word Document" $Pattern];
        }
        *.docx {
            ::return [::list "Microsoft Word Document (XML)" $Pattern];
        }
        *.dot {
            ::return [::list "Microsoft Word Template" $Pattern];
        }
        *.htm -
        *.html {
            ::return [::list "Web Page" $Pattern];
        }
        *.txt {
            ::return [::list "Text" $Pattern];
        }
        *.nv2 {
            ::return [::list "NewViews Database" $Pattern];
        }
        *.qw_script* {
            ::return [::list "NewViews Script" $Pattern];
        }
        *.nv2_screen_template {
            ::return [::list "NewViews Screen Template" $Pattern];
        }
        *.nv2_window_template {
            ::return [::list "NewViews Window Template" $Pattern];
        }
        *.nv2_database_template {
            ::return [::list "NewViews Database Template" $Pattern];
        }
        *.csv {
            ::return [::list "Comma-separate values" $Pattern];
        }
    }
	::return [::list "any file type (unspecified)" $Pattern];
}
::namespace eval ::qw::tooltip {}
#	------------------------------------------------------------
#  	::qw::tooltip (balloon help)
#	------------------------------------------------------------
/* {
	Call this method to setup tooltop help on the supplied widget and its
    subtree, i.e. its owned descendants. Whenever the cursor hovers over the
    widget or sub-widget, the callback is called to get the text for the tooltip.

	Note that with this design the tooltop text can be generated on the fly, but
    it is unfortuately "attached" to the widget during this call, and not when
    the cursor is actually over the widhet (or sub-widget).

	It would be even more general if the callback actually displayed the
    tooltip text but this is probably overkill. Howver we do return the text
    in a structure as field .text, and not as a scaler value. That will
    allow for alternatives such as returning .html to display tooltips in
    a tkhtml3 widget, for example.

	Substitutions
    -------------
	The substitutions in the callback are:

    	%widget% - cursor hovering over this widget


	Examples
    ------------

	To set up and turn on balloon help:

    	::qw::tooltip::enable .widget $Widget .command [::itcl::code $this tooltip_get .widget %widget%];

	To unset and disable balloon help:

    	::qw::tooltip::disable .widget $Widget;


	The Callback
    ------------

	The callback looks something like:

        method tooltip_get {args} {
            ::set Widget [::sargs::get $sargs .widget];
            ::switch -glob -- $Widget {
                *.year_next_button  {
                    ::set Text "Move to next year.\nAlso <Ctrl>+<PageDown>";
                    ::return [::sargs .text $Text];
                }

                ...

                *.button_frame.ok* {
                    ::set Text "Pick the current date.\n Also double-click or <Enter>.";
                    ::return [::sargs .text $Text];
                }
                *.client.formatted_date* {
                    ::set Text .text "Calendar is currently positioned on this date.";
                    ::return [::sargs .text $Text];
                }
                *.client.column_titles* -
                *.calendar_buttons.* {
                    ::set Text "Move to desired date and click <Select> button.\nAlso double-click or <Enter>.";
                    ::return [::sargs .text $Text];
                }
            }
            ::return "";
        }

	It is a -glob switch statement that returns text for each widget and returns
    empty for any widget that does not need balloon help. The balloon help enable
    iterates recursively through the sub-tree of the supplied widget argument,
    calling the callback for each sub-widget and setting up it's balloon help.
    The balloon help disable also iterates through the sub-tree, unsetting the
    balloon help for each sub-widget. Disabling does not need to call the
    callback.
*/ }
::proc ::qw::tooltip::enable {sargs} {
    /* {
	Usage: ::qw::tooltip::enable .widget $Widget .command $ToolTipGetCallback;

    .widget - add help to this widget and its subtree

    .command - calls this proc with .widget for each widget to get its text

    Note - we use BWidget ::DynamicHelp to implement balloon help but this can be
    changed at any time since the entire implementation is encapsulated here.

    This method sets up balloon help on the .widget and its entire sub-tree,
    i.e. recursively. The text callback is called for each widget to get the
    text for the widget.

    The text callback
    -----------------

    The callback is called with a .widget argument. Typically the callback will
    use a glob switch statement to return the text for the widget. It returns
    empty if no text is available.
    */ }
    ::set rwb1_debug 0;
	::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tooltip::enable,1000.0,sargs==$sargs"}
    ::set Callback [::sargs::get $sargs .command];
    ::if {$Callback eq ""} {
        ::qw::throw "[::qw::procname] - no .command argument.";
    }
    ::set Widget [::sargs::get $sargs .widget];
    ::if {$Widget eq ""} {
        ::qw::throw "[::qw::procname] - no .widget argument.";
    }
    ::set Callback [::string map [::list "%widget%" $Widget] $Callback];
	::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tooltip::enable,1000.1,Callback==$Callback"}
    ::set ReturnStructure [::uplevel #0 $Callback];
	::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tooltip::enable,1000.2,ReturnStructure==$ReturnStructure"}
    ::set Text [::sargs::get $ReturnStructure .text;]
	::if {$rwb1_debug} {::puts "rwb1_debug,::qw::tooltip::enable,1000.3,text==$Text"}
    ::if {$Text ne ""} {
        ::DynamicHelp::add $Widget -text $Text;
    }
    ::foreach Kid [::winfo children $Widget] {
        [::qw::procname] $sargs .widget $Kid;
    }
}
::proc ::qw::tooltip::disable {sargs} {
	/* {
    */ }
    ::set Widget [::sargs::get $sargs .widget];
    ::if {![::winfo exists $Widget]} {
		::return;
    }
    ::foreach Kid [::winfo children $Widget] {
        [::qw::procname] $sargs .widget $Kid;
    }
    ::qw::try {
        ::DynamicHelp::delete $Widget;
    } catch Dummy {}
}
::proc ::qw::winutil::debug_dump_bindtags {args} {
	::qw::s_args_marshal;
	::set Widget [::sargs::get $s_args .widget];
	::foreach Kid [::winfo children $Widget] {
		::qw::winutil::debug_dump_bindtags $s_args .widget $Kid;
    }
}
::proc ::qw::winutil::debug_dump_configure {args} {
	::qw::s_args_marshal;
	::set Widget [::sargs::get $s_args .widget];
	::foreach Option [$Widget configure] {
		::puts $Option;
    }
}
::proc ::qw::winutil::dump_all_widget_paths {sargs} {
	::set WidgetPathList [::qw::winutil::select_paths];
    ::set Count -1;

	::puts "widgets start------------------------------------------------";
    ::foreach WidgetPath $WidgetPathList {
        ::puts "widget_path\[[::incr Count 1]\]==$WidgetPath";
    }
	::puts "widgets end--------------------------------------------------";
}
::proc ::qw::winutil::select_paths {sargs} {
	::set ParentPath [::sargs::get $sargs .parent_path];
    ::if {$ParentPath eq ""} {
		::set Result $ParentPath;
		::set ParentPath .
    }
	::set Result [::winfo children $ParentPath];
	::foreach ParentPath $Result {
		::set Result [::concat $Result [::qw::winutil::select_paths .parent_path $ParentPath]];
    }
	::return $Result;
}
::proc ::qw::winutil::find_window_with_focus {} {
	/* {
	2.28.3

	The Problem
    -----------
    When users have multiple monitors an error message (and PAYROLL process, and EFT process, and?)
    can appear on the "wrong" monitor where the user may not notice it.

	The Solution
	------------
    Find the active toplevel and position the error window relative to it.

    The Algorithm
    -------------
    Find the active workstation. Return empty if no workstation, which many be
    true for scripts running by themselves, i.e. newviews not even running.
    */ }

	/* {
	First let's find the workstation database in the list of open databases.
    */ }
	::set WorkstationDatabase [[::qw::system] cpp_find_workstation_database];
    ::if {$WorkstationDatabase eq ""} {
		::return "";
    }
    ::if {![::qw::command_exists $WorkstationDatabase]} {
		::puts "warning: 314120151215130846 - no workstation command.";
		::return "";
    }
	::set OS [$WorkstationDatabase cpp_object_structure_load .path /OBJECT/SYSTEM/WINDOW/SCREEN];
	::set ObjectId [::sargs::get $OS .system.object_id];
	::set ScreenList [$WorkstationDatabase cpp_file_odb_masters \
		.path /odb/index/OBJECT/SYSTEM/WINDOW/SCREEN.odb_deriveds.index/database \
        .range.begin [::list string $ObjectId] \
        .range.end [::list string $ObjectId] \
	];
	::set Fwindow "";
	::foreach Screen $ScreenList {
		/* {
        */ }
		::if {![::qw::command_exists $Screen]} {
			/* {
			If the screen command does not exist the it is not loaded into
            memory and it can't be active, can it? So we move on.
            */ }
			::continue;
        }
        ::if {![$Screen tk_initialized]} {
			/* {
			I suppose it is possible for the screen to be load but not tkintialized
            but in that case it cannot be active so again we move on.
            */ }
			::continue;
        }
        ::set Fwindow [$Screen window_with_focus];
		::if {$Fwindow eq ""} {
			::continue;
        }
		::if {[[$Fwindow .client] path] eq ""||[::focus] ne [[$Fwindow .client] tkPath]} {
			::continue;
        }
		::break;
    }
	::return $Fwindow;  ;#// this is better - let caller decide what next
}