home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / help_sys.pkg < prev    next >
Encoding:
Text File  |  1993-05-19  |  23.9 KB  |  773 lines
  1. // HELP_SYS.PKG
  2. // February 2, 1992
  3. // LS
  4. //
  5. // Help System Package
  6.  
  7. #CHKSUB 1 1 // Verify the UI subsystem.
  8.  
  9. use Sellist
  10. use Data_Set
  11.  
  12. #COMMAND DEFINE_SYMBOL R "FOR" R
  13.   #IFDEF !1
  14.   #ELSE
  15.     #REPLACE !1 !3
  16.   #ENDIF
  17. #ENDCOMMAND
  18.  
  19. #COMMAND USE_FILE R
  20.   #IFDEF !1.RECNUM
  21.   #ELSE
  22.     #INCLUDE !1.FD
  23.   #ENDIF
  24.  
  25.   #IFDEF !1.FILE_NUMBER
  26.   #ELSE
  27.     #SET Q$ !1.RECNUM
  28.     #REPLACE !1.FILE_NUMBER |CI!q
  29.   #ENDIF
  30.  
  31.   #IF (!0>1)
  32.     USE_FILE !2 !3 !4 !5 !6 !7 !8 !9
  33.   #ENDIF
  34. #ENDCOMMAND
  35.  
  36. DEFINE_SYMBOL HELP_FOR_HELP_NAME   FOR 'HELP FOR HELP' //special values of
  37. DEFINE_SYMBOL HELP_KEYS_NAME       FOR 'KEYS HELP' // HELP_NAME 
  38. DEFINE_SYMBOL HELP_NAME_LENGTH     FOR 40
  39. DEFINE_SYMBOL HELP_GRP_FILENAME    FOR 'helpgrp' // default filenames
  40. DEFINE_SYMBOL HELP_SBJ_FILENAME    FOR 'helpsbj'
  41. DEFINE_SYMBOL HELP_XRF_FILENAME    FOR 'helpxrf'
  42. DEFINE_SYMBOL HELP_CTX_FILENAME    FOR 'helpctx'
  43. DEFINE_SYMBOL HELP_FILENAME_PREFIX FOR 'help'// default filename prefix
  44. DEFINE_SYMBOL HELP_STACK_ELEMENTS  FOR 50 // # of previous topics to remember
  45.  
  46. DEFINE_SYMBOL MAX_LINES_ALLOWED    FOR 32767
  47.  
  48. USE_FILE GRP SBJ XRF CTX  // allow file and field references w/o opening files
  49.  
  50. /////////////////////////////////////////////////////////////////////////////
  51. ////////////////////////////  C L A S S E S  ////////////////////////////////
  52. /////////////////////////////////////////////////////////////////////////////
  53.  
  54. //-//-//-//-//-//-//-//   HELP_TEXT
  55.  
  56. // help oriented subclass of edit class - read_only, no block marking,
  57. // recognizes zoom/shrink functions
  58.  
  59. class Help_Text is an EDIT
  60.     procedure Construct_Object
  61.         forward send Construct_Object
  62.  
  63.         property integer Zoom_Cancel_Obj Public 0
  64.         property integer Zoom_State      Public 0
  65.  
  66.         set Read_Only_State to True
  67.  
  68.         on_key kDownarrow    send Scroll_Down_Line Private
  69.         on_key kUparrow      send Scroll_Up_Line   Private
  70.         on_key kScroll_Left  send None             Private
  71.         on_key kScroll_Right send None             Private
  72.     end_procedure
  73.  
  74.     procedure Mouse_Drag integer wdw integer char_pos
  75.         send Mouse_Down wdw char_pos
  76.     end_procedure
  77.  
  78.     procedure Next
  79.         if not (Zoom_State( Current_Object )) forward send Next
  80.     end_procedure
  81.  
  82.     procedure Previous
  83.         if not (Zoom_State( Current_Object )) forward send Previous
  84.     end_procedure
  85.  
  86.     procedure Read string Fil
  87.       set Max_Lines to MAX_LINES_ALLOWED
  88.       if NUM_ARGUMENTS GE 1 forward send Read Fil
  89.       else forward send Read
  90.       set Max_Lines to (Line_Count(Current_Object))
  91.     end_procedure
  92.  
  93.     procedure Request_Cancel
  94.         local integer Ret_Val
  95.  
  96.         delegate get Msg_Request_Cancel to Ret_Val
  97.         procedure_return Ret_Val
  98.     end_procedure
  99.  
  100.     procedure Scroll_Down_Line
  101.       send Scroll Downward_Direction 1
  102.     end_procedure
  103.  
  104.     procedure Scroll_Up_Line
  105.       send Scroll Upward_Direction 1
  106.     end_procedure
  107.  
  108.     procedure Shrink_Text
  109.         set Zoom_State to False
  110.         send Deactivate to (Zoom_Cancel_Obj( Current_Object ))
  111.     end_procedure
  112.  
  113.     procedure View_Help_For_Help
  114.         if not (Zoom_State( Current_Object )) delegate send View_Help_For_Help
  115.     end_procedure
  116.  
  117.     procedure Zoom_Text
  118.         send Activate
  119.         send Popup to (Zoom_Cancel_Obj( Current_Object ))
  120.         send Activate
  121.         set Zoom_State to True
  122.     end_procedure
  123. end_class
  124.  
  125. //-//-//-//-//-//-//-//   HELP_PICK_DATA_SET
  126.  
  127. // help pick data set class for pick list (below).
  128.  
  129. class Help_Pick_Data_Set is a DATA_SET
  130.     procedure Construct_Object integer Img
  131.         forward send Construct_Object Img
  132.  
  133.         object Xrf_Set is a DATA_SET no_image main_file Xrf
  134.             set Focus_Mode to No_Activate
  135.         end_object
  136.     end_procedure
  137. end_class
  138.  
  139. //-//-//-//-//-//-//-//   HELP_PICK
  140.  
  141. // help pick class for selecting groups in help index and subjects of
  142. // specific groups.
  143.  
  144. class Help_Pick is a CLIENT
  145.     procedure Construct_Object integer Img integer List_Img integer Cancel_Img
  146.         forward send Construct_Object Img
  147.  
  148.         property integer Action_Msg Public 0
  149.  
  150.         set Block_Mouse_State   to True
  151.         set Center_State item 0 to True
  152.         set Popup_State         to True
  153.         set Scope_State         to True
  154.  
  155.         object Grp_Set is a Help_Pick_Data_Set no_image main_file Grp
  156.             set Focus_Mode to No_Activate
  157.         end_object
  158.  
  159.         object List is a SELECTION_LIST List_Img
  160.             set Local_Rotate_State to False
  161.             set Ordering           to Index.1
  162.             set Select_Mode        to No_Select
  163.  
  164.             begin_row
  165.                 entry_item Grp.Grp_Name
  166.             end_row
  167.  
  168.             // list must become batch to allow sorting of sbj_names - no index
  169.             // ordered by sbj_name for xrf file.  currently displays in
  170.             // sbj.recnum sequence.
  171.  
  172.             on_key kCancel           send Request_Cancel Private
  173.             on_key kEnter            send Choose_Topic   Private
  174.             on_key kExit_Application send Quit_Help      Private
  175.             on_key kHelp             send None           Private
  176.         end_object
  177.  
  178.         object Cancel is a BUTTON Cancel_Img
  179.             set Focus_Mode to Pointer_Only
  180.  
  181.             item_list
  182.                 on_item "<Esc=Cancel>" send Request_Cancel
  183.             end_item_list
  184.  
  185.             on_key kCancel           send Request_Cancel Private
  186.             on_key kExit_Application send Quit_Help      Private
  187.             on_key kHelp             send None           Private
  188.         end_object
  189.     end_procedure
  190.  
  191.     procedure Accept_List integer Msg
  192.         set Action_Msg to Msg
  193.         send Popup
  194.     end_procedure
  195.  
  196.     procedure Add_Focus integer Obj
  197.         local integer Lst
  198.  
  199.         move (List( Current_Object )) to Lst
  200.         set Dynamic_Update_State of Lst to False
  201.         forward send Add_Focus Obj
  202.         send Beginning_Of_Data to Lst
  203.         set Dynamic_Update_State of Lst to True
  204.     end_procedure
  205.  
  206.     procedure Choose_Topic
  207.         local integer Obj Rec_ID
  208.  
  209.         get Prior_Level to Obj
  210.         get Current_Record of (List( Current_Object )) to Rec_ID
  211.         send Deactivate
  212.         send (Action_Msg( Current_Object )) to Obj Rec_ID
  213.     end_procedure
  214.  
  215.     procedure Delete_Data
  216.         send Delete_Data to (List( Current_Object ))
  217.     end_procedure
  218.  
  219.     procedure Pick_Group integer Msg
  220.         local integer Itm Lst
  221.  
  222.         clear Grp
  223.         find GE Grp.Grp_Name
  224.  
  225.         [ Found ] begin
  226.             move (List( Current_Object )) to Lst
  227.             set Main_File of Lst to Grp.File_Number
  228.             set Server of Lst to (Grp_Set( Current_Object ))
  229.             set Data_File of (Element( Lst )) item 0 to Grp.File_Number
  230.             send Prepare_List "Help Index" Grp.File_Number ;
  231.               (Grp_Set( Current_Object )) Grp.File_Number
  232.             send Accept_List Msg
  233.         end
  234.     end_procedure
  235.  
  236.     procedure Pick_Subject integer Grp_Num String Ttl integer Msg
  237.         local integer Itm Lst
  238.  
  239.         clear Xrf
  240.         move Grp_Num to Xrf.Grp_Recnum
  241.         find GE Xrf.Grp_Recnum
  242.         [ Found ] indicate Found as Xrf.Grp_Recnum EQ Grp_Num
  243.  
  244.         [ Found ] begin
  245.             send Prepare_List Ttl Xrf.File_Number ;
  246.               (Xrf_Set( Grp_Set( Current_Object ) )) Sbj.File_Number
  247.             send Accept_List Msg
  248.         end
  249.     end_procedure
  250.  
  251.     procedure Prepare_List string Ttl integer Mfil integer Svr integer Ffil
  252.         local integer Lst
  253.  
  254.         set Value item 0 to Ttl
  255.         move (List( Current_Object )) to Lst
  256.         set Main_File of Lst to Mfil
  257.         set Server of Lst to Svr
  258.         set Data_File of (Element( Lst )) item 0 to Ffil
  259.         send Scan_Servers to Lst
  260.         send Rebuild_Constraints to Svr
  261.         send Delete_Data
  262.     end_procedure
  263.  
  264. #IFSUB 'AREA_FLAG'
  265. #ELSE
  266.   #REPLACE AREA_FLAG 3  //scope AND popup
  267. #ENDIF
  268.  
  269.     procedure Request_Cancel
  270.         send Deactivate AREA_FLAG
  271.     end_procedure
  272.  
  273.     procedure Quit_Help
  274.     local integer Ret_Val
  275.  
  276.     send Request_Cancel
  277.         delegate get Msg_Request_Cancel to Ret_Val
  278.         procedure_return Ret_Val
  279.     end_procedure
  280. end_class
  281.  
  282. //-//-//-//-//-//-//-//   HELP_STACK
  283.  
  284. // help stack class for storing and retrieving the list of topics
  285. // selected by the user during a help session.
  286.  
  287. class Help_Stack is an ARRAY
  288.     procedure Construct_Object
  289.         forward send Construct_Object
  290.         property integer Current_Item Public -1 // -1 = no items
  291.     end_procedure
  292.  
  293.     procedure Delete_Data
  294.         forward send Delete_Data
  295.         set Current_Item to -1
  296.     end_procedure
  297.  
  298.     procedure Push_Item integer Val
  299.         set Current_Item to (Current_Item( Current_Object ) + 1)
  300.  
  301.         if (Current_Item( Current_Object )) GE HELP_STACK_ELEMENTS ;
  302.             set Current_Item to 0
  303.  
  304.         set Array_Value item (Current_Item( Current_Object )) to Val
  305.     end_procedure
  306.  
  307.     function Pop_Item returns integer
  308.         local integer Old_Itm New_Itm Ret_Val
  309.  
  310.         move -1 to Ret_Val
  311.         get Current_Item to Old_Itm
  312.  
  313.         if (Old_Itm >= 0 and Integer_Value( Current_Object, Old_Itm ) <> 0 ) ;
  314.           begin
  315.             move (Old_Itm - 1) to New_Itm
  316.  
  317.             if (New_Itm < 0 and Integer_Value( Current_Object, ;
  318.               HELP_STACK_ELEMENTS - 1) <> 0) ;
  319.               move (HELP_STACK_ELEMENTS - 1) to New_Itm
  320.  
  321.             if New_Itm GE 0 get Integer_Value item New_Itm to Ret_Val
  322.  
  323.             if Ret_Val GT 0 set Array_Value item Old_Itm to 0
  324.             else move Old_Itm to New_Itm
  325.             set Current_Item to New_Itm
  326.         end
  327.  
  328.         function_return Ret_Val
  329.     end_function
  330. end_class
  331.  
  332. //-//-//-//-//-//-//-//   HELP_SYSTEM
  333.  
  334. // standard help system class for full context sensitive help support
  335.  
  336. class Help_System is a HELP
  337.     procedure Construct_Object integer Img ;
  338.       integer See_Also_Img integer Menu_Img ;
  339.       integer Pick_Img integer Pick_List_Img integer Pick_Cancel_Img ;
  340.       integer Zoom_Cancel_Img integer Cant_Open_Img
  341.  
  342.         forward send Construct_Object Img
  343.  
  344.         property string  Context_Filename  Public  HELP_CTX_FILENAME
  345.         property string  Filename_Prefix   Private HELP_FILENAME_PREFIX
  346.         property string  Group_Filename    Public  HELP_GRP_FILENAME
  347.         property string  Link_Filename     Public  HELP_XRF_FILENAME
  348.         property integer Remain_Open_State Public  0 // to keep help files open
  349.         property string  Subject_Filename  Public  HELP_SBJ_FILENAME
  350.  
  351.         set Block_Mouse_State   to True
  352.         set Center_State item 0 to True
  353.         set Center_State item 1 to True
  354.         set Client_Area_State   to True
  355.         set Location            to 2 11 Relative
  356.         set Popup_State         to True
  357.         set Ring_State          to True
  358.         set Scope_State         to True
  359.  
  360.         object Text is a HELP_TEXT
  361.             set Location to 3 1 Relative
  362.             set Size     to 10 56
  363.  
  364.             send Read_Dbms Sbj.Sbj_Text True // True arg sets Filename w/o read
  365.  
  366.             on_key kCancel           send Request_Cancel     Private
  367.             on_key kExit_Application send Request_Cancel     Private
  368.             on_key kHelp             send View_Help_For_Help Private
  369.             on_key kZoom             send Toggle_Zoom        Private
  370.         end_object
  371.  
  372.         object Zoom_Cancel is a BUTTON Zoom_Cancel_Img
  373.             set Focus_Mode  to Pointer_Only
  374.             set Location    to 19 1 Relative
  375.             set Popup_State to True
  376.  
  377.             item_list
  378.                 on_item "<Alt+F9=Cancel zoom>" send Toggle_Zoom
  379.                 on_item "<Esc=Exit>"           send Request_Cancel
  380.             end_item_list
  381.         end_object
  382.  
  383.         set Zoom_Cancel_Obj of (Text( Current_Object )) to (Zoom_Cancel( Current_Object ))
  384.  
  385.         object See_Also is a LIST See_Also_Img
  386.             on_key kCancel           send Request_Cancel     Private
  387.             on_key kExit_Application send Request_Cancel     Private
  388.             on_key kHelp             send View_Help_For_Help Private
  389.             on_key kZoom             send Toggle_Zoom        Private
  390.         end_object
  391.  
  392.         object Menu is a MENU Menu_Img
  393.             set Wrap_State   to True
  394.  
  395.             item_list
  396.                 on_item "Help for help  F1" send View_Help_For_Help
  397.                 on_item "Keys help"         send View_Keys_Help
  398.                 on_item "Previous help"     send View_Last_Help
  399.                 on_item "Help index"        send View_Help_Groups
  400.                 on_item "Zoom text  Alt+F9" send Toggle_Zoom
  401.                 on_item "Exit          Esc" send Request_Cancel
  402.             end_item_list
  403.  
  404.             on_key kCancel           send Request_Cancel     Private
  405.             on_key kExit_Application send Request_Cancel     Private
  406.             on_key kHelp             send View_Help_For_Help Private
  407.             on_key kZoom             send Toggle_Zoom        Private
  408.         end_object
  409.  
  410.         object Pick is a HELP_PICK Pick_Img Pick_List_Img Pick_Cancel_Img
  411.             set Location to 3 11 Relative
  412.         end_object
  413.  
  414.         object Stack is a HELP_STACK
  415.         end_object
  416.  
  417.         object Records is an ARRAY
  418.         end_object
  419.  
  420.         object Cant_Open is a Button Cant_Open_Img
  421.             set Block_Mouse_State to True
  422.             set Location          to 9 7 Relative
  423.             set Popup_State       to True
  424.             set Scope_State       to True
  425.  
  426.             item_list
  427.                 on_item "<OK>" send Ok
  428.             end_item_list
  429.  
  430.             on_key kHelp             send None Private
  431.             on_key kExit_Application send None Private
  432.         end_object
  433.     end_procedure
  434.  
  435.     register_procedure Goto_See_Also
  436.     register_procedure View_Help_Subjects integer Grp_Num
  437.  
  438.     procedure Close_Help integer Local_Close
  439.         if (Num_Arguments Min 1) NE (Remain_Open_State( Current_Object )) begin
  440.             close Grp
  441.             close Sbj
  442.             close Xrf
  443.             close Ctx
  444.         end
  445.  
  446.         send Delete_Data to (Text( Current_Object ))
  447.         send Delete_Data to (See_Also( Current_Object ))
  448.         send Delete_Data to (Pick( Current_Object ))
  449.         send Delete_Data to (Stack( Current_Object ))
  450.     end_procedure
  451.  
  452.     function Display_Help returns integer
  453.         local integer Xrf_Num Xrf_Count
  454.         local string Grp_Name Sbj_Name
  455.         local integer SA_Obj Tx_Obj
  456.  
  457.         move (See_Also( Current_Object )) to SA_Obj
  458.         move (Text( Current_Object )) to Tx_Obj
  459.  
  460.         move Xrf.Recnum to Xrf_Num
  461.         clear Xrf
  462.         move Sbj.Recnum to Xrf.Sbj_Recnum
  463.         find GE Xrf.Sbj_Recnum
  464.         [Found] indicate Found as Xrf.Sbj_Recnum EQ Sbj.Recnum
  465.         [not Found] function_return 0
  466.  
  467.         trim Grp.Grp_Name to Grp_Name
  468.         trim Sbj.Sbj_Name to Sbj_Name
  469.         set Dynamic_Update_State of SA_Obj to False
  470.         set Dynamic_Update_State of Tx_Obj to False
  471.         send Delete_Data to SA_Obj
  472.         move 0 to Xrf_Count
  473.  
  474.         repeat
  475.             relate Xrf
  476.             send Add_Item to SA_Obj Msg_Goto_See_Also (Trim( Grp.Grp_Name ))
  477.             set Aux_Value of SA_Obj item Xrf_Count to Grp.Recnum
  478.             increment Xrf_Count
  479.             find GT Xrf.Sbj_Recnum
  480.             [ Found ] indicate Found as Xrf.Sbj_Recnum EQ Sbj.Recnum
  481.         until [not Found ]
  482.  
  483.         set Value item 0 to Grp_Name
  484.         set Value item 1 to Sbj_Name
  485.         send Delete_Data to Tx_Obj
  486.         send Read to Tx_Obj
  487.         send Beginning_Of_Data to Tx_Obj
  488.         send Sort_Items to SA_Obj
  489.         set Current_Item of SA_Obj to 0
  490.         set Dynamic_Update_State of Tx_Obj to True
  491.         set Dynamic_Update_State of SA_Obj to True
  492.         function_return Xrf_Num
  493.     end_function
  494.  
  495.     procedure Error_Report integer Error_Info string Err_Text
  496.         local integer Ret_Val
  497.         ui_accept (Cant_Open( Current_Object )) to Ret_Val
  498.     end_procedure
  499.  
  500.     procedure Set Filename_Prefix string Prefix
  501.         local integer Old_Pre_Len
  502.         local string Old_Name
  503.  
  504.         length (Help_system.Filename_Prefix( Current_Object )) to Old_Pre_Len
  505.         set Help_System.Filename_Prefix to Prefix
  506.  
  507.         get Group_Filename to Old_Name
  508.         set Group_Filename to ;
  509.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  510.  
  511.         get Subject_Filename to Old_Name
  512.         set Subject_Filename to ;
  513.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  514.  
  515.         get Link_Filename to Old_Name
  516.         set Link_Filename to ;
  517.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  518.  
  519.         get Context_Filename to Old_Name
  520.         set Context_Filename to ;
  521.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  522.     end_procedure
  523.  
  524.     function Filename_Prefix returns string
  525.         function_return (Help_System.Filename_Prefix( Current_Object ))
  526.     end_function
  527.  
  528.     function Find_Help string App_Name string Mod_Name string Hlp_Name ;
  529.             returns integer
  530.         local integer Ret_Val
  531.  
  532.         clear Ctx
  533.         move App_Name to Ctx.App_Name
  534.         move Mod_Name to Ctx.Mod_Name
  535.         trim (Uppercase( Hlp_Name )) to Ctx.Hlp_Name
  536.         find EQ Ctx.Hlp_Name
  537.         move 0 to Ret_Val
  538.         [Found] move 1 to Ret_Val
  539.         [Found] relate Ctx
  540.         function_return Ret_Val
  541.     end_function
  542.  
  543.     procedure Goto_See_Also
  544.         send View_Help_Subjects ;
  545.           (Aux_Value( See_Also( Current_Object ), Current ))
  546.     end_procedure
  547.  
  548.     procedure Open_Help integer Local_Open
  549.         local integer Rem_Opn Old_Error_ID
  550.  
  551.         if (Active_State( Current_Object )) procedure_return
  552.  
  553.         indicate Err False
  554.  
  555.         move Error_Object_ID to Old_Error_ID
  556.         move Current_Object to Error_Object_ID
  557.  
  558.         open (Group_Filename( Current_Object )) as Grp Index.1             // language
  559.         [not Err] open (Subject_Filename( Current_Object )) as Sbj Index.1 // dep. file
  560.         [not Err] open (Link_Filename( Current_Object )) as Xrf Index.2    // names in
  561.         [not Err] open (Context_Filename( Current_Object )) as Ctx         // properties
  562.  
  563.         [Err] begin
  564.             close Grp
  565.             close Sbj
  566.             close Xrf
  567.             close Ctx
  568.         end
  569.  
  570.         move Old_Error_Id to Error_Object_ID
  571.  
  572.         [not Err] begin
  573.             get Remain_Open_State to Rem_Opn
  574.             if Num_Arguments LE 0 set Remain_Open_State to True
  575.             if Rem_Opn send Store_Records
  576.         end
  577.     end_procedure
  578.  
  579.     procedure Request_Cancel
  580.         local integer Pri_Sco
  581.  
  582.         if (Zoom_State( Text( Current_Object ) )) send Shrink_Help
  583.  
  584.         get Prior_Scope to Pri_Sco
  585.         if Pri_Sco EQ 0 move Desktop to Pri_Sco
  586.         set Current_Scope to Pri_Sco
  587.         send Deactivate_Group
  588.         send Close_Help True
  589.         if (Remain_Open_State( Current_Object )) send Restore_Records
  590.         procedure_return 1
  591.     end_procedure
  592.  
  593.     procedure Request_Help integer Msg_ID integer Arg
  594.         local integer Was_Err
  595.  
  596.         move 0 to Was_Err
  597.         [err] move 1 to Was_Err
  598.         indicate Err False
  599.  
  600.         if NUM_ARGUMENTS GT 1 send Msg_ID Arg
  601.         else send Msg_ID
  602.         [not Err] start_ui
  603.  
  604.         indicate Err as Was_Err NE 0
  605.     end_procedure
  606.  
  607.     procedure Restore_Records
  608.         local integer Obj
  609.  
  610.         move (Records( Current_Object )) to Obj
  611.         clear Grp Sbj Xrf Ctx
  612.         get Array_Value of Obj item 0 to Grp.Recnum
  613.         get Array_Value of Obj item 1 to Sbj.Recnum
  614.         get Array_Value of Obj item 2 to Xrf.Recnum
  615.         get Array_Value of Obj item 3 to Ctx.Recnum
  616.         find EQ Grp.Recnum
  617.         find EQ Sbj.Recnum
  618.         find EQ Xrf.Recnum
  619.         find EQ Ctx.Recnum
  620.     end_procedure
  621.  
  622.     procedure Shrink_Help
  623.         local integer Obj
  624.  
  625.         move (Text( Current_Object )) to Obj
  626.         send Shrink_Text to Obj
  627.         set Size of Obj to 10 56
  628.         set Location of Obj to 3 1 Relative
  629.         set Block_Mouse_State of Obj to False
  630.     end_procedure
  631.  
  632.     procedure Store_Records
  633.         local integer Obj
  634.  
  635.         move (Records( Current_Object )) to Obj
  636.         set Array_Value of Obj item 0 to Grp.Recnum
  637.         set Array_Value of Obj item 1 to Sbj.Recnum
  638.         set Array_Value of Obj item 2 to Xrf.Recnum
  639.         set Array_Value of Obj item 3 to Ctx.Recnum
  640.     end_procedure
  641.  
  642.     procedure Toggle_Zoom
  643.       if not (Zoom_State( Text( Current_Object ) )) send Zoom_Help
  644.       else send Shrink_Help
  645.     end_procedure
  646.  
  647.     procedure Topic_Help integer Xrf_Num
  648.         clear Xrf
  649.         move Xrf_Num to Xrf.Recnum
  650.         find EQ Xrf.Recnum
  651.  
  652.         if [Found] begin
  653.             relate Xrf
  654.             send View_Help
  655.         end
  656.     end_procedure
  657.  
  658.     procedure View_Context_Help integer Obj_Num
  659.         local integer Obj Ret_Val
  660.         local string App_Name Mod_Name
  661.  
  662.         send Open_Help True
  663.         [err] procedure_return
  664.  
  665.         move Obj_Num to Obj
  666.  
  667.         repeat
  668.             get Find_Help (Application_Name( Obj )) (Module_Name( Obj )) ;
  669.               (Right( Help_Name( Obj ), HELP_NAME_LENGTH )) to Ret_Val
  670.  
  671.             if not Ret_Val begin
  672.                 if Obj EQ Desktop begin
  673.                     send View_Help_Index
  674.                     move -1 to Ret_Val
  675.                 end
  676.                 else get Parent of Obj to Obj
  677.             end
  678.         until Ret_Val NE 0
  679.  
  680.         if Ret_Val GT 0 send View_Help
  681.     end_procedure
  682.  
  683.     procedure View_Help
  684.         local integer Xrf_Num
  685.  
  686.         get Display_Help to Xrf_Num
  687.         if Xrf_Num send Push_Item to (Stack( Current_Object )) Xrf_Num
  688.         if not (Active_State( Current_Object )) send Popup
  689.         else send Activate to (Text( Current_Object ))
  690.     end_procedure
  691.  
  692.     procedure View_Help_For_Help
  693.         send Open_Help True
  694.         [err] procedure_return
  695.  
  696.         if (Find_Help( Current_Object, "", "", HELP_FOR_HELP_NAME )) ;
  697.           send View_Help
  698.         else begin
  699.             clear Grp Sbj Xrf Ctx
  700.             send View_Help
  701.             send Popup
  702.             send View_Help_Groups
  703.         end
  704.     end_procedure
  705.  
  706.     procedure View_Help_Groups
  707.         send Pick_Group to (Pick( Current_Object )) Msg_View_Help_Subjects
  708.     end_procedure
  709.  
  710.     procedure View_Help_Index
  711.         local integer Ret_Val
  712.  
  713.         send Open_Help True
  714.         [err] procedure_return
  715.  
  716.         if not (Active_State( Current_Object )) begin
  717.             get Find_Help "" "" HELP_FOR_HELP_NAME to Ret_Val
  718.             send View_Help
  719.             send Popup
  720.         end
  721.  
  722.         send View_Help_Groups
  723.     end_procedure
  724.  
  725.     procedure View_Help_Subjects integer Grp_Num
  726.         clear Grp
  727.         move Grp_Num to Grp.Recnum
  728.         find EQ Grp.Recnum
  729.         send Pick_Subject to (Pick( Current_Object )) Grp_Num (Trim( Grp.Grp_Name )) ;
  730.           Msg_Topic_Help
  731.     end_procedure
  732.  
  733.     procedure View_Keys_Help
  734.         send Open_Help True
  735.         [err] procedure_return
  736.  
  737.         if (Find_Help( Current_Object, "", "", HELP_KEYS_NAME )) send View_Help
  738.         else send View_Help_Index
  739.     end_procedure
  740.  
  741.     procedure View_Last_Help
  742.         local string Sbj_Name
  743.         local integer Itm Ret_Val
  744.  
  745.         if (Current_Item( Stack( Current_Object ) )) GE 0 begin
  746.             clear Xrf
  747.             get Pop_Item of (Stack( Current_Object )) to Ret_Val
  748.  
  749.             if Ret_Val NE -1 begin
  750.                 move Ret_Val to Xrf.Recnum
  751.                 find EQ Xrf.Recnum
  752.             end
  753.  
  754.             if Status Xrf begin
  755.                 relate Xrf
  756.                 get Display_Help to Ret_Val
  757.             end
  758.         end
  759.  
  760.         send Activate to (Text( Current_Object ))
  761.     end_procedure
  762.  
  763.     procedure Zoom_Help
  764.         local integer Obj
  765.  
  766.         move (Text( Current_Object )) to Obj
  767.         set Location of Obj to 1 1 Relative
  768.         set Size of Obj to 18 56
  769.         set Block_Mouse_State of Obj to True
  770.         send Zoom_Text to Obj
  771.     end_procedure
  772. end_class
  773.