home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / help_chn.pkg < prev    next >
Encoding:
Text File  |  1993-05-19  |  7.9 KB  |  245 lines
  1. // HELP_CHN.PKG
  2. // March 13, 1992
  3. // LS
  4. //
  5. // Help Object (Global) - Chaining Version
  6.  
  7. #CHKSUB 1 1 // Verify the UI subsystem.
  8.  
  9. use UI
  10. use Helpmsgs // Global Messages for Global Help Object
  11.  
  12. /Help_Cant_Open_Img
  13. ╔══════════════════════════════════════════╗
  14. ║ The help data files could not be loaded. ║
  15. ║      The help system is unavailable.     ║
  16. ║                                          ║
  17. ║                   ____                   ║
  18. ╚══════════════════════════════════════════╝
  19. /*
  20.  
  21. #COMMAND DEFINE_SYMBOL R "FOR" R
  22.   #IFDEF !1
  23.   #ELSE
  24.     #REPLACE !1 !3
  25.   #ENDIF
  26. #ENDCOMMAND
  27.  
  28. DEFINE_SYMBOL HELP_CHAIN_PROGRAM FOR 'help'
  29.  
  30. DEFINE_SYMBOL HELP_ARG_CONTEXT_HELP  FOR 'C'
  31. DEFINE_SYMBOL HELP_ARG_HELP_FOR_HELP FOR 'H'
  32. DEFINE_SYMBOL HELP_ARG_HELP_INDEX    FOR 'I'
  33. DEFINE_SYMBOL HELP_ARG_KEYS_HELP     FOR 'K'
  34.  
  35. DEFINE_SYMBOL HELP_FOR_HELP_NAME   FOR 'HELP FOR HELP' //special values of
  36. DEFINE_SYMBOL HELP_KEYS_NAME       FOR 'KEYS HELP' // HELP_NAME 
  37. DEFINE_SYMBOL HELP_NAME_LENGTH     FOR 40
  38. DEFINE_SYMBOL HELP_GRP_FILENAME    FOR 'helpgrp' // default filenames
  39. DEFINE_SYMBOL HELP_SBJ_FILENAME    FOR 'helpsbj'
  40. DEFINE_SYMBOL HELP_XRF_FILENAME    FOR 'helpxrf'
  41. DEFINE_SYMBOL HELP_CTX_FILENAME    FOR 'helpctx'
  42. DEFINE_SYMBOL HELP_FILENAME_PREFIX FOR 'help'// default filename prefix
  43.  
  44. class Help_Chain is an ARRAY
  45.     procedure Construct_Object
  46.         forward send Construct_Object
  47.  
  48.         property string  Chain_Program_Name Public  HELP_CHAIN_PROGRAM
  49.         property string  Context_Filename   Public  HELP_CTX_FILENAME
  50.         property string  Filename_Prefix    Private HELP_FILENAME_PREFIX
  51.         property string  Group_Filename     Public  HELP_GRP_FILENAME
  52.         property string  Link_Filename      Public  HELP_XRF_FILENAME
  53.         property integer Remain_Open_State  Public  0
  54.         property string  Subject_Filename   Public  HELP_SBJ_FILENAME
  55.  
  56.         object Cant_Open is a Button Help_Cant_Open_Img
  57.             set Block_Mouse_State to True
  58.             set Location          to 11 18 Absolute
  59.             set Popup_State       to True
  60.             set Scope_State       to True
  61.  
  62.             item_list
  63.                 on_item "<OK>" send Ok
  64.             end_item_list
  65.  
  66.             on_key kHelp             send None Private
  67.             on_key kExit_Application send None Private
  68.         end_object
  69.     end_procedure
  70.  
  71.     procedure Set Filename_Prefix string Prefix
  72.         local integer Old_Pre_Len
  73.         local string Old_Name
  74.  
  75.         length (!$.Filename_Prefix( Current_Object )) to Old_Pre_Len
  76.         set Help_Chain.Filename_Prefix to Prefix
  77.  
  78.         get Group_Filename to Old_Name
  79.         set Group_Filename to ;
  80.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  81.  
  82.         get Subject_Filename to Old_Name
  83.         set Subject_Filename to ;
  84.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  85.  
  86.         get Link_Filename to Old_Name
  87.         set Link_Filename to ;
  88.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  89.  
  90.         get Context_Filename to Old_Name
  91.         set Context_Filename to ;
  92.           (Prefix + mid( Old_Name, length( Old_Name ) - Old_Pre_Len, Old_Pre_Len + 1 ))
  93.     end_procedure
  94.  
  95.     function Filename_Prefix returns string
  96.         function_return (!$.Filename_Prefix( Current_Object ))
  97.     end_function
  98.  
  99.     procedure Open_Help integer Local_Open
  100.         local integer Rem_Opn Old_Error_ID
  101.  
  102.         get Remain_Open_State to Rem_Opn
  103.         if Num_Arguments LE 0 set Remain_Open_State to True
  104.  
  105.         indicate Err False
  106.         move Error_Object_ID to Old_Error_ID
  107.         move Current_Object to Error_Object_ID
  108.  
  109.         open (Group_Filename( Current_Object ))   as Grp // language
  110.         [not Err] open (Subject_Filename( Current_Object )) as Sbj // dependent file
  111.         [not Err] open (Link_Filename( Current_Object ))    as Xrf // names are in
  112.         [not Err] open (Context_Filename( Current_Object )) as Ctx // properties
  113.  
  114.         [Err] begin
  115.             close Grp
  116.             close Sbj
  117.             close Xrf
  118.             close Ctx
  119.         end
  120.  
  121.         move Old_Error_Id to Error_Object_ID
  122.  
  123.         [not Err] if Rem_Opn send Store_Records
  124.     end_procedure
  125.  
  126.     procedure Error_Report integer Error_Info string Err_Text
  127.         local integer Ret_Val
  128.         ui_accept (Cant_Open( Current_Object )) to Ret_Val
  129.     end_procedure
  130.  
  131.     procedure Close_Help integer Local_Close
  132.         if (Num_Arguments Min 1) NE (Remain_Open_State( Current_Object )) begin
  133.             close Grp
  134.             close Sbj
  135.             close Xrf
  136.             close Ctx
  137.         end
  138.     end_procedure
  139.  
  140. // chain to the chn_help program; note the use of export_only to force the use
  141. // of help files opened in this class; chn_help prog's opens will do nothing
  142.  
  143.     procedure Chain_Help string Chn_Arg
  144.         if Chn_Arg NE HELP_ARG_CONTEXT_HELP begin
  145.             send Open_Help True
  146.             [err] procedure_return
  147.         end
  148.  
  149.         chain wait (Chain_Program_Name(Current_Object) + " " + Chn_Arg) ;
  150.           Export_Only
  151.         send Refresh_Screen to Desktop // in case screen was corrupted
  152.         if Chn_Arg NE HELP_ARG_CONTEXT_HELP send Close_Help True
  153.         if (Remain_Open_State( Current_Object )) send Restore_Records
  154.     end_procedure
  155.  
  156.     procedure View_Context_Help integer Obj
  157.         local integer Ret_Val
  158.  
  159.         send Open_Help True
  160.         [err] procedure_return
  161.         get Context_Help Obj to Ret_Val
  162.         if Ret_Val ;
  163.           send Chain_Help (HELP_ARG_CONTEXT_HELP + " " + String( Ret_Val ))
  164.         else send Chain_Help HELP_ARG_HELP_INDEX
  165.         send Close_Help True
  166.     end_procedure
  167.  
  168. // return Ctx.Recnum for passed Help Name; 0 if none found
  169.  
  170.     function Find_Help string Hlp_Name returns integer
  171.         clear Ctx
  172.         get Application_Name of Desktop to Ctx.App_Name
  173.         get Module_Name of Desktop to Ctx.Mod_Name
  174.         trim (Uppercase( Hlp_Name )) to Ctx.Hlp_Name
  175.         find EQ Ctx.Hlp_Name
  176.         [Found] relate Ctx
  177.         function_return Ctx.Recnum
  178.     end_function
  179.  
  180. // return Ctx.Recnum of appropriate Ctx record for the focus object
  181.  
  182.     function Context_Help integer Obj_Num returns integer
  183.         local string App_Name Mod_Name
  184.         local integer Obj Ret_Val
  185.  
  186.         move Obj_Num to Obj
  187.  
  188.         repeat
  189.             if (Find_Help( Current_Object, Right( Help_Name( Obj ), ;
  190.               HELP_NAME_LENGTH ) )) function_return Ctx.Recnum
  191.  
  192.             if Obj EQ Desktop function_return 0
  193.  
  194.             get Parent of Obj to Obj
  195.         loop
  196.     end_function
  197.  
  198.     procedure View_Help_For_Help
  199.         send Chain_Help to Help_Object HELP_ARG_HELP_FOR_HELP
  200.     end_procedure
  201.  
  202.     procedure View_Keys_Help
  203.         send Chain_Help to Help_Object HELP_ARG_KEYS_HELP
  204.     end_procedure
  205.  
  206.     procedure View_Help_Index
  207.         send Chain_Help to Help_Object HELP_ARG_HELP_INDEX
  208.     end_procedure
  209.  
  210.     procedure Store_Records
  211.         set Array_Value item 0 to Grp.Recnum
  212.         set Array_Value item 1 to Sbj.Recnum
  213.         set Array_Value item 2 to Xrf.Recnum
  214.         set Array_Value item 3 to Ctx.Recnum
  215.     end_procedure
  216.  
  217.     procedure Restore_Records
  218.         clear Grp Sbj Xrf Ctx
  219.         get Array_Value item 0 to Grp.Recnum
  220.         get Array_Value item 1 to Sbj.Recnum
  221.         get Array_Value item 2 to Xrf.Recnum
  222.         get Array_Value item 3 to Ctx.Recnum
  223.         find EQ Grp.Recnum
  224.         find EQ Sbj.Recnum
  225.         find EQ Xrf.Recnum
  226.         find EQ Ctx.Recnum
  227.     end_procedure
  228.  
  229.     procedure Request_Help integer Msg_ID integer Arg
  230.         local integer Was_Err
  231.  
  232.         move 0 to Was_Err
  233.         [err] move 1 to Was_Err
  234.         indicate Err False
  235.  
  236.         if NUM_ARGUMENTS GT 1 send Msg_ID Arg
  237.         else send Msg_ID
  238.  
  239.         indicate Err as Was_Err NE 0
  240.     end_procedure
  241. end_class
  242.  
  243. object Help_Object is a Help_Chain
  244. end_object
  245.