# ------------------------------------------------------------ # Copyright (c) 2003-2025 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ #//::puts "pgq,debug2385.../gui/gui.qw_tcl enter"; /* { ::array set DayCounts { 2.31.2.20170823 72 2.31.3.20171103 48 2.31.4.20171221 50 2.32.0.20180209 4 2.32.1.20180213 23 2.32.2.20180308 102 2.32.3.20180618 4 2.32.4.20180622 130 2.33.0.20181030 64 2.33.1.20190102 22 2.33.2.20190124 112 2.33.3.20190516 217 2.34.0.20191219 55 2.34.1.20200212 161 2.34.2.20200722 14 2.34.3.20200805 8 2.34.4.20200813 127 2.34.5.20201218 30 2.34.6.20210117 37 2.34.7.20210223 6 2.34.8.20210301 46 2.34.9.20210416 17 at May3 } */} /* { ::qw::finally [::list $Range cpp_destroy]; # ::qw::finally [::list ::itcl::delete object $Range]; audit_info_columns.qw_script */} /* { key types - key_types - keytypes enum { _NULL=0, _STRING=1, _REAL=2, _INTEGER=3, _DATE=4, _BINARY_DUMMY=5, _BCD=6, _TAG=7 }; */} /* { (9) c:/cpp/qw_ifs_file_handle.cpp - if (Command.first("cpp_record_")==0) (10) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_read") (11) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_count") (12) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_exists") (13) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_seek_key") (14) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_seek_count") (15) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_vector_seek_count") (16) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_first") (17) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_last") (18) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_next") (19) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_prev") (20) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_vector_first") (21) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_vector_last") (22) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_vector_next") (23) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_vector_prev") (24) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_insert") (25) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_add") (26) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_subtract") (27) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_write") (28) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_record_delete") (16) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_delete_all_records") (19) c:/cpp/qw_ifs_file_handle.cpp - if (Command=="cpp_read_all_records") */} /* { nv2_release -customer_support_locksmith -memory_field_scale -memory_record_scale -memory_sector_scale -memory_scale -memory_object_cache_field_limit_scale -memory_page_cache_record_limit_scale -memory_sector_cache_sector_limit_scale -memory_cache_scale -memory_refresh 0/1 */} ::if {![::info exists ::_qw_gui_go_find_search_string]} { ::set ::_qw_gui_go_find_search_string ""; ::set ::_qw_gui_go_find_case 0; ::set ::_qw_gui_go_find_rows 0; ::set ::_qw_gui_go_find_row 0; ::set ::_qw_gui_go_find_comparing_to ""; ::set ::_qw_gui_go_find_rows_selected 0; } ::set ::qw_gui_window_odb_initialize_count 0; ::set ::qw_gui_window_odb_kickout_count 0; ::set ::qw_gui_window_destructor_count 0; ::set ::qw_gui_toolbar_configure 0; ::set ::qw_gui_toolbar_configure_change_display_resize 0; ::set ::qw_gui_toolbar_configure_change_new 0; ::set ::qw_debug_list [::list]; ::proc ::/get {args} { #//::puts "pgq,debug224.1...invalid command name /get args==$args"; #::qw::stack_dump; ;#//pgq,debug } ::proc ::/range {args} { #//::puts "pgq,debug...invalid command name /range args==$args"; #::qw::stack_dump; ;#//pgq,debug } ::proc ::tkPath {args} { #//::puts "pgq,debug...invalid command name tkPath args==$args"; #::qw::stack_dump; ;#//pgq,debug } /* { ::proc ::15Oct18 {args} { #//::puts "pgq,debug2332...invalid command name 15Oct18 args==$args"; ::qw::stack_dump; ;#//pgq,debug } */} /* {didn't work ::trace add variable ::20 read [::list ::proc_20]; ::proc ::proc_20 {args} { ::puts "pgq,debug...proc_20 args==$args"; ::qw::stack_dump; ;#//pgq,debug } */} # super KLUDGE ALERT for now... bug 154196 empty command /* { menubutton can't survive our auto_commit_click_away This affects every toolbar button AND window tab buttons! A buttonPress causes an nv2 window to loose focus, which causes an auto_commit_click_away, which throws an application error The temp hack below replaces offending proc ::tk::MenuUnpost until (if) we exception proof Enter, buttonPress, etc. */} /* { ::if {[::qw::command_exists ::tk::MenuUnpost]} { #//::puts "pgq,debug223.0...gui\gui.qw_tcl replacing ::tk::MenuUnpost"; ::rename ::tk::MenuUnpost ::tk::MenuUnpost_qw; ::proc ::tk::MenuUnpost menu { #//::puts "pgq,debug223.0::tk::MenuUnpost enter menu==$menu"; global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) ::if {$mb eq ""&&$menu eq ""} { #// this is not good... we will miss the tail end of the proc, which cleans up the grab ::return; } ::return [::tk::MenuUnpost_qw $menu]; } } */} # ::tk::MenuUnpost -- # This procedure unposts a given menu, plus all of its ancestors up # to (and including) a menubutton, if any. It also restores various # values to what they were before the menu was posted, and releases # a grab if there's a menubutton involved. Special notes: # 1. It's important to unpost all menus before releasing the grab, so # that any Enter-Leave events (e.g. from menu back to main # application) have mode NotifyGrab. # 2. Be sure to enclose various groups of commands in "catch" so that # the procedure will complete even if the menubutton or the menu # or the grab window has been deleted. # # Arguments: # menu - Name of a menu to unpost. Ignored if there # is a posted menubutton. #//::puts "pgq,debug...gui.qw_tcl ::qw::command_exists ::tk::MbPost==[::qw::command_exists ::tk::MbPost]"; #//::puts "pgq,debug...gui.qw_tcl ::qw::command_exists ::tk::MenuUnpost==[::qw::command_exists ::tk::MenuUnpost]"; #nv2.37.0 (from rwb) #nv2.37.2 (from rwb) - remove "::if {!$::qw::control(server interface is disabled)} test (with underscores - grep proofing) wrapping the entire ::if {[::qw::command_exists ::tk::MenuUnpost]} block ::if {[::qw::command_exists ::tk::MenuUnpost]} { proc ::tk::MenuUnpost menu { global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) #//::puts "pgq,debug223.0::tk::MenuUnpost enter menu==$menu"; #//::puts "pgq,debug223.0::tk::MenuUnpost enter mb ==$mb"; #//::if {$mb eq ""} {::return;} # Restore focus right away (otherwise X will take focus away when # the menu is unmapped and under some window managers (e.g. olvwm) # we'll lose the focus completely). #nv2.28.0 (bug fix) - #//::puts "pgq,debug::tk::MenuUnpost enter menu==$menu Priv(focus)==$Priv(focus)"; catch {focus $Priv(focus)} set Priv(focus) "" # Unpost menu(s) and restore some stuff that's dependent on # what was posted. #//::puts "pgq,debug223.0::tk::MenuUnpost catch BEFORE"; catch { if {[string compare $mb ""]} { set menu [$mb cget -menu] #//::puts "pgq,debug223.0::tk::MenuUnpost set menu mb cget -menu==$menu"; $menu unpost set Priv(postedMb) {} $mb configure -cursor $Priv(cursor) $mb configure -relief $Priv(relief) } elseif {[string compare $Priv(popup) ""]} { $Priv(popup) unpost set Priv(popup) {} } elseif {$menu ne "" \ &&[string compare [$menu cget -type] "menubar"] \ && [string compare [$menu cget -type] "tearoff"] \ } { #nv2.23.0 (bug fix) tk_binding file menu.tcl #// pgq "fixed" the elseif above by adding the condition $menu ne "" # We're in a cascaded sub-menu from a torn-off menu or popup. # Unpost all the menus up to the toplevel one (but not # including the top-level torn-off one) and deactivate the # top-level torn off menu if there is one. while {1} { set parent [winfo parent $menu] #//::puts "pgq,debug223.0::tk::MenuUnpost parent==$parent"; if {[string compare [winfo class $parent] "Menu"] \ || ![winfo ismapped $parent]} { break } $parent activate none $parent postcascade none GenerateMenuSelect $parent set type [$parent cget -type] if {[string equal $type "menubar"] || \ [string equal $type "tearoff"]} { break } set menu $parent } #//::puts "pgq,debug223.0::tk::MenuUnpost 111 menu==$menu"; if {[string compare [$menu cget -type] "menubar"]} { $menu unpost } } } #//::puts "pgq,debug223.0::tk::MenuUnpost catch AFTER"; if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} { # Release grab, if any, and restore the previous grab, if there # was one. if {[string compare $menu ""]} { set grab [grab current $menu] if {[string compare $grab ""]} { grab release $grab } } RestoreOldGrab #(rwb_linux /* { if {$Priv(menuBar) ne ""} { $Priv(menuBar) configure -cursor $Priv(cursor) set Priv(menuBar) {} } */} if {$Priv(menuBar) ne ""} { ::if {!$::qw::control(skip_linux_problems)} { /* { For some reason, ::Priv(Cursor) is not defined in linux. */ } ::if {[::info exists Priv(cursor)]} { $Priv(menuBar) configure -cursor $Priv(cursor) } } else { ::set Priv(cursor) ""; } set Priv(menuBar) {} } #) if {[tk windowingsystem] ne "x11"} { set Priv(tearoff) 0 } } } } # ::tk::MbPost -- # Given a menubutton, this procedure does all the work of posting # its associated menu and unposting any other menu that is currently # posted. # # Arguments: # w - The name of the menubutton widget whose menu # is to be posted. # x, y - Root coordinates of cursor, used for positioning # option menus. If not specified, then the center # of the menubutton is used for an option menu. ::if {0&&[::qw::command_exists ::tk::MbPost]} { proc ::tk::MbPost {w {x {}} {y {}}} { global errorInfo variable ::tk::Priv global tcl_platform #//::puts "pgq,debug::tk::MbPost enter menu==[$w cget -menu] Priv(postedMb)==$Priv(postedMb)"; if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { return } set menu [$w cget -menu] if {[string equal $menu ""]} { return } set tearoff [expr {[tk windowingsystem] eq "x11" \ || [$menu cget -type] eq "tearoff"}] if {[string first $w $menu] != 0} { error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" } set cur $Priv(postedMb) if {[string compare $cur ""]} { MenuUnpost {} } set Priv(cursor) [$w cget -cursor] set Priv(relief) [$w cget -relief] $w configure -cursor arrow $w configure -relief raised set Priv(postedMb) $w set Priv(focus) [focus] $menu activate none GenerateMenuSelect $menu # If this looks like an option menubutton then post the menu so # that the current entry is on top of the mouse. Otherwise post # the menu just below the menubutton, as for a pull-down. update idletasks if {[catch { switch [$w cget -direction] { above { set x [winfo rootx $w] set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}] # if we go offscreen to the top, show as 'below' if {$y < 0} { set y [expr {[winfo rooty $w] + [winfo height $w]}] } PostOverPoint $menu $x $y } below { set x [winfo rootx $w] set y [expr {[winfo rooty $w] + [winfo height $w]}] # if we go offscreen to the bottom, show as 'above' set mh [winfo reqheight $menu] if {($y + $mh) > [winfo screenheight $w]} { set y [expr {[winfo rooty $w] - $mh}] } PostOverPoint $menu $x $y } left { set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ + [winfo reqheight $menu])/2}] } else { incr y [expr {-([$menu yposition $entry] \ + [$menu yposition [expr {$entry+1}]])/2}] } } PostOverPoint $menu $x $y if {$entry ne "" \ && [$menu entrycget $entry -state] ne "disabled"} { $menu activate $entry GenerateMenuSelect $menu } } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ + [winfo reqheight $menu])/2}] } else { incr y [expr {-([$menu yposition $entry] \ + [$menu yposition [expr {$entry+1}]])/2}] } } PostOverPoint $menu $x $y if {$entry ne "" \ && [$menu entrycget $entry -state] ne "disabled"} { $menu activate $entry GenerateMenuSelect $menu } } default { if {[$w cget -indicatoron]} { if {[string equal $y {}]} { set x [expr {[winfo rootx $w] + [winfo width $w]/2}] set y [expr {[winfo rooty $w] + [winfo height $w]/2}] } PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]] } else { PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] } } } } msg]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. set savedInfo $errorInfo MenuUnpost {} error $msg $savedInfo } set Priv(tearoff) $tearoff if {$tearoff != 0} { #nv2.28.0 (bug fix) # focus $menu if {[winfo viewable $w]} { SaveGrabInfo $w grab -global $w } } } } #nv2.32.3 (bug fix) - remove debug only code - tcl86 load timing error - tk_focus* doesn't exist yet /* { ::rename tk_focusNext tk_focusNext_qw; ::proc tk_focusNext {w} { #//::puts "pgq,debug...qw.qw_tcl tk_focusNext w==$w"; #::qw::stack_dump; ;#//pgq,debug ::return [tk_focusNext_qw $w]; } ::rename tk_focusPrev tk_focusPrev_qw; ::proc tk_focusPrev {w} { #//::puts "pgq,debug...qw.qw_tcl tk_focusPrev w==$w"; #::qw::stack_dump; ;#//pgq,debug ::return [tk_focusPrev_qw $w]; } */} /* { ::rename tkTabToWindow tkTabToWindow_qw; ::proc tkTabToWindow {w} { ::puts "pgq,debug...qw.qw_tcl tkTabToWindow w==$w"; ::qw::stack_dump; ;#//pgq,debug ::return [tkTabToWindow_qw $w]; } */} #nv2.28.4 (bind) #( /* { ::proc ::qw_gui_event_processing_is_enabled_simple {} { #::return 1; ::if {[::info exists ::qw_gui_global_progress_window]} { ::puts "pgq,debug...::qw_gui_event_processing_is_enabled ::return==0"; ::return 0; } ::puts "pgq,debug...::qw_gui_event_processing_is_enabled ::return==1"; ::return 1; } */} ::proc ::qw_gui_event_processing_is_enabled {args} { # ONLY CALLED if ::qw::control(bind_replace)==1 #::return 1; ::puts "pgq,debug501...::qw_gui_event_processing_is_enabled enter args==$args"; #//...::qw_gui_event_processing_is_enabled enter args==.32.37.38.39.46.51.52.53.63.72.73.74.75.80 _32_37_38_39_46_51_52_53_63_72_73_74_75_80 ::set DatabaseId ""; ::if {$args ne ""} { ::if {[::info exists ::qw_gui_widget_database_id_array([::lindex $args 0])]} { ::set DatabaseId $::qw_gui_widget_database_id_array([::lindex $args 0]); } } #//::puts "pgq,debug...::qw_gui_event_processing_is_enabled widget DatabaseId==$DatabaseId"; #//::puts "pgq,debug...::qw_gui_event_processing_is_enabled ::info exists ::qw_gui_database_id_progress_window_array($DatabaseId)==[::info exists ::qw_gui_database_id_progress_window_array($DatabaseId)]"; #//::set Structures [::expr {![::info exists ::qw_gui_database_id_progress_window_array($DatabaseId)]?{}:[::sargs::format .structure [$::qw_gui_database_id_progress_window_array($DatabaseId) structures]]}]; #//::puts "pgq,debug...::qw_gui_event_processing_is_enabled ::qw_gui_database_id_progress_window_array($DatabaseId) structures==$Structures"; #::set DatabaseId [::expr {$::qw_gui_global_focus_window_object eq ""?{}:[[$::qw_gui_global_focus_window_object odb_database application] cpp_id]}]; #nv2.28.4 - remove the structures compare when we're done ::if {![::info exists ::qw_gui_database_id_progress_window_array($DatabaseId)] \ ||[::sargs::select_value [::sargs .structure [$::qw_gui_database_id_progress_window_array($DatabaseId) structures] .value $DatabaseId]] eq "" \ } { #//::puts "pgq,debug501...::qw_gui_event_processing_is_enabled ++++++++++++ no progress or none for my DatabaseId ::return==1\n"; ::return 1; } #//::puts "pgq,debug501...::qw_gui_event_processing_is_enabled ------------ ::return==0\n"; # ::return 0; ::switch -glob -- [::lindex $args 2] { - <*KeyPress* - <*Button* - <*B1* - [::subst {$this idler_backoff;$this buttonPress {[::QW::GUI::EVENT::MOUSE::BUTTON::mask]};}]; ::rename ::bind ::bind_qw; ::proc ::bind {args} { #//::puts "pgq,debug501...gui.qw_tcl ::bind args==$args"; #//...gui.qw_tcl ::bind args==_32_37_38_39_46_51_52_53_63_72_73_74_75_80 {::qw::odb::20131204110038::/1391197256_7263.client idler_backoff;::qw::odb::20131204110038::/1391197256_7263.client buttonPress {.windowPath %W .type %T .serialNumber %# .send %E .state %s .subWindowHex %S .time %t .x %x .y %y .xRoot %X .yRoot %Y .buttonNumber %b};} #//::puts "pgq,debug...gui.qw_tcl ::bind ::qw_gui_global_focus_window==$::qw_gui_global_focus_window"; #//::puts "pgq,debug...gui.qw_tcl ::bind ::qw_gui_global_focus_window_object==[::expr {$::qw_gui_global_focus_window_object eq ""?{}:[$::qw_gui_global_focus_window_object odb_path]}]"; ::if {[::llength $args]!=3} { #//::puts "pgq,debug...gui.qw_tcl ::bind ::llength args==[::llength $args] args==$args"; #::qw::stack_dump; ;#//pgq,debug ::return [::eval ::bind_qw $args]; } #::if {[::string range [::lindex $args 0] 0 0] ne "_qw_"} { #//::puts "pgq,debug...gui.qw_tcl ::bind args==$args"; #::qw::stack_dump; ;#//pgq,debug #::return [::eval ::bind_qw $args]; #} #::set NewCode "::if {[::qw_gui_event_processing_is_enabled]} {[::lindex $args 2]}"; #::set NewCode "::if {1} {[::lindex $args 2]}"; #::set NewCode [::lindex $args 2]; ::set Script [::lindex $args 2]; #::set NewCode {::if {[::qw_gui_event_processing_is_enabled]} {%_script}}; #::set NewCode {::if {[::qw_gui_event_processing_is_enabled %W]} {%_script}}; ::set NewCode {::if {[::qw_gui_event_processing_is_enabled %W %_args0 %_args1]} {%_script}}; ::set NewCode [::string map [::list %_args0 [::lindex $args 0] %_args1 [::lindex $args 1] %_script $Script] $NewCode]; #//::puts "pgq,debug...gui.qw_tcl ::bind NewCode==$NewCode"; #//::puts "pgq,debug...gui.qw_tcl ::bind args 0==[::lindex $args 0] args 1==[::lindex $args 1] NewCode==$NewCode"; ::return [::eval ::bind_qw [::list [::lindex $args 0] [::lindex $args 1] $NewCode]]; #::set Script [::lindex $args 2]; #::set NewCode {::if {[::qw_gui_event_processing_is_enabled %_odb_master]} {%_script}}; #::puts "pgq,debug...gui.qw_tcl bind_qw BEFORE NewCode==$NewCode"; ##::set NewCode "::if {1} {[::lindex $args 2]}"; #::set NewCode [::string map [::list %_odb_master [odb_master] %_script $Script] $NewCode]; #::puts "pgq,debug...gui.qw_tcl bind_qw AFTER NewCode==$NewCode"; #::return [::eval ::bind [::list [::lindex $args 0] [::lindex $args 1] $NewCode]]; } ::proc ::bind_command {args} { ::return $args; } } #nv2.34.9 (experiment) - ::qw::control(bind_event_log) - record/playback ::if {0&&$::qw::control(bind_event_log)} { ::set ::_QW_GUI_bind_event_log_clock [::clock clicks -milliseconds]; #//::puts "pgq,debug...bind_event_log starting clock -milliseconds==$::_QW_GUI_bind_event_log_clock"; ::rename ::bind ::bind_qw; ::proc ::bind {args} { #//::puts "pgq,debug501...gui.qw_tcl ::bind ::llength args==[::llength $args] args==$args"; #//::return [::eval ::bind_qw $args]; ::switch -glob -- [::lindex $args 1] { - <*KeyPress* - <*Button* - <*B1* - =0} { ::puts "pgq,debug::after args==$args"; ::qw::stack_dump; ;#//pgq,debug } ::return [::eval ::after_qw $args]; } ::rename ::qw::after ::qw::after_qw; ::proc ::qw::after {args} { ::puts "pgq,debug::qw::after args==$args"; ::if {[::string first "focusIn" $args]>=0} { ::puts "pgq,debug::qw::after args==$args"; ::qw::stack_dump; ;#//pgq,debug } ::return [::eval ::qw::after_qw $args]; } ::rename ::qw::call_after_idle ::qw::call_after_idle_qw; ::proc ::qw::call_after_idle {args} { ::puts "pgq,debug::qw::call_after_idle [::llength $args] args==$args"; ::if {[::string first "focusIn" $args]>=0} { ::puts "pgq,debug::qw::call_after_idle args==$args"; ::qw::stack_dump; ;#//pgq,debug } ::return [::eval ::qw::call_after_idle_qw $args]; } */} #nv2.28.0 (debug) #nv2.38.3 (debug) - replacing ::after /* { ::puts "pgq,debug2384...gui\gui.qw_tcl replacing ::after"; ::array set ::qw::_idle_tasks_array {}; ::set ::qw::_idle_tasks_enabled 1; ::rename ::after ::after_qw; ::proc ::after {args} { ::if {!$::qw::_idle_tasks_enabled} { ::return; } ::set Result [::eval ::after_qw $args]; ::puts "pgq,debug::after Result==$Result args==$args"; #::qw::stack_dump; ;#//pgq,debug ::if {[::lindex $args 0] eq "cancel"} { ::unset -nocomplain ::qw::_idle_tasks_array([::lindex $args 1]); ::return $Result; } ::if {[::info exists ::qw::_idle_tasks_array($Result)]} {::puts "pgq,debug::after ::info exists==1";} ::set ::qw::_idle_tasks_array($Result) 1; ::return $Result; #::qw::stack_dump; ;#//pgq,debug ::return [::eval ::after_qw $args]; } ::rename ::qw::after ::qw::after_qw; ::proc ::qw::after {args} { ::if {!$::qw::_idle_tasks_enabled} { ::return; } ::set Result [::eval ::qw::after_qw $args]; ::puts "pgq,debug::qw::after Result==$Result args==$args"; #::qw::stack_dump; ;#//pgq,debug ::if {[::lindex $args 0] eq "cancel"} { ::unset -nocomplain ::qw::_idle_tasks_array([::lindex $args 1]); ::return $Result; } ::if {[::info exists ::qw::_idle_tasks_array($Result)]} {::puts "pgq,debug::after ::info exists==1";} ::set ::qw::_idle_tasks_array($Result) 1; ::return $Result; #::qw::stack_dump; ;#//pgq,debug ::return [::eval ::qw::after_qw $args]; } */} /* { ::rename ::qw::call_after_idle ::qw::call_after_idle_qw; ::proc ::qw::call_after_idle {args} { ::if {!$::qw::_idle_tasks_enabled} { ::return; } ::set Result [::eval ::qw::call_after_idle_qw $args]; ::puts "pgq,debug::qw::call_after_idle Result==$Result args==$args"; #::qw::stack_dump; ;#//pgq,debug ::if {[::lindex $args 0] eq "cancel"} { ::unset -nocomplain ::qw::_idle_tasks_array([::lindex $args 1]); ::return $Result; } ::if {[::info exists ::qw::_idle_tasks_array($Result)]} {::puts "pgq,debug::after ::info exists==1";} ::set ::qw::_idle_tasks_array($Result) 1; ::return $Result; #::qw::stack_dump; ;#//pgq,debug ::return [::eval ::qw::call_after_idle_qw $args]; } */} /* { ::proc ::qw_control_timer_increment {Item StopWatch} { ::puts "pgq,debug::qw_control_timer_increment Item==$Item StopWatch seconds==[$StopWatch seconds]"; ::set ::qw::control($Item) [::expr {$::qw::control($Item)+[$StopWatch seconds]}]; } */} #nv2.28.3 () - a diagnostic ::puts bumped into variable didn't exist running a script? ::set ::qw_gui_global_focus_window ""; #nv2.28.4 (bind) - #::set ::qw_gui_global_focus_window_object ""; ;#// NOT USED - remove when done #//----------------------------------------------------------------------------- ::array set ::qw_gui_widget_database_id_array {}; #// Keep application database cpp_id for every peer widget created #// Used only in this file to test ::qw_gui_event_processing_is_enabled to ignore mouse and keyboard events #// for toplevel login user desktops if a progress window is up for that application database #// Example from below #//::set ::qw_gui_widget_database_id_array($_tkPath) [$Database cpp_id]; #//----------------------------------------------------------------------------- ::array set ::qw_gui_database_id_login_user_desktop_array {}; #// Keep address of toplevel user desktop for every application database logged into #// Used only for progress_red window positioning #// Example from .../DESKTOP/OBJECT/MASTER/SYSTEM/USER method observer_database #//::set ::qw_gui_database_id_login_user_desktop_array([[$Src odb_database] cpp_id]) $this; #//----------------------------------------------------------------------------- ::array set ::qw_gui_database_id_progress_window_array {}; #// Keep address of toplevel progress window for every database_id #// Set in progress_red window create and used only in this file to test ::qw_gui_event_processing_is_enabled to ignore mouse and keyboard events #//::set ::qw_gui_database_id_progress_window_array([::sargs::get $_sargs .database_id]) $this; # REMOVE this when interleaved progress operations from different databases do not appear in the same progress window # NOTE they are already not interleaved because we create a progress window for each database_id # i.e. "global" .progress_window was replaced by "local" .progress_window_[::sargs::get $sargs .database_id] #// ::set ::qw::control(observer_database_count) 0; ;#// diagnostic counter #nv2.28.0 - compile flag checklist ::set ::qw::control(crm_new_lcodes) 1; ;#// may as well - they were swiched on for nv2.27.3 and nv2.27.4 - QW never used nv2.27.5 (just payroll) ::set ::qw::control(toolbarMenu_column_new) 1; ::proc ::qw_control_timer_increment {Item StartClicks} { #// diagnostic counter #//::puts "pgq,debug::qw_control_timer_increment Item==$Item StartClicks==$StartClicks Duration==[::expr {[::clock clicks -milliseconds]-$StartClicks}]"; #::qw::stack_dump; ;#//pgq,debug ::set ::qw::control($Item) [::expr {$::qw::control($Item)+[::clock clicks -milliseconds]-$StartClicks}]; } #// diagnostic counters, timers, etc. ------------------------------------------ #nv2.33.1 (experiment) - latency - search source for "::qw::finally [::list ::qw_control_timer_increment" ;#// ] for matching ::set ::qw::control(experiment_range_load_refs) 0; ::set ::qw::control(dataInterfaceCell) 0; ::set ::qw::control(dataInterfaceRow) 0; ::set ::qw::control(gui_load_observer_database) 0; ::set ::qw::control(observer_database) 0; ::set ::qw::control(observers_database) 0; ::set ::qw::control(observers_database_array_iterator) 0; ::set ::qw::control(observers_database_kickout) 0; ::set ::qw::control(observers_database_columns) 0; ::set ::qw::control(observers_database_cells) 0; ::set ::qw::control(observers_database_cells_tag_expr) 0; ::set ::qw::control(observers_database_cells_tag_expr_index) 0; ::set ::qw::control(dataInterface_cache_row) 0; ::set ::qw::control(dataInterface_cache_row_odb_seek) 0; ::set ::qw::control(signal_receive_database_item) 0; ::set ::qw::control(gui_load_tree) 0; ::set ::qw::control(structure_data_load) 0; ::set ::qw::control(structure_data_load_heritage) 0; ::set ::qw::control(columns_fit_data) 0; #nv2.33.2 (experiment) - selection_control ::set ::qw::control(go_find_doit) 0; ::set ::qw::control(selection_control_doTheWork) 0; ::set ::qw::control(selection_pair_list_minimize) 0; #nv2.33.3 ::set ::qw::control(paylist_observer_database) 0; ::set ::qw::control(paylist_columns_initialize) 0; ::set ::qw::control(paylist_notes_observer_rows) 0; ::set ::qw::control(paylist_notes_employee_get) 0; ::set ::qw::control(historic_range_amount) 0; ;#// diagnostic counter ::set ::qw::control(historic_range_amount_records) 0; ;#// diagnostic counter ::set ::qw::control(closing_prior) 0; ;#// diagnostic counter ::set ::qw::control(closing_prior_records) 0; ;#// diagnostic counter #::set ::qw::control(dump_method_calls) 1; #//----------------------------------------------------------------------------- #::set ::qw::control(server_multi_port) 0; ;#// done from the command line with -crm ::set ::qw::control(crm_casl_email) 0; ::set ::qw::control(eft_transfer_deposit_228) 1; ::set ::qw::control(nvnph_rgi) 1; ::set ::qw::control(nvnph_rgi_multi_newsub) 1; ::set ::qw::control(html_window) 1; ::set ::qw::control(custom_aldebrain) 1; ;#// taken from rwb ::set ::qw::control(tommy_address_form) 0; ;#// the companion pane examples ::set ::qw::control(tommy_form) 0; ;#// the "form project" - PROCEDURE lead the way with first attack ::set ::qw::control(tommy_form_nbook) 0; ::set ::qw::control(tommy_form_label_pad) 0; ;#// 3 for know case of character clipping ::set ::qw::control(tommy_form_install) 1; ;#// for grep ::set ::qw::control(rgi_wigwamen) 1; ;#// special rgi income calc ::set ::qw::control(nvnph_work_orders) 0; ;#// never actually used or tested ::set ::qw::control(nvnph_work_orders_private_setup_desktop) 0; ;#// a runtime kludge flag turned on and then off ::set ::qw::control(nvnph_unit_inspections_private_setup_desktop) 0; ;#// a runtime kludge flag turned on and then off ::set ::qw::control(consolidation_by_account_folder_is_enabled) 1; ;#//requires version 2.29.0 ::set ::qw::control(consolidation_with_budget_detail_is_enabled) 1; ::set ::qw::control(photo_is_enabled) 1; ::set ::qw::control(photo_max_size) [::expr {8*1024*1024}]; #::set ::qw::control(photo_display_type_list) [::list .jpg .jpeg .png .gif .tif .bmp]; ::set ::qw::control(photo_display_type_list) [::list .jpg .jpeg .png .gif .tif]; ;#// .bmp is not a valid photo image format, and we are not going to code for switching tk peer type! ::set ::qw::control(gui_host_toplevel_dialog_is_active) 0; ::set ::qw::gui_image_file_import_initial_dir ""; ::set ::qw::control(toolbarMenu_display_resize) 1; ::set ::qw::control(print_journal_transactions) 1; ;#// must be with $::qw_version>=2.32 #_pgq,debug2323 - check that _ai etc is 2.33 only ::set ::qw::control(gui_odb_kickout_disabled) 0; ;#// bug avoidance global conrol flag used at runtime - window navigation A->B->A exposed bug #//----------------------------------------------------------------------------- ::set ::qw::control(additional_info_schema) 1; ;#// must be with $::qw_version>=2.33 - RELEASED - for custom projects #::set ::qw::control(additional_info_schema_view_install) 0; ;#// must be with $::qw_version>=2.33 && additional_info_schema==1 - STILL TESTING - # moved to rwb/system/qw.qw_tcl #_pgq,debug2340 - menu appears in nph? - stopped happening? #::set ::qw::control(new_column_menu_is_enabled) 0; ;#// 2.33 - # moved to /rwb/system/qw.qw_tcl #nv2.36.0 () - has been 0 forever - never released ::set ::qw::control(menu_new_columns_invoice_information) 0; ;#//pgq,debug2.38.2 ;#//pgq,debug #_pgq,debug #nv2.37.0 ::qw::control(advanced_menu_is_enabled) ::set ::qw::control(advanced_menu_is_enabled) 0; ;#// should be zero for release! - blows away all setup script modifications - fix this with += or backward+= ::set ::qw::control(control_keypress_p_is_enabled) 1; ;#//^P #// remember to comment out ::qw_control_timer_increment ::set ::qw::control(code_demo) 0; ;#// ^P will turn on/off - disables default setup.qw_script ::set ::qw::control(code_demo_toggle) 0; ;#// single code_demo will fool a debugger some day - wondering why ^P changes code behavior #nv2.35.4 (experiment) #nv2.37.0 (profit_amount profit_margin) - NOT YET - removal of dumb-down - exposes (on screen) the entire posting field hierarchy for windowNewTree and columnDefinitionTree - previously available only for >Print >Account Ledgers ::set ::qw::control(comprehensive_postings_table) 1; ;#// 2.36.0 is 0 - 2.36.1 is 0 - 2.36.2 is 0 - 2.36.3 is 0 - 2.37.0 is 1 ::set ::qw::control(tag_expr_is_enabled) 0; ::set ::qw::control(profit_amount_column_is_enabled) 1; ;#// 2.36.3 is 0 - 2.37.0 is 1 ::set ::qw::control(npm_install) 0; #// APPARENTLY NEVER USED? - no other occurrences of this class #::set ::qw::control(donor_management_is_enabled) 0; #//rwb moved to rwb/system/qw.qw_tcl for timing reasons /* { Search Results for String=="nv2.37.0 (profit_amount profit_margin)" FOR TESTING NOT YET - set to zero HARMLESS WRAPPED */} #//----------------------------------------------------------------------------- ::set ::qw_debug_unique 0; ;#// debug ::set ::qw::control(nv3_posting_application_is_enabled) 0; ::set ::qw::control(is_destroying_private_setup) 0; ;#// for now, s_args it eventually ::set ::qw::control(column_define_active_cname) 1; #nv2.27.0 (resume) ::set ::qw::control(nvnph_compile) 0; ;#// set by command line arg -nph AND /pgq/object/nvnph_compile_prune_menus.qw_script - after FULL slow-mo default setup (Alt-X immediately after prune script) ::set ::qw::control(nvnph_compile_report_instance_explore) 0; #::set ::qw::control(bill_of_materials) 1; ;#// not used - done with column_multipy - toyed with /TRANSACTION/SALES.posting/debit/customer.quantity uncoupled from .posting/credit/charge.quantity ::set ::qw::control(print_check_ap_with_paid_invoices_detail_items) 0; ::set ::qw::control(usa_nctb) 1; ::set ::qw::control(active_audit_desktop) 1; ;#// must be 0 for nv2.24 compile ::set ::qw::control(foreign_currency_exchange) 1; ::set ::qw::control(tags_allocation) 1; ::set ::qw::control(one_time_stack_dump) 0; ::set ::qw::control(special_debug) 0; ::set ::qw::control(special_debug_1) 0; ::set ::qw::control(special_debug_2) 0; #nv2.23.01 ::set ::qw::control(is_low_level_window_copy) 0; ::set ::qw::control(low_level_window_copy_226_style) 0; ::set ::qw::control(niko_database_explorer_tree_close) 0; ::set ::qw_gui_idle_id_focusIn ""; ::array set ::qw::_tcom_handle_count {}; ::array set ::qw::_window_default_setup {}; #::set ::qw::control(automatic_pick_boxes_is_enabled) 1; ::set ::qw::control(caseware_export_is_enabled) 1; #nv2.21.1 ::set ::qw::gui_is_windowNew 0; #nv2.21.0 ::set ::qw::control(payroll_wcb) 1; ;#// not ever really tested... just a breadcrumb for grep ::set ::qw::gui_control_key 4; ::set ::qw::gui_shift_key 1; ::set ::qw::gui_alt_key 131072; ::set ::qw::gui_scroll_lock 32; ::set ::qw::gui_num_lock 8; ::set ::qw::gui_caps_lock 2; ::set ::qw::control(unit_of_measure) 1; ::set ::qw::control(proof_control) 1; ::set ::qw::control(toolbar_help_button_is_enabled) 1; ::set ::qw::control(pay_to_address_is_enabled) 1; ::set ::qw::control(template_print_speedup) 0; ::set ::qw::control(customer_sales_codes) 1; ::set ::qw::control(geographic_tax_codes) 1; ::set ::qw::control(load_postings_data_odb_level_distribution_values) 1; ::set ::qw::control(clock_clicks) 0; ::set ::qw::control(print_account_ledgers_historic_aging) 1; ::set ::qw::control(arrow_buttons) 1; ;#// set by command line arg -arrow_maximize ::set ::qw::control(smtp_log) ""; ::set ::qw::control(smtp_log_id) ""; ::set ::qw::control(eft_transfer_deposit) 1; ::set ::qw::control(address_objects_is_enabled) 1; ::set ::qw::control(mail_merge_is_enabled) 1; ::set ::qw::control(company_idPrefix_is_enabled) 0; ;#// taken from rwb ::set ::qw::control(tcl_script_interface_is_enabled) 0; ::set ::qw::control(mouse_motion_select_requires_control_key) 1; ::set ::qw::control(signalPick_after_idle) 0; ;#// failed first attempt ::set ::qw::control(signal_pick_kids_after_time_delay) 1; ;#// hope of succeeding second attempt ::set ::qw::control(unique_transaction_references) 1; ::set ::qw::control(tools_paylist_import_from_excel_is_enabled) 1; ::set ::qw::control(breadcrumbs_is_enabled_multiple_database_explorers) 1; ::set ::qw::control(signal_receive_database_after_time_delay) 1; ;#// rapid-fire pings in multi-user mode, BUT it kills multi-user edit append on interactive ::set ::qw::control(print_batch_of_detail_windows) 1; ::set ::qw::control(print_account_ledgers_from_reports) 1; ::set ::qw::control(selection_is_enabled) 1; ::set ::qw::control(de_import) 0; ;#// managed at run-time, BUT removed from newviews definition ::set ::qw::control(usa_1099_is_enabled) 1; ::set ::qw::control(breadcrumbs_is_enabled) 1; ::set ::qw::control(bookmarks_is_enabled) 1; ::set ::qw::control(tk_toolbar_is_enabled) 1; ::set ::qw::control(window_list_tabs_background) "SystemButtonFace"; ::set ::qw::control(window_list_tabs_background) "#f8d9f8"; ::set ::qw::control(window_list_tabs_background) "#eeeeee"; ;#// the nv2.10.1 "master" ::set ::qw::control(window_list_tabs_background) "#deeeee"; ::set ::qw::control(window_list_tabs_background) "#eedeee"; ::set ::qw::control(window_list_tabs_background) "#eeeede"; ;#// almost works ::set ::qw::control(window_list_tabs_background) "#dedede"; ;#// the nv2.10.2 "master" ::set ::qw::control(qw_com_collectionitem_count) 0; ::set ::qw::control(qw_com_collection_count) 0; #::set ::qw::control(excel_peer_create) 1; ;#// never referenced ::set ::qw::control(print_control) ""; ;#// halpin's _control variable, never used anymore ::set ::qw::control(eft_transfer_usa) 1; ::set ::qw::control(auto_commit_click_away) 1; #::set ::qw::control(crm_include) 1; ;#// done from the command line with -crm ::set ::qw::verbose(payrun) 0; ::set ::qw::control(interbooks_copy_paste_transactions) 1; ::set ::qw::control(interbooks_copy_paste_postings) 1; ::set ::qw::control(block_copy_paste_one_window) 1; ::set ::qw::control(charge_interest_balance_is_enabled) 1; ::set ::qw::control(tools_many_transactions_is_enabled) 1; ::set ::qw::control(payroll_t4_summary) 1; ::set ::qw::control(payroll_t4_xml) 1; #c:\revenue_canada>xsv -w -d t4_shit.xml layout.xsd > c:\tk\tst2.lst ::set ::qw::control(payroll_employee_name_sortable) 1; ::set ::qw::control(super_kludge_F9_in_progress) 0; ::set tcl_traceCompile 0; ::set tcl_traceExec 0; ::proc ::pgq_dummy {Name1 Name2 Op} { #::if {$Name2 eq "/report"} {} ::puts "pgq_dummy Name1==$Name1 Name2==$Name2 Op==$Op"; #//pgq_dummy Name1==_odb_observers Name2==/active_print_receipts_settings Op==write ::qw::stack_dump; #{} } ::proc ::pgq_dummy_2 {Name1 Name2 Op} { ::puts "pgq_dummy_2 Name1==$Name1 Name2==$Name2 Op==$Op"; ::QW::stack_dump; } ::proc ::.odb_base {} { ::puts "command .odb_base"; ::qw::stack_dump; } #kludge alert this is here to keep degui running... ::namespace eval ::QW { #// #// PGQ doesn't like this... just clock format in-line. #// ::proc ::QW::date_format {DateNumber {Format "%b %d,%Y %H:%M:%S"}} { #return [::clock format [::expr {int($DateNumber)}] -format $Format]; return $DateNumber; #return [::clock format $DateNumber -format $Format]; } } ::proc "" {args} { ::puts "::\"\" empty command PGQ args==$args"; ::qw::stack_dump; ::qw::bug 271820071031154916 "Called empty command, args==\"$args\""; } ::proc "%_odb_address" {args} { ::puts "::%_odb_address command args==$args"; ::qw::stack_dump; ::qw::bug 271820071031154916 "Called %_odb_address command, args==\"$args\""; } #nv2.10.3 ::proc "/formula" {args} { ::puts "::\"/formula\" command args==$args"; ::qw::stack_dump; ::qw::bug 271820071031154917 "Called /formula command, args==\"$args\""; } #"" TestEmptyCommandArg; /* { ::proc stack_dumper {args} { ::puts {"::stack_dumper args==$args"}; ::set CurrentLevel [::info level]; ::for {::set Level [::expr $CurrentLevel-1]} {$Level>0} {::incr Level -1} { puts {"$Level\t[::info level $Level]"}; } ::exit; } */} /* { ::QW::EFT ::QW::GUI ::QW::GUI_WINDOW_RECTANGLE ::QW::HTML ::QW::MOUSE_CURSOR_SANDWICH ::QW::NEWVIEWS ::QW::ODB ::QW::OPERATION ::QW::OPERATION_TOPLEVEL ::QW::STATUS ::QW::STOPWATCH ::QW::TOPLEVEL ::QW::WIDGET ::QW::XML */} ::namespace eval ::QW { ::proc ::QW::email_tls_policy_callback {args} { #//::puts "pgq,debug216.../TABLE email_tls_policy_callback enter args==$args"; ::return "insecure"; ::return "secure"; } ::proc ::QW::echo {Arg} { return $Arg; } ::proc ::QW::echo1 {Arg} { ::uplevel 1 $Arg; } /* { ::proc ::QW::number_format {Number {Separator ,}} { while {[regsub {^([-+]?\d+)(\d\d\d)} $Number "\\1$Separator\\2" Number]} {} return $Number; } */} /* { ::proc ::QW::number_format {Number {Separator ,}} { ::if {$Number eq ""} {::set Number 0.0;} ::set Number [::format %.2f $Number]; ::while {[regsub {^([-+]?\d+)(\d\d\d)} $Number "\\1$Separator\\2" Number]} {} ::return $Number; } ::proc ::QW::number_format_2 {Src args} { #// #// Using all defaults #// ::QW::number_format_2 $Number; #// Has the effect of #// ::QW::number_format_2 $Number -length 14 -minus_sign - -separator , -decimals 2; #// ::set Number [::expr abs($Src)]; ::array set Args $args; ::if {![::info exists Args(-separator)]} {::set Args(-separator) ",";} ::if {![::info exists Args(-length)]} {::set Args(-length) "14";} ::set Args(-length [::expr $Args(-length)-1]; ::if {![::info exists Args(-decimals)]} {::set Args(-decimals) "2";} ::if {![::info exists Args(-minus_sign)]} {::set Args(-minus_sign) "-";} ::if {$Args(-minus_sign) eq "("} {::set Args(-minus_sign) ")";} ::if {$Args(-minus_sign) ne ")"&&$Args(-minus_sign) ne "-"} {::qw::throw "Invalid -minus_sign arg: \"$Args(-minus_sign)\"";} ::set Number [::format "%$Args(-length).$Args(-decimals)f" $Number]; ::while {[regsub {^([-+]?\d+)(\d\d\d)} $Number "\\1$Args(-separator)\\2" Number]} {} ::if {$Src<0} { ::if {$Args(-minus_sign) eq "-"} { ::append Number "-"; } else { # ( ::append Number ")"; ::set Position [::string last " " $Number]; ::if {$Position>=0} { ::set Number [::string replace $Number $Position $Position "("]; ;# ) } else { ::set Number [::string repeat "*" $Args(-length)]; } } } else { ::append Number " "; } ::return $Number; } */} /* { ::proc ::QW::nv1DateToTclDate {Src} { #//We are taking a date in NV1 keystroke format and converting it to a tcl #//date, which a number representing a date in the year range 1902 to 2031. ::if {$Src==""} {::set Src 19851231;} ::if {$Src==0} {::set Src 19851231;} #::if {$Src==""} {return "";} #::if {$Src==0} {return "";} ::if {[::string length $Src]!=8} {::qw::throw "Invalid Nv1 date \"$Src\". Date must have length 8 but has length [::string length $Src].";} #::set Result [::clock scan [::string range $Src 2 3]/[::string range $Src 0 1]/[::string range $Src 4 7]]; #// i.e. 31121985 ::set Result [::clock scan [::string range $Src 4 5]/[::string range $Src 6 7]/[::string range $Src 0 3]]; #// i.e. 19851231 return $Result; } ::proc ::QW::nv1KeystrokeDateToTclDate {Src} { #//We are taking a date in NV1 keystroke format and converting it to a tcl #//date, which is a number representing a date in the year range 1902 to 2031. ::if {$Src==""} {::set Src 19851231;} ::if {$Src==0} {::set Src 19851231;} #::if {$Src==""} {return "";} #::if {$Src==0} {return "";} ::if {[::string length $Src]!=8} {::qw::throw "Invalid Nv1 date \"$Src\". Date must have length 8 but has length [::string length $Src].";} ::set Result [::clock scan [::string range $Src 2 3]/[::string range $Src 0 1]/[::string range $Src 4 7]]; return $Result; } */ } ::proc ::QW::stack_dump {} { ::set CurrentLevel [::info level]; ::for {::set Level [::expr $CurrentLevel-1]} {$Level>0} {::incr Level -1} { ::puts "$Level\t[::info level $Level]"; } } } /* {rwb provided #nv2.11.3 #nv2.11.2 ::proc ::qw::number::round2 {Src} { ::return [::expr round($Src*100.0)/100.0]; #//::puts "::qw::number::round2 Src==$Src result==[::qw::number::format $Src $::qw::number::formats(dollar)]"; #//::return [::qw::number::format $Src $::qw::number::formats(dollar)]; } */} /* { ::if {$::qw::control(eft_transfer_usa)} {} */} /* { #nv2.20.0 (T5018) - copied from .../OBJECT/NEWVIEWS/SYSTEM/EMPLOYEE/CANADA.social_insurance_number -because we will use this repeatedly */} ::namespace eval ::QW::NEWVIEWS { /* { ::QW::NEWVIEWS::audit_print_check ::QW::NEWVIEWS::cmhc_unit_layout_list ::QW::NEWVIEWS::cmhc_unit_layout_row ::QW::NEWVIEWS::currency_symbol_abbreviation_and_name_list ::QW::NEWVIEWS::currency_symbol_abbreviation_and_name_pick_list ::QW::NEWVIEWS::currency_type_abbreviation_and_name_list ::QW::NEWVIEWS::currency_type_abbreviation_and_name_pick_list ::QW::NEWVIEWS::fchi2_energy_source_list ::QW::NEWVIEWS::fchi2_service_allowance_lookup ::QW::NEWVIEWS::fchi2_unit_layout_list ::QW::NEWVIEWS::high_need_households ::QW::NEWVIEWS::hil_number_of_bedrooms_get ::QW::NEWVIEWS::hil_region_map_to_common_row_20190606 ::QW::NEWVIEWS::hil_region_map_to_common_row_20210101 ::QW::NEWVIEWS::hil_region_map_to_common_row_20220101 ::QW::NEWVIEWS::hil_region_map_to_common_row_20230101 ::QW::NEWVIEWS::hil_region_table_row_get ::QW::NEWVIEWS::household_income_limits ::QW::NEWVIEWS::interactive_row_number ::QW::NEWVIEWS::print_journal_transactions_settings_prompt_defaults ::QW::NEWVIEWS::recursive_list ::QW::NEWVIEWS::recursive_list_low_level ::QW::NEWVIEWS::rgi_calc_item_date_dump ::QW::NEWVIEWS::rgi_calc_item_dump ::QW::NEWVIEWS::rgi_calc_list_dump ::QW::NEWVIEWS::rgi_calc_province ::QW::NEWVIEWS::rgi_income_type_list ::QW::NEWVIEWS::rgi_look_up_table ::QW::NEWVIEWS::rgi_look_up_table_fchi2 ::QW::NEWVIEWS::set_help_id ::QW::NEWVIEWS::transaction_posting_field_value_get ::QW::NEWVIEWS::view_install_attachments_menu */} #nv2.29.0 ::proc view_install_attachments_menu {sargs} { /* { /maybe_command_maybe { ::qw::script::source [::sargs .script.path [::file join $::qw_library object attachments_explorer.qw_script] .odb.object %_odb_address]; } */} ::return { /menu { /view { /install { .script { /text {return "Install";} /command {} /underline {return 0;} } /attachments { .script { /text {return "Attachments";} /command {%_odb_address view_install_attachments;} /underline {return 0;} } } } } } } } #nv2.33.0 (additional_info_schema) ::if {$::qw_version>=2.33&&$::qw::control(additional_info_schema_view_install)} { ::proc view_install_custom_data_menu {sargs} { ::return { /menu { /view { /install { .script { /text {return "Install";} /command {} /underline {return 0;} } /additional_info_schema { .script { /text {return "Custom Data Definition";} /command {%_odb_address view_install_custom_data;} /underline {return 0;} } } } } } } } #nv2.33.0 (additional_info_schema) ::proc view_install_journal_custom_data_menu {sargs} { ::return { /menu { /view { /install { .script { /text {return "Install";} /command {} /underline {return 0;} } /additional_info_schema { .script { /text {return "Journal Custom Data Definition";} /command {%_odb_address view_install_custom_data [::sargs .observer_type Journal];} /underline {return 0;} } } /additional_info_schema_transaction { .script { /text {return "Transaction Custom Data Definition";} /command {%_odb_address view_install_custom_data [::sargs .observer_type Transaction];} /underline {return 0;} } } } } } } } #nv2.33.0 (additional_info_schema) /* { ::proc view_install_report_custom_data_menu {sargs} { ::return { /menu { /view { /install { .script { /text {return "Install";} /command {} /underline {return 0;} } /additional_info_schema { .script { /text {return "Report Custom Data Definition";} /command {%_odb_address view_install_custom_data [::sargs .observer_type Journal];} /underline {return 0;} } } /additional_info_schema_transaction { .script { /text {return "Account Custom Data Definition";} /command {%_odb_address view_install_custom_data [::sargs .observer_type Transaction];} /underline {return 0;} } } } } } } } */} } #//------------------------------------------------------------------------- #nv2.28.3 #nv2.35.5 (rgi_all_provinces) #::foreach Proc [::lsort [::info procs ::QW::*]] {::puts $Proc} ::proc rgi_calc_province {sargs} { /* { from payroll/canada {AB} {Alberta} {BC} {British Columbia} {MB} {Manitoba} {NB} {New Brunswick} {NL} {Newfoundland & Labrador} {NU} {Nunavut} {NT} {Northwest Territories} {NS} {Nova Scotia} {ON} {Ontario} {PE} {Prince Edward Island} {PQ} {Quebec} {SK} {Saskatchewan} {YK} {Yukon} {ZZ} {Outside Canada} */} ::set Province [::sargs::get $sargs .province]; ::if {$Province eq ""} { ::set Database [::sargs::get $sargs .odb.database]; ::set Object [::sargs::get $sargs .odb.object]; #::set Window [::sargs::get $sargs .odb.window]; ::set Province ""; ::if {$Object ne ""} { #//::puts "pgq,debug...rgi_calc_province Object==[$Object odb_path_help]"; ::set Province [[$Object .address.state] odb_get]; } ::if {$Province eq ""} { ::set Province [[[$Database "/OBJECT/NEWVIEWS/ACCOUNT"] .address.state] odb_get]; } } ::set Province [::string tolower [::string trim $Province]]; #//::puts "pgq,debug...rgi_calc_province Province==$Province"; ::switch -glob -- $Province { "" - o* {::return "ON";} a* {::return "AB";} b* {::return "BC";} m* {::return "MB";} nb - "new b*" {::return "NB";} nl - newf* {::return "NL";} nu* {::return "NU";} nt - nor* {::return "NT";} ns - nov* {::return "NS";} pr* - pe* {::return "PE";} pq - q* {::return "PQ";} y* {::return "YK";} s* {::return "SK";} default { ::return "ON"; } } } #nv2.28.0 (diagnostics) ::proc rgi_calc_list_dump {sargs} { ::set Account [::sargs::get $sargs .odb.object]; ::set RGIlist [[$Account .rgi_calc_list] odb_get]; ::foreach RGIcalc $RGIlist { ::foreach Titem [::sargs::get $RGIcalc .tenant_list] { ::puts "pgq,debug.../RGI_CALC_LIST .tenant_list item==(\n[::sargs::format .structure $Titem]\n)"; } ::foreach Titem [::sargs::get $RGIcalc .income_list] { ::puts "pgq,debug.../RGI_CALC_LIST .income_list item==(\n[::sargs::format .structure $Titem]\n)"; ::foreach Ditem [::sargs::get $Titem .amount_income_detail_list] { ::puts "pgq,debug.../RGI_CALC_LIST .amount_income_detail_list item==(\n[::sargs::format .structure $Ditem]\n)"; } } ::foreach Titem [::sargs::get $RGIcalc .additional_charges] { ::puts "pgq,debug.../RGI_CALC_LIST .additional_charges item==(\n[::sargs::format .structure $Titem]\n)"; } ::sargs::var::unset RGIcalc .tenant_list; ::sargs::var::unset RGIcalc .income_list; ::sargs::var::unset RGIcalc .additional_charges; ::sargs::var::unset RGIcalc .calc; ::puts "pgq,debug.../TABLE/LIST/RGI_CALC_LIST flat fields of .rgi_calc_list==(\n[::sargs::format .structure $RGIcalc]\n)"; } ::return; } ::proc rgi_calc_item_dump {sargs} { ::set RGIcalc [::sargs::get $sargs .rgi_calc_item]; #//::puts "==============================================================================================BEG("; #::puts "rgi_calc_item_dump RGIcalc==(\n[::sargs::format .structure $RGIcalc]\n)"; #//::puts "==============================================================================================END)"; ::puts "[::sargs::get $sargs .text]==============================================================================================BEG("; #::qw::stack_dump; ;#//pgq,debug ::puts "-------------------------------------------------------------------------------------------------.tenant_list"; ::foreach Titem [::sargs::get $RGIcalc .tenant_list] { ::puts "rgi_calc_item_dump ::foreach .tenant_list item==(\n[::sargs::format .structure $Titem]\n)"; } ::puts "-------------------------------------------------------------------------------------------------.income_list"; ::foreach Titem [::sargs::get $RGIcalc .income_list] { ::puts "rgi_calc_item_dump ::foreach .income_list item==(\n[::sargs::format .structure $Titem]\n)"; } ::puts "-------------------------------------------------------------------------------------------------.additional_charges"; ::foreach Titem [::sargs::get $RGIcalc .additional_charges] { ::puts "rgi_calc_item_dump ::foreach .additional_charges item==(\n[::sargs::format .structure $Titem]\n)"; } ::puts "-------------------------------------------------------------------------------------------------.final_adjustments"; ::foreach Titem [::sargs::get $RGIcalc .final_adjustments] { ::puts "rgi_calc_item_dump ::foreach .final_adjustments item==(\n[::sargs::format .structure $Titem]\n)"; } ::sargs::var::unset RGIcalc .tenant_list; ::sargs::var::unset RGIcalc .income_list; ::sargs::var::unset RGIcalc .additional_charges; ::sargs::var::unset RGIcalc .final_adjustments; ::set Calc [::sargs::get $RGIcalc .calc]; ::sargs::var::unset RGIcalc .calc; ::puts "-------------------------------------------------------------------------------------------------"; #//////::puts "rgi_calc_item_dump flat fields of .rgi_calc_list==(\n[::sargs::format .structure $RGIcalc]\n)"; ::puts "rgi_calc_item_dump flat fields of .rgi_calc_list .effective_end_date==[::sargs::get $RGIcalc .effective_end_date] .review_date==[::sargs::get $RGIcalc .review_date]"; ;#// Berkeley Lease End Date problem ::puts "-------------------------------------------------------------------------------------------------.unit_list"; ::foreach Titem [::sargs::get $Calc .unit_list] { ::puts "rgi_calc_item_dump ::foreach .calc.unit_list item==(\n[::sargs::format .structure $Titem]\n)"; } ::sargs::var::unset Calc .unit_list; # ::sargs::var::unset Calc .html_display_detail; # ::sargs::var::unset Calc .html_display_summary; ::puts "-------------------------------------------------------------------------------------------------"; # ::puts "rgi_calc_item_dump .calc==(\n[::sargs::format .structure $Calc]\n)"; ::puts "==============================================================================================END)"; ::return; } ::proc rgi_calc_item_date_dump {sargs} { ::set RGIcalc [::sargs::get $sargs .rgi_calc_item]; ::puts "-------------------------------------------------------------------------------------------------.rgi_calc_item"; ::puts "rgi_calc_item_dump .effective_date==[::sargs::get $RGIcalc .effective_date] .review_date==[::sargs::get $RGIcalc .review_date]"; ::foreach Titem [::sargs::get $RGIcalc .tenant_list] { ::puts "rgi_calc_item_dump .tenant_list item .tenant_birthdate==[::sargs::get $Titem .tenant_birthdate] .tenant_name==[::sargs::get $Titem .tenant_name]"; } } #nv2.34.2 (rgi_calc_regulation) ::proc rgi_income_type_list {sargs} { ::set RGItype [::sargs::get $sargs .rgi_calc_type]; ::set RGIreg [::sargs::get $sargs .rgi_calc_regulation]; #::if {$RGItype eq "HSA"&&$RGIreg eq ""} { # ::set RGIreg [[odb_master] rgi_calc_regulation_get]; ;#// should not be necessary (possible) #} ::set RGIcombo "$RGItype$RGIreg"; #::set RGIcombo [::string tolower "$RGItype$RGIreg"]; #//::puts "pgq,debug_rgireg::QW::NEWVIEWS::rgi_income_type_list RGIcombo==$RGIcombo"; ::switch -exact -- $RGIcombo { ILM - Section95 - HSA - HSA298/01 { ::set OKlist { "Self Employment" "Regular Employment" "WSIB" "Pensions" "EI" "Child Support Income" "Assets" "Other Income" "OW" "ODSP" "CPP" "CPP-D" "OAS" "OAS Spouse's Allowance" } } HSA316/19 { ::set OKlist { "Net Income" "Net Income w/Employment" "ODSP" "OW" "CPP-D" "OAS Spouse's Allowance" "RDSP" } } FCHI2 { #nv2.34.5 (FCHI2) - new income types ::set OKlist { "Employment Income" "Investment Income" "Other Income" "Social Assistance" } } default { ::qw::throw [::sargs \ .text "rgi_income_type \"$RGIcombo\" not found." \ .help_id 0 \ ]; } } } #nv2.34.2 (rgi_calc_regulation) - moved look_up_table to gui.lib ::proc rgi_look_up_table {table row column _rgi_sargs} { #//::puts "pgq,debug2384...rgi_look_up_table enter table==$table row==$row column==$column .effective_date==[::sargs::get $_rgi_sargs .effective_date]"; #::qw::stack_dump; ;#//pgq,debug #//::puts "pgq,debug_rgireg...rgi_look_up_table .effective_date==[::sargs::get $_rgi_sargs .effective_date]"; #//::puts "pgq,debug_rgireg...rgi_look_up_table .pre_nv2_31_2==[::sargs::boolean_get $_rgi_sargs .pre_nv2_31_2]"; #//::puts "pgq,debug_rgireg...rgi_look_up_table .use_2018_odsp_table==[::sargs::boolean_get $_rgi_sargs .use_2018_odsp_table]"; # WTF? ----------------------------------------------------------------- #// we swtich on row=="string value" in most cases below - fortunately ::expr {"hello"<0} returns 0 #// sample - ::set HeatAllowance [look_up_table gasHeatAllowance $Layout $ZoneIndex]; #// - where Layout is a string like "apartment, 1 bedroom" #// - where ZoneIndex is an integer created from an lsearch of a list (e.g. {northern southern}) or a switch case # robust_calc (Tommy WTF?) ::if {$row eq "" || $row < 0 || $column eq "" || $column < 0} { ::return 0; } #nv2.37.0 (ILM_S95) - rgi_look_up_table - utilities update 2023 ::if {[::string first "_cmhc" $table]>0} { ::return [rgi_look_up_table_ILM_S95_utilities $table $row $column $_rgi_sargs]; } #nv2.31.4 (bug fix) - /ACCOUNT/AR.rgi_calc_list look_up_table - replaced 800 occurances of "[... $column;]" with "[...$column];" #nv2.34.2 (rgi_calc_regulation) - table numbers changed - Table 3,4,5 are now called 1,2,3 ::switch $table { table3 { #nv2.30.3 (bug fix) - changed case '1' in the following switch #Single parent on OW where the child is not a beneficiary # old - 1 {::return 0;} #// OW - HSA298/01 TABLE 1 #// .unit_type case "benefit_OW" - [::sargs::get $Unit .single_parent] EQUAL "single_parent" ::switch $row { 0 - 1 {::return [::lindex {85 360} $column];} 2 {::return [::lindex {191 791} $column];} 3 {::return [::lindex {226 907} $column];} 4 {::return [::lindex {269 1051} $column];} 5 {::return [::lindex {311 1191} $column];} 6 {::return [::lindex {353 1331} $column];} 7 {::return [::lindex {396 1474} $column];} 8 {::return [::lindex {438 1614} $column];} 9 {::return [::lindex {480 1754} $column];} 10 {::return [::lindex {523 1897} $column];} 11 {::return [::lindex {565 2037} $column];} default { ::return [::lindex {607 2117} $column]; } } } table4 { #// OW - TABLE 2 #// .unit_type case "benefit_OW" - [::sargs::get $Unit .single_parent] NOT EQUAL "single_parent" ::switch $row { 0 {::return 0;} 1 {::return [::lindex {85 360} $column];} 2 {::return [::lindex {175 737} $column];} 3 {::return [::lindex {212 861} $column];} 4 {::return [::lindex {254 1001} $column];} 5 {::return [::lindex {296 1141} $column];} 6 {::return [::lindex {339 1284} $column];} 7 {::return [::lindex {381 1424} $column];} 8 {::return [::lindex {423 1564} $column];} 9 {::return [::lindex {466 1707} $column];} 10 {::return [::lindex {508 1847} $column];} 11 {::return [::lindex {550 1987} $column];} default { ::return [::lindex {593 2131} $column]; } } } table5 { #// ODSP - TABLE 3 #// .unit_type case "benefit_ODSP" - ::if {$NonBenefit > [look_up_table table5 $UnitSize 1]} then {Non-benefit exceeds $LookUpValue} else {::set AdjustedSubTotal [look_up_table table5 $UnitSize 0];} ::switch $row { 0 {::return 0;} 1 {::return [::lindex {109 440} $column];} 2 {::return [::lindex {199 817} $column];} 3 {::return [::lindex {236 941} $column];} 4 {::return [::lindex {278 1081} $column];} 5 {::return [::lindex {321 1224} $column];} 6 {::return [::lindex {363 1364} $column];} 7 {::return [::lindex {405 1504} $column];} 8 {::return [::lindex {448 1647} $column];} 9 {::return [::lindex {490 1787} $column];} 10 {::return [::lindex {532 1927} $column];} 11 {::return [::lindex {575 2071} $column];} default { ::return [::lindex {617 2211} $column]; } } } table6 { #// HSA - .utilities.electricity.laundry ::switch $row { none {::return [::lindex {30 43 50 53} $column];} building {::return [::lindex {36 52 61 66} $column];} unit_washer_only {::return [::lindex {32 45 52 55} $column];} unit_dryer_only {::return [::lindex {38 54 63 68} $column];} unit_washer_dryer {::return [::lindex {40 56 65 70} $column];} } } basicNeedsTable { #//::puts "pgq,debug2384...rgi_look_up_table enter table==$table row==$row column==$column .use_2018_odsp_table==[::sargs::get $_rgi_sargs .use_2018_odsp_table]"; #nv2.31.2 (update) - /ACCOUNT/AR.rgi_calc_list final_rgi_calculations - updated scale amounts - this changed on Jan 1, 2017 #// xxx #// | digit for "child of household" - Tommy said "children 18+ in the hundreds digit" #// | digit for "child 13-17 years" #// | digit for "child 0-12 years" #nv2.38.3 (basic needs) - gui/gui basicNeedsTable - updated for 20240701 - published 202409?? ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240701" "day"]>=0 \ } { ::set RGItype [::sargs::get $_rgi_sargs .rgi_calc_type]; ::set RGIreg [::sargs::get $_rgi_sargs .rgi_calc_regulation]; #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table RGItype==$RGItype RGIreg==$RGIreg row==$row column==$column"; ::if {$RGItype eq "HSA"||$RGItype eq "ILM"} { ::if {$row==0} {::return [::lindex {786 1134 1569} $column];} #nv2.38.4 (bug fix) - gui/gui basicNeedsTable - updated for government typo #::if {$row<10} {::return [::lindex {929 1134 1569} $column];} ::if {$row<10} {::return [::lindex {786 1134 1569} $column];} ::if {$row<20} {::return [::lindex {1219 1355 1790} $column];} ::if {$row<30} {::return [::lindex {1441 1602 2037} $column];} ::set Base [::lindex {1441 1602 2037} $column]; ::set Result [::expr {$Base+([::string range $row 0 0]-2)*248}]; ::return $Result; } } #nv2.37.2 (basic needs) - gui/gui basicNeedsTable - updated for 20230701 - published 202309?? ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230701" "day"]>=0 \ } { ::set RGItype [::sargs::get $_rgi_sargs .rgi_calc_type]; ::set RGIreg [::sargs::get $_rgi_sargs .rgi_calc_regulation]; #//::puts "pgq,debug2383kirk_rgireg...rgi_look_up_table RGItype==$RGItype RGIreg==$RGIreg row==$row column==$column"; ::if {$RGItype eq "HSA"||$RGItype eq "ILM"} { ::if {$row==0} {::return [::lindex {752 1085 1501} $column];} #???::if {$row<10} {::return [::lindex {752 1085 1501} $column];} ::if {$row<10} {::return [::lindex {895 1296 1501} $column];} #???::if {$row<20} {::return [::lindex {1166 1296 1712} $column];} ::if {$row<20} {::return [::lindex {1166 1085 1712} $column];} ::if {$row<30} {::return [::lindex {1378 1532 1948} $column];} ::set Base [::lindex {1378 1532 1948} $column]; ::set Result [::expr {$Base+([::string range $row 0 0]-2)*237}]; #//::puts "pgq,debug2383kirk_rgireg...rgi_look_up_table RGItype==$RGItype RGIreg==$RGIreg row==$row column==$column Result==$Result"; ::return $Result; } } #nv2.36.1 (basic needs) - gui/gui basicNeedsTable - updated for 20220901 ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220901" "day"]>=0 \ } { ::set RGItype [::sargs::get $_rgi_sargs .rgi_calc_type]; ::set RGIreg [::sargs::get $_rgi_sargs .rgi_calc_regulation]; #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table RGItype==$RGItype RGIreg==$RGIreg row==$row column==$column"; ::if {$RGItype eq "HSA"||$RGItype eq "ILM"} { ::if {$row==0} {::return [::lindex {706 1018 1409} $column];} ::if {$row<10} {::return [::lindex {849 1018 1409} $column];} ::if {$row<20} {::return [::lindex {1094 1216 1607} $column];} ::if {$row<30} {::return [::lindex {1293 1437 1828} $column];} ::set Base [::lindex {1293 1437 1828} $column]; ::set Result [::expr {$Base+([::string range $row 0 0]-2)*222}]; ::return $Result; } } #New Basic Needs Table as of Sept 1, 2018. #nv2.35.5 (basic needs) - gui/gui basicNeedsTable - use .effective_date in addition to old kludge .use_2018_odsp_table - remove kludge ASAP #::if {[::sargs::boolean_get $_rgi_sargs .use_2018_odsp_table]} {} ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0 \ ||[::sargs::boolean_get $_rgi_sargs .use_2018_odsp_table] \ } { #nv2.34.5 (bug fix) - rgi_look_up_table - basicNeedsTable lookup is wrong for RGIreg eq 316/19 ::set RGItype [::sargs::get $_rgi_sargs .rgi_calc_type]; ::set RGIreg [::sargs::get $_rgi_sargs .rgi_calc_regulation]; #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table RGItype==$RGItype RGIreg==$RGIreg row==$row column==$column"; #::if {$RGIreg eq "316/19"} {} #::if {$RGItype eq "HSA"} {} ::if {$RGItype eq "HSA"||$RGItype eq "ILM"} { ::if {$row==0} {::return [::lindex {672 969 1341} $column];} ::if {$row<10} {::return [::lindex {815 969 1341} $column];} ::if {$row<20} {::return [::lindex {1041 1157 1529} $column];} ::if {$row<30} {::return [::lindex {1230 1367 1739} $column];} ::set Base [::lindex {1230 1367 1739} $column]; ::set Result [::expr {$Base+([::string range $row 0 0]-2)*211}]; ::return $Result; } #//::puts "pgq,debug-------------kirk_rgireg...rgi_look_up_table RGIreg==$RGIreg row==$row row==\"$row\" column==$column"; ::switch -- $row { 0 {::return [::lindex {672 969 1341} $column];} 1 {::return [::lindex {815 969 1341} $column];} 10 {::return [::lindex {815 969 1341} $column];} 100 { #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table WTF case 100 ::return==[::lindex {1041 1157 1529} $column]"; ::return [::lindex {1041 1157 1529} $column]; } 2 {::return [::lindex {815 969 1341} $column];} 11 {::return [::lindex {815 969 1341} $column];} 20 {::return [::lindex {815 969 1341} $column];} 101 {::return [::lindex {1041 1157 1529} $column];} 110 {::return [::lindex {1041 1157 1529} $column];} 200 {::return [::lindex {1230 1367 1739} $column];} } #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table RGIreg==$RGIreg row==$row column==$column MISSED"; #If we reach here that means there are more than 2 children that are in the same age group #if this is the case we add $211 per extra child 18 or older, $0 for children 13-17 #and $0 for every child 12 and under. # the value of row indicates the number of #// children 12 and under in the ones digit #// children 13-17 in the tens digit #// children 18+ in the hundreds digit #//::puts "pgq,debug6kirk_rgireg...rgi_look_up_table BEFORE call naked expr function fmod"; ::set UnderTwelve [fmod $row 10]; #//::puts "pgq,debugkirk_rgireg...rgi_look_up_table AFTER call naked expr function fmod UnderTwelve==$UnderTwelve"; ::set row [::expr {$row - $UnderTwelve}]; ::set ThirteenSeventeen [::expr {[fmod $row 100] / 10}]; ::set row [::expr {$row - $ThirteenSeventeen * 10}]; ::set EighteenPlus [::expr {[fmod $row 1000] / 100}]; ::set BasicNeeds [::expr {($EighteenPlus * 211) + ($ThirteenSeventeen * 0)}]; ::switch $column { 0 { ::return [::expr {$BasicNeeds + 815}]; } 1 { ::return [::expr {$BasicNeeds + 969}]; } 2 { ::return [::expr {$BasicNeeds + 1341}]; } } } else { #New Basic Needs Table as of Sept 1, 2017. We still want to use the old table for old RGI items ::if {[::sargs::get $_rgi_sargs .effective_date] ne "" \ &&[::string range [::sargs::get $_rgi_sargs .effective_date] 0 7] < 20170901 \ ||[::sargs::boolean_get $_rgi_sargs .pre_nv2_31_2] \ } { ::switch $row { 0 {::return [::lindex {649 935 1295} $column];} 1 {::return [::lindex {792 935 1295} $column];} 10 {::return [::lindex {792 935 1295} $column];} 100 {::return [::lindex {1004 1116 1476} $column];} 2 {::return [::lindex {792 935 1295} $column];} 11 {::return [::lindex {792 935 1295} $column];} 20 {::return [::lindex {792 935 1295} $column];} 101 {::return [::lindex {1004 1116 1476} $column];} 110 {::return [::lindex {1004 1116 1476} $column];} 200 {::return [::lindex {1186 1317 1677} $column];} } #If we reach here that means there are more than 2 children that are in the same age group #if this is the case we add $202 per extra child 18 or older, $1 for children 13-17 #and $0 for every child 12 and under. #This changed to $0 for children 13-17 for version 2.29 #the value of row indicates the number of children 12 and under in the ones digit, # of #children 13-17 in the tens digit and 18+ in the hundreds digit ::set UnderTwelve [fmod $row 10]; ::set row [::expr {$row - $UnderTwelve}]; ::set ThirteenSeventeen [::expr {[fmod $row 100] / 10}]; ::set row [::expr {$row - $ThirteenSeventeen * 10}]; ::set EighteenPlus [::expr {[fmod $row 1000] / 100}]; ::set BasicNeeds [::expr {($EighteenPlus * 202) + ($ThirteenSeventeen * 0)}]; ::switch $column { 0 { ::return [::expr {$BasicNeeds + 792}]; } 1 { ::return [::expr {$BasicNeeds + 935}]; } 2 { ::return [::expr {$BasicNeeds + 1295}]; } } } else { ::switch $row { 0 {::return [::lindex {662 954 1321} $column];} 1 {::return [::lindex {805 954 1321} $column];} 10 {::return [::lindex {805 954 1321} $column];} 100 {::return [::lindex {1025 1139 1506} $column];} 2 {::return [::lindex {805 954 1321} $column];} 11 {::return [::lindex {805 954 1321} $column];} 20 {::return [::lindex {805 954 1321} $column];} 101 {::return [::lindex {1025 1139 1506} $column];} 110 {::return [::lindex {1025 1139 1506} $column];} 200 {::return [::lindex {1211 1345 1712} $column];} } #If we reach here that means there are more than 2 children that are in the same age group #if this is the case we add $202 per extra child 18 or older, $1 for children 13-17 #and $0 for every child 12 and under. #This changed to $0 for children 13-17 for version 2.29 #This changed to $207 for children 18+ for version 2.31.2 #the value of row indicates the number of children 12 and under in the ones digit, # of #children 13-17 in the tens digit and 18+ in the hundreds digit ::set UnderTwelve [fmod $row 10]; ::set row [::expr {$row - $UnderTwelve}]; ::set ThirteenSeventeen [::expr {[fmod $row 100] / 10}]; ::set row [::expr {$row - $ThirteenSeventeen * 10}]; ::set EighteenPlus [::expr {[fmod $row 1000] / 100}]; ::set BasicNeeds [::expr {($EighteenPlus * 207) + ($ThirteenSeventeen * 0)}]; ::switch $column { 0 { ::return [::expr {$BasicNeeds + 805}]; } 1 { ::return [::expr {$BasicNeeds + 954}]; } 2 { ::return [::expr {$BasicNeeds + 1321}]; } } } } } oilHeatAllowance { ::switch $row { "apartment, 1 bedroom" {::return [::lindex {49 55 56 67} $column];} "apartment, 2 bedrooms" {::return [::lindex {51 57 58 72} $column];} "apartment, 3+ bedrooms" {::return [::lindex {64 69 73 90} $column];} "row house" {::return [::lindex {68 73 79 102} $column];} "semi-detached house" {::return [::lindex {92 97 107 135} $column];} "single detached house" {::return [::lindex {136 147 149 182} $column];} } } gasHeatAllowance { ::switch $row { "apartment, 1 bedroom" {::return [::lindex {21 31 32 40} $column];} "apartment, 2 bedrooms" {::return [::lindex {24 32 33 43} $column];} "apartment, 3+ bedrooms" {::return [::lindex {25 35 39 49} $column];} "row house" {::return [::lindex {28 37 42 56} $column];} "semi-detached house" {::return [::lindex {39 49 56 76} $column];} "single detached house" {::return [::lindex {56 74 79 100} $column];} } } electricityHeatAllowance { ::switch $row { "apartment, 1 bedroom" {::return [::lindex {40 45 46 55} $column];} "apartment, 2 bedrooms" {::return [::lindex {42 47 48 59} $column];} "apartment, 3+ bedrooms" {::return [::lindex {53 57 60 74} $column];} "row house" {::return [::lindex {56 60 65 84} $column];} "semi-detached house" {::return [::lindex {76 80 88 111} $column];} "single detached house" {::return [::lindex {112 121 123 150} $column];} } } } /* { ::set Vlist { {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} } */} #nv2.34.11 (harden) - ::proc rgi_look_up_table - ::return 0 in all cases not "covered" - broken math versus poof evaluating numeric expression with "" ::return 0; } ;#//::proc rgi_look_up_table ::proc rgi_look_up_table_ILM_S95_utilities_WORKING {table row column _rgi_sargs} { #//::puts "pgq,debug2385...rgi_look_up_table_ILM_S95_utilities enter table==$table"; #::qw::stack_dump; ;#//pgq,debug #nv2.37.0 (ILM_S95) - rgi_look_up_table - utilities update 2023 - ONTARIO only for now - BC, AB, PE can wait... ::switch $table { enbridgeHeatingAllowance_2024_cmhc { #nv2.38.2 (ILM_S95) - rgi_look_up_table_ILM_S95_utilities - update 2024 ::set Vlist { {47 71 72} {57 106 108} {73 159 162} {85 203 206} {98 248 251} {65 133 137} {92 227 236} {101 256 265} {120 322 334} {128 351 363} {57 106 108} {73 159 162} {85 203 206} {98 248 251} {114 287 292} {79 0 0} {113 300 306} {123 338 344} {146 425 434} {156 463 472} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 25 26} {11 38 39} {17 57 59} {21 73 75} {26 88 92} {12 40 41} {20 68 71} {23 77 79} {29 97 100} {31 105 109} {11 38 39} {17 57 59} {21 73 75} {26 88 92} {30 103 106} {13 42 43} {21 72 74} {24 81 83} {30 102 105} {33 111 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2024_cmhc { ::set Vlist { {50 71 66} {62 106 100} {79 159 149} {94 203 191} {109 247 232} {75 132 127} {102 227 218} {112 255 245} {135 322 308} {144 350 336} {62 106 100} {79 159 149} {94 203 191} {109 247 232} {127 287 269} {91 0 0} {125 300 283} {137 337 318} {164 425 401} {176 462 436} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 25 24} {12 38 36} {19 57 54} {24 73 70} {29 88 85} {13 40 38} {22 68 65} {25 77 73} {32 97 93} {35 105 101} {12 38 36} {19 57 54} { 24 73 70} { 29 88 85} { 34 102 98} {14 42 40} {24 72 69} {27 81 77} {34 102 97} {37 111 106} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2024_cmhc { ::set Vlist { {46 71 61} {56 106 91} {70 159 137} {83 203 175} {95 248 213} {63 133 116} {89 227 199} {97 256 224} {116 322 282} {124 351 307} {56 106 91} {70 159 137} {83 203 175} {95 248 813} {110 287 247} {77 0 0} {109 300 259} {119 338 291} {141 425 367} {151 463 399} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2024_cmhc { ::set Vlist { {7 25 22} {10 38 33} {15 57 50} {20 73 64} {24 88 77} {11 40 35} {19 68 60} {21 77 67} {26 97 85} {29 105 92} {10 38 33} {15 57 50} {20 73 64} {24 88 77} {28 103 90} {11 42 37} {20 72 63} {22 81 71} {28 102 89} {30 111 97} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2024_cmhc { ::set Vlist { {50 66 71} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {75 124 136} {102 213 234} {112 239 263} {135 301 331} {144 328 361} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {127 269 290} {91 0 0} {125 281 304} {137 316 342} {164 396 431} {176 433 469} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 24 26} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {13 37 41} {22 64 70} {25 72 79} {32 90 99} {35 98 108} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {34 96 106} {14 39 43} {24 68 74} {27 76 83} {34 96 104} {37 104 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2024_cmhc { ::set Vlist { {50 66 71} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {75 124 136} {102 213 234} {112 239 263} {135 301 331} {144 328 361} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {127 269 290} {91 0 0} {125 281 304} {137 316 342} {164 398 431} {176 433 469} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 24 26} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {13 37 41} {22 64 70} {25 72 79} {32 90 99} {35 98 108} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {34 96 106} {14 39 43} {24 68 74} {27 76 83} {34 96 104} {37 104 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2024_cmhc { ::set Vlist { {46 69 64} {56 104 96} {70 155 144} {83 198 185} {95 242 225} {63 129 123} {89 222 211} {97 250 243} {116 314 298} {124 342 325} {56 104 96} {70 155 144} {83 198 185} {95 242 225} {110 280 261} {77 0 0} {109 293 274} {119 329 308} {141 415 388} {151 451 422} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2024_cmhc { ::set Vlist { {7 25 23} {10 37 35} {15 55 53} {20 71 67} {24 86 82} {11 39 37} {19 67 63} {21 75 71} {26 94 90} {29 103 97} {10 37 35} {15 55 53} {20 71 67} {24 86 82} {28 100 95} {11 41 39} {20 71 66} {22 79 75} {28 100 94} {30 109 102} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2024_cmhc { ::set Vlist { {50 72 64} {62 108 96} {79 162 144} {94 207 184} {109 253 224} {75 135 122} {102 232 210} {112 261 236} {135 329 297} {144 358 323} {62 108 96} {79 162 144} {94 207 184} {109 253 224} {127 293 260} {91 0 0} {125 306 273} {137 344 307} {164 434 386} {176 472 420} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 26 23} {12 39 35} {19 58 52} {24 74 67} {29 90 82} {13 41 37} {22 70 63} {25 78 71} {32 99 89} {35 107 97} {12 39 35} {19 58 52} {24 74 67} {29 90 82} {34 105 95} {14 43 39} {24 74 66} {27 83 74} {34 104 94} {37 114 102} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2024_cmhc - kitchenerElectricityCharge_2024_cmhc - northEasternElectricityCharge_2024_cmhc - northWesternElectricityCharge_2024_cmhc - southernElectricityCharge_2024_cmhc - enbridgeElectricityCharge_2024_cmhc - westernElectricityCharge_2024_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 60 102 115 145 157} $column];} row_town {::return [::lindex {0 47 81 91 114 124} $column];} apartment {::return [::lindex {29 44 66 84 103 119} $column];} single_laundry {::return [::lindex {0 67 114 129 162 176} $column];} row_town_laundry {::return [::lindex {0 53 91 102 128 139} $column];} apartment_laundry {::return [::lindex {32 49 74 94 115 133} $column];} } } enbridgeHeatingAllowance_2025_cmhc { #nv2.38.5 (ILM_S95) - rgi_look_up_table_ILM_S95_utilities - update 2025 ::set Vlist { {47 59 72} {56 89 108} {70 133 161} {83 177 215} {92 207 251} {63 111 135} {87 190 231} {97 222 269} {111 269 327} {120 301 365} {56 89 108 } {70 133 161} {83 177 215} {92 207 251} {108 242 294} {79 0 0} {109 251 300} {121 293 350} {138 355 425} {150 397 475} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2025_cmhc { ::set Vlist { {7 21 26} {10 35 38} {15 48 58} {20 63 77} {23 74 90} {10 33 40} {18 57 69} {21 67 81} {25 81 98} {28 90 110} {10 32 38} {15 48 58} {20 63 77} {23 74 90} {27 86 105} {11 35 42} {19 60 73} {22 71 85} {26 86 103} {29 96 115} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2025_cmhc { ::set Vlist { {53 68 66} {64 102 98} {80 153 148} {97 204 197} {108 238 229} {76 128 123} {102 219 211} {133 255 246} {131 310 299} {143 347 334} {64 102 98} {80 153 148} {97 204 197} {108 238 229} {126 279 269} {95 0 0} {127 289 274} {142 337 320} {164 409 388} {179 458 434} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 24 23} {12 36 35} {18 55 53} {24 73 70} {28 85 82} {12 38 37} {21 66 63} {25 77 74} {30 93 90} {34 104 100} {12 36 35} {18 55 53} {24 73 70} {28 85 82} {32 100 96} {13 41 39} {23 70 66} {26 81 77} {32 99 94} {36 110 105} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2025_cmhc { ::set Vlist { {46 59 60} {55 89 90} {67 133 135} {79 177 181} {87 207 211} {61 111 113} {82 190 194} {91 222 226} {104 269 274} {112 301 306} {55 89 90} {67 133 135} {79 177 181} {87 207 211} {101 242 247} {76 0 0} {103 251 252} {113 293 294} {129 355 356} {140 397 398} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2025_cmhc { ::set Vlist { {6 21 22} {9 32 32} {13 48 48} {17 63 65} {20 74 75} {9 33 34} {16 57 58} {18 67 68} {22 81 82} {25 90 92} {9 32 32} {13 48 48} {17 63 65} {20 74 75} {24 86 88} {10 35 36} {16 60 61} {19 71 71} {23 86 86} {26 96 97} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2025_cmhc { ::set Vlist { {53 55 70} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {76 103 131} {102 176 224} {113 206 261} {131 250 317} {143 279 354} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {126 225 285} {95 0 0} {127 233 291} {142 272 339} {164 330 412} {179 369 461} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 20 25} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {12 31 369} {21 53 67} {25 62 78} {30 75 95} {34 84 106} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {32 80 102} {13 33 41} {23 56 71} {26 65 82} {32 79 100} {36 89 112} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2025_cmhc { ::set Vlist { {53 55 70} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {76 103 131} {102 176 224} {113 206 261} {131 250 317} {143 279 354} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {126 225 285} {95 0 0} {127 233 291} {142 272 339} {164 330 412} {179 369 461} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 20 25} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {12 31 39} {21 53 67} {25 62 78} {30 75 95} {34 84 106} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {32 80 102} {13 33 51} {23 56 74} {26 65 82} {32 79 100} {36 89 112} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2025_cmhc { ::set Vlist { {46 56 64} {55 84 97} {67 125 145} {79 167 193} {87 195 225} {61 105 121} {82 179 207} {91 209 241} {104 254 293} {112 284 328} {55 84 97} {67 125 145} {79 167 193} {87 195 225} {101 228 264} {76 0 0} {103 236 269} {113 276 314} {129 335 381} {140 374 426} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2025_cmhc { ::set Vlist { {6 20 23} {9 30 34} {13 45 52} {17 60 69} {20 70 80} {9 31 36} {16 54 62} {18 63 72} {22 76 88} {25 85 98} {9 30 34} {13 45 52} {17 60 69} {20 70 80} {24 82 94} {10 33 38} {16 57 65} {19 66 76} {23 81 92} {26 90 103} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2025_cmhc { ::set Vlist { {53 63 63} {64 95 94} {80 143 141} {97 190 188} {108 222 220} {76 119 118} {102 204 202} {113 238 235} {131 289 286} {143 323 319} {64 95 94} {80 143 141} {97 190 188} {108 222 220} {126 260 257} {95 0 0} {127 269 262} {142 314 306} {164 381 372} {179 426 415} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 23 22} {12 34 34} {18 51 50} {24 68 67} {28 79 78} {12 36 35} {21 61 61} {25 71 71} {30 87 86} {34 97 96} {12 35 35} {18 51 50} {24 68 67} {28 79 78} {32 93 92} {13 38 37} {23 65 64} {26 76 74} {32 92 90} {36 103 101} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2025_cmhc - kitchenerElectricityCharge_2025_cmhc - northEasternElectricityCharge_2025_cmhc - northWesternElectricityCharge_2025_cmhc - southernElectricityCharge_2025_cmhc - enbridgeElectricityCharge_2025_cmhc - westernElectricityCharge_2025_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 57 98 114 138 155} $column];} row_town {::return [::lindex {0 46 78 91 111 124} $column];} apartment {::return [::lindex {28 43 64 85 99 116} $column];} single_laundry {::return [::lindex {0 64 110 128 155 174} $column];} row_town_laundry {::return [::lindex {0 52 87 102 124 139} $column];} apartment_laundry {::return [::lindex {31 48 72 95 111 130} $column];} } } } } ;#//::proc rgi_look_up_table_ILM_S95_utilities ::proc rgi_look_up_table_ILM_S95_utilities {table row column _rgi_sargs} { #//::puts "pgq,debug2385...rgi_look_up_table_ILM_S95_utilities enter table==$table"; #::qw::stack_dump; ;#//pgq,debug #nv2.37.0 (ILM_S95) - rgi_look_up_table - utilities update 2023 - ONTARIO only for now - BC, AB, PE can wait... ::switch $table { enbridgeHeatingAllowance_2021_cmhc { #nv2.34.11 (update) - ILM zones change ::set Vlist { {37 43 51} {42 65 78} {59 114 136} {64 129 154} {76 172 206} {0 0 0} {43 76 90} {63 132 158} {69 150 179} {84 200 239} {90 219 262} {42 65 78} {59 114 136} {64 129 154} {76 172 206} {82 189 226} {51 0 0} {85 191 229} {89 217 260} {111 290 346} {119 318 380} {119 318 380} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2021_cmhc { ::set Vlist { {8 12 15} {11 18 22} {14 32 38} {16 36 44} {21 49 58} {0 0 0} {12 21 25} {16 37 44} {18 42 51} {24 56 67} {26 62 74} {11 18 22} {14 32 38} {16 36 44} {21 49 58} {24 53 64} {16 31 37} {18 54 64} {19 61 73} {25 82 98} {28 90 107} {28 90 107} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2021_cmhc { ::set Vlist { {39 43 48} {46 65 73} {64 113 127} {70 129 144} {83 172 192} {0 0 0} {51 75 85} {70 132 148} {76 150 168} {96 199 224} {99 219 245} {46 65 73} {64 113 127} {70 129 144} {83 172 192} {91 188 211} {55 0 0} {94 191 214} {99 217 243} {124 289 324} {133 317 355} {133 317 355} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2021_cmhc { ::set Vlist { {9 17 19} {12 25 28} {15 44 49} {18 50 56} {23 67 75} {0 0 0} {13 29 33} {18 51 57} {20 58 65} {27 78 87} {29 85 95} {12 25 28} {15 44 49} {18 50 56} {23 67 75} {26 73 82} {18 31 35} {20 54 60} {21 61 69} {28 81 91} {31 89 100} {31 89 100} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2021_cmhc { ::set Vlist { {36 43 45} {41 65 67} {56 114 118} {61 129 134} {71 172 178} {0 0 0} {42 76 78} {60 132 137} {65 150 155} {79 200 207} {84 219 227} {41 65 67} {56 114 118} {61 129 134} {71 172 178} {77 189 195} {48 0 0} {79 191 198} {84 217 225} {103 290 300} {111 318 329} {111 318 329} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2021_cmhc { ::set Vlist { {7 17 17} {10 25 26} {12 44 46} {14 50 52} {18 67 69} {0 0 0} {11 29 30} {14 51 53} {16 58 60} {21 78 81} {23 85 88} {10 25 26} {12 44 46} {14 50 52} {18 67 69} {21 73 73} {14 31 32} {16 54 56} {17 61 63} {22 82 85} {25 90 93} {25 90 93} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2021_cmhc { ::set Vlist { {40 42 51} {47 64 77} {66 111 135} {72 126 153} {86 168 204} {0 0 0} {52 74 90} {72 129 156} {78 147 178} {96 195 237} {103 214 260} {47 64 77} {66 111 135} {72 126 153} {86 168 201} {94 184 224} {56 0 0} {97 187 227} {102 212 258} {128 286 343} {138 311 376} {138 311 376} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2021_cmhc { ::set Vlist { {9 16 20} {13 25 30} {16 43 52} {19 49 60} {24 66 79} {0 0 0} {14 29 35} {19 50 61} {21 57 69} {28 76 92} {31 83 101} {13 25 30} {16 43 52} {19 49 60} {24 66 79} {27 72 87} {19 30 37} {21 53 64} {22 60 73} {29 80 97} {32 88 106} {32 88 106} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2021_cmhc { ::set Vlist { {39 42 51} {45 64 77} {63 11 135} {70 126 153} {83 168 204} {0 0 0} {50 74 90} {69 129 156} {75 147 178} {92 195 237} {98 214 260} {45 64 77} {63 11 135} {70 126 153} {83 168 204} {90 184 224} {55 0 0} {93 187 227} {98 212 258} {122 283 343} {132 311 376} {132 311 376} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2021_cmhc { ::set Vlist { {9 16 20} {12 25 30} {15 43 52} {18 49 60} {23 66 79} {0 0 0} {13 29 35} {17 50 61} {20 57 69} {27 76 92} {29 83 101} {12 25 30} {15 43 52} {18 49 60} {23 66 79} {26 72 87} {18 30 37} {19 53 64} {21 60 73} {28 80 97} {31 88 106} {31 88 106} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2021_cmhc { ::set Vlist { {36 40 47} {40 61 71} {54 106 123} {59 120 140} {69 160 187} {0 0 0} {41 70 82} {58 123 143} {63 140 163} {76 186 217} {81 204 238} {40 61 71} {54 106 123} {59 120 140} {69 160 187} {75 176 205} {47 0 0} {76 178 208} {80 203 236} {97 270 314} {103 296 345} {103 296 345} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2021_cmhc { ::set Vlist { {7 11 13} {9 17 20} {12 30 35} {14 34 39} {17 45 53} {0 0 0} {10 20 23} {13 35 40} {15 39 46} {20 53 61} {22 58 67} {9 17 20} {12 30 35} {14 34 39} {17 45 53} {20 50 58} {13 29 34} {15 50 59} {16 57 66} {21 76 89} {23 83 97} {23 83 97} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2021_cmhc { ::set Vlist { {39 50 46} {45 75 70} {63 131 122} {69 149 138} {82 198 184} {0 0 0} {50 87 81} {68 152 141} {75 173 161} {91 230 214} {98 252 235} {45 75 70} {63 131 122} {69 149 138} {82 198 184} {90 217 202} {54 0 0} {92 220 205} {97 250 233} {122 334 310} {131 366 340} {131 366 340} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2021_cmhc { ::set Vlist { {9 19 18} {12 29 27} {15 51 47} {18 58 54} {23 77 72} {0 0 0} {13 34 32} {17 59 55} {20 67 63} {27 90 83} {29 98 91} {12 29 27} {15 51 47} {18 58 54} {23 77 72} {26 85 79} {18 36 33} {19 62 58} {21 71 66} {28 94 87} {31 103 96} {31 103 96} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2021_cmhc - kitchenerElectricityCharge_2021_cmhc - northEasternElectricityCharge_2021_cmhc - northWesternElectricityCharge_2021_cmhc - southernElectricityCharge_2021_cmhc - enbridgeElectricityCharge_2021_cmhc - westernElectricityCharge_2021_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 50 76 81 108 119} $column];} row_town {::return [::lindex {0 37 61 70 93 102} $column];} apartment {::return [::lindex {25 35 54 62 80 91} $column];} single_laundry {::return [::lindex {0 56 86 92 123 135} $column];} row_town_laundry {::return [::lindex {0 42 70 79 106 116} $column];} apartment_laundry {::return [::lindex {28 39 61 71 91 103} $column];} } } enbridgeHeatingAllowance_2022_cmhc { #nv2.35.5 (cmhc_utilities) - NOTICE - we duplicate the last row of S.F. Detached for 6 bedroom case - in case version turds remain in the data #nv2.34.11 (update) - ILM zones change ::set Vlist { {39 49 49} {47 75 78} {60 116 121} {69 144 150} {81 183 192} {52 89 95} {72 155 165} {77 171 183} {94 224 240} {101 247 264} {47 75 78} {60 116 121} {69 144 150} {81 183 192} {92 207 217} {62 0 0} {86 198 215} {93 219 238} {112 287 311} {121 316 343} {121 316 343} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2022_cmhc { ::set Vlist { {6 19 18} {9 29 31} {15 46 48} {18 57 59} {23 72 76} {10 32 34} {18 56 60} {20 62 66} {26 81 87} {28 90 96} {9 29 31} {15 46 48} {18 57 59} {23 72 76} {26 82 85} {13 41 45} {23 72 78} {26 79 86} {34 104 113} {37 115 125} {37 115 125} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2022_cmhc { ::set Vlist { {42 47 46} {50 72 74} {65 112 115} {74 138 142} {88 176 181} {58 85 92} {78 148 161} {84 164 178} {102 215 234} {110 237 257} {50 72 74} {65 112 115} {74 138 142} {88 176 181} {100 199 205} {69 0 0} {94 190 209} {101 210 232} {123 275 304} {132 303 335} {132 303 335} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2022_cmhc { ::set Vlist { {7 19 17} {10 28 29} {16 44 45} {20 54 56} {25 70 71} {11 31 34} {19 54 58} {22 60 65} {28 78 85} {31 86 93} {10 28 29} {16 44 45} {20 54 56} {25 70 71} {28 79 81} {15 40 44} {25 69 76} {28 76 84} {37 100 110} {40 110 121} {40 110 121} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2022_cmhc { ::set Vlist { {36 49 42} {43 75 67} {54 116 105} {61 144 129} {71 183 165} {47 89 84} {64 155 147} {68 171 162} {81 224 213} {87 247 235} {43 75 67} {54 116 105} {61 144 129} {71 183 165} {80 207 186} {56 0 0} {76 198 191} {81 219 211} {98 287 277} {105 316 305} {105 316 305} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2022_cmhc { ::set Vlist { {5 19 16} {8 29 26} {12 46 41} {15 57 51} {19 72 65} {8 32 31} {14 56 53} {16 62 59} {21 81 77} {23 90 85} {8 29 26} {12 46 41} {15 57 51} {19 72 65} {21 82 74} {11 41 40} {19 72 69} {21 79 77} {27 104 100} {30 115 111} {30 115 111} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2022_cmhc { ::set Vlist { {42 51 50} {50 77 80} {65 120 124} {74 149 154} {88 190 196} {58 92 100} {78 160 175} {84 177 193} {102 232 253} {110 255 279} {50 77 80} {65 120 124} {74 149 154} {88 190 196} {100 214 222} {69 0 0} {94 205 227} {101 226 251} {123 297 329} {132 327 363} {132 327 363} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2022_cmhc { ::set Vlist { {7 20 19} {10 30 32} {16 47 49} {20 59 61} {25 75 77} {11 33 36} {19 58 63} {22 64 70} {28 84 92} {31 93 101} {10 30 32} {16 47 49} {20 59 61} {25 75 77} {28 85 88} {15 43 47} {25 74 82} {28 82 91} {37 108 119} {40 119 132} {40 119 132} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2022_cmhc { ::set Vlist { {41 51 50} {49 77 80} {63 120 124} {72 149 154} {85 190 196} {57 92 100} {75 160 175} {81 177 193} {98 232 253} {106 255 279} {49 77 80} {63 120 124} {72 149 154} {85 190 196} {96 214 222} {68 0 0} {91 205 227} {97 226 251} {118 297 329} {127 324 363} {127 324 363} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2022_cmhc { ::set Vlist { {6 20 19} {10 30 32} {15 47 49} {19 59 61} {24 75 77} {11 33 36} {19 58 63} {20 64 70} {27 84 92} {30 93 101} {10 30 32} {15 47 49} {19 59 61} {24 75 77} {27 85 88} {14 43 47} {24 74 82} {27 82 91} {35 108 119} {38 119 132} {38 119 132} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2022_cmhc { ::set Vlist { {37 46 43} {44 70 69} {55 109 108} {62 135 133} {72 172 170} {44 83 84} {65 145 147} {69 160 162} {83 210 213} {89 231 234} {44 70 69} {54 106 123} {59 120 140} {69 160 187} {75 176 205} {57 0 0} {78 185 191} {83 205 211} {100 269 276} {107 296 305} {107 296 305} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2022_cmhc { ::set Vlist { {5 18 16} {8 28 27} {12 43 43} {15 53 53} {19 68 67} {8 30 31} {15 53 53} {16 58 59} {21 76 77} {23 84 85} {8 28 27} {12 43 43} {15 53 53} {19 68 67} {21 77 76} {11 39 40} {19 67 69} {21 74 77} {28 98 100} {30 107 111} {30 107 111} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2022_cmhc { ::set Vlist { {41 55 44} {49 83 71} {63 130 111} {72 161 137} {85 205 175} {57 99 90} {75 173 156} {81 191 173} {98 250 226} {106 276 249} {49 83 71} {63 130 111} {72 161 137} {85 205 175} {96 232 198} {68 0 0} {91 221 203} {97 244 224} {118 321 294} {127 353 324} {127 353 324} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2022_cmhc { ::set Vlist { {6 22 17} {10 33 28} {15 51 44} {19 63 54} {24 81 69} {11 36 32} {19 63 57} {20 69 63} {27 91 82} {30 100 91} {10 33 28} {15 51 44} {19 63 54} {24 81 69} {27 91 78} {14 46 42} {24 80 74} {27 89 81} {35 116 107} {38 128 118} {38 128 118} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2022_cmhc - kitchenerElectricityCharge_2022_cmhc - northEasternElectricityCharge_2022_cmhc - northWesternElectricityCharge_2022_cmhc - southernElectricityCharge_2022_cmhc - enbridgeElectricityCharge_2022_cmhc - westernElectricityCharge_2022_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 52 91 101 132 146} $column];} row_town {::return [::lindex {0 41 72 80 104 115} $column];} apartment {::return [::lindex {26 39 61 76 97 110} $column];} single_laundry {::return [::lindex {0 58 102 113 148 164} $column];} row_town_laundry {::return [::lindex {0 46 81 90 116 129} $column];} apartment_laundry {::return [::lindex {29 44 68 85 109 123} $column];} } } enbridgeHeatingAllowance_2023_cmhc { #nv2.37.0 (ILM_S95) - rgi_look_up_table_ILM_S95_utilities - update 2023 ::set Vlist { {47 78 61} {59 116 92} {78 180 142} {91 223 177} {108 281 223} {66 141 111} {95 236 187} {104 266 211} {126 342 270} {135 372 294} {59 116 92} {78 180 142} {91 223 177} {108 281 223} {122 318 252} {78 0 0 } {112 307 243} {122 346 274} {149 444 351} {159 483 382} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2023_cmhc { ::set Vlist { {8 26 21} {12 39 32} {18 60 50} {23 74 62} {28 94 78} {14 45 38} {23 76 63} {26 86 71} {33 110 91} {36 119 99} {12 39 32} {18 60 50} {23 74 62} {28 94 78} {32 106 88} {16 54 45} {28 91 76} {31 103 85} {40 132 110} {43 143 119} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2023_cmhc { ::set Vlist { {55 78 56} {70 118 84} {95 181 129} {112 226 161} {135 284 202} {85 142 106} {117 239 179} {129 269 202} {158 345 259} {170 376 281} {70 118 84} {95 181 129} {112 226 161} {135 284 202} {152 321 229} {100 0 0} {138 310 232} {152 350 262} {187 449 336} {201 488 366} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2023_cmhc { ::set Vlist { {10 26 20} {15 39 29} {23 60 45} {29 75 56} {37 95 71} {18 46 34} {30 77 57} {33 86 65} {43 111 83} {47 121 90} {15 39 29} {23 60 45} {29 75 56} {37 95 71} {41 107 80} {21 55 41} {36 92 69} {40 104 78} {52 133 100} {56 145 108} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2023_cmhc { ::set Vlist { {47 78 52} {59 116 78} {77 180 121} {90 223 150} {107 281 190} {66 141 100} {94 236 167} {102 266 189} {124 342 242} {133 372 264} {59 116 78} {77 180 121} {90 223 150} {107 281 190} {121 318 214} {78 0 0} {110 307 218} {121 346 245} {146 444 315} {157 483 343} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2023_cmhc { ::set Vlist { {8 26 18} {11 39 27} {17 60 42} {22 74 53} {27 94 66} {13 45 32} {22 76 54} {25 86 61} {32 110 78} {35 119 85} {11 39 27} {17 60 42} {22 74 53} {27 94 66} {31 106 75} {16 54 38} {26 91 64} {30 103 73} {38 132 93} {42 143 102} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2023_cmhc { ::set Vlist { {55 76 61} {70 114 92} {95 176 142} {112 219 176} {135 276 222} {85 138 117} {117 232 196} {129 261 221} {158 335 284} {170 365 309} {70 114 92} {95 176 142} {112 219 176} {135 276 222} {152 312 251} {100 0 0 } {138 301 255} {152 340 287} {187 436 369} {201 475 401} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2023_cmhc { ::set Vlist { {10 25 21} {15 38 32} {23 59 50} {29 73 62} {37 92 78} {18 44 38} {30 74 63} {33 84 71} {43 108 91} {47 117 99} {15 38 32} {23 59 50} {29 73 62} {37 92 78} {41 104 88} {21 53 45} {36 89 76} {40 101 85} {52 129 109} {56 141 119} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2023_cmhc { ::set Vlist { {54 76 61} {68 114 92} {92 176 142} {108 219 176} {129 276 222} {83 138 117} {113 232 196} {124 261 221} {152 335 284} {163 365 309} {68 114 92} {92 176 142} {108 219 176} {129 276 222} {146 312 251} {98 0 0} {133 301 255} {146 340 287} {179 436 369} {192 475 401} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2023_cmhc { ::set Vlist { {10 25 21} {14 38 32} {22 59 50} {28 73 62} {35 92 78} {17 44 38} {28 74 63} {32 84 71} {41 108 91} {44 117 99} {14 38 32} {22 59 50} {28 73 62} {35 92 78} {39 104 88} {20 53 45} {34 89 76} {38 101 85} {49 129 109} {53 141 119} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2023_cmhc { ::set Vlist { {47 76 54} {59 114 82} {77 175 126} {90 218 156} {107 274 197} {66 137 99} {94 230 165} {102 260 187} {124 333 239} {133 362 261} {59 114 82} {77 175 126} {90 218 156} {107 274 197} {121 310 223} {78 0 0} {110 299 215} {121 338 243} {146 433 311} {157 471 339} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2023_cmhc { # was broken by invisible character - 3 man hours down the drain ::set Vlist { {8 25 19} {11 38 29} {17 58 44} {22 72 55} {27 91 69} {13 44 33} {22 74 56} {25 83 63} {32 107 81} {35 116 88} {11 38 29} {17 58 44} {22 72 55} {27 91 69} {31 103 78} {16 53 40} {26 89 67} {30 100 76} {38 128 97} {42 140 106} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2023_cmhc { ::set Vlist { {54 79 54} {68 118 81} {92 183 125} {108 227 155} {129 286 195} {83 143 103} {113 240 172} {124 271 194} {152 347 249} {163 378 271} {68 118 81} {92 183 125} {108 227 155} {129 286 195} {146 324 221} {98 0 0} {133 312 224} {146 352 253} {179 452 324} {192 492 353} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2023_cmhc { ::set Vlist { {10 26 19} {14 39 28} {22 61 44} {28 75 54} {35 95 68} {17 46 33} {28 77 55} {32 87 62} {41 112 80} {44 121 87} {14 39 28} {22 61 44} {28 75 54} {35 95 68} {39 108 77} {20 55 40} {34 93 66} {38 104 75} {49 134 96} {53 146 105} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2023_cmhc - kitchenerElectricityCharge_2023_cmhc - northEasternElectricityCharge_2023_cmhc - northWesternElectricityCharge_2023_cmhc - southernElectricityCharge_2023_cmhc - enbridgeElectricityCharge_2023_cmhc - westernElectricityCharge_2023_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 57 96 108 139 151} $column];} row_town {::return [::lindex {0 45 75 85 109 118} $column];} apartment {::return [::lindex {28 42 64 80 101 114} $column];} single_laundry {::return [::lindex {0 64 108 121 156 169} $column];} row_town_laundry {::return [::lindex {0 50 84 95 122 132} $column];} apartment_laundry {::return [::lindex {31 47 72 90 113 128} $column];} } } enbridgeHeatingAllowance_2024_cmhc { #nv2.38.2 (ILM_S95) - rgi_look_up_table_ILM_S95_utilities - update 2024 ::set Vlist { {47 71 72} {57 106 108} {73 159 162} {85 203 206} {98 248 251} {65 133 137} {92 227 236} {101 256 265} {120 322 334} {128 351 363} {57 106 108} {73 159 162} {85 203 206} {98 248 251} {114 287 292} {79 0 0} {113 300 306} {123 338 344} {146 425 434} {156 463 472} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 25 26} {11 38 39} {17 57 59} {21 73 75} {26 88 92} {12 40 41} {20 68 71} {23 77 79} {29 97 100} {31 105 109} {11 38 39} {17 57 59} {21 73 75} {26 88 92} {30 103 106} {13 42 43} {21 72 74} {24 81 83} {30 102 105} {33 111 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2024_cmhc { ::set Vlist { {50 71 66} {62 106 100} {79 159 149} {94 203 191} {109 247 232} {75 132 127} {102 227 218} {112 255 245} {135 322 308} {144 350 336} {62 106 100} {79 159 149} {94 203 191} {109 247 232} {127 287 269} {91 0 0} {125 300 283} {137 337 318} {164 425 401} {176 462 436} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 25 24} {12 38 36} {19 57 54} {24 73 70} {29 88 85} {13 40 38} {22 68 65} {25 77 73} {32 97 93} {35 105 101} {12 38 36} {19 57 54} { 24 73 70} { 29 88 85} { 34 102 98} {14 42 40} {24 72 69} {27 81 77} {34 102 97} {37 111 106} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2024_cmhc { ::set Vlist { {46 71 61} {56 106 91} {70 159 137} {83 203 175} {95 248 213} {63 133 116} {89 227 199} {97 256 224} {116 322 282} {124 351 307} {56 106 91} {70 159 137} {83 203 175} {95 248 813} {110 287 247} {77 0 0} {109 300 259} {119 338 291} {141 425 367} {151 463 399} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2024_cmhc { ::set Vlist { {7 25 22} {10 38 33} {15 57 50} {20 73 64} {24 88 77} {11 40 35} {19 68 60} {21 77 67} {26 97 85} {29 105 92} {10 38 33} {15 57 50} {20 73 64} {24 88 77} {28 103 90} {11 42 37} {20 72 63} {22 81 71} {28 102 89} {30 111 97} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2024_cmhc { ::set Vlist { {50 66 71} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {75 124 136} {102 213 234} {112 239 263} {135 301 331} {144 328 361} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {127 269 290} {91 0 0} {125 281 304} {137 316 342} {164 396 431} {176 433 469} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 24 26} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {13 37 41} {22 64 70} {25 72 79} {32 90 99} {35 98 108} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {34 96 106} {14 39 43} {24 68 74} {27 76 83} {34 96 104} {37 104 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2024_cmhc { ::set Vlist { {50 66 71} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {75 124 136} {102 213 234} {112 239 263} {135 301 331} {144 328 361} {62 99 107} {79 149 160} {94 190 205} {109 232 250} {127 269 290} {91 0 0} {125 281 304} {137 316 342} {164 398 431} {176 433 469} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 24 26} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {13 37 41} {22 64 70} {25 72 79} {32 90 99} {35 98 108} {12 35 39} {19 53 58} {24 68 75} {29 83 91} {34 96 106} {14 39 43} {24 68 74} {27 76 83} {34 96 104} {37 104 114} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2024_cmhc { ::set Vlist { {46 69 64} {56 104 96} {70 155 144} {83 198 185} {95 242 225} {63 129 123} {89 222 211} {97 250 243} {116 314 298} {124 342 325} {56 104 96} {70 155 144} {83 198 185} {95 242 225} {110 280 261} {77 0 0} {109 293 274} {119 329 308} {141 415 388} {151 451 422} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2024_cmhc { ::set Vlist { {7 25 23} {10 37 35} {15 55 53} {20 71 67} {24 86 82} {11 39 37} {19 67 63} {21 75 71} {26 94 90} {29 103 97} {10 37 35} {15 55 53} {20 71 67} {24 86 82} {28 100 95} {11 41 39} {20 71 66} {22 79 75} {28 100 94} {30 109 102} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2024_cmhc { ::set Vlist { {50 72 64} {62 108 96} {79 162 144} {94 207 184} {109 253 224} {75 135 122} {102 232 210} {112 261 236} {135 329 297} {144 358 323} {62 108 96} {79 162 144} {94 207 184} {109 253 224} {127 293 260} {91 0 0} {125 306 273} {137 344 307} {164 434 386} {176 472 420} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2024_cmhc { ::set Vlist { {8 26 23} {12 39 35} {19 58 52} {24 74 67} {29 90 82} {13 41 37} {22 70 63} {25 78 71} {32 99 89} {35 107 97} {12 39 35} {19 58 52} {24 74 67} {29 90 82} {34 105 95} {14 43 39} {24 74 66} {27 83 74} {34 104 94} {37 114 102} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2024_cmhc - kitchenerElectricityCharge_2024_cmhc - northEasternElectricityCharge_2024_cmhc - northWesternElectricityCharge_2024_cmhc - southernElectricityCharge_2024_cmhc - enbridgeElectricityCharge_2024_cmhc - westernElectricityCharge_2024_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 60 102 115 145 157} $column];} row_town {::return [::lindex {0 47 81 91 114 124} $column];} apartment {::return [::lindex {29 44 66 84 103 119} $column];} single_laundry {::return [::lindex {0 67 114 129 162 176} $column];} row_town_laundry {::return [::lindex {0 53 91 102 128 139} $column];} apartment_laundry {::return [::lindex {32 49 74 94 115 133} $column];} } } enbridgeHeatingAllowance_2025_cmhc { #nv2.38.5 (ILM_S95) - rgi_look_up_table_ILM_S95_utilities - update 2025 ::set Vlist { {47 59 72} {56 89 108} {70 133 161} {83 177 215} {92 207 251} {63 111 135} {87 190 231} {97 222 269} {111 269 327} {120 301 365} {56 89 108 } {70 133 161} {83 177 215} {92 207 251} {108 242 294} {79 0 0} {109 251 300} {121 293 350} {138 355 425} {150 397 475} } #::set LayoutList [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs]; #::set Row [::lsearch $LayoutList $row]; #::return [::lindex [::lindex $Vlist $Row] $column]; ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } enbridgeWaterHeatAllowance_2025_cmhc { ::set Vlist { {7 21 26} {10 35 38} {15 48 58} {20 63 77} {23 74 90} {10 33 40} {18 57 69} {21 67 81} {25 81 98} {28 90 110} {10 32 38} {15 48 58} {20 63 77} {23 74 90} {27 86 105} {11 35 42} {19 60 73} {22 71 85} {26 86 103} {29 96 115} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternHeatingAllowance_2025_cmhc { ::set Vlist { {53 68 66} {64 102 98} {80 153 148} {97 204 197} {108 238 229} {76 128 123} {102 219 211} {133 255 246} {131 310 299} {143 347 334} {64 102 98} {80 153 148} {97 204 197} {108 238 229} {126 279 269} {95 0 0} {127 289 274} {142 337 320} {164 409 388} {179 458 434} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 24 23} {12 36 35} {18 55 53} {24 73 70} {28 85 82} {12 38 37} {21 66 63} {25 77 74} {30 93 90} {34 104 100} {12 36 35} {18 55 53} {24 73 70} {28 85 82} {32 100 96} {13 41 39} {23 70 66} {26 81 77} {32 99 94} {36 110 105} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerHeatingAllowance_2025_cmhc { ::set Vlist { {46 59 60} {55 89 90} {67 133 135} {79 177 181} {87 207 211} {61 111 113} {82 190 194} {91 222 226} {104 269 274} {112 301 306} {55 89 90} {67 133 135} {79 177 181} {87 207 211} {101 242 247} {76 0 0} {103 251 252} {113 293 294} {129 355 356} {140 397 398} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } kitchenerWaterHeatAllowance_2025_cmhc { ::set Vlist { {6 21 22} {9 32 32} {13 48 48} {17 63 65} {20 74 75} {9 33 34} {16 57 58} {18 67 68} {22 81 82} {25 90 92} {9 32 32} {13 48 48} {17 63 65} {20 74 75} {24 86 88} {10 35 36} {16 60 61} {19 71 71} {23 86 86} {26 96 97} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternHeatingAllowance_2025_cmhc { ::set Vlist { {53 55 70} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {76 103 131} {102 176 224} {113 206 261} {131 250 317} {143 279 354} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {126 225 285} {95 0 0} {127 233 291} {142 272 339} {164 330 412} {179 369 461} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northEasternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 20 25} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {12 31 369} {21 53 67} {25 62 78} {30 75 95} {34 84 106} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {32 80 102} {13 33 41} {23 56 71} {26 65 82} {32 79 100} {36 89 112} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternHeatingAllowance_2025_cmhc { ::set Vlist { {53 55 70} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {76 103 131} {102 176 224} {113 206 261} {131 250 317} {143 279 354} {64 82 104} {80 123 157} {97 165 209} {108 192 244} {126 225 285} {95 0 0} {127 233 291} {142 272 339} {164 330 412} {179 369 461} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } northWesternWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 20 25} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {12 31 39} {21 53 67} {25 62 78} {30 75 95} {34 84 106} {12 29 37} {18 44 56} {24 59 75} {28 69 87} {32 80 102} {13 33 51} {23 56 74} {26 65 82} {32 79 100} {36 89 112} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernHeatingAllowance_2025_cmhc { ::set Vlist { {46 56 64} {55 84 97} {67 125 145} {79 167 193} {87 195 225} {61 105 121} {82 179 207} {91 209 241} {104 254 293} {112 284 328} {55 84 97} {67 125 145} {79 167 193} {87 195 225} {101 228 264} {76 0 0} {103 236 269} {113 276 314} {129 335 381} {140 374 426} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } southernWaterHeatAllowance_2025_cmhc { ::set Vlist { {6 20 23} {9 30 34} {13 45 52} {17 60 69} {20 70 80} {9 31 36} {16 54 62} {18 63 72} {22 76 88} {25 85 98} {9 30 34} {13 45 52} {17 60 69} {20 70 80} {24 82 94} {10 33 38} {16 57 65} {19 66 76} {23 81 92} {26 90 103} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernHeatingAllowance_2025_cmhc { ::set Vlist { {53 63 63} {64 95 94} {80 143 141} {97 190 188} {108 222 220} {76 119 118} {102 204 202} {113 238 235} {131 289 286} {143 323 319} {64 95 94} {80 143 141} {97 190 188} {108 222 220} {126 260 257} {95 0 0} {127 269 262} {142 314 306} {164 381 372} {179 426 415} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } westernWaterHeatAllowance_2025_cmhc { ::set Vlist { {8 23 22} {12 34 34} {18 51 50} {24 68 67} {28 79 78} {12 36 35} {21 61 61} {25 71 71} {30 87 86} {34 97 96} {12 35 35} {18 51 50} {24 68 67} {28 79 78} {32 93 92} {13 38 37} {23 65 64} {26 76 74} {32 92 90} {36 103 101} } ::return [::lindex [::lindex $Vlist [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]] $column]; } easternElectricityCharge_2025_cmhc - kitchenerElectricityCharge_2025_cmhc - northEasternElectricityCharge_2025_cmhc - northWesternElectricityCharge_2025_cmhc - southernElectricityCharge_2025_cmhc - enbridgeElectricityCharge_2025_cmhc - westernElectricityCharge_2025_cmhc { # the $row is a "fold-down" of 22 unit types/layouts and $column is a measure of bedrooms #// NOTICE - the *_laundry cases are the sum of Hydro plus Clothes Drying Power #// (i.e. the first 3 switch cases are hydro only, and the last 3 are hydro plus dryer charge) ::switch -- $row { single {::return [::lindex {0 57 98 114 138 155} $column];} row_town {::return [::lindex {0 46 78 91 111 124} $column];} apartment {::return [::lindex {28 43 64 85 99 116} $column];} single_laundry {::return [::lindex {0 64 110 128 155 174} $column];} row_town_laundry {::return [::lindex {0 52 87 102 124 139} $column];} apartment_laundry {::return [::lindex {31 48 72 95 111 130} $column];} } } } } ;#//::proc rgi_look_up_table_ILM_S95_utilities #nv2.34.11 (update) - ILM zones change ::proc cmhc_unit_layout_row {Row} { # NOT CALLED #// convert a name to a row number ::return [::lsearch [::QW::NEWVIEWS::cmhc_unit_layout_list $_rgi_sargs] $row]; } #nv2.35.5 () - ::QW::NEWVIEWS::cmhc_unit_layout_list {sargs} ::proc cmhc_unit_layout_list {sargs} { #//::puts "pgq,debug...cmhc_unit_layout_list enter sargs==(\n[::sargs::format .structure [::sargs::unset $sargs .calc]]\n)"; #::qw::stack_dump; ;#//pgq,debug ::set LayoutList { {Apartment, Bachelor} {Apartment, 1 bedroom} {Apartment, 2 bedrooms} {Apartment, 3 bedrooms} {Apartment, 4 bedrooms} {Row House, 1 bedroom} {Row House, 2 bedrooms} {Row House, 3 bedrooms} {Row House, 4 bedrooms} {Row House, 5 bedrooms} {Stacked, 1 bedroom} {Stacked, 2 bedrooms} {Stacked, 3 bedrooms} {Stacked, 4 bedrooms} {Stacked, 5 bedrooms} {S.F. Detached (with basement), 1 bed} {S.F. Detached (with basement), 2 beds} {S.F. Detached (with basement), 3 beds} {S.F. Detached (with basement), 4 beds} {S.F. Detached (with basement), 5 beds} } ::if {[::sargs::get $sargs .effective_date] ne ""&&[::qw::date::difference [::sargs::get $sargs .effective_date] "20220101" "day"]<0} { ::lappend LayoutList {S.F. Detached (with basement), 6 beds}; } #::return [::string tolower $LayoutList]; ::return $LayoutList; } #nv2.35.5 () - FCHI_2022_utilities_tables - ::QW::NEWVIEWS::fchi2_energy_source_list {sargs} ::proc fchi2_energy_source_list {sargs} { #::set Province [::QW::NEWVIEWS::rgi_calc_province [::sargs .odb.database [$Src odb_database] .odb.object $Src]]; ::set EnergyList [::list]; ::switch -glob -- [::string tolower [::sargs::get $sargs .province]] { a* - m* - nb - "new b*" - s* { # 4 provinces share empty default } b* - o* { ::set EnergyList "gas electricity"; } pr* - pe* { ::set EnergyList "oil electricity"; } pq - q* { ::set EnergyList "gas oil electricity"; } } #//::foreach Guy $EnergyList {::puts "pgq,debug...fchi2_energy_source_list ::foreach Guy==$Guy";} ::return $EnergyList; } #nv2.35.5 () - FCHI_2022_utilities_tables - ::QW::NEWVIEWS::fchi2_unit_layout_list {sargs} ::proc fchi2_unit_layout_list {sargs} { ::set LayoutList { {Apartment, Bachelor} {Apartment, 1 bedroom} {Apartment, 2 bedrooms} {Apartment, 3 bedrooms} {Apartment, 4+ bedrooms} {Other, Bachelor} {Other, 1 bedroom} {Other, 2 bedrooms} {Other, 3 bedrooms} {Other, 4+ bedrooms} } #::set LayoutList [::string tolower $LayoutList]; ::switch -glob -- [::string tolower [::sargs::get $sargs .province]] { a* - m* - nb* - "new b*" - s* - pq - q* { # 5 provinces share default } b* - o* - pr* - pe* { ::set LayoutList [::string map [::list + {}] $LayoutList]; ::set LayoutList [::linsert $LayoutList 5 {Apartment, 5+ bedrooms}]; ::set LayoutList [::linsert $LayoutList end {Other, 5+ bedrooms}]; } } ::switch -glob -- [::string tolower [::sargs::get $sargs .province]] { pr* - pe* { #nv2.38.2 (FCHI2) - fchi2_unit_layout_list - added {SDH, Bachelor} ::set LayoutList [::concat $LayoutList { {SDH, Bachelor} {SDH, 1 bedroom} {SDH, 2 bedrooms} {SDH, 3 bedrooms} {SDH, 4 bedrooms} {SDH, 5+ bedrooms} }]; } } #//::set Count 0;::foreach Guy $LayoutList {#//::puts "pgq,debug...fchi2_unit_layout_list ::foreach ([::incr Count]) Guy==$Guy";} ::return $LayoutList; } ::proc fchi2_service_allowance_lookup {_rgi_sargs} { #//::puts "pgq,debugWTF2...::QW::NEWVIEWS::fchi2_service_allowance_lookup enter _rgi_sargs==(\n[::sargs::format .structure $_rgi_sargs]\n)" ::set Sadjust 0.0; #::set Province [::QW::NEWVIEWS::rgi_calc_province [::sargs .odb.database [[odb_master] odb_database] .odb.object [odb_master]]]; ;#// before we moved from newviews/definition #::set Province [::string tolower [::sargs::get $_rgi_sargs .province]] ::set Province [::QW::NEWVIEWS::rgi_calc_province $_rgi_sargs]; #//--------------------------------------------------------------------- #nv2.38.5 (FCHI2) - fchi2_service_allowance_lookup - update 2025 ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20250101" "day"]>=0 \ } { ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.water_and_sewer]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+65.00}];} PE {::set Sadjust [::expr {$Sadjust+33.00}];} BC - ON - SK - YT {::set Sadjust [::expr {$Sadjust+75.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.garbage]} { ::switch -exact -- $Province { BC {::set Sadjust [::expr {$Sadjust+12.00}];} ON {::set Sadjust [::expr {$Sadjust+15.00}];} PE {::set Sadjust [::expr {$Sadjust+17.00}];} AB - SK - YT {::set Sadjust [::expr {$Sadjust+25.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.insurance]} { ::switch -exact -- $Province { AB - BC - ON - SK - YT {::set Sadjust [::expr {$Sadjust+30.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.telephone]} { ::switch -exact -- $Province { AB - BC - ON - SK - YT {::set Sadjust [::expr {$Sadjust+47.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.laundry]} { ::switch -exact -- $Province { ON - SK - YT { #//::puts "pgq,debugWTF2...::QW::NEWVIEWS::fchi2_service_allowance_lookup Sadjust==$Sadjust ::sargs::integer_get .utilities.service.laundry==[::sargs::integer_get $_rgi_sargs .utilities.service.laundry]"; ::set Sadjust [::expr {$Sadjust+35.00+([::sargs::integer_get $_rgi_sargs .utilities.service.laundry]-1)*11.00}]; } } } #nv2.35.0 (bug fix) - FCHI2 .shelter_income_adjusted #nv2.35.5 (bug fix) - shelter is adjusted down whether or not the tenant pays_electricity #::if {[::sargs::boolean_get $_rgi_sargs .utilities.electricity.pays_electricity]} {} #//::set Sadjust [::expr {$Sadjust+[::sargs::real_get $_rgi_sargs .calc.utilities.electricity]}]; ::set ElecCharge [rgi_look_up_table_fchi2 ElectricityCharge $_rgi_sargs]; ::set Sadjust [::expr {$Sadjust+$ElecCharge}]; #{} ::return $Sadjust; } #nv2.38.2 (FCHI2) - fchi2_service_allowance_lookup - update 2024 ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0 \ } { ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.water_and_sewer]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+62.00}];} BC {::set Sadjust [::expr {$Sadjust+72.00}];} ON {::set Sadjust [::expr {$Sadjust+69.00}];} PE {::set Sadjust [::expr {$Sadjust+33.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.garbage]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+24.00}];} BC {::set Sadjust [::expr {$Sadjust+12.00}];} ON {::set Sadjust [::expr {$Sadjust+14.00}];} PE {::set Sadjust [::expr {$Sadjust+17.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.insurance]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+30.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.telephone]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+45.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.laundry]} { ::switch -exact -- $Province { ON { #//::puts "pgq,debugWTF2...::QW::NEWVIEWS::fchi2_service_allowance_lookup Sadjust==$Sadjust ::sargs::integer_get .utilities.service.laundry==[::sargs::integer_get $_rgi_sargs .utilities.service.laundry]"; ::set Sadjust [::expr {$Sadjust+35.00+([::sargs::integer_get $_rgi_sargs .utilities.service.laundry]-1)*11.00}]; } } } #nv2.35.0 (bug fix) - FCHI2 .shelter_income_adjusted #nv2.35.5 (bug fix) - shelter is adjusted down whether or not the tenant pays_electricity #::if {[::sargs::boolean_get $_rgi_sargs .utilities.electricity.pays_electricity]} {} #//::set Sadjust [::expr {$Sadjust+[::sargs::real_get $_rgi_sargs .calc.utilities.electricity]}]; ::set ElecCharge [rgi_look_up_table_fchi2 ElectricityCharge $_rgi_sargs]; ::set Sadjust [::expr {$Sadjust+$ElecCharge}]; #{} ::return $Sadjust; } #//--------------------------------------------------------------------- #nv2.37.0 (FCHI2) - fchi2_service_allowance_lookup - update 2023 ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0 \ } { ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.water_and_sewer]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+58.00}];} BC {::set Sadjust [::expr {$Sadjust+67.00}];} ON {::set Sadjust [::expr {$Sadjust+65.00}];} PE {::set Sadjust [::expr {$Sadjust+33.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.garbage]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+22.00}];} BC {::set Sadjust [::expr {$Sadjust+11.00}];} ON {::set Sadjust [::expr {$Sadjust+13.00}];} PE {::set Sadjust [::expr {$Sadjust+17.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.insurance]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+30.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.telephone]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+42.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.laundry]} { ::switch -exact -- $Province { ON { #//::puts "pgq,debugWTF2...::QW::NEWVIEWS::fchi2_service_allowance_lookup Sadjust==$Sadjust ::sargs::integer_get .utilities.service.laundry==[::sargs::integer_get $_rgi_sargs .utilities.service.laundry]"; ::set Sadjust [::expr {$Sadjust+19.00+([::sargs::integer_get $_rgi_sargs .utilities.service.laundry]-1)*6.00}]; } } } #nv2.35.0 (bug fix) - FCHI2 .shelter_income_adjusted #nv2.35.5 (bug fix) - shelter is adjusted down whether or not the tenant pays_electricity #::if {[::sargs::boolean_get $_rgi_sargs .utilities.electricity.pays_electricity]} {} #//::set Sadjust [::expr {$Sadjust+[::sargs::real_get $_rgi_sargs .calc.utilities.electricity]}]; ::set ElecCharge [rgi_look_up_table_fchi2 ElectricityCharge $_rgi_sargs]; ::set Sadjust [::expr {$Sadjust+$ElecCharge}]; #{} ::return $Sadjust; } #//--------------------------------------------------------------------- #nv2.35.5 (effective_date) - everywhere empty should mean "freshest" calc and table lookups - ^QR^QF [::sargs::get $_rgi_sargs .effective_date] eq "" ::if {[::sargs::get $_rgi_sargs .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0 \ } { ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.water_and_sewer]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+40.72}];} BC {::set Sadjust [::expr {$Sadjust+64.00}];} ON {::set Sadjust [::expr {$Sadjust+63.85}];} PE {::set Sadjust [::expr {$Sadjust+33.60}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.garbage]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+21.08}];} BC {::set Sadjust [::expr {$Sadjust+10.08}];} ON {::set Sadjust [::expr {$Sadjust+12.70}];} PE {::set Sadjust [::expr {$Sadjust+17.32}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.insurance]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+31.50}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.telephone]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+37.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.laundry]} { ::switch -exact -- $Province { ON { #//::puts "pgq,debugWTF2...::QW::NEWVIEWS::fchi2_service_allowance_lookup Sadjust==$Sadjust ::sargs::integer_get .utilities.service.laundry==[::sargs::integer_get $_rgi_sargs .utilities.service.laundry]"; ::set Sadjust [::expr {$Sadjust+18.00+([::sargs::integer_get $_rgi_sargs .utilities.service.laundry]-1)*6.00}]; } } } #nv2.35.0 (bug fix) - FCHI2 .shelter_income_adjusted #nv2.35.5 (bug fix) - shelter is adjusted down whether or not the tenant pays_electricity #::if {[::sargs::boolean_get $_rgi_sargs .utilities.electricity.pays_electricity]} {} #//::set Sadjust [::expr {$Sadjust+[::sargs::real_get $_rgi_sargs .calc.utilities.electricity]}]; ::set ElecCharge [rgi_look_up_table_fchi2 ElectricityCharge $_rgi_sargs]; ::set Sadjust [::expr {$Sadjust+$ElecCharge}]; #{} ::return $Sadjust; } #//--------------------------------------------------------------------- ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20211001" "day"]>=0} { #//::puts "pgq,debug23411.../ACCOUNT/AR.rgi_calc_list add_income_to_units odb_master==[[odb_master] odb_path]"; ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.water_and_sewer]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+55.46}];} BC {::set Sadjust [::expr {$Sadjust+61.73}];} ON {::set Sadjust [::expr {$Sadjust+62.23}];} PE {::set Sadjust [::expr {$Sadjust+32.59}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.garbage]} { ::switch -exact -- $Province { AB {::set Sadjust [::expr {$Sadjust+21.08}];} BC {::set Sadjust [::expr {$Sadjust+10.08}];} ON {::set Sadjust [::expr {$Sadjust+12.70}];} PE {::set Sadjust [::expr {$Sadjust+17.32}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.insurance]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+30.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.telephone]} { ::switch -exact -- $Province { AB - BC - ON {::set Sadjust [::expr {$Sadjust+37.00}];} } } ::if {[::sargs::boolean_get $_rgi_sargs .utilities.service.laundry]} { ::switch -exact -- $Province { ON { ::set Sadjust [::expr {$Sadjust+18.00+([::sargs::integer_get $_rgi_sargs .utilities.service.laundry]-1)*6.00}]; } } } #nv2.35.0 (bug fix) - FCHI2 .shelter_income_adjusted ::if {[::sargs::boolean_get $_rgi_sargs .utilities.electricity.pays_electricity]} { #::set Sadjust [::expr {$Sadjust+[::sargs::real_get $_rgi_sargs .calc.utilities.electricity]}]; ::set ElecCharge [rgi_look_up_table_fchi2 ElectricityCharge $_rgi_sargs]; ::set Sadjust [::expr {$Sadjust+$ElecCharge}]; } } #//--------------------------------------------------------------------- ::return $Sadjust; } ::proc XXX_rgi_look_up_table_fchi2_XXX {Table _rgi_sargs} { #//::puts "pgq,debug_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 enter Table==$Table - moved from /ACCOUNT/AR.rgi_calc_list"; #// #// There are two styles of lookup: #// 1 - just a simple list that depends only on the number of bedrooms #// 2 - a list of doublets or triplets that are indexed by energy source #// #nv2.34.5 (FCHI2) - utility tables for heat (gas and electricity), electricity and hot water (gas and electricity) #nv2.34.7 (code rewrite) - ::QW::NEWVIEWS::rgi_look_up_table_fchi2 - .effective_date respecting - updated for 2021 #nv2.34.11 (FCHI2-20211001) - ::QW::NEWVIEWS::rgi_look_up_table_fchi2 - added 6 other participating provinces #//::puts "pgq,debug...rgi_look_up_table_fchi2 Table==$Table _rgi_sargs==(\n[::sargs::format .structure $_rgi_sargs]\n)"; #::QW::NEWVIEWS::rgi_calc_item_dump [::sargs .rgi_calc_item $_rgi_sargs]; ;#//pgq,debug ::set Layout [::string tolower [::sargs::get $_rgi_sargs .utilities.heat.unit_layout]]; #_pgq,debug_kirk ::if {$Layout eq ""} { ::return 0; } ::set Province [::sargs::get $_rgi_sargs .province]; #::set Table "fchi2_${Province}_$Table"; #//::puts "pgq,debug...rgi_look_up_table_fchi2 Table==$Table Layout==$Layout ::string tolower Province==[::string tolower $Province]"; #nv2.35.5 (rgi_all_provinces) #::set LayoutList [fchi2_unit_layout_list $_rgi_sargs]; ::set LayoutList [::string tolower [fchi2_unit_layout_list $_rgi_sargs]]; ::set FreshDate 0; #nv2.37.0 (FCHI2) - rgi_look_up_table_fchi2 - update utilities 2023 #::if {[::sargs::get $_rgi_sargs .effective_date] eq ""||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { # ::set FreshDate 1; #} #nv2.38.2 (FCHI2) - rgi_look_up_table_fchi2 - update utilities 2024 ::if {[::sargs::get $_rgi_sargs .effective_date] eq ""||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { ::set FreshDate 1; } #//::puts "pgq,debug...rgi_look_up_table_fchi2 FreshDate==$FreshDate"; # NOTICE, and good luck /* { These tables are a bitch to update - printed .pdf is re-keyed - with the numbers organized as lists and lists of lists - for ::lindex retrieval below Evalues - Electricity - simple row major enumeration of the matrix - 2 or 3 rows for type of unit (apartment, other) - 5 or 6 columns for number of bedrooms Wvalues - Hot Water - tricky enumeration from 1, 2 or 3 matrices (one matrix for each energy source) - each matrix has a row for unit type and a column for the number of bedrooms - when there's 1 matrix (energy source doesn't matter), do the same as Electricity - when there's 2 or 3 matrices, create a list lists - top level is a block of elements for each unit type, with each element in the block being the number of bedrooms - inner list is an element for each energy sorce Hvalues - Heat - same as Hot Water */} ::while {1} { ::switch -glob -- [::string tolower $Province] { o* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list gas electricity]; ::if {$FreshDate} { #2024 numbers go here... #jrp Apartment---------- Other------------- ::set Evalues {28 42 64 80 101 101 0 45 75 85 109 118}; # {ApartmentBachelorGas ApartmentBachelorElectricity} # {Apartment1bedGas Apartment1bedElectricity} #... # {Apartment5bedGas Apartment5bedElectricity} # {OtherBachelorGas OtherBachelorElectricity} # {Other1bedGas Other1bedElectricity} #... # {Other5bedGas Other5bedElectricity} # i.e. 6 pairs for Apartment, 6 pairs for Other ::set Wvalues { {9 20} {13 30} {21 46} {26 58} {32 73} {32 73} {0 0} {16 35} {26 59} {29 66} {38 85} {41 93} } ::set Hvalues { {51 57} {65 86} {87 132} {102 164} {121 207} {121 207} {0 0} {76 107} {106 180} {116 203} {142 261} {152 284} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { #jrp Apartment---------- Other------------- ::set Evalues {28 42 64 80 101 101 0 45 75 85 109 118}; # {ApartmentBachelorGas ApartmentBachelorElectricity} # {Apartment1bedGas Apartment1bedElectricity} #... # {Apartment5bedGas Apartment5bedElectricity} # {OtherBachelorGas OtherBachelorElectricity} # {Other1bedGas Other1bedElectricity} #... # {Other5bedGas Other5bedElectricity} # i.e. 6 pairs for Apartment, 6 pairs for Other ::set Wvalues { {9 20} {13 30} {21 46} {26 58} {32 73} {32 73} {0 0} {16 35} {26 59} {29 66} {38 85} {41 93} } ::set Hvalues { {51 57} {65 86} {87 132} {102 164} {121 207} {121 207} {0 0} {76 107} {106 180} {116 203} {142 261} {152 284} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {26 39 61 76 97 97 0 41 72 80 104 115}; ::set Wvalues { {6 17} {9 29} {14 46} {18 56} {23 72} {23 72} {0 0} {10 33} {18 58} {19 65} {25 85} {28 93} } ::set Hvalues { {40 46} {48 74} {61 115} {69 143} {82 182} {82 182} {0 0} {54 92} {73 161} {78 178} {94 233} {101 257} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20210101" "day"]>=0} { ::set Evalues {28 39 61 70 91 0 41 69 79 105}; ::set Wvalues { {8 17} {12 26} {14 46} {17 52} {21 69} {0 0} {12 30} {16 53} {19 60} {25 81} } ::set Hvalues { {38 48} {44 73} {61 128} {66 145} {78 194} {0 0} {47 85} {66 148} {71 169} {87 225} } ::break; } ::set Evalues {28 40 65 77 97 33 47 77 91 114}; ::set Wvalues { {6 19} {9 28} {15 46} {17 54} {22 68} {8 24} {11 34} {18 56} {21 65} {27 82} } ::set Hvalues { {41 54} {48 77} {63 126} {70 148} {82 187} {43 63} {54 90} {70 146} {78 172} {92 217} } ::break; } a* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2024 numbers go here... ::set Evalues {80 90 99 108 118 0 162 183 200 216}; ::set Wvalues {16 19 22 25 29 0 27 32 36 40}; ::set Hvalues {64 77 89 102 115 0 110 126 143 161}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {80 90 99 108 118 0 162 183 200 216}; ::set Wvalues {16 19 22 25 29 0 27 32 36 40}; ::set Hvalues {64 77 89 102 115 0 110 126 143 161}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {51.83 58.03 64.24 70.63 77.25 0 105.59 119.25 130.48 140.79}; ::set Wvalues {10.32 12.33 14.32 16.29 18.29 0 17.83 21.61 23.24 25.98} ::set Hvalues {41.23 48.82 57.00 65.21 72.83 0 70.26 80.99 91.88 103.60} ::break; } ::set Evalues {44 49 54 59 64 0 92 101 110 119}; ::set Wvalues {8 10 12 13 15 0 14 17 19 21} ::set Hvalues {33 40 46 53 59 0 58 66 75 83} ::break; } m* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2024 numbers go here... ::set Evalues {25 30 34 40 45 0 55 64 73 82}; ::set Wvalues {9 11 14 16 18 0 16 20 23 27}; ::set Hvalues {36 45 55 64 73 0 66 79 91 107}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {25 30 34 40 45 0 55 64 73 82}; ::set Wvalues {9 11 14 16 18 0 16 20 23 27}; ::set Hvalues {36 45 55 64 73 0 66 79 91 107}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {24 29 33 39 44 0 53 62 71 80}; ::set Wvalues {7.4 9.3 10.8 13.2 15.1 0 13.6 16.2 18.9 21.6} ::set Hvalues {29.6 37.4 45.1 52.9 60.6 0 54.2 64.9 75.5 86.1} ::break; } ::set Evalues {23 28 33 38 43 0 51 60 69 78}; ::set Wvalues {6 8 9 11 13 0 11 13 16 18} ::set Hvalues {25 31 37 44 50 0 45 54 62 71} ::break; } nb - "new b*" { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2024 numbers go here... ::set Evalues {15 20 26 28 28 0 23 29 30 32}; ::set Wvalues {11 14 18 20 20 0 17 21 22 23}; ::set Hvalues {56 71 94 100 102 0 85 105 109 116}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {15 20 26 28 28 0 23 29 30 32}; ::set Wvalues {11 14 18 20 20 0 17 21 22 23}; ::set Hvalues {56 71 94 100 102 0 85 105 109 116}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {15.25 19.46 25.47 27.27 27.87 0 23.06 28.47 29.68 31.48}; ::set Wvalues {10.93 13.94 18.25 19.54 19.97 0 16.53 20.40 21.26 22.56} ::set Hvalues {55.36 70.64 92.47 99.02 101.20 0 83.74 103.39 107.75 114.30} ::break; } ::set Evalues {0 0 0 0 0 0 0 0 0 0}; ::set Wvalues {0 0 0 0 0 0 0 0 0 0} ::set Hvalues {0 0 0 0 0 0 0 0 0 0} ::break; } s* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { ::set Evalues {47 52 57 61 66 0 97 106 114 120}; ::set Wvalues {12 14 16 18 20 0 20 23 25 28}; ::set Hvalues {47 55 63 72 80 0 79 90 102 113}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {45 49 54 58 63 0 92 100 108 114}; ::set Wvalues {9.0 10.6 12.2 13.8 15.4 0 15.2 17.4 19.6 21.8} ::set Hvalues {36.0 42.4 48.8 55.2 61.6 0 60.8 69.6 78.4 87.2} ::break; } ::set Evalues {49 54 59 64 69 0 101 110 119 128}; ::set Wvalues {9 11 12 14 15 0 15 17 20 22} ::set Hvalues {36 42 49 55 62 0 61 70 78 87} ::break; } b* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list gas electricity]; ::if {$FreshDate} { ::set Evalues {31 34 58 59 71 71 0 52 89 91 110 110}; ::set Wvalues { {14 12} {15 18} {16 27} {17 36} {18 54} {18 54} {0 0} {16 18} {19 27} {20 36} {29 54} {30 56} } ::set Hvalues { {44 36} {53 43} {79 70} {86 83} {102 92} {102 92} {0 0} {64 58} {95 96} {97 111} {117 124} {122 129} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {25 28 47 48 58 58 0 46 78 80 96 96}; ::set Wvalues { {13 12} {13 18} {15 27} {15 36} {17 54} {17 54} {0 0} {15 18} {17 27} {18.16 36} {26.53 54} {27.59 56} } ::set Hvalues { {40 36} {49 42} {72 70} {79 82} {93 91} {93 91} {0 0} {57.92 49} {86.24 81} {88.23 94} {106.43 105} {110.68 110} } ::break; } ::set Evalues {25 28 47 48 58 0 46 78 79 96}; ::set Wvalues { {9 12} {10 18} {11 26} {12 36} {14 54} {0 0} {10 18} {14 26} {18 36} {25 54} } ::set Hvalues { {37 35} {45 42} {66 69} {72 81} {85 91} {0 0} {55 49} {79 81} {80 93} {97 105} } ::break; } pr* - pe* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list oil electricity]; ::if {$FreshDate} { #jrp Apartment------- Other----------- SDH------------- ::set Evalues {9 12 16 17 18 18 0 14 18 19 20 24 0 15 21 22 23 26}; #jrp SDH - Social Development Housing? ::set Wvalues { {23 19} {29 25} {39 33} {42 35} {43 36} {43 36} {0 0} {35 30} {44 37} {46 38} {49 41} {58 49} {0 0} {37 31} {50 42} {54 46} {56 47} {64 54} } ::set Hvalues { {89 75} {116 97} {154 129} {165 139} {169 142} {169 142} {0 0} {138 116} {173 145} {180 152} {192 161} {229 193} {0 0} {147 124} {199 168} {214 180} {220 185} {251 211} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { #jrp Apartment------------------------ Other-------------------------- SDH---------------------------- ::set Evalues {6.98 9.05 12.01 12.90 13.20 13.20 0 10.83 13.49 14.08 14.97 17.93 0 11.54 15.56 16.75 17.16 19.59}; #jrp oil electr #jrp apartment #jrp other #jrp SDH - Social Development Housing? ::set Wvalues { {13.46 19.83} {19.01 25.72} {26.93 34.12} {29.30 36.65} {30.09 37.49} {30.09 37.49} {0 0} {23.76 30.76} {30.89 38.33} {32.47 40.01} {34.85 42.53} {42.76 50.94} {0 0} {25.66 32.78} {36.43 44.21} {39.60 47.58} {40.71 48.75} {47.20 55.65} } #jrp oil electr #jrp apartment #jrp other #jrp SDH ::set Hvalues { {50.49 74.37} {71.27 96.43} {100.97 127.96} {109.88 137.42} {112.85 140.57} {112.85 140.57} {0 0} {89.09 115.35} {115.82 143.73} {121.76 150.03} {130.67 159.49} {160.37 191.02} {0 0} {96.22 122.92} {136.61 165.80} {148.49 178.41} {152.65 182.82} {177.00 208.67} } ::break; } ::set Evalues {7 9 12 13 13 0 11 13 14 15}; ::set Wvalues { {13 19} {17 25} {23 33} {24 36} {25 37} {0 0} {20 30} {25 37} {27 39} {28 42} } ::set Hvalues { {50 73} {64 94} {85 125} {91 134} {93 137} {0 0} {77 113} {96 141} {100 147} {106 156} } ::break; } pq - q* { ::set Table "fchi2_ON_$Table"; ::if {$FreshDate} { ::set Sources [::list gas oil electricity]; ::set Evalues {15 18 22 27 30 0 29 33 39 46}; #jrp gas oil electr ::set Wvalues { {11 15 12} {12 18 14} {15 22 17} {18 27 21} {20 29 23} {0 0 0} {19 28 22} {22 32 25} {26 38 30} {31 45 35} } ::set Hvalues { {27 40 31} {32 47 37} {41 60 47} {50 73 57} {54 79 62} {0 0 0} {53 77 60} {60 88 69} {72 105 82} {83 121 95} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Sources [::list gas oil electricity]; ::set Evalues {15 17 22 27 29 0 28 32 38 45}; #jrp gas oil electr ::set Wvalues { {9.63 13.48 11} {12.25 17.15 14} {14.88 20.83 17} {17.50 24.50 20} {19.25 26.95 22} {0 0 0} {19.25 26.95 22} {21.88 30.63 25} {25.38 35.53 29} {29.75 41.65 34} } ::set Hvalues { {27.13 37.98 31} {31.50 44.10 36} {39.38 55.13 45} {48.13 67.38 55} {53.38 74.73 61} {0 0 0} {51.63 72.28 59} {58.63 82.08 67} {69.13 96.78 79} {81.38 113.93 93} } ::break; } ::set Sources [::list gas electricity]; ::set Evalues {12 14 17 21 23 0 22 26 30 36}; ::set Wvalues { {7 8} {9 10} {11 13} {13 15} {15 17} {0 0} {14 16} {16 18} {19 22} {23 26} } ::set Hvalues { {32 36} {37 42} {46 53} {56 64} {61 70} {0 0} {60 69} {68 78} {81 93} {96 110} } ::break; } default { ::break; } } } #//::puts "pgq,debug...::QW::NEWVIEWS::rgi_look_up_table_fchi2 ::switch Table==$Table"; ::switch -- $Table { fchi2_ElectricityCharge { #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ Evalues==$Evalues"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ LayoutList==$LayoutList"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ Layout==$Layout"; ::return [::lindex $Evalues [::lsearch $LayoutList $Layout]]; } fchi2_WaterHeatAllowance {::return [::lindex $Wvalues [::lsearch $LayoutList $Layout]];} fchi2_HeatingAllowance {::return [::lindex $Hvalues [::lsearch $LayoutList $Layout]];} fchi2_ON_ElectricityCharge { #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON Evalues==$Evalues"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON LayoutList==$LayoutList"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON Layout==$Layout"; ::set Value [::lindex $Evalues [::lsearch $LayoutList $Layout]]; ::return $Value; } fchi2_ON_WaterHeatAllowance { #::set Sources [::list gas electricity]; ;#// do this above by province so we do doublets or triplets ::set Source [::sargs::get $_rgi_sargs .utilities.water.operates_water_heater]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance Source==$Source"; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance Layout==$Layout"; #//::foreach Guy $LayoutList {#//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance LayoutList Guy==$Guy";} #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance ::lsearch LayoutList $Layout==[::lsearch $LayoutList $Layout]"; ::set LayoutValues [::lindex $Wvalues [::lsearch $LayoutList $Layout]]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance LayoutValues==$LayoutValues"; ::set Value [::lindex $LayoutValues [::lsearch $Sources $Source]]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance ::lsearch Sources Source==[::lsearch $Sources $Source] Value==$Value"; ::return $Value; } fchi2_ON_HeatingAllowance { #::set Sources [::list gas electricity]; ::set Source [::sargs::get $_rgi_sargs .utilities.heat.operate_heat]; ::set LayoutValues [::lindex $Hvalues [::lsearch $LayoutList $Layout]]; ::set Value [::lindex $LayoutValues [::lsearch $Sources $Source]]; ::return $Value; } default { ::qw::throw [::sargs \ .text "rgi_look_up_table_fchi2 did not recongnize case $Table"; .help_id 0 \ ]; } } #//::puts "pgq,debug_FCHI2...rgi_look_up_table_fchi2 MISSED all cases!"; } ::proc rgi_look_up_table_fchi2 {Table _rgi_sargs} { #//::puts "pgq,debug_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 enter Table==$Table - moved from /ACCOUNT/AR.rgi_calc_list"; #// #// There are two styles of lookup: #// 1 - just a simple list that depends only on the number of bedrooms #// 2 - a list of doublets or triplets that are indexed by energy source #// #nv2.34.5 (FCHI2) - utility tables for heat (gas and electricity), electricity and hot water (gas and electricity) #nv2.34.7 (code rewrite) - ::QW::NEWVIEWS::rgi_look_up_table_fchi2 - .effective_date respecting - updated for 2021 #nv2.34.11 (FCHI2-20211001) - ::QW::NEWVIEWS::rgi_look_up_table_fchi2 - added 6 other participating provinces #//::puts "pgq,debug...rgi_look_up_table_fchi2 Table==$Table _rgi_sargs==(\n[::sargs::format .structure $_rgi_sargs]\n)"; #::QW::NEWVIEWS::rgi_calc_item_dump [::sargs .rgi_calc_item $_rgi_sargs]; ;#//pgq,debug ::set Layout [::string tolower [::sargs::get $_rgi_sargs .utilities.heat.unit_layout]]; #_pgq,debug_kirk ::if {$Layout eq ""} { ::return 0; } ::set Province [::sargs::get $_rgi_sargs .province]; #::set Table "fchi2_${Province}_$Table"; #//::puts "pgq,debug...rgi_look_up_table_fchi2 Table==$Table Layout==$Layout ::string tolower Province==[::string tolower $Province]"; #nv2.35.5 (rgi_all_provinces) #::set LayoutList [fchi2_unit_layout_list $_rgi_sargs]; ::set LayoutList [::string tolower [fchi2_unit_layout_list $_rgi_sargs]]; ::set FreshDate 0; #nv2.37.0 (FCHI2) - rgi_look_up_table_fchi2 - update utilities 2023 #::if {[::sargs::get $_rgi_sargs .effective_date] eq ""||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { # ::set FreshDate 1; #} #nv2.38.2 (FCHI2) - rgi_look_up_table_fchi2 - update utilities 2024 #::if {[::sargs::get $_rgi_sargs .effective_date] eq ""||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { # ::set FreshDate 1; #} #nv2.38.5 (FCHI2) - rgi_look_up_table_fchi2 - update utilities 2025 ::if {[::sargs::get $_rgi_sargs .effective_date] eq ""||[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20250101" "day"]>=0} { ::set FreshDate 1; } #//::puts "pgq,debug...rgi_look_up_table_fchi2 FreshDate==$FreshDate"; # NOTICE, and good luck /* { These tables are a bitch to update - printed .pdf is re-keyed - with the numbers organized as lists and lists of lists - for ::lindex retrieval below Evalues - Electricity - simple row major enumeration of the matrix - 2 or 3 rows for type of unit (apartment, other) - 5 or 6 columns for number of bedrooms Wvalues - Hot Water - tricky enumeration from 1, 2 or 3 matrices (one matrix for each energy source) - each matrix has a row for unit type and a column for the number of bedrooms - when there's 1 matrix (energy source doesn't matter), do the same as Electricity - when there's 2 or 3 matrices, create a list lists - top level is a block of elements for each unit type, with each element in the block being the number of bedrooms - inner list is an element for each energy sorce Hvalues - Heat - same as Hot Water */} ::while {1} { ::switch -glob -- [::string tolower $Province] { o* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list gas electricity]; ::if {$FreshDate} { #2025 numbers go here... #jrp Apartment---------- Other------------- ::set Evalues {29 44 66 85 103 103 0 47 81 91 114 124}; # {ApartmentBachelorGas ApartmentBachelorElectricity} # {Apartment1bedGas Apartment1bedElectricity} #... # {Apartment5bedGas Apartment5bedElectricity} # {OtherBachelorGas OtherBachelorElectricity} # {Other1bedGas Other1bedElectricity} #... # {Other5bedGas Other5bedElectricity} # i.e. 6 pairs for Apartment, 6 pairs for Other ::set Wvalues { {9 24} {13 37} {21 55} {26 71} {32 86} {32 86} {0 0} {16 39} {26 66} {29 75} {38 94} {41 102} } ::set Hvalues { {51 67} {65 101} {87 151} {102 199} {121 235} {121 235} {0 0} {76 128} {106 220} {116 249} {142 312} {152 339} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... #jrp Apartment---------- Other------------- ::set Evalues {29 44 66 84 103 103 0 47 81 91 114 124}; # {ApartmentBachelorGas ApartmentBachelorElectricity} # {Apartment1bedGas Apartment1bedElectricity} #... # {Apartment5bedGas Apartment5bedElectricity} # {OtherBachelorGas OtherBachelorElectricity} # {Other1bedGas Other1bedElectricity} #... # {Other5bedGas Other5bedElectricity} # i.e. 6 pairs for Apartment, 6 pairs for Other ::set Wvalues { {9 24} {13 37} {21 55} {26 70} {32 86} {32 86} {0 0} {16 39} {26 66} {29 74} {38 94} {41 102} } ::set Hvalues { {51 67} {65 101} {87 151} {102 193} {121 235} {121 235} {0 0} {76 128} {106 220} {116 248} {142 312} {152 339} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { #jrp Apartment---------- Other------------- ::set Evalues {28 42 64 80 101 101 0 45 75 85 109 118}; # {ApartmentBachelorGas ApartmentBachelorElectricity} # {Apartment1bedGas Apartment1bedElectricity} #... # {Apartment5bedGas Apartment5bedElectricity} # {OtherBachelorGas OtherBachelorElectricity} # {Other1bedGas Other1bedElectricity} #... # {Other5bedGas Other5bedElectricity} # i.e. 6 pairs for Apartment, 6 pairs for Other ::set Wvalues { {9 20} {13 30} {21 46} {26 58} {32 73} {32 73} {0 0} {16 35} {26 59} {29 66} {38 85} {41 93} } ::set Hvalues { {51 57} {65 86} {87 132} {102 164} {121 207} {121 207} {0 0} {76 107} {106 180} {116 203} {142 261} {152 284} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {26 39 61 76 97 97 0 41 72 80 104 115}; ::set Wvalues { {6 17} {9 29} {14 46} {18 56} {23 72} {23 72} {0 0} {10 33} {18 58} {19 65} {25 85} {28 93} } ::set Hvalues { {40 46} {48 74} {61 115} {69 143} {82 182} {82 182} {0 0} {54 92} {73 161} {78 178} {94 233} {101 257} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20210101" "day"]>=0} { ::set Evalues {28 39 61 70 91 0 41 69 79 105}; ::set Wvalues { {8 17} {12 26} {14 46} {17 52} {21 69} {0 0} {12 30} {16 53} {19 60} {25 81} } ::set Hvalues { {38 48} {44 73} {61 128} {66 145} {78 194} {0 0} {47 85} {66 148} {71 169} {87 225} } ::break; } ::set Evalues {28 40 65 77 97 33 47 77 91 114}; ::set Wvalues { {6 19} {9 28} {15 46} {17 54} {22 68} {8 24} {11 34} {18 56} {21 65} {27 82} } ::set Hvalues { {41 54} {48 77} {63 126} {70 148} {82 187} {43 63} {54 90} {70 146} {78 172} {92 217} } ::break; } a* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2025 numbers go here... ::set Evalues {80 90 99 108 118 0 162 183 200 216}; ::set Wvalues {16 19 22 25 29 0 27 32 36 40}; ::set Hvalues {64 77 89 102 115 0 110 126 143 161}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... ::set Evalues {80 90 99 108 118 0 162 183 200 216}; ::set Wvalues {16 19 22 25 29 0 27 32 36 40}; ::set Hvalues {64 77 89 102 115 0 110 126 143 161}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {80 90 99 108 118 0 162 183 200 216}; ::set Wvalues {16 19 22 25 29 0 27 32 36 40}; ::set Hvalues {64 77 89 102 115 0 110 126 143 161}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {51.83 58.03 64.24 70.63 77.25 0 105.59 119.25 130.48 140.79}; ::set Wvalues {10.32 12.33 14.32 16.29 18.29 0 17.83 21.61 23.24 25.98} ::set Hvalues {41.23 48.82 57.00 65.21 72.83 0 70.26 80.99 91.88 103.60} ::break; } ::set Evalues {44 49 54 59 64 0 92 101 110 119}; ::set Wvalues {8 10 12 13 15 0 14 17 19 21} ::set Hvalues {33 40 46 53 59 0 58 66 75 83} ::break; } m* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2025 numbers go here... ::set Evalues {28 34 38 45 51 0 62 72 83 93}; ::set Wvalues {9 12 14 16 19 0 17 20 23 28}; ::set Hvalues {37 46 56 66 75 0 67 81 94 110}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... ::set Evalues {26 32 36 42 48 0 58 68 77 87}; ::set Wvalues {9 12 14 16 19 0 17 20 23 28}; ::set Hvalues {37 46 56 66 75 0 67 81 94 110}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {25 30 34 40 45 0 55 64 73 82}; ::set Wvalues {9 11 14 16 18 0 16 20 23 27}; ::set Hvalues {36 45 55 64 73 0 66 79 91 107}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {24 29 33 39 44 0 53 62 71 80}; ::set Wvalues {7.4 9.3 10.8 13.2 15.1 0 13.6 16.2 18.9 21.6} ::set Hvalues {29.6 37.4 45.1 52.9 60.6 0 54.2 64.9 75.5 86.1} ::break; } ::set Evalues {23 28 33 38 43 0 51 60 69 78}; ::set Wvalues {6 8 9 11 13 0 11 13 16 18} ::set Hvalues {25 31 37 44 50 0 45 54 62 71} ::break; } nb - "new b*" { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2025 numbers go here... ::set Evalues {18 24 31 33 34 0 28 35 36 38}; ::set Wvalues {13 17 22 24 24 0 20 25 26 27}; ::set Hvalues {67 85 112 120 123 0 101 125 131 139}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... ::set Evalues {16 21 27 29 30 0 24 30 32 33}; ::set Wvalues {12 15 19 21 21 0 18 22 23 24}; ::set Hvalues {58 75 98 105 107 0 89 110 114 121}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {15 20 26 28 28 0 23 29 30 32}; ::set Wvalues {11 14 18 20 20 0 17 21 22 23}; ::set Hvalues {56 71 94 100 102 0 85 105 109 116}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {15.25 19.46 25.47 27.27 27.87 0 23.06 28.47 29.68 31.48}; ::set Wvalues {10.93 13.94 18.25 19.54 19.97 0 16.53 20.40 21.26 22.56} ::set Hvalues {55.36 70.64 92.47 99.02 101.20 0 83.74 103.39 107.75 114.30} ::break; } ::set Evalues {0 0 0 0 0 0 0 0 0 0}; ::set Wvalues {0 0 0 0 0 0 0 0 0 0} ::set Hvalues {0 0 0 0 0 0 0 0 0 0} ::break; } s* { ::set Table "fchi2_$Table"; ::set Sources [::list]; ::if {$FreshDate} { #2025 numbers go here... ::set Evalues {52 56 62 66 72 0 105 115 124 131}; ::set Wvalues {12 14 16 18 20 0 20 23 25 28}; ::set Hvalues {47 55 63 72 80 0 79 90 102 113}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... ::set Evalues {52 56 62 66 72 0 105 115 124 131}; ::set Wvalues {12 14 16 18 20 0 20 23 25 28}; ::set Hvalues {47 55 63 72 80 0 79 90 102 113}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {47 52 57 61 66 0 97 106 114 120}; ::set Wvalues {12 14 16 18 20 0 20 23 25 28}; ::set Hvalues {47 55 63 72 80 0 79 90 102 113}; ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {45 49 54 58 63 0 92 100 108 114}; ::set Wvalues {9.0 10.6 12.2 13.8 15.4 0 15.2 17.4 19.6 21.8} ::set Hvalues {36.0 42.4 48.8 55.2 61.6 0 60.8 69.6 78.4 87.2} ::break; } ::set Evalues {49 54 59 64 69 0 101 110 119 128}; ::set Wvalues {9 11 12 14 15 0 15 17 20 22} ::set Hvalues {36 42 49 55 62 0 61 70 78 87} ::break; } b* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list gas electricity]; ::if {$FreshDate} { #2025 numbers go here... ::set Evalues {33 37 63 64 77 77 0 57 97 99 119 119}; ::set Wvalues { {14 13} {15 18} {16 27} {20 37} {29 55} {29 55} {0 0} {16 18} {19 27} {20 37} {29 55} {30 57} } ::set Hvalues { {44 37} {53 44} {79 72} {86 85} {102 94} {102 94} {0 0} {64 59} {95 99} {97 114} {117 128} {122 133} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... ::set Evalues {31 35 59 60 73 73 0 54 91 93 112 112}; ::set Wvalues { {14 12} {15 18} {16 27} {17 37} {18 55} {18 55} {0 0} {16 18} {19 27} {20 37} {29 55} {30 57} } ::set Hvalues { {44 37} {53 44} {79 72} {86 85} {102 94} {102 94} {0 0} {64 59} {95 99} {97 114} {117 128} {122 133} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Evalues {31 34 58 59 71 71 0 52 89 91 110 110}; ::set Wvalues { {14 12} {15 18} {16 27} {17 36} {18 54} {18 54} {0 0} {16 18} {19 27} {20 36} {29 54} {30 56} } ::set Hvalues { {44 36} {53 43} {79 70} {86 83} {102 92} {102 92} {0 0} {64 58} {95 96} {97 111} {117 124} {122 129} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Evalues {25 28 47 48 58 58 0 46 78 80 96 96}; ::set Wvalues { {13 12} {13 18} {15 27} {15 36} {17 54} {17 54} {0 0} {15 18} {17 27} {18.16 36} {26.53 54} {27.59 56} } ::set Hvalues { {40 36} {49 42} {72 70} {79 82} {93 91} {93 91} {0 0} {57.92 49} {86.24 81} {88.23 94} {106.43 105} {110.68 110} } ::break; } ::set Evalues {25 28 47 48 58 0 46 78 79 96}; ::set Wvalues { {9 12} {10 18} {11 26} {12 36} {14 54} {0 0} {10 18} {14 26} {18 36} {25 54} } ::set Hvalues { {37 35} {45 42} {66 69} {72 81} {85 91} {0 0} {55 49} {79 81} {80 93} {97 105} } ::break; } pr* - pe* { ::set Table "fchi2_ON_$Table"; ::set Sources [::list oil electricity]; ::if {$FreshDate} { #2025 numbers go here... #jrp Apartment------- Other----------- SDH------------- ::set Evalues {10 13 17 19 19 19 0 15 19 20 22 26 0 17 22 24 25 28}; #jrp SDH - Social Development Housing? ::set Wvalues { {29 20} {37 26} {50 35} {53 38} {55 39} {55 39} {0 0} {45 32} {56 40} {58 41} {62 44} {74 53} {0 0} {48 34} {64 46} {69 49} {71 51} {81 58} } ::set Hvalues { {113 80} {147 104} {196 139} {211 149} {215 153} {215 153} {0 0} {176 125} {220 156} {230 163} {245 174} {294 200} {0 0} {188 133} {254 181} {274 194} {281 199} {321 219} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { #2024 numbers go here... #jrp Apartment-------- Other----------- SDH------------- ::set Evalues {10 12 17 18 18 18 0 15 19 19 21 25 0 16 22 23 24 27}; #jrp SDH - Social Development Housing? ::set Wvalues { {29 20} {37 25} {50 34} {53 36} {55 37} {55 37} {0 0} {45 30} {56 38} {58 40} {62 42} {74 51} {0 0} {48 33} {64 44} {69 47} {71 49} {81 55} } ::set Hvalues { {113 77} {147 100} {196 134} {211 144} {215 147} {215 147} {0 0} {176 120} {220 150} {230 157} {245 167} {294 200} {0 0} {188 128} {254 173} {274 187} {281 191} {321 219} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { #jrp Apartment------- Other----------- SDH------------- ::set Evalues {9 12 16 17 18 18 0 14 18 19 20 24 0 15 21 22 23 26}; #jrp SDH - Social Development Housing? ::set Wvalues { {23 19} {29 25} {39 33} {42 35} {43 36} {43 36} {0 0} {35 30} {44 37} {46 38} {49 41} {58 49} {0 0} {37 31} {50 42} {54 46} {56 47} {64 54} } ::set Hvalues { {89 75} {116 97} {154 129} {165 139} {169 142} {169 142} {0 0} {138 116} {173 145} {180 152} {192 161} {229 193} {0 0} {147 124} {199 168} {214 180} {220 185} {251 211} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { #jrp Apartment------------------------ Other-------------------------- SDH---------------------------- ::set Evalues {6.98 9.05 12.01 12.90 13.20 13.20 0 10.83 13.49 14.08 14.97 17.93 0 11.54 15.56 16.75 17.16 19.59}; #jrp oil electr #jrp apartment #jrp other #jrp SDH - Social Development Housing? ::set Wvalues { {13.46 19.83} {19.01 25.72} {26.93 34.12} {29.30 36.65} {30.09 37.49} {30.09 37.49} {0 0} {23.76 30.76} {30.89 38.33} {32.47 40.01} {34.85 42.53} {42.76 50.94} {0 0} {25.66 32.78} {36.43 44.21} {39.60 47.58} {40.71 48.75} {47.20 55.65} } #jrp oil electr #jrp apartment #jrp other #jrp SDH ::set Hvalues { {50.49 74.37} {71.27 96.43} {100.97 127.96} {109.88 137.42} {112.85 140.57} {112.85 140.57} {0 0} {89.09 115.35} {115.82 143.73} {121.76 150.03} {130.67 159.49} {160.37 191.02} {0 0} {96.22 122.92} {136.61 165.80} {148.49 178.41} {152.65 182.82} {177.00 208.67} } ::break; } ::set Evalues {7 9 12 13 13 0 11 13 14 15}; ::set Wvalues { {13 19} {17 25} {23 33} {24 36} {25 37} {0 0} {20 30} {25 37} {27 39} {28 42} } ::set Hvalues { {50 73} {64 94} {85 125} {91 134} {93 137} {0 0} {77 113} {96 141} {100 147} {106 156} } ::break; } pq - q* { ::set Table "fchi2_ON_$Table"; ::if {$FreshDate} { #2025 numbers go here... ::set Sources [::list gas oil electricity]; ::set Evalues {16 19 24 29 32 0 31 35 41 48}; #jrp gas oil electr ::set Wvalues { {11 17 13} {13 19 15} {16 23 18} {19 28 22} {21 31 24} {0 0 0} {21 31 24} {24 34 27} {28 41 32} {32 47 37} } ::set Hvalues { {29 42 33} {34 50 39} {44 64 50} {53 77 60} {57 83 65} {0 0 0} {56 82 64} {64 93 73} {75 110 86} {88 129 101} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20240101" "day"]>=0} { ::set Sources [::list gas oil electricity]; ::set Evalues {16 19 23 28 31 0 30 34 40 47}; #jrp gas oil electr ::set Wvalues { {11 15 12} {12 18 14} {16 23 18} {19 28 22} {21 31 24} {0 0 0} {20 29 23} {23 33 26} {27 40 31} {32 46 36} } ::set Hvalues { {28 41 32} {33 48 38} {42 61 48} {51 74 58} {55 80 63} {0 0 0} {55 80 63} {62 91 71} {74 107 84} {86 125 98} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20230101" "day"]>=0} { ::set Sources [::list gas oil electricity]; ::set Evalues {15 18 22 27 30 0 29 33 39 46}; #jrp gas oil electr ::set Wvalues { {11 15 12} {12 18 14} {15 22 17} {18 27 21} {20 29 23} {0 0 0} {19 28 22} {22 32 25} {26 38 30} {31 45 35} } ::set Hvalues { {27 40 31} {32 47 37} {41 60 47} {50 73 57} {54 79 62} {0 0 0} {53 77 60} {60 88 69} {72 105 82} {83 121 95} } ::break; } ::if {[::qw::date::difference [::sargs::get $_rgi_sargs .effective_date] "20220101" "day"]>=0} { ::set Sources [::list gas oil electricity]; ::set Evalues {15 17 22 27 29 0 28 32 38 45}; #jrp gas oil electr ::set Wvalues { {9.63 13.48 11} {12.25 17.15 14} {14.88 20.83 17} {17.50 24.50 20} {19.25 26.95 22} {0 0 0} {19.25 26.95 22} {21.88 30.63 25} {25.38 35.53 29} {29.75 41.65 34} } ::set Hvalues { {27.13 37.98 31} {31.50 44.10 36} {39.38 55.13 45} {48.13 67.38 55} {53.38 74.73 61} {0 0 0} {51.63 72.28 59} {58.63 82.08 67} {69.13 96.78 79} {81.38 113.93 93} } ::break; } ::set Sources [::list gas electricity]; ::set Evalues {12 14 17 21 23 0 22 26 30 36}; ::set Wvalues { {7 8} {9 10} {11 13} {13 15} {15 17} {0 0} {14 16} {16 18} {19 22} {23 26} } ::set Hvalues { {32 36} {37 42} {46 53} {56 64} {61 70} {0 0} {60 69} {68 78} {81 93} {96 110} } ::break; } default { ::break; } } } #//::puts "pgq,debug...::QW::NEWVIEWS::rgi_look_up_table_fchi2 ::switch Table==$Table"; ::switch -- $Table { fchi2_ElectricityCharge { #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ Evalues==$Evalues"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ LayoutList==$LayoutList"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ Layout==$Layout"; ::return [::lindex $Evalues [::lsearch $LayoutList $Layout]]; } fchi2_WaterHeatAllowance {::return [::lindex $Wvalues [::lsearch $LayoutList $Layout]];} fchi2_HeatingAllowance {::return [::lindex $Hvalues [::lsearch $LayoutList $Layout]];} fchi2_ON_ElectricityCharge { #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON Evalues==$Evalues"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON LayoutList==$LayoutList"; #//::puts "pgq,debug_empty_operand_FCHI2...::QW::NEWVIEWS::rgi_look_up_table_fchi2 fchi2_ON Layout==$Layout"; ::set Value [::lindex $Evalues [::lsearch $LayoutList $Layout]]; ::return $Value; } fchi2_ON_WaterHeatAllowance { #::set Sources [::list gas electricity]; ;#// do this above by province so we do doublets or triplets ::set Source [::sargs::get $_rgi_sargs .utilities.water.operates_water_heater]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance Source==$Source"; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance Layout==$Layout"; #//::foreach Guy $LayoutList {#//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance ::foreach LayoutList Guy==$Guy";} #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance ::lsearch LayoutList $Layout==[::lsearch $LayoutList $Layout]"; ::set LayoutValues [::lindex $Wvalues [::lsearch $LayoutList $Layout]]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance LayoutValues==$LayoutValues"; ::set Value [::lindex $LayoutValues [::lsearch $Sources $Source]]; #//::puts "pgq,debug_empty_operand_FCHI2...rgi_look_up_table_fchi2 case fchi2_ON_WaterHeatAllowance ::lsearch Sources Source==[::lsearch $Sources $Source] Value==$Value"; ::return $Value; } fchi2_ON_HeatingAllowance { #::set Sources [::list gas electricity]; ::set Source [::sargs::get $_rgi_sargs .utilities.heat.operate_heat]; ::set LayoutValues [::lindex $Hvalues [::lsearch $LayoutList $Layout]]; ::set Value [::lindex $LayoutValues [::lsearch $Sources $Source]]; ::return $Value; } default { ::qw::throw [::sargs \ .text "rgi_look_up_table_fchi2 did not recongnize case $Table"; .help_id 0 \ ]; } } #//::puts "pgq,debug_FCHI2...rgi_look_up_table_fchi2 MISSED all cases!"; } #nv2.34.7 (code rewrite) - ::QW::NEWVIEWS::household_income_limits - .effective_date respecting - updated for 2021 #//------------------------------------------------------------------------- # Scrape 5 columns of income limit dollar data from 4 tables on one page, each table with 65 rows # this is javascript to scrape from a web page # IDIOT - where's the link /* { var tableBodyRows = document.querySelectorAll('table.MsoNormalTable tbody tr'); var holdingPlace = ""; tableBodyRows.forEach(element => { var rowValues = ""; var dataElements = element.querySelectorAll('td p'); dataElements.forEach(dataElement => { if(dataElement.parentElement.cellIndex === 3 || dataElement.parentElement.cellIndex === 4 || dataElement.parentElement.cellIndex === 5 || dataElement.parentElement.cellIndex === 6 || dataElement.parentElement.cellIndex === 7) { rowValues = rowValues + dataElement.innerText + ' '; } }) rowValues = "{" + rowValues + "}\n"; holdingPlace = holdingPlace + rowValues; }) console.log("Row Values Are ==\n" + holdingPlace); */} # Find each unique row of data values per table (typically 5 or 6) - and a list of those among the 65 rows that use each row of data values /* { ::proc main {sargs} { #::qw::finally [::list ::namespace delete ${::qw::script::namespace}]; ::foreach ListType { high_needs_old high_needs_new low_needs_old low_needs_new } { ::set LoL [$ListType]; ::puts "::llength LoL $ListType==[::llength $LoL]"; ::set Count 0; ::set Isect31 [::lindex [::qw::intersect3 $LoL $LoL] 1]; ::foreach Item $Isect31 { ::set RowList [::lsearch -all $LoL $Item]; ::set NewList [::list]; ::foreach Row $RowList { ::lappend NewList [::expr {$Row+1}]; } ::puts "::foreach ::qw::intersect3 $ListType ([::incr Count])==$Item RowList==$NewList"; } } ::return; } */} # Four tables scraped /* { ::proc high_needs_new {} { ::return { {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {15,300 18,900 23,100 25,200 30,000 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {15,300 18,900 23,100 25,200 30,000 } {18,300 23,400 27,600 33,000 40,800 } {15,300 18,900 23,100 25,200 30,000 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {26,400 31,800 35,700 40,200 43,800 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {15,300 18,900 23,100 25,200 30,000 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {15,300 18,900 23,100 25,200 30,000 } {15,300 18,900 23,100 25,200 30,000 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {22,500 27,600 33,000 39,900 45,600 } {16,200 19,800 23,700 26,100 35,700 } {26,400 31,800 35,700 40,200 43,800 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {26,400 31,800 35,700 40,200 43,800 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {15,300 18,900 23,100 25,200 30,000 } {16,200 19,800 23,700 26,100 35,700 } {26,400 31,800 35,700 40,200 43,800 } {15,300 18,900 23,100 25,200 30,000 } {18,300 23,400 27,600 33,000 40,800 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {16,200 19,800 23,700 26,100 35,700 } {26,400 31,800 35,700 40,200 43,800 } {16,200 19,800 23,700 26,100 35,700 } {N/A 31,500 38,100 43,500 47,400 } {16,200 19,800 23,700 26,100 35,700 } {N/A 31,500 38,100 43,500 47,400 } {16,200 19,800 23,700 26,100 35,700 } {N/A 31,500 38,100 43,500 47,400 } {N/A 31,500 38,100 43,500 47,400 } {16,200 19,800 23,700 26,100 35,700 } {16,200 19,800 23,700 26,100 35,700 } {N/A 31,500 38,100 43,500 47,400 } {15,300 18,900 23,100 25,200 30,000 } {16,200 19,800 23,700 26,100 35,700 } {18,300 23,400 27,600 33,000 40,800 } {15,300 18,900 23,100 25,200 30,000 } {15,300 18,900 23,100 25,200 30,000 } } } ::proc low_needs_new {} { ::return { {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {25,500 31,500 38,500 42,000 50,000 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {25,500 31,500 38,500 42,000 50,000 } {30,500 39,000 46,000 55,000 68,000 } {25,500 31,500 38,500 42,000 50,000 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {44,000 53,000 59,500 67,000 73,000 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {25,500 31,500 38,500 42,000 50,000 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {25,500 31,500 38,500 42,000 50,000 } {25,500 31,500 38,500 42,000 50,000 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {37,500 46,000 55,000 66,500 76,000 } {27,000 33,000 39,500 43,500 59,500 } {44,000 53,000 59,500 67,000 73,000 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {44,000 53,000 59,500 67,000 73,000 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {25,500 31,500 38,500 42,000 50,000 } {27,000 33,000 39,500 43,500 59,500 } {44,000 53,000 59,500 67,000 73,000 } {25,500 31,500 38,500 42,000 50,000 } {30,500 39,000 46,000 55,000 68,000 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {27,000 33,000 39,500 43,500 59,500 } {44,000 53,000 59,500 67,000 73,000 } {27,000 33,000 39,500 43,500 59,500 } {N/A 52,500 63,500 72,500 79,000 } {27,000 33,000 39,500 43,500 59,500 } {N/A 52,500 63,500 72,500 79,000 } {27,000 33,000 39,500 43,500 59,500 } {N/A 52,500 63,500 72,500 79,000 } {N/A 52,500 63,500 72,500 79,000 } {27,000 33,000 39,500 43,500 59,500 } {27,000 33,000 39,500 43,500 59,500 } {N/A 52,500 63,500 72,500 79,000 } {25,500 31,500 38,500 42,000 50,000 } {27,000 33,000 39,500 43,500 59,500 } {30,500 39,000 46,000 55,000 68,000 } {25,500 31,500 38,500 42,000 50,000 } {25,500 31,500 38,500 42,000 50,000 } } } ::proc high_needs_old {} { ::return { {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {23,400 27,000 31,500 36,900 43,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {20,400 24,000 30,000 37,800 42,000 } {14,400 18,600 22,200 24,300 28,800 } {23,400 27,000 31,500 36,900 43,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {23,400 27,000 31,500 36,900 43,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {23,400 27,000 31,500 36,900 43,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {23,400 27,000 31,500 36,900 43,800 } {14,400 18,600 22,200 24,300 28,800 } {N/A 29,100 34,800 39,900 45,600 } {14,400 18,600 22,200 24,300 28,800 } {N/A 29,100 34,800 39,900 45,600 } {14,400 18,600 22,200 24,300 28,800 } {N/A 29,100 34,800 39,900 45,600 } {N/A 29,100 34,800 39,900 45,600 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {N/A 29,100 34,800 39,900 45,600 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } {16,200 20,700 25,200 30,600 39,300 } {14,400 18,600 22,200 24,300 28,800 } {14,400 18,600 22,200 24,300 28,800 } } } ::proc low_needs_old {} { ::return { {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {40,000 47,000 54,000 62,000 70,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {34,500 40,000 48,000 60,500 69,500 } {25,000 31,000 37,500 40,500 50,000 } {40,000 47,000 54,000 62,000 70,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {40,000 47,000 54,000 62,000 70,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {40,000 47,000 54,000 62,000 70,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {40,000 47,000 54,000 62,000 70,000 } {25,000 31,000 37,500 40,500 50,000 } {NA 52,500 59,500 66,500 74,500 } {25,000 31,000 37,500 40,500 50,000 } {NA 52,500 59,500 66,500 74,500 } {25,000 31,000 37,500 40,500 50,000 } {NA 52,500 59,500 66,500 74,500 } {NA 52,500 59,500 66,500 74,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {NA 52,500 59,500 66,500 74,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } {27,000 34,500 42,000 51,000 65,500 } {25,000 31,000 37,500 40,500 50,000 } {25,000 31,000 37,500 40,500 50,000 } } } */} # scrub result /* { ::llength LoL high_needs_old==65 ::foreach ::qw::intersect3 high_needs_old (1)==14,400 18,600 22,200 24,300 28,800 RowList==2 3 4 5 7 9 11 14 15 16 17 18 19 20 21 23 24 25 27 28 30 33 35 36 39 41 42 44 47 49 51 53 55 58 59 61 62 64 65 ::foreach ::qw::intersect3 high_needs_old (2)==16,200 20,700 25,200 30,600 39,300 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_old (3)==20,400 24,000 30,000 37,800 42,000 RowList==29 ::foreach ::qw::intersect3 high_needs_old (4)==23,400 27,000 31,500 36,900 43,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_old (5)==N/A 29,100 34,800 39,900 45,600 RowList==52 54 56 57 60 ::llength LoL high_needs_new==65 ::foreach ::qw::intersect3 high_needs_new (1)==15,300 18,900 23,100 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_new (2)==16,200 19,800 23,700 26,100 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_new (3)==18,300 23,400 27,600 33,000 40,800 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_new (4)==22,500 27,600 33,000 39,900 45,600 RowList==29 ::foreach ::qw::intersect3 high_needs_new (5)==26,400 31,800 35,700 40,200 43,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_new (6)==N/A 31,500 38,100 43,500 47,400 RowList==52 54 56 57 60 ::llength LoL high_needs_2022==65 ::foreach ::qw::intersect3 high_needs_2022 (1)==15,300 18,900 23,100 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_2022 (2)==16,500 20,400 24,300 27,000 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_2022 (3)==19,200 24,900 29,400 34,800 44,700 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_2022 (4)==24,900 28,800 35,400 41,400 51,000 RowList==29 ::foreach ::qw::intersect3 high_needs_2022 (5)==28,800 33,900 38,100 43,200 46,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_2022 (6)==N/A 31,500 38,100 43,500 47,400 RowList==52 54 56 57 60 ::llength LoL low_needs_old==65 ::foreach ::qw::intersect3 low_needs_old (1)==25,000 31,000 37,500 40,500 50,000 RowList==2 3 4 5 7 9 11 14 15 16 17 18 19 20 21 23 24 25 27 28 30 33 35 36 39 41 42 44 47 49 51 53 55 58 59 61 62 64 65 ::foreach ::qw::intersect3 low_needs_old (2)==27,000 34,500 42,000 51,000 65,500 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_old (3)==34,500 40,000 48,000 60,500 69,500 RowList==29 ::foreach ::qw::intersect3 low_needs_old (4)==40,000 47,000 54,000 62,000 70,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_old (5)==NA 52,500 59,500 66,500 74,500 RowList==52 54 56 57 60 ::llength LoL low_needs_new==65 ::foreach ::qw::intersect3 low_needs_new (1)==25,500 31,500 38,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_new (2)==27,000 33,000 39,500 43,500 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_new (3)==30,500 39,000 46,000 55,000 68,000 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_new (4)==37,500 46,000 55,000 66,500 76,000 RowList==29 ::foreach ::qw::intersect3 low_needs_new (5)==44,000 53,000 59,500 67,000 73,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_new (6)==N/A 52,500 63,500 72,500 79,000 RowList==52 54 56 57 60 ::llength LoL low_needs_2022==65 ::foreach ::qw::intersect3 low_needs_2022 (1)==25,500 31,500 38,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_2022 (2)==27,500 34,000 40,500 45,000 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_2022 (3)==32,000 41,500 49,000 58,000 74,500 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_2022 (4)==41,500 48,000 59,000 69,000 85,000 RowList==29 ::foreach ::qw::intersect3 low_needs_2022 (5)==48,000 56,500 63,500 72,000 78,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_2022 (6)==N/A 52,500 63,500 72,500 79,000 RowList==52 54 56 57 60 */} #nv2.37.0 (update) - 2023 - High Need Households and Household Income Limits - 65 regions (rows) in Ontario - 5 columns for the number of bedrooms /* { ::proc high_needs_low_needs_scrub {sargs} { ::foreach ListType { high_needs_2022 high_needs_2023 low_needs_2022 low_needs_2023 } {} ::foreach ListType { high_needs_2021 high_needs_2022 low_needs_2021 low_needs_2022 } { ::set LoL [$ListType]; ;#// execute proc to populate List Of Lists ::set BracedList [::list]; ::foreach {a b c d e} $LoL { ::lappend BracedList [::list $a $b $c $d $e]; } ::set LoL $BracedList; ::puts "::llength LoL $ListType==[::llength $LoL]"; ::set Count 0; ::set Isect31 [::lindex [::qw::intersect3 $LoL $LoL] 1]; ::foreach Item $Isect31 { ::set RowList [::lsearch -all $LoL $Item]; ::set NewList [::list]; ::foreach Row $RowList { ::lappend NewList [::expr {$Row+1}]; } ::puts "::foreach ::qw::intersect3 $ListType ([::incr Count])==$Item RowList==$NewList"; } } ::return; } ::proc high_needs_2021 {} { ::return { 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 15,300 18,900 23,100 25,200 30,000 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 15,300 18,900 23,100 25,200 30,000 18,300 23,400 27,600 33,000 40,800 15,300 18,900 23,100 25,200 30,000 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 26,400 31,800 35,700 40,200 43,800 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 15,300 18,900 23,100 25,200 30,000 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 15,300 18,900 23,100 25,200 30,000 15,300 18,900 23,100 25,200 30,000 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 22,500 27,600 33,000 39,900 45,600 16,200 19,800 23,700 26,100 35,700 26,400 31,800 35,700 40,200 43,800 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 26,400 31,800 35,700 40,200 43,800 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 15,300 18,900 23,100 25,200 30,000 16,200 19,800 23,700 26,100 35,700 26,400 31,800 35,700 40,200 43,800 15,300 18,900 23,100 25,200 30,000 18,300 23,400 27,600 33,000 40,800 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 16,200 19,800 23,700 26,100 35,700 26,400 31,800 35,700 40,200 43,800 16,200 19,800 23,700 26,100 35,700 N/A 31,500 38,100 43,500 47,400 16,200 19,800 23,700 26,100 35,700 N/A 31,500 38,100 43,500 47,400 16,200 19,800 23,700 26,100 35,700 N/A 31,500 38,100 43,500 47,400 N/A 31,500 38,100 43,500 47,400 16,200 19,800 23,700 26,100 35,700 16,200 19,800 23,700 26,100 35,700 N/A 31,500 38,100 43,500 47,400 15,300 18,900 23,100 25,200 30,000 16,200 19,800 23,700 26,100 35,700 18,300 23,400 27,600 33,000 40,800 15,300 18,900 23,100 25,200 30,000 15,300 18,900 23,100 25,200 30,000 }; } ::proc low_needs_2021 {} { ::return { 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 25,500 31,500 38,500 42,000 50,000 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 25,500 31,500 38,500 42,000 50,000 30,500 39,000 46,000 55,000 68,000 25,500 31,500 38,500 42,000 50,000 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 44,000 53,000 59,500 67,000 73,000 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 25,500 31,500 38,500 42,000 50,000 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 25,500 31,500 38,500 42,000 50,000 25,500 31,500 38,500 42,000 50,000 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 37,500 46,000 55,000 66,500 76,000 27,000 33,000 39,500 43,500 59,500 44,000 53,000 59,500 67,000 73,000 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 44,000 53,000 59,500 67,000 73,000 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 25,500 31,500 38,500 42,000 50,000 27,000 33,000 39,500 43,500 59,500 44,000 53,000 59,500 67,000 73,000 25,500 31,500 38,500 42,000 50,000 30,500 39,000 46,000 55,000 68,000 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 27,000 33,000 39,500 43,500 59,500 44,000 53,000 59,500 67,000 73,000 27,000 33,000 39,500 43,500 59,500 N/A 52,500 63,500 72,500 79,000 27,000 33,000 39,500 43,500 59,500 N/A 52,500 63,500 72,500 79,000 27,000 33,000 39,500 43,500 59,500 N/A 52,500 63,500 72,500 79,000 N/A 52,500 63,500 72,500 79,000 27,000 33,000 39,500 43,500 59,500 27,000 33,000 39,500 43,500 59,500 N/A 52,500 63,500 72,500 79,000 25,500 31,500 38,500 42,000 50,000 27,000 33,000 39,500 43,500 59,500 30,500 39,000 46,000 55,000 68,000 25,500 31,500 38,500 42,000 50,000 25,500 31,500 38,500 42,000 50,000 }; } ::proc high_needs_2022 {} { ::return { 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 15,300 18,900 23,100 25,200 30,000 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 15,300 18,900 23,100 25,200 30,000 19,200 24,900 29,400 34,800 44,700 15,300 18,900 23,100 25,200 30,000 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 28,800 33,900 38,100 43,200 46,800 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 15,300 18,900 23,100 25,200 30,000 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 15,300 18,900 23,100 25,200 30,000 15,300 18,900 23,100 25,200 30,000 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 24,900 28,800 35,400 41,400 51,000 16,500 20,400 24,300 27,000 35,700 28,800 33,900 38,100 43,200 46,800 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 28,800 33,900 38,100 43,200 46,800 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 15,300 18,900 23,100 25,200 30,000 16,500 20,400 24,300 27,000 35,700 28,800 33,900 38,100 43,200 46,800 15,300 18,900 23,100 25,200 30,000 19,200 24,900 29,400 34,800 44,700 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 16,500 20,400 24,300 27,000 35,700 28,800 33,900 38,100 43,200 46,800 16,500 20,400 24,300 27,000 35,700 N/A 31,500 38,100 43,500 47,400 16,500 20,400 24,300 27,000 35,700 N/A 31,500 38,100 43,500 47,400 16,500 20,400 24,300 27,000 35,700 N/A 31,500 38,100 43,500 47,400 N/A 31,500 38,100 43,500 47,400 16,500 20,400 24,300 27,000 35,700 16,500 20,400 24,300 27,000 35,700 N/A 31,500 38,100 43,500 47,400 15,300 18,900 23,100 25,200 30,000 16,500 20,400 24,300 27,000 35,700 19,200 24,900 29,400 34,800 44,700 15,300 18,900 23,100 25,200 30,000 15,300 18,900 23,100 25,200 30,000 }; } ::proc high_needs_2023 {} { ::return { 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 18,600 20,400 25,500 25,200 30,000 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 18,600 20,400 25,500 25,200 30,000 20,400 26,400 31,200 35,700 44,700 18,600 20,400 25,500 25,200 30,000 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 29,700 35,100 40,200 44,700 47,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 18,600 20,400 25,500 25,200 30,000 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 18,600 20,400 25,500 25,200 30,000 18,600 20,400 25,500 25,200 30,000 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 26,100 30,000 36,000 43,200 55,500 16,500 21,600 25,500 28,800 35,700 29,700 35,100 40,200 44,700 47,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 29,700 35,100 40,200 44,700 47,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 18,600 20,400 25,500 25,200 30,000 16,500 21,600 25,500 28,800 35,700 29,700 35,100 40,200 44,700 47,700 18,600 20,400 25,500 25,200 30,000 20,400 26,400 31,200 35,700 44,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 16,500 21,600 25,500 28,800 35,700 29,700 35,100 40,200 44,700 47,700 16,500 21,600 25,500 28,800 35,700 N/A 35,700 43,500 49,800 54,600 16,500 21,600 25,500 28,800 35,700 N/A 35,700 43,500 49,800 54,600 16,500 21,600 25,500 28,800 35,700 N/A 35,700 43,500 49,800 54,600 N/A 35,700 43,500 49,800 54,600 16,500 21,600 25,500 28,800 35,700 16,500 21,600 25,500 28,800 35,700 N/A 35,700 43,500 49,800 54,600 18,600 20,400 25,500 25,200 30,000 16,500 21,600 25,500 28,800 35,700 20,400 26,400 31,200 35,700 44,700 18,600 20,400 25,500 25,200 30,000 18,600 20,400 25,500 25,200 30,000 }; } ::proc low_needs_2022 {} { ::return { 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 25,500 31,500 38,500 42,000 50,000 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 25,500 31,500 38,500 42,000 50,000 32,000 41,500 49,000 58,000 74,500 25,500 31,500 38,500 42,000 50,000 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 48,000 56,500 63,500 72,000 78,000 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 25,500 31,500 38,500 42,000 50,000 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 25,500 31,500 38,500 42,000 50,000 25,500 31,500 38,500 42,000 50,000 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 41,500 48,000 59,000 69,000 85,000 27,500 34,000 40,500 45,000 59,500 48,000 56,500 63,500 72,000 78,000 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 48,000 56,500 63,500 72,000 78,000 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 25,500 31,500 38,500 42,000 50,000 27,500 34,000 40,500 45,000 59,500 48,000 56,500 63,500 72,000 78,000 25,500 31,500 38,500 42,000 50,000 32,000 41,500 49,000 58,000 74,500 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 27,500 34,000 40,500 45,000 59,500 48,000 56,500 63,500 72,000 78,000 27,500 34,000 40,500 45,000 59,500 N/A 52,500 63,500 72,500 79,000 27,500 34,000 40,500 45,000 59,500 N/A 52,500 63,500 72,500 79,000 27,500 34,000 40,500 45,000 59,500 N/A 52,500 63,500 72,500 79,000 N/A 52,500 63,500 72,500 79,000 27,500 34,000 40,500 45,000 59,500 27,500 34,000 40,500 45,000 59,500 N/A 52,500 63,500 72,500 79,000 25,500 31,500 38,500 42,000 50,000 27,500 34,000 40,500 45,000 59,500 32,000 41,500 49,000 58,000 74,500 25,500 31,500 38,500 42,000 50,000 25,500 31,500 38,500 42,000 50,000 }; } ::proc low_needs_2023 {} { ::return { 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 31,000 34,000 42,500 42,000 50,000 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 31,000 34,000 42,500 42,000 50,000 34,000 44,000 52,000 59,500 74,500 31,000 34,000 42,500 42,000 50,000 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 49,500 58,500 67,000 74,500 79,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 31,000 34,000 42,500 42,000 50,000 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 31,000 34,000 42,500 42,000 50,000 31,000 34,000 42,500 42,000 50,000 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 43,500 50,000 60,000 72,000 92,500 27,500 36,000 42,500 48,000 59,500 49,500 58,500 67,000 74,500 79,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 49,500 58,500 67,000 74,500 79,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 31,000 34,000 42,500 42,000 50,000 27,500 36,000 42,500 48,000 59,500 49,500 58,500 67,000 74,500 79,500 31,000 34,000 42,500 42,000 50,000 34,000 44,000 52,000 59,500 74,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 27,500 36,000 42,500 48,000 59,500 49,500 58,500 67,000 74,500 79,500 27,500 36,000 42,500 48,000 59,500 N/A 59,500 72,500 83,000 91,000 27,500 36,000 42,500 48,000 59,500 N/A 59,500 72,500 83,000 91,000 27,500 36,000 42,500 48,000 59,500 N/A 59,500 72,500 83,000 91,000 N/A 59,500 72,500 83,000 91,000 27,500 36,000 42,500 48,000 59,500 27,500 36,000 42,500 48,000 59,500 N/A 59,500 72,500 83,000 91,000 31,000 34,000 42,500 42,000 50,000 27,500 36,000 42,500 48,000 59,500 34,000 44,000 52,000 59,500 74,500 31,000 34,000 42,500 42,000 50,000 31,000 34,000 42,500 42,000 50,000 }; } */} # 2022 sanity check /* { ::llength LoL high_needs_2021==65 ::foreach ::qw::intersect3 high_needs_2021 (1)==15,300 18,900 23,100 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_2021 (2)==16,200 19,800 23,700 26,100 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_2021 (3)==18,300 23,400 27,600 33,000 40,800 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_2021 (4)==22,500 27,600 33,000 39,900 45,600 RowList==29 ::foreach ::qw::intersect3 high_needs_2021 (5)==26,400 31,800 35,700 40,200 43,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_2021 (6)==N/A 31,500 38,100 43,500 47,400 RowList==52 54 56 57 60 ::llength LoL high_needs_2022==65 ::foreach ::qw::intersect3 high_needs_2022 (1)==15,300 18,900 23,100 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_2022 (2)==16,500 20,400 24,300 27,000 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_2022 (3)==19,200 24,900 29,400 34,800 44,700 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_2022 (4)==24,900 28,800 35,400 41,400 51,000 RowList==29 ::foreach ::qw::intersect3 high_needs_2022 (5)==28,800 33,900 38,100 43,200 46,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_2022 (6)==N/A 31,500 38,100 43,500 47,400 RowList==52 54 56 57 60 ::llength LoL low_needs_2021==65 ::foreach ::qw::intersect3 low_needs_2021 (1)==25,500 31,500 38,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_2021 (2)==27,000 33,000 39,500 43,500 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_2021 (3)==30,500 39,000 46,000 55,000 68,000 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_2021 (4)==37,500 46,000 55,000 66,500 76,000 RowList==29 ::foreach ::qw::intersect3 low_needs_2021 (5)==44,000 53,000 59,500 67,000 73,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_2021 (6)==N/A 52,500 63,500 72,500 79,000 RowList==52 54 56 57 60 ::llength LoL low_needs_2022==65 ::foreach ::qw::intersect3 low_needs_2022 (1)==25,500 31,500 38,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_2022 (2)==27,500 34,000 40,500 45,000 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_2022 (3)==32,000 41,500 49,000 58,000 74,500 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_2022 (4)==41,500 48,000 59,000 69,000 85,000 RowList==29 ::foreach ::qw::intersect3 low_needs_2022 (5)==48,000 56,500 63,500 72,000 78,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_2022 (6)==N/A 52,500 63,500 72,500 79,000 RowList==52 54 56 57 60 */} # 2023 scrub /* { -------------------@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@-------------------------- marker dropped ^P jig_tiny.qw_script WTF ::llength LoL high_needs_old_2022==65 ::foreach ::qw::intersect3 high_needs_old_2022 (1)==15,300 18,900 23,100 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_old_2022 (2)==16,500 20,400 24,300 27,000 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_old_2022 (3)==19,200 24,900 29,400 34,800 44,700 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_old_2022 (4)==24,900 28,800 35,400 41,400 51,000 RowList==29 ::foreach ::qw::intersect3 high_needs_old_2022 (5)==28,800 33,900 38,100 43,200 46,800 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_old_2022 (6)==N/A 31,500 38,100 43,500 47,400 RowList==52 54 56 57 60 ::llength LoL high_needs_new_2023==65 ::foreach ::qw::intersect3 high_needs_new_2023 (1)==16,500 21,600 25,500 28,800 35,700 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_new_2023 (2)==18,600 20,400 25,500 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_new_2023 (3)==20,400 26,400 31,200 35,700 44,700 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_new_2023 (4)==26,100 30,000 36,000 43,200 55,500 RowList==29 ::foreach ::qw::intersect3 high_needs_new_2023 (5)==29,700 35,100 40,200 44,700 47,700 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_new_2023 (6)==N/A 35,700 43,500 49,800 54,600 RowList==52 54 56 57 60 ::llength LoL low_needs_old_2022==65 ::foreach ::qw::intersect3 low_needs_old_2022 (1)==25,500 31,500 38,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_old_2022 (2)==27,500 34,000 40,500 45,000 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_old_2022 (3)==32,000 41,500 49,000 58,000 74,500 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_old_2022 (4)==41,500 48,000 59,000 69,000 85,000 RowList==29 ::foreach ::qw::intersect3 low_needs_old_2022 (5)==48,000 56,500 63,500 72,000 78,000 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_old_2022 (6)==N/A 52,500 63,500 72,500 79,000 RowList==52 54 56 57 60 ::llength LoL low_needs_new_2023==65 ::foreach ::qw::intersect3 low_needs_new_2023 (1)==27,500 36,000 42,500 48,000 59,500 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_new_2023 (2)==31,000 34,000 42,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_new_2023 (3)==34,000 44,000 52,000 59,500 74,500 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_new_2023 (4)==43,500 50,000 60,000 72,000 92,500 RowList==29 ::foreach ::qw::intersect3 low_needs_new_2023 (5)==49,500 58,500 67,000 74,500 79,500 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_new_2023 (6)==N/A 59,500 72,500 83,000 91,000 RowList==52 54 56 57 60 */} ::proc hil_region_map_to_common_row_20190606 {} { ::return { {2 3 4 5 7 9 11 14 15 16 17 18 19 20 21 23 24 25 27 28 30 33 35 36 39 41 42 44 47 49 51 53 55 58 59 61 62 64 65} {1 6 8 10 13 22 26 32 34 37 40 45 46 48 63} {29} {12 31 38 43 50} {52 54 56 57 60} }; } ::proc hil_region_map_to_common_row_20210101 {} { ::return { {3 7 9 15 24 25 41 44 61 64 65} {2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62} {1 6 8 10 13 22 26 32 34 37 40 45 46 48 63} {29} {12 31 38 43 50} {52 54 56 57 60} }; } ::proc hil_region_map_to_common_row_20220101 {} { # NOT called - no changes } ::proc hil_region_map_to_common_row_20230101 {} { # see file - C:\pgq_scripts\crm\jig_tiny.qw_script proc - high_needs_low_needs_scrub ;#// for guidance on how update # NOTICE #// it appears the vagaries of my tcl proc flipped rows one and two between years 2022(1) and 2023 - whatever - noticed it after job was done ::return { {2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62} {3 7 9 15 24 25 41 44 61 64 65} {1 6 8 10 13 22 26 32 34 37 40 45 46 48 63} {29} {12 31 38 43 50} {52 54 56 57 60} }; } ::proc hil_region_map_to_common_row_20240101 {} { #nv2.38.2 - NOT called - hil_region_map_to_common_row_20240101 - no changes } #// google "ontario rgi household income limits" ::proc household_income_limits {sargs} { #//::puts "pgq,debug...::QW::NEWVIEWS::household_income_limits - moved from /TABLE/NOTES/PROCEDURE/NEWVIEWS/NPH_HOUSING_REPORTS enter sargs==(\n[::sargs::format .structure $sargs]\n)"; ::set RGIcalc [::sargs::get $sargs .rgi_calc]; ::set Settings [::sargs::get $sargs .prompt_settings]; ::set Bedrooms [hil_number_of_bedrooms_get $RGIcalc]; ::set RegionNumber [hil_region_table_row_get $Settings]; ;#// the row number of the government table 1-65 ::if {$Bedrooms eq "bachelor"} { ::set Bedrooms 0; } #//::puts "pgq,debug...::QW::NEWVIEWS::household_income_limits enter .effective_date==[::sargs::get $sargs .rgi_calc.effective_date] RegionNumber==$RegionNumber Bedrooms==$Bedrooms"; /* { ::llength LoL low_needs_2024==65 ::foreach ::qw::intersect3 low_needs_2024 (1)==29,500 38,500 46,500 52,500 61,000 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 low_needs_2024 (2)==31,000 36,500 46,500 42,000 50,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 low_needs_2024 (3)==36,000 46,000 55,000 63,000 83,000 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 low_needs_2024 (4)==45,500 53,000 63,500 74,500 92,500 RowList==29 ::foreach ::qw::intersect3 low_needs_2024 (5)==53,500 62,500 71,500 79,000 82,500 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 low_needs_2024 (6)==N/A 68,000 83,000 95,500 105,000 RowList==52 54 56 57 60 */} #//--------------------------------------------------------------------- #nv2.38.2 (HIL) - 2024 - household_income_limits ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20240101" "day"]>=0 \ } { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20230101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "29500 38500 46500 52500 61000" $Bedrooms];} 2 {::return [::lindex "31000 36500 46500 42000 50000" $Bedrooms];} 3 {::return [::lindex "36000 46000 55000 63000 83000" $Bedrooms];} 4 {::return [::lindex "45500 53000 63500 74500 92500" $Bedrooms];} 5 {::return [::lindex "53500 62500 71500 79000 82500" $Bedrooms];} 6 {::return [::lindex "68000 68000 83000 95500 105000" $Bedrooms];} } } #//--------------------------------------------------------------------- #nv2.37.0 (HIL) - 2023 ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20230101" "day"]>=0 \ } { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20230101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "27500 36000 42500 48000 59500" $Bedrooms];} 2 {::return [::lindex "31000 34000 42500 42000 50000" $Bedrooms];} 3 {::return [::lindex "34000 44000 52000 59500 74500" $Bedrooms];} 4 {::return [::lindex "43500 50000 60000 72000 92500" $Bedrooms];} 5 {::return [::lindex "49500 58500 67000 74500 79500" $Bedrooms];} 6 {::return [::lindex "59500 59500 72500 83000 91000" $Bedrooms];} } } #//--------------------------------------------------------------------- #nv2.35.5 (HIL) - 2022 ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20220101" "day"]>=0 \ } { ::set CommonRow 0; # NOTICE - the call to 20210101 in not a typo - the mapping to a common row didn't change - BUT the values of each common row did change ::foreach List [hil_region_map_to_common_row_20210101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "25500 31500 38500 42000 50000" $Bedrooms];} 2 {::return [::lindex "27500 34000 40500 45000 59500" $Bedrooms];} 3 {::return [::lindex "32000 41500 49000 58000 74500" $Bedrooms];} 4 {::return [::lindex "41500 48000 59000 69000 85000" $Bedrooms];} 5 {::return [::lindex "48000 56500 63500 72000 78000" $Bedrooms];} 6 {::return [::lindex "52500 52500 63500 72500 79000" $Bedrooms];} } } #//--------------------------------------------------------------------- # 2021 ::if {[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20210101" "day"]>=0} { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20210101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "25500 31500 38500 42000 50000" $Bedrooms];} 2 {::return [::lindex "27000 33000 39500 43500 59500" $Bedrooms];} 3 {::return [::lindex "30500 39000 46000 55000 68000" $Bedrooms];} 4 {::return [::lindex "37500 46000 55000 66500 76000" $Bedrooms];} 5 {::return [::lindex "44000 53000 59500 67000 73000" $Bedrooms];} 6 {::return [::lindex "52500 52500 63500 72500 79000" $Bedrooms];} } } #//--------------------------------------------------------------------- # pre 2021 #::if {[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20190606" "day"]>=0} {} ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20190606] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "25000 31000 37500 40500 50000" $Bedrooms];} 2 {::return [::lindex "27000 34500 42000 51000 65500" $Bedrooms];} 3 {::return [::lindex "34500 40000 48000 60500 69500" $Bedrooms];} 4 {::return [::lindex "40000 47000 54000 62000 70000" $Bedrooms];} 5 {::return [::lindex "52500 52500 59500 66500 74500" $Bedrooms];} } #{} ::return 0; } ::proc high_need_households {sargs} { #//::puts "pgq,debug...::QW::NEWVIEWS::high_need_households - moved from /TABLE/NOTES/PROCEDURE/NEWVIEWS/NPH_HOUSING_REPORTS enter sargs==(\n[::sargs::format .structure $sargs]\n)"; ::set RGIcalc [::sargs::get $sargs .rgi_calc]; ::set Settings [::sargs::get $sargs .prompt_settings]; ::set Bedrooms [hil_number_of_bedrooms_get $RGIcalc]; ::set RegionNumber [hil_region_table_row_get $Settings]; ;#// the row number of the government table 1-65 ::if {$Bedrooms eq "bachelor"} { ::set Bedrooms 0; } #//::puts "pgq,debug...::QW::NEWVIEWS::high_need_households enter .effective_date==[::sargs::get $sargs .rgi_calc.effective_date] RegionNumber==$RegionNumber Bedrooms==$Bedrooms"; /* { ::foreach ::qw::intersect3 high_needs_2024 (1)==17,700 23,100 27,900 31,500 36,600 RowList==2 4 5 11 14 16 17 18 19 20 21 23 27 28 30 33 35 36 39 42 47 49 51 53 55 58 59 62 ::foreach ::qw::intersect3 high_needs_2024 (2)==18,600 21,900 27,900 25,200 30,000 RowList==3 7 9 15 24 25 41 44 61 64 65 ::foreach ::qw::intersect3 high_needs_2024 (3)==21,600 27,600 33,000 37,800 49,800 RowList==1 6 8 10 13 22 26 32 34 37 40 45 46 48 63 ::foreach ::qw::intersect3 high_needs_2024 (4)==27,300 31,800 38,100 44,700 55,500 RowList==29 ::foreach ::qw::intersect3 high_needs_2024 (5)==32,100 37,500 42,900 47,400 49,500 RowList==12 31 38 43 50 ::foreach ::qw::intersect3 high_needs_2024 (6)==N/A 40,800 49,800 57,300 63,000 RowList==52 54 56 57 60 */} #//--------------------------------------------------------------------- #nv2.38.2 (HIL) - 2024 - high_need_households (sector table name is basic_needs?) ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20240101" "day"]>=0 \ } { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20230101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "17700 23100 27900 31500 36600" $Bedrooms];} 2 {::return [::lindex "18600 21900 27900 25200 30000" $Bedrooms];} 3 {::return [::lindex "21600 27600 33000 37800 49800" $Bedrooms];} 4 {::return [::lindex "27300 31800 38100 44700 55500" $Bedrooms];} 5 {::return [::lindex "32100 37500 42900 47400 49500" $Bedrooms];} 6 {::return [::lindex "40800 40800 49800 57300 63000" $Bedrooms];} } } #//--------------------------------------------------------------------- #nv2.37.0 (HIL) - 2023 ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20230101" "day"]>=0 \ } { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20230101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "16500 21600 25500 28800 35700" $Bedrooms];} 2 {::return [::lindex "18600 20400 25500 25200 30000" $Bedrooms];} 3 {::return [::lindex "18600 20400 25500 25200 30000" $Bedrooms];} 4 {::return [::lindex "18600 20400 25500 25200 30000" $Bedrooms];} 5 {::return [::lindex "29700 35100 40200 44700 47700" $Bedrooms];} 6 {::return [::lindex "35700 35700 43500 49800 54600" $Bedrooms];} } } #//--------------------------------------------------------------------- #nv2.35.5 (HIL) -2022 ::if {[::sargs::get $RGIcalc .effective_date] eq "" \ ||[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20220101" "day"]>=0 \ } { ::set CommonRow 0; # NOTICE - the call to 20210101 in not a typo - the mapping to a common row didn't change - BUT the values of each common row did change ::foreach List [hil_region_map_to_common_row_20210101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "15300 18900 23100 25200 30000" $Bedrooms];} 2 {::return [::lindex "16500 20400 24300 27000 35700" $Bedrooms];} 3 {::return [::lindex "19200 24900 29400 34800 44700" $Bedrooms];} 4 {::return [::lindex "24900 28800 35400 41400 51000" $Bedrooms];} 5 {::return [::lindex "28800 33900 38100 43200 46800" $Bedrooms];} 6 {::return [::lindex "31500 31500 38100 43500 47400" $Bedrooms];} } } #//--------------------------------------------------------------------- # 2021 ::if {[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20210101" "day"]>=0} { ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20210101] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "15300 18900 23100 25200 30000" $Bedrooms];} 2 {::return [::lindex "16200 19800 23700 26100 35700" $Bedrooms];} 3 {::return [::lindex "18300 23400 27600 33000 40800" $Bedrooms];} 4 {::return [::lindex "22500 27600 33000 39900 45600" $Bedrooms];} 5 {::return [::lindex "26400 31800 35700 40200 43800" $Bedrooms];} 6 {::return [::lindex "31500 31500 38100 43500 47400" $Bedrooms];} } } #//--------------------------------------------------------------------- # pre 2021 #::if {[::qw::date::difference [::sargs::get $RGIcalc .effective_date] "20190606" "day"]>=0} {} ::set CommonRow 0; ::foreach List [hil_region_map_to_common_row_20190606] { ::incr CommonRow; ::if {[::lsearch $List $RegionNumber]>=0} { ::break; } } ::switch $CommonRow { 1 {::return [::lindex "14400 18600 22200 24300 28800" $Bedrooms];} 2 {::return [::lindex "16200 20700 25200 30600 39300" $Bedrooms];} 3 {::return [::lindex "20400 24000 30000 37800 42000" $Bedrooms];} 4 {::return [::lindex "23400 27000 31500 36900 43800" $Bedrooms];} 5 {::return [::lindex "29100 29100 34800 39900 45600" $Bedrooms];} } #{} } ::proc hil_region_table_row_get {Settings} { #//::puts "pgq,debug...::QW::NEWVIEWS - moved from /TABLE/NOTES/PROCEDURE/NEWVIEWS/NPH_HOUSING_REPORTS"; ::set SubRegion [::string tolower [::sargs::get $Settings .service_subregion]]; ::set ValueSet 0; ::switch -glob -- [::string tolower [::sargs::get $Settings .service_region]] { "brantford" { ::switch -glob -- $SubRegion { "city*" {::set ValueSet 1;} "other" {::set ValueSet 2;} } } "dufferin" { ::switch -glob -- $SubRegion { "mono" - "orangeville" {::set ValueSet 6;} "other" {::set ValueSet 7;} } } "durham" { ::switch -glob -- $SubRegion { "ajax" - "clarington" - "oshawa" - "pickering" - "uxbridge" - "whitby" {::set ValueSet 8;} "other" {::set ValueSet 9;} } } "london" { ::switch -glob -- $SubRegion { "middlesex*" - "city*" - "thames*" {::set ValueSet 22;} "other" {::set ValueSet 23;} } } "niagara" { ::switch -glob -- $SubRegion { "west*" {::set ValueSet 25;} "other" {::set ValueSet 26;} } } "peterborough" { ::switch -glob -- $SubRegion { "city*" {::set ValueSet 32;} "other" {::set ValueSet 33;} } } "prescott*" { ::switch -glob -- $SubRegion { "clarence*" - "town*" {::set ValueSet 34;} "other" {::set ValueSet 35;} } } "simcoe" { ::switch -glob -- $SubRegion { "barrie" {::set ValueSet 37;} "bradford" - "new*" {::set ValueSet 38;} "other" {::set ValueSet 39;} } } "st.thomas" { ::switch -glob -- $SubRegion { "southwold" - "city*" - "central*" {::set ValueSet 40;} "other" {::set ValueSet 41;} } } "waterloo" { ::switch -glob -- $SubRegion { "wellesley" - "wilmot" {::set ValueSet 44;} "other" {::set ValueSet 45;} } } "wellington" { ::switch -glob -- $SubRegion { "guelph" {::set ValueSet 46;} "other" {::set ValueSet 47;} } } "windsor" { ::switch -glob -- $SubRegion { "amherstburg" - "essex" - "lakeshore" - "lasalle" - "tecumseh" - "city*" {::set ValueSet 48;} "other" {::set ValueSet 49;} } } "cochrane" { ::switch -glob -- $SubRegion { "moosonee" {::set ValueSet 52;} "other" {::set ValueSet 53;} } } "kenora" { ::switch -glob -- $SubRegion { "lake*" - "sioux*" {::set ValueSet 54;} "other" {::set ValueSet 55;} } } "nipissing" { ::switch -glob -- $SubRegion { "papineau*" {::set ValueSet 57;} "other" {::set ValueSet 58;} } } "rainy*" { ::switch -glob -- $SubRegion { "chapple" - "dawson" - "morley" {::set ValueSet 60;} "other" {::set ValueSet 61;} } } "thunder*" { ::switch -glob -- $SubRegion { "conmee" - "gillies" - "neebing" - "o'connor" - "oliver*" - "shuniah" - "city*" {::set ValueSet 63;} "other" {::set ValueSet 64;} } } "greater*" {::set ValueSet 10;} "hamilton" {::set ValueSet 13;} "bruce" {::set ValueSet 3;} "chatham-kent" {::set ValueSet 4;} "cornwall" {::set ValueSet 5;} "grey" {::set ValueSet 11;} "hastings" {::set ValueSet 14;} "huron" {::set ValueSet 15;} "kawartha*" {::set ValueSet 16;} "kingston" {::set ValueSet 17;} "lambton" {::set ValueSet 18;} "lanark" {::set ValueSet 19;} "leeds*" {::set ValueSet 20;} "lennox*" {::set ValueSet 21;} "muskoka" {::set ValueSet 24;} "norfolk" {::set ValueSet 27;} "northumberland" {::set ValueSet 28;} "oxford" {::set ValueSet 30;} "renfrew" {::set ValueSet 36;} "stratford" {::set ValueSet 42;} "algoma" {::set ValueSet ;} "parry*" {::set ValueSet 59;} "sault*" {::set ValueSet 62;} "timiskaming" {::set ValueSet 65;} "halton" {::set ValueSet 12;} "peel" {::set ValueSet 31;} "toronto" {::set ValueSet 43;} "york" {::set ValueSet 50;} "ottawa" {::set ValueSet 29;} "manitoulin*" {::set ValueSet 56;} } ::return $ValueSet; } ::proc hil_number_of_bedrooms_get {RGIcalc} { #//::puts "pgq,debug...::QW::NEWVIEWS - moved from /TABLE/NOTES/PROCEDURE/NEWVIEWS/NPH_HOUSING_REPORTS"; ::switch -glob -- [::sargs::get $RGIcalc .rgi_calc_type] { "Section95" - "ILM" { ::set UnitLayout [::sargs::get $RGIcalc .utilities.heat.unit_layout]; ::switch -- $UnitLayout { "Apartment, Bachelor" { ::set Bedrooms "bachelor"; } "Apartment, 1 bedroom" - "Row House, 1 bedroom" - "Stacked, 1 bedroom" - "S.F. Detached (with basement), 1 bed" { ::set Bedrooms 1; } "Apartment, 2 bedrooms" - "Row House, 2 bedrooms" - "Stacked, 2 bedrooms" - "S.F. Detached (with basement), 2 beds" { ::set Bedrooms 2; } "Row House, 3 bedrooms" - "Apartment, 3 bedrooms" - "Stacked, 3 bedrooms" - "S.F. Detached (with basement), 3 beds" { ::set Bedrooms 3; } "Apartment, 4 bedrooms" - "Row House, 4 bedrooms" - "Row House, 5 bedrooms" - "Stacked, 4 bedrooms" - "Stacked, 5 bedrooms" - "S.F. Detached (with basement), 4 beds" - "S.F. Detached (with basement), 5 beds" - "S.F. Detached (with basement), 6 beds" { ::set Bedrooms 4; } } } "HSA" - default { ::set Bedrooms [::sargs::get $RGIcalc .utilities.bedrooms]; ::if {$Bedrooms eq "4+"} { ::set Bedrooms 4; } } } ::return $Bedrooms; } #//------------------------------------------------------------------------- ::proc interactive_row_number {sargs} { # NOT CALLED ::set Node [::sargs::get $sargs .node]; ::set Collection [::sargs::get $sargs .collection]; ::set Name [::sargs::get $sargs .name]; # NOTICE - .index/interactive is assumed ::set Row 1; ::foreach Master [[$Node $Collection.index/interactive] odb_masters ".order_is_kept 1"] { ::if {[[$Master .name] odb_get] eq $Name} { ::break; } ::incr Row; } ::return [::sargs .row $Row .master $Master]; } #nv2.27.1 (new feature) - root journal transaction closure all posting columns /* { ::proc transaction_posting_field_value_get {sargs} { #//::puts "pgq,debug::QW::NEWVIEWS transaction_posting_field_value_get enter s_args==(\[::sargs::format .structure $s_args]\n)"; ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { ::return ""; } #//::puts "pgq,debug::QW::NEWVIEWS transaction_posting_field_value_get Transaction==[$Transaction odb_path]"; ::set Transaction [$Transaction odb_master]; ::set Ppath [::sargs::get $sargs .posting_path]; ::set Fname [::sargs::get $sargs .field_name]; ::switch $Ppath { .posting/debit/charge - .posting/debit/tax1 - .posting/debit/tax2 { ::if {[::string first /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PURCHASE [$Transaction odb_path]]!=0} { ::return ""; } } .posting/debit/customer - .posting/debit/cgs - .posting/credit/inventory - .posting/credit/charge - .posting/credit/tax1 - .posting/credit/tax2 { ::if {[::string first /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/SALES [$Transaction odb_path]]!=0} { ::return ""; } } } ::if {$Transaction eq ""} { ::return ""; } ::set Account [[$Transaction $Ppath.account] odb_get]; ::if {![::sargs::boolean_get $sargs .include_no_account_amounts]&&$Account eq ""} { ::return ""; } ::switch $Fname { .amount { ::set Amount [[$Transaction $Ppath$Fname] odb_get]; ::if {[::sargs::boolean_get $sargs .include_no_account_amounts]&&$Amount==0.0} { ::return ""; } ::if {[[$Transaction $Ppath] odb_super_find_by_id /credit] ne ""} { ::qw::number::var::negative Amount; } ::return [::qw::number::format $Amount $::qw::number::formats(dollar_minus_parentheses)]; } .account { ::if {$Account eq ""} { ::return ""; } ::return [::QW::GUI::NEWVIEWS::odb_path_help_format [::sargs .object [$Account odb_master] .format short_lower_case_folder]]; } } ::return "error"; } */} #nv2.27.1 (new feature) - root journal transaction closure all posting columns #nv2.32.0 (print_journal_transactions) - ::QW::NEWVIEWS::transaction_posting_field_value_get - updated for more info about accounts posted to ::proc transaction_posting_field_value_get {sargs} { #//::puts "pgq,debug2315::QW::NEWVIEWS transaction_posting_field_value_get enter sargs==(\n[::sargs::format .structure $sargs]\n)"; #::qw::stack_dump; ;#//pgq,debug /* { /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION .posting /debit /credit /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PURCHASE .posting /debit /charge /tax1 /tax2 /credit /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/SALES .posting /debit /customer /cgs /credit /inventory /charge /tax1 /tax2 */} ::set Transaction [::sargs::get $sargs .transaction]; ::if {$Transaction eq ""} { ::return ""; } #//::puts "pgq,debug2315::QW::NEWVIEWS transaction_posting_field_value_get Transaction==[$Transaction odb_path]"; ::set Transaction [$Transaction odb_master]; ::set Ppath [::sargs::get $sargs .posting_path]; ::set Fname [::sargs::get $sargs .field_name]; ::switch $Ppath { .posting/debit/charge - .posting/debit/tax1 - .posting/debit/tax2 { ::if {[::string first /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PURCHASE [$Transaction odb_path]]!=0} { ::return ""; } } .posting/debit/customer - .posting/debit/cgs - .posting/credit/inventory - .posting/credit/charge - .posting/credit/tax1 - .posting/credit/tax2 { ::if {[::string first /OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/SALES [$Transaction odb_path]]!=0} { ::return ""; } } } ::set Account [[$Transaction $Ppath.account] odb_get]; #//::puts "pgq,debug2315::QW::NEWVIEWS transaction_posting_field_value_get Account==[::expr {$Account eq ""?{}:[$Account odb_path_help]}]"; ::if {![::sargs::boolean_get $sargs .include_no_account_amounts]&&$Account eq ""} { ::return ""; } ::switch $Fname { .quantity - .amount { ::set Amount [[$Transaction $Ppath$Fname] odb_get]; #//::puts "pgq,debug2315::QW::NEWVIEWS transaction_posting_field_value_get odb_get Amount==$Amount qw_get Amount==[[$Transaction $Ppath$Fname] qw_get]"; ::if {[::sargs::boolean_get $sargs .include_no_account_amounts]&&$Amount==0.0} { ::return ""; } ::if {[[$Transaction $Ppath] odb_super_find_by_id /credit] ne ""} { ::qw::number::var::negative Amount; } #//::puts "pgq,debug2315::QW::NEWVIEWS transaction_posting_field_value_get ::return Amount==[::qw::number::format $Amount $::qw::number::formats(dollar_minus_parentheses)]"; ::return [::qw::number::format $Amount $::qw::number::formats(dollar_minus_parentheses)]; } .rate { #_pgq,debug2315 - calc a tax rate? ::if {[[$Transaction .journal] qw_get] ne ""&&[[[$Transaction .odb_deriveds] odb_primary] odb_items]} { #// a header with items ::return ""; } ::set Amount [[$Transaction $Ppath$Fname] odb_get]; #::if {[[$Transaction $Ppath.amount] odb_get]==0.0} {} #::if {[::QW::NEWVIEWS::transaction_posting_field_value_get [::sargs::set $sargs .field_name .amount]] eq ""} {} ::if {[::sargs::boolean_get $sargs .include_no_account_amounts]&&$Amount==0.0} { ::return ""; } ::return [::qw::number::format $Amount $::qw::number::formats(dollar_minus_parentheses)]; #::return [::qw::number::format $Amount $::qw::number::formats(rate_minus_parentheses)]; } .account { ::if {$Account eq ""} { ::return ""; } ::return [::QW::GUI::NEWVIEWS::odb_path_help_format [::sargs .object [$Account odb_master] .format short_lower_case_folder]]; } .aname { ::if {$Account eq ""} { ::return ""; } ::return [[[$Account odb_master] .name] odb_get]; } .adesc { ::if {$Account eq ""} { ::return ""; } ::return [[[$Account odb_master] .description] odb_get]; } } ::return "error"; } #//------------------------------------------------------------------------- #nv2.32.0 (print_journal_transactions) - ::QW::NEWVIEWS::print_journal_transactions_settings_prompt_defaults - populate .settings_prompt #_pgq,debug2315 - .template - blank_small_margins is ignored ::proc print_journal_transactions_settings_prompt_defaults {sargs} { #//::puts "pgq,debug2315::proc print_journal_transactions_settings_prompt_defaults sargs==(\n[::sargs::format .structure $sargs]\n)"; ::set Database [::sargs::get $sargs .database]; ::foreach Path {/prtjournals /prtjournals_transaction} { ::switch $Path { /prtjournals { ::set Template { .tag financial .range_begin {} .range_end {} .include_empty_accounts yes .account_title_1 {|%_name - %_description} .account_title_2 {|%_begin - %_end} .account_title_3 {} .account_title_4 {} .account_separator none .destination display .filename {} .printer {} .fit_to_pages_wide 1 .scaling {} .orientation landscape .template {} } ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Template .range_begin "${Year}0101" ::sargs::var::set Template .range_end "${Year}1231" } /prtjournals_transaction { ::set Template { .account_title_1 {|%_name - %_description} .account_title_2 {} .account_title_3 {} .account_title_4 {} .destination display .filename {} .printer {} .fit_to_pages_wide 1 .scaling {} .orientation landscape .template {} } } } ::sargs::var::set Result ${Path}/default.values [::sargs::set $Template .column_names {/journal/odb_path_help /date /reference /description}] ${Path}/default.name {*** Default Settings ***}; ::set Sublist [::list]; #//------------------------------------------------------------------------- ::lappend Sublist {Bank / General / Payroll - Small} ::lappend Sublist { /journal/name /date /reference /description /posting/debit/amount /posting/debit/account/name /posting/debit/account/description /posting/credit/amount /posting/credit/account/name /posting/credit/account/description } ::lappend Sublist {Bank / General / Payroll - Medium} ::lappend Sublist { /journal/odb_path_help /date /reference /description /posting/debit/amount /posting/debit/account/odb_path_help /posting/debit/account/description /posting/credit/amount /posting/credit/account/odb_path_help /posting/credit/account/description } ::lappend Sublist {Bank / General / Payroll - Large} ::lappend Sublist { /journal/odb_path_help /journal/description /date /reference /description /posting/debit/quantity /posting/debit/rate /posting/debit/amount /posting/debit/account/odb_path_help /posting/debit/account/description /posting/credit/quantity /posting/credit/rate /posting/credit/amount /posting/credit/account/odb_path_help /posting/credit/account/description } ::lappend Sublist {Purchases - Small} ::lappend Sublist { /journal/name /date /reference /description /posting/debit/charge/amount /posting/debit/charge/account/name /posting/debit/charge/account/description /posting/debit/tax1/amount /posting/debit/tax2/amount /posting/credit/amount /posting/credit/account/name /posting/credit/account/description } ::lappend Sublist {Purchases - Medium} ::lappend Sublist { /journal/name /journal/description /date /reference /description /posting/debit/charge/amount /posting/debit/charge/account/name /posting/debit/charge/account/description /posting/debit/tax1/amount /posting/debit/tax2/amount /posting/credit/amount /posting/credit/account/name /posting/credit/account/description } ::lappend Sublist {Purchases - Large} ::lappend Sublist { /journal/name /journal/description /date /reference /description /posting/debit/quantity /posting/debit/charge/rate /posting/debit/charge/amount /posting/debit/charge/account/odb_path_help /posting/debit/charge/account/description /posting/debit/tax1/amount /posting/debit/tax1/account/name /posting/debit/tax2/amount /posting/debit/tax2/account/name /posting/credit/amount /posting/credit/account/name /posting/credit/account/description } ::lappend Sublist {Sales - Small} ::lappend Sublist { /journal/name /date /reference /description /posting/debit/customer/amount /posting/debit/customer/account/name /posting/debit/customer/account/description /posting/credit/charge/amount /posting/credit/charge/account/name /posting/credit/charge/account/description /posting/credit/tax1/amount } ::lappend Sublist {Sales - Medium} ::lappend Sublist { /journal/name /journal/description /date /reference /description /posting/debit/customer/amount /posting/debit/customer/account/odb_path_help /posting/debit/customer/account/description /posting/credit/charge/amount /posting/credit/charge/account/odb_path_help /posting/credit/charge/account/description /posting/credit/tax1/amount /posting/credit/tax2/amount } ::lappend Sublist {Sales - Large} ::lappend Sublist { /journal/name /journal/description /date /reference /description /posting/debit/customer/amount /posting/debit/customer/account/odb_path_help /posting/debit/customer/account/description /posting/credit/charge/quantity /posting/credit/charge/rate /posting/credit/charge/amount /posting/credit/charge/account/odb_path_help /posting/credit/charge/account/description /posting/credit/tax1/amount /posting/credit/tax1/account/name /posting/credit/tax2/amount /posting/credit/tax2/account/name } ::lappend Sublist {Sales - XL} ::lappend Sublist { /journal/name /journal/description /date /reference /description /posting/debit/customer/amount /posting/debit/customer/account/odb_path_help /posting/debit/customer/account/description /posting/credit/charge/quantity /posting/credit/charge/rate /posting/credit/charge/amount /posting/credit/charge/account/odb_path_help /posting/credit/charge/account/description /posting/credit/tax1/amount /posting/credit/tax1/account/name /posting/credit/tax2/amount /posting/credit/tax2/account/name /posting/debit/cgs/amount /posting/debit/cgs/account/odb_path_help /posting/debit/cgs/account/description /posting/credit/inventory/amount /posting/credit/inventory/account/odb_path_help /posting/credit/inventory/account/description } ::lappend Sublist {Root - Small} ::lappend Sublist { /journal/name /date /reference /description /posting/debit/amount /posting/debit/account/name /posting/debit/account/description /posting/credit/amount /posting/credit/account/name /posting/credit/account/description } ::lappend Sublist {Root - Medium} ::lappend Sublist { /journal/name /date /reference /description /posting/debit/amount /posting/debit/account/name /posting/debit/account/description /posting/debit/charge/amount /posting/debit/charge/account/name /posting/debit/charge/account/description /posting/debit/tax1/amount /posting/debit/tax1/account/name /posting/credit/amount /posting/credit/account/name /posting/credit/account/description /posting/credit/charge/amount /posting/credit/charge/account/name /posting/credit/charge/account/description /posting/credit/tax1/amount /posting/credit/tax2/account/name } ::lappend Sublist {Root - Large} ::lappend Sublist { /journal/odb_path_help /journal/description /date /reference /description /posting/debit/amount /posting/debit/account/odb_path_help /posting/debit/account/description /posting/debit/charge/amount /posting/debit/charge/account/odb_path_help /posting/debit/charge/account/description /posting/debit/customer/account/name /posting/debit/customer/account/description /posting/debit/tax1/amount /posting/debit/tax1/account/name /posting/credit/amount /posting/credit/account/odb_path_help /posting/credit/account/description /posting/credit/charge/amount /posting/credit/charge/account/odb_path_help /posting/credit/charge/account/description /posting/credit/tax1/amount /posting/credit/tax1/account/name } ::lappend Sublist {Root - XL} ::lappend Sublist { /journal/odb_path_help /journal/description /date /reference /description /posting/debit/amount /posting/debit/account/odb_path_help /posting/debit/account/description /posting/debit/charge/amount /posting/debit/charge/account/odb_path_help /posting/debit/charge/account/description /posting/debit/cgs/amount /posting/debit/cgs/account/odb_path_help /posting/debit/cgs/account/description /posting/debit/customer/account/name /posting/debit/customer/account/description /posting/debit/tax1/amount /posting/debit/tax1/account/name /posting/debit/tax2/amount /posting/debit/tax2/account/name /posting/credit/amount /posting/credit/account/odb_path_help /posting/credit/account/description /posting/credit/charge/amount /posting/credit/charge/account/odb_path_help /posting/credit/charge/account/description /posting/credit/inventory/amount /posting/credit/inventory/account/odb_path_help /posting/credit/inventory/account/description /posting/credit/tax1/amount /posting/credit/tax1/account/name /posting/credit/tax2/amount /posting/credit/tax2/account/name } #//------------------------------------------------------------------------- ::foreach {Name Clist} $Sublist { #::set NewSub "/[$Master odb_id_factory]"; ::set NewSub "/[$Database cpp_odb_id_factory]"; #//::puts "pgq,debug2315::proc print_journal_transactions_settings_prompt_defaults NewSub==$NewSub"; #::sargs::var::set Result .unique_id [[odb_database] cpp_odb_id_factory]; ::sargs::var::set Result $Path$NewSub.values $Template; ::sargs::var::set Result $Path$NewSub.values.column_names $Clist; ::sargs::var::set Result $Path$NewSub.name $Name; } } #//::puts "pgq,debug2315.../OBJECT/NEWVIEWS/SYSTEM/TRANSACTION install Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } #//------------------------------------------------------------------------- #nv2.25.3a (new feature) - print_checks audit record foreach check printed ::proc audit_print_check {sargs} { #//::puts "pgq,debug::QW::NEWVIEWS::audit_print_check enter sargs==(\n[::sargs::format .structure $sargs]\n)"; ::set Transaction [::sargs::get $sargs .transaction]; ::set AuditRecord ""; #nv2.28.0 (new feature) - audit eft payments/deposits - just like audit_print_check #::sargs::var::set AuditRecord .operation print_check; ::set Operation [::sargs::get $sargs .operation]; ::if {$Operation eq ""} { ::set Operation "print_check"; } ::sargs::var::set AuditRecord .operation $Operation; #// #::sargs::var::set AuditRecord .address [[observer_database] odb_master]; #::sargs::var::set AuditRecord .path [[[observer_database] odb_master] odb_path]; ::sargs::var::set AuditRecord .address $Transaction; ::sargs::var::set AuditRecord .path [$Transaction odb_path]; #//::sargs::var::set AuditRecord .record.transaction_date [::qw::date::format [[$Transaction .date] odb_get] $::qw::date::formats(yyyy-mm-dd)]; ::sargs::var::set AuditRecord .record.transaction_date [::qw::date::format [[$Transaction .date] odb_get] {%Y%b%d}]; ::sargs::var::set AuditRecord .record.transaction_reference [[$Transaction .reference] odb_get]; ::sargs::var::set AuditRecord .record.transaction_amount \ [::qw::number::format [::qw::number::negative [[$Transaction .posting/credit.amount] odb_get]] $::qw::number::formats(dollar_minus_parentheses)]; # we really need the address source #::sargs::var::set AuditRecord .record.transaction_debit_account \ "[::expr {[[$Transaction .posting/debit.account] odb_get] eq ""?{}:[[[$Transaction .posting/debit.account] odb_get] odb_path_help]}]"; #// ::sargs::var::set AuditRecord .record.transaction_address_source \ "[::expr {[::sargs::get $sargs .address_source] eq ""?{}:[[::sargs::get $sargs .address_source] odb_path_help]}]"; ::sargs::var::set AuditRecord .record.transaction_payee_description \ "[::expr {[::sargs::get $sargs .address_source] eq ""?{}:[[[::sargs::get $sargs .address_source] .description] odb_get]}]"; #nv2.38.0 (behaviour change) - TODO - ::QW::NEWVIEWS::audit_print_check - when the payee has no /address/company filled in we use the payee account's .description - unless empty! - then we print the .description of the transaction /* { ::set Path ""; ::if {[::sargs::get $sargs .address_source] ne ""} { ::set Path [::QW::GUI::NEWVIEWS::odb_path_help_format [::sargs .object [::sargs::get $sargs .address_source] .format short_lower_case_folder]]; } ::sargs::var::set AuditRecord .record.transaction_address_source $Path; */} #// #::sargs::var::set AuditRecord .record.location_performed [[[observer_database] odb_master] odb_path_readable]; #::sargs::var::set AuditRecord .record.details "to be provided? - waste of disk space to duplicate payment transaction info"; #// ::set AuditObject [[$Transaction odb_database] cpp_audit_record_create $AuditRecord]; /* { ::set Notes ""; ::foreach Bank [::qw::_structure::names $_transfer_data] { #//::puts "wip_eft_transfer eft_file_create Bank==$Bank"; ::if {[::sargs::get $_transfer_data "$Bank.summary.detail_item_count"]==0} { ::continue; } ::append Notes [::sargs::get $_transfer_data "$Bank.bank_name"]; ::append Notes " "; ::append Notes [::sargs::get $_transfer_data "$Bank.bank_description"]; ::append Notes " File:\n"; ::append Notes [::sargs::get $_transfer_data "$Bank.file"]; ::append Notes "\n"; } [$Master .notes] odb_set $Notes; */} ::return $AuditObject; } #nv2.22.0 (nvreport) /* { ¤ Generic Currency Symbol $ Dollar Sign ¢ Cent Sign £ Pound Sterling ¥ Yen Symbol ₣ Franc Sign ₤ Lira Symbol ₧ Peseta Sign € Euro Symbol % Percent ‰ Per Million */} ::proc currency_symbol_abbreviation_and_name_list {} { ::return { {¤} {Generic Currency Symbol} {$} {Dollar Sign} {¢} {Cent Sign} {£} {Pound Sterling} {¥} {Yen Symbol} {₣} {Franc Sign} {₤} {Lira Symbol} {₧} {Peseta Sign} {€} {Euro Symbol} {%} {Percent} {‰} {Per Million} }; } ::proc currency_symbol_abbreviation_and_name_pick_list {} { ::set Result ""; ::foreach {Abbreviation Name} [::QW::NEWVIEWS::currency_symbol_abbreviation_and_name_list] { ::lappend Result "$Abbreviation $Name"; } ::return $Result; } ::proc currency_type_abbreviation_and_name_list {} { ::return { {AUD} {Australian Dollar (AUD)} {CAD} {Canadian Dollar (CAD)} {CHF} {Swiss Franc (CHF)} {EUR} {Euro (EUR)} {GBP} {British Pound (GBP)} {HKD} {Hong Kong Dollar (HKD)} {JPY} {Japanese Yen (JPY)} {MXN} {Mexican Peso (MXN)} {NZD} {New Zealand Dollar (NZD)} {SEK} {Swedish Krona (SEK)} {USD} {U.S. Dollar (USD)} }; } ::proc currency_type_abbreviation_and_name_pick_list {} { ::set Result ""; ::foreach {Abbreviation Name} [::QW::NEWVIEWS::currency_type_abbreviation_and_name_list] { ::lappend Result "$Abbreviation $Name"; } ::return $Result; } /* { {AED} {UAE Dirham (AED)} {AFA} {Afghanistan Afghani (AFA)} {ALL} {Albanian Lek (ALL)} {ANG} {Neth Antilles Guilder (ANG)} {ARS} {Argentine Peso (ARS)} {AUD} {Australian Dollar (AUD)} {AWG} {Aruba Florin (AWG)} {BBD} {Barbados Dollar (BBD)} {BDT} {Bangladesh Taka (BDT)} {BGN} {Bulgarian Lev (BGN)} {BHD} {Bahraini Dinar (BHD)} {BIF} {Burundi Franc (BIF)} {BMD} {Bermuda Dollar (BMD)} {BND} {Brunei Dollar (BND)} {BOB} {Bolivian Boliviano (BOB)} {BRL} {Brazilian Real (BRL)} {BSD} {Bahamian Dollar (BSD)} {BTN} {Bhutan Ngultrum (BTN)} {BWP} {Botswana Pula (BWP)} {BYR} {Belarus Ruble (BYR)} {BZD} {Belize Dollar (BZD)} {CAD} {Canadian Dollar (CAD)} {CHF} {Swiss Franc (CHF)} {CLP} {Chilean Peso (CLP)} {CNY} {Chinese Yuan (CNY)} {COP} {Colombian Peso (COP)} {CRC} {Costa Rica Colon (CRC)} {CUP} {Cuban Peso (CUP)} {CVE} {Cape Verde Escudo (CVE)} {CYP} {Cyprus Pound (CYP)} {CZK} {Czech Koruna (CZK)} {DJF} {Dijibouti Franc (DJF)} {DKK} {Danish Krone (DKK)} {DOP} {Dominican Peso (DOP)} {DZD} {Algerian Dinar (DZD)} {ECS} {Ecuador Sucre (ECS)} {EEK} {Estonian Kroon (EEK)} {EGP} {Egyptian Pound (EGP)} {ERN} {Eritrea Nakfa (ERN)} {ETB} {Ethiopian Birr (ETB)} {EUR} {Euro (EUR)} {FJD} {Fiji Dollar (FJD)} {FKP} {Falkland Islands Pound (FKP)} {GBP} {British Pound (GBP)} {GHC} {Ghanian Cedi (GHC)} {GIP} {Gibraltar Pound (GIP)} {GMD} {Gambian Dalasi (GMD)} {GNF} {Guinea Franc (GNF)} {GTQ} {Guatemala Quetzal (GTQ)} {GYD} {Guyana Dollar (GYD)} {HKD} {Hong Kong Dollar (HKD)} {HNL} {Honduras Lempira (HNL)} {HRK} {Croatian Kuna (HRK)} {HTG} {Haiti Gourde (HTG)} {HUF} {Hungarian Forint (HUF)} {IDR} {Indonesian Rupiah (IDR)} {ILS} {Israeli Shekel (ILS)} {INR} {Indian Rupee (INR)} {IQD} {Iraqi Dinar (IQD)} {IRR} {Iran Rial (IRR)} {ISK} {Iceland Krona (ISK)} {JMD} {Jamaican Dollar (JMD)} {JOD} {Jordanian Dinar (JOD)} {JPY} {Japanese Yen (JPY)} {KES} {Kenyan Shilling (KES)} {KHR} {Cambodia Riel (KHR)} {KMF} {Comoros Franc (KMF)} {KPW} {North Korean Won (KPW)} {KRW} {Korean Won (KRW)} {KWD} {Kuwaiti Dinar (KWD)} {KYD} {Cayman Islands Dollar (KYD)} {KZT} {Kazakhstan Tenge (KZT)} {LAK} {Lao Kip (LAK)} {LBP} {Lebanese Pound (LBP)} {LKR} {Sri Lanka Rupee (LKR)} {LRD} {Liberian Dollar (LRD)} {LSL} {Lesotho Loti (LSL)} {LTL} {Lithuanian Lita (LTL)} {LVL} {Latvian Lat (LVL)} {LYD} {Libyan Dinar (LYD)} {MAD} {Moroccan Dirham (MAD)} {MDL} {Moldovan Leu (MDL)} {MGF} {Malagasy Franc (MGF)} {MKD} {Macedonian Denar (MKD)} {MMK} {Myanmar Kyat (MMK)} {MNT} {Mongolian Tugrik (MNT)} {MOP} {Macau Pataca (MOP)} {MRO} {Mauritania Ougulya (MRO)} {MTL} {Maltese Lira (MTL)} {MUR} {Mauritius Rupee (MUR)} {MVR} {Maldives Rufiyaa (MVR)} {MWK} {Malawi Kwacha (MWK)} {MXN} {Mexican Peso (MXN)} {MYR} {Malaysian Ringgit (MYR)} {MZM} {Mozambique Metical (MZM)} {NAD} {Namibian Dollar (NAD)} {NGN} {Nigerian Naira (NGN)} {NIO} {Nicaragua Cordoba (NIO)} {NOK} {Norwegian Krone (NOK)} {NPR} {Nepalese Rupee (NPR)} {NZD} {New Zealand Dollar (NZD)} {OMR} {Omani Rial (OMR)} {PAB} {Panama Balboa (PAB)} {PEN} {Peruvian Nuevo Sol (PEN)} {PGK} {Papua New Guinea Kina (PGK)} {PHP} {Philippine Peso (PHP)} {PKR} {Pakistani Rupee (PKR)} {PLN} {Polish Zloty (PLN)} {PYG} {Paraguayan Guarani (PYG)} {QAR} {Qatar Rial (QAR)} {ROL} {Romanian Leu (ROL)} {RUB} {Russian Rouble (RUB)} {RWF} {Rwanda Franc (RWF)} {SAR} {Saudi Arabian Riyal (SAR)} {SBD} {Solomon Islands Dollar (SBD)} {SCR} {Seychelles Rupee (SCR)} {SDD} {Sudanese Dinar (SDD)} {SEK} {Swedish Krona (SEK)} {SGD} {Singapore Dollar (SGD)} {SHP} {St Helena Pound (SHP)} {SIT} {Slovenian Tolar (SIT)} {SKK} {Slovak Koruna (SKK)} {SLL} {Sierra Leone Leone (SLL)} {SOS} {Somali Shilling (SOS)} {SRG} {Surinam Guilder (SRG)} {STD} {Sao Tome Dobra (STD)} {SVC} {El Salvador Colon (SVC)} {SYP} {Syrian Pound (SYP)} {SZL} {Swaziland Lilageni (SZL)} {THB} {Thai Baht (THB)} {TND} {Tunisian Dinar (TND)} {TOP} {Tonga Pa'anga (TOP)} {TRL} {Turkish Lira (TRL)} {TTD} {Trinidad & Tobago Dollar (TTD)} {TWD} {Taiwan Dollar (TWD)} {TZS} {Tanzanian Shilling (TZS)} {UAH} {Ukraine Hryvnia (UAH)} {UGX} {Ugandan Shilling (UGX)} {USD} {U.S. Dollar (USD)} {UYU} {Uruguayan New Peso (UYU)} {VEB} {Venezuelan Bolivar (VEB)} {VND} {Vietnam Dong (VND)} {VUV} {Vanuatu Vatu (VUV)} {WST} {Samoa Tala (WST)} {XAF} {CFA Franc (BEAC) (XAF)} {XAG} {Silver Ounces (XAG)} {XAU} {Gold Ounces (XAU)} {XCD} {East Caribbean Dollar (XCD)} {XOF} {CFA Franc (BCEAO) (XOF)} {XPD} {Palladium Ounces (XPD)} {XPF} {Pacific Franc (XPF)} {XPT} {Platinum Ounces (XPT)} {YER} {Yemen Riyal (YER)} {YUM} {Yugoslav Dinar (YUM)} {ZAR} {South African Rand (ZAR)} {ZMK} {Zambian Kwacha (ZMK)} {ZWD} {Zimbabwe Dollar (ZWD)} */} # MOVE TO ::QW::GUI::NEWVIEWS #nv2.22.0 (moved to here - 20 copies in version convert scripts) # ------------------------------------------------------------------------------ ::proc recursive_list {Master} { ::set References ""; ::set Index [[$Master ".odb_deriveds"] odb_primary]; ::for {::set Ref [$Index odb_first];} {$Ref ne ""} {::set Ref [$Index odb_next $Ref];} { ::lappend References $Ref; ::if {[[[$Ref odb_master] ".odb_deriveds"] odb_items]} { ::set References [::concat $References [recursive_list [$Ref odb_master]]]; } } #//::puts "recursive_list returning References==$References"; ::return $References; } # ------------------------------------------------------------------------------ ::proc recursive_list_low_level {args} { ::qw::s_args_marshal; #::set Parent [::sargs::get $s_args .parent]; ::set Window [::sargs::get $s_args ".odb.object"]; ::set Database [$Window odb_database]; ::set Root [::sargs::get $s_args ".odb.root"] #//::puts "...recusive_list_low_level enter Root==$Root"; ::set OS [$Database cpp_object_structure_load .address $Root]; ::set ObjectId [::sargs::get $OS .system.object_id]; ::set ClassPath [::sargs::get $OS .system.class_path]; ::set Masters [$Database cpp_file_odb_masters \ .path /odb/index$ClassPath.odb_deriveds.index/id \ .range.begin [::list string $ObjectId] \ .range.end [::list string $ObjectId] \ ]; ::foreach Guy $Masters { ::set Masters [::concat $Masters [recursive_list_low_level [::sargs::set $s_args .odb.root $Guy]]]; } #//::puts "...recursive_list returning Masters==$Masters"; ::return $Masters; } # ------------------------------------------------------------------------------ ::proc set_help_id {Manager HelpId WindowPath} { ::set Master [$Manager $WindowPath]; ::if {[$Master odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE"]]} { ::sargs::var::set HelpDef ".help.help_id" $HelpId; ::set ColumnDefinitions [[$Master ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $HelpDef]; [$Master ".column_definitions"] qw_set $ColumnDefinitions; commit $Master; ::return; } ::if {[$Master odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/TEXT"]]} { ::sargs::var::set HelpDef "/menu.help.help_id" $HelpId; ::set Menu [[$Master ".menu"] qw_get]; ::set Menu [::sargs::var::+= Menu $HelpDef]; [$Master ".menu"] qw_set $Menu; } ::if {[$Master odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/TREE/ITCLNODES/MENU"]]} { ::sargs::var::set HelpDef "/menu.help.help_id" $HelpId; ::set Menu [[$Master ".menu"] qw_get]; ::set Menu [::sargs::var::+= Menu $HelpDef]; [$Master ".menu"] qw_set $Menu; } } } ::namespace eval ::QW::NEWVIEWS::PAYROLL {} ::namespace eval ::QW::NEWVIEWS::PAYROLL::CANADA { ::proc cra_business_number_is_valid {Value} { /* { ::puts "field_validate Value==$Value"; ::puts "field_validate ::string is digit ::string range $Value 0 8==[::string is digit [::string range $Value 0 8]]"; ::puts "field_validate range 9 10 ==[::string range $Value 9 10]"; ::puts "field_validate ::regsub -all==[::regsub -all {([A-Z])} [::string range $Value 9 10] {}]"; ::puts "field_validate ::string is digit ::string range $Value 11 end==[::string is digit [::string range $Value 11 end]]"; field_validate Value==123456789RC1234 field_validate ::string is digit ::string range 123456789RC1234 0 8==1 field_validate range 9 10 ==RC field_validate ::regsub -all==C field_validate ::string is digit ::string range 123456789RC1234 11 end==1 */} ::if {$Value ne "" \ &&([::string length $Value]!=15 \ ||![::string is digit [::string range $Value 0 8]] \ ||[::regsub -all {([A-Z])} [::string range $Value 9 10] ""] ne "" \ ||![::string is digit [::string range $Value 11 end]] \ ) } { ::return 0; } ::return 1; } ::proc cra_setup_address_printable {s_args} { /* { .filers_street 3 .filers_street2 4 .filers_city 5 .filers_state 6 .filers_country 7 .filers_zipcode 8 */} ::set Result ""; ::if {[::sargs::get $s_args .filers_street] ne ""} {::append Result "[::sargs::get $s_args .filers_street]\n";} ::if {[::sargs::get $s_args .filers_street2] ne ""} {::append Result "[::sargs::get $s_args .filers_street2]\n";} ::if {[::sargs::get $s_args .filers_city] ne ""} {::append Result "[::sargs::get $s_args .filers_city]";} ::if {[::sargs::get $s_args .filers_state] ne ""} {::append Result " [::sargs::get $s_args .filers_state]";} ::if {[::sargs::get $s_args .filers_zipcode] ne ""} {::append Result " [::sargs::get $s_args .filers_zipcode]";} ::set Result [::string trim $Result]; ::return $Result; } ::proc social_insurance_number_is_valid {Src} { #// ------------------------------------------------------------ #// S.I.N. Validation #// ------------------------------------------------------------ #// #// A SIN has nine digits. #// The first eight digits is the basic 'number'. #// The ninth digit is a check digit. #// Verification method: #// #// Example SIN: 193-456-787. #// #// Basic number: 193 456 78 Check digit: 7 #// Make a number from each alternate position to the left beginning at the second digit #// 9 4 6 8 #// Add the numbers to themselves #// 9 4 6 8 #// 9 4 6 8 #// 18 8 12 16 #// Cross-add the digits in the sum #// (1 + 8 + 8 + 1 + 2 + 1 + 6) = 27 #// Add each alternate digit beginning at the first digit #// (1 + 3 + 5 + 7) = 16 #// Sum the two results: 27 + 16 = 43 #// If the total is a multiple of 10 #// the check digit should be 0 #// else #// Subtract the total (43) from the next highest number ending in zero (50) #// The check digit is (50 - 43) = 7 #// #// Social Insurance Numbers that do not pass the validation check: #// If the SIN provided by an individual does not pass the verification check, the preparer should #// confirm the SIN with the employer who received the original number. #// If you are unable to obtain the correct number for the employee, please do NOT leave the #// SIN field on the [T4] information slip blank. #// Instead, report the SIN that was provided, even if it is not a valid number. #// Frequently, even an incorrect number will enable us to find a match so that we can correct #// the record and ensure the employee receives proper credit for the deductions. #// #// Validating the Business Number (BN) #// The Business Number is a nine digit registration number, for example: 12345 6782 RP0001. #// You can check the validity of the registration part of the Business Number by using the same #// standard formula used for the Social Insurance Number. #// For validation purposes, use only the first nine digits of the Business Number. #// ::set Src [::regsub -all \[^0-9\] $Src ""]; ::if {[string length $Src]!=9} {::return 0;} ::if {![::string is digit $Src]} {::return 0;} #// Split the number into component digit. ::foreach {Digit0 Digit1 Digit2 Digit3 Digit4 Digit5 Digit6 Digit7 Digit8} [::split $Src ""] {}; #// Make a number from each alternate position to the left beginning at the second digit #// Add the numbers to themselves ::set Sum1x ""; ::append Sum1x [::expr ($Digit1*2)]; ::append Sum1x [::expr ($Digit3*2)]; ::append Sum1x [::expr ($Digit5*2)]; ::append Sum1x [::expr ($Digit7*2)]; ::set Sum1 [::expr [::join [::split $Sum1x ""] +]]; #// Cross-add the digits in the sum ::set Sum2 [::expr $Digit0+$Digit2+$Digit4+$Digit6]; #// Add each alternate digit beginning at the first digit ::set Sum [::expr $Sum1+$Sum2]; #// Sum the two results #// If the total is a multiple of 10 #// the check digit should be 0 #// else #// Subtract the total (43) from the next highest number ending in zero (50) #// The check digit is (50 - 43) = 7 ::set CheckDigit [::expr int(10-fmod($Sum,10))]; ::if {$CheckDigit==10} {::set CheckDigit 0;} ::if {$CheckDigit!=$Digit8} {::return 0;} ::return 1; } ::proc social_insurance_number_format {Src {Separator " "}} { ::if {$Src eq ""} { ::return ""; } ::set Src [::regsub -all {([^0-9])} $Src ""]; ::return "[::string range $Src 0 2]$Separator[::string range $Src 3 5]$Separator[::string range $Src 6 8]"; } ::proc t5_box_number_and_description_list {} { /* {calculated {11} {Taxable amount of dividends other than eligible dividends} {12} {Dividend tax credit for dividends other than eligible dividends} {25} {Taxable amount of eligible dividends} {26} {Dividend tax credit for eligible dividends} */} #nv2.31.5 (t5) - t5_box_number_and_description_list - added box 30 {Equity Linked Notes Interest} #nv2.38.3 (t5) - ::QW::NEWVIEWS::PAYROLL::CANADA::t5_box_number_and_description_list - added box 34 {Capital gains dividends - 01/01/2024 to 06/24/2024} /* { There is one new T5 Box for 2025. Here are the details: New Capital Gains Box: Capital gains dividends - 01/01/2024 to 06/24/2024 - Capital Gain 2024 Period One Dividend Amount - 11 numeric - T5 slip box 34 */} ::return { {10} {Actual amount of dividends other than eligible dividends} {13} {Interest from Canadian sources} {14} {Other income from Canadian sources} {15} {Foreign income} {16} {Foreign tax paid} {17} {Royalties from Canadian sources} {18} {Capital gains dividends} {19} {Accrued income - annuities} {20} {Amount eligible for resource allowance deduction} {24} {Actual amount of eligible dividends} {30} {Equity Linked Notes Interest} {34} {Capital gains dividends - 01/01/2024 to 06/24/2024} {40} {Capital gains dividends Period 1} {41} {Capital gains dividends Period 2} } } ::proc t5_box_number_edit_assist_list {} { ::set Result ""; ::foreach {Box Description} [t5_box_number_and_description_list] { ::lappend Result "$Box $Description"; } ::return $Result; } #nv2.20.0 (t4a) ::proc t4a_box_number_and_description_list {} { #::set ExcludeList "016 018 020 022 024 028 030 032 034 040 042 048"; #nv2.27.0 (t4a) - changed 126 - added 136 162 194 195 #nv2.28.3 (t4a) - added 196 #nv2.33.1 (new feature) - t4a_box_number_and_description_list - added box 128 #nv2.34.0 (t4a) - renamed box 136 from {Federal Income Support for Parents of Murdered or Missing Children} to see below... #nv2.34.5 (t4a-covid) - added box 037 and box 200 #nv2.35.0 (t4a-covid) - added box 201, 205 and box 210 - change title of box 130 #nv2.38.0 (employer_dental_code) - ::QW::NEWVIEWS::PAYROLL::CANADA t4a_box_number_and_description_list - added .015 for box015 #IDIOT {015} {Employer/Payer Dental Code} ::return { {016} {Pension or superannuation} {018} {Lump-sum payments} {020} {Self-employed commissions} {022} {Income tax deducted} {024} {Annuities} {026} {Eligible retiring allowances} {027} {Non-eligible retiring allowances} {028} {Other income} {030} {Patronage allocations} {032} {Registered pension plan contributions (past services)} {034} {Pension adjustment} {037} {Advanced life deferred annuity purchase} {040} {RESP accumulated income payments} {042} {RESP educational assistance payments} {046} {Charitable donations} {048} {Fees for services} {102} {Lump-sum payments - non-resident services transferred under paragraph 60(j)} {104} {Research grants} {105} {Scholarships, fellowships, or bursaries} {106} {Death benefits} {107} {Income from wage loss replacement plans, not fully funded by employee premiums} {108} {Lump-sum payments out of an RPP - not eligible for transfer} {109} {Unregistered pension plan} {110} {Lump-sum payments accrued to December 31, 1971} {111} {IAAC annuities} {115} {Installment or annuity payments under a DPSP} {116} {Medical travel} {117} {Loan benefit under subsection 80.4(2)} {118} {Medical premium benefit} {119} {Group term life insurance benefit} {122} {RESP accumulated income payments to other} {123} {Installment or annuity payments under a revoked DPSP} {124} {Board and lodging at special work sites} {125} {Disability benefits} {126} {Contributor RPP Past Service pre-1990 contributions} {127} {Veteran's benefit} {128} {Veteran's benefits eligible for pension splitting} {129} {Tax deferred patronage dividends} {130} {Apprenticeship Incentive Grant/Apprenticeship Incentive Grant for Women/Apprenticeship Completion Grant} {131} {Registered Disability Savings Plan} {132} {Wage Earner Protection Program} {133} {Variable Pension Benefits} {134} {TFSA taxable amount} {135} {Recipient-paid premiums for private health services plans} {136} {Canadian Benefit for Parents of Young Victims of Crime (PYVC)} {142} {Status Indian (exempt income) - eligible retiring allowances} {143} {Status Indian (exempt income) - non-eligible retiring allowances} {144} {Status Indian (exempt income) - other income} {146} {Status Indian (exempt income) - pension or superannuation} {148} {Status Indian (exempt income) - lump-sum payments} {150} {Labour Adjustment Benefits Act and Appropriation Act} {152} {SUBP qualified under the Income Tax Act} {154} {Cash award or prize from payer} {156} {Bankruptcy settlement} {158} {Lump-sum payments - not eligible for transfer} {162} {Non Contributor RPP Past Service pre-1990 contributions} {180} {Lump-sum payments out of a DPSP - not eligible for transfer} {190} {Lump-sum payments - unregistered pension benefits} {194} {PRPP payments from taxable income} {195} {PRPP payments from exempt income} {196} {Adult basic education tuition assistance} {200} {Provincial/Territorial COVID-19 financial assistance payments} {201} {Repayment of COVID-19 financial assistance} {205} {One-time payment for older seniors} {210} {Postdoctoral fellowship income amount} } # {012} {Recipient social insurance number (SIN)} # {013} {Recipient Business Number (BN)} # {014} {Recipient number} # {036} {Plan or DPSP registration number} # {061} {Payer's Account Number (BN)} } ::proc t4a_box_number_edit_assist_list {} { ::set Result ""; ::foreach {Box Description} [t4a_box_number_and_description_list] { ::lappend Result "$Box $Description"; } ::return $Result; } } /* { #nv2.20.0 (T5018) - copied from .../PRINT_T4_SUMMARY -because we will use this repeatedly AMGAD says: */} ::namespace eval ::QW::XML { ::proc xml_file_header {s_args} { ::set Result {}; ::append Result {}; ::return $Result; } ::proc xml_file_footer {s_args} { ::return {}; } } #nv2.29.0 (new feature) - file_xml ROE ::namespace eval ::QW::XML::ROE { ::proc xml_roe_file_header {s_args} { ::set Result {}; ::append Result [::subst {}]; ::return $Result; } ::proc xml_roe_file_footer {s_args} { ::return {}; } } ::namespace eval ::QW::XML::IRS { } ::namespace eval ::QW::XML::CRA { ::proc xml_data {TagName Data Path Max} { #//::QW::XML::CRA ::if {[::sargs::get $Data $Path] eq ""} { ::return ""; } ::return "<$TagName>[::string range [::sargs::get $Data $Path] 0 [::expr {$Max-1}]]"; } ::proc xml_cra_file_header {s_args} { #//::puts "pgq,debug2383::QW::XML::CRA xml_cra_file_header s_args==(\n[::sargs::format .structure $s_args]\n)"; ::set Settings [::sargs::get $s_args ".settings_prompt"]; #//::puts "pgq,debug220::QW::XML::CRA xml_cra_file_header Settings==\n[::sargs::format .structure $Settings]"; #nv2.20.0 fix - generalize #// AND, just for the total number of "records" (T5018 slips) in the file... #::set t5018_summary [::sargs::get $s_args ".t5018_summary_data"]; /* { 20 fields - first 19 on the prompt .transmitter_number .submission_reference_id .report_type .transmitter_type .language .transmitter_name_1 .transmitter_name_2 .transmitter_street_1 .transmitter_street_2 .transmitter_city .transmitter_state .transmitter_country .transmitter_zipcode .transmitter_contact_name .transmitter_phone_area_code .transmitter_phone_number .transmitter_phone_extension .transmitter_email .total_summary_records */} #nv2.38.3 (payroll) - ::QW::XML::CRA::xml_cra_file_header - remove 7 fields, replace 2 with 1, add 2 /* { # ##.transmitter_number .submission_reference_id # ##.report_type # ##.transmitter_type .language # ##.transmitter_name_1 # ##.transmitter_name_2 .transmitter_name .transmitter_account_number_type .transmitter_account_number .transmitter_rep_id .transmitter_street_1 .transmitter_street_2 # ##.transmitter_city # ##.transmitter_state .transmitter_country # ##.transmitter_zipcode .transmitter_contact_name .transmitter_phone_area_code .transmitter_phone_number .transmitter_phone_extension .transmitter_email .total_summary_records */} #nv2.38.3 (payroll) - ::QW::XML::CRA::xml_cra_file_header /* { 2025V3 - updated 2024-10-17 What’s New: Fields removed: Report Type Code () Transmitter number () Transmitter Type Indicator () Transmitter address ( ) Transmitter city () Transmitter province or territory code () Transmitter postal code () Fields updated: Transmitter name ( replaced by ) Transmitter Country Code (, replaced by ) New fields added: Transmitter CRA Account Number -Required up to 15 alphanumeric (if logged in using My business account (MyBA) or Web access code (WAC)) -Choose one of the following; - Business Number (BN) - 9 numeric - Account Number (e.g., 123456789 RP0001) - 15 alphanumeric - 1 alpha, 8 numeric - 3 alpha, 6 numeric Transmitter RepID (Representative Identifier) -Required (if logged in using Represent a client (RAC) application) -7 alphanumeric T619 applicable to all return types (excluding T5013) T619 applicable to T5013 return types ONLY */} #nv2.38.3 (payroll) - ::QW::XML::CRA::xml_cra_file_header #nv2.38.4 (payroll) - ::QW::XML::CRA::xml_cra_file_header - cleaned up to explicitly separate <=2023 and >=2024 ::if {[::sargs::exists $s_args .t4_summary_data]&&[::sargs::get $s_args .settings_prompt.summary_year_end_date]<=2023 \ ||[::sargs::exists $s_args .t4a_summary_data]&&[::sargs::get $s_args .settings_prompt.summary_year_end_date]<=2023 \ ||[::sargs::exists $s_args .t5_summary_data]&&[::sargs::get $s_args .settings_prompt.for_the_year_ending]<=2023 \ ||[::sargs::exists $s_args .t5018_summary_data]&&[::sargs::get $s_args .settings_prompt.for_the_year_ending]<=2023 \ } { ::set Result ""; ::append Result ; ::append Result "[::sargs::get $Settings .transmitter_number]"; ::append Result "[::string range [::sargs::get $Settings .submission_reference_id] 0 7]"; ::append Result "[::sargs::get $Settings .transmitter_type]"; #// # NOTICE kludge alert #// For now, we only submit files for a single business number and there can only be one T5018 Summary. ::append Result "1"; #// ::append Result ; ::append Result "[::string range [::sargs::get $Settings .transmitter_name_1] 0 29]"; ::append Result [xml_data l2_nm $Settings .transmitter_name_2 30]; ::append Result ; ::append Result ; ::append Result [xml_data addr_l1_txt $Settings .transmitter_street_1 30]; ::append Result [xml_data addr_l2_txt $Settings .transmitter_street_2 30]; ::append Result [xml_data cty_nm $Settings .transmitter_city 28]; ::append Result [xml_data cntry_cd $Settings .transmitter_country 3]; ::append Result "[::string range [::sargs::get $Settings .transmitter_state] 0 1]"; ::append Result "[::string range [::sargs::get $Settings .transmitter_zipcode] 0 9]"; ::append Result ; ::append Result ; ::append Result "[::string range [::sargs::get $Settings .transmitter_contact_name] 0 21]"; ::append Result "[::sargs::integer_get $Settings .transmitter_phone_area_code]"; ::append Result "[::sargs::get $Settings .transmitter_phone_number]"; ::append Result [xml_data cntc_extn_nbr $Settings .transmitter_phone_extension 5]; ::append Result [xml_data cntc_email_area $Settings .transmitter_email 60]; ::append Result ; ::switch [::sargs::get $Settings ".report_type"] { "original" {::append Result "O";} "amended" {::append Result "A";} } ::switch [::sargs::get $Settings ".language"] { "english" {::append Result "E";} "french" {::append Result "F";} } ::append Result ; ::return $Result; } ::if {1} { ::set Result ""; ::append Result ; #// ::append Result ; #//::puts "pgq,debug2383::QW::XML::CRA xml_cra_file_header .transmitter_account_number_type==[::sargs::get $Settings .transmitter_account_number_type]"; ::switch -- [::sargs::get $Settings .transmitter_account_number_type] { bn9 { ::append Result [xml_data bn9 $Settings .transmitter_account_number 9]; ;#// 9 numeric - 123456789 } bn15 { ::append Result [xml_data bn15 $Settings .transmitter_account_number 15]; ;#// 15 alphanumeric - 123456789RP0001 } trust { ::append Result [xml_data trust $Settings .transmitter_account_number 9]; ;#// 1 alpha, 8 numeric } nr4 { ::append Result [xml_data nr4 $Settings .transmitter_account_number 9]; ;#// 3 alpha, 6 numeric } } ::append Result ; #// ::if {[::sargs::get $Settings .transmitter_rep_id] ne ""} { ::append Result ; ::append Result [xml_data RepID $Settings .transmitter_rep_id 7]; ::append Result ; } #// ::append Result "[::string range [::sargs::get $Settings .submission_reference_id] 0 7]"; #// # NOTICE kludge alert #// For now, we only submit files for a single business number and there can only be one T5018 Summary. ::append Result "1"; #// ::switch [::sargs::get $Settings ".language"] { "english" {::append Result "E";} "french" {::append Result "F";} } #// ::append Result ; ::append Result [xml_data l1_nm $Settings .transmitter_name 35]; ::append Result ; #// ::append Result [xml_data TransmitterCountryCode $Settings .transmitter_country 3]; #// ::append Result ; ::append Result "[::string range [::sargs::get $Settings .transmitter_contact_name] 0 21]"; ::append Result "[::sargs::integer_get $Settings .transmitter_phone_area_code]"; ::append Result "[::sargs::get $Settings .transmitter_phone_number]"; ::append Result [xml_data cntc_extn_nbr $Settings .transmitter_phone_extension 5]; ::append Result [xml_data cntc_email_area $Settings .transmitter_email 60]; ::append Result ; ::append Result ; ::return $Result; } } ::proc xml_cra_file_footer {s_args} { ::return ""; } } ::namespace eval ::QW::EFT { } ::namespace eval ::QW::EFT::CANADA { #nv2.28.0 (new feature) - eft_transfer_deposit_228 #nv2.28.0 (new feature) - JRP - credit unions - added National Bank (0006) and Credit Unions (800-899) - changed ::switch -exact .bank_id to ::switch -glob #nv2.20.0 (new feature) - dmp/jrp - CPA standard - we accept any 3 or 4 digit bank id - so change switch glob cases to fall into default without error /* { # DMP: Changes to this file: # CIBC: The documentation from CIBC says that we only need to change C to D in record 6. The only other thing I fould is that we have the word payroll # hard wired into the descriptive statement of the batch header. I think that we will have to change this. # # Scotia: For pyaing vendors/employees, Scotia uses a pair of records for the transaction details called a C/2 pair. For PAP this becomes a D/3 pair. # This means that you only need to change one field in each of the paied records. The only other change is in the Z (file footer) record. In # the Z record there are fields for the sum of the D records, the number of D records, The sum of the C records and the number of C records. # # RBC: In the detail record, change the C to a D. Ithe File footer (TRL) record, change the detail sum and count to use the second set of numbers. # # BMO: In the X and Y record, change C to a D. # In C record, field size of last item changes from 19 to 15. (Need to check this). Record changes from C to D # In Z record, Sum of detail amount and record cound preceeds the C record equivalent. # # TD: Change C to a D in the H record. # */} ::proc eft_bank_settings_check {s_args} { #//::QW::EFT::CANADA /* { "0" {::return "Receiving Data Center";} "1" {::return "Originator ID";} "2" {::return "Originator Long Name";} "3" {::return "Originator Short Name";} "4" {::return "Bank ID";} "5" {::return "Bank Transit";} "6" {::return "Bank Account";} "7" {::return "CPA Code";} "8" {::return "Currency Type";} "9" {::return "Optional Comment";} "10" {::return "File Name";} "11" {::return "File Creation Number";} "0" {::return [::sargs::get $Settings ".receiving_data_center"];} "1" {::return [::sargs::get $Settings ".originator_id"];} "2" {::return [::sargs::get $Settings ".originator_long_name"];} "3" {::return [::sargs::get $Settings ".originator_short_name"];} "4" {::return [::sargs::get $Settings ".bank_id"];} "5" {::return [::sargs::get $Settings ".bank_transit"];} "6" {::return [::sargs::get $Settings ".bank_account"];} "7" {::return [::sargs::get $Settings ".cpa_code"];} "8" {::return [::sargs::get $Settings ".currency_type"];} "9" {::return [::sargs::get $Settings ".optional_comment"];} "10" {::return [::sargs::get $Settings ".file_name"];} "11" {::return [::sargs::get $Settings ".file_creation_number"];} */} #// ::set Bpath [[::sargs::get $s_args ".bank_address"] odb_path_help]; #// ::if {[::sargs::get $s_args ".bank_id"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Bank ID\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_id"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator ID\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".bank_transit"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Bank Transit\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".bank_account"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Bank Account\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".cpa_code"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"CPA Code\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".file_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"File Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".file_creation_number"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"File Creation Number\"." \ .help_id 0 \ ]; } ::switch -glob -- [::sargs::get $s_args ".bank_id"] { "0001" { # Montreal ::if {[::sargs::get $s_args ".receiving_data_center"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Receiving Data Center\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_long_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Long Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_short_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Short Name\"." \ .help_id 0 \ ]; } } "0002" { # Scotia ::if {[::sargs::get $s_args ".receiving_data_center"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Receiving Data Center\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_long_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Long Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_short_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Short Name\"." \ .help_id 0 \ ]; } } "0003" { # Royal ::if {[::sargs::get $s_args ".originator_long_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Long Name\"." \ .help_id 0 \ ]; } /* { ::if {[::sargs::get $s_args ".optional_comment"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Optional Comment\"." \ .help_id 0 \ ]; } */} ::if {[::sargs::get $s_args ".currency_type"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Currency Type\"." \ .help_id 0 \ ]; } } "0004" { # TD ::if {[::sargs::get $s_args ".originator_short_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Short Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".currency_type"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Currency Type\"." \ .help_id 0 \ ]; } } "0006" - "0010" - "0016" - "08??" - default { #nv2.28.0 (new feature) - JRP - credit unions #nv2.31.0 (bug fix) - eft_bank_settings_check - removed .text "\"Bank ID\" 0016 (i.e. HSBC) is currently not supported." # CIBC ::if {[::sargs::get $s_args ".receiving_data_center"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Receiving Data Center\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_long_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Long Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originator_short_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Originator Short Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".currency_type"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT Canada Info does not specify the \"Currency Type\"." \ .help_id 0 \ ]; } } } /* { default { # we're not in Kansas if we ever get here ::qw::throw [::sargs \ .text "Direct Deposit/EFT Payments encountered unknown Bank Id \"$BankId\"." \ .help_id 271820051209113140 ]; } */} } #nv2.28.0 (new feature) - JRP - credit unions /* { # JRP is using "cpa_005" to switch on ".bank_id" # JRP has list of Canadian Credit Unions - ".bank_id" see below 0803 Latvian Credit Union Limited 0806 DUCA Financial Services Cr Union Ltd 0807 Communication Technologies Cr Un Ltd 0808 Arnstein Community Credit Union Ltd 0809 Central 1 Credit Union - BC Region 0810 All Trans Financial Servs. Cr Un Ltd 0815 Caisses Desjardins du Quebec 0819 Caisses populaires Desjardins du Manitoba 0821 Credit Unions in Nova Scotia - Various 0828 Central 1 Credit Union - ON Region 0829 Caisses Populaires Desjardins de L'Ontario 0830 Airline Financial Credit Union Ltd 0831 Credit Unions in New Brunswick - Various 0833 St Stanislaus Casimir's Cr Un Ltd 0834 Community First Credit Union Limited 0836 La Caisse Populaire De Kapuskasing 0837 Meridian Credit Union (formerly Hepco) 0839 Credit Union Central of Nova Scotia 0840 Dundalk District Credit Union Ltd 0841 Credit Unions in Quebec - Various 0842 Alterna Savings and Credit Union Ltd 0844 Goderich Community Credit Union Ltd 0846 Ontario Civil Service Credit Union Ltd 0848 Virtual One Credit Union Limited 0849 Brunswick Cr. Union Federation Ltd 0850 Lambton Financial Credit Union Ltd 0851 Credit Unions in Ontario - Various 0853 Concentra Financial Services Assoc 0854 Golden Horsehoe Credit Union Ltd 0865 Caisses Populaires Desjardins Acadiennes 0879 Credit Union Central of Manitoba 0889 Credit Union Central of Saskatchewan 0890 L'Alliance Caisses Pop. De L'Ontario 0899 Credit Union Central Alberta Limited */} ::proc eft_receiver_settings_check {s_args} { } ::proc eft_file_header_create {ClockSeconds BankEftSettings Text} { #//::QW::EFT::CANADA #// # kludge alert (::uplevel) #// pgq was under the gun to get July 2008 payroll out the door but eft_transfer needs to be redesigned. #// The problem is that the eft file creation code is broken into 5 sections to keep a handle on the format. #// BUT "global" counters and hash totals are maintained as the pieces of the file are put together. #// We should probably switch is all to s_args in (with current data, counters and hash totals) #// and s_args out (with updated counters and hash totals). # AND notice #// The args to these procs are meaningless and only remain (from original methods "design") for documentation #// (all variable references are reaching up the stack to the caller's variables). #// And the ::return at the end of the proc seems superfluous. #// ::uplevel 1 { ::set _line_number 0; ::set _batch_count 0; ::set _detail_item_count 0; ::set _detail_item_sum 0.0; #nv2.28.0 (new feature) - audit eft payments/deposits - just like audit_print_check ::set _detail_item_list [::list]; #// # bank account eft info for the file header #// ::set BankId [::sargs::get $BankEftSettings ".bank_id"]; ::set BranchId [::sargs::get $BankEftSettings ".bank_transit"]; ::set OriginatorId [::sargs::get $BankEftSettings ".originator_id"]; ::set ReturnBankAccount [::sargs::get $BankEftSettings ".bank_account"]; ::set DestinationDataCenter [::sargs::get $BankEftSettings ".receiving_data_center"]; ::set FileCreationNumber [::sargs::get $BankEftSettings ".file_creation_number"]; ;#// A unique id number that increments each time the file is created ::set ClientLongName [::sargs::get $BankEftSettings ".originator_long_name"]; ;#// max 30 characters ::set ClientShortName [::sargs::get $BankEftSettings ".originator_short_name"]; ;#// max 15 characters ::set CpaCode [::sargs::get $BankEftSettings ".cpa_code"]; ::set OptionalRecord [::sargs::get $BankEftSettings ".optional_record"]; ;#// This is additional info to print on the cheque (Merry Xmas) ::set CurrencyType [::sargs::get $BankEftSettings ".currency_type"]; ;#// CAD or USD #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment #//::puts "pgq,debug::QW::EFT::CANADA eft_file_header_create BankEftSettings==(\n[::sargs::format .structure $BankEftSettings]\n)"; #// # kludge alert until we do PAP (pre approved payments) #// #nv2.28.0 (new feature) - eft_transfer_deposit_228 #::set PaymentType "C"; ;#// A batch may either credit or debit ::switch $TransType { deposit {::set PaymentType "D";} payment {::set PaymentType "C";} } #// ::incr _line_number; ;#// for Royal and National every file line is numbered, base 1 #// ::switch -glob -- $BankId { "0001" { # Bank of Montreal 80 byte strings ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%y"][::format "%03s" [::clock format $ClockSeconds -format "%j"]]]; ;#// yyyddd # # The layout of file creation date changes from bank to bank. # For Bank of Montreal the file creation date is a six digit number. A zero, the last 2 digits of the year and three digits for the day of the year # ::append EftString "A"; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString $FileCreationDate; ::append EftString [::format "%05s" $DestinationDataCenter]; ::append EftString [::string repeat " " 54]\n; } "0002" { # Scotia Bank 80 byte strings ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%y"][::format "%03s" [::clock format $ClockSeconds -format "%j"]]]; ;#// yyyddd ::append EftString "A"; ::append EftString [::format "%09s" "000000001"]; ;#// hard-wired record count ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString $FileCreationDate; ::append EftString [::format "%05s" $DestinationDataCenter]; ;#// ScotiaBank uses 00220 ::append EftString "D"; ;#// Service identifier ::append EftString [::string repeat " " 44]\n; # Scotiabank has what they call the 'Costoner Infromation' record. This does not appear to be a # batch header record so I am adding it right here. ::append EftString "Y"; ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%-30s" $ClientLongName]; ::append EftString [::format "%03s" [::string range $BankId 1 3]]; ;#// Every other bank uses a 4 digit ID. ::append EftString [::format "%05s" $BranchId]; ::append EftString [::format "%-12s" $ReturnBankAccount]; ::append EftString [::string repeat " " 14]\n; } "0003" { # Royal Bank 152 byte strings ::set FileCreationDate [::format "%07s" [::clock format $ClockSeconds -format "%Y"][::format "%03s" [::clock format $ClockSeconds -format "%j"]]]; ;#// yyyyddd #20060207_build_change (eft - Royal Bank) #nv2.28.0 (new feature) - eft_transfer_deposit_228 #::append EftString "\$\$AAPDSTD0152\[PROD\[NL\$\$\n"; ;#// \]\] ::append EftString "\$\$AA01STD0152\[PROD\[NL\$\$\n"; ;#// \]\] ::append EftString [::format "%06s" $_line_number]; ;#// every file line is numbered, base 1 ::append EftString "A"; ::append EftString "HDR"; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%-30s" $ClientLongName]; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString $FileCreationDate; ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString 1; ;#//Input Type ::append EftString [::string repeat " " 15]; ;#// four reserved fields ::append EftString [::string repeat " " 6]; ::append EftString [::string repeat " " 8]; ::append EftString [::string repeat " " 9]; ::append EftString [::string repeat " " 46]; ;#// two filler fields ::append EftString [::string repeat " " 2]; ::append EftString N\n; ;#// Client has optional data (Y or N) } "0004" { # TD 80 byte strings # # The layout of file creation date changes form bank to bank. # For Bank of Montreal the file creation date is a six digit number. A zero, the last 2 digits of the year and three digits for the day of the year # ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%d%m%y"]]; ;#// ddmmyy ::append EftString "H"; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString $PaymentType; ::append EftString $CpaCode; ::append EftString $FileCreationDate; ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%04s" $BankId]; ::append EftString [::format "%05s" $BranchId]; ::append EftString [::format "%-12s" $ReturnBankAccount]; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString [::string repeat " " 19]\n; } "0010" { # CIBC 80 byte strings ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%y%m%d"]]; ;#// yymmdd ::append EftString 1; ::append EftString [::string repeat " " 2]; ::append EftString [::format "%05s" $DestinationDataCenter]; ::append EftString [::string repeat " " 5]; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString $FileCreationDate; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%04s" $BankId]; ::append EftString [::format "%05s" $BranchId]; ::append EftString [::format "%-12s" $ReturnBankAccount]; ::append EftString [::string repeat " " 2]; ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString [::string repeat " " 4]\n; } "0006" - "08??" - default { # National 1464 byte strings #nv2.28.0 (new feature) - JRP - credit unions #// Credit Unions - CPA standard 005 - Logical record Type "A" - Page 4 - 1464 byte strings ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%y"][::format "%03s" [::clock format $ClockSeconds -format "%j"]]]; ;#// 0yyddd # #// The layout of file creation date changes from bank to bank. #// For CPA standard 005 the file creation date is a six digit number. A zero, the last 2 digits of the year and three digits for the day of the year # ::append EftString "A"; ::append EftString [::format "%09s" "000000001"]; ;#// hard-wired record count ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%04s" $FileCreationNumber]; ::append EftString $FileCreationDate; ::append EftString [::format "%05s" $DestinationDataCenter]; ;#// CPA 005 uses ? ? ? ::append EftString [::format "%-20s" $OptionalRecord]; ;#// Reserved Customer-Direct Clearer Communication area ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString [::string repeat " " 1406]\n; } } /* { default { # we're not in kansas if we ever get here ::qw::throw [::sargs \ .text "Direct Deposit/EFT Payments encountered unknown Bank Id \"$BankId\"." \ .help_id 271820051209113140 ]; } */} ::return [::append Text "$EftString"]; } } ::proc eft_file_footer_create {BankEftSettings Text} { #//::QW::EFT::CANADA ::uplevel 1 { ::set DetailSum [::expr {int([::qw::number::multiply $_detail_item_sum 100.0])}] #// ::set BankId [::sargs::get $BankEftSettings ".bank_id"]; ::set BranchId [::sargs::get $BankEftSettings ".bank_transit"]; ::set OriginatorId [::sargs::get $BankEftSettings ".originator_id"]; ::set ReturnBankAccount [::sargs::get $BankEftSettings ".bank_account"]; ::set DestinationDataCenter [::sargs::get $BankEftSettings ".receiving_data_center"]; ::set FileCreationNumber [::sargs::get $BankEftSettings ".file_creation_number"]; ;#// A unique id number that increments each time the file is created ::set CpaCode [::sargs::get $BankEftSettings ".cpa_code"]; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment #// ::incr _line_number; ::switch -glob -- $BankId { "0001" { # Bank of Montreal ::append EftString "Z"; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::switch $TransType { deposit { ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%05s" $_detail_item_count]; ::append EftString [::string repeat "0" 14]; ;#// this is the number of "C" records that were created ::append EftString [::string repeat "0" 5]; ;#// if we were to have any, we would have to track them. } payment { ::append EftString [::string repeat "0" 14]; ;#// this is the number of "D" records that were created ::append EftString [::string repeat "0" 5]; ;#// if we were to have any, we would have to track them. ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%05s" $_detail_item_count]; } } ::append EftString [::string repeat " " 41]\n; } "0002" { # Scotia Bank ::append EftString "Z"; ::append EftString [::string repeat " " 9]; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%04s" $FileCreationNumber]; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::switch $TransType { deposit { #// DMP The sum of the D records and the corresponding item count preceed the C record equivilant. ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%04s" $_detail_item_count]; ::append EftString [::string repeat "0" 14]; ;#// this is the number of "C" records that were created ::append EftString [::string repeat "0" 8]; ;#// we were to have any, we would have to track them. } payment { ::append EftString [::string repeat "0" 14]; ;#// this is the number of "D" records that were created ::append EftString [::string repeat "0" 8]; ;#// we were to have any, we would have to track them. ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%08s" $_detail_item_count]; } } ::append EftString [::string repeat " " 12]\n; } "0003" { # Royal Bank ::append EftString [::format "%06s" $_line_number]; ::append EftString "Z"; ::append EftString "TRL"; ::append EftString [::format "%-10s" $OriginatorId]; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::switch $TransType { deposit { #// DMP The sum of the D records and the corresponding item count follow the C record equivilant. ::append EftString [::string repeat "0" 6]; ::append EftString [::string repeat "0" 14]; ::append EftString [::format "%06s" $_detail_item_count]; ::append EftString [::format "%014s" $DetailSum]; } payment { ::append EftString [::format "%06s" $_detail_item_count]; ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::string repeat "0" 6]; ::append EftString [::string repeat "0" 14]; } } ::append EftString [::string repeat "0" 2]; ;#// this is the number of optinal records that were created ::append EftString [::string repeat "0" 6]; ;#// if we were to have any, we would have to track them. ::append EftString [::string repeat " " 12]; ::append EftString [::string repeat " " 6]; ::append EftString [::string repeat " " 63]; ::append EftString [::string repeat " " 2]; ::append EftString [::string repeat " " 1]\n; } "0004" { # TD ::append EftString "T"; ::append EftString [::format "%08s" $_detail_item_count]; ;#// this is the number of C records ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::string repeat " " 57]\n; ;#// Aladine Hanna says the extra characters and line feed are wrong... } "0010" { # CIBC ::append EftString 9; ::append EftString [::format "%06s" $_batch_count]; ;#// this is the number of batches ::append EftString [::format "%06s" $_detail_item_count]; ;#// this is the number of detail records ::append EftString [::string repeat " " 67]\n; } "0006" - "08??" - default { # National #nv2.28.0 (new feature) - JRP - credit unions #// Credit Unions - CPA standard 005 - Logical record Type "Z" - Page 14 - 1464 byte strings #//::puts "pgq,debug::QW::EFT::CANADA eft_file_footer_create 0800 _detail_item_count==$_detail_item_count mod 6==[::expr {($_detail_item_count%6)}]"; ::if {($_detail_item_count%6)!=0} { ::set Pad [::expr {6-($_detail_item_count%6)}]; ::for {::set k 1} {$k<=$Pad} {::incr k} { #nv2.34.0 (bug fix) - EFT file format for credit unions - last detail item not padded correctly #// The entire string length needs to be 1464 characters but each detail record starts with a header of 24 characters, #// leaving 1440 for the 6 transactions. 1440/6 = 240. #::append EftString [::string repeat " " 244]; ::append EftString [::string repeat " " 240]; } ::append EftString \n; ;#// after you reach a record length of 1464 } ::append EftString "Z"; #nv2.30.0 (bug fix) - EFT file format for credit unions - detail item record count corrected #::append EftString [::format "%09s" $_line_number]; ::append EftString [::format "%09s" [::expr {int(ceil(double($_detail_item_count)/6.0))+2}]]; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%04s" $FileCreationNumber]; ::switch $TransType { deposit { ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%08s" $_detail_item_count]; ::append EftString [::string repeat "0" 14]; ::append EftString [::string repeat "0" 8]; } payment { ::append EftString [::string repeat "0" 14]; ::append EftString [::string repeat "0" 8]; ::append EftString [::format "%014s" $DetailSum]; ::append EftString [::format "%08s" $_detail_item_count]; } } ::append EftString [::string repeat "0" 14]; ;#// Total Value of Error Corrections "E" ::append EftString [::string repeat "0" 8]; ;#// Total Number of Error Corrections "E" ::append EftString [::string repeat "0" 14]; ;#// Total Value of Error Corrections "F" ::append EftString [::string repeat "0" 8]; ;#// Total Number of Error Corrections "F" ::append EftString [::string repeat " " 1352]\n; } } /* { default { # we're not in kansas if we ever get here ::qw::throw [::sargs \ .text "Unknown Bank Id \"$BankId\"." \ .help_id 271820051209113140 ]; } */} #// #//::puts "20051211.000 _line_number==$_line_number"; #//::puts "20051211.000 _detail_item_count==$_detail_item_count"; #//::puts "20051211.000 _detail_item_sum==$_detail_item_sum"; #// ::return [::append Text "$EftString"]; } } ::proc eft_batch_header_create {Date BankEftSettings Text} { #//::QW::EFT::CANADA ::uplevel 1 { ::set Date [::string range $Date 1 end]; ;#// strip off the leading . #// #// The Batch Header. Not used by all banks. I'm assuming that we will only ever have one batch per run. #// If we want to have more than one batch then we need an extra pair of variables to track the total number #// detail records in the file and the total of the cheques. #::return [::append Text "\n This is a batch header"]; #// ::set _batch_detail_item_count 0; ::set _batch_detail_item_sum 0.0; #// ::set BankId [::sargs::get $BankEftSettings ".bank_id"]; ::set BranchId [::sargs::get $BankEftSettings ".bank_transit"]; ::set ReturnBankAccount [::sargs::get $BankEftSettings ".bank_account"]; ::set ClientLongName [::sargs::get $BankEftSettings ".originator_long_name"]; ;#// max 30 characters ::set ClientShortName [::sargs::get $BankEftSettings ".originator_short_name"]; ;#// max 15 characters ::set CpaCode [::sargs::get $BankEftSettings ".cpa_code"]; ::set OptionalComment [::sargs::get $BankEftSettings ".optional_comment"] #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment ::switch $TransType { deposit {::set PaymentType "D";} payment {::set PaymentType "C";} } #// ::switch -- $BankId { "0001" { # Bank of Montreal ::incr _batch_count; ::incr _line_number; ::append EftString "X"; ::append EftString $PaymentType; ::append EftString $CpaCode; ::append EftString "[::string range [::qw::date::format $Date %Y] 1 end][::qw::date::format $Date %j]"; ;#// yyyddd ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%-30s" $ClientLongName]; ::append EftString [::format "%04s" $BankId]; ::append EftString [::format "%05s" $BranchId]; ::append EftString [::format "%-12s" $ReturnBankAccount]; ::append EftString [::string repeat " " 3]\n; } "0010" { # CIBC ::incr _batch_count; ::incr _line_number; ::append EftString 5; ::append EftString [::string repeat " " 46]; ::append EftString $CpaCode; #nv2.28.0 (new feature) - eft_transfer_deposit_228 - no change yet #// DMP - I don't think we should have the word payroll hard wired into the descriptive statement field. This should come from the user #::append EftString [::format "%-10s" "Payroll"]; ::append EftString [::format "%-10s" [::string range $OptionalComment 0 9]]; ::append EftString [::qw::date::format $Date "%y%m%d"]; ;#// yymmdd ::append EftString [::string repeat " " 14]\n; } default { ::return $Text; } } ::return [::append Text "$EftString"]; } } ::proc eft_batch_footer_create {BankEftSettings Text} { #//::QW::EFT::CANADA ::uplevel 1 { ::set BankId [::sargs::get $BankEftSettings ".bank_id"]; ::set CpaCode [::sargs::get $BankEftSettings ".cpa_code"]; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::switch $TransType { deposit {::set PaymentType "D";} payment {::set PaymentType "C";} } #// ::switch -- $BankId { "0001" { # Bank of Montreal ::incr _line_number; ::append EftString "Y"; ::append EftString $PaymentType; ::append EftString [::format "%08s" $_batch_detail_item_count]; ::append EftString [::format "%014s" [::expr {int([::qw::number::multiply $_batch_detail_item_sum 100.0])}]]; ::append EftString [::string repeat " " 56]\n; } "0010" { # CIBC ::incr _line_number; ::append EftString 7; ::append EftString $CpaCode; ::append EftString [::format "%06s" $_batch_detail_item_count]; ::append EftString [::string repeat "9" 10]; #// the hash total ::append EftString [::string repeat " " 20]; ::append EftString [::format "%012s" [::expr {int([::qw::number::multiply $_batch_detail_item_sum 100.0])}]]; ::append EftString [::string repeat " " 28]\n; } default { ::return $Text; } } #// #//::puts "20051211.000 _batch_count==$_batch_count"; #//::puts "20051211.000 _batch_detail_item_count==$_batch_detail_item_count"; #//::puts "20051211.000 _batch_detail_item_sum==$_batch_detail_item_sum"; #// ::return [::append Text "$EftString"]; } } ::proc eft_transaction_item_create {Receiver Transaction BankEftSettings ReceiverEftSettings Text} { #//::QW::EFT::CANADA ::uplevel 1 { #// #//::puts "pgq,debug::QW::EFT::CANADA::eft_transaction_item_create Receiver==[$Receiver odb_path]"; #//::puts "pgq,debug::QW::EFT::CANADA::eft_transaction_item_create Transaction==[$Transaction odb_path]"; #//::puts "pgq,debug::QW::EFT::CANADA::eft_transaction_item_create BankEftSettings==(\n[::sargs::format .structure $BankEftSettings]\n)"; #//::puts "pgq,debug::QW::EFT::CANADA::eft_transaction_item_create ReceiverEftSettings==(\n[::sargs::format .structure $ReceiverEftSettings]\n)"; #//::puts "pgq,debug::QW::EFT::CANADA::eft_transaction_item_create Text==$Text"; #// #nv2.28.0 (new feature) - eft_transfer_deposit_228 - added .../DEPOSIT ::switch -glob -- [$Transaction odb_path] { "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/BANK/DEPOSIT*" - "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/BANK/PAYMENT*" { ::set ReceiverId [[$Receiver ".name"] odb_get]; ::set ReceiverName [[$Receiver ".description"] odb_get]; } "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PAYROLL/PAYCHECK*" { ::set Receiver [[[[$Transaction odb_master] ".employee"] odb_get] odb_master]; ::set ReceiverId [[$Receiver ".employee_id"] odb_get]; ;#// 15 characters max ::set ReceiverName [[$Receiver ".employee_name.print_as"] odb_get]; } default { ::qw::throw [::sargs \ .text "Attempted to EFT transfer unsupported transaction type \"[[$Transaction odb_master] odb_class_path]\"." \ .help_id 0 \ ]; } } ::set FileCreationNumber [::sargs::get $BankEftSettings ".file_creation_number"]; ;#// A unique id number that increments each time the file is created ::set BankId [::sargs::get $BankEftSettings ".bank_id"]; ::set BranchId [::sargs::get $BankEftSettings ".bank_transit"]; ::set OriginatorId [::sargs::get $BankEftSettings ".originator_id"]; ::set ReturnBankAccount [::sargs::get $BankEftSettings ".bank_account"]; ::set CpaCode [::sargs::get $BankEftSettings ".cpa_code"]; ::set ClientLongName [::sargs::get $BankEftSettings ".originator_long_name"]; ;#// max 30 characters ::set ClientShortName [::sargs::get $BankEftSettings ".originator_short_name"]; ;#// max 15 characters ::set CurrencyType [::sargs::get $BankEftSettings ".currency_type"]; ;#// CAD or USD ::set OptionalRecord [::sargs::get $BankEftSettings ".optional_record"]; ;#// This is additional info to print on the cheque (Merry Xmas) #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment ::switch $TransType { deposit { ::set PaymentType "D"; ::set PaymentTypeBackward "C"; } payment { ::set PaymentType "C"; ::set PaymentTypeBackward "D"; } } #// # kludge alert... when we support transfers from Canada to US ::set CountryName "CDN"; ;#// or USA #// ::set ReceiverBankId [::sargs::get $ReceiverEftSettings ".bank_id"]; ::set ReceiverBankTransit [::sargs::get $ReceiverEftSettings ".bank_transit"]; ::set ReceiverBankAccount [::sargs::get $ReceiverEftSettings ".bank_account"]; ::set Transaction [$Transaction odb_master]; ::set Date [[$Transaction ".date"] odb_get]; ::set RefNumber [[$Transaction ".reference"] odb_get]; ::set Amount [::qw::number::negative [[$Transaction ".posting/credit.amount"] odb_get]]; #// ::incr _detail_item_count; ::incr _batch_detail_item_count; ::qw::number::var::add _detail_item_sum $Amount; ::qw::number::var::add _batch_detail_item_sum $Amount; ::set Amount [::expr {int([::qw::number::multiply $Amount 100.0])}]; #nv2.28.0 (new feature) - audit eft payments/deposits - just like audit_print_check ::lappend _detail_item_list $Transaction; ::lappend _detail_item_list $Receiver; #// ::incr _line_number; ::switch -glob -- $BankId { "0001" { # Bank of Montreal #::append EftString "C"; ::append EftString $PaymentType; ::append EftString [::format "%010s" $Amount]; ::append EftString [::format "%04s" $ReceiverBankId]; ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-12s" $ReceiverBankAccount]; ::append EftString [::string range [::format "%-29s" $ReceiverName] 0 28]; ::switch $TransType { deposit {::append EftString [::format "%-15s" $RefNumber]\n;} payment {::append EftString [::format "%-19s" $RefNumber]\n;} } } "0002" { # Scotia Bank #::append EftString "C"; ::append EftString $PaymentType; ::append EftString $CpaCode; ::append EftString [::format "%010s" $Amount]; ::append EftString "[::string range [::qw::date::format $Date %Y] 1 end][::qw::date::format $Date %j]"; ;#// yyyddd ::append EftString [::format "%03s" [::string range $ReceiverBankId 1 3]]; ;#// Why 3 when everyone else is using 4? ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-12s" $ReceiverBankAccount]; ::append EftString [::string range [::format "%-30s" $ReceiverName] 0 29]; ::append EftString [::string repeat " " 10]\n; # Scotia Bank uses 2 records per cheque. This is called the C2 pair. ::switch $TransType { deposit {::append EftString 3;} payment {::append EftString 2;} } ::append EftString [::format "%-19s" $RefNumber]; ::append EftString [::format "%-15s" $OptionalRecord]; ::append EftString [::format "%-12s" $ReceiverBankAccount]; ::append EftString [::string repeat " " 33]\n; } "0003_original" { # Royal Bank #20060207_build_change (eft - Royal Bank) ::set CountryName "CAN"; ;#// or USA ::append EftString [::format "%06s" $_line_number]; ::append EftString "C"; ::append EftString $CpaCode; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::string repeat " " 1]; #// #::append EftString [::string repeat "0" 19]; ;#// Customer Number ::append EftString [::string range [::format "%-19s" $ReceiverId] 0 18]; ;#// Customer Number ::append EftString [::string repeat "0" 2]; ;#// Payment Number #// ::append EftString [::format "%04s" $ReceiverBankId]; ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-18s" $ReceiverBankAccount]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%010s" $Amount]; ::append EftString [::string repeat " " 6]; ::append EftString "[::qw::date::format $Date %Y][::qw::date::format $Date %j]"; ;#// yyyyddd ::append EftString [::string range [::format "%-30s" $ReceiverName] 0 29]; ::append EftString "E"; ;#// Language (E - English, F - French) ::append EftString " "; ;#// Payment Medium (E - Electronic, P - Paper, space is reserved for future use) ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%-3s" $CountryName]; ::append EftString [::string repeat " " 2]; ::append EftString [::string repeat " " 2]; ::append EftString N\n; ;#// Client has optional data (Y or N) } "0003" { # Royal Bank #nv2.17.0 (eft) ::set CountryName "CAN"; ;#// or USA ::if {[::string trim [::string tolower [[$Receiver .address.country] odb_get]]] eq "usa"} { ::set CountryName "USA"; ;#// or USA } ::if {$CountryName eq "CAN"} { ::append EftString [::format "%06s" $_line_number]; #::append EftString "C"; ::append EftString $PaymentType; ::append EftString $CpaCode; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::string repeat " " 1]; ::append EftString [::string range [::format "%-19s" $ReceiverId] 0 18]; ;#// Customer Number ::append EftString [::string repeat "0" 2]; ;#// Payment Number ::append EftString [::format "%04s" $ReceiverBankId]; ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-18s" $ReceiverBankAccount]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%010s" $Amount]; ::append EftString [::string repeat " " 6]; ::append EftString "[::qw::date::format $Date %Y][::qw::date::format $Date %j]"; ;#// yyyyddd ::append EftString [::string range [::format "%-30s" $ReceiverName] 0 29]; ::append EftString "E"; ;#// Language (E - English, F - French) ::append EftString " "; ;#// Payment Medium (E - Electronic, P - Paper, space is reserved for future use) ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%-3s" $CountryName]; ::append EftString [::string repeat " " 2]; ::append EftString [::string repeat " " 2]; ::append EftString N\n; ;#// Client has optional data (Y or N) } ::if {$CountryName eq "USA"} { ::set RootAccount [[$Receiver odb_database application] /OBJECT/NEWVIEWS/ACCOUNT]; ::append EftString [::format "%06s" $_line_number]; #::append EftString "C"; ::append EftString $PaymentType; ::append EftString [::format "%03s" [::sargs::get $ReceiverEftSettings ".transaction_code"]]; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%-19s" [::string range $ReceiverId 0 14]]; ;#// Customer Number ::append EftString [::string repeat "0" 2]; ;#// Payment Number ::append EftString [::format "%09s" $ReceiverBankTransit]; ::append EftString [::format "%-18s" $ReceiverBankAccount]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%010s" $Amount]; ::append EftString [::string repeat " " 6]; ::append EftString "[::qw::date::format $Date %Y][::qw::date::format $Date %j]"; ;#// yyyyddd ::append EftString [::string range [::format "%-30s" $ReceiverName] 0 29]; ::append EftString "E"; ;#// Language (E - English, F - French) ::append EftString " "; ;#// Payment Medium (E - Electronic, P - Paper, space is reserved for future use) ::append EftString [::format "%-15s" $ClientShortName]; ::append EftString [::format "%-3s" $CurrencyType]; ::append EftString [::string repeat " " 1]; ::append EftString [::format "%-3s" $CountryName]; ::append EftString [::string repeat " " 2]; ::append EftString [::string repeat " " 2]; ::append EftString N\n; ;#// Client has optional data (Y or N) # append two IRS detail records ::incr _line_number; ::append EftString [::format "%06s" $_line_number]; #// DMP Why is there a C here and a few lines down. Need to check this. ::append EftString "C"; ::append EftString "AD1"; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::format "%-30s" $ClientLongName]; ::append EftString [::format "%-35s" [[$RootAccount .address.street] odb_get]]; ::append EftString [::format "%-35s" "[[$RootAccount .address.city] odb_get]*[[$RootAccount .address.state] odb_get]\\"]; ::append EftString [::format "%-32s" "[[$RootAccount .address.country] odb_get]*[[$RootAccount .address.zipcode] odb_get]\\"]\n; ::incr _line_number; ::append EftString [::format "%06s" $_line_number]; ::append EftString "C"; ::append EftString "AD2"; ::append EftString [::format "%-10s" $OriginatorId]; ::append EftString [::string range [::format "%-35s" [[$Receiver .address.street] odb_get]] 0 34]; ::append EftString [::format "%-35s" "[[$Receiver .address.city] odb_get]*[[$Receiver .address.state] odb_get]\\"]; ::append EftString [::format "%-35s" "[[$Receiver .address.country] odb_get]*[[$Receiver .address.zipcode] odb_get]\\"]; ::append EftString "BUS"; ::append EftString [::format "%-10s" [::sargs::get $BankEftSettings ".optional_comment"]]; ::append EftString [::string repeat " " 14]\n; } } "0004" { # TD #nv2.28.1 (bug fix) - DMP fuckup - TD bank EFT detail item records unconditionally begin with "D", for "detail" #::append EftString "D"; #::append EftString $PaymentType; ::append EftString "D"; ::append EftString [::string range [::format "%-23s" $ReceiverName] 0 22]; ::append EftString [::qw::date::format $Date "%d%m%y"]; ;#// ddmmyy ::append EftString [::format "%-19s" $RefNumber]; ::append EftString [::format "%04s" $ReceiverBankId]; ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-12s" $ReceiverBankAccount]; ::append EftString [::format "%010s" $Amount]\n; } "0010" { # CIBC ::append EftString 6; #::append EftString "C"; ;#//DD Service "C" or PAP Service "D" ::append EftString $PaymentType; ::append EftString [::string repeat " " 1] ::append EftString [::format "%04s" $ReceiverBankId]; ::append EftString [::format "%05s" $ReceiverBankTransit]; ::append EftString [::format "%-12s" $ReceiverBankAccount]; ::append EftString [::string repeat " " 5]; ::append EftString [::format "%010s" $Amount]; ::append EftString [::format "%-13s" $RefNumber]; ::append EftString [::string range [::format "%-22s" $ReceiverName] 0 21]; ::append EftString [::string repeat " " 6]\n; } "0006" - "08??" - default { # National #nv2.28.0 (new feature) - JRP - credit unions #// Credit Unions - CPA standard 005 - Logical record Type "D" - Page 6 - 1464 byte strings #::append EftString "D"; ;#// 01 "D" - Logical Record Type ID ::if {($_detail_item_count%6)==1} { ::append EftString $PaymentType; #nv2.30.0 (bug fix) - EFT file format for credit unions - detail item record count corrected #::append EftString [::format "%09s" $_line_number]; ;#// 02 Numeric - Logical Record Count ::append EftString [::format "%09s" [::expr {int(ceil(double($_detail_item_count)/6.0))+1}]]; ;#// 02 Numeric - Logical Record Count ::append EftString [::format "%-10s" $OriginatorId]; ;#// 03 Alphanumeric - Origination Control Data ::append EftString [::format "%04s" $FileCreationNumber]; ;#// 03 Alphanumeric - Origination Control Data } # --------------------------------PHIL ----------------------------------------------------- # the code below repeats 6 times. That is, 6 employees are strung together to create one record. # if you have fewer than 6 employees, you must pad the record out with blanks to a record length of 1464. ::append EftString $CpaCode; ;#// 04 Numeric - Transaction Type ::append EftString [::format "%010s" $Amount]; ;#// 05 Numeric - Amount ::append EftString "[::string range [::qw::date::format $Date %Y] 1 end][::qw::date::format $Date %j]"; ;#// 0yyddd; ::append EftString [::format "%04s" $ReceiverBankId]; ;#// 07 Numeric - Institutional Identification No. ::append EftString [::format "%05s" $ReceiverBankTransit]; ;#// 07 Numeric - Institutional Identification No. ::append EftString [::format "%-12s" $ReceiverBankAccount]; ;#// 08 Alphanumeric - Payer Account No. ::append EftString [::string repeat "0" 22]; ;#// search string ::append EftString [::string repeat "0" 3]; ;#// 10 Numeric - Stored Transaction Type ::append EftString [::format "%-15s" $ClientShortName]; ;#// 11 Alphanumeric - Originator's Short Name ::append EftString [::format "%-30s" $ReceiverName]; ;#// 12 Alphanumeric - Payor Name (name of the account to be debited) ::append EftString [::format "%-30s" $ClientLongName]; ;#// 13 Alphanumeric - Originator Long Name (name of the originator of the transaction) ::append EftString [::format "%-10s" $OriginatorId]; ;#// 14 Alphanumeric - Originating Direct Clearer's Users's ID ::append EftString [::string repeat " " 19]; ;#// 15 Alphanumeric - Originator's Cross Reference No. ::append EftString [::format "%04s" $BankId]; ;#// 16 Numeric - Institutional ID Number for Returns ::append EftString [::format "%05s" $BranchId]; ;#// 16 Numeric - Institutional ID Number for Returns ::append EftString [::format "%-12s" $ReturnBankAccount]; ;#// 17 Alphanumeric - Account No. for Returns ::append EftString [::string repeat " " 15]; ;#// 18 Alphanumeric - Originator's Sundry Information ::append EftString [::string repeat " " 22]; ;#// 19 Alphanumeric - Filler ::append EftString [::string repeat " " 2]; ;#// 20 Alphanumeric - Originator-Direct Clearer Settlement Code ::append EftString [::string repeat "0" 11]; ;#// 21 Numeric - Invalid Data Element I.D. #---------------------------- END of 6 employee loop -------------------------------------- # NOTICE ;#// the last item may be padded by the file footer kludge ::if {($_detail_item_count%6)==0} { ::append EftString \n; ;#// after you reach a record length of 1464 } } } /* { default { # we're not in kansas if we ever get here ::return $Text; } */} ::return [::append Text "$EftString"]; } } } ::namespace eval ::QW::EFT::USA { ::proc eft_bank_settings_check {s_args} { #//::QW::EFT::USA /* { "0" {::return "Immediate Origin ID";} "1" {::return "Immediate Origin Name";} "2" {::return "Immediate Destination ID";} "3" {::return "Immediate Destination Name";} "4" {::return "Company Name";} "5" {::return "Company Identification";} "6" {::return "Message Authentication Code";} "7" {::return "Originating DFI ID";} "8" {::return "Reference Code";} "9" {::return "Service Class Code";} "10" {::return "Standard Entry Class Code";} "11" {::return "Company Entry Description";} "12" {::return "Company Discretionary Data";} "13" {::return "File Name";} "14" {::return "File ID Modifier";} "0" {::return [::sargs::get $Settings ".immediate_origin_id"];} "1" {::return [::sargs::get $Settings ".immediate_origin_name"];} "2" {::return [::sargs::get $Settings ".immediate_destination_id"];} "3" {::return [::sargs::get $Settings ".immediate_destination_name"];} "4" {::return [::sargs::get $Settings ".company_name"];} "5" {::return [::sargs::get $Settings ".company_identification"];} "6" {::return [::sargs::get $Settings ".message_authentication_code"];} "7" {::return [::sargs::get $Settings ".originating_dfi_id"];} "8" {::return [::sargs::get $Settings ".reference_code"];} "9" {::return [::sargs::get $Settings ".service_class_code"];} "10" {::return [::sargs::get $Settings ".standard_entry_class_code"];} "11" {::return [::sargs::get $Settings ".company_entry_description"];} "12" {::return [::sargs::get $Settings ".company_discretionary_data"];} "13" {::return [::sargs::get $Settings ".file_name"];} "14" {::return [::sargs::get $Settings ".file_id_modifier"];} */} #// ::set Bpath [[::sargs::get $s_args ".bank_address"] odb_path_help]; #// ::if {[::sargs::get $s_args ".immediate_origin_id"] eq ""} { #::qw::stack_dump; ;#//pgq,debug ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Immediate Origin ID\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".immediate_origin_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Immediate Origin Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".immediate_destination_id"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Immediate Destination ID\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".immediate_destination_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Immediate Destination Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".company_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Company Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".originating_dfi_id"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Originating DFI ID\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".service_class_code"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Service Class Code\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".standard_entry_class_code"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Standard Entry Class Code\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".company_entry_description"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"Company Entry Description\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".file_name"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"File Name\"." \ .help_id 0 \ ]; } ::if {[::sargs::get $s_args ".file_id_modifier"] eq ""} { ::qw::throw [::sargs \ .text "Account $Bpath - EFT USA Info does not specify the \"File ID Modifier\"." \ .help_id 0 \ ]; } } ::proc eft_file_header_create {ClockSeconds BankEftSettings Text} { #//::QW::EFT::USA ::uplevel 1 { ::set _line_number 0; ::set _batch_count 0; ::set _detail_item_count 0; ::set _detail_item_sum 0.0; ::set _file_hash 0; #nv2.28.0 (new feature) - audit eft payments/deposits - just like audit_print_check ::set _detail_item_list [::list]; #// # bank account eft info for the file header #// ::set ImmediateDestinationId [::sargs::get $BankEftSettings ".immediate_destination_id"]; ;#// Company's Bank Transit Number. 9 digits ::set ImmediateOriginId [::sargs::get $BankEftSettings ".immediate_origin_id"]; ::set FileIDModifier [::sargs::get $BankEftSettings ".file_id_modifier"]; ::set ImmediateDestinationName [::sargs::get $BankEftSettings ".immediate_destination_name"]; ;#// max 23 characters ::set ImmediateOriginName [::sargs::get $BankEftSettings ".immediate_origin_name"]; ;#// max 23 characters ::set ReferenceCode [::sargs::get $BankEftSettings ".reference_code"]; #// ::incr _line_number; ;#// this will give us a count of the total number of records. Necessary info for the file footer, base 1 #// #// For US banks, the file structure remains constant. The information contained in some of the fields is at the bank's descretion so the #// concept here will be to have the fields as generic as possible ans allow the user to enter whatever their bank tells them. #// ::set FileCreationDate [::format "%06s" [::clock format $ClockSeconds -format "%y%m%d"]]; ;#// yymmdd ::set FileCreationTime [::format "%04s" [::clock format $ClockSeconds -format "%H%M"]]; ;#// Hour & Minute in 24 hour format #// ::append EftString "1"; ;#//Record Code ::append EftString "01"; ;#//Priority Code ::append EftString " "; ::append EftString $ImmediateDestinationId; ::if {[::string length $ImmediateOriginId]==9} { ::append EftString " "; } ::append EftString $ImmediateOriginId; ::append EftString $FileCreationDate; ::append EftString $FileCreationTime; ::append EftString $FileIDModifier; ::append EftString "094"; ;#// Record Size ::append EftString "10"; ;#// Blocking Factor ::append EftString "1"; ;#// Format Code ::append EftString [::format "%-23s" $ImmediateDestinationName]; ::append EftString [::format "%-23s" $ImmediateOriginName]; ::append EftString [::format "%-8s" $ReferenceCode]\n; #// ::return [::append Text "$EftString"]; } } ::proc eft_file_footer_create {BankEftSettings Text} { #//::QW::EFT::USA ::uplevel 1 { ::incr _line_number; #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment #// #//::puts "eft_file_footer_create _line_number==$_line_number"; #//::puts "eft_file_footer_create _detail_item_count==$_detail_item_count"; #//::puts "eft_file_footer_create _detail_item_sum==$_detail_item_sum"; #// #PGQ This is the sum of all detail hash amounts for all batches. I only want the last 10 digits. ::set FileHash [::string range $_file_hash [::expr {[::string length $_file_hash]-10}] end]; #// ::append EftString "9"; ::append EftString [::format "%06s" $_batch_count]; ::set BlockCount [::expr {$_line_number/10}]; #nv2.11.4 #//::puts "::QW::EFT::USA eft_file_footer_create $_line_number==$_line_number _line_number%10==[::expr ($_line_number%10)]"; ::set PadLines 0; ::if {($_line_number%10)!=0} { ::incr BlockCount; ::set PadLines [::expr {10-($_line_number%10)}]; } ::append EftString [::format "%06s" $BlockCount]; ;#// block count (i.e. 10 rows per block, padded to a multiple of 10) ::append EftString [::format "%08s" $_detail_item_count]; ::append EftString [::format "%010s" $FileHash]; ;#// arithmetic sum of the 8 digit DFI routing numbers but limited to the last 10 digits. #nv2.28.0 (new feature) - eft_transfer_deposit_228 #::append EftString [::string repeat "0" 12]; ;#// this is the debit amount (not used, so zeros) #::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_detail_item_sum] 100.0])}]]; ::switch $TransType { deposit { ::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_detail_item_sum] 100.0])}]]; ::append EftString [::string repeat "0" 12]; ;#// this is the credit amount } payment { ::append EftString [::string repeat "0" 12]; ;#// this is the debit amount ::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_detail_item_sum] 100.0])}]]; } } ::append EftString [::string repeat " " 39]\n; ;#// reserved ::for {::set j 0;} {$j<$PadLines} {::incr j} { ::append EftString [::string repeat "9" 94]\n; } ::return [::append Text "$EftString"]; } } ::proc eft_batch_header_create {Date BankEftSettings Text} { #//::QW::EFT::USA ::uplevel 1 { ::set Date [::string range $Date 1 end]; ;#// strip off the leading . #// ::set _batch_detail_item_count 0; ::set _batch_detail_item_sum 0.0; ::set _batch_hash 0; #// ::incr _batch_count; ::incr _line_number; #// ::append EftString "5"; # According to the manual, the service class code will always be either 220 for Credits (EFT Payments) or 225 for Debits (PAD). We seem to have it hard wired in tha bank # setup to be 200 which is the code for mixed debits/credits. ::append EftString [::format "%03s" [::sargs::get $BankEftSettings ".service_class_code"]]; ::append EftString [::string range [::format "%-16s" [::sargs::get $BankEftSettings ".company_name"]] 0 15]; ::append EftString [::string range [::format "%-20s" [::sargs::get $BankEftSettings ".company_discretionary_data"]] 0 19]; ::if {[::string length [::sargs::get $BankEftSettings ".company_identification"]]==9} { ::append EftString " "; } ::append EftString [::sargs::get $BankEftSettings ".company_identification"]; ::append EftString [::format "%-3s" [::sargs::get $BankEftSettings ".standard_entry_class_code"]]; ::append EftString [::string range [::format "%-10s" [::sargs::get $BankEftSettings ".company_entry_description"]] 0 9]; ::append EftString [::clock format [::clock scan $Date] -format "%m%d%y"]; ::append EftString [::clock format [::clock scan $Date] -format "%y%m%d"]; ::append EftString [::string repeat " " 3]; ;#// Settlement (Julian) date to be left blank. ::append EftString "1"; ;#// Originator Status Code ::append EftString [::format "%08s" [::sargs::get $BankEftSettings ".originating_dfi_id"]]; ::append EftString [::format "%07s" $_batch_count]\n; #// ::return [::append Text "$EftString"]; } } ::proc eft_batch_footer_create {BankEftSettings Text} { #//::QW::EFT::USA ::uplevel 1 { ::set ServiceClassCode [::sargs::get $BankEftSettings ".service_class_code"]; #::set ImmediateOriginId [::sargs::get $BankEftSettings ".immediate_origin_id"]; ::set CompanyIdentification [::sargs::get $BankEftSettings ".company_identification"]; ::set CompanyAuthenticationCode [::sargs::get $BankEftSettings ".message_authentication_code"]; ;#// Max 8 characters ::set OriginatingDfiId [::sargs::get $BankEftSettings ".originating_dfi_id"]; ;#// Company's Bank Transit Number #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::set TransType [::sargs::get $BankEftSettings ".transaction_type"]; ;#// deposit or payment #// ::incr _line_number; #PGQ BatchHash is the sum of the detail hash amounts limited to the last 10 digits ::set BatchHash [::string range $_batch_hash [::expr {[::string length $_batch_hash]-10}] end]; #PGQ _file_hash is the total for the whole file. ::set _file_hash [::expr {$_file_hash+$_batch_hash}]; ;#// the file footer prints the sum of all detail hashs for all batches #// ::append EftString "8"; ::append EftString [::format "%03s" $ServiceClassCode]; ::append EftString [::format "%06s" $_batch_detail_item_count]; ::append EftString [::format "%010s" $BatchHash]; ;#// sum of the leftmost 8 digits of 9 digit DFI routing numbers, but limited to the last 10 digits #::append EftString [::string repeat "0" 12]; ;#// this is the debit amount #::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_batch_detail_item_sum] 100.0])}]]; ::switch $TransType { deposit { ::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_batch_detail_item_sum] 100.0])}]]; ::append EftString [::string repeat "0" 12]; ;#// this is the credit amount } payment { ::append EftString [::string repeat "0" 12]; ;#// this is the debit amount ::append EftString [::format "%012s" [::expr {int([::qw::number::multiply [::format %.2f $_batch_detail_item_sum] 100.0])}]]; } } #// #::append EftString [::format "%-10s" $ImmediateOriginId]; ;#// Company Identification ::if {[::string length $CompanyIdentification]==9} { ::append EftString " "; } ::append EftString $CompanyIdentification; #// ::append EftString [::string range [::format "%-19s" $CompanyAuthenticationCode] 0 18]; ::append EftString [::string repeat " " 6]; ;#// Reserved #::append EftString [::format "%08s" [::string range $ImmediateDestinationId 0 7]]; ::append EftString [::format "%08s" $OriginatingDfiId]; ::append EftString [::format "%07s" $_batch_count]\n; #// #//::puts "eft_batch_footer_create _batch_count==$_batch_count"; #//::puts "eft_batch_footer_create _batch_detail_item_count==$_batch_detail_item_count"; #//::puts "eft_batch_footer_create _batch_detail_item_sum==$_batch_detail_item_sum"; #// ::return [::append Text "$EftString"]; } } ::proc eft_transaction_item_create {Receiver Transaction BankEftSettings ReceiverEftSettings Text} { #//::QW::EFT::USA ::uplevel 1 { #// #//::puts "::QW::EFT::USA::eft_transaction_item_create Transaction==[$Transaction odb_path]"; #// #nv2.28.0 (new feature) - eft_transfer_deposit_228 ::switch -glob -- [$Transaction odb_path] { "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/BANK/DEPOSIT*" - "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/BANK/PAYMENT*" { ::set ReceiverId [[$Receiver ".name"] odb_get]; ::set ReceiverName [[$Receiver ".description"] odb_get]; } "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION/PAYROLL/PAYCHECK*" { #::if {[::sargs::get $ReceiverEftSettings ".status"] ne "active"} {::return $Text;} ::set ReceiverId [[[[[[$Transaction odb_master] ".employee"] odb_get] odb_master] ".employee_id"] odb_get]; ;#// 15 characters max ::set ReceiverName [[[[[[$Transaction odb_master] ".employee"] odb_get] odb_master] ".employee_name.print_as"] odb_get]; } default { ::qw::throw [::sargs \ .text "Attempted to EFT transfer unsupported transaction type \"[[$Transaction odb_master] odb_class_path]\"." \ .help_id 0 \ ]; } } ::set OriginatingDfiId [::sargs::get $BankEftSettings ".originating_dfi_id"]; ;#// Company's Bank Transit Number ::set ReceiverBankTransit [::sargs::get $ReceiverEftSettings ".bank_transit"]; ::set ReceiverBankAccount [::sargs::get $ReceiverEftSettings ".bank_account"]; # The transaction code controls whether we are debiting or crediting an account. # 22 and 32 are credits to a chequing or savings account respectivly. 27 or 37 are debits to a chequing or savings account respectivly. ::set Transaction [$Transaction odb_master]; ::set Date [[$Transaction ".date"] odb_get]; ::set RefNumber [[$Transaction ".reference"] odb_get]; ::set Amount [::format %.2f [::qw::number::negative [[$Transaction ".posting/credit.amount"] odb_get]]]; #// ::incr _detail_item_count; ::incr _batch_detail_item_count; ::qw::number::var::add _detail_item_sum $Amount; ::qw::number::var::add _batch_detail_item_sum $Amount; ::set Amount [::expr {int([::qw::number::multiply $Amount 100.0])}]; #nv2.28.0 (new feature) - audit eft payments/deposits - just like audit_print_check ::lappend _detail_item_list $Transaction; ::lappend _detail_item_list $Receiver; #// #//::puts "::QW::EFT::USA::eft_transaction_item_create _batch_hash==$_batch_hash ::string range $ReceiverBankTransit 0 7==[::string range $ReceiverBankTransit 0 7]"; #//::QW::EFT::USA::eft_transaction_item_create _batch_hash==1114116 ::string range 021000089 0 7==02100008 #::set _batch_hash [::expr {$_batch_hash+[::string range $ReceiverBankTransit 0 7]}]; ;#// octal strikes again ::set _batch_hash [::expr {$_batch_hash+[::string trimleft [::string range $ReceiverBankTransit 0 7] 0]}]; #// ::incr _line_number; #// ::append EftString "6"; #::append EftString "22"; ;#// Transaction Code ::append EftString [::sargs::get $ReceiverEftSettings ".transaction_code"]; ::append EftString [::format "%-9s" $ReceiverBankTransit]; ;#// Receiving DFI ID, 8 digits plus 1 check digit ::append EftString [::format "%-17s" $ReceiverBankAccount]; ;#// DFI Account ::append EftString [::format "%010s" $Amount]; ::append EftString [::string range [::format "%-15s" $ReceiverId] 0 14]; ::append EftString [::string range [::format "%-22s" $ReceiverName] 0 21]; ::append EftString [::string repeat " " 2]; ;#// Discretionary Data ::append EftString "0"; ;#// We may want to consider addenda records for A/P cheques as we could use this to list the invoices being paid. #::append EftString [::format "%08s" [::string range $ImmediateDestinationId 0 7]]; ::append EftString [::format "%08s" $OriginatingDfiId]; ::append EftString [::format "%07s" $_detail_item_count]\n; #// ::return [::append Text "$EftString"]; } } } ::namespace eval ::QW::GUI { /* { ::QW::GUI::COLLECTION ::QW::GUI::DISTANCE ::QW::GUI::EVENT ::QW::GUI::IMAGE_BITMAP ::QW::GUI::NEWVIEWS ::QW::GUI::OPTIONS ::QW::GUI::OPTIONS_FONT ::QW::GUI::OPTIONS_IMAGE ::QW::GUI::OPTIONS_IMAGE_PHOTO ::QW::GUI::POINT ::QW::GUI::RECTANGLE ::QW::GUI::REFERENCE ::QW::GUI::SANDWICH_TABLE_SIGNAL_WRITE ::QW::GUI::SANDWICH_WAIT_CURSOR ::QW::GUI::SYSTEM ::QW::GUI::TEXT ::QW::GUI::WIDGET ::QW::GUI::WIDGET_CALENDAR ::QW::GUI::WIDGET_CANVAS ::QW::GUI::WIDGET_CANVAS_TREE ::QW::GUI::WIDGET_ENTRY ::QW::GUI::WIDGET_HTML ::QW::GUI::WIDGET_LABEL ::QW::GUI::WIDGET_LABEL_BUTTON ::QW::GUI::WIDGET_LABEL_BUTTON_CHECK ::QW::GUI::WIDGET_LABEL_BUTTON_PUSH ::QW::GUI::WIDGET_LABEL_BUTTON_RADIO ::QW::GUI::WIDGET_SCALE ::QW::GUI::WIDGET_SCREEN ::QW::GUI::WIDGET_SCROLLBAR ::QW::GUI::WIDGET_TABLE ::QW::GUI::WIDGET_TABNOTEBOOK ::QW::GUI::WIDGET_TEXT ::QW::GUI::WINEXPLO */} /* { ::QW::GUI::color_darken ::QW::GUI::database_boolean ::QW::GUI::duplicate_database_explorer ::QW::GUI::eval ::QW::GUI::generic_notes_table_definition ::QW::GUI::generic_procedure_notes_table_definition ::QW::GUI::generic_table_definition ::QW::GUI::is_branch_row_with_closure ::QW::GUI::list_remove_duplicates ::QW::GUI::low_level_window_copy ::QW::GUI::low_level_window_setup_script_marker_set ::QW::GUI::lreverse ::QW::GUI::multiline_title ::QW::GUI::puts_stderr ::QW::GUI::remove_amount_formatting ::QW::GUI::settings_sub_find_by_name ::QW::GUI::start_team_viewer ::QW::GUI::string2hex ::QW::GUI::structure_sort_subs ::QW::GUI::subst ::QW::GUI::uniqueId ::QW::GUI::unique_database_explorer_name ::QW::GUI::unique_name ::QW::GUI::unique_settings_name ::QW::GUI::window_boolean ::QW::GUI::window_default_setup_decr ::QW::GUI::window_default_setup_incr */} ::set _focus_traffic 1; ::set _uniqueId 0; #nv2.28.0 (new utility) ::proc is_branch_row_with_closure {sargs} { ::set Win [::sargs::get $sargs .window]; ::set Object [::sargs::get $sargs .odb_object]; ::set Row [::sargs::get $sargs .row]; #// branch row #// phony total row ::set CurrentIndex [[$Win .observer_index] odb_get]; #20040220_total_row (branch rows and closure indexes) #::set BranchRowWithClosure 0; ;#// here just for grep #//::set Od [[$Win observer_database] odb_master]; #//::puts "pgq,debug228::QW::GUI::is_branch_row_with_closure Object==[::expr {$Object eq ""?{}:[$Object odb_path_help]}] Od==[::expr {$Od eq ""?{}:[$Od odb_path_help]}]"; ::if {$Object ne [[$Win observer_database] odb_master] \ &&[::string first "_closure" $CurrentIndex]>=0 \ &&[[$Object .odb_deriveds] odb_items]>0 \ &&$Row<[[$Win observer_database] odb_items] \ &&[::string first "/" [::string map [::list .index ""] $CurrentIndex] 1]<0 \ } { ::return 1; } ::return 0; } #nv2.26.0 (new feature) - for nvnph_compile - auto switch to most important view of a table ::proc ::QW::GUI::settings_sub_find_by_name {sargs} { ::set Window [::sargs::get $sargs .window]; ::set Name [::sargs::get $sargs .name]; ::set SavedSettings [[$Window .saved_settings] odb_get]; #//::foreach Sub [::sargs::subs .structure [::sargs::get $SavedSettings /column_define]] { #// ::puts "pgq,debug::QW::GUI::settings_sub_find_by_name ::foreach all Sub==$Sub /column_define$Sub.name==[::sargs::get $SavedSettings /column_define$Sub.name]"; #//} ::foreach Sub [::sargs::subs .structure [::sargs::get $SavedSettings /column_define]] { #//::puts "pgq,debug::QW::GUI::settings_sub_find_by_name ::foreach Sub==$Sub /column_define$Sub.name==[::sargs::get $SavedSettings /column_define$Sub.name]"; ::if {[::sargs::get $SavedSettings /column_define$Sub.name] eq $Name} { #::return $Sub; ::return [::string map [::list / ""] $Sub]; } } ::return ""; # auto install the view } #nv2.25.3a (new feature) - column_multiply ::proc remove_amount_formatting {Src} { /* { enter Src=="837.78 " ::string is digit==0 enter Src=="837.78 " ::string is double==1 ::regsub Result=="837.78" Src=="837.78 " Src=="837.78 " Result=="837.78" enter Src=="TOTUSW." enter Src=="TOTUSW." ::string is digit==0 enter Src=="TOTUSW." ::string is double==0 ::regsub Result=="." Src=="TOTUSW." Src=="TOTUSW." Result=="." enter Src=="" enter Src=="" ::string is digit==1 enter Src=="" ::string is double==1 ::regsub Result=="" Src=="" Src=="" Result=="" */} #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting enter Src==\"$Src\""; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting enter Src==\"$Src\" ::string is digit==[::string is digit $Src]"; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting enter Src==\"$Src\" ::string is double==[::string is double $Src]"; #//#//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting enter Src==\"$Src\" ::qw::number::scan==\"[::qw::number::scan $Src]\""; #// enter Src=="TOTCANU" ::qw::number::scan=={syntax error in expression "TOTCANU": variable references require preceding $} ::set Result [::regsub -all {[^0-9.]} $Src ""]; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting ::regsub Result==\"$Result\""; ::if {[::regexp {\(|-} $Src]} { #// ) to match ::set Result [::qw::number::negative $Result]; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting ::regexp Result==\"$Result\""; } #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting Src==\"$Src\""; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting Src==\"$Src\" Result==\"$Result\""; #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting Src==\"$Src\" Result==\"$Result\" ::qw::number::scan==\"[::qw::number::scan $Src]\""; #nv2.34.9 (bug fix) - ::proc remove_amount_formatting - AFTER removing parentheses - added test for ::string is double ::if {![::string is double $Result]} { #// three choices #::return $Src; #::return 0; #::return ""; ::set Result ""; } #//::puts "pgq,debug::qw::print::windows::table::postings remove_amount_formatting ::return Result==\"$Result\""; ::return $Result; } #nv2.34.0 (go_find_compare) - gui.qw_tcl - list_remove_duplicates - poached from internet ::proc list_remove_duplicates {a} { for {set i 0} {$i < [llength $a]} {incr i} { set indices [lsearch -all $a [lindex $a $i]] foreach index $indices { if {$index != $i} { set a [lreplace $a $index $index] } } } return $a } #nv2.25.0 (new feature) - start team viewer from NV2 help menu ::proc start_team_viewer {} { ::qw::try { #//::puts "pgq,debug...try ::qw_library==$::qw_library file==[::file join $::qw_library lib qw Windows TeamViewerQS.exe]"; #::qw::launch [::file join $::qw_library lib qw Windows TeamViewerQS.exe]; #//::puts "pgq,debug224.1...try ::qw_program_folder==$::qw_program_folder ::exec [::file join $::qw_program_folder TeamViewerQS.exe]"; #nv2.34.1c (bug fix)( - ::QW::GUI::start_team_viewer - won't run if TeamViewer is already running ::qw::try { # batch file code #taskkill /F /IM TeamViewer_Service.exe /T #taskkill /F /IM TeamViewer.exe /T # tcl command #::eval exec [::auto_execok taskkill] /F /IM nv2.exe /T #By image name ::eval ::exec [::auto_execok taskkill] /F /IM TeamViewer.exe /T; ;#// by image name #::eval ::exec [::auto_execok taskkill] /F /IM TeamViewer_Service.exe /T; ;#// by image name } catch Dummy { #//::puts "pgq,debug...start_team_viewer taskkill TeamViewer.exe exception thrown Dummy==$Dummy"; } ::qw::try { ::eval ::exec [::auto_execok taskkill] /F /IM TeamViewer_Service.exe /T; ;#// by image name } catch Dummy { #//::puts "pgq,debug...start_team_viewer taskkill TeamViewer_Service.exe exception thrown Dummy==$Dummy"; } #) ::exec [::file join $::qw_program_folder TeamViewerQS.exe]; } catch Dummy { #//::puts "pgq,debug...start_team_viewer exception thrown Dummy==$Dummy"; } } #nv2.23.0 (new feature) - window tabs that look like tabs /* { ::array set ::QW::GUI::_window_tab_image_array {}; ::foreach {Iname Ifile} { "Accounts" tabs_account.png "History" tabs_history.png "Notes" tabs_notes.png "Ledger" tabs_ledger.png } { #//::puts "pgq,debug223.0.../gui/gui.qw_tcl ::set ::QW::GUI::_window_tab_image_array Iname==$Iname Ifile==$Ifile"; ::set _window_tab_image_array($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; } ::proc ::QW::GUI::window_tab_image_array_get {Text} { ::return ""; #//::puts "pgq,debug223.0.../gui/gui.qw_tcl ::set ::QW::GUI::_window_tab_image_array_get Text==$Text"; ::foreach {N V} [::array get ::QW::GUI::_window_tab_image_array] {::puts "window_tab_image_array_get ::QW::GUI::_window_tab_image_array N==$N V==$V";} ::if {[::info exists ::QW::GUI::_window_tab_image_array($Text)]} { ::return $::QW::GUI::_window_tab_image_array($Text); } ::return ""; } */} #nv2.23.0 (performance improvement) - high speed, low_level_window_copy replace default setup_desktop.qw_script #nv2.26.0 (new feature) - private_window_branch ::if {$::qw::control(low_level_window_copy_226_style)} { # NOT CALLED # 4 procs ::proc ::QW::GUI::low_level_window_setup_script_marker_set {sargs} { #//::puts "pgq,debug...::QW::GUI::low_level_window_setup_script_marker_set sargs==(\n[::sargs::format .structure $sargs]\n)"; #::qw::stack_dump; ;#//pgq,debug #// # helper - called only by 1 local procs #// ::QW::GUI::low_level_window_setup_script_marker_set /* { Set a script path marker in the .clientdata field indicating this is a node that is to be exported to a .nv2_window_template file. First we remove the $::qw_library prefix from the full script path. */ } ::set Window [::sargs::get $sargs .odb.object]; ::if {$Window eq ""} { ::qw::bug 314120120423111111 "[::qw::procname] - empty window."; } ::set ScriptPathMarker [::QW::GUI::low_level_window_copy_private_path_process $sargs]; ::if {$ScriptPathMarker eq ""} { ::qw::bug 314120120423111110 "[::qw::procname] - empty script path."; } [$Window .clientdata] odb_set [::sargs::set [[$Window .clientdata] qw_get] .newviews.default_setup_qw_script $ScriptPathMarker]; } ::proc ::QW::GUI::low_level_window_copy_private_path_process {sargs} { #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy_private_path_process sargs==(\n[::sargs::format .structure $sargs]\n)"; #// # helper - called only by 2 local procs # ::QW::GUI::low_level_window_setup_script_marker_set # ::QW::GUI::low_level_window_copy #// We convert the script path to lower, string off the qw_library prefix, e.g. d:/nv/nv2.exe #// Then, if explorerDepth is instance, we append to the path the observer_database odb_path_help #// using ::qw::union to accommodate overlap # several alternate (superior?) algorithms to build longer private path /* { ...::QW::GUI::low_level_window_copy_private_path_process sargs==( .odb { .object ::qw::odb::20130517133929::/1368908359_628 } .script { .path d:/nv/nv226.exe/object/newviews/account/ap/setup_desktop.qw_script .namespace_id 5 .namespace ::qw::script::5 .stack {{.odb {.object ::qw::odb::20130517133929::/1368908359_628} .script {.path d:/nv/nv226.exe/object/newviews/account/ap/setup_desktop.qw_script .namespace_id 5 .namespace ::qw::script::5}}} } ) */} /* { */ } ::set Window [::sargs::get $sargs .odb.object]; ::set ScriptPath [::string tolower [::sargs::get $sargs .script.path]]; ::set ScriptPath [::string map [::list [::string tolower $::qw_library] ""] $ScriptPath]; #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy_private_path_process Window==[$Window odb_path]\n ScriptPath==$ScriptPath"; #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy_private_path_process Window observer_database==[::expr {[$Window observer_database] eq ""?{}:[[$Window observer_database] odb_path_help]}]"; #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy_private_path_process Window explorerDepth==[$Window explorerDepth]"; ::if {[$Window explorerDepth] eq "instance"} { ::set Slist [::split $ScriptPath /]; #//::puts "pgq,debug677...Slist==$Slist"; ::set SpathList [::lrange $Slist 1 end-1]; ::set Oph [::string tolower [[$Window observer_database] odb_path_help]]; ::set Olist [::lrange [::split $Oph /] 1 end]; #//::puts "pgq,debug677...Slist==$Slist"; #//::puts "pgq,debug677...Olist==$Olist"; #//::puts "pgq,debug677...::qw::union==[::qw::union $SpathList $Olist]"; ::set Rlist [::qw::union $SpathList $Olist]; ::lappend Rlist [::lindex $Slist end]; ::set ScriptPath /[::join $Rlist /]; #::set ScriptPath [::string tolower $::qw_library]/[::join $Rlist /]; } #//::puts "pgq,debug677...::return ScriptPath==$ScriptPath"; ::return $ScriptPath; } ::proc ::QW::GUI::low_level_window_copy_private_template_file_find {sargs} { #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy_private_template_file_find sargs==(\n[::sargs::format .structure $sargs]\n)"; #::qw::stack_dump; ;#//pgq,debug /* { ...::QW::GUI::low_level_window_copy_private_template_file_find sargs==( .workstation_database ::qw::cpp::3 .default_setup_script_path /object/newviews/account/ar/setup_desktop.qw_script ) */} ::set Spath [::string tolower [::sargs::get $sargs .default_setup_script_path]]; #//::puts "pgq,debug677...private_template_file enter Spath==$Spath"; #//...private_template_file enter Spath==/object/newviews/account ::set Wdatabase [::sargs::get $sargs .workstation_database]; ::set Pos [::string first "/object" $Spath]; ::if {$Pos<0} { #::qw::bug 314120120420191940 "[::qw::procname] - invalid setup script path \"$Spath\"."; ::return ""; } ::set Spath [::string range $Spath $Pos end]; #//::puts "pgq,debug677...private_template_file ::file dirname==[::file dirname $Spath]"; #::set Spath [::file dirname $Spath]; ;#// this was necessary in window_template_import ::set Slist [::split $Spath "/"]; #//::puts "pgq,debug677...private_template_file Slist==$Slist"; ::set Sname [::lindex $Slist end]; #//::puts "pgq,debug677...private_template_file Sname==$Sname"; ::set Slist [::lrange $Slist 0 end-1]; #//::puts "pgq,debug677...private_template_file Slist==$Slist"; ::set Spath [::join $Slist "_"]; ::set SpathFound ""; ::set FileFound ""; ::set Header ""; ::while {1} { #//::puts "pgq,debug677...private_template_file ::while Spath==$Spath"; ::if {$Spath eq ""} { ::return ""; } ::foreach Folder [::list \ [::file join [::file dirname $Wdatabase] window_templates] \ [::file join $::qw_data window_templates] \ ] { /* { We search for a file that matches the original setup script path. We search first in the window_templates folder in the workstation folder, if any, and then in workstation folder in the nv2.dat folder. */ } ::set File [::file join $Folder $Spath.nv2_window_template]; #//::puts "pgq,debug677...private_template_file ::foreach File==$File"; ::if {![::file isfile $File]} { ::continue; } ::set Header [::qw::fileutil::header_read .file_path $File]; ::if {$Header eq ""} { ::continue; } ::set Release [::sargs::get $Header .qw_release]; ::set Version [::join [::lrange [::split $Release .] 0 1] .]; ::if {$Version ne ""} { ::if {$Version!=$::qw_version} { ::continue; } } #//::puts "pgq,debug677...private_template_file ::foreach Spath==$Spath"; ::set SpathFound [::split $Spath _]; ::lappend SpathFound $Sname; #//::puts "pgq,debug677...private_template_file ::foreach SpathFound==$SpathFound"; ::set SpathFound [::join $SpathFound /]; ::set FileFound $File; ::break; } ::if {$FileFound ne ""} { ::break; } ::if {![::sargs::boolean_get $sargs .lookup]} { ::break; } ::set Spath [::string range $Spath 0 [::expr [::string last _ $Spath end]-1]]; } #//::puts "pgq,debug677...private_template_file SpathFound==$SpathFound"; #//::puts "pgq,debug677...private_template_file FileFound==$FileFound"; ::return [::sargs::set $sargs \ .setup_script_path_found $SpathFound \ .setup_script_template_file_found $FileFound \ .setup_script_template_file_header $Header \ ]; } ::proc ::QW::GUI::low_level_window_copy {sargs} { #//::puts "pgq,debug...::QW::GUI::low_level_window_copy enter sargs==(\n[::sargs::format $sargs]\n)"; #::qw::stack_dump; ;#//pgq,debug /* { ...::QW::GUI::low_level_window_copy enter sargs==( .odb { .object ::qw::odb::20130517133929::/1368907118_628 } .script { .path d:/nv/nv226.exe/object/newviews/account/ap/setup_desktop.qw_script .namespace_id 5 .namespace ::qw::script::5 .stack {{.odb {.object ::qw::odb::20130517133929::/1368907118_628} .script {.path d:/nv/nv226.exe/object/newviews/account/ap/setup_desktop.qw_script .namespace_id 5 .namespace ::qw::script::5}}} } ) */} # NOTICE - called by 30ish setup_desktop.qw_script files /* { Find a .nv2_window_template file and import it return 0 on failure In either case write the path of the running script (including instance info if any) to the root window */} ::set ScriptPath [::string tolower [::sargs::get $sargs .script.path]]; ::if {$ScriptPath eq ""} { ::qw::bug 314120120422100439 "[::qw::procname] - no script path."; } ::set RootWindow [::sargs::get $sargs .odb.object]; ::if {$RootWindow eq ""} { ::qw::bug 314120120422100440 "[::qw::procname] - no root window."; } #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter ScriptPath ==$ScriptPath"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow ==[$RootWindow odb_path]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow explorerDepth ==[$RootWindow explorerDepth]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow odb_base ==[[$RootWindow odb_base] odb_path]"; #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy enter RootWindow observer_database==[[$RootWindow observer_database] odb_path]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; # kludge alert #//::set Win [[$RootWindow odb_database] "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/ACCOUNT/AP"]; #//$RootWindow window_deriveds_dump $Win; ;#//pgq,debug #//$RootWindow window_relations_dump [$RootWindow screen]; ;#//pgq,debug /* { pgq has no idea how to solve this problem, in the time allotted... The "instance" explore case is not copying windows setup OR the copied in window setup is being lost SO revisit this another time */} ::if {[$RootWindow explorerDepth] eq "instance"} { #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy EXPLICIT instance explore"; #::return 0; } ::set ScriptPath [::QW::GUI::low_level_window_copy_private_path_process $sargs]; #//::puts "pgq,debug...::QW::GUI::low_level_window_copy ScriptPath==$ScriptPath"; ::set TemplateFound [::QW::GUI::low_level_window_copy_private_template_file_find [::sargs .workstation_database [$RootWindow odb_database] .default_setup_script_path $ScriptPath .lookup 1]]; #//::puts "pgq,debug...::QW::GUI::low_level_window_copy TemplateFound==(\n[::sargs::format $TemplateFound]\n)"; ::set ScriptPath [::sargs::get $TemplateFound .setup_script_path_found]; ::if {$ScriptPath eq ""} { ::QW::GUI::low_level_window_setup_script_marker_set $sargs; ::return 0; } #nv2.23.00 /* { These next two tests could come in either order, OR we could omit the first test altogether... In a slow mo high level setup the observer_database is empty Leave them both as a documentation note */} # IDIOT - the next test is always true (e.g. /REPORT==/REPORT) /* { ::if {[$RootWindow observer_database] ne "" \ &&[[$RootWindow observer_database] odb_id] eq [[$RootWindow odb_base] odb_id] \ } { #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy DETECTED 000 instance explore [[$RootWindow observer_database] odb_id]==[[$RootWindow odb_base] odb_id]"; #//...::QW::GUI::low_level_window_copy DETECTED instance explore /1343419073_86==/1343419073_86 ::return 0; } */} # NOTICE ;#// check for all digits in odb_id ::set Rid [[$RootWindow odb_base] odb_id]; ::set Rid [::string map [::list / "" _ ""] $Rid]; ::if {[::regsub -all \[^0-9\] $Rid ""] eq $Rid} { #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy DETECTED 111 instance explore"; #::return 0; } #// #nv2.23.01 #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow==[$RootWindow odb_path] - [[$RootWindow odb_master] window_titles_get]"; #//::puts "\t\t+++ positionInScreen==[[[$RootWindow odb_master] .frame] positionInScreen]"; ;#//pgq,debug #//$RootWindow putsParentList $RootWindow ".clipper.parent";::puts "\n"; ;#//pgq,debug ::set ::qw::control(is_low_level_window_copy) 1; ::qw::finally [::list ::set ::qw::control(is_low_level_window_copy) 0]; ::set Position [[$RootWindow .client] positionInScreen]; ::set Position [::QW::GUI::POINT::+ $Position ".x 80 .y 80"]; ::set Operation [::itcl::local ::QW::OPERATION #auto $Position .text "Installing window setup..."]; /* { #// # NOTICE #// All this code to display a toplevel progress window... THAT CAN BE DESTROYED TO STOP THE OPERATION #// ::set Toplevel ".qw_low_level_window_copy_progress"; ::if {[::winfo exists $Toplevel]} {::destroy $Toplevel;} ::toplevel $Toplevel; ::wm title $Toplevel "Window Setup"; ::set Position [[$RootWindow .frame] positionInScreen]; #//::puts "20040929 Position==$Position"; ::set TopPosition [::QW::GUI::POINT::+ $Position ".x 50 .y 50"]; ::wm geometry $Toplevel "+[::sargs::get $TopPosition .x]+[::sargs::get $TopPosition .y]"; ::set StatusLabel [::label $Toplevel.label -font {Arial 12 bold} -text "Installing default window setup..."] ::pack $StatusLabel; */} ::set Screen [$RootWindow screen]; ::set ScreenOS [[$RootWindow odb_database] cpp_object_structure_load .address $Screen]; ::set Result [::qw::script::source \ .script.path [::file join $::qw_library object system gui window_template_import.qw_script] \ .default_setup_script_path $ScriptPath \ .default_setup_root_window $RootWindow \ ]; #//::puts "pgq,debug677...::QW::GUI::low_level_window_copy ScriptPath==$ScriptPath Result==$Result"; /* { ...::QW::GUI::low_level_window_copy enter RootWindow==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT/1343419073_86/1343419040_1010 ...::QW::GUI::low_level_window_copy enter RootWindow explorerDepth== ...::QW::GUI::low_level_window_copy enter ::qw::control(window_default_setup)==1 ...window_template_import enter sargs==( .script { .path d:/nv/nv223.exe/object/system/gui/window_template_import.qw_script .directory d:/nv/nv223.exe/object/system/gui .folder d:/nv/nv223.exe/object/system/gui .tail window_template_import.qw_script .name window_template_import .extension .qw_script .type .qw_script .namespace_id 9 .namespace ::qw::script::9 .stack {{.script {.path d:/nv/nv223.exe/object/system/gui/window_template_import.qw_script .directory d:/nv/nv223.exe/object/system/gui .folder d:/nv/nv223.exe/object/system/gui .tail window_template_import.qw_script .name window_template_import .extension .qw_script .type .qw_script .namespace_id 9 .namespace ::qw::script::9} .default_setup_script_path d:/nv/nv223.exe/object/newviews/report/setup_desktop.qw_script .default_setup_root_window ::qw::odb::20120727155720::/1343419040_1010}} } .default_setup_script_path d:/nv/nv223.exe/object/newviews/report/setup_desktop.qw_script .default_setup_root_window ::qw::odb::20120727155720::/1343419040_1010 ) ...window_template_import SetupScriptPath==_object_newviews_report ...window_template_import _template_file==d:/nv/nv2.dat/window_templates/_object_newviews_report.nv2_window_template ...::QW::GUI::low_level_window_copy AFTER script ::qw::control(window_default_setup)==1 ...::QW::GUI::low_level_window_copy Result==1 ...::QW::GUI::low_level_window_copy AFTER gui_load ::qw::control(window_default_setup)==1 ...::QW::GUI::window_default_setup_decr ---------------::qw::control(window_default_setup)==0 */} #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy AFTER script ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #//::puts "pgq,debug...::QW::GUI::low_level_window_copy Result==$Result"; #//$RootWindow window_deriveds_dump $Win; ;#//pgq,debug #//$RootWindow window_relations_dump [$RootWindow screen]; ;#//pgq,debug ::if {$Result} { /* { The import script returns false if it couldn't find the template file or if it was the wrong version. For any other problems a bug is thrown. By returning false when we can't import we can cause the file to be created by deleting it. Otherwise we would have to re-compile just to toggle a flag, forcing the creation of the template file. */ } ::if {$::qw::control(window_default_setup)!=1} { #// restricted user access pushes the count at least up to 2... #::qw::throw [::sargs \ .text "::qw::control(window_default_setup) sandwich error. Contact Q.W. Page technical support." \ .help_id 0 \ ]; } #::QW::GUI::window_default_setup_decr [$RootWindow odb_path]; ::set Scounter $::qw::control(window_default_setup); ::set ::qw::control(window_default_setup) 0; $Screen gui_isLoading 1; ::qw::finally [::list $Screen gui_isLoading 0]; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids odb_items==[[$RootWindow .clipper.kids] odb_items]"; #//::foreach Kid [[[$RootWindow .clipper.kids] odb_primary] odb_masters .order_is_kept 1] {#//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow Kid==[$Kid odb_path]";} #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids gui_load"; [$RootWindow .clipper.kids] gui_load; #nv2.23.01 #::update; ;#// this is a killer #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids gui_load_observer_database"; $RootWindow gui_load_observer_database; #nv2.25.3a (bug fix) - Mariner Investment Group, F2 to a destination that needs a window default setup is encountering an empty observer_database [$RootWindow .pick.kids] signalWrite; #$RootWindow gui_load_focusPath; #$RootWindow gui_load_focusPath_rectangles; ;#// NOTICE this method is a NOP. I'm sure it's related to the gray screen of death. ::if {![$RootWindow is_tk_toplevel] \ &&[[$RootWindow .frame.dressing.isDisplayed] odb_get] \ } { #nv2.23.00 (resume) - why the fuck is this here? - and maybe it should be destroy & create #[$RootWindow .frame] buttons_create_menu_style; #nv2.23.01 ::if {[[$RootWindow .frame] path] ne "" \ &&![::winfo exists [[$RootWindow .frame] tkPath]._windowMenu_button_frame] \ } { [$RootWindow .frame] buttons_create_menu_style; } } #::QW::GUI::window_default_setup_incr [$RootWindow odb_path]; ::set ::qw::control(window_default_setup) $Scounter; #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy AFTER gui_load ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #nv2.23.0 (resume) ::QW::GUI::low_level_window_setup_script_marker_set $sargs; } else { #//::puts "pgq,debug...::QW::GUI::low_level_window_copy calling ::QW::GUI::low_level_window_setup_script_marker_set sargs==(\n[::sargs::format $sargs]\n)"; ::QW::GUI::low_level_window_setup_script_marker_set $sargs; } #nv2.23.01 /* { ::if {![::winfo exists $Toplevel]} { ::destroy $Toplevel; } */} #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy return Result==$Result"; ::return $Result; } } else { # CALLED # 2 procs ::proc ::QW::GUI::low_level_window_setup_script_marker_set {sargs} { #//::puts "pgq,debug2311b...::QW::GUI::low_level_window_setup_script_marker_set sargs==(\n[::sargs::format .structure $sargs]\n)"; /* { Set a script path marker in the a clientdata field indicating this is a node that is to be exported. First we remove the $::qw_library prefix from the full script path. */ } ::set ScriptPathMarker [::string tolower [::sargs::get $sargs .script.path]]; ::set ScriptPathMarker [::string map [::list [::string tolower $::qw_library] ""] $ScriptPathMarker]; ::if {$ScriptPathMarker eq ""} { ::qw::bug 314120120423111110 "[::qw::procname] - empty script path."; } ::set Window [::sargs::get $sargs .odb.object]; ::if {$Window eq ""} { ::qw::bug 314120120423111111 "[::qw::procname] - empty window."; } #//::puts "pgq,debug2311b...::QW::GUI::low_level_window_setup_script_marker_set Window==[$Window odb_path] ScriptPathMarker==$ScriptPathMarker"; /* { ::QW::GUI::low_level_window_setup_script_marker_set Window==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/JOURNAL/BANK/416 ScriptPathMarker==/object/newviews/journal/setup_desktop.qw_script */} [$Window .clientdata] odb_set [::sargs::set [[$Window .clientdata] qw_get] .newviews.default_setup_qw_script $ScriptPathMarker]; } ::proc ::QW::GUI::low_level_window_copy {sargs} { #//::puts "pgq,debug2311b...::QW::GUI::low_level_window_copy enter sargs==(\n[::sargs::format $sargs]\n)"; #//::puts "pgq,debug2311b...::QW::GUI::low_level_window_copy .odb.object==[::expr {[::sargs::get $sargs .odb.object] eq ""?{}:[[::sargs::get $sargs .odb.object] odb_path]}]"; #::qw::stack_dump; ;#//pgq,debug ::set ScriptPath [::string tolower [::sargs::get $sargs .script.path]]; ::if {$ScriptPath eq ""} { ::qw::bug 314120120422100439 "[::qw::procname] - no script path."; } ::set RootWindow [::sargs::get $sargs .odb.object]; ::if {$RootWindow eq ""} { ::qw::bug 314120120422100440 "[::qw::procname] - no root window."; } #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter ScriptPath ==$ScriptPath"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow ==[$RootWindow odb_path]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow explorerDepth ==[$RootWindow explorerDepth]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter RootWindow odb_base ==[[$RootWindow odb_base] odb_path]"; #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy enter RootWindow observer_database==[[$RootWindow observer_database] odb_path]"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy enter ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; # kludge alert #//::set Win [[$RootWindow odb_database] "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/ACCOUNT/AP"]; #//$RootWindow window_deriveds_dump $Win; ;#//pgq,debug #//$RootWindow window_relations_dump [$RootWindow screen]; ;#//pgq,debug /* { pgq has no idea how to solve this problem, in the time allotted... The "instance" explore case is not copying windows setup OR the copied in window setup is being lost SO revisit this another time */} ::if {[$RootWindow explorerDepth] eq "instance"} { #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy EXPLICIT instance explore"; #::return 0; } #nv2.23.00 /* { These next two tests could come in either order, OR we could omit the first test altogether... In a slow mo high level setup the observer_database is empty Leave them both as a documentation note */} # IDIOT - the next test is always true (e.g. /REPORT==/REPORT) /* { ::if {[$RootWindow observer_database] ne "" \ &&[[$RootWindow observer_database] odb_id] eq [[$RootWindow odb_base] odb_id] \ } { #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy DETECTED 000 instance explore [[$RootWindow observer_database] odb_id]==[[$RootWindow odb_base] odb_id]"; #//...::QW::GUI::low_level_window_copy DETECTED instance explore /1343419073_86==/1343419073_86 ::return 0; } */} # NOTICE ;#// check for all digits in odb_id ::set Rid [[$RootWindow odb_base] odb_id]; ::set Rid [::string map [::list / "" _ ""] $Rid]; ::if {[::regsub -all \[^0-9\] $Rid ""] eq $Rid} { #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy DETECTED 111 instance explore"; #::return 0; } #// #nv2.23.01 #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow==[$RootWindow odb_path] - [[$RootWindow odb_master] window_titles_get]"; #//::puts "\t\t+++ positionInScreen==[[[$RootWindow odb_master] .frame] positionInScreen]"; ;#//pgq,debug #//$RootWindow putsParentList $RootWindow ".clipper.parent";::puts "\n"; ;#//pgq,debug ::set ::qw::control(is_low_level_window_copy) 1; ::qw::finally [::list ::set ::qw::control(is_low_level_window_copy) 0]; ::set Position [[$RootWindow .client] positionInScreen]; ::set Position [::QW::GUI::POINT::+ $Position ".x 80 .y 80"]; ::set Operation [::itcl::local ::QW::OPERATION #auto $Position .text "Installing window setup..."]; /* { #// # NOTICE #// All this code to display a toplevel progress window... THAT CAN BE DESTROYED TO STOP THE OPERATION #// ::set Toplevel ".qw_low_level_window_copy_progress"; ::if {[::winfo exists $Toplevel]} {::destroy $Toplevel;} ::toplevel $Toplevel; ::wm title $Toplevel "Window Setup"; ::set Position [[$RootWindow .frame] positionInScreen]; #//::puts "20040929 Position==$Position"; ::set TopPosition [::QW::GUI::POINT::+ $Position ".x 50 .y 50"]; ::wm geometry $Toplevel "+[::sargs::get $TopPosition .x]+[::sargs::get $TopPosition .y]"; ::set StatusLabel [::label $Toplevel.label -font {Arial 12 bold} -text "Installing default window setup..."] ::pack $StatusLabel; */} ::set Screen [$RootWindow screen]; ::set ScreenOS [[$RootWindow odb_database] cpp_object_structure_load .address $Screen]; ::set Result [::qw::script::source \ .script.path [::file join $::qw_library object system gui window_template_import.qw_script] \ .default_setup_script_path $ScriptPath \ .default_setup_root_window $RootWindow \ ]; /* { ...::QW::GUI::low_level_window_copy enter RootWindow==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT/1343419073_86/1343419040_1010 ...::QW::GUI::low_level_window_copy enter RootWindow explorerDepth== ...::QW::GUI::low_level_window_copy enter ::qw::control(window_default_setup)==1 ...window_template_import enter sargs==( .script { .path d:/nv/nv223.exe/object/system/gui/window_template_import.qw_script .directory d:/nv/nv223.exe/object/system/gui .folder d:/nv/nv223.exe/object/system/gui .tail window_template_import.qw_script .name window_template_import .extension .qw_script .type .qw_script .namespace_id 9 .namespace ::qw::script::9 .stack {{.script {.path d:/nv/nv223.exe/object/system/gui/window_template_import.qw_script .directory d:/nv/nv223.exe/object/system/gui .folder d:/nv/nv223.exe/object/system/gui .tail window_template_import.qw_script .name window_template_import .extension .qw_script .type .qw_script .namespace_id 9 .namespace ::qw::script::9} .default_setup_script_path d:/nv/nv223.exe/object/newviews/report/setup_desktop.qw_script .default_setup_root_window ::qw::odb::20120727155720::/1343419040_1010}} } .default_setup_script_path d:/nv/nv223.exe/object/newviews/report/setup_desktop.qw_script .default_setup_root_window ::qw::odb::20120727155720::/1343419040_1010 ) ...window_template_import SetupScriptPath==_object_newviews_report ...window_template_import _template_file==d:/nv/nv2.dat/window_templates/_object_newviews_report.nv2_window_template ...::QW::GUI::low_level_window_copy AFTER script ::qw::control(window_default_setup)==1 ...::QW::GUI::low_level_window_copy Result==1 ...::QW::GUI::low_level_window_copy AFTER gui_load ::qw::control(window_default_setup)==1 ...::QW::GUI::window_default_setup_decr ---------------::qw::control(window_default_setup)==0 */} #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy AFTER script ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy Result==$Result"; #//$RootWindow window_deriveds_dump $Win; ;#//pgq,debug #//$RootWindow window_relations_dump [$RootWindow screen]; ;#//pgq,debug ::if {$Result} { /* { The import script returns false if it couldn't find the template file or if it was the wrong version. For any other problems a bug is thrown. By returning false when we can't import we can cause the file to be created by deleting it. Otherwise we would have to re-compile just to toggle a flag, forcing the creation of the template file. */ } ::if {$::qw::control(window_default_setup)!=1} { #// restricted user access pushes the count at least up to 2... #::qw::throw [::sargs \ .text "::qw::control(window_default_setup) sandwich error. Contact Q.W. Page technical support." \ .help_id 0 \ ]; } #::QW::GUI::window_default_setup_decr [$RootWindow odb_path]; ::set Scounter $::qw::control(window_default_setup); ::set ::qw::control(window_default_setup) 0; $Screen gui_isLoading 1; ::qw::finally [::list $Screen gui_isLoading 0]; #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids odb_items==[[$RootWindow .clipper.kids] odb_items]"; #//::foreach Kid [[[$RootWindow .clipper.kids] odb_primary] odb_masters .order_is_kept 1] {#//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow Kid==[$Kid odb_path]";} #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids gui_load"; [$RootWindow .clipper.kids] gui_load; #nv2.23.01 #::update; ;#// this is a killer #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy RootWindow .clipper.kids gui_load_observer_database"; $RootWindow gui_load_observer_database; #nv2.25.3a (bug fix) - Mariner Investment Group, F2 to a destination that needs a window default setup is encountering an empty observer_database [$RootWindow .pick.kids] signalWrite; #$RootWindow gui_load_focusPath; #$RootWindow gui_load_focusPath_rectangles; ;#// NOTICE this method is a NOP. I'm sure it's related to the gray screen of death. ::if {![$RootWindow is_tk_toplevel] \ &&[[$RootWindow .frame.dressing.isDisplayed] odb_get] \ } { #nv2.23.00 (resume) - why the fuck is this here? - and maybe it should be destroy & create #[$RootWindow .frame] buttons_create_menu_style; #nv2.23.01 ::if {[[$RootWindow .frame] path] ne "" \ &&![::winfo exists [[$RootWindow .frame] tkPath]._windowMenu_button_frame] \ } { [$RootWindow .frame] buttons_create_menu_style; } } #::QW::GUI::window_default_setup_incr [$RootWindow odb_path]; ::set ::qw::control(window_default_setup) $Scounter; #//::puts "pgq,debug223.00...::QW::GUI::low_level_window_copy AFTER gui_load ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #nv2.23.0 (resume) ::QW::GUI::low_level_window_setup_script_marker_set $sargs; } else { # NOTICE #// we want low_level_window_setup_script_marker_set unconditionally, #// so we can always know this window is a "toplevel", outermost "Russian doll" ::QW::GUI::low_level_window_setup_script_marker_set $sargs; } #nv2.23.01 /* { ::if {![::winfo exists $Toplevel]} { ::destroy $Toplevel; } */} #//::puts "pgq,debug223.01...::QW::GUI::low_level_window_copy return Result==$Result"; ::return $Result; } } ::proc ::QW::GUI::unique_settings_name {s_args} { #//::puts "pgq,debug::QW::GUI::unique_settings_name enter s_args==(\n[::sargs::format .structure $s_args]\n)"; #::qw::stack_dump; ;#//pgq,debug ::set NewName [::sargs::get $s_args .name]; ::set Settings [::sargs::get $s_args .settings]; #nv2.22.0 (bug fix) - but not very satisfying ::if {[::string match "Copy (*) of *" $NewName]} { #( for match ::set NewName [::string range $NewName [::expr {[::string first ") of " $NewName]+5}] end]; } ::set Suffix $NewName; ::set NameExists 1; ::set UniqueId 1; ::while {1} { ::if {!$NameExists} { ::break; } ::set NameExists 0; ::foreach CheckSub [::sargs::subs .structure $Settings] { #//::puts "pgq,debug222.0::QW::GUI::unique_settings_name NewName==$NewName Sub.name==[::sargs::get $Settings $CheckSub.name]"; ::if {$NewName eq [::sargs::get $Settings $CheckSub.name]} { ::set NameExists 1; ::set NewName "Copy ($UniqueId) of $Suffix"; ::incr UniqueId; ::break; } } } ::return $NewName; } #nv2.23.0 (bug fix) - select window tab for just deleted database_explorer ::proc ::QW::GUI::unique_name {s_args} { #//::puts "pgq,debug222.0::QW::GUI::unique_name enter s_args==(\n[::sargs::format .structure $s_args]\n)"; #::qw::stack_dump; ;#//pgq,debug ::set NewName [::sargs::get $s_args .name]; ::set NameList [::sargs::get $s_args .list]; #nv2.22.0 (bug fix) - but not very satisfying ::if {[::string match "Copy (*) of *" $NewName]} { #( for match ::set NewName [::string range $NewName [::expr {[::string first ") of " $NewName]+5}] end]; } ::set Suffix $NewName; ::set NameExists 1; ::set UniqueId 1; ::while {1} { ::if {!$NameExists} { ::break; } ::set NameExists 0; ::foreach Name $NameList { #//::puts "pgq,debug222.0::QW::GUI::unique_name NewName==$NewName Sub.name==[::sargs::get $NameList $CheckSub.name]"; ::if {$NewName eq $Name} { ::set NameExists 1; ::set NewName "Copy ($UniqueId) of $Suffix"; ::incr UniqueId; ::break; } } } ::return $NewName; } #nv2.23.0 (bug fix) - select window tab for just deleted database_explorer ::proc ::QW::GUI::unique_database_explorer_name {s_args} { #//::puts "pgq,debug222.0::QW::GUI::unique_database_explorer_name enter s_args==(\n[::sargs::format .structure $s_args]\n)"; #::qw::stack_dump; ;#//pgq,debug ::set NewName [::sargs::get $s_args .name]; ::set NameList [::sargs::get $s_args .list]; #nv2.22.0 (bug fix) - but not very satisfying ::if {[::string match " (*)" $NewName]} { ::set NewName [::string range $NewName 0 [::expr {[::string first " (" $NewName]-1}]]; #) for match } ::set Prefix $NewName; ::set NameExists 1; ::set UniqueId 2; ::while {1} { ::if {!$NameExists} { ::break; } ::set NameExists 0; ::foreach Name $NameList { #//::puts "pgq,debug222.0::QW::GUI::unique_database_explorer_name NewName==$NewName Sub.name==[::sargs::get $NameList $CheckSub.name]"; ::if {$NewName eq $Name} { ::set NameExists 1; ::set NewName "$Prefix ($UniqueId)"; ::incr UniqueId; ::break; } } } ::return $NewName; } #nv2.23.0 (new feature) - duplicate_database_explorer ::proc ::QW::GUI::duplicate_database_explorer {sargs} { /* { */} ::set Window [::sargs::get $sargs .window]; ::set OwnerParent [[[$Window ".owner.parent"] odb_get] odb_master]; ::set GrandParent [[[$OwnerParent ".owner.parent"] odb_get] odb_master]; #//::puts "pgq,debug223.0_new_dbx.../TREE/ITCLNODES/HERITAGE/EXPLORER duplicate_database_explorer enter [$Window odb_path] OwnerParent==[$OwnerParent odb_path]"; #//::puts "20050113_000 nv_toplevel==[[nv_toplevel] odb_path]"; #//::puts "20050113_000 [$Window odb_path] GrandParent==[$GrandParent odb_path]"; # NOTICE #// Without Window, there is no window list button for the explorers... ::if {[[$GrandParent ".frame.dressing.isDisplayed"] odb_get]==0} { [$GrandParent ".frame.dressing.isDisplayed"] odb_set 1; [$GrandParent ".frame.dressing.settings"] replace .maximizeRestore 0; } [$OwnerParent ".frame.dressing.isDisplayed"] odb_set 1; [$OwnerParent ".restore_state"] odb_set "restored"; ::set Kids [[$GrandParent odb_observer_get whateverKids] odb_masters]; ::if {[::llength $Kids]==1} { ::set NameList ""; ::foreach Kid $Kids { ::lappend NameList [::subst [::sargs::get [[$Kid .frame.dressing.settings] odb_get] .title_text]]; #//::puts "pgq,debug223.0_new_dbx.../TREE/ITCLNODES/HERITAGE/EXPLORER duplicate_database_explorer BEFORE Kid==[$Kid odb_path] .title_text==[::subst [::sargs::get [[$Kid .frame.dressing.settings] odb_get] .title_text]]"; } [[::lindex $Kids 0] ".frame.dressing.settings"] replace .title_text [::QW::GUI::unique_database_explorer_name [::sargs .name "Explorer" .list $NameList]]; } #// #nv2.23.0 (resume) $OwnerParent odb_commit; ::set Result [::qw::script::source \ .script.path [::file join $::qw_library object system gui window_duplicate_low.qw_script] \ .root_window $OwnerParent \ ]; ::set Explorer [::sargs::get $Result .newborn_window]; #//::puts "pgq,debug223.0_new_dbx.../TREE/ITCLNODES/HERITAGE/EXPLORER duplicate_database_explorer Explorer==[$Explorer odb_path]"; ::set NameList ""; ::set Kids [[$GrandParent odb_observer_get whateverKids] odb_masters]; ::foreach Kid $Kids { ::lappend NameList [::subst [::sargs::get [[$Kid .frame.dressing.settings] odb_get] .title_text]]; #//::puts "pgq,debug223.0_new_dbx.../TREE/ITCLNODES/HERITAGE/EXPLORER duplicate_database_explorer AFTER Kid==[$Kid odb_path] .title_text==[::subst [::sargs::get [[$Kid .frame.dressing.settings] odb_get] .title_text]]"; } ::set OwnerName [::sargs::get [[$OwnerParent .frame.dressing.settings] odb_get] .title_text]; #[$Explorer ".frame.dressing.settings"] replace .title_text [::QW::GUI::unique_name [::sargs .name $OwnerName .list $NameList]]; [$Explorer ".frame.dressing.settings"] replace .title_text [::QW::GUI::unique_database_explorer_name [::sargs .name $OwnerName .list $NameList]]; #// [$Window odb_database] cpp_ping; ::qw::call_after_idle ::after [$Explorer tree] focusIn; ::return $Explorer; } ::proc ::QW::GUI::multiline_title {Src} { #//::puts "pgq,debug220::QW::GUI::multiline_title Src==\"$Src\""; ::set Src [::string map {" " \n} $Src]; ::set Src [::string map {\na\n " a " \nto\n " to " \nthe\n " the " \nor\n "\nor " \nfor\n " for " \nnot\n " not " \nby\n " by " \nand\n "\nand " \n-\n "\n- " \nof\n " of "} $Src]; ::set Src [::string trim $Src]; #//::puts "pgq,debug220::QW::GUI::multiline_title return==\"$Src\""; ::return $Src; # unbalanced char map or whatever /* { ::set FindReplace ""; ::lappend FindReplace \na\n " a "; ::lappend FindReplace \nto\n " to "; ::lappend FindReplace \nthe\n " the "; ::lappend FindReplace \nfor\n " for "; ::lappend FindReplace \nor\n " or "; ::lappend FindReplace \nnot\n " not "; ::lappend FindReplace \nby\n " by "; ::lappend FindReplace \nand\n "\nand "; ::lappend FindReplace \n-\n "\n- "; ::lappend FindReplace \nof\n " of "; ::foreach {Find Replace} $Description { ::set Description [::string map "$Find $Replace" $Description]; } */} } ::proc ::QW::GUI::uniqueId {} { ::return [::incr ::QW::GUI::_uniqueId]; } #nv2.11.2 ::proc ::QW::GUI::eval {Arg} { ::uplevel 1 $Arg; } /* { ::proc ::QW::GUI::eval {Arg} { ::qw::try { ::puts "pgq,debug::QW::GUI::eval Arg==$Arg"; ::uplevel 1 $Arg; ::puts "pgq,debug::QW::GUI::eval AFTER"; } catch Exception { ::puts "pgq,debug::QW::GUI::eval catch Exception==$Exception"; ::qw::stack_dump; ::qw::throw [::qw::exception::parent $Exception "Could not ::QW::GUI::eval \"$Arg\""]; } } */} ::proc ::QW::GUI::subst {Arg} { ::if {$Arg eq ""} {::return "";} ::uplevel 1 ::subst $Arg; } /* { ::rename ::subst ::subst_qw; ::proc ::subst {args} { ::qw::try { ::puts "pgq,debug::subst_qw...gui.qw_tcl ::subst args==$args"; #::set Rslt [::eval ::subst_qw $args]; #::set Rslt [::subst_qw $args]; ::set Result [::uplevel 1 ::subst $args]; ::return $Rslt; } catch Exception { ::puts "pgq,debug::subst_qw catch Exception==$Exception"; ::qw::stack_dump; ::qw::throw [::qw::exception::parent $Exception "Could not ::subst_qw \"$args\""]; } } */} /* { ::rename ::puts ::puts_qw; ::proc ::puts {args} { ::puts_qw "pgq,debug::puts args==$args"; ::qw::stack_dump; ;#//pgq,debug ::return [::eval ::puts_qw $args]; } */} #nv2.38.2 (debug) /* { ::rename ::qw::throw ::qw::throw_qw; ::proc ::qw::throw {args} { ::puts "pgq,debug::qw::throw args==$args"; ::qw::stack_dump; ;#//pgq,debug ::return [::eval ::qw::throw_eq $args]; } ::rename ::throw ::throw_qw; ::proc ::throw {args} { ::puts "pgq,debug::throw args==$args"; ::qw::stack_dump; ;#//pgq,debug ::return [::eval ::throw_eq $args]; } */} #nv2.15.0 ::proc ::QW::GUI::database_boolean {Src} { ::switch -glob -- [::string tolower $Src] { "" - "n*" - "f*" { ::return 0; } "y*" - "t*" { ::return 1; } } ::qw::throw [::sargs \ .text "::QW::GUI::database_boolean encountered unknown Src==\"$Src\"" \ .help_id 0 \ ]; } ::proc ::QW::GUI::window_boolean {Src} { ::switch $Src { "" {::return "";} "0" {::return "";} "1" {::return "yes";} } ::qw::throw [::sargs \ .text "::QW::GUI::window_boolean encountered unknown Src==\"$Src\"" \ .help_id 0 \ ]; } ::proc ::QW::GUI::lreverse {List} { ::set Guys [::list]; ::foreach Guy $List { ::set Guys [::linsert $Guys 0 $Guy]; } ::return $Guys; } ::proc ::QW::GUI::color_darken {Color Darken} { ::set Red ""; ::set Green ""; ::set Blue ""; ::scan [::string range $Color 1 2] %x Red; ::scan [::string range $Color 3 4] %x Green; ::scan [::string range $Color 5 6] %x Blue; #::return [::format #%02x%02x%02x [::expr {$Red-$Darken}] [::expr {$Green-$Darken}] [::expr {$Blue-$Darken}]]; ::if {$Red eq ""} { #//::puts "20070305_111 ::QW::GUI::color_darken Color==$Color Darken==$Darken"; ::set Try [::qw::color::symbol_to_rgb $Color]; ::scan [::string range $Try 1 2] %x Red; ::scan [::string range $Try 3 4] %x Green; ::scan [::string range $Try 5 6] %x Blue; ::if {$Red eq ""} { ::return $Color } } ::set Red [::expr {$Red-$Darken}]; ::if {$Red<0} {::set Red 0;} ::if {$Red>255} {::set Red 255;} ::set Green [::expr {$Green-$Darken}]; ::if {$Green<0} {::set Green 0;} ::if {$Green>255} {::set Green 255;} ::set Blue [::expr {$Blue-$Darken}]; ::if {$Blue<0} {::set Blue 0;} ::if {$Blue>255} {::set Blue 255;} ::return [::format #%02x%02x%02x $Red $Green $Blue]; } #nv2.12.0 ::proc ::QW::GUI::window_default_setup_incr {{Src ""}} { #nv2.23.0 (experiment) ::incr ::qw::control(window_default_setup) 1; ;#//nv2.12.0 #//::puts "pgq,debug...::QW::GUI::window_default_setup_incr +++++++++++++++::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #::qw::stack_dump; ;#//pgq,debug /* { ::if {$Src ne ""} { ::if {[::info exists ::qw::_window_default_setup($Src)]} { ::set ::qw::_window_default_setup($Src) [::expr {$::qw::_window_default_setup($Src)+1}]; } else { ::set ::qw::_window_default_setup($Src) 1; } } */} #//::puts "::qw::_window_default_setup array..."; #//::foreach {Name Value} [::array get ::qw::_window_default_setup] {::puts "::qw::_window_default_setup Name==$Name Value==$Value";} ::return; } ::proc ::QW::GUI::window_default_setup_decr {{Src ""}} { #nv2.23.0 (experiment) ::incr ::qw::control(window_default_setup) -1; ;#//nv2.12.0 #//::puts "pgq,debug...::QW::GUI::window_default_setup_decr ---------------::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; #::qw::stack_dump; ;#//pgq,debug /* { #::if {$Src ne ""} {::set ::qw::_window_default_setup($Src) [::expr {$::qw::_window_default_setup($Src)-1}];} ::if {$Src ne ""} { ::if {[::info exists ::qw::_window_default_setup($Src)]} { ::set ::qw::_window_default_setup($Src) [::expr {$::qw::_window_default_setup($Src)-1}]; } else { ::set ::qw::_window_default_setup($Src) -1; } } #//::puts "::qw::_window_default_setup array..."; #//::foreach {Name Value} [::array get ::qw::_window_default_setup] {::puts "pgq,debug::qw::_window_default_setup Name==$Name Value==$Value";} */} ::if {$::qw::control(window_default_setup)==0} { #[[screen] focus_window] database_reload_command; ;#// had to do this in a dozen places instead (the caller sandwiches) } ::if {$::qw::control(window_default_setup)<0} { ::set ::qw::control(window_default_setup) 0; #::qw::stack_dump; ;#//pgq,debug #::qw::throw [::sargs \ .text "::qw::control(window_default_setup) sandwich error." \ .help_id 0 \ ]; } ::return; } #nv2.23.0 (cleanup) - ::array set ::qw::_gui_image_array {}; /* { ::array set ::QW::GUI::_images_toolbar {}; ::proc ::QW::GUI::image_get {s_args} { ::set Iname [::sargs::get $s_args .image_name]; ::if {[::info exists ::QW::GUI::_images_toolbar($Iname)] \ &&$::QW::GUI::_images_toolbar($Iname) ne "" \ } { ::return $::QW::GUI::_images_toolbar($Iname); } ::switch $Iname { image_breadcrumb_position_scroll_previous {::set Ifile hv3_BG_back_button_small.png;} image_breadcrumb_position_scroll_previous_gray {::set Ifile hv3_BG_back_button_grey_small.png;} image_breadcrumb_position_scroll_next {::set Ifile hv3_BG_forward_button_small.png;} image_breadcrumb_position_scroll_next_gray {::set Ifile hv3_BG_forward_button_grey_small.png;} image_breadcrumb_position_scroll_next_end {::set Ifile hv3_BG_forward_end_button_small.png;} image_breadcrumb_position_scroll_next_end_gray {::set Ifile hv3_BG_forward_end_button_grey_small.png;} } ::set ::QW::GUI::_images_toolbar($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; ::puts "::proc ::QW::GUI::image_get .image_name==$Iname ::QW::GUI::_images_toolbar($Iname)==$::QW::GUI::_images_toolbar($Iname)"; ::return $::QW::GUI::_images_toolbar($ImageName); } */} #//::puts "pgq,debug.../gui/gui.qw_tcl 001"; #nv2.31.3 (new feature) - desktop_auto_bookmark ::array set ::qw::_gui_image_array {}; # _image_columns_fit_data_auto_off autofit_off_line.png # _image_item_duplicate_on edit_copy_2.png # _image_item_duplicate_off edit_copy_3.png # _image_desktop_auto_bookmark_on pin_on.png # _image_desktop_auto_bookmark_off pin_off.png ::foreach {Iname Ifile} { _image_edit_delete_on table_row_delete_26x24.png _image_edit_delete_off table_row_delete_bw.png _image_bookmarks_button bookmarks_borders_inset.png _image_columns_fit_data_auto_on autofit_on.png _image_columns_fit_data_auto_off autofit_off_line.png _image_goto_account_button go_account_a_noBG_powder_blue_with_gradient.png _image_edit_quit_undo_on edit_quit_undo_on.png _image_edit_quit_undo_off edit_quit_undo_off.png _image_edit_insert_on table_row_insert_26x24.png _image_edit_insert_off table_row_insert_bw.png _image_help_button help_book.png _image_home_button home.png _image_explorer_detail_open_on split_top_bottom.png _image_explorer_detail_open_off split_top_bottom_grey.png _image_item_duplicate_on transaction_duplicate_dark_on.png _image_item_duplicate_off transaction_duplicate_dark_off.png _image_breadcrumb_position_scroll_previous hv3_BG_back_button_small.png _image_breadcrumb_position_scroll_previous_gray hv3_BG_back_button_grey_small.png _image_breadcrumb_position_scroll_next hv3_BG_forward_button_small.png _image_breadcrumb_position_scroll_next_gray hv3_BG_forward_button_grey_small.png _image_breadcrumb_position_scroll_next_end hv3_BG_forward_end_button_small.png _image_breadcrumb_position_scroll_next_end_gray hv3_BG_forward_end_button_grey_small.png _image_column_delete_on table_column_delete.png _image_column_delete_off table_column_delete_blackwhite.png _image_column_new_on table_column_insert.png _image_column_new_off table_column_insert_blackwhite.png _image_display_resize resize_borders_inset_2.png _image_desktop_auto_bookmark_on pin_on_pushed_in.png _image_desktop_auto_bookmark_off pin_off_pointed.png } { #//::puts "pgq,debug226.1.../gui/gui.qw_tcl ::set ::qw::_gui_image_array Iname==$Iname Ifile==$Ifile"; ::set ::qw::_gui_image_array($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; } #nv2.28.2 (new feature) - rent_check /* { #//::puts "pgq,debug.../gui/gui.qw_tcl ::qw_sub_product==$::qw_sub_product"; #::if {$::qw_sub_product eq "nph"} {} ::foreach {Iname Ifile} { _image_rent_check_on RentCheck_24x24_button.png _image_rent_check_off RentCheck_24x24_button_grayed_out.png } { #//::puts "pgq,debug.../gui/gui.qw_tcl ::set ::qw::_gui_image_array Iname==$Iname Ifile==$Ifile"; ::set ::qw::_gui_image_array($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; } #{} */} #camera image_icon_4.png ::foreach {Iname Ifile} { _image_folder_root_object root_object.png _image_folder_newviews newviews.png _image_folder_user user_lighter.png _image_folder_audit audit-2.png _image_folder_attachment paperclip_3.png _image_folder_session session.png _image_folder_system system_screw_driver_17x15.png _image_folder_inactive folder_closed_yellow.png _image_folder_active folder_open_yellow.png _image_folder_inactive_account folder_closed_nv_blue.png _image_folder_active_account folder_open_nv_blue.png _image_folder_inactive_account_dark folder_closed_nv_dark.png _image_folder_active_account_dark folder_open_nv_dark.png _image_leaf_account leaf_blue.png _image_folder_inactive_journal folder_closed_pink.png _image_folder_active_journal folder_open_pink.png _image_leaf_journal leaf_pink.png _image_folder_inactive_payroll folder_closed_nv_green.png _image_folder_active_payroll folder_open_nv_green.png _image_leaf_payroll leaf_green.png } { #//::puts "pgq,debug226.1.../gui/gui.qw_tcl ::set ::qw::_gui_image_array Iname==$Iname Ifile==$Ifile"; ::set ::qw::_gui_image_array($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; } #nv2.38.4 (oauth) - ::set ::qw::_gui_image_array Iname - Google and Microsoft signin buttons ::foreach {Iname Ifile} { _image_oauth_sign_in_microsoft ms-symbollockup_signin_light.png _image_oauth_sign_in_google web_light_sq_SI@1x.png } { #//::puts "pgq,debug2384.../gui/gui.qw_tcl ::set ::qw::_gui_image_array Iname==$Iname Ifile==$Ifile"; ::set ::qw::_gui_image_array($Iname) [::image create photo -file [::file join $::qw_library object system gui images $Ifile]]; } # ------------------------------------------------------------------------------ # ------------------------------------------------------------------------------ #nv2.16.0 ::proc ::QW::GUI::generic_notes_table_definition {} { ::set Result { /field { .script { /title "Data" /command { /get {::return [[%_this odb_master] field_title_command_get [::sargs .this %_this .row %_row .reference {%_reference} .object %_object .format {%_format}]];} } } .justify left .width 30 } /value { .script { /title "Value" /command { /get { ::return [[%_this odb_master] field_value_command_get [::sargs .this %_this .row %_row .reference {%_reference} .object %_object .format {%_format}]]; } /change_before { ::return [[%_this odb_master] field_value_command_change_before [::sargs .this %_this .row %_row .reference {%_reference} .object %_object .format {%_format}]]; } /set { ::return [[%_this odb_master] field_value_command_set [::sargs .this %_this .row %_row .reference {%_reference} .object %_object .format {%_format} .value {%_value}]]; } /unset { ::return [[%_this odb_master] field_value_command_unset [::sargs .this %_this .row %_row .reference {%_reference} .object %_object .format {%_format} .value {%_value}]]; } } } .justify left .width 50 } } ::return $Result; } # ------------------------------------------------------------------------------ ::proc ::QW::GUI::generic_procedure_notes_table_definition {} { ::set Result [generic_notes_table_definition]; ::sargs::var::set Result /field.script/title "Setting"; ::return $Result; } # ------------------------------------------------------------------------------ #nv2.28.0 (new implementation) - experiment for RGI tables - service packable, but still overridable (scriptable) table columns ::proc ::QW::GUI::generic_table_definition {} { ::set Result { .script { /title {[ ::return [[%_this odb_master] cell_title_command_get [::sargs .this %_this .cname %_cname]]; ]} /command { /get { ::return [[%_this odb_master] cell_value_command_get [::sargs .this %_this .row %_row .cname %_cname .reference {%_reference} .object %_object .format {%_format}]]; } /change_before { ::return [[%_this odb_master] cell_value_command_change_before [::sargs .this %_this .row %_row .cname %_cname .reference {%_reference} .object %_object .format {%_format}]]; } /set { ::return [[%_this odb_master] cell_value_command_set [::sargs .this %_this .row %_row .cname %_cname .reference {%_reference} .object %_object .format {%_format} .value {%_value}]]; } /unset { ::return [[%_this odb_master] cell_value_command_unset [::sargs .this %_this .row %_row .cname %_cname .reference {%_reference} .object %_object .format {%_format} .value {%_value}]]; } } } .justify left .width 50 } ::return $Result; } # ------------------------------------------------------------------------------ /* { proc valid_cc {acct} { regsub -all -- {[^0-9]} $acct "" acct; set len [string length $acct] if {!([string match 5* $acct]&&$len==16) &&!([string match 4* $acct]&&($len==13||$len==16)) \ &&!([string match {3[47]*} $acct]&&$len==15) \ &&!([string match 6011* $acct]&&$len==16) \ } { return 0 } if {[expr [string length $acct] % 2]} { append acct 0 set odd_factor 1 set even_factor 2 } else { set odd_factor 2 set even_factor 1 } foreach {odd even} [split $acct ""] { append digits "[expr $odd * $odd_factor][expr $even * $even_factor]" } set sum 0 foreach digit [split $digits ""] { incr sum $digit } if {[expr $sum % 10] == 0} { return 1 } else { return 0 } } proc card_type {acct} { if {[valid_cc $acct]} { set len [string length $acct] if {[string match 5* $acct]&&$len==16} { return mastercard } elseif {[string match 4* $acct] && ($len == 13 || $len == 16)} { return visa } elseif {[string match {3[47]*} $acct] && $len == 15} { return amex } elseif {[string match 6011* $acct] && $len == 16} { return discover } } } proc card_type {acct} { set cards { mastercard 5 16 visa 4 13|16 amex 3[47] 15 discover 6011 16 } if { [ valid_cc2 $acct ] } { regsub -all {[^0-9]} $acct "" acct ;# [2] set len [ string length $acct ] foreach { card apat lpat } $cards { if { [ regexp ^${apat}.+,($lpat)\$ $acct,$len ] } { return $card } } } ;# [1] return invalid } # proc revised 07.21.02 -- Carl M. Gregory, MC_8 - http://www.cartochka.ru/ #{ [1] Missing a '}'. # [2] Should only worry about 0-9, remove the rest (as does valid_cc2). # The code below might be faster. proc valid_cc2 {acct} { regsub -all {[^0-9]} $acct "" acct set even 0 set sum 0 set len [string length $acct] while {$len} { set new [string index $acct [incr len -1]] if {$even} { incr new $new set new [expr {($new%10)+($new/10)}] } incr sum $new set even [expr {!$even}] } return [expr {($sum%10) == 0}] } */} #nv2.16.0 (email) ::proc ::QW::GUI::puts_stderr {args} { #//::puts "::QW::GUI::puts_stderr args==$args"; ::set Arg [::lindex $args 0]; #//::puts "::QW::GUI::puts_stderr Arg==$Arg"; ::if {[::string first "<-- 250 2.0.0" $Arg]==0} { ::set ::qw::control(smtp_log_id) [::string map {"<-- " ""} $Arg]; #//::puts "::QW::GUI::puts_stderr ::qw::control(smtp_log_id)==$::qw::control(smtp_log_id)"; } ::set ::qw::control(smtp_log) $::qw::control(smtp_log)[::append Arg \n]; #//::puts "::QW::GUI::puts_stderr ::qw::control(smtp_log)==$::qw::control(smtp_log)"; } ::proc ::QW::GUI::structure_sort_subs {s_args} { # unfinished ::set Result ""; ::set Subs [::lsort [::sargs::subs .structure $s_args]]; #//::puts "pgq,debug216::QW::GUI::structure_sort_subs Subs==$Subs"; ::foreach Sub $Subs { #//::puts "::QW::GUI::structure_sort_subs Sub==$Sub"; ::foreach Inner [::sargs::inners .structure $s_args] { ::sargs::var::set Result $Inner [::sargs::get $s_args $Inner]; } ::sargs::var::set Result $Sub [::QW::GUI::structure_sort_subs [::sargs::get $s_args $Sub]]; } ::return $Result; } /* { [8] Backslash substitution. If a backslash (``\'') appears within a word then backslash substitution occurs. In all cases but those described below the backslash is dropped and the following character is treated as an ordinary character and included in the word. This allows characters such as double quotes, close brackets, and dollar signs to be included in words without triggering special processing. The following table lists the backslash sequences that are handled specially, along with the value that replaces each sequence. \a Audible alert (bell) (0x7). \b Backspace (0x8). \f Form feed (0xc). \n Newline (0xa). \r Carriage-return (0xd). \t Tab (0x9). \v Vertical tab (0xb). \whiteSpace A single space character replaces the backslash, newline, and all spaces and tabs after the newline. This backslash sequence is unique in that it is replaced in a separate pre-pass before the command is actually parsed. This means that it will be replaced even when it occurs between braces, and the resulting space will be treated as a word separator if it isn't in braces or quotes. \\ Backslash (``\''). \ooo The digits ooo (one, two, or three of them) give an eight-bit octal value for the Unicode character that will be inserted. The upper bits of the Unicode character will be 0. \xhh The hexadecimal digits hh give an eight-bit hexadecimal value for the Unicode character that will be inserted. Any number of hexadecimal digits may be present; however, all but the last two are ignored (the result is always a one-byte quantity). The upper bits of the Unicode character will be 0. \uhhhh The hexadecimal digits hhhh (one, two, three, or four of them) give a sixteen-bit hexadecimal value for the Unicode character that will be inserted. Backslash substitution is not performed on words enclosed in braces, except for backslash-newline as described above. */} ::proc ::QW::GUI::string2hex {string} { set where 0 set res {} while {$where<[string length $string]} { set str [string range $string $where [expr $where+15]] if {![binary scan $str H* t] || $t==""} break regsub -all (....) $t {\1 } t4 regsub -all (..) $t {\1 } t2 set asc "" foreach i $t2 { scan $i %2x c append asc [expr {$c>=32 && $c<=127? [format %c $c]: "."}] } lappend res [format "%7.7x: %-42s %s" $where $t4 $asc] incr where 16 } ::return [join $res \n]; } } ::itcl::class ::QW::GUI::SANDWICH_TABLE_SIGNAL_WRITE { # NOT USED protected variable _window ""; protected variable _semaphore ""; public method constructor {Window Semaphore} { ::set _window $Window; ::set _semaphore $Semaphore; } public method destructor {} { } } ::itcl::class ::QW::GUI::SANDWICH_WAIT_CURSOR { protected variable _window ""; protected variable _current_cursor ""; protected variable _wait_cursor ""; public method constructor {Window WaitCursor} { ::set _window $Window; #nv2.38.0 (linux) ::if {[::info exists ::qw::platform_dependent_cursor($WaitCursor)]} { ::set WaitCursor $::qw::platform_dependent_cursor($WaitCursor); } ::set _wait_cursor $WaitCursor; ::array set Options [[$_window ".client.options.widget"] qw_get]; #// NOTICE not the configureList ::if {[::info exists Options(-cursor)]} { ::set _current_cursor $Options(-cursor); #// since we have to reset it only if it was present } ::set Options(-cursor) $_wait_cursor; [$_window ".client.options.widget"] odb_set [::array get Options]; } public method destructor {} { #::if {[::info commands $_window] eq ""} {::return ""} ::if {![::qw::command_exists $_window]} {::return ""} ::array set Options [[$_window ".client.options.widget"] qw_get]; #// NOTICE not the configureList ::if {$_current_cursor ne ""} { ::set Options(-cursor) $_current_cursor; } else { ::unset Options(-cursor); } [$_window ".client.options.widget"] odb_set [::array get Options]; } } #::set ::QW::GUI::_load_from_directory_path $::env(pgq); /* { #// ------------------------------------------------------------ #// ::QW::NV2::STRING class #// ------------------------------------------------------------ ::itcl::class ::QW::NV2::STRING { inherit ::QW::ODB::STRING; public method schema1_default {} {::return "heritage";} # method odb_get {} { # if {[qw_is_null]} { # if {[::string length [odb_base]]} {return [[odb_base] odb_get];} # } # return [qw_get]; # } public method odb1_set {After} { ::return [chain [::string trim $After]]; } } */ } /* { #// ------------------------------------------------------------ #// ::QW::NV2::ENTITY class #// ------------------------------------------------------------ ::namespace eval ::QW::NV2::ENTITY { } #// ------------------------------------------------------------ #// ::QW::NV2::ENTITY::STRING class #// ------------------------------------------------------------ ::itcl::class ::QW::NV2::ENTITY::STRING { inherit ::QW::ODB::STRING; #// # NOTICE #// With schema1_default returning "heritage", and with the entity information #// strings declared as fields of the root /ACCOUNT class, we get robust polymorphic #// behaviour. First we return our own value, if set. Then we give priority to #// our .entity reference, which will follow up its heritage path, if necessary. #// Otherwise we follow up our own heritage path. #// public method schema1_default {} {::return "heritage";} method odb_get {} { ::if {![qw_is_null]} {::return [chain];} #// #::if {[[odb_database] cpp_find [[[odb_master] odb_path] ".entity"]] eq ""} {::return [chain];} ::if {![[odb_master] odb_is_a "/OBJECT/NV2/ACCOUNT/TB"]} {::return [chain];} #// ::if {[[[odb_master] ".entity"] odb_get] eq ""} {::return [chain];} ::set EntityPath [[[[[odb_master] ".entity"] odb_get] odb_master] odb_path]; ::append EntityPath [odb_path_from_object [odb_master]]; ::set EntityParent [[odb_database] cpp_find $EntityPath]; ::if {$EntityParent eq ""} {::return [chain];} ::return [$EntityParent odb_get]; } } */} #//::set Inners [[$this cpp_inners] tcl_handles]; #//::foreach Inner $Inners {$Inner foo;} /* { public method daemon_tcl_constructor {This} { ::set _this $This; #//return [tcl_constructor]; return [initialize]; } public method initialize {args} { } */} /* { by reference ... proc ::QW::GUI::POINT::+= {ThisVar Src} { ::upvar 1 ThisVar This; ::set x [::expr [::sargs::get $This .x]+[::sargs::get $Src .x]]; ::set y [::expr [::sargs::get $This .y]+[::sargs::get $Src .y]]; ::set This ".x $x .y $y"; return $This; } by value ... proc ::QW::GUI::POINT::+= {This Src} { ::set x [::expr [::sargs::get $This .x]+[::sargs::get $Src .x]]; ::set y [::expr [::sargs::get $This .y]+[::sargs::get $Src .y]]; return ".x $x .y $y"; } by reference ... ::proc ::QW::GUI::RECTANGLE::moveby {ThisVar Point} { ::upvar 1 ThisVar This; ::set ThisPosition [::sargs::get $This .position]; POINT::+= ThisPosition $Point; ::set This [::sargs::set $This .position $ThisPosition] return $This; } by value ... ::proc ::QW::GUI::RECTANGLE::moveby {This Point} { return [::sargs::set $This .position [POINT::+= [::sargs::get $This .position] $Point]]; } */} #// ------------------------------------------------------------ #// ::QW::GUI::DISTANCE namespace #// ------------------------------------------------------------ ::namespace eval ::QW::GUI::DISTANCE { ::proc ::QW::GUI::DISTANCE::== {Arg1 Arg2} { if {$Arg1 eq ""||$Arg1==0} {return [::expr {$Arg2 eq ""||$Arg2==0}];} if {$Arg2 eq ""||$Arg2==0} {return [::expr {$Arg1 eq ""||$Arg1==0}];} return [::expr {$Arg1==$Arg2}]; } ::proc ::QW::GUI::DISTANCE::+ {Arg1 Arg2} { #//puts_pgq {"::QW::GUI::DISTANCE::+ Arg1==$Arg1, Arg2==$Arg2"}; if {$Arg1 eq ""} {return $Arg2;} if {$Arg2 eq ""} {return $Arg1;} return [::expr {$Arg1+$Arg2}]; } ::proc ::QW::GUI::DISTANCE::- {Arg1 Arg2} { if {$Arg2 eq ""} {return $Arg1;} if {$Arg1 eq ""} {return [::expr {-$Arg2}];} return [::expr {$Arg1-$Arg2}]; } ::proc ::QW::GUI::DISTANCE::* {Arg1 Arg2} { if {$Arg1 eq ""} {return 0;} if {$Arg2 eq ""} {return 0;} return [::expr {$Arg1*$Arg2}]; } ::proc ::QW::GUI::DISTANCE::/ {Arg1 Arg2} { if {$Arg1 eq ""} {return 0;} if {$Arg2 eq ""} {::qw::bug "271820050331195316" "::QW::GUI::DISTANCE::/ attempted to divide by null.";} if {$Arg2==0} {::qw::bug "271820050331195336" "::QW::GUI::DISTANCE::/ attempted to divide by zero.";} return [::expr {$Arg1/$Arg2}]; } #// # NOTICE #// This looks funny, especially looking at it months after it was written... #// I seem to have decided to ignore the rule of treating numeric nulls like zero #// and instead consider anything to be less than null? and anything to be greater #// than null? DON'T change this without a careful examination of the affect on #// point minimum, point maximum, the rectangle | user, and the rectangleBounding #// or rectangleScrolled, and so on! If anything, I would probably end up renaming #// these methods to more accurately describe what and how they do, and fixing #// all of the existing callers, and then adding new, properly implemented minimum #// and maximum procs. Maybe I'll be back. #// ::proc ::QW::GUI::DISTANCE::minimum {Arg1 Arg2} { if {$Arg2 eq ""} {return $Arg1;} if {$Arg1 eq ""} {return $Arg2;} if {$Arg1<$Arg2} {return $Arg1;} return $Arg2; } ::proc ::QW::GUI::DISTANCE::maximum {Arg1 Arg2} { if {$Arg2 eq ""} {return $Arg1;} if {$Arg1 eq ""} {return $Arg2;} if {$Arg1>$Arg2} {return $Arg1;} return $Arg2; } #// ::proc ::QW::GUI::DISTANCE::> {Arg1 Arg2} { return [::expr {![QW::GUI::DISTANCE::<= $Arg1 $Arg2]}]; } ::proc ::QW::GUI::DISTANCE::>= {Arg1 Arg2} { if {[::QW::GUI::DISTANCE::== $Arg1 $Arg2]} {return 1;} return [QW::GUI::DISTANCE::> $Arg1 $Arg2]; } ::proc ::QW::GUI::DISTANCE::< {Arg1 Arg2} { if {$Arg1 eq ""} {::set Arg1 0;} if {$Arg2 eq ""} {::set Arg2 0;} return [::expr {$Arg1<$Arg2}]; } ::proc ::QW::GUI::DISTANCE::<= {Arg1 Arg2} { if {[::QW::GUI::DISTANCE::== $Arg1 $Arg2]} {return 1;} return [QW::GUI::DISTANCE::< $Arg1 $Arg2]; } } #// ------------------------------------------------------------ #// ::QW::GUI::POINT namespace #// ------------------------------------------------------------ ::namespace eval ::QW::GUI::POINT { ::proc ::QW::GUI::POINT::isNull {Point} { ::if {[::sargs::get $Point .x] eq "" \ ||[::sargs::get $Point .y] eq "" \ } { ::return 1; } ::return 0; } ::proc ::QW::GUI::POINT::isZero {Point} { ::set x [::sargs::get $Point .x]; ::set y [::sargs::get $Point .y]; ::if {$x eq ""||$x==0&&$y eq ""||$y==0} { ::return 1; } ::return 0; } ::proc ::QW::GUI::POINT::== {Point1 Point2} { ::return [::expr {[::QW::GUI::DISTANCE::== [::sargs::get $Point1 .x] [::sargs::get $Point2 .x]] && \ [::QW::GUI::DISTANCE::== [::sargs::get $Point1 .y] [::sargs::get $Point2 .y]]}]; } ::proc ::QW::GUI::POINT::+ {Point1 Point2} { ::set x [::QW::GUI::DISTANCE::+ [::sargs::get $Point1 .x] [::sargs::get $Point2 .x]]; ::set y [::QW::GUI::DISTANCE::+ [::sargs::get $Point1 .y] [::sargs::get $Point2 .y]]; ::return ".x $x .y $y"; } ::proc ::QW::GUI::POINT::- {Point1 Point2} { ::set x [::QW::GUI::DISTANCE::- [::sargs::get $Point1 .x] [::sargs::get $Point2 .x]]; ::set y [::QW::GUI::DISTANCE::- [::sargs::get $Point1 .y] [::sargs::get $Point2 .y]]; ::return ".x $x .y $y"; } ::proc ::QW::GUI::POINT::* {Point Arg} { ::if {[::sargs::exists $Arg .x]} { ::set x [::QW::GUI::DISTANCE::* [::sargs::get $Point .x] [::sargs::get $Arg .x]]; ::set y [::QW::GUI::DISTANCE::* [::sargs::get $Point .y] [::sargs::get $Arg .y]]; } else { ::set x [::QW::GUI::DISTANCE::* [::sargs::get $Point .x] $Arg]; ::set y [::QW::GUI::DISTANCE::* [::sargs::get $Point .y] $Arg]; } ::return ".x $x .y $y"; } ::proc ::QW::GUI::POINT::/ {Point Arg} { ::if {[::sargs::exists $Arg .x]} { ::set x [::QW::GUI::DISTANCE::/ [::sargs::get $Point .x] [::sargs::get $Arg .x]]; ::set y [::QW::GUI::DISTANCE::/ [::sargs::get $Point .y] [::sargs::get $Arg .y]]; } else { ::set x [::QW::GUI::DISTANCE::/ [::sargs::get $Point .x] $Arg]; ::set y [::QW::GUI::DISTANCE::/ [::sargs::get $Point .y] $Arg]; } ::return ".x $x .y $y"; } ::proc ::QW::GUI::POINT::minimum {Point1 Point2} { ::if {[isNull $Point2]} {::return $Point1;} ::if {[isNull $Point1]} {::return $Point2;} ::set x [::QW::GUI::DISTANCE::minimum [::sargs::get $Point1 .x] [::sargs::get $Point2 .x]]; ::set y [::QW::GUI::DISTANCE::minimum [::sargs::get $Point1 .y] [::sargs::get $Point2 .y]]; ::return ".x $x .y $y"; } ::proc ::QW::GUI::POINT::maximum {Point1 Point2} { ::if {[isNull $Point2]} {::return $Point1;} ::if {[isNull $Point1]} {::return $Point2;} ::set x [::QW::GUI::DISTANCE::maximum [::sargs::get $Point1 .x] [::sargs::get $Point2 .x]]; ::set y [::QW::GUI::DISTANCE::maximum [::sargs::get $Point1 .y] [::sargs::get $Point2 .y]]; ::return ".x $x .y $y"; } } /* { itcl::class ::QW::GUI::POINT { protected variable _peer {::QW::GUI::factory "::QW::GUI::POINT";} method constructor {} { } method destructor {} { ::qw::assert {$_peer!=""} $_peer destroy; ::set _peer ""; } method x {args} { switch -exact [::llength $args] { 0 { return [$_peer x]; } 1 { $_peer x $args; return $this; } } ::qw::throw "blah blah"; } } */} #// ------------------------------------------------------------ #// ::QW::GUI::RECTANGLE namespace #// ------------------------------------------------------------ ::namespace eval ::QW::GUI::RECTANGLE { ::proc ::QW::GUI::RECTANGLE::isNull {Rect} { ::return [::expr {[::QW::GUI::POINT::isNull [::sargs::get $Rect .position]] && \ [::QW::GUI::POINT::isNull [::sargs::get $Rect .size]]}]; } ::proc ::QW::GUI::RECTANGLE::isEmpty {Rect} { ::return [::QW::GUI::POINT::isZero [::sargs::get $Rect .size]]; } ::proc ::QW::GUI::RECTANGLE::== {Rect1 Rect2} { ::return [::expr {[::QW::GUI::POINT::== [::sargs::get $Rect1 .position] [::sargs::get $Rect2 .position]] && \ [::QW::GUI::POINT::== [::sargs::get $Rect1 .size] [::sargs::get $Rect2 .size]]}]; } #// #// NOTICE negative size rectangles are possible #// ::proc ::QW::GUI::RECTANGLE::bottomRight {args} { ::set Rect [::lindex $args 0]; switch -- [::llength $args] { 1 { #//puts_pgq {"::QW::GUI::RECTANGLE::bottomRight, Rect==$Rect"}; #//puts_pgq {"::QW::GUI::RECTANGLE::bottomRight, .position.x==[::sargs::get $Rect .position.x]"}; #//puts_pgq {"::QW::GUI::RECTANGLE::bottomRight, .size.x==[::sargs::get $Rect .size.x]"}; ::set x [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .position.x] [::sargs::get $Rect .size.x]]; #//puts_pgq {"::QW::GUI::RECTANGLE::bottomRight, .positon.x + size.x==$x"}; ::set y [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .position.y] [::sargs::get $Rect .size.y]]; ::return ".x $x .y $y"; } 2 { ::set Point [::lindex $args 1]; ::set Size [::QW::GUI::POINT::- $Point [::sargs::get $Rect .position]]; ::return [::sargs::set $Rect .size "$Size"]; } } ::qw::bug "271820050331195603" "::QW::GUI::RECTANGLE::bottomRight didn't recognize args==$args"; } ::proc ::QW::GUI::RECTANGLE::topRight {args} { ::set Rect [::lindex $args 0]; switch -- [::llength $args] { 1 { ::set x [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .position.x] [::sargs::get $Rect .size.x]]; ::set y [::sargs::get $Rect .position.y] ::return ".x $x .y $y"; } 2 { ::set Point [::lindex $args 1]; ::set xSize [::QW::GUI::DISTANCE::- [::sargs::get $Point .x] [::sargs::get $Rect .position.x]]; ::set yChange [::QW::GUI::DISTANCE::- [::sargs::get $Point .y] [::sargs::get $Rect .position.y]]; ::set ySize [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .size.y] $yChange]; ::return [::sargs::set $Rect .position.y [::sargs::get $Point .y] .size ".x $xSize .y $ySize"]; } } ::qw::bug "271820050331195622" "::QW::GUI::RECTANGLE::topRight didn't recognize args==$args"; } ::proc ::QW::GUI::RECTANGLE::bottomLeft {args} { ::set Rect [::lindex $args 0]; switch -- [::llength $args] { 1 { ::set x [::sargs::get $Rect .position.x]; #// #::set y [::QW::GUI::DISTANCE::- [::sargs::get $Rect .position.y] [::sargs::get $Rect .size.y]]; ::set y [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .position.y] [::sargs::get $Rect .size.y]]; #// ::return ".x $x .y $y"; } 2 { ::set Point [::lindex $args 1]; ::set ySize [::QW::GUI::DISTANCE::- [::sargs::get $Point .y] [::sargs::get $Rect .position.y]]; ::set xChange [::QW::GUI::DISTANCE::- [::sargs::get $Point .x] [::sargs::get $Rect .position.x]]; ::set xSize [::QW::GUI::DISTANCE::+ [::sargs::get $Rect .size.x] $xChange]; ::return [::sargs::set $Rect .position.x [::sargs::get $Point .x] .size ".x $xSize .y $ySize"]; } } ::qw::bug "271820050331195651" "::QW::GUI::RECTANGLE::bottomLeft didn't recognize args==$args"; } ::proc ::QW::GUI::RECTANGLE::moveBy {Rect Point} { ::set Position [::QW::GUI::POINT::+ [::sargs::get $Rect .position] $Point]; ::return [::sargs::set $Rect .position $Position]; } ::proc ::QW::GUI::RECTANGLE::moveTo {Rect Point} { ::return [::sargs::set $Rect .position $Point]; } ::proc ::QW::GUI::RECTANGLE::| {Rect1 Rect2} { ::if {[::QW::GUI::RECTANGLE::isNull $Rect2]==1} {::return $Rect1;} ::if {[::QW::GUI::RECTANGLE::isNull $Rect1]==1} {::return $Rect2;} ::set TopLeft [::QW::GUI::POINT::minimum [::sargs::get $Rect1 .position] [::sargs::get $Rect2 .position]]; ::set BottomRight [::QW::GUI::POINT::maximum [bottomRight $Rect1] [bottomRight $Rect2]]; ::set Rect [::sargs::set $Rect1 .position $TopLeft]; ::return [bottomRight $Rect $BottomRight]; } ::proc ::QW::GUI::RECTANGLE::& {Rect1 Rect2} { ::qw::bug "271820050331195759" "::QW::GUI::RECTANGLE::& attempted to execute unimplemented proc."; } ::proc ::QW::GUI::RECTANGLE::* {Rect Point} { #// #// This looks funny, but we use it for stretching windows (think of the #// clipper.kids moving and changing size as a window is stretched). #// ::set Position [::QW::GUI::POINT::* [::sargs::get $Rect .position] $Point]; ::set Size [::QW::GUI::POINT::* [::sargs::get $Rect .size] $Point]; ::return [::sargs::set $Rect .position $Position .size $Size]; } ::proc ::QW::GUI::RECTANGLE::isPointInside {Rect Point} { /* { ::puts "::QW::GUI::RECTANGLE::isPointInside called Rect==$Rect, Point==$Point"; ::puts "::QW::GUI::RECTANGLE::isPointInside Point.x==[::sargs::get $Point .x]"; ::puts "::QW::GUI::RECTANGLE::isPointInside Rect.position.x==[::sargs::get $Rect .position.x]"; ::puts "::QW::GUI::RECTANGLE::isPointInside bottomRight of rectangle==[bottomRight $Rect]"; */} /* { return [::expr { \ [::sargs::get $Point .x] >= [::sargs::get $Rect .position.x] && \ [::sargs::get $Point .x] <= [::sargs::get [bottomRight $Rect] .x] && \ [::sargs::get $Point .y] >= [::sargs::get $Rect .position.y] && \ [::sargs::get $Point .y] <= [::sargs::get [bottomRight $Rect] .y] \ }]; */} ::return [::expr { \ [::QW::GUI::DISTANCE::>= [::sargs::get $Point .x] [::sargs::get $Rect .position.x]] && \ [::QW::GUI::DISTANCE::<= [::sargs::get $Point .x] [::sargs::get [bottomRight $Rect] .x]] && \ [::QW::GUI::DISTANCE::>= [::sargs::get $Point .y] [::sargs::get $Rect .position.y]] && \ [::QW::GUI::DISTANCE::<= [::sargs::get $Point .y] [::sargs::get [bottomRight $Rect] .y]] \ }]; /* { ::QW::GUI::RECTANGLE::isPointInside called Rect==.position {.x 136 .y 357} .size {.x 1302 .y 729}, Point==.x 450 .y 242 ::QW::GUI::RECTANGLE::isPointInside Point.x==450 ::QW::GUI::RECTANGLE::isPointInside Rect.position.x==136 ::QW::GUI::RECTANGLE::isPointInside bottomRight of rectangle==.x 1438 .y 1086 20030517_pm isPointInside position==0 */} } ::proc ::QW::GUI::RECTANGLE::isRectangleInside {Rect1 Rect2} { /* { ::puts "20030517_pm Outer Rect1==$Rect1"; ::puts "20030517_pm Inner Rect2==$Rect2"; ::puts "20030517_pm isPointInside position==[isPointInside $Rect1 [::sargs::get $Rect2 .position]]"; ::puts "20030517_pm bottomRight Rect2==[bottomRight $Rect2]"; ::puts "20030517_pm isPointInside bottomRight Rect2==[isPointInside $Rect1 [bottomRight $Rect2]]"; */} ::return [::expr { \ [isPointInside $Rect1 [::sargs::get $Rect2 .position]] && \ [isPointInside $Rect1 [bottomRight $Rect2]] }]; } } /* { #// ------------------------------------------------------------ #//itcl::local documentation #// ------------------------------------------------------------ itcl::class QW::TCL::HANDLE { protected variable _handle ""; method constructor {Handle} { ::set _handle $Handle; } method destructor {} { if {$_handle!=""} { $_handle destroy; ::set _handle ""; } } method = {Src} { if {$Src==$_handle} {return $this;} if {$_handle!=""} {$_handle destroy;} ::set _handle $Src; return $this; } method () {} { ::qw::assert {$_handle!=""}; return $_handle; } } */} #// ------------------------------------------------------------ #// ::QW::GUI::EVENT namespace #// ------------------------------------------------------------ /* { Change the %substitutions to -whateverName %W .windowPath %T .type %# .serialNumber %E .send %b .buttonNumber %R .rootWindowName %s .state %S .subWindowHex %t .time %x .x %y .y %X .rootX %Y .rootY %p .circulatePlace %a .configureAboveWindowHex %B .configureBorderWidth %h .height %w .width %o .overrideRedirect %f .focus %d .crossingAndFocusDetail %m .crossingAndFocusGrabMode %c .exposeCount %k .keyCode %A .asciiCharacter %K .keySymbolString %N .keySymbolDecimal */} namespace eval ::QW::GUI::EVENT {} namespace eval ::QW::GUI::EVENT::MOUSE {} namespace eval ::QW::GUI::EVENT::MOUSE::MOTION {} namespace eval ::QW::GUI::EVENT::MOUSE::BUTTON {} namespace eval ::QW::GUI::EVENT::MOUSE::CROSSING {} namespace eval ::QW::GUI::EVENT::MOUSE::WHEEL {} namespace eval ::QW::GUI::EVENT::KEYBOARD {} namespace eval ::QW::GUI::EVENT::UNMAP {} namespace eval ::QW::GUI::EVENT::MAP {} namespace eval ::QW::GUI::EVENT::CONFIGURE {} namespace eval ::QW::GUI::EVENT::FOCUS {} namespace eval ::QW::GUI::EVENT::VISIBILITY {} ::proc ::QW::GUI::EVENT::mask {} {return ".windowPath %W .type %T .serialNumber %# .send %E";} #nv2.14.0 ::proc ::QW::GUI::EVENT::MOUSE::mask {} {return [::concat [::QW::GUI::EVENT::mask] .state %s .subWindowHex %S .time %t .x %x .y %y .xRoot %X .yRoot %Y];} ::proc ::QW::GUI::EVENT::MOUSE::MOTION::mask {} {return [::QW::GUI::EVENT::MOUSE::mask];} ::proc ::QW::GUI::EVENT::MOUSE::BUTTON::mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .buttonNumber %b];} ::proc ::QW::GUI::EVENT::MOUSE::CROSSING::mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .focus %f .crossingAndFocusDetail %d .crossingAndFocusGrabMode %m];} ::proc ::QW::GUI::EVENT::MOUSE::WHEEL::mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .delta %D];} ::proc ::QW::GUI::EVENT::KEYBOARD::mask {} {return [::concat [::QW::GUI::EVENT::mask] .state %s .subWindowHex %S .time %t .x %x .y %y .keyCode %k .asciiCharacter %A .keySymbolString %K .keySymbolDecimal %N];} ::proc ::QW::GUI::EVENT::UNMAP::mask {} {return [::QW::GUI::EVENT::mask];} ::proc ::QW::GUI::EVENT::MAP::mask {} {return [::concat [::QW::GUI::EVENT::UNMAP::mask] .overrideRedirect %o];} ::proc ::QW::GUI::EVENT::CONFIGURE::mask {} {return [::concat [::QW::GUI::EVENT::mask] .configureAboveWindowHex %a .configureBorderWidth %B .width %w .height %h .x %x .y %y .overrideRedirect %o];} ::proc ::QW::GUI::EVENT::FOCUS::mask {} {return [::concat [::QW::GUI::EVENT::mask] .crossingAndFocusDetail %d .crossingAndFocusGrabMode %m];} ::proc ::QW::GUI::EVENT::VISIBILITY::mask {} {return [::concat [::QW::GUI::EVENT::mask] .visibilityState %s];} /* { namespace eval ::QW::GUI::EVENT { proc mask {} {return ".windowPath %W .type %T .serialNumber %# .send %E";} } namespace eval ::QW::GUI::EVENT::MOUSE { #proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .state %s .subWindowHex %S .time %t .x %x .y %y];} proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .state %s .subWindowHex %S .time %t .x %x .y %y .xRoot %X .yRoot %Y];} } namespace eval ::QW::GUI::EVENT::MOUSE::MOTION { proc mask {} {return [::QW::GUI::EVENT::MOUSE::mask];} } namespace eval ::QW::GUI::EVENT::MOUSE::BUTTON { proc mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .buttonNumber %b];} } namespace eval ::QW::GUI::EVENT::MOUSE::CROSSING { proc mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .focus %f .crossingAndFocusDetail %d .crossingAndFocusGrabMode %m];} } #20030323 namespace eval ::QW::GUI::EVENT::MOUSE::WHEEL { proc mask {} {return [::concat [::QW::GUI::EVENT::MOUSE::mask] .delta %D];} } namespace eval ::QW::GUI::EVENT::KEYBOARD { proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .state %s .subWindowHex %S .time %t .x %x .y %y .keyCode %k .asciiCharacter %A .keySymbolString %K .keySymbolDecimal %N];} } namespace eval ::QW::GUI::EVENT::UNMAP { proc mask {} {return [::QW::GUI::EVENT::mask];} } namespace eval ::QW::GUI::EVENT::MAP { proc mask {} {return [::concat [::QW::GUI::EVENT::UNMAP::mask] .overrideRedirect %o];} } namespace eval ::QW::GUI::EVENT::CONFIGURE { proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .configureAboveWindowHex %a .configureBorderWidth %B .width %w .height %h .x %x .y %y .overrideRedirect %o];} } namespace eval ::QW::GUI::EVENT::FOCUS { proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .crossingAndFocusDetail %d .crossingAndFocusGrabMode %m];} } namespace eval ::QW::GUI::EVENT::VISIBILITY { proc mask {} {return [::concat [::QW::GUI::EVENT::mask] .visibilityState %s];} } */ } /* { #// ------------------------------------------------------------ #// QW::GUI::SYSTEM class #// ------------------------------------------------------------ ::itcl::class ::QW::GUI::SYSTEM { inherit ::QW::ODB::MASTER; public method initialize {args} { ::wm withdraw "."; ::set tk_strictMotif 0; ;#// Turn off strict Motif look and feel as a default. } method destructor {} { #//::qw::assert {[::winfo children "."]==""} ;#//rwbpostquit rwb??? why did you comment this out #//if {[::winfo exists .qwguiinit]==1} { #// ::unset initCounters; ;#//whatever #// ::destroy .qwguiinit; #//} #// moved this here from failed .SHUTDOWN destructor (originally from .NV.WS.DESKTOP destructor) if {[::winfo exists .qwguiconfirmexit]==1} {::destroy .qwguiconfirmexit;} #// ::destroy "."; } } */} #// ------------------------------------------------------------ #// ::QW::GUI::OPTIONS class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::OPTIONS { inherit ::QW::ODB::STRING; public method odb_set_args {s_args} { #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] s_args==(\n[::sargs::format .structure $s_args]\n)"; ::if {[odb_is_remote]} {::return [chain $s_args];} ::set After [::sargs::get $s_args .after]; ::qw::try { ::set Before [qw_get]; ::if {$Before eq $After} {::return $this;} #::if {[::sargs::get $s_args .odb_change_before]} {} ::if {![::sargs::boolean_get $s_args .odb_change_before_skip]} { #//odb_security_check ".object $this .operation change"; odb_change_before [::sargs .object $this .before $Before .after $After]; } #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] calling qw_set After==$After"; qw_set $After; } catch Exception { #nv2.17#//::if {[::string length $Before]>63} {::set Before "[::string range $Before 0 63]..."} #nv2.17#//::if {[::string length $After]>63} {::set After "[::string range $After 0 63]..."} ::if {[::string length $Before]>63||[::string length $After]>63} { ::qw::throw [::qw::exception::parent $Exception [::sargs \ .text "Could not change \"[odb_path_from_master]\"." \ .help_id 314120050225150933 \ ]]; } ::qw::throw [::qw::exception::parent $Exception [::sargs \ .text "Could not change [odb_path_from_master] from \"$Before\" to \"$After\"." \ .help_id 314120050225150933 \ ]]; } #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] calling odb_change_after BEFORE"; odb_change_after [::sargs .object $this .before $Before .after [qw_get]]; #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] calling odb_change_after AFTER"; #::qw::stack_dump; ;#//pgq,debug #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] ::return"; #//::puts "pgq,debug::QW::GUI::OPTIONS odb_set_args [odb_path] ::return After==$After"; ::return $After; } #nv2.23.0 (new feature) - explorer_pane_restore_maximize_control ;#// no changes in the end, just experiments with "favour base" vs "favour super" options behaviour #nv2.27.0 (bug fix) - built-in pass #nv.34.0 method odb_get {} {::return [$this cpp_odb_assignable_gui_options_odb_get];} /* { favour base public method odb_get {} { #// # Testing odb_super (fractalled assignable) #// #//puts_pgq {"::QW::GUI::OPTIONS::odb_get"}; #//puts_pgq {"::QW::GUI::OPTIONS::qw_get==[qw_get]"}; #// #// This method "simulates" polymorphic widget-font-image-whatever options. #// These options are a list of -name value pairs that will satisfy and #// completely configure a tk peer. We expect to be installed as an odb_inners #// field of something (e.g. widget) and provide a polymorphic representation #// of the list on demand. We follow the heritage hierarchy until we hit #// the root and then we swing into the super, and then again up the heritage, #// and so. On the return pass -name value pairs are replaced (overridden) #// or added (introduced). ALSO, we expect these option lists to be fractalled #// as a convenient way to manage several configurations simultaneously #// (e.g. .title.options.font or .title.options/focusPath.font) #// Depending on the state of the machine, a peer configure would use one #// list (.title.options when not in the focusPath) or another #// (.title.options/focusPath when in the focusPath). #// NOTE: rwb discussed the poo compiler solution to "this problem". #// Instead of building the list on the return pass, we build it as we follow #// the heritage trail by testing if the -name value pair is in the list #// and only inserting it if it isn't. rwb says I'll be back. #// ::array set HeritageArray {}; if {[odb_base]!=""} { #//puts_pgq {"odb_base odb_path==[[odb_base] odb_path]"}; ::array set HeritageArray [[odb_base] odb_get]; } else { if {[odb_super]!=""} { #//puts_pgq {"odb_super odb_path==[[odb_super] odb_path]"}; ::array set HeritageArray [[odb_super] odb_get]; } } if {[qw_get]==""} {return [::array get HeritageArray];} #// #// "merge" the two arrays, adding what we introduce and replacing what we override #// ::array set HeritageArray [qw_get]; return [::array get HeritageArray]; } */ } /* { favour super public method odb_get {} { ::set BugPath "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/1206707965_12239.frame.dressing.title"; ::if {[::string first $BugPath [odb_path]]==0} { ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get odb_path==[odb_path]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get outer ==[::expr {[::string length [odb_outer]]?[[odb_outer] odb_path]:[odb_outer]}]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get super ==[::expr {[::string length [odb_super]]?[[odb_super] odb_path]:[odb_super]}]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get outsuper==[::expr {[::string length [[odb_outer] odb_super]]?[[[odb_outer] odb_super] odb_path]:[[odb_outer] odb_super]}]"; } ::array set HeritageArray {}; ::if {[odb_super] ne ""} { #//::puts "\todb_get odb_super odb_path==[[odb_super] odb_path]"; ::array set HeritageArray [[odb_super] odb_get]; } else { ::if {[odb_base] ne ""} { #//::puts "\todb_get odb_base odb_path==[[odb_base] odb_path]"; ::array set HeritageArray [[odb_base] odb_get]; } } ::if {[qw_get]==""} { ::if {[::string first $BugPath [odb_path]]==0} {::puts "\t[odb_path] qw_get==\"\"";} ::return [::array get HeritageArray]; } #// #// "merge" the two arrays, adding what we introduce and replacing what we override #// ::if {[::string first $BugPath [odb_path]]==0} {::puts "\t[odb_path] qw_get==[qw_get]";} ::array set HeritageArray [qw_get]; ::return [::array get HeritageArray]; } */} /* { try outer super - infinite loop never examined, debug broken off for another solution public method odb_get {} { ::set BugPath "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/1206707965_12239.frame.dressing.title"; #::if {[::string first $BugPath [odb_path]]==0} {} ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get odb_path==[odb_path]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get outer ==[::expr {[::string length [odb_outer]]?[[odb_outer] odb_path]:[odb_outer]}]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get super ==[::expr {[::string length [odb_super]]?[[odb_super] odb_path]:[odb_super]}]"; ::puts "pgq,debug223.0::QW::GUI::OPTIONS::odb_get outsuper==[::expr {[::string length [[odb_outer] odb_super]]?[[[odb_outer] odb_super] odb_path]:[[odb_outer] odb_super]}]"; #{} ::array set HeritageArray {}; ::while {1} { ::if {[[odb_outer] odb_super] ne ""} { ::array set HeritageArray [[[odb_outer] odb_super] odb_get]; ::break; } ::if {[odb_super] ne ""} { #//::puts "\todb_get odb_super odb_path==[[odb_super] odb_path]"; ::array set HeritageArray [[odb_super] odb_get]; ::break; } ::if {[odb_base] ne ""} { #//::puts "\todb_get odb_base odb_path==[[odb_base] odb_path]"; ::array set HeritageArray [[odb_base] odb_get]; ::break; } } ::if {[qw_get]==""} { ::if {[::string first $BugPath [odb_path]]==0} {::puts "\t[odb_path] qw_get==\"\"";} ::return [::array get HeritageArray]; } #// #// "merge" the two arrays, adding what we introduce and replacing what we override #// ::if {[::string first $BugPath [odb_path]]==0} {::puts "\t[odb_path] qw_get==[qw_get]";} ::array set HeritageArray [qw_get]; ::return [::array get HeritageArray]; } */} /* { public method odb_get {} { #// # Testing odb_outer odb_super (no fractalled assignables) #// #//puts_pgq {"::QW::GUI::OPTIONS::odb_get"}; #//puts_pgq {"::QW::GUI::OPTIONS::qw_get==[qw_get]"}; #// ::array set HeritageArray {}; if {[odb_base]!=""} { #//puts_pgq {"odb_base odb_path==[[odb_base] odb_path]"}; ::array set HeritageArray [[odb_base] odb_get]; } else { if {[[odb_outer] odb_super]!=""} { #//puts_pgq {"odb_outer odb_super odb_path==[[[odb_outer] odb_super] odb_path]"}; ::array set HeritageArray [[[[odb_outer] odb_super] [odb_path_from_object [odb_outer]]] odb_get]; } } if {[qw_get]==""} {return [::array get HeritageArray];} #// #// "merge" the two arrays, adding what we introduce and replacing what we override #// ::array set HeritageArray [qw_get]; return [::array get HeritageArray]; } */} /* { public method odb_get {} { This failed because ron returns a master's base when asked for it's super #// # Testing odb_outer odb_super (no fractalled assignables) - AND favouring super instead of base... #// #//puts_pgq {"::QW::GUI::OPTIONS::odb_get"}; #//puts_pgq {"::QW::GUI::OPTIONS::qw_get==[qw_get]"}; #// ::array set HeritageArray {}; if {[[odb_outer] odb_super]!=""} { puts_pgq {"odb_outer odb_super odb_path==[[[odb_outer] odb_super] odb_path]"}; ::array set HeritageArray [[[[odb_outer] odb_super] [odb_path_from_object [odb_outer]]] odb_get]; } else { if {[odb_base]!=""} { puts_pgq {"odb_base odb_path==[[odb_base] odb_path]"}; ::array set HeritageArray [[odb_base] odb_get]; } } if {[qw_get]==""} {return [::array get HeritageArray];} #// #// "merge" the two arrays, adding what we introduce and replacing what we override #// ::array set HeritageArray [qw_get]; return [::array get HeritageArray]; } */} public method replace {args} { #// #//::puts "pgq,debug::QW::GUI::OPTIONS replace [odb_path], args==$args, qw_get==[qw_get]"; #// ::array set Current [qw_get]; ::array set Current $args; #// #//::puts "pgq,debug options replace, array get Current==[::array get Current]"; #//::foreach N [::array names Current] {::puts "pgq,debug::QW::GUI::OPTIONS replace [odb_path] array Current N==$N";} #//::foreach N [::array names Current] {::puts "pgq,debug::QW::GUI::OPTIONS replace [odb_path] array Current N==$N V==$Current($N)";} #//::foreach {N V} [::array get Current] {::puts "pgq,debug::QW::GUI::OPTIONS replace [odb_path] array Current N==$N V==$V";} #// odb_set [::array get Current]; #// #//::puts "pgq,debug2292::QW::GUI::OPTIONS replace [odb_path], after odb_set and odb_get==[odb_get]"; #// ::return $this; } } #// ------------------------------------------------------------ #// ::QW::GUI::OPTIONS_FONT class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::OPTIONS_FONT { inherit ::QW::GUI::OPTIONS; protected variable _tkName ""; public method odb_initialize {} { chain; ::if {[qw_get] ne ""} { #//::puts "pgq,debug2384::QW::GUI::OPTIONS_FONT odb_initialize odb_path==[odb_path]"; ::set _tkName [::eval ::font create [odb_get]]; #//::puts "pgq,debug2384::QW::GUI::OPTIONS_FONT odb_initialize created font _tkName==$_tkName, with options qw_get==[qw_get]"; #::qw::stack_dump; #//::puts "pgq,debug2384::QW::GUI::OPTIONS_FONT odb_initialize created font _tkName==$_tkName, with options odb_get==[odb_get]"; #//#//::puts "pgq,debug2384::QW::GUI::OPTIONS_FONT odb_initialize font names==[::font names]"; ::foreach Fname [::lsort [::font names]] {#//::puts "pgq,debug2384::QW::GUI::OPTIONS_FONT odb_initialize font name==$Fname";} } } public method destructor {} { ::if {$_tkName ne ""} { ::font delete $_tkName; #//puts_pgq {"deleted font _tkName==$_tkName"}; #//puts_pgq {"deleted font names==[::font names]"}; ::set _tkName ""; } } public method odb_get {} { #// #// NOTICE font sizes are stored as real numbers (if they are set to a real #// number or stretched). We need to respect realness and round to an integer #// point size only when we wack tk. (If we didn't we get a drifting mess #// of error accumulation in the life of stretching a window.) #// #//::puts "20040603 screen tk_info screenwidth==[::winfo screenwidth .]"; #//::puts "20040603 screen tk_info screenheight==[::winfo screenheight .]"; ::array set Options [chain]; ::set Options(-size) [::expr round($Options(-size))]; #//::puts "\n::QW::GUI::OPTIONS_FONT odb_get odb_path==[odb_path] font options odb_get==[::array get Options]"; /* { ::set ScreenWidth [::winfo screenwidth .]; ::if {$ScreenWidth<1050} { ::set Options(-family) "Tahoma"; ::set Options(-weight) "normal"; ::set Options(-size) "8"; } ::if {$ScreenWidth<1300} { ::set Options(-family) "Tahoma"; ::set Options(-weight) "bold"; ::if {} { } ::set Options(-size) "9"; } */} ::return [::array get Options]; #// # NOTICE #// Screen sizes found on pgq's computer and Anna's smaller, older screen... #// 640 480 #// 800 600 #//* 1024 768 #// 1152 864 #// 1280 768 #//* 1280 1024 #//* 1600 1200 #// 1792 1344 #// Screen sizes found on Anna's smaller, older screen... #// 848 480 #// Screen sizes found on Craig's very small, very old screen??? #// 1800 1440 #// 1856 1392 #// 1920 1080 #// 1920 1200 #// 1920 1440 #// 2048 1536 } protected method odb_change_after {s_args} { #//::puts "::QW::GUI::OPTIONS_FONT odb_change_after odb_path==[odb_path] s_args==(\n[::sargs::format .structure $s_args]\n)"; ::if {[::sargs::get $s_args .before] eq ""} { ::set _tkName [::eval ::font create [odb_get]]; } ::if {[::sargs::get $s_args .after] eq ""} { ::font delete $_tkName; ::set _tkName ""; } else { ::eval ::font configure $_tkName [odb_get]; } chain $s_args; } public method tkName {} { ::if {$_tkName ne ""} { #//::puts "pgq,debug::QW::GUI::OPTIONS_FONT tkName ::return _tkName==$_tkName"; ::return $_tkName; } #//::puts "font tkName called odb_base==[odb_base]"; ::if {[odb_base] eq ""} { #// #//::puts "font name is empty and odb_base==\"\""; #//return "{}"; ::set Wow [chain]; #// #//::puts "font odb_base==[odb_base]"; #//::puts "pgq,debug::QW::GUI::OPTIONS_FONT tkName chain returns==$Wow"; ::return $Wow; #// #//return [chain]; #// } #//::puts "pgq,debug::QW::GUI::OPTIONS_FONT tkName calling odb_base==[[odb_base] odb_path]"; ::return [[odb_base] tkName]; } #public method average_character_width_pixels {Window} {} public method average_character_width_pixels {} { #::set Sample "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()-_=+|[{]};:<,>.?/"; ;# WOW braces and brackets really mess up tcl ::set Sample "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()-_=+|;:<,>.?/"; ::return [::expr {[::font measure tkName $Sample]/[::string length $Sample]}]; } public proc defaultOptionsList {} { #//::set Result $chain; ;#// derived class will do this ::append Result " -family System"; ::append Result " -size 5"; #::append Result " -weight bold"; ::append Result " -weight normal"; ::append Result " -slant roman"; ::append Result " -underline 0"; ::append Result " -overstrike 0"; ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::OPTIONS_IMAGE class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::OPTIONS_IMAGE { inherit ::QW::GUI::OPTIONS; protected variable _tkName ""; protected variable _hyphen_data 1; # NOTICE ::qw::control(photo_is_enabled) /* { public method odb_get {} must be replaced with non-defaulted get (unless we want a "No Photo Available" photo everywhere for free once at the root) */} public method odb_initialize {} { chain; #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_initialize [odb_path] qw_get ::string length==[::string length [qw_get]]"; ::if {[qw_get] ne ""} { #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_initialize [odb_path] qw_get==\"[qw_get]\""; #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_initialize [odb_path] qw_get ::string length==[::string length [qw_get]]"; #imagebug #::set _tkName [::eval ::image create [createCommand] [odb_get]]; ;#// some problem never documented #nv2.29.0 (debug) ::if {$_hyphen_data} { #::set _tkName [::eval ::image create [createCommand] "gui_[::QW::GUI::uniqueId]" [odb_get]]; ;#// this is the statement working for 10 years ::set _tkName [::eval ::image create [createCommand] "gui_[::string map [::list / _ . _] [odb_path]]_[::QW::GUI::uniqueId]" [odb_get]]; ;#// readable debug # NOTICE #// toyed with dropping the "-data " from the value stored in this window's client image option - not happy, too many changes for no/little gain #//#::set _tkName [::eval ::image create [createCommand] "gui_[::string map [::list / _ . _] [odb_path]]_[::QW::GUI::uniqueId]" "-data [odb_get]"]; } else { ::set _tkName [::eval ::image create [createCommand] "gui_[::string map [::list / _ . _] [odb_path]]_[::QW::GUI::uniqueId]"]; configure_data; } #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_initialize created image _tkName==$_tkName, with options==[odb_get]"; #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_initialize created image names==[::image names]"; } } public method destructor {} { #//puts_pgq {"::QW::GUI::OPTIONS_IMAGE destructor _tkName==$_tkName"}; ::if {$_tkName ne ""} { ::image delete $_tkName; #//puts_pgq {"deleted image _tkName==$_tkName"}; #//puts_pgq {"deleted image names==[::image names]"}; ::set _tkName ""; } } public method createCommand {} {::return "bitmap";} #nv2.29.0 public method configure_data {} { # ONLY CALLED if $_hyphen_data==0 #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE configure_data [odb_path] qw_get ::string length==[::string length [qw_get]] _tkName==$_tkName"; ::eval $_tkName configure [odb_get]; ;#// bitmaps have -data and -maskdata ::return; } public method odb_change_after {s_args} { #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] s_args==(\n[::sargs::format .structure $s_args]\n)"; ;#// gigabyte list file! ::set Object [::sargs::get $s_args .object]; ::set Before [::sargs::get $s_args .before]; ::set After [::sargs::get $s_args .after]; #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] .object==[$Object odb_path]"; #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] .before==\"[::string range $Before 0 9]\""; #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] .after ==\"[::string range $After 0 9]\""; #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] _tkName==$_tkName"; /* { pgq,debug::QW::GUI::OPTIONS_IMAGE odb_change_after /OBJECT/NEWVIEWS/ACCOUNT/BANK/1154357649_1185.photo s_args==( .object ::qw::odb::20070607175816::/1154357649_1185.photo .before {} .after {-data R0lGODlhAAKAAfcAABUSE6mMYkxAfk5PPL...} ) */} #bullshit waiting to leak? ::if {[::sargs::get $s_args .before] eq ""||[::sargs::get $s_args .before] eq "-data {}"} { #imagebug #::set _tkName [::eval ::image create [createCommand] [odb_get]]; ;#// some problem never documented #nv2.29.0 (debug) ::if {$_hyphen_data} { #::set _tkName [::eval ::image create [createCommand] "gui_[::QW::GUI::uniqueId]" [odb_get]]; #::set _tkName [::eval ::image create [createCommand] "gui_[::QW::GUI::uniqueId]" "-data [odb_get]"]; ::set _tkName [::eval ::image create [createCommand] "gui_[::string map [::list / _ . _] [odb_path]]_[::QW::GUI::uniqueId]" [odb_get]]; } else { ::set _tkName [::eval ::image create [createCommand] "gui_[::string map [::list / _ . _] [odb_path]]_[::QW::GUI::uniqueId]"]; configure_data; } #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] ::image created _tkName==$_tkName"; } ::if {[::sargs::get $s_args .after] eq ""||[::sargs::get $s_args .after] eq "-data {}"} { #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] .after eq \"\" _tkName==\"$_tkName\""; #//::foreach Iname [::image names] {#//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] image name==$Iname"}; ::qw::try { ::image delete $_tkName; } catch Exception { #//::puts "pgq,debug::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] Exception==$Exception"; #::qw::stack_dump; ;#//pgq,debug229 ::qw::throw $Exception; } ::set _tkName ""; } else { /* { */} #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE odb_change_after [odb_path] calling image configure"; #nv2.29.0 () ::if {$_hyphen_data} { #::eval $_tkName configure "-data [odb_get]"; #$_tkName blank; ;#// this is new for nv2.29.0 - but bitmaps don't have this command #image_blank; ;#// a lame attempt to get a configure of -data {something} to -data {} to be live, but problem went away by itself ::eval $_tkName configure [odb_get]; } else { configure_data; } } chain $s_args; } method image_blank {} { ::return; } #nv2.29.0 () public method tkNameReplace {Src} { # NOT CALLED ::if {$_tkName ne ""} { ::set NewName [::eval ::image create [createCommand] "gui_[::QW::GUI::uniqueId]"]; $NewName copy $_tkName; ::image delete $_tkName; ::set _tkName $NewName; } ::return $_tkName; } public method tkName {} { ::if {$_tkName ne ""} { #//::puts "pgq,debug...::QW::GUI::OPTIONS_IMAGE tkName ::return $_tkName"; ::return $_tkName; } #//::puts "20060111.444.111 odb_base==[odb_base]"; #//if {[odb_base]==""} {return "{}";} #//::qw::stack_dump; #nv2.29.0 () #::return ""; ;#// just debugging #//::puts "pgq,debug...::QW::GUI::OPTIONS_IMAGE tkName odb_base==\"[::expr {[odb_base] eq ""?{}:[[odb_base] odb_path]}]\""; ::if {[odb_base] eq ""} { ::return ""; } ::return [[odb_base] tkName]; } public proc defaultOptionsList {} { #//::set Result $chain; ;#// derived class will do this #// #// We have a major kludge to contend with here. The boys at tk decided that #// image display takes precedence over text display. So to display text on #// a button, no node in the heritage path can return an image. This includes #// the root. There are other solutions, but this will do for now. #// #//::set Data {}; #//::set Data { #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #// {----------}\ #//} #// #// We would like to do this, but tk will croak, unless we provide for non configureList #// stuff in the options (e.g. carry the stuff around, and when the rubber hits #// the road for a call to tk, take out only what we know we need, YUK, or strip #// out the stuff we don't need, YUK, or split the option into two versions, tk #// only vs non tk...) #//::append Result " -asciiData $Data"; #// #//::append Result " -background white"; #//::append Result " -foreground black"; #//::append Result " -data [::QW::GUI::IMAGE_BITMAP::asciiToHex $Data data]"; #//::append Result " -maskdata [::QW::GUI::IMAGE_BITMAP::asciiToHex $Data mask]"; #//::append Result " -file {}"; #//::append Result " -maskfile {}"; #// ::qw::throw [::sargs \ .text "Pure virtual proc in class ::QW::GUI::OPTIONS_IMAGE not overridden." \ .help_id 271820160429112455 \ ]; ::return $Result; } public method size {} { #nv2.29.0 (bug fix) - ::QW::GUI::OPTIONS_IMAGE method size - ::image width "" error - when resurrecting .photo fields ::if {$_tkName eq ""} { ::return ".x 0 .y 0"; } ::set Width [::image width $_tkName]; ::set Height [::image height $_tkName]; ::return ".x $Width .y $Height"; } } #// ------------------------------------------------------------ #// ::QW::GUI::OPTIONS_IMAGE_PHOTO class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::OPTIONS_IMAGE_PHOTO { inherit ::QW::GUI::OPTIONS_IMAGE; public method createCommand {} {::return "photo";} #nv2.29.0 public method configure_data {} { # ONLY CALLED if $_hyphen_data==0 #//::puts "pgq,debug229::QW::GUI::OPTIONS_IMAGE_PHOTO configure_data [odb_path] qw_get ::string length==[::string length [qw_get]] _tkName==$_tkName"; $_tkName blank; #$_tkName put [::string range [odb_get] 6 end]; ;#// strip off "-data " ;#//GP #$_tkName put "[::string range [odb_get] 6 end]"; ;#// strip off "-data " ;#//GP ::set Data [::string range [odb_get] 6 end]; ;#// strip off "-data " ::if {$Data ne "{}"} { $_tkName put $Data; } ::return; } /* { method image_blank {} { $_tkName blank; ;#// this is new for nv2.29.0 - but bitmaps don't have this command ::return; } */} } #// ------------------------------------------------------------ #// ::QW::GUI::REFERENCE class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::REFERENCE { inherit ::QW::ODB::REFERENCE; /* { c:/pgq/object/system/gui/install.qw_script - [$Window ".owner"] odb_inners_factory -cpp_class "::QW::ODB::REFERENCE" -odb_id ".parent" -tcl_base "::QW::GUI::REFERENCE"; c:/pgq/object/system/gui/install.qw_script - [$Window ".clipper"] odb_inners_factory -cpp_class "::QW::ODB::REFERENCE" -odb_id ".parent" -tcl_base "::QW::GUI::REFERENCE"; c:/pgq/object/system/gui/install.qw_script - [$Window ".focus"] odb_inners_factory -cpp_class "::QW::ODB::REFERENCE" -odb_id ".parent" -tcl_base "::QW::GUI::REFERENCE"; c:/pgq/object/system/gui/install.qw_script - [$Window ".pick"] odb_inners_factory -cpp_class "::QW::ODB::REFERENCE" -odb_id ".parent" -tcl_base "::QW::GUI::REFERENCE"; */} /* {20041213 protected method odb_change_after {{s_args ""}} { #//rwbfix odb_commit; ;#// update the indexes #//rwbfix [odb_master] odb_commit; ;#// update the indexes (this worked for boot and run for many weeks) #// #broken index experiment #// #20040728_blink (remove this and NOTHING works...) ::if {![[odb_master] odb_is_committing]&&![[odb_master] odb_is_destroying]} {[odb_master] odb_commit;} ;#// this is slow as a snail #// #if {![[odb_master] cpp_isCommitting]} {$this cpp_update;} ;#// this is much snappier #// chain $s_args; } */} /* {20061025 protected method odb_change_after {{s_args ""}} { #//rwbfix odb_commit; ;#// update the indexes #//rwbfix [odb_master] odb_commit; ;#// update the indexes (this worked for boot and run for many weeks) #// #broken index experiment #// #20040728_blink (remove this and NOTHING works...) ::if {![[odb_master] odb_is_committing]&&![[odb_master] odb_is_destroying]} { [odb_master] odb_commit; } ;#// this is slow as a snail #// #if {![[odb_master] cpp_isCommitting]} {$this cpp_update;} ;#// this is much snappier #// chain $s_args; } */} protected method odb_change_after {{s_args ""}} { #//rwbfix odb_commit; ;#// update the indexes #//rwbfix [odb_master] odb_commit; ;#// update the indexes (this worked for boot and run for many weeks) #// #broken index experiment #// #20040728_blink (remove this and NOTHING works...) #// #// With tokens, we no longer need the odb_is_committing and odb_is_destroying calls #// and in fact I have removed these methods. #// #2.09 ::if {![[odb_master] odb_is_committing]&&![[odb_master] odb_is_destroying]} {} #//::puts "pgq,debug613::QW::GUI::REFERENCE odb_change_after enter s_args==(\n[::sargs::format $s_args]\n)"; #//::puts "pgq,debug613::QW::GUI::REFERENCE odb_change_after this==$this"; #//::puts "pgq,debug613::QW::GUI::REFERENCE odb_change_after this ::qw::command_exists==[::qw::command_exists $this]"; #nv2.27.0 (built-ins) ::if {[::qw::command_exists $this]} { #//::puts "pgq,debug613::QW::GUI::REFERENCE odb_change_after calling odb_commit, odb_path==[odb_path]"; [odb_master] odb_commit; #// chain $s_args; } } public method signalWrite {} { #//::puts "pgq,debug::QW::GUI::REFERENCE signalWrite enter"; ::return $this; } } #// ------------------------------------------------------------ #// ::QW::GUI::COLLECTION class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::COLLECTION { inherit ::QW::ODB::COLLECTION; /* { c:/pgq/object/system/gui/install.qw_script - [$Window ".owner"] odb_inners_factory -cpp_class "::QW::ODB::COLLECTION" -odb_id ".kids" -tcl_base "::QW::GUI::COLLECTION"; c:/pgq/object/system/gui/install.qw_script - [$Window ".clipper"] odb_inners_factory -cpp_class "::QW::ODB::COLLECTION" -odb_id ".kids" -tcl_base "::QW::GUI::COLLECTION"; c:/pgq/object/system/gui/install.qw_script - [$Window ".focus"] odb_inners_factory -cpp_class "::QW::ODB::COLLECTION" -odb_id ".kids" -tcl_base "::QW::GUI::COLLECTION"; c:/pgq/object/system/gui/install.qw_script - [$Window ".pick"] odb_inners_factory -cpp_class "::QW::ODB::COLLECTION" -odb_id ".kids" -tcl_base "::QW::GUI::COLLECTION"; */} public method signalWrite {} { #//::puts "pgq,debugGP::QW::GUI::COLLECTION signalWrite enter odb_path==[odb_path]"; #::qw::stack_dump; ;#//pgq,debug ::set Index [odb_primary]; #//::puts "pgq,debug609::QW::GUI::COLLECTION signalWrite Index==$Index"; #//::puts "pgq,debug609::QW::GUI::COLLECTION signalWrite Index==[$Index odb_path]"; #//::puts "pgq,debug609::QW::GUI::COLLECTION signalWrite odb_items==[$Index odb_items]"; #//::puts "pgq,debug609::QW::GUI::COLLECTION signalWrite odb_first==[$Index odb_first]"; #//::for {::set Ref [$Index odb_first];} {$Ref ne ""} {::set Ref [$Index odb_next $Ref];} { #// ::puts "pgq,debug::QW::GUI::COLLECTION kid==[$Ref odb_path]"; #//} #nv2.27.1 (experiment) - signalWrite propagation in gui hierarchies are odb_next iterating over indexes that could change underfoot - the ::foreach was here from eons ago but commented out #//::puts "pgq,debug::QW::GUI::COLLECTION signalWrite Index odb_items==[$Index odb_items]"; /* { ::for {::set Ref [$Index odb_first];} {$Ref ne ""} {::set Ref [$Index odb_next $Ref];} { #//::puts "pgq,debug::QW::GUI::COLLECTION signalWrite ::for Ref==[$Ref odb_path]"; $Ref signalWrite; } */} ::set Refs [$Index odb_references ".order_is_kept 1"]; #//::puts "pgq,debug::QW::GUI::COLLECTION signalWrite ::foreach Refs ::llength==[::llength $Refs]"; ::foreach Ref $Refs { ::if {[::qw::command_exists $Ref]} { #//::puts "pgq,debug::QW::GUI::COLLECTION signalWrite ::foreach Ref==[$Ref odb_path]"; $Ref signalWrite; } } /* { */} #//::puts "pgq,debug609::QW::GUI::COLLECTION signalWrite return this==$this ::qw::command_exists==[::qw::command_exists $this]"; ::return $this; } } /* { #// ------------------------------------------------------------ #// ::QW::GUI::SYSTEM class #// ------------------------------------------------------------ ::itcl::class ::QW::GUI::SYSTEM { #//inherit ::QW::ODB::OBJECT; inherit ::QW::ODB::MASTER; #// protected variable _tkPeers ""; public method initialize {args} { chain $args; ::array set _tkPeers {}; } public method destructor {} { ::qw::assert ...array is empty } public method tkPeerCreate {} { } public method tkPeerDestroy {} { } public method tkPeerEventDispatch {args} { ::array set Event $args; $_tkPeers($Event(-windowPath)) } public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// #//chain; #// #//::bind QW_GUI_WIDGET [::itcl::code $this] buttonPress [::QW::GUI::EVENT::MOUSE::BUTTON::mask]; #// ::set Options(-xscrollcommand) [::itcl::code [[$Master ".client"] cpp_tcl_instance] scrollbarSetH]; puts_pgq {"::QW::GUI::WIDGET::setBindings, [odb_path], this info class==[$this info class]"}; ::bind ::QW::GUI::WIDGET [::itcl::code [[odb_master] cpp_tcl_instance]] focusIn; #// return $this; } } */} #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET class #// ------------------------------------------------------------ #// Ideally, we'd like to have our toplevel be just a region on the screen without #// host window manager dressing, and let our window class do the dressing and #// manage the window just like we do for all internal mdi windows. But tk will #// not iconize a region, it has to be a toplevel which the host wm dresses and #// manages (i.e. with overrideredirect false). Maybe we could turn host wm dressing #// on and iconize it without flicker? When the icon is restored we do the reverse? #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET { #//inherit ::QW::ODB::OBJECT; inherit ::QW::ODB::FIELD; protected variable _tkName ""; protected variable _tkPath ""; protected variable _tkClass ""; #// #// ------------------------------------------------------------ /* { public method tk_eval {args} { ::foreach Handle [::lrange $args 1 end] { if {![$Handle tk_isCreated]} {return $this;} } ::eval [::lindex $args 0]; return $this; } public method tk_isCreated {} { if {$_tkName==""} {return 0;} return 1; } #// or... public method tk_eval {args} { ::qw::try {::eval $args;} catch Exception {return $this;} return $this; } #//from _SCROLLBAR public method scrollbarSet {args} { ::eval [tkPath] set $args; return $this; } public method scrollbarSet {args} { tk_eval "[tkPath] set $args" $this; return $this; } public method scrollbarSet {args} { tk_eval "[tkPath] set $args"; return $this; } #//from WINDOW.clipper.parent public method restore {} { ::pack propagate [[[odb_master] ".frame"] tkPath] 1; ::set Rect [[odb_master] rectangle]; if {[::QW::GUI::POINT::isNull [::sargs::get $Rect .position]] || [::QW::GUI::RECTANGLE::isEmpty $Rect]} {::update idletasks;} [odb_get] restore $this; ::pack propagate [[[odb_master] ".frame"] tkPath] 0; return $this; } public method restore {} { tk_eval "::pack propagate [[[odb_master] .frame] tkPath] 1" [[odb_master] ".frame"]; ::set Rect [[odb_master] rectangle]; if {[::QW::GUI::POINT::isNull [::sargs::get $Rect .position]] || [::QW::GUI::RECTANGLE::isEmpty $Rect]} {::update idletasks;} [odb_get] restore $this; tk_eval "::pack propagate [[[odb_master] .frame] tkPath] 0" [[odb_master] ".frame"]; return $this; } public method restore {} { tk_eval "::pack propagate [[[odb_master] .frame] tkPath] 1"; ::set Rect [[odb_master] rectangle]; if {[::QW::GUI::POINT::isNull [::sargs::get $Rect .position]] || [::QW::GUI::RECTANGLE::isEmpty $Rect]} {::update idletasks;} [odb_get] restore $this; tk_eval "::pack propagate [[[odb_master] .frame] tkPath] 0"; return $this; } #//from WINDOW.clipper.kids public method pgq_makeBefore {Ref,Key} { #//chain $Ref $Key; makeBefore $Ref $Key; ::raise [[[$Ref odb_master] ".frame"] tkPath] [[[$Key odb_master] ".frame"] tkPath] ; return $this; } public method pgq_makeBefore {Ref,Key} { #//chain $Ref $Key; makeBefore $Ref $Key; tk_eval "::raise [[[$Ref odb_master] .frame] tkPath] [[[$Key odb_master] .frame] tkPath]" [[[$Ref odb_master] ".frame"] tkPath] [[[$Key odb_master] ".frame"] tkPath]; return $this; } */} #// ------------------------------------------------------------ public method tk_create {TkOwnerPath} { #//::puts "pgq,debug_86font::QW::GUI::WIDGET tk_create enter TkOwnerPath==$TkOwnerPath"; ::if {$_tkName ne ""} { #20050215_333 #::return $this; ::lappend Error "[odb_path], tk_create attempted to create peer _tkName==$_tkName, _tkPath==$_tkPath of class \"[tkClass]\" that already exists."; ::lappend Error "[odb_path], tk reports ::winfo exists _tkPath==[::winfo exists $_tkPath]"; ::qw::bug "271820050208111947" $Error; } #nv2.12.1 (no change - just looking relating to bookmark id's) ::set _tkName [unique_id]; ::set _tkPath $TkOwnerPath.$_tkName; ;#// NOTICE the "." is NOT a typo #// #nv2.28.4 (bind) ::if {$::qw::control(bind_replace)} { ::set Database [[odb_master] odb_database application]; ::if {$Database ne ""} { ::set ::qw_gui_widget_database_id_array($_tkPath) [$Database cpp_id]; } } #// #//::puts "pgq,debug_86font------- tk_create widget:[createCommand] $_tkPath of tkClass:[tkClass], configureList==[configureList]"; #//::puts "pgq,debug_86font------- tk_create widget:this==$this"; #//::puts "pgq,debug_86font------- tk_create widget:this==[odb_path]"; #//::puts "pgq,debug_86font_dialogs------- tk_create widget==[createCommand] $_tkPath of tkClass==[tkClass], swizzled_configure_list==[swizzled_configure_list]"; #// #//#//::puts "pgq,debug tk_create calling createPeerInstance before"; createPeerInstance; #//#//::puts "pgq,debug tk_create calling createPeerInstance after"; #// Unlike every other widget type, toplevels are created in a "mapped" state #// so we withdraw it at creation so it behaves like everybody else #// and we hide its dressing for the same reason (WINDOW.dressing.show() #// and hide() will turn it on and off) ::if {[tkClass] eq "Toplevel"} { #// # NOTICE #// These 2 statements are causing me trouble on gui_load. Only one of two #// tk_toplevels makes it to the screen? Commenting them out seems to cause no adverse affects. #::wm withdraw [tkPath]; #::wm overrideredirect [tkPath] 1; #// ::array set Options [[[odb_master] ".frame.dressing.title.options.widget"] odb_get]; ::wm title [tkPath] $Options(-text); #// #::wm iconbitmap [tkPath] [::file join $::env(pgq) lib gui nv2.ico]; #// #::qw::toplevel_add [::sargs .path $_tkPath]; } bind; tag; #//::puts "pgq,debug_86font::QW::GUI::WIDGET tk_create ::return"; ::return $this; } public method createPeerInstance {} { /* { ::set BugPath "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/1206707965_12239.frame.dressing.title"; ::if {[::string first $BugPath [odb_path]]==0} { ::puts "pgq,debug223.0...createPeerInstance:[createCommand] $_tkPath of tkClass:[tkClass]"; } */} #::eval [createCommand] $_tkPath [configureList]; /* { #//::puts "pgq,debug238.1...createPeerInstance [odb_path] createCommand==\"[createCommand]\" $_tkPath of tkClass==\"[tkClass]\""; #//::puts "pgq,debug238.1...createPeerInstance [::string range [odb_path] [::string first . [odb_path]] end] createCommand==\"[createCommand]\" $_tkPath of tkClass==\"[tkClass]\""; #//::puts "pgq,debug238.1_code_demo...createPeerInstance [::string range [odb_path] [::string first . [odb_path]] end] createCommand==\"[createCommand]\" tkClass==\"[tkClass]\""; ::foreach {Option Value} [swizzled_configure_list] {#//::puts "pgq,debug238.1...createPeerInstance BEFORE [odb_path] configure Option==$Option Value==\"$Value\"";} ::qw::stack_dump; ;#//pgq,debug238.1 */} ::qw::try { ::eval [createCommand] $_tkPath [swizzled_configure_list]; #//::puts "pgq,debug...createPeerInstance AFTER"; } catch Exception { #//::puts "pgq,debug...createPeerInstance Exception==$Exception"; #::qw::stack_dump; ;#//pgq,debug229 ::qw::throw $Exception; } ::return $this; } public method createCommand {} { #//puts_pgq {"createCommand, odb_outer odb_path==[[odb_outer] odb_path]"}; #// move this to WINDOW.frame #//if {[[[odb_master] ".clipper.parent"] odb_get]==""} {::set _tkClass "Frame";return "::frame";} ;#// this covers the screen #//if {[[[[[odb_master] ".clipper.parent"] odb_get] odb_master] isScreen]} {::set _tkClass "Toplevel";return "::toplevel";} #// ::set _tkClass "Frame"; ::return "::frame"; } /* { public method recreate {} { puts_pgq {"QW::WIDGET.recreate() before _tkPath=$_tkPath"}; tk_destroy; create; puts_pgq {"QW::WIDGET.recreate() after _tkPath=$_tkPath"}; return $this; } */} #// ------------------------------------------------------------ public method tk_destroy {} { #//::puts "pgq,debug::QW::GUI::WIDGET tk_destroy enter odb_master odb_path==[[odb_master] odb_path]"; #//::puts "pgq,debug2383::QW::GUI::WIDGET tk_destroy enter odb_path==[odb_path]"; #::qw::stack_dump; ;#//pgq,debug #// #//too agressive - everything is dismantled/gone #//puts_pgq {"------- tk_destroy widget:[createCommand] $_tkPath of tkClass:[tkClass], configureList==[configureList]"}; #//puts_pgq {"------- tk_destroy widget:[createCommand] $_tkPath of tkClass:[tkClass], swizzled_configure_list==[swizzled_configure_list]"}; #// ::if {$_tkName eq ""} { ::puts "Fatal Error: Window [odb_path] attempted to destroy a peer that doesn't exist."; ::qw::stack_dump; ::qw::bug "271820050208110956" "Fatal Error: Window [odb_path] attempted to destroy a peer that doesn't exist."; } #pink screen of death ::set OwnerKids "[::winfo children [tkPath]]"; #::set OwnerKids ""; #// ::if {$OwnerKids ne ""} { ::puts "Fatal Error: Widget [tkPath] being destroyed but it still has OwnerKids:\n$OwnerKids"; ::puts "20040703_bad_window_path odb_master observer_database==[[odb_master] observer_database]"; ::if {[[odb_master] observer_database] ne ""} {::puts "odb_master observer_database odb_path==[[[odb_master] observer_database] odb_path]";} ::set Owner [[[[odb_master] ".owner.parent"] odb_get] odb_master]; ::puts "20040703_bad_window_path owner==[$Owner odb_path]"; #// #[[odb_master] screen] putsMarkerToListFile; ::qw::stack_dump; ::qw::bug "271820050208110902" "Fatal Error: Window [odb_path] is being destroyed but it still has sub windows."; } /* { */} #// We should also check to make sure the peer's "slaves" collection is empty! #// Switch on the class of the master/slave relation? NOT #// We can use tk to retrieve pack, place and grid slaves #// (but not interactives - actually canvas and tags and a few minutes work will do it) #// # NOTICE #// We are toast. tk is firing bindings long after a widget is destroyed. First just toplevels #// but then it fired on an internal frame do we nuke it from orbit. Thankfully setting all #// bindings to empty saves us. /* { if {[tkClass]=="Toplevel"} { ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} ::bind [pathAsTag] {} } #::bindtags [tkPath] ___void___; #// this does not help, we still receive events (enter at least) long after the widget is gone */} /* { puts_pgq {"before tk_destroy ::winfo exists _tkPath==$_tkPath and exists==[::winfo exists $_tkPath]"}; ::set PathAsTag [pathAsTag]; foreach Binding [::bind $PathAsTag] { puts_pgq {"before tk_destroy binding $Binding==[::bind $PathAsTag $Binding]"}; ::bind $PathAsTag $Binding {} } */} ::qw::try { ::destroy [tkPath]; #nv2.28.4 (bind) ::if {$::qw::control(bind_replace)} { ::if {[::info exists ::qw_gui_widget_database_id_array($_tkPath)]} { ::unset ::qw_gui_widget_database_id_array($_tkPath); } } } catch Exception { ::puts "Fatal Error: Window [odb_path] destroy encountered exception==$Exception"; ::qw::stack_dump; ::qw::bug "271820050208111336" "Fatal Error: Window [odb_path] destroy encountered exception==$Exception"; } /* { puts_pgq {"after tk_destroy ::winfo exists _tkPath==[::winfo exists $_tkPath]"}; foreach Binding [::bind $PathAsTag] { puts_pgq {"after tk_destroy binding $Binding==[::bind [pathAsTag] $Binding]"}; } */} ::set _tkName ""; ::set _tkPath ""; ::set _tkClass ""; ::return ""; } #//nameCleanup #//method THIS& (OUTER&) tkName(.STRING& Src) {_tkName=Src;return This;} #// public method tkName {} { ::if {$_tkName eq ""} { ::qw::stack_dump; ::qw::bug "271820050208112057" "[odb_path], tkName attempted to access a peer that doesn't exist."; } ::return $_tkName; } public method path {} { #//pgqfix #// This method is used when OUTER calls to get the path, we're hooking #// up an ownerParent pass and we dont want the asserts of the tkPath() #// method that follows. RWB says rename tkPath() to handle() ::return $_tkPath; } public method tkPath {} { ::if {$_tkName eq ""} { #20050215_333 #[odb_master] peerCreate; #::return $_tkPath; #// # NOTICE #// For some reason, I don't remember and have to debug the hard way, the throw #// was replaced with a return empty... ::puts "20040703_bad_window_path [odb_path], tkPath called for non existing peer."; ::puts "20040703_bad_window_path odb_master observer_database==[::expr {[[odb_master] observer_database] eq ""?{}:[[[odb_master] observer_database] odb_path]}]"; ::set Owner [[[[odb_master] ".owner.parent"] odb_get] odb_master]; ::puts "20040703_bad_window_path owner==[$Owner odb_path]"; #[[odb_master] screen] putsMarkerToListFile; /* { right - idiot, if you can't fix it, kill it... ::if {[$Owner odb_is_a [[odb_database] "/OBJECT/SYSTEM/WINDOW/EXPLORER"]]} { $Owner destroy; } else { [odb_master] destroy; } */} ::qw::stack_dump; ::qw::bug "271820050212162844" "Fatal Error: Window [odb_path] attempted to access a peer that doesn't exist."; ::return ""; } #// #// experiment to see what kind of drag this function causes (since it's called a lot!) #// #//::qw::assert {[::winfo exists $_tkPath]=="1"} #(rwb_linux /* { ::if {[::winfo exists $_tkPath]=="0"} { ::puts "Fatal Error: Widget _tkPath==$_tkPath being accessed but the tk peer has disappeared."; ::qw::stack_dump; ::qw::bug "271820050208112452" "Fatal Error: Widget _tkPath==$_tkPath being accessed but the tk peer has disappeared."; } */} ::if {[::winfo exists $_tkPath]=="0"} { ::puts "Fatal Error: Widget _tkPath==$_tkPath being accessed but the tk peer has disappeared."; ::if {$::qw::control(skip_linux_problems)} { ::set _tkName ""; return ""; } ::qw::stack_dump; ::qw::bug "271820050208112452" "Fatal Error: Widget _tkPath==$_tkPath being accessed but the tk peer has disappeared."; } #) #// ::return $_tkPath; } public method tkClass {} { #//pgq??? this method seems out of place (historic?) ::if {$_tkClass ne ""} {::return $_tkClass;} #//puts_pgq {"and WIDGET tkClass, not set"}; ::if {[[[odb_master] ".clipper.parent"] odb_get] ne ""} { ::if {[[[[[odb_master] ".clipper.parent"] odb_get] odb_master] isScreen]=="1"} {::return "Toplevel";} } ::return "Frame"; } public method swizzled_configure_list {} { #// #// We swizzle for the -command, -xscrollcommand style -options #// ::set List [configureList]; ::regsub -all %this $List $this List; #// swizzle #// #nv2.28.0 (debug) /* { ::if {[odb_path] eq "/OBJECT/SYSTEM/WINDOW/SCROLLED/HTML/1414796352_462.client"} { ::foreach {O V} $List { #//::puts "pgq,debug...swizzled_configure_list return List option==$O value==$V"; } ::qw::stack_dump; ;#//pgq,debug } */} #//::foreach {O V} $List {#//::puts "pgq,debug229...swizzled_configure_list return List option==$O value==$V";} #// ::return $List; } public method tk_configure {args} { ;#// configure is an itcl keyword! #// #//::puts "pgq,debug...tk_configure enter for [odb_path] _tkName==$_tkName _tkPath==$_tkPath _tkClass==$_tkClass args==$args"; /* { ::set BugPath "/OBJECT/SYSTEM/WINDOW/LABEL/1462227250_535.client"; ::if {[odb_path] eq $BugPath} { #//::puts "pgq,debug229...tk_configure enter for [odb_path] _tkClass==$_tkClass args==$args"; } #::qw::stack_dump; */} #// switch -- [::llength $args] { 0 { #// We intrepret tk_configure with no args as sledge hammer the widget #// #if {$_tkName!=""} {::eval [tkPath] configure [configureList];} ;#// reconfigure, we got a signal from base ::if {$_tkName ne ""} { ::qw::try { #//::foreach {Option Value} [swizzled_configure_list] {#//::puts "pgq,debug229...tk_configure BEFORE [odb_path] configure Option==$Option Value==\"$Value\"";} #//::puts "pgq,debug...tk_configure calling tkPath configure BEFORE [odb_path]"; ::eval [tkPath] configure [swizzled_configure_list]; ;#// reconfigure, we got a signal from base #//::puts "pgq,debug...tk_configure calling tkPath configure AFTER [odb_path]"; } catch Exception { #//::puts "pgq,debug229...tk_configure exception [odb_path] Exception==$Exception"; #::qw::stack_dump; ;#//pgq,debug229 ::qw::throw $Exception; } } #// #//pgq??? is this right, why are we signalling, and why unconditionally? #// NOTICE the widget is just a "nop" placeholder (once the options #// where pushed down into an options field - which we fractal, #// and we don' want to fractal widgets, creating multiple copies, #// each with different options, yada yada) #// #//rwb??? #//pgq??? and what about the individual options, are they signalling, or what the fuck is going on #// #//::puts "pgq,debug...tk_configure BEFORE odb_signal_send [odb_path]"; #$this cpp_signal_send -command odb_change_after; ;#//pgq??? odb_signal_send ".command odb_change_after"; ;#//pgq??? #//::puts "pgq,debug...tk_configure AFTER odb_signal_send [odb_path]"; #// #//::puts "pgq,debug...tk_configure ::return"; ::return $this; } 1 { ::return [[tkPath] cget $args]; } } #//::qw::assert {![::llength $args]==2} ::eval [tkPath] configure $args; ::return $this; } public method tk_info {Property} { ;#// info is an itcl keyword! #//::puts "tk_info enter for [odb_path] odb_master tk_initialized==[[odb_master] tk_initialized] _tkPath==$_tkPath"; ::return [::winfo $Property [tkPath]]; } /* { I tryed playing around with this to see if I could fugure out how substitutions are performed for event sequences. Apparently, the substitutions are valid for the last event in the sequence but garbage for the others... for the simple example below, the first definition of the VirtualEvent produces a button number of 90 (i.e. the z key) and the second version produces garbage ("??") in the key substitutions. #// bind . {puts_pgq {"T=%T #=%# E=%E W=%W s=%s S=%S t=%t x=%x y=%y b=%b"}} bind . {puts_pgq {"T=%T #=%# E=%E W=%W s=%s S=%S t=%t x=%x y=%y k=%k A=%A K=%K N=%N"}} event add <> event add <> bind . <> { puts_pgq {"T=%T #=%# E=%E W=%W s=%s S=%S t=%t x=%x y=%y b=%b"}; puts_pgq {"T=%T #=%# E=%E W=%W s=%s S=%S t=%t x=%x y=%y k=%k A=%A K=%K N=%N"}; } */} /* { public method tagList {} { #// #// pgq??? CHECK if we should be going up the super like odb_get #// I want to cause some bindings to occur for all widgets, (like when #// we click anywhere on the window and we get focus) so... #//if {[odb_base]==""} {return [pathAsTag];} if {[odb_base]==""} {return [::list "::QW_GUI_LIB" [pathAsTag]];} #// #//return [[odb_base] tagList][pathAsTag]; #//return "[[odb_base] tagList] [pathAsTag]"; #// #//puts_pgq {"taglist chain==[::concat [chain] [pathAsTag]]"}; #//puts_pgq {"taglist==[::concat [[odb_base] tagList] [pathAsTag]]"}; #// return [::concat [[odb_base] tagList] [pathAsTag]]; } */} public method tagList {} { #// pgq??? CHECK if we should be going up the super like odb_get #// I want to cause some bindings to occur for all widgets, (like when #// we click anywhere on the window and we get focus) so... #// #//puts_pgq {"tagList and this class==[$this info class], heritage==[$this info heritage]"}; #// ::if {[odb_base] eq ""} { ::if {[$this info inherit] ne ""} { ::return [$this info heritage]; } ::return [$this info class]; } ::return [::concat [[odb_base] tagList] [pathAsTag]]; } public method pathAsTag {} { #// this replaces all dots with underscores, and the / character doesn't seem to bother tk #//puts_pgq {"pathAsTag==[::string map {. _} [odb_path]]"}; #nv2.28.4 (bind) - NO CHANGE - we could prepend _qw or _qw_gui or... ::return [::string map {. _} [tkPath]]; # YIKES, not with many databases open in the same process space (i.e. one tk, many path collisions are possible) ::return [::string map {. _} [odb_path]]; } public method tag {} { #// #// The poo version of the gui did this: Created a tag for each widget class in the symbol table #// and did all the bindings for each node in a ripple down manner (by calling base and replicating #// (defining) the full set of bindings). Only the symbol table nodes were tagged and they #// received all messages, which they dispatched to the correct instance by searching the collection #// of instances for the widget with the same tkPath as the %W substitution (i.e. the target #// widget). #// The odb/c version will do this: Create a tag for each node in the heritage hierarchy and tag #// each peer with the full list of tags from where we are to the root of the heritage hierarchy. #// #//puts_pgq {"tagList==[tagList]"}; #// #//::bindtags [tkPath] [tagList]; #// # NOTICE #// With the host menu system, we need the tag "all"... # BUT #// It wreaks havoc with the tab from window to window functionality, and tab #// right across the table cells, and who knows what else. We definitely have #// a problem if we are going to offer host menus! #// #debugging (i.e. winexplo can display the peer path name easily) #::bindtags [tkPath] [pathAsTag]; #// #20040212_host_menus #20040912_01_host_menu #::bindtags [tkPath] "[pathAsTag] [odb_path]"; ;// works across the boards for NV2, BUT no host menu system. #nv2.28.4 (bind) - #//NO CHANGE - just experimenting ::bindtags [tkPath] "[pathAsTag] [odb_path] all"; #::bindtags [tkPath] "[pathAsTag] [odb_path] [odb_master] all"; #::bindtags [tkPath] "[pathAsTag] [odb_path] [odb_master] [[[odb_master] odb_database application] cpp_id] all"; #::bindtags [tkPath] "[pathAsTag] [odb_path] Menubutton"; ;#// unknown option .state #// ::if {[tkClass] eq "Toplevel"} { #//::puts "pgq,debug501::QW::GUI::WIDGET::tag tkClass==Toplevel for widget odb_path==[odb_path]"; #//::wm protocol [tkPath] "WM_DELETE_WINDOW [::list $this destroyRequest [tkPath]]"; #//pgq?? direct to the window? ::wm protocol [tkPath] WM_DELETE_WINDOW [::list [odb_master] destroy]; } ::return $this; } public method bind {} { #//pgq?? too many notes #//::puts "::QW::GUI::WIDGET::bind enter for widget path==[path]"; setBindings; #//::eval [[$this ".bindings"] odb_get]; ::return $this; } public method bind_qw {args} { # NOT CALLED ::set Script [::lindex $args 2]; ::set NewCode {::if {[::qw_gui_event_processing_is_enabled %_odb_master]} {%_script}}; #//::puts "pgq,debug...gui.qw_tcl bind_qw BEFORE NewCode==$NewCode"; #::set NewCode "::if {1} {[::lindex $args 2]}"; ::set NewCode [::string map [::list %_odb_master [odb_master] %_script $Script] $NewCode]; #//::puts "pgq,debug...gui.qw_tcl bind_qw AFTER NewCode==$NewCode"; ::return [::eval ::bind [::list [::lindex $args 0] [::lindex $args 1] $NewCode]]; } public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// #//chain; #// #//::bind QW_GUI_WIDGET [::itcl::code $this] buttonPress [::QW::GUI::EVENT::MOUSE::BUTTON::mask]; #//::set Options(-xscrollcommand) [::itcl::code [[$Master ".client"] cpp_tcl_instance] scrollbarSetH]; #// #//puts_pgq {"::QW::GUI::WIDGET::setBindings, this info class==[$this info class]"}; #// #//::bind [pathAsTag] [::itcl::code [[odb_master] cpp_tcl_instance]] focusIn; #//::puts "20030920 setBindings called for tkClass==[tkClass] odb_path==[odb_path]"; #::bind [pathAsTag] [::itcl::code $this] buttonPress [::QW::GUI::EVENT::MOUSE::BUTTON::mask]; ;#// commented out long before 2.28.4 experiment #nv2.28.4 (bind) - server hub/node #//NO CHANGE - just experimenting ::bind [pathAsTag] [::subst {$this idler_backoff;$this buttonPress {[::QW::GUI::EVENT::MOUSE::BUTTON::mask]};}]; #bind_qw [pathAsTag] [::subst {$this idler_backoff;$this buttonPress {[::QW::GUI::EVENT::MOUSE::BUTTON::mask]};}]; /* { ::set Mask [::QW::GUI::EVENT::MOUSE::BUTTON::mask]; ::bind [pathAsTag] [::subst -nocommands { ::puts "pgq,debug...::bind all ::winfo exists .progress_window==[::winfo exists .progress_window]"; ::puts "pgq,debug...::bind all ::qw_gui_global_progress_window==[::expr {![::info exists ::qw_gui_global_progress_window]?{}:\$::qw_gui_global_progress_window}]"; ::puts "pgq,debug...::bind all _structures==[::expr {![::info exists ::qw_gui_global_progress_window]?{}:\n[::sargs::format .structure [\$::qw_gui_global_progress_window structures]]}]"; ::puts "pgq,debug...::bind all _structures==[::expr {![::info exists ::qw_gui_global_progress_window]?{}:\n[::sargs::format .structure [\$::qw_gui_global_progress_window structures]]}]"; ::if {[::info exists ::qw_gui_global_progress_window]} { ::puts "pgq,debug...Paths==[::sargs::select_value [::sargs .structure [\$::qw_gui_global_progress_window structures] .value [[[$this odb_master] odb_database application] cpp_id]]]"; } ::puts "pgq,debug...::bind all odb_master==[::expr {[$this odb_master] eq ""?{}:[[$this odb_master] odb_path]}]"; ::puts "pgq,debug...::bind all odb_database application==[[$this odb_master] odb_database application]"; ::puts "pgq,debug...::bind all odb_database application==[[[$this odb_master] odb_database application] cpp_id]"; ::if {![::info exists ::qw_gui_global_progress_window] \ ||[::sargs::select_value [::sargs .structure [\$::qw_gui_global_progress_window structures] .value [[[$this odb_master] odb_database application] cpp_id]]] eq "" \ } { ::puts "pgq,debug...::bind all event PROCESS"; $this idler_backoff; $this buttonPress {$Mask}; } else { ::puts "pgq,debug...::bind all event IGNORE"; } }]; */} #// #20030901 #::bind [pathAsTag] [::itcl::code $this] enter [::QW::GUI::EVENT::MOUSE::CROSSING::mask]; #// #nv2.23.0 (new feature) - goto any account from anywhere #//::bind [pathAsTag] [::itcl::code [odb_master]] slash_go_item_from_anywhere [::QW::GUI::EVENT::KEYBOARD::mask]; #//::puts "pgq,debug::QW::GUI::WIDGET bind for odb_path==[odb_path]"; #::bind [pathAsTag] [::itcl::code [odb_master]] slash_go_item_from_anywhere [::QW::GUI::EVENT::KEYBOARD::mask]; ::bind [pathAsTag] [::list [odb_master] slash_go_item_from_anywhere [::QW::GUI::EVENT::KEYBOARD::mask]]; #//::bind [pathAsTag] [::list [odb_master] control_slash_go_item_from_anywhere [::QW::GUI::EVENT::KEYBOARD::mask]]; #20030919 ::bind [pathAsTag] [::itcl::code [odb_master] restore [::QW::GUI::EVENT::KEYBOARD::mask]]; ::bind [pathAsTag] [::itcl::code [odb_master] maximize [::QW::GUI::EVENT::KEYBOARD::mask]]; #// #20040912_01_host_menu ::bind all {} ::bind all {} #// ::return $this; } #20030901 #public method enter {args} { # [[odb_database] "/OBJECT/SYSTEM/GUI"] window_enter_event $this; #} #public method leave {args} { #} public method buttonPress {{s_args ""}} { #//::QW::GUI::WIDGET /* { too many (11) overrides and still a million other events and keystrokes, and host menu commands... ::if {$::qw::control(window_default_setup)} { ::return $this; } */} #nv2.29.0 (bug fix) - experiment #//::puts "pgq,debug229::QW::GUI::WIDGET::buttonPress, [odb_path] ::qw::control(gui_host_toplevel_dialog_is_active)==$::qw::control(gui_host_toplevel_dialog_is_active)"; ::if {$::qw::control(gui_host_toplevel_dialog_is_active)} { ::return $this; } #20060421_build_change (::qw::call_after_idle ::qw::after $this slash_document_jump_to_desktop;) #::qw::after cancel $::qw_gui_idle_id_slash_document_jump_to_desktop; #// #//::puts "pgq,debug::QW::GUI::WIDGET::buttonPress, [odb_path] s_args==(\n[::sargs::format .structure $s_args]\n)"; #//::puts "pgq,debug20303::QW::GUI::WIDGET::buttonPress, [odb_path] s_args==$s_args"; #//::puts "pgq,debug::QW::GUI::WIDGET::buttonPress, [odb_path] .buttonNumber==[::sargs::get $s_args .buttonNumber]"; #::qw::stack_dump; ;#//pgq,debug #[odb_master] putsMarkerToListFile; ;#//pgq,debug2303 #//::puts "pgq,debug659::QW::GUI::WIDGET::buttonPress, [odb_path] odb_master .settings==[[[odb_master] .settings] odb_get]"; #//::puts "pgq,debug659::QW::GUI::WIDGET::buttonPress, [odb_path] dressing .settings==[[[odb_master] .frame.dressing.settings] odb_get]"; #20040723_suck_shit_with_a_garden_hose (no pulldown window list button after window default setup - not receiving signal from whateverKids) #::update; #// #20031226 #[odb_master] focusIn; ::if {![::sargs::exists $s_args ".refuse_focus"] \ ||[::sargs::get $s_args ".refuse_focus"]==0 \ } { #//::puts "pgq,debug_code_demoxxx223.0_no_peer::QW::GUI::WIDGET::buttonPress, ----------------------------------- calling focusIn for [[odb_master] odb_path]"; #nv2.23.0 (bug fix) - _no_peer #::set ::qw::control(dump_method_calls) 1; # NOTICE #// For auto_commit we want a view of the world where windows have focus, not widgets #// #//::puts "pgq,debug223.0_no_peer...::QW::GUI::WIDGET::buttonPress, BEFORE ::qw_gui_global_focus_window==$::qw_gui_global_focus_window"; #//::puts "pgq,debug223.0_no_peer...::QW::GUI::WIDGET::buttonPress, path==[path]"; [odb_master] window_with_focus_auto_commit; ::if {[path] eq ""} { ::return; } #//::puts "pgq,debug223.0_no_peer...::QW::GUI::WIDGET::buttonPress, AFTER ::qw_gui_global_focus_window==$::qw_gui_global_focus_window"; #//::puts "pgq,debug223.0_no_peer...::QW::GUI::WIDGET::buttonPress, path==[path]"; #// [odb_master] focusIn $s_args; } ::if {[::sargs::get $s_args .buttonNumber]==3} { #toplevel experiment #::set Position [::QW::GUI::POINT::+ [positionInScreen] ".x [::sargs::get $s_args .x] .y [::sargs::get $s_args .y]"]; /* { ::puts "\n::QW::GUI::WIDGET::buttonPress, Event(-x)==[::sargs::get $s_args .x] Event(-y)==[::sargs::get $s_args .y]"; ::puts "\n::QW::GUI::WIDGET::buttonPress, Event(-xRoot)==[::sargs::get $s_args .xRoot] Event(-yRoot)==[::sargs::get $s_args .yRoot]"; ::puts "::QW::GUI::WIDGET::buttonPress, positionInScreen==[positionInScreen]"; ::puts "::QW::GUI::WIDGET::buttonPress, positionInClipper==[positionInClipper]"; ::puts "::QW::GUI::WIDGET::buttonPress, odb_master tk_toplevel positionInScreen==[[[[odb_master] tk_toplevel] .frame] positionInScreen]"; ::puts "::QW::GUI::WIDGET::buttonPress, odb_master tk_toplevel positionInClipper==[[[[odb_master] tk_toplevel] .frame] positionInClipper]"; ::puts "::QW::GUI::WIDGET::buttonPress, odb_master nv_toplevel positionInScreen==[[[[odb_master] nv_toplevel] .frame] positionInScreen]"; ::puts "::QW::GUI::WIDGET::buttonPress, odb_master nv_toplevel positionInClipper==[[[[odb_master] nv_toplevel] .frame] positionInClipper]\n"; #::set Position [::QW::GUI::POINT::+ [positionInClipper] ".x [::sargs::get $s_args .x] .y [::sargs::get $s_args .y]"]; */} #::set Position [::QW::GUI::POINT::- [positionInScreen] [[[[odb_master] tk_toplevel] .frame] positionInScreen]]; #::set Position [::QW::GUI::POINT::+ $Position ".x [::sargs::get $s_args .x] .y [::sargs::get $s_args .y]"]; #OR simply (trusting -xRoot and -yRoot (i.e. screen coordinates for MS Windows) will always be supported and work properly) #nv2.12.0 #::set Position [::QW::GUI::POINT::- ".x [::sargs::get $s_args .xRoot] .y [::sargs::get $s_args .yRoot]" [[[[odb_master] tk_toplevel] .frame] positionInScreen]]; ::set Position [::QW::GUI::POINT::- ".x [::sargs::get $s_args .xRoot] .y [::sargs::get $s_args .yRoot]" [[[[odb_master] tk_toplevel] .client] positionInScreen]]; ::eval [odb_master] menuPost "{$Position}"; } ::return $this; } public method focusIn {{s_args ""}} { #20060421_build_change (::qw::call_after_idle ::qw::after $this slash_document_jump_to_desktop;) #::qw::after cancel $::qw_gui_idle_id_slash_document_jump_to_desktop; #// #20040704_type_ahead #//::puts "pgq,debug223.0_no_peer::QW::GUI::WIDGET focusIn 20050310 giving peer focus to [odb_path] path==[path]"; #nv2.22.0 (bug fix) - work in progress... #::if {[path] eq ""} { #//::puts "pgq,debug222.0_no_peer::QW::GUI::WIDGET focusIn avoiding bugs return"; #::qw::stack_dump; ;#//pgq,debug #::return $this; #} #//::puts "pgq,debug229::QW::GUI::WIDGET focusIn 20050310 giving peer focus to [odb_path] path==[path]"; #::qw::stack_dump; ;#//pgq,debug ::focus [tkPath]; #// # NOTICE #// To kill tk focus issues after long-duration operations ::set ::qw_gui_global_focus_window [tkPath]; #nv2.28.4 (bind) - server hub/node #//NOT USED - just experimenting #//::puts "pgq,debug501::QW::GUI::WIDGET focusIn setting ::qw_gui_global_focus_window_object=[[odb_master] odb_path]"; #::set ::qw_gui_global_focus_window_object [odb_master]; #// #::focus -force [tkPath]; ;#// no difference to pick totalto account type_ahead #// #//::puts "ff:D--.In() we just focused [odb_path] peer:[tkPath]"; #// # NOTICE #// This reintroduced the noisey window create (in the case of column define select format) #// AND it had no effect on the type_ahead problem #::update; #// #//P366 #//::puts "P366 peer focus, tk thinks focus -displayof window . = [::focus -displayof .]"; #// ::return $this; } public method configureList {} { #//puts_pgq {"peer configureList about to return this .options.widget odb_get==[[$this .options.widget] odb_get]"}; #//::puts "pgq,debug2330 peer configureList enter [odb_path]"; /* { #//::puts "pgq,debug odb_master focusPath==[[odb_master] focusPath]"; ::puts "pgq,debug peer configureList .options.widget odb_get==[[$this .options.widget] odb_get]"; ::foreach Whatever [::array names [[$this .options.widget] odb_get]] {::puts "configureList option Name==$Whatever Value==$ConfigureList($Whatever)";} ::puts "pgq,debug peer options=="; ::foreach Whatever [::array names [[$this .options.widget] odb_get]] {::puts "configureList option Name==$Whatever Value==$ConfigureList($Whatever)";} ::puts "pgq,debug peer option/focusPath=="; ::foreach Whatever [::array names [[$this .options/focusPath.widget] odb_get]] {::puts "configureList option Name==$Whatever Value==$ConfigureList($Whatever)";} */} /* { #::set BugPath "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/1206707965_12239.frame.dressing.title"; ::if {[::string first $BugPath [odb_path]]==0} { ::puts "pgq,debug peer configureList about to call return... this options.widget odb_get"; } */} ::return [[$this ".options.widget"] odb_get]; } public method configureList_puts {} { ::array set ConfigureList [configureList]; ::foreach Whatever [::array names ConfigureList] {puts_pgq {"configureList option Name==$Whatever Value==$ConfigureList($Whatever)"};} ::return $this; } #public method published_configureList {} { # return [[$this ".options.widget"] odb_get]; #} # # NOTICE all distances are now pixels. # public method rectangleRequestInClipper {} {::return ".position {[positionInClipper]} .size {[sizeRequest]}";} #// Yes! This is the screen, at least in an MSWindows world, see positionInVirtualRoot public method rectangleRequestInScreen {} {::return ".position {[positionInScreen]} .size {[sizeRequest]}";} public method rectangleActualInClipper {} {::return ".position {[positionInClipper]} .size {[sizeActual]}";} public method rectangleActualInScreen {} {::return ".position {[positionInScreen]} .size {[sizeActual]}";} #// # NOTICE some difficulties with null positions, but positionInClipper includes border and we get stuff like .x 2 .y 2 #public method rectangleRequest {} {::return ".position {.x {} .y {}} .size {[sizeRequest]}";} #public method rectangleActual {} {::return ".position {.x {} .y {}} .size {[sizeActual]}";} public method rectangleRequest {} {::return ".position {.x 0 .y 0} .size {[sizeRequest]}";} public method rectangleActual {} {::return ".position {.x 0 .y 0} .size {[sizeActual]}";} # public method positionInClipper {} {::return ".x [tk_info x] .y [tk_info y]";} ;#//pgq?? do I have to ::update idletasks to be sure public method positionInScreen {} {::return ".x [tk_info rootx] .y [tk_info rooty]";} public method sizeRequest {} {::return ".x [widthRequest] .y [heightRequest]";} public method sizeActual {} {::return ".x [widthActual] .y [heightActual]";} public method widthRequest {} {::return [tk_info reqwidth];} public method heightRequest {} {::return [tk_info reqheight];} public method widthActual {} {::return [tk_info width];} public method heightActual {} {::return [tk_info height];} #// #// ------------------------------------------------------------ #// I removed configured sizes from widgets. They are what they are. #// BUT the root frame... whose size is controlled interactively and can be set. #// BUT the scrollbar deadspot... whose size tracks the scrollbar height and width. # # NOTICE all distances are now pixels. # public method rectangle {args} { ::switch -- [::llength $args] { 0 { ::return ".position {.x {} .y {}} .size {.x [widthConfigure] .y [heightConfigure]}"; } 1 { #//::puts "pgq,debug_86foff...WIDGET rectangle enter [odb_path] args==$args"; #::qw::stack_dump; ;#//pgq,debug_86foff #//::puts "pgq,debug659...widget rectangle args==$args odb_path==[odb_path]"; #::if {[::string first "/SCROLLED/FORM/PROCEDURE/TABLE_PRINT" [odb_path]]>=0} { #::qw::stack_dump; ;#//pgq,debug #} #//puts_pgq {"widget rectangle lindex args 0==[::lindex $args 0]"}; #//widthConfigure [::sargs::get $args .size.x]; #//heightConfigure [::sargs::get $args .size.y]; widthConfigure [::sargs::get [::lindex $args 0] .size.x]; heightConfigure [::sargs::get [::lindex $args 0] .size.y]; ::return $this; } } ::qw::bug "271820050208112652" "[odb_path], ::QW::GUI::WIDGET::rectangle didn't recognize args==$args"; } public method widthConfigure {args} { ::switch -- [::llength $args] { 0 {::return [tk_configure -width];} 1 {::return [tk_configure -width $args];} } ::puts "Fatal Error: widthConfigure didn't recognize args==$args"; ::qw::stack_dump; ::qw::bug "271820050208112724" "Fatal Error: widthConfigure didn't recognize args==$args"; } public method heightConfigure {args} { ::switch -- [::llength $args] { 0 {::return [tk_configure -height];} 1 {::return [tk_configure -height $args];} } ::puts "Fatal Error: heightConfigure didn't recognize args==$args"; ::qw::stack_dump; ::qw::bug "271820050208112758" "Fatal Error: heightConfigure didn't recognize args==$args"; } /* { */} public method signalStretch {Point} { #// #//puts_pgq {"::QW::GUI::WIDGET signalStretch, Point==$Point"}; #// ::return $this; } public proc defaultOptionsList {} { #//::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ;#// derived class will do this ::append Result " -relief flat"; ::append Result " -highlightbackground gray51"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 0"; ::append Result " -cursor arrow"; #::qw::control(tommy_form) #_pgq,debug230 - what is the global remification of this? - do we need to convert existing windows? #::append Result " -background gray91"; ::append Result " -background white"; #//pgq?? #// -screen ?? -use -menu (and everything from frame: -class -container -colormodel -colormap) #// ::return $Result; } public method idler_backoff {} { [::qw::system] cpp_idler_backoff; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_SCREEN class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_SCREEN { inherit ::QW::GUI::WIDGET; #// #// We have to replace four methods... #// BUT the question remains, is there any reason to allow user to change #// configured rectangle? I'll be back. #// public method widthActual {} {::return [tk_info "screenwidth"];} public method heightActual {} {::return [tk_info "screenheight"];} public method widthRequest {} {::return [widthActual];} public method heightRequest {} {::return [heightActual];} #// public method pixelsPerPoint {args} { switch -- [::llength $args] { 0 { ::return [::tk scaling]; } 1 { ::tk scaling [::lindex $args 0]; ::return $this; } } ::qw::bug 271820050208113010 "::QW::GUI::WIDGET_SCREEN::pixelsPerPoint method called with [::llength $args] arguments. Zero arguments will get tk scaling and one argument will set tk scaling."; } public method colorModel {} {::return [tk_info "screenvisual"];} public method colorMapItems {} {::return [tk_info "screencells"];} public method bitsPerPixel {} {::return [tk_info "screendepth"];} #// #// Screen peer's tk identification string (e.g. :0.0 meaning :display.screen) public method hostHandle {} {::return [tk_info "screen"];} #// #//pgq? I have no idea what the next comment means... #// The next two methods can't call tk_info because it returns a .STRING and we need TCL lists public method colorModelsAvailable {} {::return [::winfo visualsavailable [tkPath]];} public method colorModelsAvailableHostHandles {} {::return [::winfo visualsavailable [tkPath] includeids];} public proc defaultOptionsList {} { ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_LABEL class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_LABEL { inherit ::QW::GUI::WIDGET; public method tkClass {} {::return "Label";} public method createCommand {} {::return "::label";} public method setBindings {} { #// #//puts_pgq {"::QW::GUI::WIDGET_LABEL::setBindings"}; #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// chain; #// ::return $this; } #// #// The label is one of those widget classes where we have to translate distances #// to something else - this time character units (e.g. 1 inch becomes 6 lines). #// BUT this is only true if the widget is displaying text. For images we can #// let base do it. #// /* { public method heightConfigure { if {[[odb_outer] ".image"]!=""} {::return [chain];} ::return [[odb_outer] heightConfigure]; } public method widthConfigure { if {[[odb_outer] ".image"]!=""} {::return [chain];} ::return [[odb_outer] widthConfigure]; } public method heightConfigure {args} { if {[[odb_outer] ".image"]!=""} {::return [chain];} [[odb_outer] heightConfigure $args]; ::return $this; } public method widthConfigure {args} { if {[[odb_outer] ".image"]!=""} {::return [chain];} [[odb_outer] widthConfigure $args]; ::return $this; } */} public proc defaultOptionsList {} { #//::puts "pgq,debug223.0::QW::GUI::WIDGET_LABEL defaultOptionsList enter for [odb_path]"; #// frame options #//::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background gray51"; #// label options ::append Result " -anchor w"; ::append Result " -padx 0"; ::append Result " -pady 0"; ::append Result " -background SystemButtonFace"; ::append Result " -text {}"; ::append Result " -foreground SystemButtonText"; ::append Result " -font {}"; #//::append Result " -height 0"; #//::append Result " -width 0"; ::append Result " -underline -1"; ::append Result " -wraplength 0"; ::append Result " -justify center"; ::append Result " -image {}"; ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_LABEL_BUTTON class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_LABEL_BUTTON { inherit ::QW::GUI::WIDGET_LABEL; # protected variable _mouseInside 0; protected variable _saveRelief ""; protected variable _reliefHasBeenSaved 0; protected variable _saveState ""; # public method setBindings {} { #// #//::puts "::QW::GUI::WIDGET_LABEL_BUTTON::setBindings"; #// ::bind [pathAsTag] [::itcl::code $this buttonRelease [::QW::GUI::EVENT::MOUSE::BUTTON::mask]]; ::bind [pathAsTag] [::itcl::code $this enter [::QW::GUI::EVENT::MOUSE::CROSSING::mask]]; ::bind [pathAsTag] [::itcl::code $this leave [::QW::GUI::EVENT::MOUSE::CROSSING::mask]]; ::bind [pathAsTag] [::itcl::code $this keyPress [::QW::GUI::EVENT::KEYBOARD::mask]]; chain; ;#// we will pick up the base's bindings by applying it's tag ::return $this; } public method enter {s_args} { #//::puts "pgq,debug223.0::QW::GUI::WIDGET_LABEL_BUTTON enter s_args==$s_args"; # #// derived button classes will provide buttonPress, enter and keyPress functionality # #//chain $s_args; ::return $this; } public method keyPress {s_args} { #rwb #// chain $s_args; ::return $this; } public method buttonRelease {s_args} { #//::puts "pgq,debug::QW::GUI::WIDGET_LABEL_BUTTON buttonRelease s_args==$s_args"; #//chain $s_args; ::if {[::sargs::get $s_args .buttonNumber]!=1} {::return $this;} ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; ::if {$Options(-state) eq "disabled"} {::return $this;} ::if {$_reliefHasBeenSaved=="0"} {::return $this;} #// ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set Options(-relief) $_saveRelief; ::set Options(-state) $_saveState; [$this ".options.widget"] odb_set [::array get Options]; #// ::set _reliefHasBeenSaved "0"; # NOTICE #tk8.4a4 bug (we don't receive enter events) #nv2.23.0 (bug fix) - try uncommenting this... ::if {$_mouseInside=="0"} {::return $this;} #//::puts "pgq,debug223.0::QW::GUI::WIDGET_LABEL_BUTTON buttonRelease _mouseInside==$_mouseInside"; commandInvoke; ::return $this; } public method leave {s_args} { #//::puts "pgq,debug223.0::QW::GUI::WIDGET_LABEL_BUTTON leave s_args==$s_args"; #//chain $s_args; ::set _mouseInside "0"; ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} {::return $this;} if {$_reliefHasBeenSaved=="0"} {::return $this;} #// ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set Options(-relief) $_saveRelief; ::set Options(-state) $_saveState; [$this ".options.widget"] odb_set [::array get Options]; #// ::return $this; } public method commandInvoke {} { #nv2.23.0 (bug fix) - _no_peer [odb_master] window_with_focus_auto_commit; ::if {[path] eq ""} { ::return; } ::return ""; } public proc defaultOptionsList {} { #// frame and label options ::set Result [::QW::GUI::WIDGET_LABEL::defaultOptionsList]; ::append Result " -relief raised"; ::append Result " -highlightbackground SystemButtonFace"; ::append Result " -highlightcolor SystemWindowFrame"; ::append Result " -borderwidth 1"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background SystemButtonFace"; #//::append Result " -default disabled"; #// label options ::append Result " -anchor center"; ::append Result " -padx 1"; ::append Result " -pady 1"; ::append Result " -background SystemButtonFace"; ::append Result " -text {}"; ::append Result " -foreground SystemButtonText"; ::append Result " -font {}"; #//::append Result " -height 0"; #//::append Result " -width 0"; ::append Result " -underline -1"; ::append Result " -wraplength 0"; ::append Result " -justify center"; ::append Result " -image {}"; #// button options #//::append Result " -command {}"; #//::append Result " -textvariable {}"; ::append Result " -state normal"; ::append Result " -activebackground SystemButtonFace"; ::append Result " -activeforeground SystemButtonText"; #_pgq,debug2323 (bug fix) - tcl86 exposed this? # ::append Result " -disabledforeground SystemDisabledText"; ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_LABEL_BUTTON_PUSH class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_LABEL_BUTTON_PUSH { inherit ::QW::GUI::WIDGET_LABEL_BUTTON; public method tkClass {} {::return "Button";} #::qw::control(tommy_form) public method createCommand {} {::return "::button";} # public method createCommand {} {::return "::tk::button";} public method setBindings {} { #// #//puts_pgq {"::QW::GUI::WIDGET_LABEL_BUTTON_PUSH::setBindings"}; #// #//pushbuttons add no new bindings #// chain; ;#// we will pick up the base's bindings by applying it's tag ::return $this; } public method buttonPress {s_args} { #//::puts "pgq,debug_code_demoxxx::QW::GUI::WIDGET_LABEL_BUTTON_PUSH::buttonPress, [odb_path] s_args==$s_args"; #_pgq,debug229 - we chain twice - beginning and end - ??? - working for years chain $s_args; #nv2.23.0 (bug fix) - _no_peer ::if {[path] eq ""} { ::return; } ::if {[::sargs::get $s_args .buttonNumber]!=1} { #//chain $s_args; ::return $this; } ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; ::if {$Options(-state) eq "disabled"} { #//chain $s_args; ::return $this; } ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set _saveRelief $Options(-relief); ;#// since we have to reset it even if it was null ::set _saveState $Options(-state); ;#// since we have to reset it even if it was null ::set _reliefHasBeenSaved "1"; ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; chain $s_args; ::return $this; } public method enter {{s_args ""}} { #//::puts "pgq,debug::QW::GUI::WIDGET_LABEL_BUTTON_PUSH enter s_args==$s_args"; ::set _mouseInside "1"; ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; #//puts_pgq {"enter Options==[::array get Options]"}; ::if {$Options(-state)=="disabled"} {::return $this;} ::if {$_reliefHasBeenSaved=="0"} {::return $this;} ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; #//::eval chain $args; ::return $this; } #// #// Ya gotta wonder why we give a push button a keyPress binding, when we plan #// to allow only window clients to have focus... The plan is to have all buttons #// like the traditional Ok, Apply or Cancel of a dialog box BE window clients. #// public method keyPress {{s_args ""}} { ::if {[::sargs::get $s_args .keySymbolString] ne "space"} {::return $this;} ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; ::if {$Options(-state)=="disabled"} {::return $this;} ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set _saveRelief $Options(-relief); ;#// since we have to reset it even if it was null ::set _saveState $Options(-state); ;#// since we have to reset it even if it was null ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; ::update idletasks; ::after 100; ;#// the button will wink down and up for 1/10 of a second ::set Options(-relief) $_saveRelief; ::set Options(-state) $_saveState; [$this ".options.widget"] odb_set [::array get Options]; commandInvoke; #//chain $s_args; ::return $this; } public proc defaultOptionsList {} { #// frame and label and button ::set Result [::QW::GUI::WIDGET_LABEL_BUTTON::defaultOptionsList]; ::return $Result; } } /* { #// ------------------------------------------------------------ #// ::QW::GUI::PUSHBUTTON class #//??? cut the crap and give him names that are flat and ignore the underlying #// cpoo hierarchy - and ya gotta admit underscores in the names is not a pretty sight #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::PUSHBUTTON { inherit ::QW::GUI::BUTTON; } ::qw::itcl::class ::QW::GUI::WINDOW::FRAME::DRESSING::SYSTEM { inherit ::QW::GUI::WIDGET_LABEL_BUTTON; public method commandInvoke {} { [odb_master] systemMenu; chain; ::return $this; } } */} #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_LABEL_BUTTON_CHECK class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_LABEL_BUTTON_CHECK { inherit ::QW::GUI::WIDGET_LABEL_BUTTON; protected variable _qw_uniqueId ""; protected variable _booleanValue 0; public method odb_initialize {} { chain; ::set _qw_uniqueId QW_GUI_[unique_id]; ::set ::$_qw_uniqueId 0; ;#// tcl's global variable } public method destructor {} { ::unset ::$_qw_uniqueId; } public method tkClass {} {::return "Checkbutton";} public method createCommand {} {::return "::checkbutton";} public method setBindings {} { #// #//checkbuttons add no new bindings #// chain; ;#// we will pick up the base's bindings by applying it's tag ::return $this; } public method buttonPress {s_args} { #pgq,debug229 - we chain twice - beginning and end - ??? - working for years chain $s_args; #nv2.23.0 (bug fix) - _no_peer ::if {[path] eq ""} { ::return; } #// #// pgq??? Something is wrong here... this is an EXACT duplicated of the #// BUTTON_PUSH method? Except for the "sunken" part. #// if {[::sargs::get $s_args .buttonNumber]!=1} { #//chain $s_args; ::return $this; } ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} { #//chain $s_args; ::return $this; } ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set _saveRelief $Options(-relief); ;#// since we have to reset it even if it was null ::set _saveState $Options(-state); ;#// since we have to reset it even if it was null ::set _reliefHasBeenSaved "1"; ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; chain $s_args; ::return $this; } public method enter {{s_args ""}} { #// #// pgq??? Something is wrong here... this is an EXACT duplicated of the #// BUTTON_PUSH method? Except for the "sunken" part. #// ::set _mouseInside "1"; ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} {::return $this;} if {$_reliefHasBeenSaved=="0"} {::return $this;} ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; #//::eval chain $args; ::return $this; } public method keyPress {{s_args ""}} { ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} {::return $this;} if {[::sargs::get $s_args .keySymbolString] eq "space"} {commandInvoke;::return $this;} if {[::sargs::get $s_args .keySymbolString] eq "equal"||[::sargs::get $s_args .keySymbolString] eq "plus"} {booleanValue 1;::return $this;} if {[::sargs::get $s_args .keySymbolString] eq "minus"} {booleanValue 0;::return $this;} #//::eval chain $args; ::return $this; } public method booleanValue {args} { switch -- [::llength $args] { 0 { ::return $_booleanValue; } 1 { ::set _booleanValue $args; ::if {$args==1} {[tkPath] select;} else {[tkPath] deselect;} ::return $this; } } ::qw::bug "271820050331195843" "[odb_path], booleanValue did not recognize args==$args"; } public method commandInvoke {} { if {[booleanValue]==0} {booleanValue 1;} else {booleanValue 0;} ::return $this; } public proc defaultOptionsList {} { #// frame and label and button options ::set Result [::QW::GUI::WIDGET_LABEL_BUTTON::defaultOptionsList]; #// checkbutton options #// #// I got screwed for a few hours of subtle debugging because I left this #// out... manual for -vaiable says: "Specifies name of global variable to #// set to indicate whether or not this button is selected. Defaults to #// the name of the button within its parent (i.e. the last element of the #// button windows path name)." #// ::append Result " -variable ::$_qw_uniqueId"; #// ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_LABEL_BUTTON_RADIO class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_LABEL_BUTTON_RADIO { inherit ::QW::GUI::WIDGET_LABEL_BUTTON; protected variable _dataValue ""; public method tkClass {} {::return "Radiobutton";} public method createCommand {} {::return "::radiobutton";} public method setBindings {} { #// #//checkbuttons add no new bindings #// chain; ;#// we will pick up the base's bindings by applying it's tag ::return $this; } public method buttonPress {s_args} { #pgq,debug229 - we chain twice - beginning and end - ??? - working for years chain $s_args; #nv2.23.0 (bug fix) - _no_peer ::if {[path] eq ""} { ::return; } #// #// pgq??? Something is wrong here... this is an EXACT duplicated of the #// BUTTON_PUSH method? Except for the "sunken" and "active" parts. #// if {[::sargs::get $s_args .buttonNumber]!=1} { #//::eval chain $args; ::return $this; } ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} { #//::eval chain $args; ::return $this; } ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set _saveRelief $Options(-relief); ;#// since we have to reset it even if it was null ::set _saveState $Options(-state); ;#// since we have to reset it even if it was null ::set _reliefHasBeenSaved "1"; ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; #// [tkPath] select; #// chain $s_args; ::return $this; } public method enter {{s_args ""}} { #// #// pgq??? Something is wrong here... this is an EXACT duplicated of the #// BUTTON_PUSH method? Except for the "acrive" part. #// ::set _mouseInside "1"; ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} {::return $this;} if {$_reliefHasBeenSaved=="0"} {::return $this;} ::array set Options [[$this ".options.widget"] qw_get]; ;#// NOTICE not [configureList] ::set Options(-relief) "sunken"; ::set Options(-state) "active"; [$this ".options.widget"] odb_set [::array get Options]; #//::eval chain $args; ::return $this; } public method keyPress {s_args} { #rwb ::array set Options [configureList]; ;#// NOTICE not [[$this ".options.widget"] qw_get]; if {$Options(-state)=="disabled"} {::return $this;} if {[::sargs::get $s_args .keySymbolString] eq "space"} {commandInvoke;::return $this;} if {[::sargs::get $s_args .keySymbolString] eq "equal"||[::sargs::get $s_args .keySymbolString] eq "plus"} {select 1;::return $this;} #// NOTICE, you can't turn a radiobutton off, it goes off when another goes on #//::eval chain $args; ::return $this; } public method select {args} { switch -- [::llength $args] { 0 { ::return $_booleanValue; } 1 { ::set _booleanValue $args; if {$args==1} {[tkPath] select;} else {[tkPath] deselect;} ::return $this; } } ::qw::bug "271820050331195935" "[odb_path], select did not recognize args==$args"; } public proc defaultOptionsList {} { #// frame and label and button options ::set Result [::QW::GUI::WIDGET_LABEL_BUTTON::defaultOptionsList]; #// checkbutton options #// #// I got screwed for a few hours of subtle debugging because I left this #// out... manual for -vaiable says: "Specifies name of global variable to #// set to indicate whether or not this button is selected. Defaults to #// the name of the button within its parent (i.e. the last element of the #// button windows path name)." #// #// NOTICE, this could be done in the WINDOW/RADIOBUTTON.client.item (shared by many buttons) #// or we can just assume an odb_outer... #// ::append Result " -variable {}"; #// ::append Result " -value {}"; #// ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_CANVAS class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_CANVAS { inherit ::QW::GUI::WIDGET; public method tkClass {} {::return "Canvas";} public method createCommand {} {::return "::canvas";} public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// chain; #// ::return $this; } /* { public method scrollbarSetH {args} { ::return $this; } public method scrollbarSetV {args} { ::return $this } */} #// ------------------------------------------------------------ /* { method .RECTANGLE (/&) rectangleBounding() { // // the bounding box of all the items on the canvas??? // ::return base(); // for now } method THIS& (/&) rectangleScrolled(.RECTANGLE& Src) { if (_isDestructing) ::return This; base(Src); // _rectangleScrolled.debugDump(".GUI.WIDGET/MENUED/CANVAS.rectangleScrolled "+tkPath()+", Src="); // _peer.configure("-scrollregion",Src.tclRectangle().brace()); ::return This; } */} #// ------------------------------------------------------------ public proc defaultOptionsList {} { #// #// NOTICE the -borderwidth and -highlightthickness are part of the drawable area #// area and caused several hours of grief tracking down badly behaved automatic #// scrollbars! #// #// frame options #//::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 0"; ::append Result " -cursor arrow"; #::append Result " -background gray91"; #::append Result " -background #caf8d9"; #::qw::control(tommy_form) - f8d9f8 for 10 years # ::append Result " -background #f8d9f8"; ::append Result " -background gray91"; #// #// canvas options #// apparently exportselection is always true for canvas text items, in fact, its a bad option #//::append Result " -exportselection 1"; #// #// With a "static" proc, there is no this. So we must do this each time #// we install a scolled canvas... #//::append Result " -xscrollcommand [::concat [::itcl::code $this] scrollbarSetH]";#// echo back to ourself #//::append Result " -yscrollcommand [::concat [::itcl::code $this] scrollbasSetV]"; #// ::append Result " -insertbackground black"; ::append Result " -insertborderwidth 0"; ::append Result " -insertofftime 200"; ::append Result " -insertontime 200"; ::append Result " -insertwidth 5"; ::append Result " -selectbackground orange"; ::append Result " -selectborderwidth 1"; ::append Result " -selectforeground blue"; #// ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH} -yscrollcommand {::eval \[%this odb_master\] scrollbarSetV}"; #// ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_CANVAS_TREE class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_CANVAS_TREE { inherit ::QW::GUI::WIDGET_CANVAS; } #::source "d:/tk/lib/treenode.tcl"; #// the original tree proc namespace #::source "d:/tk/lib/treenodest.tcl"; #// causes the tree to track the tree nodes in a structure #::source "d:/tk/lib/treenodestonly.tcl"; #// was going to remove the tcl parent and list of kids and run exclusively on the structure (not done), but works well #::source "d:/tk/lib/treenodestonlyo.tcl"; #// this adds the observer_database and observer_database_index #//::source "d:/tk/lib/tree_new_observers.tcl"; #// this switched over to the array of observers approach #::source [::file join $::env(pgq) lib gui tree_new_observers.tcl]; #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_CALENDAR class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_CALENDAR { inherit ::QW::GUI::WIDGET; public method tkClass {} {::return "Calendar";} public method createCommand {} {::return "::iwidgets::calendar";} public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// chain; #// ::return $this; } public proc defaultOptionsList {} { ::lappend Result -cursor arrow; ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_TABNOTEBOOK class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_TABNOTEBOOK { inherit ::QW::GUI::WIDGET; public method tkClass {} {::return "Tabnotebook";} public method createCommand {} {::return "::iwidgets::tabnotebook";} #public method createCommand {} {::return "NoteBook";} public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// chain; #// ::return $this; } /* {iwidget */} public proc defaultOptionsList {} { ::append Result " -cursor arrow"; ::append Result " -tabpos n"; ::return $Result; } /* {BWidget public proc defaultOptionsList {} { ::set Result ""; #::append Result " -cursor arrow"; ::return $Result; } */} } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_SCROLLBAR class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_SCROLLBAR { inherit ::QW::GUI::WIDGET; public method tkClass {} {::return "Scrollbar";} public method createCommand {} {::return "::scrollbar";} public method tagList {} { #// #// When tcl/tk implemented scrollbars in terms of MSWindows peers, the tag #// that follows is necessary (But I can't remember why? I'll be back.). #// ::return "[chain] Scrollbar"; } public method pathAsTag {} { #// #//puts_pgq {"pathAsTag chain==[chain]"}; #//puts_pgq {"pathAsTag==[chain] Scrollbar"}; #// ::return "[chain] Scrollbar"; } public method setBindings {} { #// #// NOTICE we now tag a window with a list of tags, one tag for each base class in the path back to the root, #// instead of one tag with all the bindings from the path back to the root. #// chain; #// ::return $this; } public method scrollbarSet {args} { #// #//#//::puts "pgq,debug::QW::GUI::WIDGET_SCROLLBAR scrollbarSet enter [odb_path] args==$args"; #// #// called by some observer widget #//::qw::try {::eval [tkPath] set $args;} catch Exception {::return $this;} ::qw::try {::eval [tkPath] set $args;} catch Exception {} ::return $this; } /* { public method scrollbarSet {args} { #// #//puts_pgq {"scrollbarSet, args==$args"}; #// #// called by some observer widget tk_eval "[tkPath] set $args"; ::return $this; } */} public method signal_scrollees {args} { #// #//::puts "pgq,debugWGB::QW::GUI::WIDGET_SCROLLBAR signal_scrollees enter [odb_path] args==$args"; #// #$this cpp_signal_send -command odb_change_after -before {} -after $args; ::sargs::var::set Signal .command odb_change_after; ::sargs::var::set Signal .before ""; ::sargs::var::set Signal .after $args; odb_signal_send $Signal; # odb_signal_send -command odb_change_after -before "" -after $args; ::return $this; } public proc defaultOptionsList {} { #// frame options ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; #// scrollbar options ::append Result " -width 18"; ;#// all persistant positions and sizes are stored in inches #// #// With a "static" proc, there is no this. So we must do this each time #// we install a scollbar... #//::append Result " -command [::concat [::itcl::code $this] signal_scrollees]"; ;#// echo back #// ::append Result " -activebackground magenta"; ;#// no effect ::append Result " -jump 0"; ;#// smoothScroll ::append Result " -repeatdelay 30"; ::append Result " -repeatinterval 30"; ::append Result " -troughcolor LimeGreen"; ;#// no effect ::append Result " -activerelief sunken"; ::append Result " -elementborderwidth 0"; #// ::append Result " -command {%this signal_scrollees}"; #// ::return $Result; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_ENTRY class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_ENTRY { inherit ::QW::GUI::WIDGET; #// protected variable _saveMouseX ""; protected variable _selectMode ""; protected variable _mouseMoved ""; protected variable _afterId ""; #// public method tkClass {} {::return "Entry";} public method createCommand {} {::return "::entry";} #// #// From WIDGET_LABEL. Is this trash, or a place-holder PGQ is coming back to? #// #// The label is one of those widget classes where we have to translate distances #// to something else - this time character units (e.g. 1 inch becomes 6 lines). #// BUT this is only true if the widget is displaying text. For images we can #// let base do it. #// /* { public method heightConfigure { if {[[odb_outer] ".image"]!=""} {::return [chain];} ::return [[odb_outer] heightConfigure]; } public method widthConfigure { if {[[odb_outer] ".image"]!=""} {::return [chain];} ::return [[odb_outer] widthConfigure]; } public method heightConfigure {args} { if {[[odb_outer] ".image"]!=""} {::return [chain];} [[odb_outer] heightConfigure $args]; ::return $this; } public method widthConfigure {args} { if {[[odb_outer] ".image"]!=""} {::return [chain];} [[odb_outer] widthConfigure $args]; ::return $this; } */} /* { #// ------------------------------------------------------------ # ::QW::GUI::WIDGET #// ------------------------------------------------------------ ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background gray51"; # #// ------------------------------------------------------------ # entry - all options #// ------------------------------------------------------------ #// #// i = inherit from ::QW::GUI::WIDGET #// i -background SystemWindow i -borderwidth 2 i -cursor xterm -exportselection 1 -font {MS Sans Serif} 8 -foreground SystemWindowText i -highlightbackground SystemButtonFace i -highlightcolor SystemWindowFrame i -highlightthickness 0 -insertbackground SystemWindowText -insertborderwidth 0 -insertofftime 300 -insertontime 600 -insertwidth 2 -invalidcommand -justify left i -relief sunken -selectbackground SystemHighlight -selectborderwidth 0 -selectforeground SystemHighlightText -show -state normal -takefocus -textvariable -validate none -validatecommand -width 20 -xscrollcommand */} public proc defaultOptionsList {} { #//::QW::GUI::WIDGET options: #//::append Result " -relief flat"; #//::append Result " -highlightbackground white"; #//::append Result " -highlightcolor black"; #//::append Result " -borderwidth 0"; #//::append Result " -highlightthickness 1"; #//::append Result " -cursor arrow"; #//::append Result " -background gray51"; ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; #// entry options ::append Result " -background SystemButtonFace"; ::append Result " -exportselection 1"; ::append Result " -foreground SystemWindowText"; ::append Result " -font {}"; ::append Result " -insertbackground SystemWindowText"; ::append Result " -insertborderwidth 0"; ::append Result " -insertofftime 300"; ::append Result " -insertontime 600"; ::append Result " -insertwidth 5"; ::append Result " -invalidcommand {}"; ::append Result " -justify left"; ::append Result " -selectbackground SystemHighlight"; ::append Result " -selectborderwidth 0"; ::append Result " -selectforeground SystemHighlightText"; ::append Result " -show {}"; ::append Result " -state normal"; ::append Result " -takefocus {}"; #//::append Result " -textvariable _textVariable"; #//::append Result " -textvariable {}"; ::append Result " -validate none"; ::append Result " -validatecommand {}"; #//::append Result " -width 0"; #// #//::append Result " -textvariable {::QW_GUI_WINDOW_ENTRY_TEXTVARIABLE_%this}"; #// a global variable (NOT, ::WHATEVER::QW::TCLINTERFACE::485858383) #//::append Result " -xscrollcommand {}"; ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH}"; #// #// ::return $Result; } /* { ::set _textVariableId "::QW_GUI_WINDOW_ENTRY_TEXTVARIABLE_[unique_id]"; #// a global variable #// [$this ".options.widget"] replace -textvariable $_textVariableId; [$this ".options/focusPath.widget"] replace -textvariable $_textVariableId; #// #// or #// [$this ".options.widget"] replace \ -textvariable $_textVariableId \ -xscrollcommand [::concat [::itcl::code [odb_master]] scrollbarSetH] \ ; [$this ".options/focusPath.widget"] replace \ -textvariable $_textVariableId \ -xscrollcommand [::concat [::itcl::code [odb_master]] scrollbarSetH] \ ; #//puts_pgq {"\$this==$this, initialize, -textVariableId==$_textVariableId"}; */} } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_TEXT class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_TEXT { inherit ::QW::GUI::WIDGET; #// public method tkClass {} {::return "Text";} public method createCommand {} {::return "::text";} /* { #// ------------------------------------------------------------ # ::QW::GUI::WIDGET #// ------------------------------------------------------------ ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background gray51"; # #// ------------------------------------------------------------ # text - all options #// ------------------------------------------------------------ #// #// i = inherit from ::QW::GUI::WIDGET #// i -background SystemWindow i -borderwidth 2 i -cursor xterm -exportselection 1 -font {MS Sans Serif} 8 -foreground SystemWindowText -height 24 i -highlightbackground SystemButtonFace i -highlightcolor SystemWindowFrame i -highlightthickness 0 -insertbackground SystemWindowText -insertborderwidth 0 -insertofftime 300 -insertontime 600 -insertwidth 2 -padx 1 -pady 1 i -relief sunken -selectbackground SystemHighlight -selectborderwidth 0 -selectforeground SystemHighlightText -setgrid 0 -spacing1 0 -spacing2 0 -spacing3 0 -state normal -tabs -takefocus -width 80 -wrap char -xscrollcommand -yscrollcommand */} public proc defaultOptionsList {} { #//::QW::GUI::WIDGET options: #//::append Result " -relief flat"; #//::append Result " -highlightbackground white"; #//::append Result " -highlightcolor black"; #//::append Result " -borderwidth 0"; #//::append Result " -highlightthickness 1"; #//::append Result " -cursor arrow"; #//::append Result " -background gray51"; ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; #// text options ::append Result " -exportselection 1"; #//::append Result " -font {{MS Sans Serif} 8}"; ::append Result " -foreground SystemWindowText"; ::append Result " -height 24"; ::append Result " -insertbackground SystemWindowText"; ::append Result " -insertborderwidth 0"; ::append Result " -insertofftime 300"; ::append Result " -insertontime 600"; ::append Result " -insertwidth 5"; ::append Result " -padx 1"; ::append Result " -pady 1"; ::append Result " -selectbackground SystemHighlight"; ::append Result " -selectborderwidth 0"; ::append Result " -selectforeground SystemHighlightText"; ::append Result " -setgrid 0"; ::append Result " -spacing1 0"; ::append Result " -spacing2 0"; ::append Result " -spacing3 0"; ::append Result " -state normal"; ::append Result " -tabs {}"; ::append Result " -takefocus {}"; ::append Result " -width 80"; #::append Result " -wrap char"; ;#// original #20060129_build_change_1_b (-wrap word) #::append Result " -wrap none"; ::append Result " -wrap word"; #::append Result " -xscrollcommand {}"; #::append Result " -yscrollcommand {}"; #// ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH}"; ::append Result " -yscrollcommand {::eval \[%this odb_master\] scrollbarSetV}"; #// ::return $Result; } } ::if {$::qw::control(html_window)} { # copied from ::QW::GUI::WIDGET_TEXT #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_HTML class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_HTML { inherit ::QW::GUI::WIDGET; #// public method tkClass {} {::return "Html";} public method createCommand {} {::return "::html";} /* { #// ------------------------------------------------------------ # ::QW::GUI::WIDGET #// ------------------------------------------------------------ ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background gray51"; # #// ------------------------------------------------------------ # html - all options #// ------------------------------------------------------------ #// #// i = inherit from ::QW::GUI::WIDGET #// i -background SystemWindow i -borderwidth 2 i -cursor xterm -exportselection 1 -font {MS Sans Serif} 8 -foreground SystemWindowText -height 24 i -highlightbackground SystemButtonFace i -highlightcolor SystemWindowFrame i -highlightthickness 0 -insertbackground SystemWindowText -insertborderwidth 0 -insertofftime 300 -insertontime 600 -insertwidth 2 -padx 1 -pady 1 i -relief sunken -selectbackground SystemHighlight -selectborderwidth 0 -selectforeground SystemHighlightText -setgrid 0 -spacing1 0 -spacing2 0 -spacing3 0 -state normal -tabs -takefocus -width 80 -wrap char -xscrollcommand -yscrollcommand */} public proc defaultOptionsList {} { #//::QW::GUI::WIDGET options: #//::append Result " -relief flat"; #//::append Result " -highlightbackground white"; #//::append Result " -highlightcolor black"; #//::append Result " -borderwidth 0"; #//::append Result " -highlightthickness 1"; #//::append Result " -cursor arrow"; #//::append Result " -background gray51"; #_pgq,debug2340 # uncomment for test - has been commented out for years #::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::set Result ""; #// html options ::append Result " -shrink 1"; ::append Result " -forcewidth true"; #// ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH}"; ::append Result " -yscrollcommand {::eval \[%this odb_master\] scrollbarSetV}"; #// ::return $Result; } } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_TABLE class #// ------------------------------------------------------------ namespace eval ::QW::GUI::EVENT::TABLE::DATAINTERFACE { #// proc mask {} {::return [::concat [::QW::GUI::EVENT::mask] -command [::expr \{%i\}=="1"?"write":"read"] -row %r -column %c -value %s];} #// proc mask {} {::return [::concat -windowPath %W -command [::expr \{%i\}=="1"?"write":"read"] -row %r -column %c -value %s];} proc mask {} {::return [::concat -windowPath %W -command %i -row %r -column %c -value %s];} } #// #// ^QF #//RTH-??? #// ::set _afterId [::after 50 [::list $this tclMessage scrollRepeatBegin [tkPath]]]; #// #::if {[::info commands table] ne "table"} { #::load [::file join $::env(pgq) tktable2.7 tktable.dll]; #::load [::file join $::env(pgq) tktable2.8 tktable.dll]; #::load [::file join $::env(pgq) tktable2.8 original tktable28.dll]; #} #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_TABLE { inherit ::QW::GUI::WIDGET; #// public method tkClass {} {::return "Table";} public method createCommand {} {::return "::qw::table";} /* { method VOID (/&) destructor() { // puts("we are in the table destructor and tkPath()="+tkPath()); //puts(" and fonts seek is="+.STRING(&gui()._fonts.seek(name()))); if (&gui()._fonts.seek(tkPath())) puts(" and fonts seek is true"); else puts(" and fonts seek is false"); // if (&gui()._fonts.seek(tkPath())) { // // found a cute bug... In the case of the 3-pane total explorer where we stretch resized the ledger and allocated a private font, // deleting the font causes a (FONT&) signalDestroy(), which sets the font to a Syetem font, which causes a signalWrite to the // ledger observers - the ledgerItem - which, not differentiating meaningful signals from noise, attempts to restart and redisplay // a new ledgerItem, after we've already progressed far enough in the destruction that things are gone. Poof, ref through a null var. // // ANY OTHER CLASS THAT COULD HAS A FONT REFERENCE IS EXPOSED (E.G. LABEL, ENTRY, BLAHBLAH, ETC.) // _font.detach(); // gui()._fonts.delete(tkPath()); } // //assert(_afterId.items()==0); // or... scrollRepeatEnd(); // } */} /* { All default options when table is created: -anchor center -autoclear 0 -background SystemButtonFace -bd -bg -bordercursor crosshair -borderwidth 1 -browsecommand -browsecmd -cache 0 -colorigin 0 -cols 10 -colseparator -colstretchmode none -coltagcommand -colwidth 10 -command -cursor xterm -diagnostics 1 -drawmode compatible -exportselection 1 -fg -flashmode 0 -flashtime 2 -font {MS Sans Serif} 8 -foreground black -height 0 -highlightbackground SystemButtonFace -highlightcolor SystemWindowFrame -highlightthickness 2 -insertbackground Black -insertborderwidth 0 -insertofftime 300 -insertontime 600 -insertwidth 2 -invertselected 0 -maxheight 600 -maxwidth 800 -multiline 1 -padx 2 -pady 1 -relief sunken -resizeborders both -rowheight 1 -roworigin 0 -rows 10 -rowseparator -rowstretchmode none -rowtagcommand -selcmd -selectioncommand -selectmode browse -selecttitles 0 -selecttype cell -sparsearray 1 -state normal -takefocus -titlecols 0 -titlerows 0 -usecommand 1 -variable -validate 0 -validatecommand -vcmd -width 0 -wrap 0 -xscrollcommand -yscrollcommand */} #//As set by smd0 public proc defaultOptionsList {} { ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::append Result " -anchor nw"; ::append Result " -autoclear 0"; #::append Result " -background SystemButtonFace"; ::append Result " -background #caf8d9"; ::append Result " -resize_cursor_we size_we"; ::append Result " -resize_cursor_ns size_ns"; ::append Result " -resize_cursor_nw_se size_nw_se"; ::append Result " -resize_col_enabled 1"; ::append Result " -resize_row_enabled 0"; ::append Result " -resize_titlecol_enabled 1"; ::append Result " -resize_titlerow_enabled 1"; ::append Result " -whitespace_top_enabled 1"; ::append Result " -whitespace_bottom_enabled 0"; ::append Result " -whitespace_left_enabled 1"; ::append Result " -whitespace_right_enabled 0"; ::append Result " -borderwidth 2"; #::append Result " -borderwidth 1"; #::append Result " -colstretchmode unset"; #// stretch columns that have no width set ::append Result " -colstretchmode none"; #::append Result " -command \"\""; ::append Result " -cursor arrow"; ::append Result " -drawmode fast"; #// slow is unbelieveable, blacks screen, repaints slowly (I didn't even bother trying compatible) # ::append Result " -drawmode slow"; #// slow is unbelieveable, blacks screen, repaints slowly (I didn't even bother trying compatible) ::append Result " -exportselection 1"; ::append Result " -font {}"; ::append Result " -foreground black"; ::append Result " -highlightbackground SystemButtonFace"; ::append Result " -highlightcolor black"; #::append Result " -highlightthickness 2"; ;#//original ::append Result " -highlightthickness 0"; # ::append Result " -highlightbackground green"; # ::append Result " -highlightcolor blue"; # ::append Result " -highlightthickness 2"; ::append Result " -insertbackground black"; ::append Result " -insertborderwidth 0"; ::append Result " -insertofftime 300"; ::append Result " -insertontime 600"; #::append Result " -insertofftime 0"; #::append Result " -insertontime 0"; ::append Result " -insertwidth 5"; ::append Result " -maxwidth 2000000000"; ::append Result " -maxheight 2000000000"; ::append Result " -padx 0"; ::append Result " -pady 0"; ::append Result " -relief sunken"; ::append Result " -selectmode browse"; #::append Result " -selectmode extended"; ::append Result " -selecttype row"; ::append Result " -state normal"; ::append Result " -takefocus 0"; ::append Result " -width 0"; #// #::append Result " -xscrollcommand \"\""; #::append Result " -yscrollcommand \"\""; ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH}"; ::append Result " -yscrollcommand {::eval \[%this odb_master\] scrollbarSetV}"; ::append Result " -command {%this dataInterface [::QW::GUI::EVENT::TABLE::DATAINTERFACE::mask]}"; #::append Result " -usecommand 1"; #// #//RTH-??? If these aren't in the list then trouble in the methods to come. ::append Result " -titlerows 0"; #// pgq included this one #20040728 table blink # ::append Result " -rows 10"; # ::append Result " -cols 10"; ::append Result " -rows 0"; ::append Result " -cols 0"; ::return $Result; } /* { public proc defaultOptionsList {} { ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; ::append Result " -anchor nw"; ::append Result " -autoclear 0"; #::append Result " -background SystemButtonFace"; ::append Result " -background #caf8d9"; ::append Result " -bordercursor size_we"; ::append Result " -borderwidth 2"; #::append Result " -cache 1"; #::append Result " -colstretchmode unset"; #// stretch columns that have no width set ::append Result " -colstretchmode none"; #::append Result " -command \"\""; ::append Result " -cursor arrow"; ::append Result " -drawmode fast"; #// slow is unbelieveable, blacks screen, repaints slowly (I didn't even bother trying compatible) ::append Result " -exportselection 1"; ::append Result " -font {}"; ::append Result " -foreground black"; ::append Result " -highlightbackground SystemButtonFace"; ::append Result " -highlightcolor black"; ::append Result " -highlightthickness 2"; ::append Result " -insertbackground black"; ::append Result " -insertborderwidth 0"; ::append Result " -insertofftime 300"; ::append Result " -insertontime 600"; #::append Result " -insertofftime 0"; #::append Result " -insertontime 0"; ::append Result " -insertwidth 5"; ::append Result " -maxwidth 2000000000"; ::append Result " -maxheight 2000000000"; ::append Result " -padx 0"; ::append Result " -pady 0"; ::append Result " -relief sunken"; ::append Result " -resizeborders col"; ::append Result " -selectmode browse"; #::append Result " -selectmode extended"; ::append Result " -selecttype row"; ::append Result " -state normal"; ::append Result " -takefocus 0"; ::append Result " -width 0"; #// #::append Result " -xscrollcommand \"\""; #::append Result " -yscrollcommand \"\""; ::append Result " -xscrollcommand {::eval \[%this odb_master\] scrollbarSetH}"; ::append Result " -yscrollcommand {::eval \[%this odb_master\] scrollbarSetV}"; ::append Result " -command {%this dataInterface [::QW::GUI::EVENT::TABLE::DATAINTERFACE::mask]}"; #::append Result " -usecommand 1"; #// #//RTH-??? If these aren't in the list then trouble in the methods to come. ::append Result " -titlerows 0"; #// pgq included this one ::append Result " -rows 10"; ::append Result " -cols 10"; ::return $Result; } */ } #20040309 (experiment - to see some of Hobb's behaviour) /* { public method tag {} { ::bindtags [tkPath] "[pathAsTag] [odb_path] Table all"; ::return $this; } */} public method setBindings {} { chain; ::bind [pathAsTag] [::list [odb_master] control_slash_go_item_from_anywhere [::QW::GUI::EVENT::KEYBOARD::mask]]; ::return $this; } } #// ------------------------------------------------------------ #// ::QW::GUI::WIDGET_SCALE class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::GUI::WIDGET_SCALE { inherit ::QW::GUI::WIDGET; #// protected variable _draggingSlider 0; protected variable _startNumber 0; protected variable _startPoint ""; protected variable _deltaX 0; protected variable _deltaY 0; protected variable _increment 0; protected variable _afterId ""; protected variable _direction ""; protected variable _delayTime 0; protected variable _saveSliderRelief 0; protected variable _repeatLimit 0; #// public method tkClass {} {::return "Scale";} public method createCommand {} {::return "::scale";} /* { #// ------------------------------------------------------------ # ::QW::GUI::WIDGET #// ------------------------------------------------------------ ::append Result " -relief flat"; ::append Result " -highlightbackground white"; ::append Result " -highlightcolor black"; ::append Result " -borderwidth 0"; ::append Result " -highlightthickness 1"; ::append Result " -cursor arrow"; ::append Result " -background gray51"; # #// ------------------------------------------------------------ # scale - all options #// ------------------------------------------------------------ #// #// i = inherit from ::QW::GUI::WIDGET #// -activebackground SystemButtonFace i -background SystemButtonFace -bigincrement 0.0 i -borderwidth 2 -command i -cursor -digits 0 -font {MS Sans Serif} 8 -foreground SystemButtonText -from 0.0 i -highlightbackground SystemButtonFace i -highlightcolor SystemWindowFrame i -highlightthickness 2 -label -length 100 -orient vertical i -relief flat -repeatdelay 300 -repeatinterval 100 -resolution 1.0 -showvalue 1 -sliderlength 30 -sliderrelief raised -state normal -takefocus -tickinterval 0.0 -to 100.0 -troughcolor SystemScrollbar -variable -width 15 */} public proc defaultOptionsList {} { #//::QW::GUI::WIDGET options: #//::append Result " -relief flat"; #//::append Result " -highlightbackground white"; #//::append Result " -highlightcolor black"; #//::append Result " -borderwidth 0"; #//::append Result " -highlightthickness 1"; #//::append Result " -cursor arrow"; #//::append Result " -background gray51"; ::set Result [::QW::GUI::WIDGET::defaultOptionsList]; #// scale options ::append Result " -activebackground SystemButtonFace"; ::append Result " -bigincrement 0.0"; ::append Result " -command {}"; ::append Result " -digits 0"; ::append Result " -font {}"; ::append Result " -foreground SystemButtonText"; ::append Result " -from 0.0"; ::append Result " -label {}"; ::append Result " -length 100"; ::append Result " -orient vertical"; ::append Result " -repeatdelay 200"; ::append Result " -repeatinterval 50"; ::append Result " -resolution 1.0"; ::append Result " -showvalue 1"; ::append Result " -sliderlength 30"; ::append Result " -sliderrelief raised"; ::append Result " -state normal"; ::append Result " -takefocus {}"; ::append Result " -tickinterval 0.0"; ::append Result " -to 100.0"; ::append Result " -troughcolor SystemScrollbar"; ::append Result " -variable {}" ::append Result " -width 15"; #// ::return $Result; } } ::namespace eval ::QW::GUI::IMAGE_BITMAP { ::proc /* {args} {} # ------------------------------------------------------------ # #RTH comiled this documentation, created an ascii representation of X bitmaps # and procedures to assist in the creation and editing of these bitmaps # ------------------------------------------------------------ /* { Tcl Bitmap Format ----------------- Tcl understands only one bitmap format called XBM (X BitMap.) The format is simple in the sense that it stored as straight text. The format is a pain in the rear to create/edit without an X bitmap editor (which are pretty rare in an MS-Windows environment.) Example: #define _width 10 #define _height 10 static unsigned char bits = { 0x00, 0x00, 0x00, 0x00, 0xff, 0x01, 0xfe, 0x00, 0x7c, 0x00, 0x38, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, } From here on we refer to this format as the 'hex' format. Tcl bitmap Images ----------------- Tcl bitmap images have two configuration options that take a hex bitmap: -data The "image" to be displayed -mask Controls the "transparency" of the image data & mask logic for a given pixel: if mask&&data foreground color if mask&&!data background color if !mask&&data "tranparent" if !mask&&!data "tranparent" Or, stated so even Bob can understand it: if mask bit = 0 "transparent" Else if data bit = 1 foreground color Else background color Notes: You cannot "image configure -mask ..." until you have set the -data configuration option The -mask option seems to be optional. When the option is not set, the display defaults to a behaviour consistent with a mask of all "1"s Poo Bitmap Handling ------------------- We have an "internal" representation for bitmaps that is much easier to create/edit than the hex format. We call this format "Ascii" for convenience. The Ascii representation is a Tcl list that looks like this: {{----------} {----------} {111111111-} {-1111111--} {--11111---} {---111----} {----1-----} {----------} {----------} {----------}} Each item in the list represents one row of pixels in the bitmap Each character in a row represents the pixel at that position in the bitmap The characters used in the Ascii format are used to control the 4 possible states at each pixel position: char data mask ' ' off off '-' off on '1' on on '.' on off Note: The width of bitmap is determined by the string length of the first element The height of bitmap determined by the number of elements There is no error checking to catch inconsistent element lengths (garbage in, garbage out) Conversions Between Formats --------------------------- Ascii to Hex mask: method .STRING (/&) bitmapAsciiToHexMask(.STRING& Src) - Returns the Hex format for -mask option from an Ascii bitmap Ascii to Hex data: method .STRING (/&) bitmapAsciiToHexData(.STRING& Src) - Returns the Hex format for -data option from an Ascii bitmap Hex data & mask to Ascii: method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc,.STRING& MaskSrc) - Hex data to Ascii: method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc) - Hex data only to Ascii (as if mask was all 1's) */} /* { ControlArray is a Tcl array we are using to store the four characters used in Ascii bitmaps to represent the bit states. In this way the "mapping" is set once, rather than being hard-coded in the procs. It is a field because it's value (the Tcl variable name) is needed elsewhere. */} ::variable ControlArray; ::array set ControlArray {m0d0 " " m0d1 . m1d0 - m1d1 1} #::array set ControlArray ""; #::set ControlArray(m0d0) " "; #::set ControlArray(m0d1) "."; #::set ControlArray(m1d0) "-"; #::set ControlArray(m1d1) "1"; # # bitmapWidth: Expands/truncates an Ascii bitmap to specified width # ::proc bitmapWidth {AsciiBitmap Src} { ::variable ControlArray; ::set CurrentWidth [::string length [::lindex $AsciiBitmap 0]]; ::if {$CurrentWidth==$Src} {::return $AsciiBitmap;} ::set Result {}; ::if {$CurrentWidth>$Src} { ::incr Src -1; ::foreach Row $AsciiBitmap {::lappend Result [::string range $Row 0 $Src];} } else { ::set AppendString [::string repeat $ControlArray(m1d0) [::expr $Src-$CurrentWidth]]; ::foreach Row $AsciiBitmap {::lappend Result $Row$AppendString;} } ::return $Result; } # # bitmapHeight: Expands/truncates an Ascii bitmap to specified height # ::proc bitmapHeight {AsciiBitmap Src} { ::variable ControlArray; ::if {!$Src} {::return {};} ::set Rows [::llength $AsciiBitmap]; ::if {$Rows==$Src} {::return $AsciiBitmap;} ::if {$Rows>$Src} {::return [::lrange $AsciiBitmap 0 [::expr $Src-1]];} ::set RowString [::string repeat $ControlArray(m1d0) [::string length [::lindex $AsciiBitmap 0]]]; ::for {::set i $Rows} {$i<$Src} {::incr i} {::lappend AsciiBitmap $RowString;} ::return $AsciiBitmap; } # # asciiToHex: Takes an Ascii bitmap and returns a hex data or hex mask. Mode arg is either "data" or "mask" # ::proc asciiToHex {Src Mode} { ::variable ControlArray; ::if {$Src==""} {::return "";} ::if {$Mode=="data"} { ::set Chars "$ControlArray(m1d1)$ControlArray(m0d1)"; } else { ::set Chars "$ControlArray(m1d1)$ControlArray(m1d0)"; } ::set Width [::string length [::lindex $Src 0]]; ::set Result ""; ::append Result "#define _width $Width"; ::append Result "\n#define _height [::llength $Src]"; ::append Result "\nstatic unsigned char bits[] = \x7b"; ::set Limit [::expr $Width<8?8:$Width]; ::incr Limit [::expr 8-$Limit%8<8?8-$Limit%8:0]; ::foreach Row $Src { ::append Result "\n\t"; ::set Byte 0; ::set Factor 1; ::for {::set i 0} {$i<$Limit} {::incr i} { ::if {[string first [string index $Row $i] $Chars]>=0} { ::incr Byte $Factor; }; ::set Factor [::expr int($Factor*2)]; ::if {$Factor==256} { ::set Byte [::format 0x%02x $Byte]; ::append Result " $Byte,"; ::set Byte 0; ::set Factor 1; }; }; }; ::append Result "\n\x7d"; ::return $Result; }; # # hexToBitPattern: Parses a hex bitmap into a "generic" Ascii bitmap. # Generic: The structure is the same as our Ascii bitmap, but the bits are either "0" or "1" # ::proc hexToBitPattern {HexSrc} { #//::puts "pgq,debug...gui\gui.qw_tcl hexToBitPattern enter HexSrc==$HexSrc"; ::proc substitute {Src Search Replace} { ::regsub -all $Search $Src $Replace Result; ::return $Result; } # hex to unsigned 8 bit # eg: for '41' returns 'A' ::proc hexToU8 {Src} { ::upvar ErrorText ErrorText; ::if {[::string length $Src]==1} {::set Src 0$Src;} ::if {[::string length $Src]!=2} {setErrorText "Too many hex digits in $Src";::return "";} ::return [::binary format H* $Src]; } # hex to binary # eg: for 'a3' returns '10100011' ::proc hexToBin {Src} { ::binary scan [hexToU8 $Src] B* Result; ::return $Result; } ::proc reverse {Src} { ::set Result ""; ::set i [::expr [::string length $Src]-1]; ::while {$i>=0} { ::append Result [::string index $Src $i]; ::incr i -1; } ::return $Result; } ::proc advance {} { ::upvar Src Src; ::upvar Offset Offset; ::incr Offset; ::set Char [::string index $Src $Offset]; ::return $Char; } ::proc retreat {} { ::upvar Src Src; ::upvar Offset Offset; ::incr Offset -1; } ::proc whiteSpace {} { ::upvar Offset Offset; ::upvar Src Src; ::while {[::expr [::string first [advance] "\r\n\t "]>=0]} {} retreat; comment; } ::proc comment {} { ::upvar Offset Offset; ::upvar Src Src; ::if {"[advance][advance]"=="\x2f\x2a"} { ::set char1 [advance]; ::set char2 [advance]; ::set sanity 0; ::while {"$char1$char2"!="\x2a\x2f"&&$sanity<1024} { ::incr sanity; ::set char1 $char2; ::set char2 [advance]; } } else { retreat;retreat; } } ::proc nextWord { } { ::upvar Src Src; ::upvar Offset Offset; ::set Word ""; whiteSpace; ::set Char [advance]; ::while {[::expr [::string first [::string toupper $Char] "ABCDEFGHIJKLMNOPQRSTUVWXYZ#_"]>=0]} { ::append Word $Char; ::set Char [advance]; } retreat; ::return $Word; } ::proc expectNumber {} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; whiteSpace; ::set Number ""; ::set Char [advance]; ::while {[::expr [::string first $Char "0123456789"]>=0]} { ::append Number $Char; ::set Char [advance]; } retreat; ::if {![::string length $Number]} { setErrorText "Expected decimal digit but encountered \"$Char\""; ::return 0; } ::return $Number; } ::proc nextHexNumber {} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; whiteSpace; ::set Number ""; ::set Char ""; ::if {[advancePastWord 0x]} { ::set Char [advance]; ::while {[::expr [::string first [::string toupper $Char] "0123456789ABCDEF"]>=0]} { ::append Number $Char; ::set Char [advance]; } retreat; } ::if {![::string length $Number]} { setErrorText "Expected hex digit but encountered \"$Char\""; } ::return $Number; } ::proc expectChar {Char} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; whiteSpace; ::set NextChar [advance]; ::if {[::string compare $Char $NextChar]==0} { ::return 1; } retreat; setErrorText "Expected \"$Char\" but encountered \"$NextChar\""; ::return 0; } ::proc advancePastWord {String} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; ::set Pos [::string first [::string toupper $String] [::string toupper [::string range $Src [::expr $Offset+1] end]]]; ::if {$Pos>=0} { ::set Offset [::expr $Pos+$Offset+[::string length $String]]; ::return 1; } setErrorText "Expected \"$String\"" ::return 0; } ::proc expectWord {String} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; whiteSpace; ::set nextWord [nextWord]; ::if {[::string compare [::string toupper $nextWord] [::string toupper $String]]==0} {::return 1;} setErrorText "Expected \"$String\" but encountered \"$nextWord\"" ::return 0; } ::proc expectWordContaining {String} { ::upvar Src Src; ::upvar Offset Offset; ::upvar ErrorText ErrorText; whiteSpace; ::set NextWord [nextWord]; ::if {[::string first [::string toupper $String] [::string toupper $NextWord]]>=0} {::return 1;} setErrorText "Expected string containing \"$String\" but encountered \"$NextWord\"" ::return 0; } ::proc setErrorText {Text} { ::upvar ErrorText ErrorText; ::if {[::string length $ErrorText]} {::append ErrorText \n;} ::append ErrorText $Text; } ::proc main {Mode} { #//::puts "pgq,debug...gui\gui.qw_tcl hexToBitPattern main{Mode} enter Mode==$Mode"; #//::puts "pgq,debug...gui\gui.qw_tcl hexToBitPattern main{Mode} ::qw::command_exists ::nextHexNumber==[::qw::command_exists ::nextHexNumber]"; #//::puts "pgq,debug...gui\gui.qw_tcl hexToBitPattern main{Mode} ::qw::command_exists ::hexToBitPattern::nextHexNumber==[::qw::command_exists ::hexToBitPattern::nextHexNumber]"; ::upvar HexSrc Src; ::upvar Offset Offset ::upvar ErrorText ErrorText; ::set Result ""; ::set Offset -1; ::if {[expectWord #define]} { ::if {[expectWordContaining _width]} { ::if {[::set Width [expectNumber]]} { ::if {[expectWord #define]} { ::if {[expectWordContaining _height]} { ::if {[::set Height [expectNumber]]} { ::if {[advancePastWord bits]} { whiteSpace; ::if {[expectChar =]} { whiteSpace; ::if {[expectChar \x7b]} { whiteSpace; ::if {$Width&&$Height} { ::set HexNumbersExpected [::expr int([::expr floor([::expr ($Width+7)/8])*$Height])]; ::set HexNumbersPerRow [::expr $HexNumbersExpected/$Height]; ::set HexNumbersSeen 0; ::set StringIndex [::expr $Width-1]; ::for {::set Row 0} {$Row<$Height} {::incr Row} { ::set RowBits ""; ::for {::set Col 0} {$Col<$HexNumbersPerRow} {::incr Col} { ::set HexNumber [nextHexNumber]; ::if {$HexNumber!=""} { ::incr HexNumbersSeen; ::append RowBits [reverse [hexToBin $HexNumber]]; } else { # ERROR!!!! ::set Col $HexNumbersPerRow ::set Row $Height #::set RowBits \"ERROR\"; } } ::set RowBits [::string range $RowBits 0 $StringIndex]; ::if {[::string length $RowBits>0]} { ::lappend Result $RowBits; } } ::if {$HexNumbersSeen!=$HexNumbersExpected} { setErrorText "Expected $HexNumbersExpected hex numbers but encountered $HexNumbersSeen"; ::set Result ""; } }}}}}}}}}} ::return $Result; } ::set ErrorText ""; ::set Result [main HexSrc]; # Clobber the procs ::rename substitute ""; ::rename hexToU8 ""; ::rename hexToBin ""; ::rename reverse ""; ::rename advance ""; ::rename retreat ""; ::rename whiteSpace ""; ::rename comment ""; ::rename nextWord ""; ::rename expectNumber ""; ::rename nextHexNumber ""; ::rename expectChar ""; ::rename advancePastWord ""; ::rename expectWord ""; ::rename expectWordContaining ""; ::rename setErrorText ""; ::rename main ""; ::if {$ErrorText!=""} {::return "ERROR:\n$ErrorText"} ::return $Result; } # # bitPatternsToAscii: Combines a data and mask bit pattern into an Ascii bitmap. # ::proc bitPatternsToAscii {DataSrc MaskSrc} { ::variable ControlArray; ::set Result ""; ::set DataRows [::llength $DataSrc]; ::if {$DataRows!=[::llength $MaskSrc]} {::return "ERROR: Data rows != mask rows."} ::for {::set i 0} {$i<$DataRows} {::incr i} { ::set DataRowBits [::lindex $DataSrc $i]; ::set MaskRowBits [::lindex $MaskSrc $i]; ::set DataRowLength [::string length $DataRowBits]; ::if {$DataRowLength!=[::string length $MaskRowBits]} {::return "ERROR: Data row $i length != mask row length."} ::set RowResult ""; ::for {::set j 0} {$j<[::string length $DataRowBits]} {::incr j} { ::set Bits "[::string index $MaskRowBits $j][::string index $DataRowBits $j]"; ::if {$Bits=="00"} {::append RowResult $ControlArray(m0d0);continue;}; ::if {$Bits=="01"} {::append RowResult $ControlArray(m0d1);continue;}; ::if {$Bits=="10"} {::append RowResult $ControlArray(m1d0);continue;}; ::if {$Bits=="11"} {::append RowResult $ControlArray(m1d1);continue;}; } ::lappend Result $RowResult; } ::return $Result; } # # bitPatternToAscii: Combines a data bit pattern into an Ascii bitmap with all mask bits "on" # ::proc bitPatternToAscii {DataSrc} { ::variable ControlArray; ::set Result ""; ::set DataRows [::llength $DataSrc]; ::for {::set i 0} {$i<$DataRows} {::incr i} { ::set DataRowBits [::lindex $DataSrc $i]; ::set DataRowLength [::string length $DataRowBits]; ::set RowResult ""; ::for {::set j 0} {$j<[::string length $DataRowBits]} {::incr j} { ::set Bit "[::string index $DataRowBits $j]"; ::if {$Bit=="0"} {::append RowResult $ControlArray(m1d0);continue;}; ::if {$Bit=="1"} {::append RowResult $ControlArray(m1d1);continue;}; } ::lappend Result $RowResult; } ::return $Result; } # # hexToAscii: Converts a data and mask hex bitmap into an Ascii bitmap. # If mask is null, the returned ascii bitmap will have all mask bits set "on". ::proc hexToAscii {DataSrc MaskSrc} { ::set DataBits [hexToBitPattern $DataSrc]; ::if {[::string first "ERROR" $DataBits]>=0} {::return $DataBits;} ::if {[::string length $MaskSrc]>0} { ::set MaskBits [hexToBitPattern $MaskSrc]; ::if {[::string first "ERROR" $MaskBits]>=0} {::return $MaskBits;} ::return [bitPatternsToAscii $DataBits $MaskBits]; } else { ::return [bitPatternToAscii $DataBits]; } } # Ascii to Hex mask: method .STRING (/&) bitmapAsciiToHexMask(.STRING& Src) - Returns the Hex format for -mask option from an Ascii bitmap # Ascii to Hex data: method .STRING (/&) bitmapAsciiToHexData(.STRING& Src) - Returns the Hex format for -data option from an Ascii bitmap #method .STRING (/&) bitmapAsciiToHexData(.STRING& Src) { # if(Src=="") ::return Src; # ::return ._tcl.eval("::"+.STRING(cppAddress())+"asciiToHex "+Src+" data"); #} ::proc AsciiToHexData {Src} { ::if {$Src eq ""} {::return $Src;} ::return [asciiToHex $Src data]; } #method .STRING (/&) bitmapAsciiToHexMask(.STRING& Src) { # if(Src=="") ::return Src; # ::return ._tcl.eval("::"+.STRING(cppAddress())+"asciiToHex "+Src+" mask"); #} ::proc AsciiToHexMask {Src} { ::if {$Src eq ""} {::return $Src;} ::return [asciiToHex $Src mask]; } # Hex data & mask to Ascii: method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc,.STRING& MaskSrc) - # Hex data to Ascii: method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc) - Hex data only to Ascii (as if mask was all 1's) #method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc,.STRING& MaskSrc) { # if(DataSrc=="") ::return DataSrc.brace(); # if(MaskSrc=="") ::return bitmapHexToAscii(DataSrc.brace()); # ::return ._tcl.eval("::"+.STRING(cppAddress())+"hexToAscii "+DataSrc.brace()+" "+MaskSrc.brace()).brace(); #} ::proc HexToAscii {DataSrc MaskSrc} { ::if {$DataSrc eq ""} {::return \{\};} ::return [hexToAscii $DataSrc $MaskSrc]; } #method .STRING (/&) bitmapHexToAscii(.STRING& DataSrc) { # ::return ._tcl.eval("::"+.STRING(cppAddress())+"hexToAscii "+DataSrc.brace()+" "+.STRING.quote()).brace(); #} #::proc HexToAscii {DataSrc} { # ::return [hexToAscii \{$DataSrc\} {}]; #} #method .STRING (/&) bitmapAsciiWidth(.STRING& AsciiBitmap,.DISTANCE& Width) { # ::return ._tcl.eval("::"+.STRING(cppAddress())+"bitmapWidth "+AsciiBitmap+" "+(.GUI.DISTANCE/PIXELS=Width).tclString()).brace(); #} ::proc AsciiWidth {AsciiBitmap Width} { ::return [bitmapWidth $AsciiBitmap $Width]; } #method .STRING (/&) bitmapAsciiHeight(.STRING& AsciiBitmap,.DISTANCE& Height) { # ::return ._tcl.eval("::"+.STRING(cppAddress())+"bitmapHeight "+AsciiBitmap+" "+(.GUI.DISTANCE/PIXELS=Height).tclString()).brace(); #} ::proc AsciiHeight {AsciiBitmap Height} { ::return [bitmapHeight $AsciiBitmap $Height]; } } ;#::QW::GUI::IMAGE /* { # ------------------------------------------------------------ # Test bitmap images # ------------------------------------------------------------ puts_pgq -nonewline {"Testing..."} set bitmapTestAscii \ {{----------} \ {----------} \ {111111111-} \ {-1111111--} \ {--11111---} \ {---111----} \ {----1-----} \ {----------} \ {----------} \ {----------}} # Ascii to Hex and back set Temp [::QW::GUI::IMAGE::HexToAscii [::QW::GUI::IMAGE::AsciiToHexData $bitmapTestAscii] ""]; ::if {[::llength $Temp]!=[::llength $bitmapTestAscii]} {error "AsciiToHexData failed (1)"} ::for {set i 0} {$i<[::llength $Temp]} {incr i} { ::if {[::string compare [::lindex $Temp $i] [::lindex $bitmapTestAscii $i]]!=0} { error "AsciiToHexData failed (2)" } } # Height set Temp [::QW::GUI::IMAGE::AsciiHeight [::QW::GUI::IMAGE::AsciiHeight $bitmapTestAscii 12] 10] ::if {[::llength $Temp]!=[::llength $bitmapTestAscii]} {puts_pgq \n$bitmapTestAscii\n$Temp\n;error {"AsciiHeight failed (1)"}} ::for {set i 0} {$i<[::llength $Temp]} {incr i} { ::if {[::string compare [::lindex $Temp $i] [::lindex $bitmapTestAscii $i]]!=0} { error "AsciiHeight failed (2)" } } # Width set Temp [::QW::GUI::IMAGE::AsciiWidth [::QW::GUI::IMAGE::AsciiWidth $bitmapTestAscii 12] 10] ::if {[::llength $Temp]!=[::llength $bitmapTestAscii]} {puts_pgq \n$bitmapTestAscii\n$Temp\n;error {"AsciiWidth failed (1)"}} ::for {set i 0} {$i<[::llength $Temp]} {incr i} { ::if {[::string compare [::lindex $Temp $i] [::lindex $bitmapTestAscii $i]]!=0} { error "AsciiWidth failed (2)" } } puts_pgq {"OK"} */} /* { #// ------------------------------------------------------------ #// ::QW::NV2::TEMPORAL class #// ------------------------------------------------------------ ::namespace eval ::QW::NV2::TEMPORAL { } #// ------------------------------------------------------------ #// ::QW::NV2::TEMPORAL::STRING class #// ------------------------------------------------------------ ::qw::itcl::class ::QW::NV2::TEMPORAL::STRING { inherit ::QW::ODB::STRING; public method schema_default {} {::return "heritage";} method odb_get {} { ::if {![qw_is_null]} {::return [chain];} ::if {[odb_base] eq ""} { #// A cryptic way to test number of items. #// If this is the base field, it can't have any siblings to previous to... ::return [chain]; } ::set PreviousRef [[[[odb_master] odb_base] ".deriveds.index/date"] odb_last]; ::if {[$PreviousRef odb_master] eq [odb_master]} { #// i.e. I landed on myself. ::return [chain]; } ::return [[[$PreviousRef odb_master] [odb_path_from_object [odb_master]]] odb_get]; } #// # NOTICE #// Still have signal propagation to do... } */} ::namespace eval ::QW::GUI::NEWVIEWS { /* { ::proc eatshit {} { ::upvar _eatshit _eatshit; ::set _eatshit "eatshit asshole"; } */} #nv2.20.0 (moved to here for Navigator's script) ::proc name_split {Src} { ::set Position -1; ::foreach Char {"." "-" "~" "="} { ::set i [::string last $Char $Src]; ::if {$i<$Position} {::continue;} ::set Position $i; ::set Separator $Char; } ::if {$Position<=0} {::return "";} ::if {$Position>=[::expr [::string length $Src]-1]} {::return "";} ::set Prefix [::string range $Src 0 [::expr $Position-1]]; ::set Suffix [::string range $Src [::expr $Position+1] end]; ::return [::list $Prefix $Separator $Suffix]; } ::proc name_prefix {Src} {::return [::lindex [name_split $Src] 0];} ::proc name_separator {Src} {::return [::lindex [name_split $Src] 1];} ::proc name_suffix {Src} {::return [::lindex [name_split $Src] 2];} ::proc ::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list {s_args} { ::set Database [::sargs::get $s_args .database]; ::set PickList [[$Database "/OBJECT/NEWVIEWS/JOURNAL"] tags_allocation_downward_closure_name_and_description_pairs_get]; #//::set Count 0;::foreach Guy $PickList {#//::puts "pgq,debug238586...::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list PickList 000 ([::incr Count]) Guy==\"$Guy\"";} ::set Ptags [[$Database "/OBJECT/NEWVIEWS/JOURNAL"] tags_downward_closure_get]; ::foreach Ptag $Ptags { ::lappend PickList [::list $Ptag {}]; } ::set PickList [::lsort -dictionary -index 0 $PickList]; #//::set Count 0;::foreach Guy $PickList {#//::puts "pgq,debug238586...::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list PickList 111 ([::incr Count]) Guy==\"$Guy\"";} ::set HalpinList ""; ::foreach Item $PickList { ::lappend HalpinList "[::lindex $Item 0] [::lindex $Item 1]"; } ::set PickList $HalpinList; #//::set Count 0;::foreach Guy $PickList {#//::puts "pgq,debug238586...::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list PickList 222 ([::incr Count]) Guy==\"$Guy\"";} ::return $PickList; /* { PickList=={x {X Project}} {y {Y Project}} {z {Z Project}} {x {Project X}} {y {Project Y}} {z {Project Z}} PickList=={budget {}} {financial {}} {order {}} {tfinancial {}} {torder {}} {x {X Project}} {x {Project X}} {y {Y Project}} {y {Project Y}} {z {Z Project}} {z {Project Z}} PickList=={budget } {financial } {order } {tfinancial } {torder } {x X Project} {x Project X} {y Y Project} {y Project Y} {z Z Project} {z Project Z} */} } ::proc ::QW::GUI::NEWVIEWS::edit_assist_tag_pair_list_MAYBE {s_args} { # NOT CALLED ::set Database [::sargs::get $s_args .database]; ::set PickList [[$Database "/OBJECT/NEWVIEWS/JOURNAL"] tags_downward_closure_partition_allocation_pairs_get]; #//::puts "pgq,debug217.../TABLE/NOTES/COLUMN_DEFINE/RUNNING_BALANCE/RANGE_AMOUNT/ACCOUNT PickList==$PickList"; ::set Ptags [[$Database "/OBJECT/NEWVIEWS/JOURNAL"] tags_downward_closure_get]; ::foreach Ptag $Ptags { ::lappend PickList [::list $Ptag {}]; } ::set PickList [::lsort -dictionary -index 0 $PickList]; #//::puts "pgq,debug217.../TABLE/NOTES/COLUMN_DEFINE/RUNNING_BALANCE/RANGE_AMOUNT/ACCOUNT PickList==$PickList"; ::set HalpinList ""; ::foreach Item $PickList { ::lappend HalpinList "[::lindex $Item 0] [::lindex $Item 1]"; } ::set PickList $HalpinList; #//::puts "pgq,debug217.../TABLE/NOTES/COLUMN_DEFINE/RUNNING_BALANCE/RANGE_AMOUNT/ACCOUNT PickList==$PickList"; ::return $PickList; /* { PickList=={x {X Project}} {y {Y Project}} {z {Z Project}} {x {Project X}} {y {Project Y}} {z {Project Z}} PickList=={budget {}} {financial {}} {order {}} {tfinancial {}} {torder {}} {x {X Project}} {x {Project X}} {y {Y Project}} {y {Project Y}} {z {Z Project}} {z {Project Z}} PickList=={budget } {financial } {order } {tfinancial } {torder } {x X Project} {x Project X} {y Y Project} {y Project Y} {z Z Project} {z Project Z} */} } ::proc ::QW::GUI::NEWVIEWS::odb_path_help_format_list {} { ::set Formats ""; ::lappend Formats "long"; ::lappend Formats "long_lower_case"; ::lappend Formats "short"; ::lappend Formats "short_lower_case"; ::lappend Formats "short_lower_case_folder"; ::lappend Formats "name"; ::lappend Formats "name_lower_case"; ::return $Formats; } ::proc ::QW::GUI::NEWVIEWS::odb_path_help_format {s_args} { #//::puts "pgq,debug2330...odb_path_help_format s_args==(\n[::sargs::format .structure $s_args]\n)"; #::qw::stack_dump; ;#//pgq,debug #//::puts "pgq,debug2330...odb_path_help_format odb==[::string range [::sargs::get $s_args .object] 0 24]"; /* { pgq,debug...odb_path_help_format s_args==( .object ::qw::odb::20170715141322::/1502284215_150470 .format short_lower_case_folder ) */} #nv2.33.0 ((harden) - ::QW::GUI::NEWVIEWS::odb_path_help_format - test for empty and deleted objects /* { ::if {[::sargs::get $s_args .object] eq "" \ ||[[::string range [::sargs::get $s_args .object] 0 24] cpp_find_from_address [::sargs::get $s_args .object]] eq "" \ } { #//::puts "pgq,debug2330...odb_path_help_format - deleted object - ::return empty"; ::return ""; } */} /* { ::if {$RefObject eq "" \ ||[[odb_database application] cpp_id] ne [::qw::odb::database_id_extract .address $RefObject] \ ||[[odb_database application] cpp_find_from_address $RefObject] eq "" \ } { } */} ::set Object [::sargs::get $s_args .object]; ::if {$Object eq ""} { ::return ""; } ::set DatabaseId [::qw::odb::database_id_extract .address $Object]; ::set Database [[::qw::system] cpp_find_database .database_id $DatabaseId]; ::if {$Database eq "" \ ||[$Database cpp_find_from_address $Object] eq "" \ } { #//::puts "pgq,debug2330...odb_path_help_format Object==\"\" s_args==(\n[::sargs::format .structure $s_args]\n)"; ::return ""; } #) #nv2.17.0 (NOT - or fix before release - 4 places that call without odb_master) #::set Oph [[::sargs::get $s_args .object] odb_path_help]; ::set Oph [[[::sargs::get $s_args .object] odb_master] odb_path_help]; #nv2.24.1d (resume) ::return [::QW::GUI::NEWVIEWS::odb_path_help_format_from_string [::sargs::set $s_args .odb_path $Oph]]; } ::proc ::QW::GUI::NEWVIEWS::odb_path_help_format_from_string {s_args} { #//::puts "pgq,debug2.24.1d...odb_path_help_format_from_string s_args==(\n[::sargs::format .structure $s_args]\n)"; ::set Oph [::sargs::get $s_args .odb_path]; ::switch -- [::sargs::get $s_args .format] { "" - "long" { } "long_lower_case" { ::set Oph [::string tolower $Oph]; } "short" { ::if {[::string first "/" $Oph 1]>=0} { ::set Oph [::string range $Oph [::string first "/" $Oph 1] end]; } } "short_lower_case" { ::if {[::string first "/" $Oph 1]>=0} { ::set Oph [::string tolower [::string range $Oph [::string first "/" $Oph 1] end]]; } } "short_lower_case_folder" { ::if {[::string first "/" $Oph 1]>=0} { ::set Remainder [::string range $Oph [::string first "/" $Oph 1] end]; ::set FolderPart [::string range $Remainder 0 [::expr {[::string last "/" $Remainder]-1}]]; ::set NamePart [::string range $Remainder [::string last "/" $Remainder] end]; ::set Oph "[::string tolower $FolderPart]$NamePart"; } } "name" { ::set Oph [::string range $Oph [::expr {[::string last "/" $Oph]+1}] end]; } "name_lower_case" { ::set Oph [::string tolower [::string range $Oph [::expr {[::string last "/" $Oph]+1}] end]]; } } #::set Oph [::string map {/ " "} $Oph]; #//::puts "pgq,debug232...odb_path_help_format_from_string returning Oph==$Oph"; ::return $Oph; } ::proc setup_help_id {HelpId Window} { #20050410_help ::sargs::var::set ColumnSetup ".help.help_id" $HelpId; ::set ColumnDefinitions [[$Window ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::+= $ColumnDefinitions $ColumnSetup]; [$Window ".column_definitions"] odb_set $ColumnDefinitions; ::return; } #(-------------------------------------------------------------------------- ::proc ::QW::GUI::NEWVIEWS::setup_final_position_no_buttons_recreate {Window Explorer FinishOnSub} { #nv2.27.0 (bug fix) - setup_final_position_no_buttons_recreate - tk GP recreating buttons for nvnph_compile auto switch to Budget Monthly Input for account EXPENSE and SALES #//::puts "pgq,debug::QW::GUI::NEWVIEWS::setup_final_position_no_button_recreate enter"; # NOTICE #// very nasty GP in tk button destroy... #// investigated for a while but moved on with workaround #// just skip button manipulation if caller knows we a just positioning in a static setup /* { #$Window windowSelect $Explorer; #// ------------------------------------------------------------ # Refresh buttons, FIRST #// ------------------------------------------------------------ #//::puts "20061102_000 .clientdata==\n[::sargs::format .structure [[$Window .clientdata] qw_get]]"; #//::puts "20061102_000 WindowMenu==\n[::sargs::format .structure $WindowMenu]"; #[$Window ".clientdata"] odb_set [::sargs::set [[$Window ".clientdata"] qw_get] ".newviews.windowMenu" $WindowMenu]; ::if {[$Window windowMenu_buttons_isDisplayed]} { #$Window windowMenu_buttons_hide; #$Window windowMenu_buttons_display; ::if {![$Window is_tk_toplevel]&&[[$Window ".frame.dressing.isDisplayed"] odb_get]} { [$Window ".frame"] buttons_destroy; [$Window ".frame"] buttons_create_menu_style; } } $Window odb_commit; */} #// ------------------------------------------------------------ # Position on Accounts List, SECOND #// ------------------------------------------------------------ #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Window ==[$Window odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Explorer==[$Explorer odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position tree ==[[$Explorer tree] odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position desktop ==[[$Explorer desktop] odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Sub ==$FinishOnSub"; #nv2.27.0 (harden needed) - if FinishOnSub is empty we have a bug? $Window windowSelect $Explorer; ::set Settings [::sargs::get [[[$Explorer tree] ".saved_settings"] odb_get] "/column_define"]; ::set ColumnDefinitions [::sargs::get $Settings "/$FinishOnSub.column_definitions"]; ::set ColumnNames [::sargs::get $Settings "/$FinishOnSub.column_names"]; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position ColumnNames==$ColumnNames"; ::sargs::var::set Settings .current_sub /$FinishOnSub; [[$Explorer tree] ".saved_settings"] odb_set [::sargs::+= [[[$Explorer tree] ".saved_settings"] qw_get] [::sargs "/column_define" $Settings]]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $ColumnNames; ::set Title [::sargs::get [[$Explorer ".frame.dressing.settings"] odb_get] ".title_text"]; ::if {[::string first "," $Title]>0} { ::set Title [::string range $Title 0 [::expr {[::string first "," $Title]-1}]]; } ::append Title ", [::sargs::get $Settings /$FinishOnSub.name]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Title==$Title"; [$Explorer ".frame.dressing.settings"] replace .title_text $Title; $Window window_titles; #nv2.12.0 #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Window==[$Window odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Explorer==[$Explorer odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; ::if {$::qw::control(window_default_setup)==1} { #$Window database_reload_command; } } ::proc ::QW::GUI::NEWVIEWS::setup_final_position {Window Explorer FinishOnSub} { #//::puts "pgq,debug::QW::GUI::NEWVIEWS::setup_final_position enter"; #$Window windowSelect $Explorer; #// ------------------------------------------------------------ # Refresh buttons, FIRST #// ------------------------------------------------------------ #//::puts "20061102_000 .clientdata==\n[::sargs::format .structure [[$Window .clientdata] qw_get]]"; #//::puts "20061102_000 WindowMenu==\n[::sargs::format .structure $WindowMenu]"; #[$Window ".clientdata"] odb_set [::sargs::set [[$Window ".clientdata"] qw_get] ".newviews.windowMenu" $WindowMenu]; ::if {[$Window windowMenu_buttons_isDisplayed]} { #$Window windowMenu_buttons_hide; #$Window windowMenu_buttons_display; ::if {![$Window is_tk_toplevel]&&[[$Window ".frame.dressing.isDisplayed"] odb_get]} { [$Window ".frame"] buttons_destroy; [$Window ".frame"] buttons_create_menu_style; } } $Window odb_commit; #// ------------------------------------------------------------ # Position on Accounts List, SECOND #// ------------------------------------------------------------ #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position Window ==[$Window odb_path]"; #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position Explorer==[$Explorer odb_path]"; #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position tree ==[[$Explorer tree] odb_path]"; #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position desktop ==[[$Explorer desktop] odb_path]"; #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position Sub ==$FinishOnSub"; $Window windowSelect $Explorer; #nv2.31.3 (improvement) - ::QW::GUI::NEWVIEWS::setup_final_position - FinishOnSub can be eq "" - custom_data_explorer.qw_script creates additional ledger_explorer which has no extra views ::if {$FinishOnSub eq ""} { ::return; } ::set Settings [::sargs::get [[[$Explorer tree] ".saved_settings"] odb_get] "/column_define"]; ::set ColumnDefinitions [::sargs::get $Settings "/$FinishOnSub.column_definitions"]; ::set ColumnNames [::sargs::get $Settings "/$FinishOnSub.column_names"]; #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position ColumnNames==$ColumnNames"; ::sargs::var::set Settings .current_sub /$FinishOnSub; [[$Explorer tree] ".saved_settings"] odb_set [::sargs::+= [[[$Explorer tree] ".saved_settings"] qw_get] [::sargs "/column_define" $Settings]]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $ColumnNames; ::set Title [::sargs::get [[$Explorer ".frame.dressing.settings"] odb_get] ".title_text"]; ::if {[::string first "," $Title]>0} { ::set Title [::string range $Title 0 [::expr {[::string first "," $Title]-1}]]; } ::append Title ", [::sargs::get $Settings /$FinishOnSub.name]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Title==$Title"; [$Explorer ".frame.dressing.settings"] replace .title_text $Title; $Window window_titles; #nv2.12.0 #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Window==[$Window odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position Explorer==[$Explorer odb_path]"; #//::puts "pgq,debug677::QW::GUI::NEWVIEWS::setup_final_position ::qw::control(window_default_setup)==$::qw::control(window_default_setup)"; ::if {$::qw::control(window_default_setup)==1} { #$Window database_reload_command; } } ::proc ::QW::GUI::NEWVIEWS::setup_final_position_table {Window Table FinishOnSub} { #// ------------------------------------------------------------ # Refresh buttons, FIRST #// ------------------------------------------------------------ #//::puts "20061102_000 .clientdata==\n[::sargs::format .structure [[$Window .clientdata] qw_get]]"; #//::puts "20061102_000 WindowMenu==\n[::sargs::format .structure $WindowMenu]"; #[$Window ".clientdata"] odb_set [::sargs::set [[$Window ".clientdata"] qw_get] ".newviews.windowMenu" $WindowMenu]; ::if {[$Window windowMenu_buttons_isDisplayed]} { #$Window windowMenu_buttons_hide; #$Window windowMenu_buttons_display; ::if {![$Window is_tk_toplevel]&&[[$Window ".frame.dressing.isDisplayed"] odb_get]} { [$Window ".frame"] buttons_destroy; [$Window ".frame"] buttons_create_menu_style; } } $Window odb_commit; #// ------------------------------------------------------------ # Position on List, SECOND #// ------------------------------------------------------------ #//::puts "pgq,debug2330::QW::GUI::NEWVIEWS::setup_final_position_table Window==[$Window odb_path] Table==[$Table odb_path] FinishOnSub==$FinishOnSub"; $Window windowSelect $Table; #nv2.33.0 (improvement) - ::QW::GUI::NEWVIEWS::setup_final_position - FinishOnSub can be eq "" - custom_data_explorer.qw_script creates additional ledger_explorer which has no extra views ::if {$FinishOnSub eq ""} { ::return; } ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set ColumnDefinitions [::sargs::get $Settings "/$FinishOnSub.column_definitions"]; ::set ColumnNames [::sargs::get $Settings "/$FinishOnSub.column_names"]; ::sargs::var::set Settings .current_sub /$FinishOnSub; [$Table ".saved_settings"] odb_set [::sargs::+= [[$Table ".saved_settings"] qw_get] [::sargs "/column_define" $Settings]]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $ColumnNames; ::set Title [::sargs::get [[$Table ".frame.dressing.settings"] odb_get] ".title_text"]; ::if {[::string first "," $Title]>0} { ::set Title [::string range $Title 0 [::expr {[::string first "," $Title]-1}]]; } ::append Title ", [::sargs::get $Settings /$FinishOnSub.name]"; #//::puts "20060605_000 Title==$Title"; [$Table ".frame.dressing.settings"] replace .title_text $Title; $Window window_titles; } #nv2.11.4 (not used in the end... added method .../DESKTOP windowMenu_execute arg==Path) ::proc ::QW::GUI::NEWVIEWS::select_table_and_view {Window Table FinishOnSub} { #//::puts "::QW::GUI::NEWVIEWS::select_table_and_view Window==[$Window odb_path] and Table==[$Table odb_path] FinishOnSub==$FinishOnSub"; # NOTICE #// The change (from ::QW::GUI::NEWVIEWS::setup_final_position) #// to expect a full path (e.g. /5, as opposed to 5) #// $Window windowSelect $Table; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set ColumnDefinitions [::sargs::get $Settings "$FinishOnSub.column_definitions"]; ::set ColumnNames [::sargs::get $Settings "$FinishOnSub.column_names"]; ::sargs::var::set Settings .current_sub $FinishOnSub; [$Table ".saved_settings"] odb_set [::sargs::+= [[$Table ".saved_settings"] qw_get] [::sargs "/column_define" $Settings]]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $ColumnNames; ::set Title [::sargs::get [[$Table ".frame.dressing.settings"] odb_get] ".title_text"]; ::if {[::string first "," $Title]>0} { ::set Title [::string range $Title 0 [::expr {[::string first "," $Title]-1}]]; } ::append Title ", [::sargs::get $Settings $FinishOnSub.name]"; #//::puts "::QW::GUI::NEWVIEWS::select_table_and_view Title==$Title"; [$Table ".frame.dressing.settings"] replace .title_text $Title; $Window window_titles; $Window odb_commit; } /* { */} #nv2.11.4 (not used in the end... added method .../DESKTOP windowMenu_execute arg==Path) ::proc ::QW::GUI::NEWVIEWS::select_explorer_and_view {Window Explorer FinishOnSub} { #// ------------------------------------------------------------ #//::puts "::QW::GUI::NEWVIEWS::select_explorer_and_view \n\tWindow==[$Window odb_path] \n\tExplorer==[$Explorer odb_path] \n\tFinishOnSub==$FinishOnSub"; $Window windowSelect $Explorer; ::set Settings [::sargs::get [[[$Explorer tree] ".saved_settings"] odb_get] "/column_define"]; #//::puts "::QW::GUI::NEWVIEWS::select_explorer_and_view Settings==(\n[::sargs::format .structure [::sargs::get $Settings $FinishOnSub]]\n)"; ::set ColumnDefinitions [::sargs::get $Settings "$FinishOnSub.column_definitions"]; ::set ColumnNames [::sargs::get $Settings "$FinishOnSub.column_names"]; ::sargs::var::set Settings .current_sub $FinishOnSub; [[$Explorer tree] ".saved_settings"] odb_set [::sargs::+= [[[$Explorer tree] ".saved_settings"] qw_get] [::sargs "/column_define" $Settings]]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $ColumnNames; ::set Title [::sargs::get [[$Explorer ".frame.dressing.settings"] odb_get] ".title_text"]; #//::puts "::QW::GUI::NEWVIEWS::select_explorer_and_view Title==$Title"; ::if {[::string first "," $Title]>0} { ::set Title [::string range $Title 0 [::expr {[::string first "," $Title]-1}]]; } ::append Title ", [::sargs::get $Settings $FinishOnSub.name]"; #//::puts "::QW::GUI::NEWVIEWS::select_explorer_and_view Title==$Title"; [$Explorer ".frame.dressing.settings"] replace .title_text $Title; $Window window_titles; $Window odb_commit; } #nv2.23.00 (resume) - clean up creating and maintaining table views, too many copies of the same code (^QF "::set NewSub 0;::while") ::proc ::QW::GUI::NEWVIEWS::table_view_settings_create_single_tab_check {Window Settings} { /* { /view/install When these scripts run on a single view tab (i.e. no "+") the code was incomplete, so the original view is stomped and no "+" appears on the window tab Modeled "solution" after F11 New For the 4 payroll guys, there already is a user immutable "+" so it's not an issue More investigation needed as to exactly why this "solution" is necessary (when setup scripts run, they create several views and this doesn't come up?) Release version 23 and do with code cleanup ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account caseware_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account html_report_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account setup_account_aging_historic.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account ap 1099_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account ap t5_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account ap t4a_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews account ap t5018_list.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews payroll canada t4_list_basic_columns.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews payroll canada t4_list_all_columns.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews payroll canada t4a_list_basic_columns.qw_script] .odb.object %_odb_address]; ::qw::script::source [::sargs .script.path [::file join $::qw_library object newviews payroll canada t4a_list_all_columns.qw_script] .odb.object %_odb_address]; */} ::if {[::sargs::get $Settings .current_sub] eq ""} { ::if {![::sargs::exists $Settings "/default"]} { ::sargs::var::set Settings "/default.column_definitions" [[$Window .column_definitions] qw_get]; ::sargs::var::set Settings "/default.column_names" [[$Window .column_names] qw_get]; #nv2.15.0 or #nv2.14.5 - settings_activate_special # more needed ::sargs::var::set Settings "/default.name" "*** Default Settings ***"; } } ::return $Settings; } #nv2.23.00 ::proc ::QW::GUI::NEWVIEWS::pick_roots_list_format {s_args} { ::set PickAnchor [::sargs::get $s_args .pick_anchor]; ::set PickList [::sargs::get $s_args .pick_list]; ::set Result ""; ::set PickAnchorPath [::string tolower [$PickAnchor odb_path_help]]; ::foreach Root $PickList { #//::set PathHelp [::QW::GUI::NEWVIEWS::odb_path_help_format [::sargs .object $Root .format short_lower_case_folder]]; ::set PathHelp [::QW::GUI::NEWVIEWS::odb_path_help_format [::sargs .object $Root .format long_lower_case]]; ::lappend Result [::string map "${PickAnchorPath}/ {}" $PathHelp]; } ::return $Result; } # ------------------------------------------------------------ # ------------------------------------------------------------ ::proc ::QW::GUI::NEWVIEWS::setup_desktop_root_object {Window} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_desktop_root_object enter Window==[$Window odb_path]"; #::qw::stack_dump; ;#//pgq,debug #// ------------------------------------------------------------ #// ------------------------------------------------------------ # Address Information #// ------------------------------------------------------------ ::set Address [$Window windowNew "/menu/window/new/address_table"]; [$Address ".frame.dressing.settings"] replace .title_text "My Company Address/Info"; [$Address ".frame.dressing.isDisplayed"] odb_set 0; #20050410_help #//.title "Company Address Information" setup_help_id 8577200504161702 $Address; #// ------------------------------------------------------------ #// ------------------------------------------------------------ # Access/Audit #// ------------------------------------------------------------ ::set User [[$Window odb_database application] cpp_user_get]; ::if {$User ne ""} { #// ------------------------------------------------------------ # Access Froms #// ------------------------------------------------------------ ::set AccessView [[$User ".access_view"] odb_get]; ::if {$AccessView eq "yes"} { ::set AccessFroms [$Window windowNew "/menu/window/new/access_froms_closure"]; [$AccessFroms ".frame.dressing.settings"] replace .title_text "Access From"; [$AccessFroms ".frame.dressing.isDisplayed"] odb_set 0; [$AccessFroms ".restore_state"] odb_set "maximized"; } /* { #// ------------------------------------------------------------ # Audit #// ------------------------------------------------------------ ::set AuditView [[$User ".audit_view"] odb_get]; ::if {$AuditView eq "yes"} { ::set AuditTrail [$Window windowNew "/menu/window/new/audit_trail"]; [$AuditTrail ".frame.dressing.settings"] replace .title_text "Audit"; [$AuditTrail ".frame.dressing.isDisplayed"] odb_set 0; [$AuditTrail ".restore_state"] odb_set "maximized"; #::apdate; } */} } #// ------------------------------------------------------------ # Notes #// ------------------------------------------------------------ ::set Notes [$Window windowNew "/menu/window/new/notes"]; [$Notes ".frame.dressing.settings"] replace .title_text "Notes"; [$Notes ".frame.dressing.isDisplayed"] odb_set 0; [$Notes ".restore_state"] odb_set "maximized"; #// ------------------------------------------------------------ # Position on Address #// ------------------------------------------------------------ #//::if {$User ne "" && $AccessView eq "yes"} { #// $Window windowSelect $AccessFroms; #//} $Window windowSelect $Address; $Address activeCell "1,2"; #//::puts "20070411_111 ::QW::GUI::setup_desktop_root_object Window==[$Window odb_path] activeCell set 1,2"; ::return $Address; } # ------------------------------------------------------------ # NewViews odb_derived objects Table # ------------------------------------------------------------ ::proc ::QW::GUI::NEWVIEWS::setup_sub_list {Table} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_sub_list enter Table==[$Table odb_path]"; #::qw::stack_dump; ;#//pgq,debug ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; ::if {$Fman ne "List"} { ::lappend Result "/folder"; } ::lappend Result "/name"; ::lappend Result "/description"; #::lappend Result "/odb_base/odb_path_help"; #::lappend Result "/odb_base/description"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/name.script/title" "Name" \ "/name.width" "25" \ "/description.script/title" "Description" \ "/description.width" "45" \ "/odb_base/odb_path_help.script/title" "Folder" \ "/odb_base/odb_path_help.width" "40" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } # ------------------------------------------------------------ # Account Tables # ------------------------------------------------------------ ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_list {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::if {$Fman ne "List"} { ::lappend ColumnNames "/folder"; } ::lappend ColumnNames "/name_closure"; ::lappend ColumnNames "/description_closure"; #nv_209_02 ::set RangeA [$Table windowNew "/menu/window/new/range_amount"]; ::lappend ColumnNames $RangeA; ::lappend ColumnNames "/odb_base/odb_path_help_closure"; ::lappend ColumnNames "/odb_base/description"; ::lappend ColumnNames "/report/odb_path_help_closure"; ::lappend ColumnNames "/report/description"; [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; #::sargs::var::set ColumnDefinitions \ "/odb_path_backward.width" "25" \ "/odb_path_backward.script/title" "Account Path" \ "/odb_path_backward.script/command/get" {::return [::string map {/ACCOUNT/NEWVIEWS/OBJECT/ ""} [[%_object odb_master] odb_path_backward_readable]];} \ "/description_closure.script/title" "Description" \ "/report/name.script/title" "Report" \ ; ::sargs::var::set ColumnSetup \ "$RangeA.script/title" "Balance" \ "$RangeA.index_path" ".postings.index/date" \ "$RangeA.rb_name" ".amount" \ "$RangeA.range_begin" ".tag financial" \ "$RangeA.range_end" ".tag financial" \ "$Range.script/title" "Sub Accounts" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".odb_deriveds.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ "/folder.script/title" "Type" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ "/report/odb_path_help_closure.script/title" "Report" \ "/report/odb_path_help_closure.width" "20" \ "/report/description.script/title" "Report Description" \ "/report/description.width" "30" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_address {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Address"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/address/company"; ::lappend Result "/address/street"; ::lappend Result "/address/street2"; ::lappend Result "/address/city"; ::lappend Result "/address/state"; ::lappend Result "/address/zipcode"; ::lappend Result "/address/country"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/address/company.script/title" "Mail to" \ "/address/company.width" "40" \ ; #nv2.18.0 (added count of extra address_objects) #//::puts "pgq,debug218 Table==[$Table odb_path]"; ::switch -glob -- [$Table odb_path] { "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/AR/*" { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; #nv2.34.0 (nph_smarten_up) - account/ar setup_desktop.qw_script - show extra addresses #::set Ctitle [::expr {$::qw_sub_product eq "nph"?"History":"Extra"}]; #nv2.34.2 (npm) #::set Ctitle [::expr {$::qw_sub_product eq "nph"?"Address\nHistory Items":"Extra\nAddresses"}]; ::set Ctitle [::expr {$::qw_sub_product eq "nph"||$::qw_sub_product eq "npm"?"Address\nHistory Items":"Extra\nAddresses"}]; ::sargs::var::set ColumnSetup \ "$Range.script/title" $Ctitle \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".addresses.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; } } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; #[$Table ".column_names"] odb_set $Result; ::return $NewSub; } #nv2.18.0 (geographic_tax_codes) ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_address_ar {Table} { ::set NewSub [::QW::GUI::NEWVIEWS::setup_accounts_sub_address $Table]; ::set Result [[$Table ".column_names"] odb_get]; ::lappend Result "/trade_tax/1/rate"; ::lappend Result "/trade_tax/2/rate"; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } #nv2.16.0 ::if {$::qw::control(address_objects_is_enabled)} { ::proc ::QW::GUI::NEWVIEWS::setup_sub_address_all {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "All Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/account/odb_path_help"; ::lappend Result "/account/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/street"; ::lappend Result "/address/street2"; ::lappend Result "/address/city"; ::lappend Result "/address/state"; ::lappend Result "/address/zipcode"; ::lappend Result "/address/country"; ::lappend Result "/address/phone/freeform"; ::lappend Result "/address/phone/fax/freeform"; ::lappend Result "/address/email"; ::lappend Result "/address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/address/street2.width" "10" \ "/address/country.width" "10" \ "/account/odb_path_help.script/title" "Account" \ "/account/odb_path_help.width" "20" \ "/account/odb_path_help.format" "short_lower_case_folder" \ "/account/description.script/title" "Account Description" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_sub_address_all_no_account {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "All Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/street"; ::lappend Result "/address/street2"; ::lappend Result "/address/city"; ::lappend Result "/address/state"; ::lappend Result "/address/zipcode"; ::lappend Result "/address/country"; ::lappend Result "/address/phone/freeform"; ::lappend Result "/address/phone/fax/freeform"; ::lappend Result "/address/email"; ::lappend Result "/address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/address/street2.width" "10" \ "/address/country.width" "10" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_sub_address {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Mail Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/account/odb_path_help"; ::lappend Result "/account/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/street"; ::lappend Result "/address/street2"; ::lappend Result "/address/city"; ::lappend Result "/address/state"; ::lappend Result "/address/zipcode"; ::lappend Result "/address/country"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/address/street2.width" "10" \ "/address/country.width" "10" \ "/account/odb_path_help.script/title" "Account" \ "/account/odb_path_help.width" "20" \ "/account/odb_path_help.format" "short_lower_case_folder" \ "/account/description.script/title" "Account Description" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_sub_address_no_account {Table} { #//::puts "pgq,debug2340::QW::GUI::NEWVIEWS::setup_sub_address_no_account Table==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Mail Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/street"; ::lappend Result "/address/street2"; ::lappend Result "/address/city"; ::lappend Result "/address/state"; ::lappend Result "/address/zipcode"; ::lappend Result "/address/country"; #nv2.34.0 (nph_smarten_up) - account/ar setup_desktop.qw_script - show extra addresses ::if {$::qw_sub_product ne "nph"} { ;#// ::setup_sub_address_no_account - remove geographic_tax_codes #nv2.18.0 (geographic_tax_codes) ::lappend Result "/tax1_rate"; ::lappend Result "/tax2_rate"; } [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/address/street2.width" "10" \ "/address/country.width" "10" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; #[$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_sub_contact {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Contact Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/account/odb_path_help"; ::lappend Result "/account/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/phone/freeform"; ::lappend Result "/address/phone/fax/freeform"; ::lappend Result "/address/email"; ::lappend Result "/address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/account/odb_path_help.script/title" "Account" \ "/account/odb_path_help.width" "20" \ "/account/odb_path_help.format" "short_lower_case_folder" \ "/account/description.script/title" "Account Description" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_sub_contact_no_account {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Contact Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/company"; ::lappend Result "/address/phone/freeform"; ::lappend Result "/address/phone/fax/freeform"; ::lappend Result "/address/email"; ::lappend Result "/address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/description.width" "12" \ "/address/street2.width" "10" \ "/address/country.width" "10" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_address_desktop {Desktop} { #// ------------------------------------------------------------ # Address Information #// ------------------------------------------------------------ ::set Address [$Desktop windowNew "/menu/window/new/address_table"]; [$Address ".frame.dressing.settings"] replace .title_text "Address"; [$Address ".frame.dressing.isDisplayed"] odb_set 0; $Address activeCell "1,2"; #// ------------------------------------------------------------ # Audit Trail subwindow #// ------------------------------------------------------------ ::set User [[$Desktop odb_database application] cpp_user_get]; ::if {$User ne ""} { ::set AuditView [[$User ".audit_view"] odb_get]; ::if {$AuditView eq "yes"} { ::set AuditTrail [$Desktop windowNew "/menu/window/new/audit_trail"]; [$AuditTrail ".frame.dressing.settings"] replace .title_text "Audit"; [$AuditTrail ".frame.dressing.isDisplayed"] odb_set 0; [$AuditTrail ".restore_state"] odb_set "maximized"; } } #// ------------------------------------------------------------ # Notes #// ------------------------------------------------------------ ::set Notes [$Desktop windowNew "/menu/window/new/notes"]; [$Notes ".frame.dressing.settings"] replace .title_text "Notes"; [$Notes ".frame.dressing.isDisplayed"] odb_set 0; [$Notes ".restore_state"] odb_set "maximized"; #// ------------------------------------------------------------ # Position on Postings Explorer #// ------------------------------------------------------------ $Desktop windowSelect $Address; } } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_shipping_address {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Shipping Address"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/shipping_address/company"; ::lappend Result "/shipping_address/street"; ::lappend Result "/shipping_address/street2"; ::lappend Result "/shipping_address/city"; ::lappend Result "/shipping_address/state"; ::lappend Result "/shipping_address/zipcode"; ::lappend Result "/shipping_address/country"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/shipping_address/company.script/title" "Ship to" \ "/shipping_address/company.width" "40" \ ; #nv2.18.0 (added count of extra address_objects) #//::puts "pgq,debug218 Table==[$Table odb_path]"; ::switch -glob -- [$Table odb_path] { "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/AR/*" { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Extra\nAddresses" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".addresses.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; } } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; #[$Table ".column_names"] odb_set $Result; ::return $NewSub; } #nv2.18.0 (geographic_tax_codes) ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_shipping_address_ar {Table} { ::set NewSub [::QW::GUI::NEWVIEWS::setup_accounts_sub_shipping_address $Table]; ::set Result [[$Table ".column_names"] odb_get]; ::lappend Result "/trade_tax/1/rate"; ::lappend Result "/trade_tax/2/rate"; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_contact {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Contact Info"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/address/company"; ::lappend Result "/address/name/freeform"; ::lappend Result "/address/phone/freeform"; ::lappend Result "/address/phone/fax/freeform"; ::lappend Result "/address/email"; ::lappend Result "/address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/address/company.script/title" "Mail to" \ "/address/company.width" "40" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_shipping_contact {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Shipping Contact"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/shipping_address/company"; ::lappend Result "/shipping_address/name/freeform"; ::lappend Result "/shipping_address/phone/freeform"; ::lappend Result "/shipping_address/phone/fax/freeform"; ::lappend Result "/shipping_address/email"; ::lappend Result "/shipping_address/website"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_setup {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Setup"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Args ""; ::sargs::var::set Args .odb.object $Table; ::sargs::var::set Args .script.path [::file join $::qw_library object newviews account setup_setup.qw_script]; ::qw::script::source $Args; ::return $NewSub; } #nv2.21.0 (setup_with_totalto2_description) ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_setup_with_totalto2_description {s_args} { /* { added proc to be called from employee/canada employee/usa account/payroll added jrp amount column moved report/name to the end (and renamed to report/odb_path_help?) */} ::set Table [::sargs::get $s_args .table]; ::set Caller [::sargs::get $s_args .caller]; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Setup with Totalto2 Description"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/odb_base/odb_path_help"; ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; #::lappend ColumnNames "/line_type"; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "" \ "$Range.index_path" ".postings.index/date" \ "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ "$Range.rb_name" ".amount" \ "$Range.format" "dollar_minus_parentheses" \ "$Range.width" "18" \ ; ::lappend ColumnNames $Range; ::lappend ColumnNames "/normal_balance"; ::lappend ColumnNames "/normal_representation"; ::lappend ColumnNames "/active"; ::set ScriptBase { ::if {"%_object" eq ""} {::return "";} ::if {[[[%_object odb_master] ".odb_base"] odb_get] eq ""} {::return "";} ::if {[[[%_object odb_master] ".line_type"] odb_get] eq "text_line"} {::return "";} ::return [[[[%_object odb_master] ".odb_base"] odb_get] odb_master]; } ::sargs::var::set ColumnSetup \ "/odb_base.script/command/get" $ScriptBase \ "/odb_base/odb_path_help.script/title" "Folder" \ "/odb_base/odb_path_help.width" "20" \ "/odb_base/odb_path_help.format" "name_lower_case" \ ; /* { ::sargs::var::set ColumnSetup \ "/setup_column.script/title" "C" \ "/setup_column.justify" "right" \ "/setup_column.width" "2" \ ; ::sargs::var::set ColumnSetup \ "/underline.script/title" "U" \ "/underline.justify" "left" \ "/underline.width" "2" \ ; */} ::sargs::var::set ColumnSetup "/report/name.script/title" "Report"; #::lappend ColumnNames "/setup_column"; #::lappend ColumnNames "/underline"; ::lappend ColumnNames "/totalto1_account/name"; ::lappend ColumnNames "/totalto2_account/name"; ::lappend ColumnNames "/totalto2_account/description"; #::lappend ColumnNames "/report/odb_path_help"; ::lappend ColumnNames "/report/name"; #// ------------------------------------------------------------ ::switch $Caller { account_payroll_setup_desktop { } employee_usa_setup_desktop - employee_canada_setup_desktop { ::set ScriptAmount { ::return ""; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "T" \ "$Range.index_path" ".total.kids.index/name" \ "$Range.range_begin" "" \ "$Range.range_end" "" \ "$Range.rb_name" ".count" \ "$Range.format" "integer" \ "$Range.width" "4" \ "$Range.script/command/get/range_empty" $ScriptAmount \ ; ::lappend ColumnNames $Range; } } #// ------------------------------------------------------------ ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::+= $ColumnDefinitions $ColumnSetup]; #// # NOTICE #// For some reason, never investigated, the qw_set doesn't work... The numbers #// display zero in all columns, even though we follow with a column_names odb_set! #[$Table ".column_definitions"] qw_set $ColumnDefinitions; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $ColumnNames; ::return $NewSub; } #nv2.21.0 (horizontal paycodes) #::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_payroll_basic_paycodes_canada {s_args} {} ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_payroll_basic_paycodes {s_args} { ::set Table [::sargs::get $s_args .table]; ::set Caller [::sargs::get $s_args .caller]; #//::puts "pgq,debug221...setup_accounts_sub_payroll_basic_paycodes Table==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Setup - Basic Paycodes"; ::sargs::var::set Settings /$NewSub.tag "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/odb_base/odb_path_help"; ::switch $Caller { account_payroll_setup_desktop { ::lappend ColumnNames "/employee/employee_name"; } } ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "" \ "$Range.index_path" ".postings.index/date" \ "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ "$Range.rb_name" ".amount" \ "$Range.format" "dollar_minus_parentheses" \ "$Range.width" "18" \ ; ::lappend ColumnNames $Range; ::lappend ColumnNames "/normal_balance"; ::lappend ColumnNames "/paycodes/description"; ::lappend ColumnNames "/paycodes/type"; ::lappend ColumnNames "/paycodes/quantity"; ::lappend ColumnNames "/paycodes/rate"; ::lappend ColumnNames "/paycodes/percent"; ::lappend ColumnNames "/paycodes/percentage_base"; #::lappend ColumnNames "/paycodes/frequency"; ;#// not yet... ::lappend ColumnNames "/paycodes/annual_limit"; ::set ScriptBase { ::if {"%_object" eq ""} {::return "";} ::if {[[[%_object odb_master] ".odb_base"] odb_get] eq ""} {::return "";} ::if {[[[%_object odb_master] ".line_type"] odb_get] eq "text_line"} {::return "";} ::return [[[[%_object odb_master] ".odb_base"] odb_get] odb_master]; } ::sargs::var::set ColumnSetup \ "/odb_base.script/command/get" $ScriptBase \ "/odb_base/odb_path_help.script/title" "Folder" \ "/odb_base/odb_path_help.width" "20" \ "/odb_base/odb_path_help.format" "name_lower_case" \ "/paycodes/percent.justify" right \ "/paycodes/annual_limit.justify" right \ "/employee/employee_name.script/title" "Employee Name" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::+= $ColumnDefinitions $ColumnSetup]; #// # NOTICE #// For some reason, never investigated, the qw_set doesn't work... The numbers #// display zero in all columns, even though we follow with a column_names odb_set! #[$Table ".column_definitions"] qw_set $ColumnDefinitions; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $ColumnNames; ::return $NewSub; } #nv2.21.0 (horizontal paycodes) #::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_payroll_all_paycodes_canada {s_args} {} ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_payroll_all_paycodes {s_args} { ::set Table [::sargs::get $s_args .table]; ::set Caller [::sargs::get $s_args .caller]; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Setup - All Paycodes"; ::sargs::var::set Settings /$NewSub.tag "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/odb_base/odb_path_help"; ::switch $Caller { account_payroll_setup_desktop { ::lappend ColumnNames "/employee/employee_name"; } } ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "" \ "$Range.index_path" ".postings.index/date" \ "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ "$Range.rb_name" ".amount" \ "$Range.format" "dollar_minus_parentheses" \ "$Range.width" "18" \ ; ::lappend ColumnNames $Range; ::lappend ColumnNames "/normal_balance"; ::set Fnames { .description .type .quantity .rate .percent .percentage_base .annual_limit } ::switch [$Table odb_class_path] { /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/PAYROLL/CANADA { ::set Fnames [::concat $Fnames { .t4 .t4a .releve1 .tax .cpp .ei .quebec_tax .vacation_pay .hsf .ppip .wcb .wcb_per_hundred .insurable_hours .roe_period }]; } /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/PAYROLL/USA { ::set Fnames [::concat $Fnames { .w2 .1099 .federal_tax .state_tax1 .state_tax2 .local_tax1 .local_tax2 .social_security .medicare .futa .unemployment_insurance .sdi .vacation_pay }]; } } ::foreach Fname $Fnames { ::set Cname [::string map {. /} $Fname]; ::lappend ColumnNames "/paycodes$Cname"; } ::lappend ColumnNames "/name"; ;#// another copy of account name at the end is helpful ::set ScriptBase { ::if {"%_object" eq ""} {::return "";} ::if {[[[%_object odb_master] ".odb_base"] odb_get] eq ""} {::return "";} ::if {[[[%_object odb_master] ".line_type"] odb_get] eq "text_line"} {::return "";} ::return [[[[%_object odb_master] ".odb_base"] odb_get] odb_master]; } ::sargs::var::set ColumnSetup \ "/odb_base.script/command/get" $ScriptBase \ "/odb_base/odb_path_help.script/title" "Folder" \ "/odb_base/odb_path_help.width" "20" \ "/odb_base/odb_path_help.format" "name_lower_case" \ "/paycodes/percent.justify" right \ "/paycodes/annual_limit.justify" right \ "/employee/employee_name.script/title" "Employee Name" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::+= $ColumnDefinitions $ColumnSetup]; #// # NOTICE #// For some reason, never investigated, the qw_set doesn't work... The numbers #// display zero in all columns, even though we follow with a column_names odb_set! #[$Table ".column_definitions"] qw_set $ColumnDefinitions; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $ColumnNames; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_single_period {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Single Period Report"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Args ""; ::sargs::var::set Args .odb.object $Table; ::sargs::var::set Args .script.path [::file join $::qw_library object newviews account setup_indented.qw_script]; ::qw::script::source $Args; #20050410_help #//.title "Setting Up A Single Period Report" #setup_help_id 150220041129153140 $Table; ::return $NewSub; } #nv2.29.0 (new feature) - work_orders ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_maintenance {Table} { #//::puts "pgq,debugUI::QW::GUI::NEWVIEWS::setup_accounts_sub_maintenance enter Table==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Maintenance"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Args ""; ::sargs::var::set Args .odb.object $Table; ::sargs::var::set Args .script.path [::file join $::qw_library object newviews account setup_maintenance.qw_script]; ::qw::script::source $Args; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_multiple_period_analysis {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Multiple Period Analysis"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; #nv2.32.0 (nph dumb down) ::if {$::qw_sub_product ne "nph"} { ;#// setup_accounts_sub_multiple_period_analysis - remove folder column from mulitiple period analysis if it's /TABLE/NEWVIEWS/ACCOUNT/AR } ::if {$::qw_sub_product ne "nph" \ ||$::qw_sub_product eq "nph"&&[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/AR" [$Table odb_path]]!=0 \ } { ::lappend Result "/odb_base/odb_path_help_closure"; } ::if {[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT" [[$Table explorer_desktop] odb_path]]==0} { ::lappend Result "/name"; ::lappend Result "/description"; } else { ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; } [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".resolution"] odb_set "year" #20050410_help #//.title "Setting Up A Multiple Period Analysis" #setup_help_id 150220041129161055 $Table; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_menu_tree_arrange {s_args} { #nv2.19.0 #//::puts "pgq,debug219...menu_tree_arrange enter ========================="; /* { The blue account table >View>Analysis>New Column list is placed in a visually pleasing order. */} ::set MenuTree [::sargs::get $s_args .menu_tree]; ::set TrialBalance 0; ::if {[::sargs::get $MenuTree /menu/view/analysis/range_amount] ne ""} { #//::puts "pgq,debug219...menu_tree_arrange MenuTree /menu/view/analysis==(\n[::sargs::format .structure [::sargs::get $MenuTree /menu/view/analysis/range_amount]]\n)"; #//::puts "pgq,debug219...menu_tree_arrange TrialBalance=1"; ::set TrialBalance 1; } ::set Menu [::sargs::get $MenuTree /menu/view/analysis/new]; #//::puts "pgq,debug219...menu_tree_arrange Menu==(\n[::sargs::format .structure $Menu]\n)"; ::set Subs [::sargs::subs .structure $Menu]; ::set Item [::lsearch -glob $Subs /range_amount*]; ::set List ""; ::if {$Item>=0} { ::set Sub [::lindex $Subs $Item]; #//::puts "pgq,debug219...000 Sub==$Sub"; ::lappend List $Sub; ::set Nodes($Sub) [::sargs::get $Menu $Sub]; ::set Subs [::lreplace $Subs $Item $Item]; ;#// remove Item } ::lappend List /difference ::lappend List /sum ::lappend List /percent_change ::lappend List /percent_of ::lappend List /percent_of_account ::lappend List /a_minus_b ::lappend List /b_minus_a ::lappend List /b_monthly ::lappend List /foreign_currency_exchange_accounts ::array set Nodes {}; ::foreach Sub $Subs { #//::puts "pgq,debug219...000 foreach Sub==$Sub"; ::set Nodes($Sub) [::sargs::get $Menu $Sub]; ::sargs::var::unset MenuTree /menu/view/analysis/new$Sub; } #//::puts "pgq,debug219...array get Nodes==[::array get Nodes]"; ::foreach Sub $List { #//::puts "pgq,debug219...111 foreach Sub==$Sub"; ::if {[::info exists Nodes($Sub)]} { ::sargs::var::set MenuTree /menu/view/analysis/new$Sub $Nodes($Sub); } else { ::if {!$TrialBalance} { #//::puts "pgq,debug219...missing ---------------------------------------------------------- Sub==$Sub"; } } } ::return $MenuTree; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_menu_view_additional {Table} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_accounts_menu_view_additional Table odb_path==[$Table odb_path]"; #nv2.34.2 (npm) - &&$::qw_sub_product ne "npm" - _pgq,debug66 ;#// ::QW::GUI::NEWVIEWS::setup_accounts_menu_view_additional ::if {$::qw_sub_product eq "nph"} { ;#// ::setup_accounts_menu_view_additional - omit menu commands to add FX accounts columns ::return; } #nv2.19.0 $Table menuPost ".x 0 .y 0"; ::set MenuWindow [[$Table ".activeMenu"] odb_get]; #//::puts "20070215_000 MenuWindow odb_path==[$MenuWindow odb_path]"; ::set MenuTree [$MenuWindow tree]; #//::puts "20041107_01 MenuTree==\n[::sargs::format .structure $MenuTree]"; #::sargs::var::unset MenuTree "/menu/view/analysis"; ::set Result { /menu { /view { /analysis { /new { /foreign_currency_exchange_accounts { .script { /text {return "Foreign Exchange Accounts";} /command { %_odb_address windowNew "/foreign_currency_exchange_synchronize_account/odb_path_help"; %_odb_address windowNew "/foreign_currency_exchange_synchronize_account/description"; %_odb_address windowNew "/foreign_currency_exchange_gain_loss_account/odb_path_help"; %_odb_address windowNew "/foreign_currency_exchange_gain_loss_account/description"; } /underline {return 0;} } } } } } } } ::set Result [::string map "%_odb_address $Table" $Result]; ::sargs::var::+= MenuTree $Result; #nv2.19.0 ::set MenuTree [::QW::GUI::NEWVIEWS::setup_accounts_menu_tree_arrange [::sargs .menu_tree $MenuTree]]; $MenuWindow tree $MenuTree; #nv2.23.0 (resume_menu_withdraw) #$Table focusIn; ;#// i.e. cause menu to be unmapped (so it never appears) #$Table menuDismiss; #$MenuWindow odb_destroy; #[$MenuWindow .restore_state] odb_set "unmapped"; ::if {[[$MenuWindow .clipper.parent] odb_get] ne ""} { [$MenuWindow .clipper.parent] withdraw; } } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_custom_analysis {Table} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_accounts_sub_custom_analysis Table odb_path==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Custom Analysis"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; #nv2.32.0 (nph dumb down) ::if {$::qw_sub_product ne "nph"} { ;#// ::setup_accounts_sub_custom_analysis - remove folder column from custom analysis if it's /TABLE/NEWVIEWS/ACCOUNT/AR} ::if {$::qw_sub_product ne "nph" \ ||$::qw_sub_product eq "nph"&&[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT/AR" [$Table odb_path]]!=0 \ } { ::lappend Result "/odb_base/odb_path_help_closure"; } ::if {[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT" [[$Table explorer_desktop] odb_path]]==0} { ::lappend Result "/name"; ::lappend Result "/description"; } else { ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; } [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".resolution"] odb_set "none" #// $Table menuPost ".x 0 .y 0"; ::set MenuWindow [[$Table ".activeMenu"] odb_get]; #//::puts "20070215_000 MenuWindow odb_path==[$MenuWindow odb_path]"; ::set MenuTree [$MenuWindow tree]; #//::puts "20041107_01 MenuTree==\n[::sargs::format .structure $MenuTree]"; #::sargs::var::unset MenuTree "/menu/view/analysis"; ::set Result { /menu { /view { /analysis { .script { /text {return "Analysis";} /command "" } /new { .script { /text {return "New Column";} /command {} /underline {return 0;} } /range_amount { .script { /text {return "Amount";} /command {%_odb_address windowNew "/menu/window/new/range_amount"} /underline {return 0;} } } /difference { .script { /text {return "Difference";} /command { ::qw::script::source \ [::sargs \ .script.path [::file join $::qw_library object newviews account setup_difference.qw_script] \ .odb.object %_odb_address \ .value_or_percent "value" \ ]; } /underline {return 0;} } } /sum { .script { /text {return "Sum";} /command { ::qw::script::source \ [::sargs \ .script.path [::file join $::qw_library object newviews account setup_difference.qw_script] \ .odb.object %_odb_address \ .value_or_percent "value_sum" \ ]; } /underline {return 0;} } } /percent_change { .script { /text {return "Percent Change";} /command { ::qw::script::source \ [::sargs \ .script.path [::file join $::qw_library object newviews account setup_difference.qw_script] \ .odb.object %_odb_address \ .value_or_percent "percent_change" \ ]; } /underline {return 0;} } } /percent_of { .script { /text {return "Percent Of";} /command { ::qw::script::source \ [::sargs \ .script.path [::file join $::qw_library object newviews account setup_difference.qw_script] \ .odb.object %_odb_address \ .value_or_percent "percent_of" \ ]; } /underline {return 1;} } } /percent_of_account { .script { /text {return "Percent Of Account";} /command { ::qw::script::source \ [::sargs \ .script.path [::file join $::qw_library object newviews account setup_difference.qw_script] \ .odb.object %_odb_address \ .value_or_percent "percent_of_account" \ ]; } /underline {return 2;} } } } } } } } /* { */} ::set Result [::string map "%_odb_address $Table" $Result]; ::sargs::var::+= MenuTree $Result; #nv2.19.0 ::set MenuTree [::QW::GUI::NEWVIEWS::setup_accounts_menu_tree_arrange [::sargs .menu_tree $MenuTree]]; $MenuWindow tree $MenuTree; #nv2.23.0 (resume_menu_withdraw) # $Table focusIn; ;#// i.e. cause menu to be unmapped (so it never appears) #$Table menuDismiss; #$MenuWindow odb_destroy; #[$MenuWindow .restore_state] odb_set "unmapped"; ::if {[[$MenuWindow .clipper.parent] odb_get] ne ""} { [$MenuWindow .clipper.parent] withdraw; } #20050410_help #//.title "Setting Up A Custom Analysis" #setup_help_id 150220041129161204 $Table; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_budget {Table} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_accounts_sub_budget Table odb_path==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Budget"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::if {[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT" [[$Table explorer_desktop] odb_path]]==0} { ::lappend Result "/name"; ::lappend Result "/description"; } else { ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; } [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::set s_args ""; ::sargs::var::set s_args .script.path [::file join $::qw_library object newviews account setupana_budget.qw_script]; ::sargs::var::set s_args .odb.object $Table; ::sargs::var::set s_args .type "actual_minus_budget"; ::qw::script::source $s_args; $Table menuPost ".x 0 .y 0"; ::set MenuWindow [[$Table ".activeMenu"] odb_get]; ::set MenuTree [$MenuWindow tree]; #//::puts "20041107_01 MenuTree==\n[::sargs::format .structure $MenuTree]"; #::sargs::var::unset MenuTree "/menu/view/analysis"; #nv2.17.0 (budget monthly) ::set Result { /menu { /view { /analysis { .script { /text {return "Analysis";} /command "" } /new { .script { /text {return "New Column";} /command {} } /a_minus_b { .script { /text {return "Actual Minus Budget";} /command { ::sargs::var::set s_args .script.path [::file join $::qw_library object newviews account setupana_budget.qw_script]; ::sargs::var::set s_args .odb.object %_odb_address; ::sargs::var::set s_args .type "actual_minus_budget"; ::qw::script::source $s_args; } } } /b_minus_a { .script { /text {return "Budget Minus Actual";} /command { ::sargs::var::set s_args .script.path [::file join $::qw_library object newviews account setupana_budget.qw_script]; ::sargs::var::set s_args .odb.object %_odb_address; ::sargs::var::set s_args .type "budget_minus_actual"; ::qw::script::source $s_args; } } } /b_monthly { .script { /text {return "Budget Monthly";} /command { ::sargs::var::set s_args .script.path [::file join $::qw_library object newviews account setupana_budget.qw_script]; ::sargs::var::set s_args .odb.object %_odb_address; ::sargs::var::set s_args .type "budget_monthly"; ::qw::script::source $s_args; } } } } } } } } ::set Result [::string map "%_odb_address $Table" $Result]; ::sargs::var::+= MenuTree $Result; #nv2.19.0 ::set MenuTree [::QW::GUI::NEWVIEWS::setup_accounts_menu_tree_arrange [::sargs .menu_tree $MenuTree]]; $MenuWindow tree $MenuTree; #nv2.23.0 (resume_menu_withdraw) # $Table focusIn; ;#// i.e. cause menu to be unmapped (so it never appears) #$Table menuDismiss; #$MenuWindow odb_destroy; #[$MenuWindow .restore_state] odb_set "unmapped"; ::if {[[$MenuWindow .clipper.parent] odb_get] ne ""} { [$MenuWindow .clipper.parent] withdraw; } ::return $NewSub; } #nv2.28.0 (new feature) -nph - Budget Input view of /ACCOUNT/EXPENSE and /ACCOUNT/SALES ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_budget_input {Table} { #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::setup_accounts_sub_budget Table odb_path==[$Table odb_path]"; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Budget Input"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; #::lappend Result "/odb_base/odb_path_help_closure"; ::if {[::string first "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT" [[$Table explorer_desktop] odb_path]]==0} { ::lappend Result "/name"; ::lappend Result "/description"; } else { ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; } ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Begin: %_begin\nEnd: %_end\nTag: %_tag" \ "$Range.index_path" ".postings.index/date" \ "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ "$Range.rb_name" ".amount" \ "$Range.format" "dollar_minus_parentheses" \ "$Range.width" "15" \ ; ::lappend Result $Range; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; [$Table ".column_names"] odb_set $Result; ::set s_args ""; ::sargs::var::set s_args .script.path [::file join $::qw_library object newviews account setupana_budget.qw_script]; ::sargs::var::set s_args .odb.object $Table; ::sargs::var::set s_args .type "budget_monthly"; ::sargs::var::set s_args .title "Begin: %_begin\nEnd: %_end\nBudget Input"; ::qw::script::source $s_args; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_accounts_sub_aging {Table Title Tag} { #// ------------------------------------------------------------ # Invoice Aging #// ------------------------------------------------------------ ::set Settings [::sargs::get [[[$Explorer tree] ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Invoice Aging"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [[$Explorer tree] ".saved_settings"] odb_set [::sargs::set [[[$Explorer tree] ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Args ""; ::sargs::var::set Args .odb.object [$Explorer tree]; ::sargs::var::set Args .script.path [::file join $::qw_library object newviews account setup_account_aging.qw_script]; ::qw::script::source $Args; ::return $NewSub; #// ------------------------------------------------------------ # Order Aging #// ------------------------------------------------------------ ::set Settings [::sargs::get [[[$Explorer tree] ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Order Aging"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [[$Explorer tree] ".saved_settings"] odb_set [::sargs::set [[[$Explorer tree] ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Args ""; ::sargs::var::set Args .odb.object [$Explorer tree]; ::sargs::var::set Args .script.path [::file join $::qw_library object newviews account setup_account_aging_orders.qw_script]; ::qw::script::source $Args; } # ------------------------------------------------------------ # Journal Tables # ------------------------------------------------------------ ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_list {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; ::if {$Fman ne "List"} { ::lappend Result "/folder"; } ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/odb_base/description"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::set Range1 [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Transactions" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range1.script/title" "Sub Journals" \ "$Range1.script/command/get/range_empty" "::return {}" \ "$Range1.index_path" ".odb_deriveds.index/id" \ "$Range1.rb_name" ".count" \ "$Range1.format" "integer_minus_trailing" \ "$Range1.width" "13" \ "$Range1.justify" "right" \ "/folder.script/title" "Type" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "40" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_settings {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_settings s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_settings Table==$Table"; #// ------------------------------------------------------------ # Journals Settings Information #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/folder"; ;#//#nv2.17.0 ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; ::lappend Result "/active"; #nv2.33.0 (new feature) - transaction_date_range_check_is_enabled ::lappend Result "/date_range_check_is_enabled"; ::lappend Result "/unique_transaction_references"; ;#//#nv2.14.0 ::lappend Result "/transactions_collection_is_enabled"; ;#//#nv2.15.0 ::lappend Result "/tags"; #nv2.37.0 (allocation_tags) - ::QW::GUI::NEWVIEWS::setup_journals_sub_settings - create tab for PURCHASE for unit inspections ::if {$::qw_sub_product ne "nph" \ ||$::qw_sub_product eq "nph"&&$::qw::control(nvnph_unit_inspections_private_setup_desktop) \ } { ;#// ::setup_journals_sub_settings - remove columns for Allocation Tags and Inactive Allocation Tags ::lappend Result "/tags_allocation"; ;#//#nv2.17.0 ::lappend Result "/tags_allocation_inactive"; ;#//#nv2.17.0 } ::lappend Result "/next_reference"; #nv2.34.0 ::if {1||$::qw_sub_product ne "nph"} { ;#// ::setup_journals_sub_settings - unconditionally add 2 columns for Next Ref#, Unqiue Reference - add column /move_to_journal for /PURCHASE* and /SALES* #nv2.21.0 (move_to_journal) ::lappend Result "/next_reference1"; ::lappend Result "/unique_transaction_references1"; ;#//#nv2.21.0 #nv2.23.0 (bug fix) - /move_to_journal column appeared blank and undefined on journal settings view of non /PURCHASE and /SALES ::switch -glob -- [$Table odb_path] { /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/JOURNAL/PURCHASE* - /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/JOURNAL/SALES* { ::lappend Result "/move_to_journal/odb_path_help"; } } } [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "40" \ "/tags.width" "30" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Transactions" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ ; #nv2.17.0 ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Sub\nJournals" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".odb_deriveds.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_proof {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof Table==$Table"; ::set DisplayOption [::sargs::get $s_args ".display_option"]; #// ------------------------------------------------------------ # Journals Proof Information #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "40" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; # "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ ; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Transactions" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ ; ::if {$DisplayOption ne "quantities_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Amount Proof" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; } ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Quantity Proof" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting.quantity" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_proof_purchase {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof Table==$Table"; ::set DisplayOption [::sargs::get $s_args ".display_option"]; #// ------------------------------------------------------------ # Journals Proof Information PURCHASE #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; #// Create a unique path ::set NewSub 0; ::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; # "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ ; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Items" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "8" \ ; ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nCharge Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/charge.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nCharge Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/charge.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nTax1 Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/tax1.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nTax2 Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/tax2.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nAmount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Amount Proof" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_proof_sales {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof Table==$Table"; ::set DisplayOption [::sargs::get $s_args ".display_option"]; #// ------------------------------------------------------------ # Journals Proof Information SALES #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; # "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ ; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Items" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "8" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nCustomer Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/customer.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::if {$::qw_sub_product ne "nph"} { ;#// ::setup_journals_sub_proof_sales - remove /debit/cgs.amount and /debit.amount ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nCGS Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/cgs.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nAmount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; } ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nCharge Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/charge.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nCharge Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/charge.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nInventory Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/inventory.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::if {$::qw_sub_product ne "nph"} { ;#// ::setup_journals_sub_proof_sales - remove /credit/inventory.amount ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nInventory Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/inventory.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nTax1 Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/tax1.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nTax2 Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/tax2.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nAmount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Amount Proof" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::if {$::qw::control(donor_management_is_enabled)} { ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_proof_donation {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof Table==$Table"; ::set DisplayOption [::sargs::get $s_args ".display_option"]; #// ------------------------------------------------------------ # Journals Proof Information DONATION #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; # "$Range.range_begin" ".tag financial" \ "$Range.range_end" ".tag financial" \ ; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Items" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "8" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nBank Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/bank.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nDonor Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit/donor.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Debit\nAmount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/debit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nDonor Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/donor.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nDonor Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/donor.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::if {$DisplayOption ne "amounts_only"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nRevenue Quantity" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/revenue.quantity" \ "$Range.format" "none" \ "$Range.width" "17" \ ; } ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nRevenue Amount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit/charge.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Credit\nAmount" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting/credit.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Amount Proof" \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" ".posting.amount" \ "$Range.format" "dollar_minus_trailing" \ "$Range.width" "17" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } } ::proc ::QW::GUI::NEWVIEWS::setup_journals_sub_proof_payroll_canada {s_args} { #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof s_args==\n[::sargs::format .structure $s_args]"; ::set Table [::sargs::get $s_args ".table"]; #//::puts "20070409_000 ::QW::GUI::NEWVIEWS::setup_journals_sub_proof Table==$Table"; ::set DisplayOption [::sargs::get $s_args ".display_option"]; #// ------------------------------------------------------------ # Journals Proof Information #// ------------------------------------------------------------ ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name [::sargs::get $s_args ".title"]; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; #[$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ ; #pgq_???_??? #nv2.21.0 (CSST EHT WCB) #nv2.38.0 (CPP2) - NOT - /EMPLOYEE/CANADA - ::QW::GUI::NEWVIEWS::setup_journals_sub_proof_payroll_canada - add /new/range_amount for .cpp_pensionable_earnings # "CPP2\nEarnings" .cpp2_pensionable_earnings "dollar_minus_trailing" ::set Columns { "CPP\nEarnings" .cpp_pensionable_earnings "dollar_minus_trailing" \ "CPP\nExemption" .cpp_exemption "dollar_minus_trailing" \ "EI\nEarnings" .ei_insurable_earnings "dollar_minus_trailing" \ "EI\nHours" .ei_insurable_hours "none" \ "EHT/HSF\n/HAPSET\nEarnings" .hsf_earnings "dollar_minus_trailing" \ "WCB/CSST\nEarnings" .wcb_earnings "dollar_minus_trailing" \ "PPIP\nEarnings" .ppip_insurable_earnings "dollar_minus_trailing" \ "Benefit 1" .non_cash_taxable_benefits/1.amount "dollar_minus_trailing" \ "Benefit 2" .non_cash_taxable_benefits/2.amount "dollar_minus_trailing" \ "Benefit 3" .non_cash_taxable_benefits/3.amount "dollar_minus_trailing" \ "Benefit 4" .non_cash_taxable_benefits/4.amount "dollar_minus_trailing" \ } ::foreach {Title Rbname Format} $Columns { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" $Title \ "$Range.index_path" ".transactions.index/id" \ "$Range.rb_name" $Rbname \ "$Range.format" $Format \ "$Range.width" "12" \ ; } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_journals_access_audit {s_args} { #//::puts "::QW::GUI::NEWVIEWS::setup_journals_access_audit s_args==$s_args"; #::if {$::qw_sub_product eq "nph"} {::return;} ::set Window [::sargs::get $s_args ".odb.object"]; ::set Manager [$Window odb_database]; ::if {![$Window odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/JOURNAL"]]} { ::qw::throw [::sargs \ .text "The setup_journals_access_audit must be run from a journal desktop." \ .help_id 0 \ ]; } ::set User [[$Window odb_database application] cpp_user_get]; ::if {$User eq ""} { ::return void; } #// #::set AccessWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/ACCESS"] odb_access_closure [::sargs .user $User]] ne ""}]; #::set AuditWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/AUDIT"] odb_access_closure [::sargs .user $User]] ne ""}]; ::set AccessWindow [::expr {[[$User ".access_view"] odb_get] eq "yes"}]; ::set AuditWindow [::expr {[[$User ".audit_view"] odb_get] eq "yes"}]; #// ::if {!$AuditWindow&&!$AccessWindow} { ::return ""; } ::set Explorer [$Window windowNew "/menu/window/new/deriveds/collection_explorer"]; #//::puts "::QW::GUI::NEWVIEWS::setup_journals_access_audit Explorer==[$Explorer odb_path]"; #[$Explorer ".frame.dressing.settings"] replace .title_text "Vendor Audit"; #[$Explorer ".frame.dressing.isDisplayed"] odb_set 0; [$Explorer desktop] explorerDepth "/OBJECT/NEWVIEWS/JOURNAL"; [[$Explorer tree] ".observer_index"] odb_set ".index/name_closure"; [[$Explorer tree] ".restore_state"] odb_set "maximized"; ::if {[[$Explorer tree] observer_database] ne ""} { ::if {[[[$Explorer tree] observer_database] odb_items]} { [$Explorer tree] activeCell "1,0"; } } #//::puts "::QW::GUI::NEWVIEWS::setup_journals_access_audit Explorer desktop explorerDepth==[[$Explorer desktop] explorerDepth]"; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/odb_id.script/title" "Address" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "40" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "25" \ "/odb_base/odb_path_help_closure.format" "long" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set Result ""; ::lappend Result "/line"; #::lappend Result "/folder"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/odb_id"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; #::lappend Result "/odb_base/description"; #nv2.22.0 (access/audit item counts) #//::puts "pgq,debug218 Table==[$Table odb_path]"; /* { ::set Range [[$Explorer tree] windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Access\nObjects" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".access_froms.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; */} #nv2.22.0 (access/audit item counts) ::set Sargs [::QW::GUI::NEWVIEWS::patch_access_from_helper [::sargs .cnames $Result .cdefs $ColumnSetup]]; ::set ColumnSetup [::sargs::get $Sargs .cdefs]; ::set Result [::sargs::get $Sargs .cnames]; ::set ColumnDefinitions [[[$Explorer tree] ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $Result; /* { ::set RangeIndex [$Manager "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; #// #//::puts "20041227_001 explorer_desktop==[[explorer_desktop] odb_path] explorer_desktop observer_database==[[explorer_desktop] observer_database]"; #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/ACCOUNT/AP/1104187129_1079 explorer_desktop observer_database==::qw::odb::20041223165713::/1103839035_607 #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/SYSTEM/AUDIT/1104162438_580 explorer_desktop observer_database== #// # NOTICE big time! #// For some reason, never investigated, we are getting whacked twice and #// the first time the observer is empty ... #// ::if {[[explorer_desktop] observer_database] ne ""} { ::set ObjectId [[[explorer_desktop] observer_database] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; } else { #// # AND #// At this point, any dribble for the range define (that guarantees empty) will do. #::set ObjectId [[observer_database] odb_id]; ::set ObjectId "whatever"; #//::puts "20050106_000 observer_database==[[observer_database] odb_path] ObjectId==$ObjectId"; ::set RangeBegin ".address $ObjectId"; ::set RangeEnd ".address $ObjectId"; } */} /* { ::set AuditItems [$Table windowNew "/menu/window/new/formula"]; ::set Script { ::set Range ::set RangeIndex [[[%_object odb_master] odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [[%_object odb_master] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; $Range cpp_configure -index $RangeIndex -begin $RangeBegin -end $RangeEnd; } ::set Script [::string map "%_qtyOnHand $QtyOnHand %_netQtyOrdered $NetQtyOrdered" $Script]; ::sargs::var::set ColumnSetup \ "$AuditItems.script/title" "Audit Items" \ "$AuditItems.script/command/get" $Script \ "$Column.format" "integer_minus_trailing" \ "$Column.width" "12" \ ; */} #// ------------------------------------------------------------ # Access Froms subwindow #// ------------------------------------------------------------ ::if {$AccessWindow} { ::set AccessFroms [[$Explorer desktop] windowNew "/menu/window/new/access_froms_closure"]; [$AccessFroms ".frame.dressing.settings"] replace .title_text "Access From"; [$AccessFroms ".frame.dressing.isDisplayed"] odb_set 0; [$AccessFroms ".restore_state"] odb_set "maximized"; } #// ------------------------------------------------------------ # Audit Trail subwindow #// ------------------------------------------------------------ ::if {$AuditWindow} { ::set AuditTrail [[$Explorer desktop] windowNew "/menu/window/new/audit_trail"]; [$AuditTrail ".frame.dressing.settings"] replace .title_text "Audit"; [$AuditTrail ".frame.dressing.isDisplayed"] odb_set 0; [$AuditTrail ".restore_state"] odb_set "maximized"; } ::if {$AccessWindow&&$AuditWindow} { ::set Title "Access/Audit"; [$Explorer desktop] windowSelect $AccessFroms; } else { ::if {$AccessWindow} { ::set Title "Access"; } else { ::set Title "Audit"; } } [$Explorer ".frame.dressing.settings"] replace .title_text $Title; [$Explorer ".frame.dressing.isDisplayed"] odb_set 0; [[$Explorer tree] ".restore_state"] odb_set "restored"; ::return $Explorer; } #nv2.23.0 (performance improvement) - transaction_count_this_journal_low_level ::proc ::QW::GUI::NEWVIEWS::setup_allocation_tags_sub_views {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Basic Columns"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/active"; [$Table ".column_names"] odb_set $Result; ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Transaction Item Counts"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result ""; ::lappend Result "/line"; ::lappend Result "/name"; ::lappend Result "/description"; ::lappend Result "/active"; ::lappend Result "/transaction_count_this_journal"; ::lappend Result "/transaction_count_all_journals"; [$Table ".column_names"] odb_set $Result; ::return $NewSub; } # ------------------------------------------------------------ # Reports Tables # ------------------------------------------------------------ ::proc ::QW::GUI::NEWVIEWS::setup_reports_sub_list {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set Result "" ::lappend Result "/line"; ::if {$Fman ne "List"} { ::lappend Result "/folder"; } ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/odb_base/description"; [$Table ".column_names"] odb_set $Result; ::set ColumnSetup ""; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::set Range1 [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Accounts" \ "$Range.index_path" ".accounts.index/interactive" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range1.script/title" "Sub Reports" \ "$Range1.script/command/get/range_empty" "::return {}" \ "$Range1.index_path" ".odb_deriveds.index/id" \ "$Range1.rb_name" ".count" \ "$Range1.format" "integer_minus_trailing" \ "$Range1.width" "13" \ "$Range1.justify" "right" \ "/folder.script/title" "Type" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "40" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::NEWVIEWS::setup_reports_access_audit {s_args} { #::if {$::qw_sub_product eq "nph"} {::return;} ::set Window [::sargs::get $s_args ".odb.object"]; ::set Manager [$Window odb_database]; ::if {![$Window odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/REPORT"]]} { ::qw::throw [::sargs \ .text "The setup_reports_access_audit must be run from a report desktop." \ .help_id 0 \ ]; } ::set User [[$Window odb_database application] cpp_user_get]; ::if {$User eq ""} {::return void;} #// #::set AccessWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/ACCESS"] odb_access_closure [::sargs .user $User]] ne ""}]; #::set AuditWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/AUDIT"] odb_access_closure [::sargs .user $User]] ne ""}]; ::set AccessWindow [::expr {[[$User ".access_view"] odb_get] eq "yes"}]; ::set AuditWindow [::expr {[[$User ".audit_view"] odb_get] eq "yes"}]; #// ::if {!$AuditWindow&&!$AccessWindow} { ::return ""; } ::set Explorer [$Window windowNew "/menu/window/new/deriveds/collection_explorer"]; #nv2.23.00 [$Explorer desktop] explorerDepth "/OBJECT/NEWVIEWS/REPORT"; [[$Explorer tree] ".observer_index"] odb_set ".index/name_closure"; [[$Explorer tree] ".restore_state"] odb_set "maximized"; ::if {[[$Explorer tree] observer_database] ne ""} { ::if {[[[$Explorer tree] observer_database] odb_items]} { [$Explorer tree] activeCell "1,0"; } } ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/odb_id.script/title" "Address" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "40" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "25" \ "/odb_base/odb_path_help_closure.format" "long" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set Result ""; ::lappend Result "/line"; #::lappend Result "/folder"; ::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/odb_id"; ::lappend Result "/name_closure"; ::lappend Result "/description_closure"; #::lappend Result "/odb_base/description"; #nv2.22.0 (access/audit item counts) ::set Sargs [::QW::GUI::NEWVIEWS::patch_access_from_helper [::sargs .cnames $Result .cdefs $ColumnSetup]]; ::set ColumnSetup [::sargs::get $Sargs .cdefs]; ::set Result [::sargs::get $Sargs .cnames]; ::set ColumnDefinitions [[[$Explorer tree] ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $Result; /* { ::set RangeIndex [$Manager "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; #// #//::puts "20041227_001 explorer_desktop==[[explorer_desktop] odb_path] explorer_desktop observer_database==[[explorer_desktop] observer_database]"; #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/ACCOUNT/AP/1104187129_1079 explorer_desktop observer_database==::qw::odb::20041223165713::/1103839035_607 #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/SYSTEM/AUDIT/1104162438_580 explorer_desktop observer_database== #// # NOTICE big time! #// For some reason, never investigated, we are getting whacked twice and #// the first time the observer is empty ... #// ::if {[[explorer_desktop] observer_database] ne ""} { ::set ObjectId [[[explorer_desktop] observer_database] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; } else { #// # AND #// At this point, any dribble for the range define (that guarantees empty) will do. #::set ObjectId [[observer_database] odb_id]; ::set ObjectId "whatever"; #//::puts "20050106_000 observer_database==[[observer_database] odb_path] ObjectId==$ObjectId"; ::set RangeBegin ".address $ObjectId"; ::set RangeEnd ".address $ObjectId"; } */} /* { ::set AuditItems [$Table windowNew "/menu/window/new/formula"]; ::set Script { ::set Range ::set RangeIndex [[[%_object odb_master] odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [[%_object odb_master] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; $Range cpp_configure -index $RangeIndex -begin $RangeBegin -end $RangeEnd; } ::set Script [::string map "%_qtyOnHand $QtyOnHand %_netQtyOrdered $NetQtyOrdered" $Script]; ::sargs::var::set ColumnSetup \ "$AuditItems.script/title" "Audit Items" \ "$AuditItems.script/command/get" $Script \ "$Column.format" "integer_minus_trailing" \ "$Column.width" "12" \ ; */} #// ------------------------------------------------------------ # Access Froms subwindow #// ------------------------------------------------------------ ::if {$AccessWindow} { ::set AccessFroms [[$Explorer desktop] windowNew "/menu/window/new/access_froms_closure"]; [$AccessFroms ".frame.dressing.settings"] replace .title_text "Access From"; [$AccessFroms ".frame.dressing.isDisplayed"] odb_set 0; [$AccessFroms ".restore_state"] odb_set "maximized"; } #// ------------------------------------------------------------ # Audit Trail subwindow #// ------------------------------------------------------------ ::if {$AuditWindow} { ::set AuditTrail [[$Explorer desktop] windowNew "/menu/window/new/audit_trail"]; [$AuditTrail ".frame.dressing.settings"] replace .title_text "Audit"; [$AuditTrail ".frame.dressing.isDisplayed"] odb_set 0; [$AuditTrail ".restore_state"] odb_set "maximized"; } ::if {$AccessWindow&&$AuditWindow} { ::set Title "Access/Audit"; [$Explorer desktop] windowSelect $AccessFroms; } else { ::if {$AccessWindow} { ::set Title "Access"; } else { ::set Title "Audit"; } } [$Explorer ".frame.dressing.settings"] replace .title_text $Title; [$Explorer ".frame.dressing.isDisplayed"] odb_set 0; [[$Explorer tree] ".restore_state"] odb_set "restored"; #//::puts "pgq,debug223.00...::QW::GUI::NEWVIEWS::setup_reports_access_audit exit"; ::return $Explorer; } #)-------------------------------------------------------------------------- /* {20060421_build_change (settings_prompt_fix) ::return "/apply"; ::return "/consolidation_analysis"; ::return "/prtaccts"; ::return "/prtpay"; ::return "/print_statements"; # from ACCOUNT ::return "/print_invoices"; ::return "/print_checks"; ::return "/print_ap_checks"; # from TRANSACTION ::return "/print_invoices"; ::return "/print_checks"; ::return "/print_ap_checks"; ::return "/pay_withholdings"; ::return "/payroll_report"; ::return "/print_t4s"; ::return "/print_releve1s"; ::return "/print_roes"; ::return "/print_w2s"; */} ::if {$::qw::control(payroll_t4_summary)} { # need a new case for /print_t4_summary (blending /print_t4s and /pay_withholdings_canada) } /* { public method default_settings {} { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTACCTS ::set Result { .postings_order "date" .debit_is_hit "yes" .credit_is_hit "yes" .open_is_hit "yes" .closed_is_hit "yes" .tag "financial" .periodic_begin_date "" .range_begin "" .range_end "" .include_empty_accounts "yes" .respect_normal_representation "yes" .print_distributions "no" .total_account_option "ledger" .account_title "|%_name - %_description\\n|%_begin - %_end" .account_separator "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /account/name /journal/name /date /reference /description /amount_debit /amount_credit /amount /running_balance_amount /cross_account/name /reconcile } }; ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Result ".periodic_begin_date" "${Year}0101" ::sargs::var::set Result ".range_begin" "${Year}0101" ::sargs::var::set Result ".range_end" "${Year}1231" #// # NOTICE #// No default template, since template use is optional #// ::return $Result; } */} /* { public method default_settings {} { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTACCTS ::set Result { .index "ledger" .periodic_begin_date "" .range_begin "" .range_end "" .respect_normal_representation "yes" .tag "" .print_distributions "no" .print_empty_accounts "no" .account_separator "page" .account_title "|%_name - %_description\\n|%_begin - %_end" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /journal/name /date /reference /description /amount /running_balance_amount /cross_account/name /reconcile } }; ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Result ".range_begin" "${Year}0101" ::sargs::var::set Result ".range_end" "${Year}1231" #// # NOTICE #// No default template, since template use is optional #// ::return $Result; } */ } ::proc ::QW::GUI::NEWVIEWS::settings_prompt_default_settings {Object SettingsPath} { #nv2.20.0 (bug) - Object is empty - BUT a grep suggests it's only a bug for the ::puts #//::puts "pgq,debug222.0::QW::GUI::NEWVIEWS::settings_prompt_default_settings Object==[$Object odb_path] SettingsPath==$SettingsPath"; #//::puts "pgq,debug222.0::QW::GUI::NEWVIEWS::settings_prompt_default_settings Object==$Object SettingsPath==$SettingsPath"; #//settings_prompt_default_settings Object==/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/SYSTEM/TRANSACTION/SALES/1182360738_3032 SettingsPath==/print_invoices #nv2.27.0 (print accounts open view) ::switch -exact -- $SettingsPath { "/table_print_account_html" { # NOTICE - NOT called - moved to "in-line" like /table_print - pgq really needs to sort out the location of all defaults ::return { .title { /1 { .text "" } /2 { .text "" } /3 { .text "" } } .print_titles "yes" .print_zero_accounts "no" .filename "" .template "" .template_style_sheet "" .print_columns "3" .sort_by_column_number "2" .sort_by_order "descending" .currency_symbol_characters "$" .zero_amount_characters "-" .destination "file" }; } "/prtaccts_simple" { ::return [::QW::GUI::NEWVIEWS::settings_prompt_default_settings "" "/prtaccts"]; } "/prtaccts" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTACCTS #.account_title "|%_name - %_description\\n|%_begin - %_end" #nv2.28.0 (new feature) - Print Account Ledgers - .print_boomerangs boolean ::set Result { .postings_order "date" .debit_is_hit "yes" .credit_is_hit "yes" .open_is_hit "yes" .closed_is_hit "yes" .tag "financial" .periodic_begin_date "" .range_begin "" .range_end "" .include_closed_balance "all_closed" .historic_aging "no" .include_empty_accounts "yes" .total_account_option "ledger" .print_boomerangs "yes" .print_distributions "no" .print_distributions_sort_by "date" .print_distributions_summarize "no" .print_distributions_summarize_folder_list "" .print_distributions_flows_analysis "no" .print_distributions_flows_sort_by "amount_descending" .account_title_1 "|%_name - %_description" .account_title_2 "|%_begin - %_end" .account_title_3 "" .account_title_4 "" .account_separator "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /account/odb_path_help /journal/odb_path_help /date /reference /description /amount_debit /amount_credit /amount /running_balance_amount /cross_account/odb_path_help /cross_account/description /reconcile } .respect_normal_representation "yes" }; ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Result ".periodic_begin_date" "${Year}0101" ::sargs::var::set Result ".range_begin" "${Year}0101" ::sargs::var::set Result ".range_end" "${Year}1231" #// # NOTICE #// No default template, since template use is optional #// ::return $Result; } "/prtaccts_open_view" { #.account_title "|%_name - %_description\n|Reconcile - Open View\n|Prepared: %_today" ::set Result { .postings_order "date" .debit_is_hit "yes" .credit_is_hit "yes" .open_is_hit "yes" .closed_is_hit "no" .tag "financial" .periodic_begin_date "" .range_begin "" .range_end "" .include_closed_balance "all_closed" .historic_aging "no" .include_empty_accounts "yes" .total_account_option "ledger" .print_distributions "no" .print_distributions_sort_by "date" .print_distributions_summarize "no" .print_distributions_summarize_folder_list "" .print_distributions_flows_analysis "no" .print_distributions_flows_sort_by "amount_descending" .account_title_1 "|%_name - %_description" .account_title_2 "|Reconcile - Open View" .account_title_3 "|Prepared: %_today" .account_title_4 "" .account_separator "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /date /journal/odb_path_help /reference /description /amount /running_balance_amount } .respect_normal_representation "yes" }; ::return $Result; } "/prtaccts_requisition" { #nv2.27.1c (change) - kirk wanted change to /prtaccts_requisition default prompt settings #.account_title "Cheque Requisition - %_description\nApproved by: ______________________________ Amount: ____________________\nPrepared %_today by: ______________________________" #nv2.34.0 (requisition) - replaced .column_names #//{/date /journal/odb_path_help /reference /description /posting/charge/account/odb_path_help /posting/charge/account/description /posting/charge/amount /posting/tax1/amount /amount /running_balance_amount} ::set Result { .postings_order "date" .debit_is_hit "yes" .credit_is_hit "yes" .open_is_hit "yes" .closed_is_hit "no" .tag "financial" .periodic_begin_date "" .range_begin "" .range_end "" .include_closed_balance "all_closed" .historic_aging "no" .include_empty_accounts "no" .total_account_option "ledger" .print_distributions "yes" .print_distributions_sort_by "date" .print_distributions_summarize "no" .print_distributions_summarize_folder_list "" .print_distributions_flows_analysis "no" .print_distributions_flows_sort_by "amount_descending" .account_title_1 "Cheque Requisition - %_description" .account_title_2 "Prepared %_today by: ______________________________ Amount: ____________________" .account_title_3 "Approved by: ______________________________ Approved by: ______________________________" .account_title_4 "" .account_separator "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /date /reference /description /posting/charge/account/name /posting/charge/account/description /posting/charge/amount /posting/tax1/amount /amount /running_balance_amount } .respect_normal_representation "yes" }; ::return $Result; } "/prtjournals" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTJOURNALS #.account_title "|%_name - %_description\\n|%_begin - %_end" ::set Result { .tag "financial" .range_begin "" .range_end "" .include_empty_accounts "yes" .account_title_1 "|%_name - %_description" .account_title_2 "|%_begin - %_end" .account_title_3 "" .account_title_4 "" .account_separator "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide 1 .scaling {} .orientation "landscape" .template "" .column_names { /journal/odb_path_help /date /reference /description } }; ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Result ".range_begin" "${Year}0101" ::sargs::var::set Result ".range_end" "${Year}1231" # NOTICE #// No default template, since template use is optional ::return $Result; } "/prtjournals_transaction" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTJOURNALS #.account_title "|%_name - %_description\\n|%_begin - %_end" ::set Result { .account_title_1 "|%_name - %_description" .account_title_2 "" .account_title_3 "" .account_title_4 "" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" .column_names { /journal/odb_path_help /date /reference /description } }; # NOTICE #// No default template, since template use is optional ::return $Result; } "/foreign_currency_exchange_synchronize" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/FOREIGN_CURRENCY_EXCHANGE_SYNCHRONIZE ::set Result { .exchange_rate_source_type "report_notes" .exchange_rate_source_file "" .synchronize_journal "" .post_zero_amounts "yes" }; ::return $Result } /transaction_create_invoice { #nv2.21.0 (backorder) #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/TRANSACTION_CREATE_INVOICE ::set Result { .move_to_journal "" .invoice_date "" .invoice_reference "" .backorder_journal "" .preserve_item_count "yes" }; ::return $Result; } /account_sales_cgs_refresh { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/ACCOUNT_SALES_CGS_REFRESH ::set Result { .tag "financial" .begin_date "" .end_date "" .close_enough 0.0 }; ::return $Result; } "/apply" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/APPLY ::return { .holdInvoiceIndicatorText "*HOLD*" .applyPartialPayments "yes" .reconcileErrorAction "warning" .applyMethod "fifo" .confirmEachApplication "yes" .discountAccount "" .discountJournal "" }; } "/charge_interest_daily" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/CHARGE_INTEREST/DAILY ::set Result { .charge_date "" .last_charge_date "" .interest_account "" .interest_journal "" .posting_description "Interest" .method "simple" .interest_identifier "INTEREST" .charge_for_full_age "yes" .use_separate_journal_entries "no" }; ::set Today [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".charge_date" $Today; ::sargs::var::set Result ".last_charge_date" [::qw::date::add $Today month -1]; ::return $Result } "/consolidation_analysis" { #nv2.28.3 (experiment) - can we trick CONSOLIDATION_ANALYSIS to produce a column for every account folder seen instead of every report seen? - added .account_folder #nv2.28.4 (new feature) - consolidation_analysis - budget and variance columns for every report - added .print_budget_column_detail #nv2.29.0 () ::set Result { .index "ledger" .range_begin "" .range_end "" .tag "financial" .title { /1 { .text "" } /2 { .text "" } /3 { .text "" } } .account_folder "" .title_source "name" .id_columns "name description" .column_width "15" .print_zero_accounts "no" .print_zero_columns "no" .print_budget_column "none" .print_budget_column_detail "none" .destination "display" .filename "" .printer "" .fit_to_pages_wide "" .scaling 100 .orientation "portrait" .template "" }; ::if {!$::qw::control(consolidation_by_account_folder_is_enabled)} { ::sargs::var::unset Result .account_folder; } ::return $Result; } "/pay_withholdings" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS #nv2.21.0 (CSST EHT WCB) - TABLE/NOTES/PROCEDURE ::set Result { .check_date "" .check_number "" .withholdings_start_date "" .withholdings_end_date "" .payee "" .bank_journal "" .bank_account "" .withholding { /1 { .description "" .accrued { .text "" .account "" } .remitted { .text "" .account "" } } /2 { .description "" .accrued { .text "" .account "" } .remitted { .text "" .account "" } } /3 { .description "" .accrued { .text "" .account "" } .remitted { .text "" .account "" } } /4 { .description "" .accrued { .text "" .account "" } .remitted { .text "" .account "" } } /5 { .description "" .accrued { .text "" .account "" } .remitted { .text "" .account "" } } } }; ::sargs::var::set Result ".check_date" [::clock format [::clock seconds] -format "%Y%m%d"]; ::return $Result } "/pay_withholdings/canada" - "/pay_withholdings_canada" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS/CANADA ::set Result { .check_date "" .check_number "" .withholdings_start_date "" .withholdings_end_date "" .payee "" .bank_journal "" .bank_account "" .withholding { /1 { .description "Employee EI Remitted" .accrued { .text "Employee EI Withheld Account" .account "" } .remitted { .text "Employee EI Remitted Account" .account "" } } /2 { .description "Employer EI Remitted" .accrued { .text "Employer EI Accrued Account" .account "" } .remitted { .text "Employer EI Remitted Account" .account "" } } /3 { .description "Employee CPP Remitted" .accrued { .text "Employee CPP/QPP Withheld Account" .account "" } .remitted { .text "Employee CPP/QPP Remitted Account" .account "" } } /4 { .description "Employer CPP Remitted" .accrued { .text "Employer CPP/QPP Accrued Account" .account "" } .remitted { .text "Employer CPP/QPP Remitted Account" .account "" } } /5 { .description "Income Tax Remitted" .accrued { .text "Employee Tax Withheld Account" .account "" } .remitted { .text "Employee Tax Remitted Account" .account "" } } /6 { .description "EHT/HAPSET/HSF Remitted" .accrued { .text "Employer EHT/HAPSET/HSF Accrued Account" .account "" } .remitted { .text "Employer EHT/HAPSET/HSF Remitted Account" .account "" } } /7 { .description "WCB/CSST Remitted" .accrued { .text "Employer WCB/CSST Accrued Account" .account "" } .remitted { .text "Employer WCB/CSST Remitted Account" .account "" } } } }; #nv2.38.0 (CPP2) - /TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS/CANADA - settings_prompt_default_settings ::sargs::var::+= Result { .withholding { /8 { .description "Employee CPP2 Remitted" .accrued { .text "Employee CPP2/QPP2 Withheld Account" .account "" } .remitted { .text "Employee CPP2/QPP2 Remitted Account" .account "" } } /9 { .description "Employer CPP2 Remitted" .accrued { .text "Employer CPP2/QPP2 Accrued Account" .account "" } .remitted { .text "Employer CPP2/QPP2 Remitted Account" .account "" } } } } ::sargs::var::set Result ".check_date" [::clock format [::clock seconds] -format "%Y%m%d"]; ::return $Result } "/pay_withholdings/usa" - "/pay_withholdings_usa" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS/USA ::set Result { .check_date "" .check_number "" .withholdings_start_date "" .withholdings_end_date "" .payee "" .bank_journal "" .bank_account "" .withholding { /1 { .description "Employee S.S. Remitted" .accrued { .text "Employee S.S. Withheld Account" .account "" } .remitted { .text "Employee S.S. Remitted Account" .account "" } } /2 { .description "Employer S.S. Remitted" .accrued { .text "Employer S.S. Accrued Account" .account "" } .remitted { .text "Employer S.S. Remitted Account" .account "" } } /3 { .description "Employee Medicare Remitted" .accrued { .text "Employee Medicare Withheld Account" .account "" } .remitted { .text "Employee Medicare Remitted Account" .account "" } } /4 { .description "Employer Medicare Remitted" .accrued { .text "Employer Medicare Accrued Account" .account "" } .remitted { .text "Employer Medicare Remitted Account" .account "" } } /5 { .description "Federal Income Tax Remitted" .accrued { .text "Employee Tax Withheld Account" .account "" } .remitted { .text "Employee Tax Remitted Account" .account "" } } /6 { .description "Employer FUTA Remitted" .accrued { .text "Employer FUTA Accrued Account" .account "" } .remitted { .text "Employer FUTA Remitted Account" .account "" } } } }; ::sargs::var::set Result ".check_date" [::clock format [::clock seconds] -format "%Y%m%d"]; ::return $Result; } "/payroll_report" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_REPORT ::set Result { .begin_date "" .end_date "" .title "Payroll Report" .detail "detail" .include_all_employees "yes" .template "" .destination "display" .filename "" .printer "" }; ::set Search "payroll"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } ::return $Result; } "/payroll_report_paychecks" { #nv2.23.0 (kirk) - split payroll_report prompt #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_REPORT ::set Result { .begin_date "" .end_date "" .title "Payroll Report" .detail "paycheck" .include_all_employees "yes" .template "" .destination "display" .filename "" .printer "" }; ::set Search "payroll"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } ::return $Result; } "/print_ap_checks" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_AP_CHECKS ::set Result { .copies "1" .template "" .destination "printer" .filename "" .printer "" .ocr_date_format {} .asterisk_amount_format {} .text_amount_format {} .currency_symbol {$} .currency_name {dollar} .currency_fraction_name {cent} .email_status "" .email_setup "" .email_from "" .email_reply_to "" .email_archive_list "" .email_subject "No Subject" .email_message "" .email_log_file "" }; ::set Search "check_ap"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } ::return $Result } "/print_checks" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_CHECKS ::set Result { .copies "1" .template "" .destination "printer" .filename "" .printer "" .ocr_date_format {} .asterisk_amount_format {} .text_amount_format {} .currency_symbol {$} .currency_name {dollar} .currency_fraction_name {cent} .eft_status {inactive} .email_status "" .email_setup "" .email_from "" .email_reply_to "" .email_archive_list "" .email_subject "No Subject" .email_message "" .email_log_file "" }; ::set TemplatePath [::file join $::qw_data object newviews]; ::set Templates [::glob -nocomplain $TemplatePath/*.xls]; ;#*/ ::foreach {Search Exclude} { {check} {check_ap} } { ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::if {$Exclude ne ""&&[::string first $Exclude [::file tail $Template]]>=0} { ::continue; } ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } } ::return $Result; } "/print_invoices" { #nv2.16.0 (pdf) #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_INVOICES ::set Result { .copies "1" .template "" .destination "printer" .filename "" .printer "" .email_status "" .email_setup "" .email_from "" .email_reply_to "" .email_archive_list "" .email_subject "No Subject" .email_message "" .email_log_file "" }; ::set Search "invoice"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } ::return $Result; } "/print_releve1s" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_RELEVE1S ::set Result { .copies "1" .forms_per_page "3" .account_number "" .employers_name "" .employers_address_1 "" .employers_address_2 "" .employers_address_3 "" .template "" .destination "printer" .filename "" .printer "" }; #// (T4s) ::sargs::var::set Result ".business_number" [[[[[[[$this .owner.parent] odb_get] odb_master] observer_database] odb_master] ".cra_account_number"] odb_get]; # ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::sargs::var::set Result ".employers_name" [[$Source ".company"] odb_get]; ::array set AddressArray {}; ::foreach Field {street street2 city state country zipcode} { ::set AddressArray($Field) [::string trim [[$Source ".$Field"] odb_get]]; } ::set Address ""; ::if {$AddressArray(street) ne ""} {::lappend Address $AddressArray(street);} ::if {$AddressArray(street2) ne ""} {::lappend Address $AddressArray(street2);} ::set Line3 ""; ::if {$AddressArray(city) ne ""} {::append Line3 "$AddressArray(city), ";} ::if {$AddressArray(state) ne ""} {::append Line3 "$AddressArray(state) ";} ::if {$AddressArray(zipcode) ne ""} {::append Line3 $AddressArray(zipcode);} ::lappend Address $Line3; ::for {::set i 0;::set j 1;} {$i<3} {::incr i;::incr j;} { ::sargs::var::set Result ".employers_address_$j" [::string trim [::lindex $Address $i]]; } ::set Year [::clock format [::clock seconds] -format %Y]; ::set TemplateFileName [::file join $::qw_data object newviews RELEVE1-$Year.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } ::return $Result; } "/print_roes" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_ROES ::set Result { .copies "1" .template "" .destination "printer" .filename "" .printer "" }; ::set TemplateFileName [::file join $::qw_data object newviews ROE-INS-2106-03-01E.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } ::return $Result; } "/print_statements" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_STATEMENTS ::set Result { .statement_date "" .skip_zero "yes" .message_1 "Thank you for your business" .message_2 "" .message_3 "" .message_4 "" .days_1 "30" .days_2 "60" .days_3 "90" .template "" .destination "" .filename "" .printer "" .email_status "" .email_setup "" .email_from "" .email_reply_to "" .email_archive_list "" .email_subject "No Subject" .email_message "" .email_log_file "" }; ::sargs::var::set Result ".statement_date" [::clock format [::clock seconds] -format "%Y%m%d"]; ::set Search "statement"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } ::return $Result; } "/print_t4s" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4S ::set Result { .cra_setup "*** Default Settings ***" .for_the_year_ending "" .copies "1" .forms_per_page "2" .template "" .destination "display" .filename "" .printer "" }; #//::puts "pgq,debug222.0.../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4S Object observer_database odb_path==[[$Object observer_database] odb_path]"; #//.../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4S Object observer_database odb_path==/OBJECT/NEWVIEWS/PAYROLL/CANADA.employees.index/employee_name #::sargs::var::set Result ".business_number" [[$Object ".cra_account_number"] odb_get]; #209_209_convert #::set Payroll [[$Object observer_database] odb_master]; #::sargs::var::set Result ".business_number" [[$Payroll ".cra_account_number"] odb_get]; # ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; /* { ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::sargs::var::set Result ".employers_name" [[$Source ".company"] odb_get]; ::array set AddressArray {}; ::foreach Field {street street2 city state country zipcode} { ::set AddressArray($Field) [::string trim [[$Source ".$Field"] odb_get]]; } ::set Address ""; ::if {$AddressArray(street) ne ""} {::lappend Address $AddressArray(street);} ::if {$AddressArray(street2) ne ""} {::lappend Address $AddressArray(street2);} ::set Line3 ""; ::if {$AddressArray(city) ne ""} {::append Line3 "$AddressArray(city), ";} ::if {$AddressArray(state) ne ""} {::append Line3 "$AddressArray(state) ";} ::if {$AddressArray(zipcode) ne ""} {::append Line3 $AddressArray(zipcode);} ::lappend Address $Line3; ::for {::set i 0;::set j 1;} {$i<3} {::incr i;::incr j;} { ::sargs::var::set Result ".employers_address_$j" [::string trim [::lindex $Address $i]]; } */} ::set TemplateFileName [::file join $::qw_data object newviews t4_${Year}_gray_pdf.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } ::return $Result; } "/print_t4_summary" { #//::puts "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4_SUMMARY /print_t4_summary"; ::set Result { .cra_setup "*** Default Settings ***" .date_prepared "" .preparer_position "" .summary_year_end_date "" .begin_remittance_date "" .end_remittance_date "" .withholding "" .template "" .destination "display" .filename "" .printer "" }; ::set Today [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".date_prepared" $Today; #// ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".summary_year_end_date" $YearEnd; ::set TemplateFileName [::file join $::qw_data object newviews T4_${Year}_summary_preview.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #// # WOW //Poach from the defaults of print_t4s, assuming it has run first. #// /* { ::set Print_t4s [::QW::GUI::NEWVIEWS::settings_prompt_default_settings $Object "/print_t4s"]; ::sargs::var::set Result ".employers_name" [::sargs::get $Print_t4s ".employers_name"]; ::for {::set i 0;::set j 1;} {$i<3} {::incr i;::incr j;} { ::sargs::var::set Result ".employers_address_$j" [::sargs::get $Print_t4s ".employers_address_$j"]; } */} #// # WOW //Poach from the defaults of pay_withholdings_canada #// ::set Paywith [::QW::GUI::NEWVIEWS::settings_prompt_default_settings $Object "/pay_withholdings_canada"]; ::sargs::var::set Result ".withholding" [::sargs::get $Paywith ".withholding"]; #// # AND //defaulted values from currently active, for this user, PAY_WITHHOLDING settings #// #//::set Settings [[[odb_database application] "/OBJECT/NEWVIEWS/PAYROLL/CANADA.settings_prompt"] qw_get]; #//::puts ".../PAYROLL/CANADA .settings_prompt qw_get==(\n[::sargs::format .structure $Settings]\n)"; ::set Settings [[[$Object odb_database application] "/OBJECT/NEWVIEWS/PAYROLL/CANADA.settings_prompt"] odb_get]; #//::puts ".../PAYROLL/CANADA .settings_prompt odb_get==(\n[::sargs::format .structure $Settings]\n)"; ::set PaySettings ""; ::set ControlWindow [[$Object settings_prompt_control_window "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/PAYROLL/CANADA"] ".client"]; #//::puts ".../PAYROLL/CANADA ControlWindow==$ControlWindow"; ::set PayWindow [[$ControlWindow ".active_pay_withholdings_settings"] odb_get]; #//::puts ".../PAYROLL/CANADA PayWindow==$PayWindow"; ::if {$PayWindow ne "" \ &&[[$Object odb_database] cpp_find_from_address $PayWindow] ne "" \ } { #//::puts ".../PAYROLL/CANADA PayWindow==[$PayWindow odb_path]"; #//.../PAYROLL/CANADA PayWindow==/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS/CANADA/1202250619_5488 #//::puts ".../PAYROLL/CANADA PayWindow .clientdata odb_get==(\n[::sargs::format .structure [[$PayWindow .clientdata] odb_get]]\n)"; ::set Paysub [::sargs::get [[$PayWindow .clientdata] odb_get] ".current_sub"]; #//::puts "Paysub==$Paysub"; ::if {$Paysub eq ""} { ::set Paysub "/current"; } ::set PaySettings [::sargs::get $Settings "/pay_withholdings_canada$Paysub"]; } ::if {$PaySettings eq ""} { ::foreach Sub [::sargs::subs .structure [::sargs::get $Settings "/pay_withholdings_canada"]] { ::if {[::sargs::get $Settings "/pay_withholdings_canada$Sub.values.withholding/1.accrued.account"] ne ""} { ::set PaySettings [::sargs::get $Settings "/pay_withholdings_canada$Sub"]; ::break; } } } #//::puts ".../PAYROLL/CANADA PaySettings==(\n[::sargs::format .structure $PaySettings]\n)"; ::for {::set j 1;} {$j<=5} {::incr j;} { /* { ::sargs::var::set Result ".withholding/$j.accrued.account" [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]; ::sargs::var::set Result ".withholding/$j.remitted.account" [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]; */} ::if {[::sargs::get $PaySettings ".values.withholding/$j.accrued.account"] ne ""} { ::if {[[$Object odb_database application] cpp_find_from_address [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]] ne ""} { ::sargs::var::set Result ".withholding/$j.accrued.account" [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]; } } ::if {[::sargs::get $PaySettings ".values.withholding/$j.remitted.account"] ne ""} { ::if {[[$Object odb_database application] cpp_find_from_address [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]] ne ""} { ::sargs::var::set Result ".withholding/$j.remitted.account" [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]; } } } #//::puts ".../print_t4_summary Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_t4a" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A ::set Result { .cra_setup "*** Default Settings ***" .for_the_year_ending "" .tag "financial" .copies "1" .forms_per_page "2" .template "" .destination "display" .filename "" .printer "" }; #//::puts ".../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A Object observer_database odb_path==[[$Object observer_database] odb_path]"; #//.../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A Object observer_database odb_path==/OBJECT/NEWVIEWS/PAYROLL/CANADA.employees.index/employee_name ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; ::set TemplateFileName [::file join $::qw_data object newviews T4A_${Year}_slip_front.xls]; #//::puts "pgq,debug220.../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A TemplateFileName==$TemplateFileName"; #//.../TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A TemplateFileName==d:/nv/nv2.dat/object/newviews/T4A_2010_slip_front.xls ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } ::return $Result; } "/print_t4a_summary" { #//::puts "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_T4A_SUMMARY /print_t4a_summary"; ::set Result { .cra_setup "*** Default Settings ***" .date_prepared "" .preparer_position "" .summary_year_end_date "" .begin_remittance_date "" .end_remittance_date "" .tag "financial" .withholding "" .template "" .destination "display" .filename "" .printer "" }; ::set Today [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".date_prepared" $Today; #// ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".summary_year_end_date" $YearEnd; #// ::set TemplateFileName [::file join $::qw_data object newviews T4A_${Year}_Summary_front.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #// # WOW //Poach from the defaults of pay_withholdings_canada #// ::set Paywith [::QW::GUI::NEWVIEWS::settings_prompt_default_settings $Object "/pay_withholdings_canada"]; ::sargs::var::set Result ".withholding" [::sargs::get $Paywith ".withholding"]; #//::puts "pgq,debug220.../print_t4a_summary poach Result==(\n[::sargs::format .structure $Result]\n)"; ::for {::set j 1;} {$j<=4} {::incr j;} { ::sargs::var::unset Result .withholding/$j; } #//::puts "pgq,debug220.../print_t4a_summary poach & pruned Result==(\n[::sargs::format .structure $Result]\n)"; #// # AND //defaulted values from currently active, for this user, PAY_WITHHOLDING settings #// #//::set Settings [[[odb_database application] "/OBJECT/NEWVIEWS/PAYROLL/CANADA.settings_prompt"] qw_get]; #//::puts ".../PAYROLL/CANADA .settings_prompt qw_get==(\n[::sargs::format .structure $Settings]\n)"; ::set Settings [[[$Object odb_database application] "/OBJECT/NEWVIEWS/PAYROLL/CANADA.settings_prompt"] odb_get]; #//::puts ".../PAYROLL/CANADA .settings_prompt odb_get==(\n[::sargs::format .structure $Settings]\n)"; ::set PaySettings ""; ::set ControlWindow [[$Object settings_prompt_control_window "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/PAYROLL/CANADA"] ".client"]; #//::puts ".../PAYROLL/CANADA ControlWindow==$ControlWindow"; ::set PayWindow [[$ControlWindow ".active_pay_withholdings_settings"] odb_get]; #//::puts ".../PAYROLL/CANADA PayWindow==$PayWindow"; ::if {$PayWindow ne "" \ &&[[$Object odb_database] cpp_find_from_address $PayWindow] ne "" \ } { #//::puts ".../PAYROLL/CANADA PayWindow==[$PayWindow odb_path]"; #//.../PAYROLL/CANADA PayWindow==/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PAYROLL_PAY_WITHHOLDINGS/CANADA/1202250619_5488 #//::puts ".../PAYROLL/CANADA PayWindow .clientdata odb_get==(\n[::sargs::format .structure [[$PayWindow .clientdata] odb_get]]\n)"; ::set Paysub [::sargs::get [[$PayWindow .clientdata] odb_get] ".current_sub"]; #//::puts "Paysub==$Paysub"; ::if {$Paysub eq ""} { ::set Paysub "/current"; } ::set PaySettings [::sargs::get $Settings "/pay_withholdings_canada$Paysub"]; } ::if {$PaySettings eq ""} { ::foreach Sub [::sargs::subs .structure [::sargs::get $Settings "/pay_withholdings_canada"]] { ::if {[::sargs::get $Settings "/pay_withholdings_canada$Sub.values.withholding/1.accrued.account"] ne ""} { ::set PaySettings [::sargs::get $Settings "/pay_withholdings_canada$Sub"]; ::break; } } } #//::puts ".../PAYROLL/CANADA PaySettings==(\n[::sargs::format .structure $PaySettings]\n)"; # start at 5 and copy only the income tax pair ::for {::set j 5;} {$j<=5} {::incr j;} { /* { ::sargs::var::set Result ".withholding/$j.accrued.account" [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]; ::sargs::var::set Result ".withholding/$j.remitted.account" [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]; */} ::if {[::sargs::get $PaySettings ".values.withholding/$j.accrued.account"] ne ""} { ::if {[[$Object odb_database application] cpp_find_from_address [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]] ne ""} { ::sargs::var::set Result ".withholding/$j.accrued.account" [::sargs::get $PaySettings ".values.withholding/$j.accrued.account"]; } } ::if {[::sargs::get $PaySettings ".values.withholding/$j.remitted.account"] ne ""} { ::if {[[$Object odb_database application] cpp_find_from_address [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]] ne ""} { ::sargs::var::set Result ".withholding/$j.remitted.account" [::sargs::get $PaySettings ".values.withholding/$j.remitted.account"]; } } } #//::puts "pgq,debug220.../print_t4a_summary return Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/cra_setup" { #//::puts "pgq,debug220/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/CRA_SETUP /cra_setup"; ::set Result { .business_number "" .pension_plan_registration_number "" .filers_name "" .filers_street "" .filers_street2 "" .filers_city "" .filers_state "" .filers_country "" .filers_zipcode "" .proprietor_1_sin "" .proprietor_2_sin "" .filers_contact_name "" .filers_phone_area_code "" .filers_phone_number "" .filers_phone_extension "" .filers_email "" }; #nv2.38.3 (payroll) - /NOTES/PROCEDURE/CRA_SETUP /cra_setup - ::QW::XML::CRA::xml_cra_file_header /* { .transmitter_number .submission_reference_id .report_type .transmitter_type .language .transmitter_name_1 .transmitter_name_2 .transmitter_street_1 .transmitter_street_2 .transmitter_city .transmitter_state .transmitter_country .transmitter_zipcode .transmitter_contact_name .transmitter_phone_area_code .transmitter_phone_number .transmitter_phone_extension .transmitter_email .transmitter_name .transmitter_account_number_type .transmitter_account_number .transmitter_rep_id */} ::sargs::var::set Result ".report_type" "original"; ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::set SourcePhone ""; ::if {[[$Source .phone.prefix] odb_get] ne ""&&[[$Source .phone.suffix] odb_get] ne ""} { ::set SourcePhone "[[$Source .phone.prefix] odb_get]-[[$Source .phone.suffix] odb_get]"; } ::sargs::var::set Result ".filers_name" [[$Source ".company"] odb_get]; ::sargs::var::set Result ".filers_street" [[$Source ".street"] odb_get]; ::sargs::var::set Result ".filers_street2" [[$Source ".street2"] odb_get]; ::sargs::var::set Result ".filers_city" [[$Source ".city"] odb_get]; ::sargs::var::set Result ".filers_state" [[$Source ".state"] odb_get]; ::sargs::var::set Result ".filers_country" [[$Source ".country"] odb_get]; ::sargs::var::set Result ".filers_zipcode" [[$Source ".zipcode"] odb_get]; ::sargs::var::set Result ".filers_phone_area_code" [[$Source ".phone.area_code"] odb_get]; ::sargs::var::set Result ".filers_phone_number" $SourcePhone; ::sargs::var::set Result ".filers_phone_extension" [[$Source ".phone.extension"] odb_get]; ::sargs::var::set Result ".filers_email" [[$Source ".email"] odb_get]; #nv2.38.3 (payroll) - /NOTES/PROCEDURE/CRA_SETUP /cra_setup - ::QW::XML::CRA::xml_cra_file_header ::sargs::var::set Result ".transmitter_name" [[$Source ".company"] odb_get]; ::sargs::var::set Result ".transmitter_account_number_type" {}; ::sargs::var::set Result ".transmitter_account_number" {}; #::sargs::var::set Result ".transmitter_account_number" [[$Payroll ".cra_account_number"] odb_get]; ;#//::append Result [xml_data "B5" $RoeData ".employer.5_business_number" 15]; ::sargs::var::set Result ".transmitter_rep_id" {}; ::sargs::var::set Result ".transmitter_name_1" [[$Source ".company"] odb_get]; ::sargs::var::set Result ".transmitter_street_1" [[$Source ".street"] odb_get]; ::sargs::var::set Result ".transmitter_street_2" [[$Source ".street2"] odb_get]; ::sargs::var::set Result ".transmitter_city" [[$Source ".city"] odb_get]; ::sargs::var::set Result ".transmitter_state" [[$Source ".state"] odb_get]; ::sargs::var::set Result ".transmitter_country" [[$Source ".country"] odb_get]; ::sargs::var::set Result ".transmitter_zipcode" [[$Source ".zipcode"] odb_get]; ::sargs::var::set Result ".transmitter_phone_area_code" [[$Source ".phone.area_code"] odb_get]; ::sargs::var::set Result ".transmitter_phone_number" $SourcePhone; ::sargs::var::set Result ".transmitter_phone_extension" [[$Source ".phone.extension"] odb_get]; ::sargs::var::set Result ".transmitter_email" [[$Source ".email"] odb_get]; #//::puts "pgq,debug220.../cra_setup Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_t5018" { #//::puts "pgq,debug220/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/PRINT_T5018 /print_t5018"; ::set Result { .cra_setup "*** Default Settings ***" .for_the_year_ending "" .tag financial .minimum_amount 600 .copies 2 .forms_per_page 3 .template "" .destination "display" .filename "" .printer "" }; ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; #// ::set TemplateFileName [::file join $::qw_data object newviews T5018_${Year}_slip_front.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #//::puts "pgq,debug220.../print_t5018 Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_t5018_summary" { #//::puts "pgq,debug220/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/T5018_SUMMARY /t5018_summary"; ::set Result { .cra_setup "*** Default Settings ***" .date_prepared "" .position_of_preparer "" .for_the_year_ending "" .tag financial .minimum_amount "600" .payers_legal_name "" .payers_trade_name "" .template "" .destination "display" .filename "" .printer "" }; ::set Today [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".date_prepared" $Today; #// ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; #// ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::sargs::var::set Result ".payers_legal_name" [[$Source ".company"] odb_get]; #// #::set Year [::clock format [::clock seconds] -format %Y]; ::set TemplateFileName [::file join $::qw_data object newviews T5018_${Year}_summary_front.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #//::puts "pgq,debug220.../print_t5018_summary Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_t5" { #//::puts "pgq,debug220/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/PRINT_T5 /print_t5"; ::set Result { .cra_setup "*** Default Settings ***" .for_the_year_ending "" .posting_type "credit" .tag financial .minimum_amount 50 .copies 2 .forms_per_page 3 .template "" .destination "display" .filename "" .printer "" }; ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; #// #//::set TemplateFileName [::file join $::qw_data object newviews T5_[::incr Year -1]_slip.xls]; ::set TemplateFileName [::file join $::qw_data object newviews T5_${Year}_slip.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #//::puts "pgq,debug220.../print_t5 Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_t5_summary" { #//::puts "pgq,debug220/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/T5_SUMMARY /print_t5_summary"; ::set Result { .cra_setup "*** Default Settings ***" .date_prepared "" .position_of_preparer "" .for_the_year_ending "" .posting_type "credit" .tag financial .minimum_amount "50" .payers_legal_name "" .payers_trade_name "" .payers_bank_transit "" .additional_summary "no" .filed_before "no" .template "" .destination "display" .filename "" .printer "" }; ::set Today [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".date_prepared" $Today; #// ::set Year [::expr {[::clock format [::clock seconds] -format %Y]-1}]; ::set YearEnd [::string range [::qw::date::extend_end $Year] 0 7]; ::sargs::var::set Result ".for_the_year_ending" $YearEnd; #// ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::sargs::var::set Result ".payers_legal_name" [[$Source ".company"] odb_get]; #// ::set TemplateFileName [::file join $::qw_data object newviews T5_${Year}_summary_form.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } #//::puts "pgq,debug220.../print_t5_summary Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result; } "/print_w2s" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRINT_W2S ::set Result { .copies "1" .forms_per_page "2" .federal_id_number "" .starting_control_number "" .employers_name "" .employers_address_1 "" .employers_address_2 "" .employers_address_3 "" .template "" .destination "printer" .filename "" .printer "" }; #::sargs::var::set Result ".federal_id_number" [[$Object ".federal_id_number"] odb_get]; #209_209_convert #::set Payroll [[$Object observer_database] odb_master]; #::sargs::var::set Result ".federal_id_number" [[$Payroll ".federal_id_number"] odb_get]; # ::set Source [[[$Object odb_database application] "/OBJECT/NEWVIEWS/ACCOUNT"] ".address"]; ::sargs::var::set Result ".employers_name" [[$Source ".company"] odb_get]; ::array set AddressArray {}; ::foreach Field {street street2 city state country zipcode} { ::set AddressArray($Field) [::string trim [[$Source ".$Field"] odb_get]]; } ::set Address ""; ::if {$AddressArray(street) ne ""} {::lappend Address $AddressArray(street);} ::if {$AddressArray(street2) ne ""} {::lappend Address $AddressArray(street2);} ::set Line3 ""; ::if {$AddressArray(city) ne ""} {::append Line3 "$AddressArray(city), ";} ::if {$AddressArray(state) ne ""} {::append Line3 "$AddressArray(state) ";} ::if {$AddressArray(zipcode) ne ""} {::append Line3 $AddressArray(zipcode);} ::lappend Address $Line3; ::for {::set i 0;::set j 1;} {$i<3} {::incr i;::incr j;} { ::sargs::var::set Result ".employers_address_$j" [::string trim [::lindex $Address $i]]; } ::set Year [::clock format [::clock seconds] -format %Y]; ::set TemplateFileName [::file join $::qw_data object newviews W2-$Year.xls]; ::if {[::file exists $TemplateFileName]} { ::sargs::var::set Result ".template" [$Object qw_data_file_make_relative $TemplateFileName]; } ::return $Result; } "/prtpay" { #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTPAY #nv2.28.0 (bug fix) - forgot 2 new fields ..._eft - did nothing for convert ::set Result { .payUpToDate "" .checkDate "" .checkNumber "" .bankJournal "" .checkNumber_eft "" .bankJournal_eft "" .bankAccount "" .discountAccount "" .holdInvoiceIndicatorText "*HOLD*" .confirmPayments "yes" .payAccordingToTerms "no" .takeDiscounts "no" .takeDiscountsOnTax1 "yes" .takeDiscountsOnTax2 "yes" .advanceReference "yes" .template "" .destination "printer" .filename "" .printer "" .ocr_date_format {} .asterisk_amount_format {} .text_amount_format {} .currency_symbol {$} .currency_name {dollar} .currency_fraction_name {cent} }; ::sargs::var::set Result ".payUpToDate" [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".checkDate" [::clock format [::clock seconds] -format "%Y%m%d"]; ::set Search "check_ap"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } #//::puts "pgq,debug...::QW::GUI::NEWVIEWS::settings_prompt_default_settings Object==[$Object odb_path_help] Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result } "/prtpay_deposit" { #nv2.28.0 (new feature) - eft_transfer_deposit_228 # NOTICE ;#// .destination "none" is for one case pgq found where it was just a convenient solution #// /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTPAY ::set Result { .payUpToDate "" .checkDate "" .checkNumber_eft "" .bankJournal_eft "" .bankAccount "" .discountAccount "" .holdInvoiceIndicatorText "*HOLD*" .confirmPayments "yes" .payAccordingToTerms "no" .takeDiscounts "no" .takeDiscountsOnTax1 "no" .takeDiscountsOnTax2 "no" .use_separate_journal_entries "no" .destination "none" }; ::sargs::var::set Result ".payUpToDate" [::clock format [::clock seconds] -format "%Y%m%d"]; ::sargs::var::set Result ".checkDate" [::clock format [::clock seconds] -format "%Y%m%d"]; ::return $Result } "/print_1099s" { ::set Result { .payers_federal_id "" .payers_state_id "" .payers_name "" .payers_address_1 "" .payers_address_2 "" .payers_address_3 "" .payers_address_4 "" .minimum_amount "600.0" .box_number "7" .corrected "no" .copies "1" .forms_per_page "2" .template "" .destination "display" .filename "" .printer "" }; ::set Search "1099"; ::set Templates [::glob -nocomplain [::file join $::qw_data object newviews]/*.xls]; ;#*/ ::foreach Template [::string tolower $Templates] { ::if {[::string first $Search [::file tail $Template]]>=0} { ::sargs::var::set Result ".template" [::string map "{$::qw_data/} {}" $Template]; ::break; } } #//::puts "::QW::GUI::NEWVIEWS::settings_prompt_default_settings ::return Result==(\n[::sargs::format .structure $Result]\n)"; ::return $Result } "/print_receipts" { #nv2.33.0 ::set Result { .copies "1" .template "" .destination "display" .filename "" .printer "" .email_status "" .email_setup "" .email_from "" .email_reply_to "" .email_archive_list "" .email_subject "No Subject" .email_message "" .email_log_file "" }; ::return $Result } "/nph_housing_reports_housing_income_limit" { #nv2.33.0 ::set Result { .report_type "housing_income_limit" .report_date "" .destination "display" .filename "" .printer "" .begin_date "" .end_date "" .former_tenants_folder "" .service_region "Toronto" .service_subregion "Whole Service Area" .units_modified 0 .receiving_support_services 0 }; ::sargs::var::set Result ".report_date" [::clock format [::clock seconds] -format "%Y%m%d"]; ::set Year [::clock format [::clock seconds] -format "%Y"]; ::sargs::var::set Result ".begin_date" "${Year}0101" ::sargs::var::set Result ".end_date" "${Year}1231" ::return $Result } "/nph_housing_reports_unit_specific_age" { #nv2.33.0 ::set Result { .print_line_numbers "yes" .report_type "unit_specific_age" .report_date "" .destination "display" .filename "" .printer "" }; ::return $Result } "/nph_housing_reports_age_group_details" { #nv2.33.0 ::set Result { .print_line_numbers "yes" .report_type "age_group_details" .report_date "" .destination "display" .filename "" .printer "" }; ::return $Result } "/nph_housing_reports_meeting_sign_in_sheet" { #nv2.33.0 ::set Result { .print_line_numbers "yes" .report_type "meeting_sign_in_sheet" .report_date "" .destination "display" .filename "" .printer "" }; ::return $Result } "/nph_housing_reports_income_review_required" { #nv2.33.0 ::set Result { .print_line_numbers "yes" .report_type "income_review_required" .report_date "" .destination "display" .filename "" .printer "" }; ::return $Result } } } ::proc ::QW::GUI::NEWVIEWS::sin_format {Src {Separator " "}} { #pgq_fix - remove this if possible (replaced by ::QW::NEWVIEWS::PAYROLL::CANADA) but used in 209_210.tcl ::if {$Src eq ""} { ::return ""; } ::set Src [::regsub -all {([^0-9])} $Src ""]; ::return "[::string range $Src 0 2]$Separator[::string range $Src 3 5]$Separator[::string range $Src 6 8]"; } ::proc ::QW::GUI::NEWVIEWS::paste_buffer_prune {Path Buffer} { ::switch -glob -- $Path { "/OBJECT/NEWVIEWS/ACCOUNT*" { #::foreach StructurePath [::sargs::select_all .structure $Buffer] {} ::set Paths [::sargs::select_all .structure $Buffer]; #//::puts "20060412_000 Path==$Path Paths length==[::llength $Paths]"; ::for {::set i [::expr {[::llength $Paths]-1}]} {$i>=0} {::incr i -1} { ::set StructurePath [::lindex $Paths $i]; #//::puts "20060412_000 StructurePath==$StructurePath"; ::switch -glob -- $StructurePath { "/blkcopy/account*" { ::switch -glob -- $StructurePath { "*.odb_deriveds*" - "*.access_froms*" - "*.postings*" - "*.records*" - "*.nv2_odb_address*" - "*.import_datum*" - "*.settings_prompt*" { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } "*.qw_get" { ::if {[::sargs::get $Buffer $StructurePath] eq ""} { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } } } } "/blkcopy/transaction*" { ::switch -glob -- $StructurePath { "*.settings_prompt*" { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } "*.qw_get" { ::if {[::sargs::get $Buffer $StructurePath] eq ""} { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } } } } } } ::set Paths [::sargs::select_all .structure $Buffer]; #//::puts "20060412_000 Path==$Path Paths length PASS TWO==[::llength $Paths]"; ::for {::set i [::expr {[::llength $Paths]-1}]} {$i>=0} {::incr i -1} { ::set StructurePath [::lindex $Paths $i]; #//::puts "20060412_000 StructurePath PASS TWO==$StructurePath"; ::if {[::sargs::get $Buffer $StructurePath] eq ""} { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } } } "/OBJECT/NEWVIEWS/SYSTEM/TRANSACTION*" { ::set Paths [::sargs::select_all .structure $Buffer]; #//::puts "20060412_000 Path==$Path Paths length==[::llength $Paths]"; ::for {::set i [::expr {[::llength $Paths]-1}]} {$i>=0} {::incr i -1} { ::set StructurePath [::lindex $Paths $i]; #//::puts "20060412_000 StructurePath==$StructurePath"; ::switch -glob -- $StructurePath { "/blkcopy/transaction*" { ::switch -glob -- $StructurePath { "*.settings_prompt*" { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } "*.qw_get" { ::if {[::sargs::get $Buffer $StructurePath] eq ""} { #//::puts "20060412_000 unsetting StructurePath==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } } } } } } ::set Paths [::sargs::select_all .structure $Buffer]; #//::puts "20060412_000 Path==$Path Paths length PASS TWO==[::llength $Paths]"; ::for {::set i [::expr {[::llength $Paths]-1}]} {$i>=0} {::incr i -1} { ::set StructurePath [::lindex $Paths $i]; #//::puts "20060412_000 StructurePath PASS TWO==$StructurePath"; ::if {[::sargs::get $Buffer $StructurePath] eq ""} { #//::puts "20060412_000 unsettings StructurePath PASS TWO==$StructurePath"; ::sargs::var::unset Buffer $StructurePath; } } } } ::return $Buffer; } /* { ::proc patch_prtaccts_table_definitions {Master} { #nv2.11.3 #nv2.17.0 - removed! after 3 hrs of debugging... #// ::set ColumnDefinitions [[$Master ".column_definitions"] qw_get]; #// ------------------------------------------------------------ # /OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NOTES/PROCEDURE/NEWVIEWS/PRTACCTS odb_set #// ------------------------------------------------------------ ::set Result { /value { .script { /command { /change_before { ::switch -- %_row { "0" { ::qw::throw [::sargs \ .text "Only date order is allowed at this time." \ .help_id ??? \ ]; } "1" {} "2" {} "3" {} "4" {} "5" {} "6" {} "7" {} "8" {} "9" {} "10" {} "11" {} "12" {} "13" {} "14" {} "15" {} "16" { ::qw::throw [::sargs \ .text "The printer name cannot be typed in. Press F3 to pick a printer." \ .help_id ??? \ ]; } "17" {} "18" {} "19" {} "20" {} default { ::return void; ;#// a derived table may chain to this with a greater number of rows #::qw::bug "271820050331181742" "Print Accounts settings did not recognize row number %_row."; } } } } } } } ::sargs::var::+= ColumnDefinitions $Result; [$Master ".column_definitions"] qw_set $ColumnDefinitions; $Master odb_commit; } */} ::proc ::QW::GUI::NEWVIEWS::pruned_account_columnDefinitionTree {Workstation} { #nv2.11.3 ::set RefDefs [[$Workstation "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/ACCOUNT"] columnDefinitionTree]; #//::puts "20040919_00 POSTINGSUBS RefDefs /account names==\n"; #//::foreach Name [::qw::_structure::names $RefDefs] {::puts " $Name";} #//::puts "20040311.04 postingsubs account RefDefs==\n[::sargs::format .structure $RefDefs]"; #::sargs::var::unset RefDefs /line /odb_base; /* { /address /report /odb_base /line /odb_address /odb_id /odb_path_id /odb_path /odb_path_help /odb_path_backward /name /description /name_and_description /folder /name_closure /description_closure /odb_path_help_closure /totalto1_account /totalto2_account /totalto3_account /totalto4_account /normal_balance /normal_representation /setup_column /underline /line_type /active */} ::set RemoveList ""; ::lappend RemoveList "/address"; ::lappend RemoveList "/report"; ::lappend RemoveList "/odb_base"; ::lappend RemoveList "/line"; #nv2.17.0 #::lappend RemoveList "/odb_address"; ::lappend RemoveList "/odb_id"; ::lappend RemoveList "/odb_path_id"; ::lappend RemoveList "/folder"; ::lappend RemoveList "/name_closure"; ::lappend RemoveList "/description_closure"; ::lappend RemoveList "/odb_path_help_closure"; ::lappend RemoveList "/totalto1_account"; ::lappend RemoveList "/totalto2_account"; ::lappend RemoveList "/totalto3_account"; ::lappend RemoveList "/totalto4_account"; ::lappend RemoveList "/normal_balance"; ::lappend RemoveList "/normal_representation"; ::lappend RemoveList "/setup_column"; ::lappend RemoveList "/underline"; ::lappend RemoveList "/line_type"; ::lappend RemoveList "/active"; #nv2.24.1d (bug fix) - pruned_account_columnDefinitionTree used for postings tables account references was out of date and needed to unset columns added since prune was introduced ::lappend RemoveList "/unique_transaction_references"; ::lappend RemoveList "/foreign_currency_exchange_synchronize_account"; ::lappend RemoveList "/foreign_currency_exchange_gain_loss_account"; ::lappend RemoveList "/report_tag"; ::lappend RemoveList "/caseware_account_type"; #// ::foreach Name $RemoveList {::sargs::var::unset RefDefs $Name;} ::return $RefDefs; } ::proc ::QW::GUI::NEWVIEWS::pruned_journal_columnDefinitionTree {Workstation} { #nv2.11.3 ::set RefDefs [[$Workstation "/OBJECT/SYSTEM/WINDOW/SCROLLED/TABLE/NEWVIEWS/JOURNAL"] columnDefinitionTree]; /* { /odb_base /line /odb_address /odb_id /odb_path_id /odb_path /odb_path_help /odb_path_backward /name /description /name_and_description /folder /name_closure /description_closure /odb_path_help_closure /tags /journal_type /active /next_reference /next_reference1 */} ::set RemoveList ""; ::lappend RemoveList "/odb_base"; ::lappend RemoveList "/line"; ::lappend RemoveList "/odb_address"; ::lappend RemoveList "/odb_id"; ::lappend RemoveList "/odb_path_id"; ::lappend RemoveList "/folder"; ::lappend RemoveList "/name_closure"; ::lappend RemoveList "/description_closure"; ::lappend RemoveList "/odb_path_help_closure"; ::lappend RemoveList "/journal_type"; ::lappend RemoveList "/active"; ::lappend RemoveList "/next_reference"; #nv2.21.0 (move_to_journal) ::lappend RemoveList "/next_reference1"; ::foreach Name $RemoveList {::sargs::var::unset RefDefs $Name;} ::return $RefDefs; } ::proc ::QW::GUI::NEWVIEWS::patch_access_from_helper {s_args} { ::set Cnames [::sargs::get $s_args .cnames]; ::set Cdefs [::sargs::get $s_args .cdefs]; ::set Found 0; ::foreach Cname $Cnames { ::if {[::string first "/range" $Cname]==0 \ &&[::sargs::get $Cdefs $Cname.index_path] eq ".odb_deriveds.index/id" \ &&[::sargs::get $Cdefs $Cname.script/title] eq "Sub Payrolls" \ } { ::set Found 1; } } ::if {[::lsearch -glob $Cnames /odb_id]>=0} { ::set Found 1; } ::if {!$Found} { ::return $s_args; } # access count --------------------------------------------------- /* { a range field on .access_froms only gives the direct kids, not the access closure ::set Range "/range_amount_[::qw::id_factory]"; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Access\nObjects" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".access_froms.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; */} /* { [::qw::id_factory] [cpp_odb_id_factory] */ } #::set F1 "/formula_[::qw::id_factory]"; ::set F1 "/access_closure_count"; ::set Script { ::if {"%_object" eq ""} { ::return ""; } ::return [::llength [[%_object odb_master] odb_access_closure]]; } ::sargs::var::set Cdefs $F1 [::sargs::+= [formula_new_defaults] [::sargs .script/command/get $Script]]; ::sargs::var::set Cdefs \ $F1.script/title {Access\nCount} \ ; ::lappend Cnames $F1; # audit count --------------------------------------------------- #::set F2 "/formula_[::qw::id_factory]"; ::set F2 "/audit_object_count"; #nv2.36.0 (::itcl::delete object) ::set Script { ::if {"%_object" eq ""} { ::return ""; } ::set Range [::qw::odb::factory range]; ::qw::finally [::list ::itcl::delete object $Range]; $Range cpp_configure -index [[[%_object odb_master] odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [[%_object odb_master] odb_object_id]; $Range cpp_configure -begin ".address /$ObjectId"; $Range cpp_configure -end ".address /$ObjectId"; ::return [$Range odb_items]; } ::sargs::var::set Cdefs $F2 [::sargs::+= [formula_new_defaults] [::sargs .script/command/get $Script]]; ::sargs::var::set Cdefs \ $F2.script/title {Audit\nCount} \ ; ::lappend Cnames $F2; # audit first --------------------------------------------------- ::set F2 "/audit_object_date_created"; ::set Script { ::set Object "%_object"; ::if {$Object eq ""} { ::return ""; } ::set Object [$Object odb_master]; ::set Format [[[[$Object odb_database application] cpp_user_get] .options.date.format] odb_get]; ::set Format $::qw::date::formats($Format); #// ::set Range [::qw::odb::factory range]; ::qw::finally [::list ::itcl::delete object $Range]; $Range cpp_configure -index [[$Object odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [$Object odb_object_id]; $Range cpp_configure -begin ".address /$ObjectId"; $Range cpp_configure -end ".address /$ObjectId"; ::set First [$Range odb_first]; ::if {$First ne "" \ &&[[[$First odb_master] .operation] odb_get] eq "create" \ } { ::set Date [[[$First odb_master] .date] odb_get]; ::return [::qw::date::format $Date $Format]; } #// ::set ImportDate [::string range [::sargs::get [[$Object .clientdata] odb_get] .import.date] 0 7]; ::if {$ImportDate ne ""} { ::return [::qw::date::format $ImportDate $Format]; } ::return ""; } ::sargs::var::set Cdefs $F2 [::sargs::+= [formula_new_defaults] [::sargs .script/command/get $Script]]; ::sargs::var::set Cdefs \ $F2.script/title {Date\nCreated} \ ; ::lappend Cnames $F2; # audit last --------------------------------------------------- ::set F2 "/audit_object_date_last_modified"; ::set Script { ::if {"%_object" eq ""} { ::return ""; } ::set Range [::qw::odb::factory range]; ::qw::finally [::list ::itcl::delete object $Range]; $Range cpp_configure -index [[[%_object odb_master] odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [[%_object odb_master] odb_object_id]; $Range cpp_configure -begin ".address /$ObjectId"; $Range cpp_configure -end ".address /$ObjectId"; ::set First [$Range odb_last]; ::if {$First eq ""} { ::return ""; } ::set Date [[[$First odb_master] .date] odb_get]; ::set Format [[[[%_object odb_database application] cpp_user_get] ".options.date.format"] odb_get]; ::set Format $::qw::date::formats($Format); ::return [::qw::date::format $Date $Format]; } ::sargs::var::set Cdefs $F2 [::sargs::+= [formula_new_defaults] [::sargs .script/command/get $Script]]; ::sargs::var::set Cdefs \ $F2.script/title {Last\nModified} \ ; ::lappend Cnames $F2; #// --------------------------------------------------------------- ::sargs::var::set s_args .cnames $Cnames; ::sargs::var::set s_args .cdefs $Cdefs; ::return $s_args; } ::proc ::QW::GUI::NEWVIEWS::formula_new_defaults {} { ::return { .script { /title "Undefined" /explanation {return "";} /help "" /command { /get {} /change_before { ::qw::throw [::sargs \ .text "Attempted to edit a value calculated by a script." \ .help_id 271820070831134813 \ ]; } /set { ::qw::throw [::sargs \ .text "Attempted to edit a value calculated by a script." \ .help_id 271820070831134813 \ ]; } } } .justify right .width {16} .format dollar_minus_parentheses } } } ::namespace eval ::QW::GUI::SYSTEM { # ------------------------------------------------------------ # User Tables # ------------------------------------------------------------ /* { ::proc ::QW::GUI::SYSTEM::setup_users_sub_list {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::if {$Fman ne "List"} { ::lappend ColumnNames "/folder"; } ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; ::lappend ColumnNames "/odb_base/odb_path_help_closure"; ::lappend ColumnNames "/odb_base/description"; [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Sub Users" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".odb_deriveds.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } */} ::proc ::QW::GUI::SYSTEM::setup_users_sub_list {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::set Fman "List"; ::if {[[[[$Table odb_database application] cpp_user_get] ".options.folder_management"] odb_get] eq "yes"} { ::set Fman "Folder Management"; } ::sargs::var::set Settings /$NewSub.name $Fman; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::if {$Fman ne "List"} { ::lappend ColumnNames "/folder"; } ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; /* { ::if {$Fman ne "List"} { ::lappend ColumnNames "/odb_base/odb_path_help_closure"; ::lappend ColumnNames "/odb_base/description"; } */} [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; /* { ::if {$Fman ne "List"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "Sub Users" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".odb_deriveds.index/id" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; } */} ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::SYSTEM::setup_users_sub_access_rights {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Access Rights"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; #::lappend ColumnNames "/odb_base/odb_path_help_closure"; #::lappend ColumnNames "/odb_base/description"; ::lappend ColumnNames "/password"; #nv2.33.0 (bug fix) - password_collect_always ::lappend ColumnNames "/options/password_collect_always"; #nv2.23.0 (deleted feature) - .options.folder_management .access_view and .audit_view /* { ::lappend ColumnNames "/access_view"; ::lappend ColumnNames "/audit_view"; ::lappend ColumnNames "/options/folder_management"; */} ::lappend ColumnNames "/options/transaction/begin"; ::lappend ColumnNames "/options/transaction/end"; #nv2.33.0 (new feature) - transaction_date_range_check_is_enabled ::lappend ColumnNames "/options/transaction/date_range_check_is_enabled"; ::lappend ColumnNames "/options/transaction/reconcile/safety"; ::lappend ColumnNames "/options/edit/safety"; #nv2.34.0 (new feature) - database_file_download - renamed /options/backup/multi_user to /options/backup/file_download #nv2.34.0 (new feature) - database_file_download - renamed /options/backup/single_user to /options/backup/file_backup #nv2.34.1d (new feature REVISIT) - ::QW::GUI::SYSTEM::setup_users_sub_access_rights - UNDO 2.34.0 change of column name paths and descriptions - added new database_download ::lappend ColumnNames "/options/backup/database_download"; ::lappend ColumnNames "/options/backup/multi_user"; ::lappend ColumnNames "/options/backup/single_user"; #nv2.22.0 (backup.reminder_days) ::lappend ColumnNames "/options/backup/reminder_days"; #nv2.33.0 (bug fix) - backup_logout_always ::lappend ColumnNames "/options/backup/backup_logout_always"; #nv2.21.0 ::lappend ColumnNames "/options/proof_check"; [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "30" \ "/access_view.script/title" "User\nAccess View" \ "/access_view.width" "13" \ "/audit_view.script/title" "Data\nAudit View" \ "/audit_view.width" "13" \ "/options/transaction/begin.script/title" "Transaction\nEdit Range\nBegin Date" \ "/options/transaction/end.script/title" "Transaction\nEdit Range\nEnd Date" \ "/options/transaction/date_range_check_is_enabled.script/title" "Transaction\nEdit Range\nCheck Control" \ "/options/transaction_date_range_check_is_enabled.width" "15" \ "/options/transaction/reconcile/safety.script/title" "Transaction\nReconcile\nSafety" \ "/options/edit/safety.script/title" "Data\nEdit\nSafety" \ "/options/backup/multi_user.script/title" "Backup\nMulti-User" \ "/options/backup/multi_user.width" "12" \ "/options/backup/database_download.script/title" "File\nDownload" \ "/options/backup/database_download.width" "12" \ "/options/backup/single_user.script/title" "Backup\nSingle-User" \ "/options/backup/single_user.width" "12" \ "/options/folder_management.script/title" "Folder\nManagement" \ "/options/backup/single_user.width" "12" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::SYSTEM::setup_users_sub_display_options {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Display/Entry Options"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; #::lappend ColumnNames "/odb_base/odb_path_help_closure"; #::lappend ColumnNames "/odb_base/description"; ::lappend ColumnNames "/options/date/format"; ::lappend ColumnNames "/options/date/entry"; ::lappend ColumnNames "/options/currency/format"; ::lappend ColumnNames "/options/history/begin"; ::lappend ColumnNames "/options/history/end"; ::lappend ColumnNames "/options/as_of_date"; ::lappend ColumnNames "/options/purchase_item_entry_mode"; ;#//nv2.21.0 ::lappend ColumnNames "/options/automatic_pick_boxes"; ;#//nv2.23.0 (new feature) - automatic_pick_boxes ::lappend ColumnNames "/options/explorer_pane_restore_maximize_control"; ;#//nv2.23.0 (new feature) - explorer_pane_restore_maximize_control ::lappend ColumnNames "/options/prompt_display_style"; ;#//nv2.30.0 (new feature) - prompt_display_style [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "35" \ "/options/date/format.script/title" "Date Display\nFormat" \ "/options/date/format.width" "15" \ "/options/date/entry.script/title" "Date Entry\nFormat" \ "/options/date/entry.width" "15" \ "/options/currency/format.script/title" "Currency\nDisplay Format" \ "/options/currency/format.width" "25" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ "/options/history/begin.script/title" "History Display\nBegin Date" \ "/options/history/begin.width" "17" \ "/options/history/end.script/title" "History Display\nEnd Date" \ "/options/history/end.width" "17" \ "/options/as_of_date.script/title" "Report/Aging\nAs of Date" \ "/options/as_of_date.width" "17" \ ; ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::SYSTEM::setup_users_sub_session_counts {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Session Counts"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; #::lappend ColumnNames "/odb_base/odb_path_help_closure"; #::lappend ColumnNames "/odb_base/description"; [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::foreach {State Title} {"" "All" /open "Open" /closed "Closed" /crashed "Crashed" /terminated "Terminated" /disconnected "Disconnected"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "$Title\nSessions" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".sessions.index/state$State" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::SYSTEM::setup_users_sub_audit_counts {Table} { ::set Settings [::sargs::get [[$Table ".saved_settings"] odb_get] "/column_define"]; ::set NewSub 0;::while {[::sargs::exists $Settings /$NewSub]} {::incr NewSub;} ::sargs::var::set Settings .current_sub /$NewSub; ::sargs::var::set Settings /$NewSub.name "Audit Counts"; ::sargs::var::set Settings "/$NewSub.tag" "persistent"; [$Table ".saved_settings"] odb_set [::sargs::set [[$Table ".saved_settings"] qw_get] "/column_define" $Settings]; ::set ColumnNames ""; ::lappend ColumnNames "/line"; ::lappend ColumnNames "/name"; ::lappend ColumnNames "/description"; #::lappend ColumnNames "/odb_base/odb_path_help_closure"; #::lappend ColumnNames "/odb_base/description"; [$Table ".column_names"] odb_set $ColumnNames; ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/name.script/title" "Name" \ "/name.width" "17" \ "/description.script/title" "Description" \ "/description.width" "35" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "20" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::foreach {Operation Title} {"" "All" create "Create" change "Change" delete "Delete"} { ::set Range [$Table windowNew "/menu/window/new/range_amount"]; ::sargs::var::set ColumnSetup \ "$Range.script/title" "$Title\nAudit Items" \ "$Range.script/command/get/range_empty" "::return {}" \ "$Range.index_path" ".audit_trail.index/operation" \ "$Range.rb_name" ".count" \ "$Range.format" "integer_minus_trailing" \ "$Range.width" "13" \ "$Range.justify" "right" \ ; ::if {$Operation ne ""} { ::sargs::var::set ColumnSetup \ "$Range.range_begin" ".operation $Operation" \ "$Range.range_end" ".operation $Operation" \ ; } } ::set ColumnDefinitions [[$Table ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [$Table ".column_definitions"] odb_set $ColumnDefinitions; ::return $NewSub; } ::proc ::QW::GUI::SYSTEM::setup_users_access_audit {s_args} { #::if {$::qw_sub_product eq "nph"} {::return;} ::set Window [::sargs::get $s_args ".odb.object"]; ::set Manager [$Window odb_database]; ::if {![$Window odb_is_a [$Manager "/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/SYSTEM/USER"]]} { ::qw::throw [::sargs \ .text "The setup_user_access_audit must be run from a user desktop." \ .help_id 0 \ ]; } ::set User [[$Window odb_database application] cpp_user_get]; ::if {$User eq ""} { ::return void; } #// #::set AccessWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/ACCESS"] odb_access_closure [::sargs .user $User]] ne ""}]; #::set AuditWindow [::expr {[[[$Window odb_database application] "/OBJECT/SYSTEM/AUDIT"] odb_access_closure [::sargs .user $User]] ne ""}]; ::set AccessWindow [::expr {[[$User ".access_view"] odb_get] eq "yes"}]; ::set AuditWindow [::expr {[[$User ".audit_view"] odb_get] eq "yes"}]; #// ::if {!$AuditWindow&&!$AccessWindow} { ::return void; } ::set Explorer [$Window windowNew "/menu/window/new/deriveds/collection_explorer"]; #[$Explorer ".frame.dressing.settings"] replace .title_text "User Audit"; #[$Explorer ".frame.dressing.isDisplayed"] odb_set 0; [$Explorer desktop] explorerDepth "/OBJECT/SYSTEM/USER"; #rwb_??? #[[$Explorer tree] ".observer_index"] odb_set ".index/name_closure"; [[$Explorer tree] ".observer_index"] odb_set ".index/name"; [[$Explorer tree] ".restore_state"] odb_set "maximized"; ::if {[[$Explorer tree] observer_database] ne ""} { ::if {[[[$Explorer tree] observer_database] odb_items]} { [$Explorer tree] activeCell "1,0"; } } ::set ColumnSetup ""; ::sargs::var::set ColumnSetup \ "/folder.script/title" "Type" \ "/odb_id.script/title" "Address" \ "/name_closure.script/title" "Name" \ "/name_closure.width" "15" \ "/description_closure.script/title" "Description" \ "/description_closure.width" "40" \ "/odb_base/odb_path_help_closure.script/title" "Folder" \ "/odb_base/odb_path_help_closure.width" "25" \ "/odb_base/odb_path_help_closure.format" "long" \ "/odb_base/description.script/title" "Folder Description" \ "/odb_base/description.width" "30" \ ; ::set Result ""; ::lappend Result "/line"; #::lappend Result "/folder"; #::lappend Result "/odb_base/odb_path_help_closure"; ::lappend Result "/odb_base/name"; ::lappend Result "/odb_id"; #::lappend Result "/name_closure"; ::lappend Result "/name"; #::lappend Result "/description_closure"; ::lappend Result "/description"; #::lappend Result "/odb_base/description"; #nv2.22.0 (access/audit item counts) ::set Sargs [::QW::GUI::NEWVIEWS::patch_access_from_helper [::sargs .cnames $Result .cdefs $ColumnSetup]]; ::set ColumnSetup [::sargs::get $Sargs .cdefs]; ::set Result [::sargs::get $Sargs .cnames]; ::set ColumnDefinitions [[[$Explorer tree] ".column_definitions"] qw_get]; ::set ColumnDefinitions [::sargs::var::+= ColumnDefinitions $ColumnSetup]; [[$Explorer tree] ".column_definitions"] odb_set $ColumnDefinitions; [[$Explorer tree] ".column_names"] odb_set $Result; /* { ::set RangeIndex [$Manager "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; #// #//::puts "20041227_001 explorer_desktop==[[explorer_desktop] odb_path] explorer_desktop observer_database==[[explorer_desktop] observer_database]"; #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/NEWVIEWS/ACCOUNT/AP/1104187129_1079 explorer_desktop observer_database==::qw::odb::20041223165713::/1103839035_607 #//20041227_001 explorer_desktop==/OBJECT/SYSTEM/WINDOW/SCROLLED/DESKTOP/OBJECT/MASTER/SYSTEM/AUDIT/1104162438_580 explorer_desktop observer_database== #// # NOTICE big time! #// For some reason, never investigated, we are getting whacked twice and #// the first time the observer is empty ... #// ::if {[[explorer_desktop] observer_database] ne ""} { ::set ObjectId [[[explorer_desktop] observer_database] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; } else { #// # AND #// At this point, any dribble for the range define (that guarantees empty) will do. #::set ObjectId [[observer_database] odb_id]; ::set ObjectId "whatever"; #//::puts "20050106_000 observer_database==[[observer_database] odb_path] ObjectId==$ObjectId"; ::set RangeBegin ".address $ObjectId"; ::set RangeEnd ".address $ObjectId"; } */} /* { ::set AuditItems [$Table windowNew "/menu/window/new/formula"]; ::set Script { ::set Range ::set RangeIndex [[[%_object odb_master] odb_database] "/OBJECT/SYSTEM/AUDIT.odb_deriveds.index/address"]; ::set ObjectId [[%_object odb_master] odb_object_id]; ::set RangeBegin ".address /$ObjectId"; ::set RangeEnd ".address /$ObjectId"; $Range cpp_configure -index $RangeIndex -begin $RangeBegin -end $RangeEnd; } ::set Script [::string map "%_qtyOnHand $QtyOnHand %_netQtyOrdered $NetQtyOrdered" $Script]; ::sargs::var::set ColumnSetup \ "$AuditItems.script/title" "Audit Items" \ "$AuditItems.script/command/get" $Script \ "$Column.format" "integer_minus_trailing" \ "$Column.width" "12" \ ; */} #// ------------------------------------------------------------ # Access Froms subwindow #// ------------------------------------------------------------ ::if {$AccessWindow} { ::set AccessFroms [[$Explorer desktop] windowNew "/menu/window/new/access_froms_closure"]; [$AccessFroms ".frame.dressing.settings"] replace .title_text "Access From"; [$AccessFroms ".frame.dressing.isDisplayed"] odb_set 0; [$AccessFroms ".restore_state"] odb_set "maximized"; } #// ------------------------------------------------------------ # Audit Trail subwindow #// ------------------------------------------------------------ ::if {$AuditWindow} { ::set AuditTrail [[$Explorer desktop] windowNew "/menu/window/new/audit_trail_user_object"]; [$AuditTrail ".frame.dressing.settings"] replace .title_text "User Object Audit"; [$AuditTrail ".frame.dressing.isDisplayed"] odb_set 0; [$AuditTrail ".restore_state"] odb_set "maximized"; } ::if {$AccessWindow&&$AuditWindow} { ::set Title "Access From / User Object Audit"; [$Explorer desktop] windowSelect $AccessFroms; } else { ::if {$AccessWindow} { ::set Title "Access From"; } else { ::set Title "User Object Audit"; } } [$Explorer ".frame.dressing.settings"] replace .title_text $Title; [$Explorer ".frame.dressing.isDisplayed"] odb_set 0; [[$Explorer tree] ".restore_state"] odb_set "restored"; [[$Explorer tree] ".observer_index"] odb_set ".index/id"; ::return $Explorer; } } #//::puts "pgq,debug223.0.../gui/gui.qw_tcl exit"; /* { (bin) 6 % source c:/pgq_scripts/gun.tcl Search and replace for file==c:/pgq/object/newviews/definition.qw_tcl 2 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 3 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 4 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 5 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 6 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 7 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 8 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 9 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 10 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 11 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 12 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 13 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 14 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 15 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 16 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 17 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 18 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 19 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Search and replace for file==c:/pgq/object/system/gui/definition.qw_tcl 20 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}} {::return [[$this ".client"] dataInterface_cache_row $Row $ObserversCreate $Priority];}" 21 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 22 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 23 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 24 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 25 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 26 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 27 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 28 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 29 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 30 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 31 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Search and replace for file==c:/rth/object/newviews/payroll/canada/definition.qw_tcl 32 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 33 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 34 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Search and replace for file==c:/rth/object/newviews/payroll/definition.qw_tcl 35 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 36 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 37 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 38 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 39 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Search and replace for file==c:/rth/object/newviews/payroll/usa/definition.qw_tcl 40 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 41 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Search and replace for file==c:/rwb/object/system/definition.qw_tcl 42 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 43 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" 44 LineValue==" public method dataInterface_cache_row {Row {ObserversCreate 1} {Priority ""}}" Done, Total files==371 SearchCountTotal==0 Changed Files==0 Changed Files Names */} #nv2.38.4 (oauth) - gui.qw_tcl ::QW::OAUTH procs #//::puts "pgq,debug2384.../gui/gui.qw_tcl about to ::package require dict"; ::if {$::tcl_version<8.5} { ::package require dict; } #//::puts "pgq,debug2384.../gui/gui.qw_tcl about to ::package require json"; ::package require json; /* { ::namespace eval ::QW::OAUTH { } ::proc ${::qw::script::namespace}::main {sargs} { ::QW::OAUTH::main $sargs; } */} #//::puts "pgq,debug2384.../gui/gui.qw_tcl about to ::namespace eval ::QW::OAUTH"; #::proc ${::qw::script::namespace}::main {sargs} { # ::QW::OAUTH::main $sargs; #} ::namespace eval ::QW::OAUTH { ::proc oauth_signin {Database SettingsSub Iname} { /* { /default { .values { .email_server {} .email_port {} .email_tls_enabled yes .email_tls_username {} .email_tls_password {} .email_client {} .email_queue no .email_atleastone no } .name {*** Default Settings ***} } */} ::if {$SettingsSub eq "/default"} { #::qw::throw [::sargs \ .text "Attempted Oauth signin with *** Default Settings ***" \ .help_id 0 \ ]; } ::switch -exact -- $Iname { _image_oauth_sign_in_google { ::set url "https://accounts.google.com/o/oauth2/v2/auth" ::append url "?client_id=556624734793-5vntpkf4kf25hdcqq4qrfskek68228cg.apps.googleusercontent.com"; ::append url "&scope=https%3A//www.googleapis.com/auth/userinfo.email%20https://www.googleapis.com/auth/gmail.send"; ::append url "&access_type=offline"; ::append url "&response_type=code"; #::append url "&state=$Database,$SettingsSub,$::QW::OAUTH::Port,google"; ;#// not needed with a field value paste #::append url "&redirect_uri=http%3A//localhost%3A2615/oauth_redirect"; ::append url "&redirect_uri=https://newviews.com/oauth/index.html"; ::append url "&include_granted_scopes=true"; ::append url "&prompt=consent"; #//#//::puts "pgq,debug2384...main url google==$url"; #//::puts "env==[::parray ::env]"; ::exec [::file join $::env(COMSPEC)] << "start \"\" \"$url\" \n exit \n" &; } _image_oauth_sign_in_microsoft { ::set url "https://login.microsoftonline.com/common/oauth2/v2.0/authorize"; ::append url "?client_id=0038eb36-7eef-4424-8e98-72d0d9f834c8"; ::append url "&scope=openid+email%20offline_access%20Mail.Send%20"; ::append url "&access_type=offline"; ::append url "&response_type=code%20id_token"; #::append url "&state=$Database,$SettingsSub,$::QW::OAUTH::Port,microsoft"; ;#// not needed with a field value paste #::append url "&redirect_uri=http%3A//localhost%3A2615/oauth_redirect"; ::append url "&redirect_uri=https://newviews.com/oauth/index.html"; ::append url "&response_mode=fragment"; ::append url "&nonce=3"; ::append url "&prompt=login"; #//#//::puts "pgq,debug2384...main url microsoft==$url"; #//::puts "env==[::parray ::env]"; ::exec [::file join $::env(COMSPEC)] << "start \"\" \"$url\" \n exit \n" &; } } } ::proc oauth_code_http_oauth_info_get {sargs} { #//::puts "pgq,debug2384...::QW::OAUTH::oauth_code_http_oauth_info_get enter sargs==(\n[::sargs::format .structure $sargs]\n)"; ::set Acode [::sargs::get $sargs .oauth_code]; ::set EmailProvider [::sargs::get $sargs ._active_oauth_signin]; #::set EmailProvider "google"; ::qw::try { ::switch -glob -- $EmailProvider { "*google*" { ::set ClientID "556624734793-5vntpkf4kf25hdcqq4qrfskek68228cg.apps.googleusercontent.com"; ::set ClientSecret "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"; ::set OauthUrl "https://oauth2.googleapis.com/token"; } "*microsoft*" { ::set ClientID "0038eb36-7eef-4424-8e98-72d0d9f834c8"; ::set ClientSecret "qd08Q~pZhewRovqHYaCIiew-h72OZDnOrjowqbJ4"; ::set OauthUrl "https://login.microsoftonline.com/common/oauth2/v2.0/token"; } default { ::qw::throw [::sargs \ .text "Please select a sign in choice and keep the setup window open until you finish." \ .help_id 0 \ ]; } } #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect ClientID==$ClientID"; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect ClientSecret==$ClientSecret"; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthUrl==$OauthUrl"; ::set RedirectURI "https://newviews.com/oauth/index.html"; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect RedirectURI==$RedirectURI"; ::set OauthQuery "code=$Acode&client_id=$ClientID&client_secret=$ClientSecret&redirect_uri=$RedirectURI&grant_type=authorization_code"; # Get the access_token and other oauth info ::http::register https 443 [list ::tls::socket -tls1 1]; ::set OauthCode [::http::geturl $OauthUrl -type application/x-www-form-urlencoded -query $OauthQuery]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthCode after ::http::geturl OauthCode==$OauthCode"; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthCode HttpNcode==[::http::ncode $OauthCode]"; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthCode HttpStatus==[::http::status $OauthCode]"; ::set OauthCodeResponseBody [::sargs::json2sargs .json [::http::data $OauthCode]]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthCodeResponseBody==[::sargs::format $OauthCodeResponseBody]"; ::if {[::http::ncode $OauthCode] != 200} { # there was a problem getting the access token with the provided authorization code ::http::cleanup $OauthCode; ::http::unregister https; ::return; } else { ::http::cleanup $OauthCode; ::http::unregister https; } # Stuffing ClientID and ClientSecret into sargs to be added to the email settings ::sargs::var::set OauthCodeResponseBody .client_id $ClientID; ::sargs::var::set OauthCodeResponseBody .client_secret $ClientSecret; ::sargs::var::set OauthCodeResponseBody .email_provider $EmailProvider; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect OauthCodeResponseBody==(\n[::sargs::format $OauthCodeResponseBody]\n)"; ::sargs::var::set ReturnSargs .oauth $OauthCodeResponseBody; #::sargs::var::set ReturnSargs .email_settings_database $Database; #::sargs::var::set ReturnSargs .email_settings_sub $SettingsSub; # Get Email Address out of the id token # JSON -> dict -> Remove Picture Field with unicode char using dict -> JSON -> Sargs ::foreach Piece [::split "[::sargs::get $OauthCodeResponseBody .id_token]" .] { ::set TempJSON [::base64::decode $Piece]; ::qw::try { ::set dictJson [::json::json2dict $TempJSON]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect id_token dictJson 1==$dictJson"; ::set dictJson [dict remove $dictJson picture]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect id_token dictJson 2==$dictJson"; ::set dictJson [dict2json $dictJson]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect id_token dictJson 3==$dictJson"; ::set OauthUserInfo [::sargs::json2sargs .json $dictJson]; #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect id_token OauthUserInfo==$OauthUserInfo"; ::if {[::sargs::exists $OauthUserInfo .email]} { ::sargs::var::set ReturnSargs .email_tls_username [::sargs::get $OauthUserInfo .email]; ::break; } } catch Error { #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect dictJson json2dict2sargs Error==$Error"; ::continue; } } #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect id_token ReturnSargs==(\n[::sargs::format $ReturnSargs]\n)"; ::return $ReturnSargs; ::set SettingsSub [email_setup_set $ReturnSargs]; ## send success email - need to call newviews email_send instead to have the correct sargs # ::qw::try { # ::set SettingsPrompt [[$Database "/OBJECT/NEWVIEWS/ACCOUNT.settings_prompt"] odb_get]; # ::set EmailSettings [::sargs::get $SettingsPrompt "/email_setup"]; # email_send [::sargs .email_settings_sub $SettingsSub .to "wbenn@qwpage.com" .subject "NewViews Web App Setup Email" .content "test oauth email" .oauth [::sargs::get $EmailSettings ${SettingsSub}.values.oauth]]; # } catch Error { # ::set HTML [make_html [::sargs .title "Send Email Error" .content "Send Email Error==$Error"]]; # ::Httpd_ReturnData $Socket "text/html" $HTML; # # ::Httpd_Shutdown; # ::return; # } } catch Error { #//::puts "pgq,debug2384...::QW::OAUTH::http_connection_handler oauth_redirect get access_token Error==$Error"; ::qw::throw $Error; } } ::proc dict2json {dictionary} { dict for {key value} $dictionary { if {[string match {\[*\]} $value]} { lappend Result "\"$key\":$value" } elseif {![catch {dict size $value}]} { lappend Result "\"$key\":\"[dict2json $value]\"" } else { lappend Result "\"$key\":\"$value\"" } } return "\{[join $Result ",\n"]\}" } ::proc email_send {sargs} { #//::puts "pgq,debug2384...::QW::OAUTH::email_send sargs==(\n[::sargs::format $sargs]\n)"; /* { pgq,debug...::QW::OAUTH::email_send sargs==( .copies 1 .template qw_page_demo/deluxe_purchase_order_080625.xls .destination email .filename c:/nv/purchase_order_%_clock.pdf .printer {} .email_status active .email_setup GMail .email_from {Jane Doe } .email_reply_to reply@qwpage.com .email_archive_list newviews_archive@qwpage.com .email_subject {Purchase Order from Q.W. Page Associates Inc.} .email_message {Please find attached our P.O. for our latest order - RSVP MORONSKI} .email_log_file {c:\nv\email.log} .settings_sub /1259609931_22178 .settings_name {Laser Purchase Order - Email - GMail} .email_server {} .email_port {} .email_tls_enabled {} .email_tls_password {} .email_client {} .email_queue {} .email_atleastone {} .email_log_smtp {} .email_tls_username wardbenn10@gmail.com .email_oauth_code 4/0ASVgi3J9vcAXdQF6wxipBomOf9D_I7PuLl-TwXs_Ce09Z0m-ajNW31_LeTEWNoH3HBd7cA .oauth { .access_token ya29.a0AXeO80REpKRs_j16xGD1n610hKLcoP3FCzXCyOoXNVBOC-U5mMFQFxQSq6yh4DePt2IAbmqaz-RqYahwT1GWjfQdslW-avnYI3pTHycJIjg3WuFqJapBIH3Lgoi61bBgxO45L2n6O8D_9DI10tmol2h9Ad7TL4iINjbXKnpkaCgYKAVESARESFQHGX2MiED0hgPcKT5Cw0BnNCClExA0175 .expires_in 3599 .refresh_token 1//04l_1BXaEpL8WCgYIARAAGAQSNwF-L9IrTSN28PPylkZTxEOVP-KSFvx26j2eRjwxbRTN4nOyH0mdq3xY_nFSVCh-_0zP6yx4Tvo .scope {https://www.googleapis.com/auth/gmail.send https://www.googleapis.com/auth/userinfo.email openid} .token_type Bearer .id_token eyJhbGciOiJSUzI1NiIsImtpZCI6ImZhMDcyZjc1Nzg0NjQyNjE1MDg3YzcxODJjMTAxMzQxZTE4ZjdhM2EiLCJ0eXAiOiJKV1QifQ.eyJpc3MiOiJodHRwczovL2FjY291bnRzLmdvb2dsZS5jb20iLCJhenAiOiI1NTY2MjQ3MzQ3OTMtNXZudHBrZjRrZjI1aGRjcXE0cXJmc2tlazY4MjI4Y2cuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJhdWQiOiI1NTY2MjQ3MzQ3OTMtNXZudHBrZjRrZjI1aGRjcXE0cXJmc2tlazY4MjI4Y2cuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJzdWIiOiIxMDM2MjgyNDQxNzg0NzM1MTA4ODIiLCJlbWFpbCI6IndhcmRiZW5uMTBAZ21haWwuY29tIiwiZW1haWxfdmVyaWZpZWQiOnRydWUsImF0X2hhc2giOiJLR1VTSWd2OFQ5d3M3UjA5eDZOMGJnIiwiaWF0IjoxNzM4Njk5NTcwLCJleHAiOjE3Mzg3MDMxNzB9.cjq8b4OA5DxFdJ3cD0ZpaqYdBD1vsyUDB6IiNsLcv3zijCkNFHAApJyje93K9XRUeE6yLwaX7PE1Ew5m2csKPCHSmnDzd2DONeYBcUj4WD6Qpl4sKlOTdhAUrQVLm9Fo6cx2pp2YNkAMqapvohrWV_tkqtZuuuxWvymC4n4XilG42sf1cFTCrvhYBqhdGX-roDdaBczOxxkKYpl54luiNHtn-EXCsgH1CbVTTYGhDO2IwNMMFu_Cn9UX6PzNg518_IMVaHcv7eRvDYsxb9hiCfeAg1uqRzowUOQCjEgDd9rrhrBl563BL_C_fEpe-z4NE7ZPRP1-A9TslEfxGOwMnQ .client_id 556624734793-5vntpkf4kf25hdcqq4qrfskek68228cg.apps.googleusercontent.com .client_secret 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 .email_provider _image_oauth_sign_in_google } .email_settings_sub /1259194734_21025 .email_settings_name GMail .prompt_window ::qw::odb::20241118181027::/1737582922_3983 .email_to quackenb@qwpage.com .email_attachment_file_list c:/nv/purchase_order_20250204150636.pdf .email_token ::mime::3 .email_recipients quackenb@qwpage.com .email_settings_database ::qw::cpp::F46D0461A3C0_9772_44 ) */} ::qw::try { #::set EmailProvider [::sargs::get $sargs ._active_oauth_signin]; ::set EmailProvider [::sargs::get $sargs .oauth.email_provider]; ::set OauthAccessToken [::sargs::get $sargs .oauth.access_token]; #//::puts "pgq,debug2384...::QW::OAUTH::email_send OauthAccessToken==$OauthAccessToken"; ::set PassedEmailToken [::sargs::get $sargs .email_token]; ::mime::setheader $PassedEmailToken To "[::sargs::get $sargs .email_recipients]"; # ::mime::setheader $PassedEmailToken Recipients "[::sargs::get $sargs .email_recipients],[::sargs::get $sargs .email_archive_list]"; ::mime::setheader $PassedEmailToken Reply-To "[::sargs::get $sargs .email_reply_to]"; ::mime::setheader $PassedEmailToken From "[::sargs::get $sargs .email_tls_username]"; ::set EmailQuery [::mime::buildmessage $PassedEmailToken]; #//::puts "pgq,debug...::QW::OAUTH::email_send EmailQuery==$EmailQuery"; # ::mime::finalize $EmailMime; ;#// caller is doing this # ::set EmailBase64 [::string map {+ - / _ = ""} [::base64::encode -maxlen 0 $EmailQuery]]; ::set EmailBase64 [::base64::encode -maxlen 0 $EmailQuery]; #//::puts "pgq,debug...::QW::OAUTH::email_send after base64 encode EmailBase64==$EmailBase64"; ::dict set GmailHeaders Authorization "Bearer $OauthAccessToken"; #::return; ::http::register https 443 [list ::tls::socket -tls1 1]; ::switch -glob -- $EmailProvider { "*google*" { ::set EmailUrl "https://www.googleapis.com/gmail/v1/users/me/messages/send"; ::set EmailQuery "\{\"raw\": \"$EmailBase64\"\}"; ::set EmailToken [::http::geturl $EmailUrl -headers $GmailHeaders -type application/json -query $EmailQuery]; } "*microsoft*" { ::set EmailUrl "https://graph.microsoft.com/v1.0/me/sendMail"; ::set EmailQuery $EmailBase64; ::set EmailToken [::http::geturl $EmailUrl -headers $GmailHeaders -type text/plain -query $EmailQuery]; } } #//::puts "pgq,debug2384...::QW::OAUTH::EmailToken after ::http::geturl EmailToken==$EmailToken"; ::set EmailTokenNcode [::http::ncode $EmailToken]; #//::puts "pgq,debug2384...::QW::OAUTH::EmailToken HttpNcode==$EmailTokenNcode"; #//::puts "pgq,debug2384...::QW::OAUTH::EmailToken HttpStatus==[::http::status $EmailToken]"; ::set EmailResponseBody [::http::data $EmailToken]; #//::puts "pgq,debug2384...::QW::OAUTH::EmailResponseBody==$EmailResponseBody"; ::set EmailResponseBody [::sargs::json2sargs .json $EmailResponseBody]; #//::puts "pgq,debug2384...::QW::OAUTH::EmailResponseBody==(\n[::sargs::format $EmailResponseBody]\n)"; ::sargs::var::set sargs .email_send_response_ncode $EmailTokenNcode; ::sargs::var::set sargs .email_send_response_body $EmailResponseBody; ::sargs::var::set sargs .email_send_success [::expr {$EmailTokenNcode==200||$EmailTokenNcode==202}]; ::http::cleanup $EmailToken; ::http::unregister https; ::return $sargs; } catch Error { #//::puts "pgq,debug2384...::QW::OAUTH::oauth_redirect send email Error==$Error"; ::qw::throw $Error; } } ::proc email_access_token_refresh {sargs} { ::switch -glob -- [::sargs::get $sargs .oauth.email_provider] { "*google*" { ::set RefreshUrl "https://oauth2.googleapis.com/token"; } "*microsoft*" { ::set RefreshUrl "https://login.microsoftonline.com/common/oauth2/v2.0/token"; } } ::set RefreshQuery "client_id=[::sargs::get $sargs .oauth.client_id]&client_secret=[::sargs::get $sargs .oauth.client_secret]&refresh_token=[::sargs::get $sargs .oauth.refresh_token]&grant_type=refresh_token"; ::http::register https 443 [list ::tls::socket -tls1 1]; ::set RefreshResponse [::http::geturl $RefreshUrl -type application/x-www-form-urlencoded -query $RefreshQuery]; #//::puts "pgq,debug2384...::QW::OAUTH::email_send RefreshResponse after ::http::geturl RefreshResponse==$RefreshResponse"; #//::puts "pgq,debug2384...::QW::OAUTH::email_send RefreshResponse HttpNcode==[::http::ncode $RefreshResponse]"; #//::puts "pgq,debug2384...::QW::OAUTH::email_send RefreshResponse HttpStatus==[::http::status $RefreshResponse]"; ::set RefreshResponseBody [::sargs::json2sargs .json [::http::data $RefreshResponse]]; # ::sargs::var::set RefreshResponseBody .email [::sargs::get $OauthSargs .email_tls_username]; #//::puts "pgq,debug2384...::QW::OAUTH::email_send RefreshResponse RefreshResponseBody==(\n[::sargs::format $RefreshResponseBody]\n)"; /* { pgq,debug2384...::QW::OAUTH::email_send RefreshResponse RefreshResponseBody== .access_token ya29.a0AXeO80T4K_YL8XzI6bZWUiVRX2awBDdRWmdA_rLD_BYZwU24-SdoBvQkbdm4PCZ6rSki6adG8AL3h6ega-IampCEVCx5Ki37SOqFFkTNj-d56qAWxOAwQdw5TUIGFdAhRxMEpGe60Z_xXXZrjYfAOMYK0SSmEdlR_U5uz5dc9gaCgYKAZkSARESFQHGX2MitvU9t-6YM8NwrWbHhXNoEg0177 .expires_in 3599 .scope {https://www.googleapis.com/auth/userinfo.email openid https://www.googleapis.com/auth/gmail.send} .token_type Bearer .id_token eyJhbGciOiJSUzI1NiIsImtpZCI6ImZhMDcyZjc1Nzg0NjQyNjE1MDg3YzcxODJjMTAxMzQxZTE4ZjdhM2EiLCJ0eXAiOiJKV1QifQ.eyJpc3MiOiJodHRwczovL2FjY291bnRzLmdvb2dsZS5jb20iLCJhenAiOiI1NTY2MjQ3MzQ3OTMtNXZudHBrZjRrZjI1aGRjcXE0cXJmc2tlazY4MjI4Y2cuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJhdWQiOiI1NTY2MjQ3MzQ3OTMtNXZudHBrZjRrZjI1aGRjcXE0cXJmc2tlazY4MjI4Y2cuYXBwcy5nb29nbGV1c2VyY29udGVudC5jb20iLCJzdWIiOiIxMDM2MjgyNDQxNzg0NzM1MTA4ODIiLCJlbWFpbCI6IndhcmRiZW5uMTBAZ21haWwuY29tIiwiZW1haWxfdmVyaWZpZWQiOnRydWUsImF0X2hhc2giOiJaNlA1TzV0bmtJUDBnNkg1Q2VUV0lRIiwiaWF0IjoxNzM4Nzc0OTI5LCJleHAiOjE3Mzg3Nzg1Mjl9.btk97xrHn31ybmkCB5uhvgfGdMdBdfconMF02QTFThfIe7Jz54XVbjItpT9NE_reSit3vsR5Ern492gsw1Ixp1La8NTm9MD-eK-WDWCzq7DyVetLDGpP2ALPR0kfNGHP_ZjPCElI1zJHpFiQZ5qIgUzTKXZEwTdBxRypqWdjmLJZtpNQTTGVN4psMJ14xSLTTbQKuwfW-ax-hpA3vfoO5SZO_QccIRYXCD_974ahBgfLz7DMXgP_tXZ1EVMfgJK75PXu1zYMDlgR4yDrnQXqPuOGPsyRWnVijH9gF32jh22Vxnow0FL38DSMMdTJKKoBK1K3N3rJX5-a12wlCvWS9A */} ::sargs::var::set sargs .oauth.access_token [::sargs::get $RefreshResponseBody .access_token]; ::if {[::http::ncode $RefreshResponse] != 200} { ::qw::throw "Could not refresh the token. Please sign back in from NewViews"; #::qw::throw "Could not refresh the token. Response from the email server==$RefreshResponseBody"; } ::http::cleanup $RefreshResponse; ::http::unregister https; ::return $sargs; } } #//::puts "pgq,debug2384.../gui/gui.qw_tcl exit";