# ------------------------------------------------------------ # Copyright (c) 2003-2020 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ /* { 2.28.3 Moved qw::help related code from qw.qw_tcl to .../doc/qw_help.qw_lib 2.28.3 Help tags are a non-starter. We built the help structure and then removed the pages that did not match the tags. But what we didn't consider until we started really using tags is that we want to have multiple pages with the same page id but different tags. So we have to skip pages as we build the help structure instead of filtering them out after building the help structure. */ } # ------------------------------------------------------------ # Examples of launching and linking to help. # ------------------------------------------------------------ /* { ------------------------------------ Link into the manual from help page. ------------------------------------ From a help page such as one on a prompt or error message, we wish to provide a link into a specific page in the manual: [p { For more see [link .chm [::file join $::qw_data manual.chm] .id 314120121012113810 .bookmark 314120140530154232 {Brief Run-Through}]. }] The .id is the page id and the .bookmark (optional) is identified by a bookmark in the manual if you want to position on a specific position in the page. */ } # ------------------------------------------------------------ # 2.31.0 - Moving help from chm to the browser. # ------------------------------------------------------------ /* { Attempting to move help and manual from .chm to browser. This will presumably make us more platfom independant. Current strategy: (1) ::qw::launch This was used to launch hh $::qw::manual_file and the accounting primer. There are still occurrences in the menu commands that require a version change to fix. The qw::launch command was reimplemented to handle these but should otherwise be deprecated. (2) qw::htmlhelp This launches a chm file and positions on a particular page. A good example is the help/keyboard command that places us on 150220040804162555.htm within the manual.chm. Now maps to ::qw::launch_manual_page (3) qw_chtml_compile.qw_script for reports such as auto_reconcile Testing auto_reconcile. This is a case of using the jstree and ui_layout to create the report. The auto_reconcile chm file was not launched immediately but afterward so it could be positioned on a particular page. This made handling it special. todo: Select the node in the jstree that corrsponds to .initial_page_path. (4) Total to report. Total to graphs, semiloop search use qw_chtml_compile and they all work. Replaced their main_help methods. (5) qw_chtml_compile.qw_script for error and dialog help. Help on errors and dialogs typically calls qw_chtml_compile. It typically produces a single page and we will want that page to be rendered in a browser with no tree. Turn off ::qw::control(browser_help) to compile the manual to .chm. Otherwise it will attempt to produce a single page. (6) Help pages with links to manual. These use something like [::link .chm $ManualFile .id $PageId .bookmark $BookmarkId]; database_backup.qw_script has a link in it's confim help. Will start there and then check the rest. Grep for ".chm ". ------------------------------------------------------------------- (7) Some more things to do. Many pages look naked because not heading. Maybe use the title. I think errors are ok but prompts aren't. Nah, just add h1's to the page where you see them. (8) Can't we cut out the css file? For manual it should be easy. But what about pages built on the fly? We should be able to link ok, but where do we put the file. Actually, why not use in-line css for generated pages and a linked css for manual pages. Or if the web server is always running, we could use the same link either way. (9) pay attention to console and eliminate all errors and warnings. ------------------------------------------------------------------- (1) Try to isolate help access to this file. (2) Continue to build manual to .chm and convert to web. This is the easiest way to do it because chm2web conversion retains all chm functionality. Can replace that with out own builder eventually. (3) All links into manual must be replaced. These must respect the version. (4) Generate error/script help for browser instead of chm. (5) Some reports use chm and will have to check that. Auto-reconcile. Totalto semiloops. (6) Launching help from windows start menu. (7) Cases in menus that launch help. Example in 222_223_low.tcl ::qw::launch "hh [::file join $::qw_data accounting_primer.chm]"; This implies we certainly can only introduce in version change (8) Hunt down all uses of $::qw_manual_file (9) Some menu items call qw_chtml_compile We need to fix that for error and other help anyway */ } ::namespace eval ::qw::help {} #rwb_custom #::source [::file join $::qw_program_path system chtml.qw_lib]; # - do we need chtml right here or can it wait until later, i.e. on demand? ::proc ::qw::launch_manual_page {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.0,sargs==$sargs";} ::set ChmPath [::sargs::get $sargs .chm_path]; ::set PageId [::sargs::get $sargs .id]; ::if {$PageId eq ""} { ::qw::throw \ .text "::qw::launch_manual_page - couldn't load help page without page id." \ ; } ::if {[::string index $PageId 0] ne "/"} { ::set PageId "/$PageId"; } ::switch -glob -- $ChmPath { *manual.chm { ::if {$PageId eq ""} { ::set PageId 150220040726110330; # root of nv2_manual.chm ::set PageId 150220040726110330 ; # root of nph_manual.chm } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.1";} ::set ShortVersion [::string map [::list "." ""] $::qw_version]; # ::set Url "$::qw::control(qw_manual_url)/qw_manual/${ShortVersion}${::qw_patch_level}_${::qw_sub_product}/topics$PageId"; ::set Url "$::qw::control(qw_manual_url)/qw_manual/${::qw_sub_product}/topics$PageId"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.2,url==$Url";} ::qw::launch_browser .url $Url; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.3";} } *accounting_primer.chm { ::if {$PageId eq ""} { ::set PageId 618020120530100215; # root of accounting_primer.chm } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.4";} ::set Url "$::qw::control(qw_manual_url)/qw_manual/accounting_primer/topics$PageId"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.5,url==$Url";} ::qw::launch_browser .url $Url; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_manual_page,1000.6";} } default { ::qw::throw \ .text "Couldn't load help page $PageId." \ ; } } } ::if {$::qw::control(browser_help)&&$::tcl_version>=8.6} { /* { 2.31.0 Introduced qw::launch_browser. We have separate versions for 8.4 and 8.6 because of the use of {*} in 8.6. */ } ::proc ::qw::launch_browser {sargs} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.0,sargs==$sargs";} ::set Url [::sargs::get $sargs .url]; ::set CommandList [::list xdg-open open start]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.1";} ::foreach Command1 $CommandList { ::if {$Command1 eq "start"} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.2";} ::set Command [::list {*}[::auto_execok start] {}]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.3";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.4";} ::set Command [::auto_execok $Command1]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.5";} } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.6";} ::if {$Command ne ""} { ::break; } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.7";} ::if {$Command eq ""} { ::qw::throw \ .text "Couldn't launch help because couldn't find browser." \ .error_id 314120170214133943 \ ; } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.8";} ::eval ::exec $Command $Url &; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,1000.9";} } catch Exception { ::qw::throw \ .text "Error encountered launching browser:$Exception"; .error_id 314120170214133944 \ ; } } } ::if {$::qw::control(browser_help)&&$::tcl_version<=8.4} { ::proc ::qw::launch_browser {sargs} { /* { ::if {!$::qw::control(browser_help)} { ::qw::bug 314120170205121112 "Unexpected ::qw::launch_browser call."; } */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.0,sargs==$sargs";} ::set Url [::sargs::get $sargs .url]; ::set CommandList [::list xdg-open open start]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.1,CommandList==$CommandList";} ::foreach Command1 $CommandList { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.1.0,Command1==$Command1";} ::if {$Command1 eq "start"} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.2";} ::set Command [auto_execok start]; ::lappend Command {}; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.3";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.4";} ::set Command [::auto_execok $Command1]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.5";} } ::if {$Command ne ""} { ::break; } } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.6";} ::if {$Command eq ""} { ::qw::throw \ .text "Couldn't lauch help because couldn't find browser." \ ; } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.7";} ::eval ::exec $Command $Url &; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.8";} } catch Exception { ::qw::throw \ .text "Error encountered launching browser:$Exception"; ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch_browser,2000.9";} } } ::proc ::qw::launch {CommandLine} { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.0,CommandLine==$CommandLine";} ::if {!$::qw::control(browser_help)} { /* { 2.31.0 We would really like to get rid of the ::qw::launch command and just launch applications directly. In this version we do get rid of the cpp implementation of qw::launch which was platform dependent. But we still have qw::launch calls in the qw menus which require a version change to fix. So for now, we just intercept them here. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.0.0";} ::set Result [::eval ::exec $CommandLine &]; ::return $Result; } ::set Command0 [::lindex $CommandLine 0]; ::switch -glob -- $Command0 { "hh" { ::set HelpFile [::string tolower [::lindex $CommandLine 1]]; ::if {$HelpFile eq $::qw_manual_file} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.1";} ::set ShortVersion [::string map [::list "." ""] $::qw_version]; #::set Url "http://benn7:8015/qw_manual/2304_alpha_nv2/index.html"; # ::set Url "$::qw::control(qw_manual_url)/qw_manual/${ShortVersion}${::qw_patch_level}_${::qw_sub_product}/index.html"; ::set Url "$::qw::control(qw_manual_url)/qw_manual/${::qw_sub_product}/index.html"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.2,Url==$Url";} ::qw::launch_browser .url $Url; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.3";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.10";} ::if {[::string match "*accounting_primer.chm" $HelpFile]} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.11";} ::set Url "$::qw::control(qw_manual_url)/qw_manual/accounting_primer/index.html"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.12,Url==$Url";} ::qw::launch_browser .url $Url; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::launch,1000.13";} ::return; } } } # 2.31.0 - added the & to next line ::set Result [::eval ::exec $CommandLine &]; ::return $Result; } ::proc ::qw::help::launch_from_error_dialog {s_args} { /* { We are invoked from an error dialog. .tree.structure This contains the error structure that the error dialog is using. Within this structure each node will contain fields such as .text and .help_id plus any other fields that the thrower set such as .command. These are passed along to the help page. .tree.handle The actual handle of the error dialog. Turns out we don't use it. Our job is to produce a temporary chm file and launch it. We could and did implement the error help to switch to indivdual pages depending on which error node was active. However, instead, we now append all of the help into one big help page closure so that the user can see everything at once. In the help page, each message is presented in a header followed by the text rendered from the help page identified by the error message's .help_id. If it has no .help_id we artificially generate a little body that in effect says there is no help. Of course we do not have to do this. */ } ::set Formatter [::itcl::local ::qw::html::formatter #auto]; ::set ErrorMessageStructure [::sargs::get $s_args .tree.structure]; ::set Paths [::sargs::select_field .structure $ErrorMessageStructure .field .text]; ::set UniqueId 0; ::set Body ""; ::foreach Path $Paths { /* { We iterate through the paths in the order returned by the select. This is a top down forward traversal that conforms to order seen in the error tree. We render the page associated with each error message as identified by its .help_id and we append this page to the body. We are making a single page whose body is the closure of all the pages associated with all error messages in the error structure. This is more convenient than forcing the user to click on each tree node. Also, on other platforms we might not have a tree in the final error help screen. We generate one h2 header for each error message in the final body. */ } ::set Error [::sargs::get $ErrorMessageStructure $Path]; ::set HelpId [::sargs::get $Error .help_id]; #2.10 ::set HelpPage [::sargs::get $Error .help_page]; ::set Text [::sargs::get $Error .text]; ::set Title [::string map {"\"" ""} $Text]; ::set RenderedTitle [::subst -nobackslashes -nocommands {[h2 {$Title}]}]; ::append Body $RenderedTitle; ::sargs::var::set ErrorMessageStructure "$Path.title" $Title; ::sargs::var::set ErrorMessageStructure "$Path.id" "3141[::clock seconds][::incr UniqueId]"; ::if {$HelpPage eq ""} { ::if {$HelpId eq ""} { /* { If there is no help for an error message we create an arbitrary body that says so in some way. We coult instead leave it blank. The resulting help page will show the error message in a header regardless. */ } ::append Body { [p { There is no help on this error. Either it needs no further explanation or else help is currently under construction. }] } ::continue; } ::set HelpPage [::qw::help::find_page_by_id $HelpId]; } ::sargs::var::+= HelpPage [::sargs::get $ErrorMessageStructure $Path]; ::append Body [::sargs::get [$Formatter body_render $HelpPage] .body]; } ::foreach Path $Paths { /* { The body has been completely built as the closure of all the error help bodies at this point. Now we iterate through the tree structure that we will eventual pass the help compiler and give each node this body. This may be inefficient but it has not been a problem. What is important is that the user sees the tree in the left pane and the full help in the right pane regardless of what he/she clicks on in the left pane. */ } ::sargs::var::set ErrorMessageStructure $Path.body $Body; } ::qw::script::source \ .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script] \ .structure $ErrorMessageStructure \ .compiler.command error \ ; ::return; } /* { ::proc ::qw::help::launch_from_dialog {s_args} { /* { We are bringing up a single help page. The s_args contains .help_id. We automatically make a header from the page title. */ } ::set Formatter [::itcl::local ::qw::html::formatter #auto]; ::set HelpId [::sargs::get $s_args .help_id]; ::set Body ""; ::set HelpPage [::qw::help::find_page_by_id $HelpId]; ::set Title [::sargs::get $HelpPage .title]; ::append Body [::subst -nocommands {[h2 {$Title}]}]; # ::append Body [::sargs::get [$Formatter body_render $HelpPage] .body]; ::append Body [::sargs::get $HelpPage .body]; ::sargs::var::set s_args .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script]; ::sargs::var::set s_args .structure.title $Title; ::sargs::var::set s_args .structure.id $HelpId; ::sargs::var::set s_args .structure.body $Body; /* { ::set SArgs ""; ::sargs::var::set SArgs .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script]; ::sargs::var::set SArgs .structure.title $Title; ::sargs::var::set SArgs .structure.id $HelpId; ::sargs::var::set SArgs .structure.body $Body; */ } # ::qw::script::source $SArgs; ::qw::script::source $s_args; # ::qw::help::launch $TargetHelpStructure; } */ } ::proc ::qw::help::launch_help_page {sargs} { /* { We are bringing up a single help page. This is used mainly from registration and similar dialogs that are hand-rolled. The sargs contains .help_id and any other values to be passed on to the help page. We automatically make a header from the page title. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.00";} ::switch -- [::sargs::get $sargs .help_id] { "314120041120114620" - "314120180221174307" { /* { 2.34.5 We used to have about.qw_help but we move it to qw_help_about.qw_script. However, the gui still tries to launch the help page, i.e. about.qw_help. We didn't fix this in the past and we still won't until we have a version change in order to fix the menu. In the meantime we chweck for the help_ids (one for windows and one for unix), and run the script. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.00";} ::sargs::var::unset sargs .help_id; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.00.0";} ::qw::script::source $sargs .script.path [::file join $::qw_program_path doc qw_help_about.qw_script]; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.00.1";} ::return; } } ::set Formatter [::qw::html::formatter ::qw::html::formatter::#auto]; ::qw::finally [::list ::itcl::delete object $Formatter]; ::set Body ""; ::set HelpId [::sargs::get $sargs .help_id]; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.00.0";} ::set HelpPage [::qw::help::find_page_by_id $HelpId]; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.01,HelpId==$HelpId,HelpPage==\n[::sargs::format $HelpPage]";} ::if {[::sargs::size $HelpPage]!=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.02";} ::sargs::var::+= HelpPage $sargs; ::set Title [::sargs::get $HelpPage .title]; ::if {![::sargs::boolean_get $sargs .title_skip]} { ::append Body [::subst -nocommands {[h2 {$Title}]}]; } ::append Body [::sargs::get $HelpPage .body]; ::sargs::var::set HelpPage .body $Body; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.03,HelpId==$HelpId,HelpPage==\n[::sargs::format $HelpPage]";} } else { ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.04";} ::set Title "Help is not available."; ::sargs::var::set HelpPage .title $Title; ::sargs::var::set HelpPage .id 314120050401091056; ::append Body [::subst -nocommands {[h2 {$Title}]}]; ::append Body [::subst -nocommands { [p { Further help is not available. }] }]; ::sargs::var::set HelpPage .body $Body; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.05";} } ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.06";} ::qw::script::source \ .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script] \ .structure $HelpPage \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,launch_help_page,1000.07";} } ::proc ::qw::help::launch_from_dialog {sargs} { /* { We are bringing up a single help page. The sargs contains .help_id. We automatically make a header from the page title. */ } ::set Formatter [::itcl::local ::qw::html::formatter #auto]; ::set Body ""; ::set Tree ""; ::set Count 0; ::set Path ""; ::foreach HelpId [::sargs::get $sargs .help_id] { ::set HelpPage [::qw::help::find_page_by_id $HelpId]; ::if {$HelpPage eq ""} {::continue;} ::sargs::var::+= HelpPage $sargs; ::set Title [::sargs::get $HelpPage .title]; ::append Body [::subst -nocommands {[h2 {$Title}]}]; ::append Body [::sargs::get $HelpPage .body]; ::sargs::var::set Tree $Path $HelpPage; ::append Path "/[::incr Count]"; } ::foreach Path [::sargs::select_field .structure $Tree .field ".id"] { ::sargs::var::set Tree ${Path}.body $Body; } # ::sargs::var::set sargs .structure.title $Title; # ::sargs::var::set sargs .structure.id $HelpId; # ::sargs::var::set sargs .structure.body $Body; ::qw::script::source \ .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script] \ .structure $Tree \ ; } ::proc ::qw::help::launch_from_dialog1 {sargs} { /* { We are bringing up a single help page. The sargs contains .help_id. We automatically make a header from the page title. */ } ::set Formatter [::itcl::local ::qw::html::formatter #auto]; ::set SrcTree [::sargs::get $sargs .structure]; ::set Paths [::sargs::select_field .structure $SrcTree .field .help_id]; ::set UniqueId 0; ::set DstTree ""; ::set Body ""; ::foreach Path $Paths { ::set SrcNode [::sargs::get $SrcTree $Path]; ::set HelpId [::sargs::get $SrcNode .help_id]; ::if {$HelpId eq ""} { ::continue; } ::set HelpPage [::qw::help::find_page_by_id $HelpId]; ::if {$HelpPage eq ""} { ::continue; } ::set Title [::sargs::get $SrcNode .title]; ::if {$Title eq ""} { ::set Title [::sargs::get $HelpPage .title] } ::set RenderedTitle [::string map {"\"" ""} $Title]; ::set RenderedTitle [::subst -nobackslashes -nocommands {[h2 {$RenderedTitle}]}]; ::append Body $RenderedTitle; ::sargs::var::set DstTree $Path $SrcNode; ::sargs::var::set DstTree ${Path}.title $Title; ::sargs::var::set DstTree ${Path}.id "3141[::clock seconds][::incr UniqueId]"; ::if {$HelpId eq ""} { /* { If there is not help for an error message we create an arbitray body that says so in some way. We coult instead leave it blank. The resulting help page will show the error message in a header regardless. */ } ::append Body { [p { There is no help on this dialog. Either it needs no further explanation or else help is currently under construction. }] } ::continue; } ::sargs::var::+= HelpPage [::sargs::get $SrcTree $Path]; ::append Body [::sargs::get [$Formatter body_render $HelpPage] .body]; } ::foreach Path [::sargs::select_field .structure $SrcTree .field ".help_id"] { /* { The body has been completely built as the closure of all the error help bodies at this point. Now we iterate through the tree structure that we will eventual pass the help compiler and give each node this body. This may be inefficient but it has not been a problem. What is important is that the user sees the tree in the left pane and the full help in the right pane regardless of what he/she clicks on in the left pane. */ } ::sargs::var::set DstTree "${Path}.body" $Body; } ::qw::script::source \ .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script] \ .structure $DstTree \ .compiler.command error \ ; } ::proc ::qw::help::launch_from_odb_object {s_args} { /* { Builds the help associated with the fields of a master or actually the fields under any object within a master. odb_build_field_help_tree is a method of a master that builds a structure isomorphic to the master's fields, except it uses generated names for the nodes. We can then place information such as .text, .body, .title, etc., inside these nodes and build a help structure. We need the isometric structure in which to place the information because if we were to use the meta directly we would run into name collisions. */ } ::set Object [::sargs::get $s_args .object]; ::set Master [$Object odb_master]; ::set FieldStructure [$Master odb_build_field_help_tree]; ::for {::set MasterClass $Master;} {![$MasterClass odb_is_class]&&[$MasterClass odb_base] ne ""} {::set MasterClass [$MasterClass odb_base]} {} ::set Database [$Master odb_database]; ::set Meta [$Master odb_meta_get]; ::set NodePaths [::sargs::select_field .structure $FieldStructure .field .odb_address]; ::foreach NodePath $NodePaths { ::set Field [$Database cpp_find_from_address [::sargs::get $FieldStructure $NodePath.odb_address]]; ::set FieldPath [$Field odb_path_from_master]; ::set Type [::sargs::get $Meta $FieldPath.odb.type]; ::set MasterPath [::regsub "/SYSTEM/TRANSACTION" "[$MasterClass odb_path]" "/TRANSACTION"]; ::set FullPath "$MasterPath$FieldPath"; ::if {$Type eq "master"} { ::for {::set Class $Field;} {![$Class odb_is_class]&&[$Class odb_base] ne ""} {::set Class [$Class odb_base]} {} ::set Title [$Class odb_id]; ::set Text [$Class odb_id]; ::set Name [$Class odb_id]; ::set Body [::subst -nocommands { [h2 $FullPath] [table { [tr { [td { Name }] [td { $Name }] }] [tr { [td { Type }] [td { $Type }] }] }] }]; } else { ::set Title [$Field odb_id]; ::set Text [$Field odb_id]; ::for {::set Introduced $Field;} {[$Introduced odb_base] ne ""} {::set Introduced [$Introduced odb_base]} {} ::set Introduced [[$Introduced odb_master] odb_path]; ::set Introduced [::regsub "/SYSTEM/TRANSACTION" "$Introduced" "/TRANSACTION"]; ::set Name [$Field odb_id]; ::set Body [::subst -nocommands { [h2 $FullPath] [table { [tr { [td { Name }] [td { $Name }] }] [tr { [td { Type }] [td { $Type }] }] [tr { [td { Path }] [td { $FieldPath }] }] [tr { [td { Defined in Class }] [td { $Introduced }] }] }] }]; } ::switch -- $Type { "index" { ::set Schema [$Field odb_schema]; ::set SchemaKey [::sargs::get $Schema .key]; ::set Components [::sargs::inners .structure $SchemaKey]; ::if {[::llength $Components]} { ::append Body [::subst -nocommands { [h2 { Index Key Components }] [p { Indexes are sorted by a key. The key is an ordered list of key components that controls the sort order. The key components for index [qw_field_name $FieldPath] are displayed in the table below. }] }]; ::append Body [::subst -nocommands { [table \{ [tr { [td { Name }] [td { Type }] }] }]; ::foreach Component $Components { ::set ComponentType [::sargs::get $SchemaKey $Component.type]; ::append Body [::subst -nocommands { [tr { [td { $Component }] [td { $ComponentType }] }] }] }; ::append Body [::subst -nocommands { \}\] }] ::set Schema [[$Field odb_outer] odb_schema]; ::set CollectionPaths [::sargs::select_field .structure $Schema .field .get]; ::append Body [::subst -nocommands { [h2 { Running Balances }] [p { The running balances for index [qw_field_name $FieldPath] are displayed in the table below. }] }]; ::append Body [::subst -nocommands { [table \{ [tr { [td { Amount }] [td { Description }] }] }]; ::foreach AmountPath $CollectionPaths { ::set Description [::sargs::get_poly $Schema $AmountPath.description]; ::append Body [::subst -nocommands { [tr { [td { $AmountPath }] [td { $Description }] }] }] }; ::append Body [::subst -nocommands { \}\] }] } } "collection" { ::set Schema [$Field odb_schema]; ::set CollectionPaths [::sargs::select_field .structure $Schema .field .get]; ::append Body [::subst -nocommands { [h2 { Running Balances }] [p { All indexes for a collection have the same running balances. The running balances for collection [qw_field_name $FieldPath] are displayed in the table below. }] }]; ::append Body [::subst -nocommands { [table \{ [tr { [td { Amount }] [td { Description }] }] }]; ::foreach AmountPath $CollectionPaths { ::set Description [::sargs::get_poly $Schema $AmountPath.description]; ::append Body [::subst -nocommands { [tr { [td { $AmountPath }] [td { $Description }] }] }] }; ::append Body [::subst -nocommands { \}\] }] } } ::set HelpIds [[$Field odb_master] odb_field_help_ids [::sargs .field_path $FieldPath]]; ::foreach HelpId $HelpIds { ::set HelpPage [::qw::help::find_page_by_id $HelpId]; ::if {$HelpPage ne ""} { ::append Body [::sargs::get $HelpPage .body]; } } ::sargs::var::set FieldStructure $NodePath.text $Text; ::sargs::var::set FieldStructure $NodePath.title $Title; ::sargs::var::set FieldStructure $NodePath.body $Body; } ::qw::script::source \ .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script] \ .title $MasterPath \ .structure $FieldStructure \ ; } # ------------------------------------------------------------ # QW::WIDGET::HTML class # ------------------------------------------------------------ ::itcl::class ::QW::WIDGET::HTML { inherit iwidgets::Scrolledwidget itk_option define -font font Font {-family Arial -size 11 -weight bold} # itk_option define -height height Height 0 itk_option define -selectcommand selectCommand Command {} itk_option define -background background Background white itk_option define -foreground foreground Foreground black itk_option define -selectbackground selectBackground Foreground red itk_option define -selectforeground selectForeground Background white # itk_option define -width width Width 0 method xview {args} {::return [eval $itk_component(tkhtml) xview $args];} method yview {args} {::return [eval $itk_component(tkhtml) yview $args];} method constructor {args} { # itk_option remove iwidgets::Labeledwidget::state # # Create a clipping frame which will provide the border for # relief display. # itk_component add clipper { frame $itk_interior.clipper } { usual keep -borderwidth -relief -highlightthickness -highlightcolor rename -highlightbackground -background background Background } grid $itk_component(clipper) -row 0 -column 0 -sticky nsew grid rowconfigure $_interior 0 -weight 1 grid columnconfigure $_interior 0 -weight 1 itk_component add tkhtml { html $itk_component(clipper).tkhtml \ -width 512 -height 384 \ -padx 5 \ -pady 9 \ -background white \ -xscrollcommand [::itcl::code $this _scrollWidget $itk_interior.horizsb] \ -yscrollcommand [::itcl::code $this _scrollWidget $itk_interior.vertsb] \ -tablerelief raised } {} /* { { # usual # ignore -highlightthickness -highlightcolor # ignore -insertbackground -insertborderwidth # ignore -insertontime -insertofftime -insertwidth # ignore -selectborderwidth # ignore -borderwidth } */ } /* { html .h.h \ -width 512 -height 384 \ -yscrollcommand {.h.vsb set} \ -xscrollcommand {.f2.hsb set} \ -padx 5 \ -pady 9 \ -formcommand FormCmd \ -imagecommand "ImageCmd 1" \ -scriptcommand ScriptCmd \ -appletcommand AppletCmd \ -hyperlinkcommand HyperCmd \ -fontcommand pickFont \ -appletcommand {runApplet small} \ -bg white -tablerelief raised */ } grid $itk_component(tkhtml) -row 0 -column 0 -sticky nsew grid rowconfigure $itk_component(clipper) 0 -weight 1 grid columnconfigure $itk_component(clipper) 0 -weight 1 $itk_component(vertsb) configure -command [::itcl::code $itk_component(tkhtml) yview] $itk_component(horizsb) configure -command [::itcl::code $itk_component(tkhtml) xview] # Add popup menus that can be configured by the user to add new functionality. /* { itk_component add itemMenu { menu $itk_component(list).itemmenu -tearoff 0 } { usual ignore -tearoff rename -cursor -menucursor menuCursor Cursor } itk_component add bgMenu { menu $itk_component(list).bgmenu -tearoff 0 } { usual ignore -tearoff rename -cursor -menucursor menuCursor Cursor } */ } # # Adjust the bind tags to remove the class bindings. Also, add # bindings for mouse button 1 to do selection and button 3 to # display a popup. # # bindtags $itk_component(canvas) [::list $itk_component(canvas) . all] # bind $itk_component(list) [::itcl::code $this _select %x %y] # bind $itk_component(list) [::itcl::code $this _post %x %y] eval itk_initialize $args # kludge alert # We are not handling -background properly # The way we use icons it looks like we will need a plain white background # We have to see how to set default background to white even though # we inherited the background option. configure -background white -vscrollmode dynamic -hscrollmode dynamic -selectbackground red # ::set itk_option(-selectbackground) red; # hide the damn label until we can get rid of altogether # grid forget [component label] # pack forget [component label] # deleting the label causes error when destructing. # itk_component delete label # foreach Option [configure] {puts $Option}; /* { Kludge Alert: Plus/Minus Box size. Because the plus/minus box might not be displayed in any particular item we cannot always use canvas item information to get their size. So we create a temporary box here and get its size once. */ } # $itk_component(canvas) create image 0 0 -image [cget -box_minus] -anchor nw -tags _temp_; # ::set BoundingBox [$itk_component(canvas) bbox _temp_]; # $itk_component(canvas) delete _temp_; # ::set _box_width [::expr [::lindex $BoundingBox 2]-[::lindex $BoundingBox 0]]; # ::set _box_height [::expr [::lindex $BoundingBox 3]-[::lindex $BoundingBox 1]]; } destructor { # puts "QW::WIDGET::HTML destructor" } } /* { # ------------------------------------------------------------ # ::QW::WIDGET::TREE::HELP # ------------------------------------------------------------ ::itcl::class ::QW::WIDGET::TREE::HELP { inherit ::QW::WIDGET::TREE; public variable _toplevel ""; public itk_option define -structure structure Fractal {} /* { public itk_option define -structure structure Fractal {} { ::if {[::sargs::is_primitive $itk_option(-structure)]} { ::set itk_option(-structure) [::list .text $itk_option(-structure)]; } } */ } public constructor {args} { ::eval ::QW::WIDGET::TREE::constructor $args; } { ::eval itk_initialize $args; } # destructor {chain;} method items {Path} {::return [::llength [::sargs::names .structure [::sargs::get $itk_option(-structure) $Path] .glob /*]]; #*/} method node_class {} {::return ::QW::WIDGET::TREE::HELP::NODE;} method root_get {} {::return "";} method text_get {Path} { ::return [::subst [::sargs::get $itk_option(-structure) $Path.title]]; ::puts "About to render title:$Title"; ::set Rendered [$_toplevel render [::sargs::get $itk_option(-structure) $Path.title]]; ::puts "Rendered:$Rendered"; ::return [$_toplevel render [::sargs::get $itk_option(-structure) $Path.title]]; # ::return [::sargs::get $itk_option(-structure) $Path.title]; } method kids_get {Path} { ::set Field [::sargs::get $itk_option(-structure) $Path]; ::set Names [::sargs::subs .structure $Field]; ::set Result ""; ::foreach Name $Names {::lappend Result $Path$Name;} return $Result; } method icon_get {Path} { # ::if {![items $Path]} {::return $_icon_leaf;} ::if {[[node $Path] isExpanded]} {::return $_icon_open;} return $_icon_closed; } method select_path {Path} { [node $Path] expand; } method toplevel {Arg} {::set _toplevel $Arg;return $this;} } ::itcl::class ::QW::WIDGET::TREE::HELP::NODE { inherit ::QW::WIDGET::TREE::NODE; public constructor {args} { ::eval ::QW::WIDGET::TREE::NODE::constructor $args; } { } # destructor {chain;} } */ } # ------------------------------------------------------------ # ::QW::TOPLEVEL::HELP class # ------------------------------------------------------------ ::itcl::class ::QW::TOPLEVEL::HELP { inherit ::itk::Toplevel; protected variable _me; protected variable _paned ""; protected variable _pane_left ""; protected variable _pane_right ""; protected variable _tree ""; protected variable _html ""; protected variable _options ""; protected variable _help ""; protected variable _formatter ""; method constructor {args} { ::set WindowType scrolledhtml; # ::set WindowType tkhtml; # ::set WindowType scrolledtext; ::set Defaults [::sargs::+= $::qw::widget::options [::subst { .title "NewViews Help" .class "HelpToplevel" .sound "" .bbox "" .file "" .default "" .files 1 .orient vertical /button { .text "Text not specified." .command {} /select { .text Select } /cancel { .text Cancel .command {::set ::qw::dialog::result ""} } /help { .text Help } } .window $WindowType }]]; ::set _options $Defaults; ::sargs::var::+= _options $args; ::set _help [option_get .page]; # ::if {[option_get ".file"] ne ""} { # ::set _help [::structure_load [option_get ".file"]]; # } ::set _formatter [::qw::html::formatter #auto]; /* { We render the titles now because the tree widget knows nothing about subst. */ } ::foreach Path [::sargs::select_field .structure $_help .field ".text"] { ::sargs::var::set _help $Path [$_formatter render [::sargs::get $_help $Path]]; } ::set _options [::sargs::set $_options .structure $_help]; ::set _options [::sargs::set $_options .command.select [::itcl::code $this node_selected]]; ::set _me $itk_component(hull); # ::wm geometry $Toplevel 300x[::expr {int(300.0*1.618)}]; ::set Width 6; ::set Height $Width; # ::set Height [::expr {int($Width*1.618)}]; ::set _paned [::iwidgets::panedwindow $_me.pw -width ${Width}i -height ${Height}i]; ::pack $_paned -padx 4 -pady 4 -expand yes -fill both; $_paned add "top" ::set _pane_left [$_paned childsite "top"]; # ::set _help [::structure_load c:/qw/lib/help_newviews.structure]; # ::set _tree [::QW::WIDGET::TREE::HELP $_pane_left.l]; ::set _tree [::eval ::QW::WIDGET::TREE::FRACTAL $_pane_left.l $_options]; # $_tree toplevel $this; # $_tree configure -structure $_help; ::pack $_tree -expand 1 -fill both; ::if {[option_get .default] eq ""} { # [$_tree node ""] expand } else { # $_tree select_path [::sargs::get $Args .default]; # $_tree select_path ""; } $_tree option_set .font [option_get .font]; # $_tree option_set .command [::list .select [::itcl::code $this node_selected]]; $_tree draw; $_paned add "bottom"; ::set _pane_right [$_paned childsite "bottom"]; ::switch -- [option_get ".window"] { tkhtml { ::set _html [::QW::WIDGET::HTML $_pane_right.l] } scrolledtext { # ::set _html [::iwidgets::scrolledtext $_pane_right.l -hscrollmode [option_get /scroll/horizontal.mode] -vscrollmode [option_get /scroll/vertical.mode]]; ::set _html [::iwidgets::scrolledtext $_pane_right.l -hscrollmode [option_get /scroll/horizontal.mode] -vscrollmode dynamic]; } scrolledhtml { ::set _html [::iwidgets::scrolledhtml $_pane_right.l -hscrollmode [option_get /scroll/horizontal.mode] -vscrollmode [option_get /scroll/vertical.mode]]; $_html configure -fontname helvetica $_html configure -fontsize large } } ::pack $_html -expand 1 -fill both; render [::sargs::get $_help ".body"]; # ::set OptionMenu [::iwidgets::optionmenu $_me.orient]; # $OptionMenu configure -labeltext "Orientation:" -command [::list $_paned configure -orient [$OptionMenu get]]; # ::pack $OptionMenu -padx 4 -pady 4 # $OptionMenu insert end horizontal vertical configure -title [option_get ".title"] $_paned configure -orient [option_get ".orient"]; ::set Left [::expr int((1.0/2.618)*100.0)]; ::set Right [::expr {100-$Left}]; $_paned fraction $Left $Right; puts "Paned window complete"; } destructor { ::qw::try { ::destroy $_html; ::set _html ""; ::destroy $_pane_right; ::set _pane_right ""; ::destroy $_tree; ::set _tree ""; ::destroy $_pane_left; ::set _pane_left ""; ::itcl::delete object $_formatter; ::set _formatter ""; } catch Exception { ::qw::warning 314120040817103132 "Help window destructor caught exception:$Exception"; } } method option_get {Path} {::return [::sargs::get_poly $_options $Path];} method option_set {args} { ::qw::s_args_marshal; ::sargs::var::+= _options $s_args; } method render {Body} { ::puts "body 1:$Body" ::set Body [$_formatter render $Body]; ::puts "body 2:$Body" ::switch -- [option_get ".window"] { tkhtml { [$_html component tkhtml] clear; [$_html component tkhtml] parse $Body; } scrolledtext { $_html delete 1.0 end; $_html insert end "$Body\n"; } scrolledhtml { $_html clear; $_html render $Body; } } ::return $Body; } /* { method html_recreate {} { ::if {$_html ne ""} { ::destroy $_html; ::set _html [::QW::WIDGET::HTML $_pane_right.l] ::pack $_html -expand 1 -fill both; } } */ } /* { method html_set {Path} { # html_recreate puts "html display a" ::set Script [::sargs::set $_help $Path.body]; puts "html display b" ::set Body [render $Script]; puts "Going to display html:" puts $Body; puts "html display 1" [$_html component tkhtml] clear; # ::set Html [::itcl::scope [$_html component tkhtml]]; # ::set Html [$_html component tkhtml]; puts "html display 2" [$_html component tkhtml] parse $Body; # ::after idle "[::itcl::scope $Html clear];[::itcl::scope $Html parse $Body];" # ::after idle "$Html clear;$Html parse {$Body};" puts "html display 3" } */ } /* { method html_set {Path} { # html_recreate puts "html display a" ::set Body [::sargs::set $_help $Path.body]; $_html delete 1.0 end; $_html insert end "$Body\n"; # ::set Html [::itcl::scope [$_html component tkhtml]]; # ::set Html [$_html component tkhtml]; puts "html display 3" } */ } method node_selected {} { puts "node_selected 1" puts "tree selecteds:\"[$_tree selecteds]\"" ::set Path [::lindex [$_tree selecteds] 0]; ::set Body [::sargs::set $_help $Path.body]; render $Body; puts "node_selected 3" } } ::proc ::qw::help {args} { ::eval ::QW::TOPLEVEL::HELP .#auto .file [::sargs::get $args ".file"]; } #::namespace eval ::qw::help {} /* { The next line is a temporary fix to find the root of the help system. It is generally the qw program directory and this is not necessary, but during development we are keeping the code and help separate so that the developers do not clobber each other's stuff. */ } ::proc ::qw::help::window {args} { /* { .structure The help Structure; .page { .id 314120030520122325 .path c:/qw .window { .type chtml,tk } } */ } ::qw::try { ::set Paths [::qw::select @@@] ::set Structure [::sargs::get $args .structure]; ::if {$Structure eq ""} {::set Structure [::qw::help::qw_help_load];} ::set PageId [::sargs::get $args .page.id]; ::if {$PageId ne ""} { ::set PagePath [::sargs::find_field_value .structure $Structure .field .id .value $PageId]; ::if {$PagePath eq ""} {::qw::throw "Could not find help with page id \"$PageId\".";} } ::set WindowType [::sargs::get $args .window.type]; ::switch -- $WindowType { "" - chtml { } tk { ::set Structure [::eval ::qw::help::page_load $args]; ::return [::eval ::QW::TOPLEVEL::HELP .#auto {.page $Structure}]; } default { ::qw::throw "Encountered invalid window type \"$WindowType\"."; } } } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Could not create help window with arguments \"$args\"."]; } } ::proc ::qw::help::process_title_field {sargs} { /* { # 2.34.0 Usage: ::set NewPage [::qw::help::process_title_field $sargs .page $Page]; The title field needs special processing so that we can tag it. Note: We dislike too many methods. this method is called from regular pages and the root page. If it were only called once we would have done it in line. The .title field must be specified even it it isn't used. .title "This is the default title." .title_list { title_tag_manual_nph "The Rain in Spain" title_tag_manual_nv2 "The Rain in Italy" } */ } ::set NewTitle ""; ::set Page [::sargs::get $sargs .page]; ::set PageId [::sargs::get $Page .id]; ::set TitleList [::sargs::get $Page .title_list]; ::set MainTagList [::sargs::get $sargs .title_tag_list]; ::if {[::llength $TitleList]==0} { ::return $Page; } ::if {[::llength $MainTagList]==0} { ::return $Page; } /* { Both main title tag list and the page title list are non-empty so we use them to select a new title from the page's title list. If the */ } ::if {[::llength $TitleList]%2!=0} { ::qw::throw \ .text "Mal-formed .title_list in page id \"$PageId\"." \ .error_id 314120190730170953 \ ; } ::foreach {TitleTag Title} $TitleList { ::if {[::lsearch $MainTagList $TitleTag]>=0} { ::if {$Title eq ""} { ::qw::throw \ .text "Empty title in .title_list in page id \"$PageId\"." \ .error_id 314120190730170954 \ ; } ::sargs::var::set Page .title $Title; ::return $Page; } } ::return $Page; } # ------------------------------------------------------------ # ::qw::help::file_expander # ------------------------------------------------------------ ::textutil::expander ::qw::help::file_expander; ::qw::help::file_expander setbrackets (file* *file); ::set ::qw::help::_file_expander ""; # ------------------------------------------------------------ # ::qw::help::_file_path_stack - for relative files in ::qw::help::file_include. # ------------------------------------------------------------ ::set ::qw::help::_file_path_stack [::list]; ::proc ::qw::help::file_path_stack_push {sargs} { ::set Path [::sargs::get $sargs .path]; ::lappend ::qw::help::_file_path_stack $Path; } ::proc ::qw::help::file_path_stack_pop {sargs} { ::if {[::llength $::qw::help::_file_path_stack]==0} { ::qw::bug 314120191220143304 "[::qw::procname] - tried to pop an empty stack." } ::set Top [::lindex $::qw::help::_file_path_stack end]; ::set ::qw::help::_file_path_stack [::lreplace $::qw::help::_file_path_stack end end]; ::return $Top; } ::proc ::qw::help::file_path_stack_top {sargs} { ::set Top [::lindex $::qw::help::_file_path_stack end]; ::return $Top; } ::proc ::qw::help::file_load {sargs} { /* { 2.28.3 Usage: ::qw::help::file_load $sargs .path $FilePath; returns processed file as a path/page list, or if this is the "root" page, then structure is returned. The sargs contains all sargs oroginally passed to the help compiler. Come processing including skipping comments, file expander on (file* ... *file), and is_hit test on .page_tag_list. At the same time, since we now process the file, we may as well allow comments. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.0,sargs==\n[::sargs::format $sargs]";} ::set FilePath [::sargs::get $sargs .path]; ::if {$FilePath eq ""} { ::qw::throw \ .text "[::qw::procname] - no .path argument." \ .error_id 314120150917154735 \ ; } ::if {[::file pathtype $FilePath] eq "relative"} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.0.0,relative==$FilePath";} ::set FilePath [::file join [::file dirname [::qw::help::file_path_stack_top]] $FilePath]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.0.1,absolute==$FilePath";} ::set FilePath [::file normalize $FilePath]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.0.2,normalized==$FilePath";} } /* { 2.34.1 Added ability to specify relative file paths in file_include statements. The path is considered to be relative to the folder of the page containing the file_include statement. So for example we use ../common/backing_up.qw_help to specify the basckip_up file from the nv2 or nph manuals. */ } ::qw::help::file_path_stack_push .path $FilePath; ::qw::finally [::list ::qw::help::file_path_stack_pop]; /* { 2.34.0 The .parent_page_path was added when implementing the file_include mechanism. It enables us to figure out the full path to a page, which is the path in the local file prepended by the parent_page_path. When processing the "root" file, containing the "root" page, the parent_page_path is of course empty. The root page is somewhat special because we allowed it's inner fields to be global within the file. */ } ::set ParentPagePath [::sargs::get $sargs .parent_page_path]; # ------------------------------------------------------------ # read the file specified by .path. # ------------------------------------------------------------ ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.1.0";} ::set FileContentsBefore [::qw::fileutil::file_read .path $FilePath]; ::set Milli0 [::clock clicks -milliseconds]; # ------------------------------------------------------------ # Expand (file* ... *file) macros. # ------------------------------------------------------------ ::if {$rwb1_debug} { ::set Milli0 [::clock clicks -milliseconds]; ::set FileContents [::qw::help::file_expander expand $FileContentsBefore]; ::puts "rwb1_debug,expand,file size==[::file size $FilePath],milliseconds==[::expr {[::clock clicks -milliseconds]-$Milli0}]"; } else { ::set FileContents [::qw::help::file_expander expand $FileContentsBefore]; } # ------------------------------------------------------------ # Check field/value form. # ------------------------------------------------------------ ::if {[::llength $FileContents]%2!=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.1.1.1";} ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\", syntax error, mismatched braces?" \ .error_id 314120150917154736 \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.1.1.2";} /* { Managing backslash continuation in code examples. ------------------------------------------------ 2.28.3 We have a problem working with the continuation character, i.e. a backslash at the end of a line. This really doesn't seem to happen in help files in general, but occurs in source code. We can change such source code manually with a find and replace, substituting \ but the subst command is usually used to process a help file and this processes the continuation characters, merging multiple lines into a single line, before they can be replaced later. We tried at several points but they were always too late. So we do it here, at the very earliest moment. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.1.2";} ::set FileContents [::string map [::list "\r" ""] $FileContents]; ::set FileContents [::string map [::list "\\\n" "\\n"] $FileContents]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.2";} ::set ErrorHelpPage { .id 314120150917160958 .tags {error} .body { [p { This is all because of tags. There are two ways to define the root page of a help file. If there is only one root page then inner fields (starting with dot) are used to define it. When tags are used, you can provide more than one root page, (even can have the same id), by wrapping each root page in the path [qw_quoted /]. One and only one of these multiple root pages can be selected using tags and will be used as the [qw_quoted real] root page. }] [p { So you can have a single root page defined using inner fields, or you have one or more root pages using the [qw_quoted /] path, but don't use both techniques in the same file. }] } } ::set InnerFieldCount 0; # non-zero iff using inners to define root page ::set RootPageCount 0; # count of root pages wrapped in path "/" ::set RootPage [::sargs]; # Root Page in either case. ::set FieldBodyPairs [::list]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.3";} ::foreach {Path Value} $FileContents { ::if {$Path eq "/*"} { # ------------------------------------------------------------ # Skip inter-page comments. # ------------------------------------------------------------ /* { Comments can occur between help pages and this also means help pages and/or groups of help pages can be commented out. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.4";} ::continue; } ::if {$Path eq "/"} { # ------------------------------------------------------------ # Handle potential "/" root page. # ------------------------------------------------------------ /* { We have to wrap the root page separately. The root page can still be spread out in dot fields but not if we need two or more root pages separated by tags. */ } ::if {$ParentPagePath ne ""} { ::qw::throw \ .text "[::qw::procname] - invalid page path \"$Path\" in non-root page." \ .error_id 314120191126145022 \ .help_page $ErrorHelpPage \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.5";} ::if {$InnerFieldCount!=0} { ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\" can't have both fields and a root page." \ .error_id 314120150917154737 \ .help_page $ErrorHelpPage \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.5.0";} ::if {[::qw::help::page_is_hit $sargs .page $Value]} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.5.1";} ::if {$RootPageCount!=0} { ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\", has multiple root pages matching tags." \ .error_id 314120150917154739 \ ; } ::if {[::sargs::get $Value .page_file_path] eq ""} { ::sargs::var::set Value .page_file_path $FilePath; } ::incr RootPageCount 1; # 2.34.0 ::set Value [::qw::help::process_title_field $sargs .page $Value]; ::set RootPage $Value; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.5.2";} ::continue; } ::if {[::string match ".*" $Path]} { # ------------------------------------------------------------ # Handle root page inner field. # ------------------------------------------------------------ /* { This is an inner field, i.e. a root page field. */ } ::if {$ParentPagePath ne ""} { ::qw::throw \ .text "[::qw::procname] - invalid inner field \"$Path\" in non-root page." \ .error_id 314120191126145022 \ .help_page $ErrorHelpPage \ ; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.6";} ::if {$RootPageCount!=0} { ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\" can't have both fields and a root page." \ .error_id 3141201509171547140 \ .help_page $ErrorHelpPage \ ; } ::if {[::sargs::exists $RootPage $Path]} { ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\", root page has duplicate field \"$Path\"." \ .error_id 314120150917154741 \ ; } ::sargs::var::set RootPage $Path $Value; ::incr InnerFieldCount 1; ::continue; } ::if {![::sargs::is_field_path $Path]} { ::if {$Path ne "/"} { ::qw::throw \ .text "[::qw::procname] - invalid help page path \"$Path\"." \ .error_id 314120191128183405 \ ; } } ::if {![::string match "/*" $Path]} { # ------------------------------------------------------------ # Regular page's path must start with slash/name. # ------------------------------------------------------------ ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\", invalid field \"$Path\"." \ .error_id 314120150917154743 \ ; } # ------------------------------------------------------------ # Process "ordinary" help page. # ------------------------------------------------------------ /* { This is an "ordinary" help page. We check for a duplicate path but that's about it. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.7";} ::set PageId [::sargs::get $Value .id]; ::if {$PageId eq ""} { ::qw::throw \ .text "Page $Path has no .id field." \ .error_id 314120150923191023 \ ; } ::set Title [::sargs::get $Value .title]; ::if {$Title eq ""} { ::qw::throw \ .text "Page with id $PageId has no .title field." \ .error_id 314120190730151655 \ ; } ::if {[::sargs::get $Value .page_file_path] eq ""} { /* { We are adding a field to the page indicating the file from which the page was actually loaded. We need this for such commands a img so that we can look for the .src path relative to the original file path. This is useful when loading a file using ::qw::help::file::include because the images belonging to the pages you are including are probably in the same folder that contained the included file. */ } ::sargs::var::set Value .page_file_path $FilePath; } # ------------------------------------------------------------ # Prepend the parent page path. # ------------------------------------------------------------ ::set Path "${ParentPagePath}$Path"; ::if {[::qw::help::page_is_hit $sargs .page $Value]} { # ------------------------------------------------------------ # If page is a hit append it to the result. # ------------------------------------------------------------ ::if {[::lsearch $FieldBodyPairs $Path]>=0} { ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\", has duplicate page \"$Path\"." \ .error_id 314120150917154742 \ ; } # 2.34.0 ::set Value [::qw::help::process_title_field $sargs .page $Value]; ::lappend FieldBodyPairs $Path [::sargs::format $Value]; } } ::if {$ParentPagePath ne ""} { # ------------------------------------------------------------ # This file was included. Return path/page list as is. # ------------------------------------------------------------ ::return $FieldBodyPairs; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.8";} ::if {$ParentPagePath eq ""&&[::sargs::size $RootPage]==0} { ::qw::warning 314120151006190236 "[::qw::procname] - file \"$FilePath\" has no root page." /* { This was put in when we upgraded the processing of help tags but it tripped over various newviews help files. ::qw::throw \ .text "[::qw::procname] - file \"$FilePath\" has no root page." \ .error_id 314120150917154744 \ ; */ } } ::set HelpPageResult [::sargs]; ::foreach Path [::sargs::select_leaves .structure $RootPage] { # ------------------------------------------------------------ # Process root page inner fields. # ------------------------------------------------------------ ::sargs::var::set HelpPageResult $Path [::sargs::get $RootPage $Path]; } ::foreach {Path Value} $FieldBodyPairs { # ------------------------------------------------------------ # Turn Field/Body list into structure. # ------------------------------------------------------------ ::sargs::var::set HelpPageResult $Path $Value; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::file_load,1000.10";} ::return $HelpPageResult; } /* { ::proc ::qw::help::file_load_before_228_3 {FilePath} { # replaces 2.28.3 /* { Doesn't appear to be used. */ } ::set File [::open $FilePath r]; ::set Data [::read $File]; ::close $File; ::set Result ""; ::qw::try { ::set HasText 0; ::foreach {Path Value} $Data { ::if {$Path eq ".text"} { ::set HasText 1; ::sargs::var::set Result $Path $Value; ::continue; } ::if {$Path eq ".body"} { ::set HasText 1; ::sargs::var::set Result $Path $Value; ::continue; } ::if {HasText} ::sargs::var::set Result $Path $Value; } } catch Exception { ::qw::throw [::qw::exception::nest parent .sub $Exception .super "Could not load file \"$FilePath\"."]; } # ::puts "Fractal for file $FilePath:"; # ::puts [::sargs::format .structure $Result]; return $Result; } */ } ::namespace eval ::qw::help { variable _help_page_structure ""; variable _help_page_paths_by_page_id; # index is .help_id, element is page path. } ::array set ::qw::help::_help_page_ids {}; ::proc ::qw::help::find_page_by_id {HelpId} { variable _help_page_structure; variable _help_page_paths_by_page_id; /* { Searches the main help structure for the page identified by the id and returns that page. Returns empty if the page cannot be found. Loads the help structure on demand first. */ } ::qw::help::load_all; ::if {![::info exists _help_page_paths_by_page_id($HelpId)]} { ::return ""; } ::return [::sargs::get $_help_page_structure $_help_page_paths_by_page_id($HelpId)]; } ::proc ::qw::help::load_all {} { /* { Loads help structure on demand. Calls ::qw::help::page_load to do it, passing it a .path argument. Builds _help_page_paths_by_page_id, and array of help page paths, indexed by help_id. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::help::load_all,1000.00";} variable _help_page_structure; variable _help_page_paths_by_page_id; ::if {[::sargs::size $_help_page_structure]!=0} { ::return $_help_page_structure; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::help::load_all,1000.01";} ::set _help_page_structure [::qw::help::page_load [::sargs .path $::qw_program_path]]; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::help::load_all,1000.02,_help_page_structure==\n[::sargs::format $_help_page_structure]";} ::if {[::sargs::size $_help_page_structure]==0} { ::qw::throw "Could not load help structure."; } ::foreach Path [::sargs::select_field .structure $_help_page_structure .field .id] { ::set PageId [::sargs::get $_help_page_structure ${Path}.id]; ::if {[::info exists _help_page_paths_by_page_id($PageId)]} { ::qw::throw "Duplicate help page id \"$PageId\"."; } ::set _help_page_paths_by_page_id($PageId) $Path; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::help::load_all,1000.03";} ::return $_help_page_structure; } ::proc ::qw::help::launch {Page} { ::set Args ""; ::sargs::var::set Args .script.path [::file join $::qw_program_path doc qw_chtml_compile.qw_script]; ::sargs::var::set Args .structure $Page; ::qw::script::source $Args; } ::proc ::qw::help::directory_load {s_args} { #puts "314120030502,s_args:$s_args" ::set Path [::sargs::get $s_args .path]; ::set Extension [::sargs::get $s_args .extension]; ::if {$Path eq ""} {::qw::throw "Encountered empty path.";} ::if {![::file exists $Path]} {::qw::throw "Expected folder \"$Path\" to exist.";} ::if {![::file isdirectory $Path]} {::qw::throw "Expected \"$Path\" to be a folder.";} ::set Result ""; ::if {[::file exists [::file join $Path "this$Extension"]]} { ::set Result [::sargs::file::get [::file join $Path "this$Extension"]]; } ::foreach Kid [::glob -nocomplain [::file join $Path *]] { ::set KidTail [::string tolower [::file tail $Kid]]; ::if {$KidTail eq "this$Extension"} {continue;} ::set KidName [::file rootname $KidTail]; ::set KidExtension [::file extension $KidTail]; ::if {[::file isdirectory $Kid]} { ::set Structure [::qw::help::directory_load [::sargs .path $Kid .extension $Extension]]; ::if {$Structure ne ""} { ::if {$Result eq ""} { ::sargs::var::set Result .title "[::file tail $Path]"; ::sargs::var::set Result .id [::qw::id_factory]; ::sargs::var::set Result .body {[p "Help is not defined for this topic."]}; } ::sargs::var::set Result /[::file tail $Kid] $Structure; } continue; } ::if {![::file isfile $Kid]} {continue;} ::if {$KidExtension ne $Extension} {continue;} #2.28.3 ::set Structure [::sargs::file::get $Kid]; ::set Structure [::qw::help::file_load $s_args .path $Kid]; ::if {$Structure ne ""} { ::if {$Result eq ""} { ::sargs::var::set Result .title "[::file tail $Path]"; ::sargs::var::set Result .id [::qw::id_factory]; ::sargs::var::set Result .body {[p "Help is not defined for this topic."]}; } ::sargs::var::set Result "/$KidName" $Structure; } } return $Result; } ::set ::qw::help::structure ""; ::proc ::qw::help::qw_help_load {} { ::if {$::qw::help::structure eq ""} { ::set ::qw::help::structure [::qw::help::page_load $::qw_program_path]; } return $::qw::help::structure; } ::proc ::qw::help::page_load {sargs} { /* { Loads all documentation under a specified directory and returns it as a structure. .path Loads all documentation found under this directory. If the directory is not specified then $::qw_program_path is used as the default. .extensions Loads only files that match these extensions. If the extensions are not specified or are empty, then the default extension is ".qw_help". Loads and returns a sargs structure representing help. The .path argument identifies the page. It can be a path to a directory, file, or extend right into a file. .path c:/qw We follow the path through the directory system, node by node. If the current node is a directory, we search its files and/or sub-directory for the next node. When the current node is a file and there are additional nodes in the path, we load the file, which should have the form of a sargs structure, and continue within that structure. The path can end in one of three places: directory We traverse the entire sub-tree and build the help structure from all files found within it. file We load the entire file as the help structure. structure We are within a file and we load the node as the help structure. Mapping the directory system to a help structure. ------------------------------------------------- What do we do with directories? Do they become nodes in the tree? Suppose we have the following directory structure: qw object newviews account ar ap report system dos printer procedure odds_and_ends home transaction general server worstation system audit user session access A branch node shows up in the tree with any file/sub-directories as kids in the tree. But what is displayed in the right pane of a branch? Can a branch have its own contents? The this.qw_help file supplies the contents of a branch. If a branch has no contents we can either display help not available or else general an index into the kids. This method finds and builds the structure representing the help. Rather than provide for a potentially complicated assortment of functionality for page selection, we leave it to the caller to manupulate the resulting pages in any way desired after the retrieval. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.0,sargs==$sargs";} ::set Path [::sargs::get $sargs .path]; ::set Extension [::sargs::get $sargs .extension]; ::if {$Extension eq ""} { ::set Extension .qw_help; } # ::set Path [::sargs::get ".path c:/qw_help" .path]; # puts "314120030513,page being loaded is:$Path"; ::if {$Path eq ""} { ::set Path $::qw_program_path; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.1";} ::qw::try { ::set Suffix [::file split $Path]; ::set Prefix ""; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.2";} ::while {[::llength $Suffix]!=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.3";} ::lappend Prefix [::lindex $Suffix 0]; ::set Suffix [::lreplace $Suffix 0 0]; ::set FilePath [::eval ::file join $Prefix]; ::if {![::file exists $FilePath]} { ::qw::throw "Could not find qw_help file \"$FilePath\"."; } ::if {[::file isdirectory $FilePath]} { ::continue; } ::if {![::file isfile $FilePath]} { ::qw::throw "Expected \"$FilePath\" to be a file or folder."; } /* { We have reached a file. We load the file. If the suffix is empty we return the entire file. Otherwise we extract the page identified by the suffix and return it. */ } #2.28.3 ::set Structure [::sargs::file::get $FilePath]; ::set Structure [::qw::help::file_load $sargs .path $FilePath]; ::if {$Suffix eq ""} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.4";} ::return $Structure; } ::set PagePath "/[::eval ::file join $Suffix]"; ::if {![::sargs::exists $Structure $PagePath]} { ::qw::throw "Could not find help page \"$PagePath\" in file \$FilePath\"."; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.5";} ::return [::sargs::get $Structure $PagePath]; } } catch Exception { ::qw::throw [::qw::exception::nest .sub $Exception .super "Could not load help page \"$Path\"."]; } /* { We have reached the end of the path without encountering a file. The path must represent a directory. We call directory_load which will load help associated with the directory and recursively load any help under the directory. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.6";} ::set Result [::qw::help::directory_load [::sargs .path $Path .extension $Extension]]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::help::page_load,1000.7";} # puts "314120030501 Loaded the following structure:"; # puts "[::sargs::format .structure $Result]"; ::return $Result; # return [::qw::help::directory_load .path $Path]; } #::proc ::qw::help::select_tags {Structure FieldName FieldValue {Parent ""} {Name ""}} {} ::proc ::qw::help::select_tags {s_args} { /* { .tags The list of tags to match. .structure The structure to match within. Returns a list of all paths for all pages that match. */ } ::set Structure [::sargs::get $s_args .structure]; ::set Tags [::sargs::get $s_args .tags]; ::set Parent [::sargs::get $s_args .parent]; ::set Kid [::sargs::get $s_args .kid]; ::set PageTags [::sargs::get $Structure .tags]; ::set Result ""; ::foreach Tag $Tags { ::if {[::lsearch -glob $Tag $PageTags]>=0} { ::lappend Result $Parent$Kid; break; } } ::foreach KidName [::sargs::subs .structure $Structure] { ::foreach KidPath [select_tags [::qw::list { .structure [::sargs::get $Structure $KidName] .parent $Parent$Kid .kid $KidName .tags $Tags }]] { ::lappend Result $KidPath; } } return $Result; } ::proc ::qw::help::page_is_hit {sargs} { /* { .page - This is the help structure to filter. It will also contain a .page_tag_list field. .page_tag_list - Called on a page to see if it is a hit using .page_tag_list. The compiler is called with a main .page_tag_list, and each page has a .page_tag_list. If either is empty, then the page is deemed to be a hit. Otherwise it's a hit if the interection is non-empty. If you don't want to ever include a page just set it's .page_tag_list to something like "dummy" or "null". */ } ::set rwb1_debug 0; ::set Page [::sargs::get $sargs .page]; ::if {[::sargs::size $Page]==0} { ::qw::throw \ .text "[::qw::procname] - empty .page argument." \ .error_id 314120150924091410 \ ; } ::set MainTagList [::sargs::get $sargs .page_tag_list]; ::if {[::llength $MainTagList]==0} { # ------------------------------------------------------------ # No main .page_tag_list specifies that all pages are hits. # ------------------------------------------------------------ ::return 1; } ::set PageTagList [::sargs::get $Page .page_tag_list]; ::if {[::llength $PageTagList]==0} { # ------------------------------------------------------------ # If pages's page .page_tag_list is empty, then page is a hit. # ------------------------------------------------------------ ::return 1; } ::set IntersectList [::qw::intersect $MainTagList $PageTagList]; ::if {[::llength $IntersectList]!=0} { ::return 1; } ::return 0; } ::proc ::qw::help::file_include {sargs} { /* { Usage: ::qw::help::file_include \ .path c:/a/b/c.qw_help \ ?.parent_path /314120191126160528? \ ; Returns the contents of the file. Assumes the file is in the form of a sargs. Prepends the path of each page so that it can be included under a parent node in the calling file. This is to be used in global page space, not in a page body. Expands (file* ... *file). Very similar to file_load but but recursion. rwb1_debug,file_include,1000.0,sargs==.path j:/qw_manual_234/common/backing_up.qw_help */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,file_include,1000.0,sargs==$sargs";} ::set Result [::qw::help::file_load $sargs]; ::if {$rwb1_debug} {::puts "rwb1_debug,file_include,1000.1";} ::return $Result; }