home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / dfpds.src < prev    next >
Encoding:
Text File  |  1993-05-19  |  52.9 KB  |  1,590 lines
  1. /title_bar
  2. ______________________________________________________________________________
  3. /status_line
  4. ______________________________________________________________________________
  5. /action_bar
  6.   ____  ____  ____  ___  _______  ____                                        
  7. /file_pull_down
  8. ┌────────────────────┐
  9. │ __________________ │
  10. │ __________________ │
  11. │ __________________ │
  12. │ __________________ │
  13. ├────────────────────┤
  14. │ __________________ │
  15. │ __________________ │
  16. ├────────────────────┤
  17. │ __________________ │
  18. ├────────────────────┤
  19. │ __________________ │
  20. └────────────────────┘
  21. /edit_pull_down
  22. ┌─────────────────────┐
  23. │ ___________________ │
  24. │ ___________________ │
  25. │ ___________________ │
  26. │ ___________________ │
  27. └─────────────────────┘
  28. /block_ops_pull_down
  29. ┌───────────────────────────┐
  30. │ _________________________ │
  31. │ _________________________ │
  32. │ _________________________ │
  33. ├───────────────────────────┤
  34. │ _________________________ │
  35. │ _________________________ │
  36. ├───────────────────────────┤
  37. │ _________________________ │
  38. │ _________________________ │
  39. └───────────────────────────┘
  40. /nav_ops_pull_down
  41. ┌──────────────────────────────┐
  42. │ ____________________________ │
  43. │ ____________________________ │
  44. ├──────────────────────────────┤
  45. │ ____________________________ │
  46. │ ____________________________ │
  47. ├──────────────────────────────┤
  48. │ ____________________________ │
  49. │ ____________________________ │
  50. ├──────────────────────────────┤
  51. │ ____________________________ │
  52. │ ____________________________ │
  53. ├──────────────────────────────┤
  54. │ ____________________________ │
  55. └──────────────────────────────┘
  56. /search_ops_pull_down
  57. ┌──────────────────────────┐
  58. │ ________________________ │
  59. │ ________________________ │
  60. │ ________________________ │
  61. └──────────────────────────┘
  62. /misc_ops_pull_down
  63. ┌──────────────────┐
  64. │ ________________ │
  65. ├──────────────────┤
  66. │ ________________ │
  67. │ ________________ │
  68. ├──────────────────┤
  69. │ ________________ │
  70. │ ________________ │
  71. └──────────────────┘
  72. /view_pull_down
  73. ┌────────────────────────────┐
  74. │ __________________________ │
  75. │ __________________________ │
  76. │ __________________________ │
  77. ├────────────────────────────┤
  78. │ __________________________ │
  79. │ __________________________ │
  80. └────────────────────────────┘
  81. /run_pull_down
  82. ┌──────────────────────────┐
  83. │ ________________________ │
  84. │ ________________________ │
  85. │ ________________________ │
  86. │ ________________________ │
  87. ├──────────────────────────┤
  88. │ ________________________ │
  89. ├──────────────────────────┤
  90. │ ________________________ │
  91. │ ________________________ │
  92. ├──────────────────────────┤
  93. │ ________________________ │
  94. │ ________________________ │
  95. └──────────────────────────┘
  96. /options_pull_down
  97. ┌───────────────────────────────┐
  98. │ _____________________________ │
  99. │ _____________________________ │
  100. │ _____________________________ │
  101. │ _____________________________ │
  102. │ _____________________________ │
  103. └───────────────────────────────┘
  104. /help_pull_down
  105. ┌──────────────────┐
  106. │ ________________ │
  107. │ ________________ │
  108. │ ________________ │
  109. │ ________________ │
  110. ├──────────────────┤
  111. │ ________________ │
  112. └──────────────────┘
  113. /load_buffer
  114. ╔══════════════════════════════════════════╗
  115. ║__________________________________________║
  116. ║                                          ║
  117. ║  File Name:                              ║
  118. ║  ______________________________________  ║
  119. ║                                          ║
  120. ║  Directory:                              ║
  121. ║  ______________________________________  ║
  122. ║                                          ║
  123. ║   Files:                                 ║
  124. ║   ┌─────────────┐      Directories:      ║
  125. ║   │____________ │      ┌─────────────┐   ║
  126. ║   │____________ │      │____________ │   ║
  127. ║   │____________ │      │____________ │   ║
  128. ║   │____________ │      │____________ │   ║
  129. ║   │____________ │      │____________ │   ║
  130. ║   └─────────────┘      └─────────────┘   ║
  131. ║      <__>       <______>     <____>      ║
  132. ╚══════════════════════════════════════════╝
  133. /save_buffer
  134. ╔════════════════════════════════════════╗
  135. ║________________________________________║
  136. ║                                        ║
  137. ║  File name:                            ║
  138. ║  ____________________________________  ║
  139. ║                                        ║
  140. ║     <__>       <______>     <____>     ║
  141. ╚════════════════════════════════════════╝
  142. /pick_file
  143. ╔════════════════════════════════════════╗
  144. ║________________________________________║
  145. ║                                        ║
  146. ║ ______________________________________ ║
  147. ║ ______________________________________ ║
  148. ║ ______________________________________ ║
  149. ║ ______________________________________ ║
  150. ║ ______________________________________ ║
  151. ║                                        ║
  152. ║     <__>       <______>     <____>     ║
  153. ╚════════════════════════════════════════╝
  154. /options
  155. ╔═════════════════════════════════════════════╗
  156. ║ ___________________________________________ ║
  157. ║                                             ║
  158. ║  Listings: ___ None  ___ File  ___ Printer  ║
  159. ║─────────────────────────────────────────────║
  160. ║  On Errors:   ___ Stop      ___ Continue    ║
  161. ║─────────────────────────────────────────────║
  162. ║  ___ Quiet (no bell on error)               ║
  163. ║  ___ Delete output on error                 ║
  164. ║  ___ Write errors                           ║
  165. ║  ___ Symbol table                           ║
  166. ║─────────────────────────────────────────────║
  167. ║  Verbose level                 ___          ║
  168. ║  Output to disk device         ___          ║
  169. ║  Output file revision          ___          ║
  170. ║  Macro expansion buffer size   __ K         ║
  171. ║                                             ║
  172. ║           <__>         <____>               ║
  173. ╚═════════════════════════════════════════════╝
  174. /environment_screen
  175. ╔══════════════════════════╗
  176. ║__________________________║
  177. ║                          ║
  178. ║ ________________________ ║
  179. ║ ________________________ ║
  180. ║                          ║
  181. ║     <__>      <____>     ║
  182. ╚══════════════════════════╝
  183. /compile_msg
  184. ╔═════════════════════════════════════════════════════╗
  185. ║_____________________________________________________║
  186. ║                                                     ║
  187. ║  File name: ______________________________________  ║
  188. ║                                                     ║
  189. ║  Errors   : ___                                     ║
  190. ║                                                     ║
  191. ║_____________________________________________________║
  192. ╚═════════════════════════════════════════════════════╝
  193. /about
  194. ╔═════════════════════════════════════════════════════╗
  195. ║_____________________________________________________║
  196. ║                                                     ║
  197. ║                       D F P D S                     ║
  198. ║                                                     ║
  199. ║                     Version 1.00b                   ║
  200. ║                                                     ║
  201. ║                                                     ║
  202. ║     Copyright 1987-1992 Data Access Corporation     ║
  203. ║         Miami FL, USA - All rights reserved         ║
  204. ║                                                     ║
  205. ║               Memory: __________ Bytes              ║
  206. ║                                                     ║
  207. ║                   <__>     <____>                   ║
  208. ╚═════════════════════════════════════════════════════╝
  209. /read_msg
  210. READ
  211. /arguments
  212. ╔════════════════════════════════════════════╗
  213. ║____________________________________________║
  214. ║                                            ║
  215. ║  Arguments                                 ║
  216. ║  ________________________________________  ║
  217. ║                                            ║
  218. ║     <__>        <______>        <____>     ║
  219. ╚════════════════════════════════════════════╝
  220. /right_margin
  221. ┌────────────────────────┐
  222. │                        │
  223. │  Right Margin... ___   │
  224. │                        │
  225. └────────────────────────┘
  226. /search_for
  227. ┌──────────────────────────────────────────────────┐
  228. │ Find what: ____________________________________  │
  229. └──────────────────────────────────────────────────┘
  230. /go_line
  231. ┌────────────────────┐
  232. │ Goto line: _____.  │
  233. └────────────────────┘
  234. /translate_back
  235. ╔═══════════════════════════════════════════════════════════╗
  236. ║                                                           ║
  237. ║                ┌───────────────────────────────────────┐  ║
  238. ║   Find what:   │ ____________________________________  │  ║
  239. ║                └───────────────────────────────────────┘  ║
  240. ║                                                           ║
  241. ║                ┌───────────────────────────────────────┐  ║
  242. ║   Change to:   │ ____________________________________  │  ║
  243. ║                └───────────────────────────────────────┘  ║
  244. ║                                                           ║
  245. ║   <_________>  <______>  <__________>  <______>  <____>   ║
  246. ╚═══════════════════════════════════════════════════════════╝
  247. /exit_confirm
  248. ╔════════════════════════════════════════╗
  249. ║________________________________________║
  250. ║                                        ║
  251. ║                  File                  ║
  252. ║  ____________________________________  ║
  253. ║                                        ║
  254. ║               Has changed              ║
  255. ║                                        ║
  256. ║           Save current changes?        ║
  257. ║                                        ║
  258. ║      <___>       <__>     <______>     ║
  259. ╚════════════════════════════════════════╝
  260. /*
  261.  
  262. use ui
  263. use menu
  264. use help_chn
  265. use error
  266. set application_name to 'SYSTEM'
  267. set module_name to 'DFPDS'
  268.  
  269. sub_page open_title     from load_buffer 1
  270. sub_page file_name_form from load_buffer 2
  271. sub_page dir_msg        from load_buffer 3
  272. sub_page files          from load_buffer vertical 4 5
  273. sub_page directories    from load_buffer vertical 6 4
  274. sub_page open_buttons   from load_buffer 13 14 15
  275.  
  276. sub_page save_title     from save_buffer 1
  277. sub_page save_name_form from save_buffer 2
  278. sub_page save_buttons   from save_buffer 3 4 5
  279.  
  280. sub_page options_title  from options 1
  281. sub_page listings       from options 2 3 4
  282. sub_page error_stop     from options 5 6
  283. sub_page check_opts     from options 7 8 9 10
  284. sub_page entry_opts     from options 11 12 13 14
  285. sub_page options_buttons from options 15 16
  286.  
  287. Sub_Page trans_From     FROM translate_back 1
  288. Sub_Page trans_to       FROM translate_back 2
  289. Sub_Page transBtns      FROM translate_back 3 4 5 6 7
  290.  
  291. sub_page exit_title     from exit_confirm 1
  292. sub_page exit_name_form from exit_confirm 2
  293. sub_page exit_buttons   from exit_confirm 3 4 5
  294.  
  295. sub_page arg_title     from arguments 1
  296. sub_page arg_value     from arguments 2
  297. sub_page arg_buttons   from arguments 3 4 5
  298.  
  299. sub_page environment_title   from environment_screen 1
  300. sub_page environment_options from environment_screen 2 3
  301. sub_page environment_buttons from environment_screen 4 5
  302.  
  303. sub_page pick_title   from pick_file 1
  304. sub_page pick_list    from pick_file 2 3 4 5 6
  305. sub_page pick_buttons from pick_file 7 8 9
  306.  
  307. name_object environment_screen global
  308. name_object environment_options child environment_screen
  309.  
  310. string old_arg_val
  311.  
  312.  
  313. // Define a string to contain the OS defined directory separator, another for
  314. // the file wild card spec and a third for the list of valid directory
  315. // separators.
  316. String Dir_Separator Wild_Card_Mask Valid_Separators
  317. Move ( SysConf( SYSCONF_DIR_SEPARATOR )) to Dir_Separator
  318. Move ( SysConf( SYSCONF_FILE_MASK ))     to Wild_Card_Mask
  319. Move "/\"                                to Valid_Separators
  320.  
  321.  
  322. function strip_extn string file returns string
  323.     local integer cnt
  324.     length file to cnt
  325.     while cnt gt 0
  326.         if (pos(mid(file,1,cnt),(Valid_Separators + ":"))) gt 0 ;
  327.                 move 0 to cnt
  328.         else if (mid(file,1,cnt)) eq '.' begin
  329.             pad file to file (cnt-1)
  330.             move 0 to cnt
  331.         end
  332.         move (cnt-1) to cnt
  333.     end
  334.     function_return file
  335. end_function
  336.  
  337. function int_cvt string str integer pos returns integer
  338.     local integer val
  339.     local string ch
  340.     move 0 to val
  341.     while pos le (length(str))
  342.         mid str to ch 1 pos
  343.         if ch in '0123456789' move ((val*10)+ch) to val
  344.         else move 999 to pos
  345.         increment pos
  346.     end
  347.     function_return val
  348. end_function
  349.  
  350. class file_frame is a client
  351.     procedure construct_object
  352.         local string cdir
  353.  
  354.         set BLOCK_MOUSE_STATE to true
  355.  
  356.         on_key kcancel send deactivate to current_object
  357.  
  358.         object open_title is a title
  359.             set center_state item 0 to true
  360.             set focus_mode to NONFOCUSABLE
  361.         end_object
  362.  
  363.         object file_name_form is a form
  364.             item_list
  365.                 on_item Wild_Card_Mask send load_file_list
  366.                 format load_buffer.2
  367.                 set autoclear_state to true
  368.             end_item_list
  369.         end_object
  370.  
  371.         object dir_msg is a form
  372.             item_list
  373.                 on_item ('.' + Dir_Separator) send load_dir_list
  374.                 format load_buffer.3
  375.                 set autoclear_state to true
  376.             end_item_list
  377.         end_object
  378.  
  379.         object files is a list
  380.             set select_mode to auto_select
  381.         end_object
  382.  
  383.         object directories is a list
  384.         end_object
  385.  
  386.         object open_buttons is a button
  387.             item_list
  388.                 on_item 'OK' send file_selected
  389.                 on_item 'CANCEL' send deactivate to (parent(current_object))
  390.                 on_item 'HELP' send help
  391.             end_item_list
  392.         end_object
  393.  
  394.         get_current_directory to cdir
  395.         set value of (dir_msg(current_object)) item 0 to cdir
  396.     end_procedure
  397.  
  398.     procedure activating
  399.         send paint to (directories(current_object))
  400.         send load_dir_list to (directories(current_object))
  401.     end_procedure
  402.  
  403.     procedure load_file_list
  404.         local string astr
  405.         get value of file_frame.dir_msg item 0 to astr
  406.         if (right(astr,1)) ne Dir_Separator append astr Dir_Separator
  407.         direct_input ('dir:' + astr + value(file_name_form(current_object),0))
  408.         readln aStr         //read first filename
  409.         send delete_data to file_frame.files
  410.         while astr gt '' //[not seqeof]
  411.             trim aStr to aStr                  //[.] & [..] ignored
  412.             message$address msg_file_selected   //fwd ref
  413.             if (left(aStr,1)) ne "[" ;
  414.                     send add_item to file_frame.files msg_file_selected aStr
  415.             readln aStr
  416.         end
  417.         close_input
  418.         send SORT_ITEMS to file_frame.files ASCENDING
  419.         if (item_count(files(current_object))) eq 1 ;
  420.         if (pos('*', value(file_name_form(current_object),0))) eq 0 ;
  421.                 send file_selected
  422.     end_procedure
  423.  
  424.     procedure redir
  425.         local string new_dir ch
  426.         local integer len
  427.         get value of file_frame.directories to new_dir
  428.         if new_dir eq '..' begin
  429.             get value of file_frame.dir_msg item 0 to new_dir
  430.             length new_dir to len
  431.             while len gt 0
  432.                 right new_dir to ch 1               
  433.                 if ch eq ':' move 0 to len
  434.                 else begin
  435.                     pad new_dir to new_dir (len-1)
  436.                     if ch in Valid_Separators move 0 to len
  437.                 end
  438.                 move (len-1) to len
  439.             end
  440.             set value of file_frame.dir_msg item 0 to new_dir
  441.         end
  442.         else if new_dir ne '.' ;
  443.                 set value of file_frame.dir_msg item 0 to ;
  444.                 (value(dir_msg(current_object), 0) + Dir_Separator + new_dir)
  445.         send load_dir_list
  446.     end_procedure
  447.  
  448.     procedure load_dir_list
  449.         local string astr
  450.         send delete_data to file_frame.directories
  451.         direct_input ('dir:' + value(dir_msg(current_object),0) + Dir_Separator + Wild_Card_Mask)
  452.         readln aStr         //read first filename
  453.         [seqeof] send add_item to file_frame.directories msg_redir '..'
  454.         while astr gt '' //[not seqeof]
  455.             trim aStr to aStr                  //[.] & [..] included
  456.             if (left(aStr,1)) eq "[" ;
  457.                     send add_item to file_frame.directories msg_redir (mid(astr,length(astr)-2,2))
  458.             readln aStr
  459.         end
  460.         close_input
  461.         send SORT_ITEMS to file_frame.directories ASCENDING
  462.         send load_file_list to (files(current_object))
  463.     end_procedure
  464.  
  465.     procedure file_selected
  466.         local string file_spec
  467.         get value of file_frame.dir_msg item 0 to file_spec
  468.         if not (right(file_spec,1)) in (Valid_Separators + ":") ;
  469.             append file_spec Dir_Separator
  470.         if (item_count(files(current_object))) eq 0 ;
  471.             append file_spec (value(file_name_form(current_object),0))
  472.         else append file_spec (value(files(current_object),current) )
  473.         send load_it file_spec
  474.     end_procedure
  475. end_class
  476.  
  477. class searchpopup is a client
  478.     procedure construct_object integer myImg integer transFromImg ;
  479.         integer transToImg integer Btns
  480.         forward send construct_object myImg
  481.         set LOCATION to 4 10 relative
  482.         set BLOCK_MOUSE_STATE to true
  483.         set Exit_Msg to Exit
  484.         on_key kcancel        send deactivate to current_object
  485.         on_key kexit_function send deactivate to current_object
  486.  
  487.         object transFromForm is a FORM transFromImg
  488.             set LOCATION to 2 15 relative
  489.             item_list 
  490.                 on_item "" SEND next
  491.             end_item_list 
  492.         end_object 
  493.  
  494.         object transToForm is a FORM transToImg
  495.             set LOCATION to 6 15 relative
  496.             item_list 
  497.                 on_item "" SEND next
  498.             end_item_list 
  499.         end_object 
  500.  
  501.         object theButtons is a BUTTON Btns
  502.             set LOCATION to 11 6 relative
  503.             item_list
  504.                 on_item "Find Next"  SEND do_find_next
  505.                 on_item "Change"     SEND do_trans_go
  506.                 on_item "Change All" SEND do_trans_all
  507.                 on_item "Cancel"     SEND deactivate to (parent(current_object))
  508.                 on_item "Help"       SEND help
  509.             end_item_list 
  510.         end_object 
  511.  
  512.     end_procedure
  513.  
  514.     procedure do_find_next
  515.         local integer itemp lFoc#
  516.         get parent to lFoc#
  517.         send find to lFoc# (value(SearchPopUp.transFromForm.obj,0)) itemp
  518.         if itemp eq 0 send not_found_message
  519.     end_procedure
  520.  
  521.     procedure do_trans_go
  522.         local integer itemp lFoc#
  523.         get parent to lFoc#
  524.         send key to lFoc# kLeftArrow 
  525.         send replace to lFoc# (value(SearchPopUp.transFromForm.obj,0)) ;
  526.                 (value(SearchPopUp.transToForm.obj,0)) itemp
  527.         if itemp eq 0 send not_found_message
  528.     end_procedure
  529.  
  530.     procedure do_trans_all
  531.         local string  stemp xtemp
  532.         local integer itemp lFoc# counter
  533.         get parent to lFoc#
  534.         move (value(SearchPopUp.transFromForm.obj,0)) to stemp
  535.         move (value(SearchPopUp.transToForm.obj,0)) to xtemp
  536.         send key to lFoc# kLeftArrow 
  537.         move 0 to counter
  538.         repeat        
  539.             send replace to lFoc# stemp xtemp itemp
  540.             if (itemp + counter) eq 0 send not_found_message
  541.             else calc (counter + 1) to counter
  542.         until itemp eq 0
  543.     end_procedure
  544. end_class
  545.  
  546. class file_editor is an edit
  547.     procedure construct_object
  548.         set insert_mode to true
  549.  
  550.         object status_line is a message
  551.             set location to (screenend-1) 1 absolute
  552.             set object_color 112 112
  553.         end_object
  554.  
  555.         object right_margin is a form
  556.             set location to 7 10 relative
  557.             set exit_msg to exit
  558.             item_list
  559.                 on_item '' send change_margin
  560.             end_item_list
  561.             on_key kcancel send deactivate
  562.         end_object
  563.  
  564.         object search_for is a form
  565.             set location to 7 10 relative
  566.             set exit_msg to exit
  567.             item_list
  568.                 on_item '' send do_search
  569.             end_item_list
  570.             on_key kcancel send deactivate
  571.         end_object
  572.  
  573.         object go_line is a form
  574.             set location to 7 10 relative
  575.             set exit_msg to exit
  576.             item_list
  577.                 on_item '' send do_goto
  578.             end_item_list
  579.             on_key kcancel send deactivate
  580.         end_object
  581.  
  582.         object transobj is a searchpopup ;
  583.             translate_back trans_From trans_to transBtns 
  584.             set object_color to 1 2
  585.         end_object
  586.  
  587.         set status_line_state to 2
  588.     end_procedure
  589.  
  590.     procedure display_status string status_text
  591.         set value of file_editor.status_line item 0 to status_text
  592.     end_procedure
  593.  
  594.     procedure activating
  595.         send page_object to file_editor.status_line true
  596.     end_procedure
  597.  
  598.     procedure deactivating
  599.         send page_object to file_editor.status_line false
  600.     end_procedure
  601.  
  602.     procedure activate
  603.         send add_focus desktop
  604.         forward send activate
  605.     end_procedure
  606.  
  607.     function file_change_confirm returns integer
  608.         local integer return_code
  609.         move MSG_OK to return_code
  610.         if (changed_state(current_object)) eq 1 begin
  611.             get select_state of environment_options item 1 to windowindex
  612.             if windowindex eq 0 send write_current to file_buffer
  613.             else ui_accept exit_confirm object to return_code
  614.             end
  615.         function_return return_code
  616.     end_function
  617.  
  618.     procedure clear_buffer
  619.         if (file_change_confirm(current_object)) eq MSG_OK begin
  620.             set file_name to 'NONAME'
  621.             send delete_data
  622.             send delete_data to error_buffer
  623.             set changed_state to false
  624.             end
  625.         send activate
  626.     end_procedure
  627.  
  628.     procedure read_buffer string fname
  629.         send activate to read_msg
  630.         if fname gt '' set file_name to fname
  631.             send delete_data
  632.         set dynamic_update_state to false
  633.         send read ''
  634.             send beginning_of_data
  635.         set dynamic_update_state to true
  636.         set changed_state to false
  637.         send deactivate to read_msg
  638.     end_procedure
  639.  
  640.     procedure include_file string fname
  641.         local integer was_insert
  642.         get insert_mode to was_insert
  643.         send activate to read_msg
  644.         set dynamic_update_state to false
  645.         set insert_mode to true
  646.         send read fname
  647.         set insert_mode to was_insert
  648.         set dynamic_update_state to true
  649.         send deactivate to read_msg
  650.     end_procedure
  651.  
  652.     procedure write_current string fname
  653.         local string backup_name
  654.         local integer backup_file
  655.         if num_arguments gt 0 begin
  656.             if (file_name(current_object)) ne fname ;
  657.                 set changed_state to true
  658.             set file_name to fname
  659.             end
  660.         if (changed_state(current_object)) begin
  661.             get select_state of environment_options item 0 to backup_file
  662.             if backup_file begin
  663.                 move (strip_extn(desktop,file_name(current_object))+'.bak') to ;
  664.                     backup_name
  665.                 erasefile backup_name
  666.                 renamefile (file_name(current_object)) to ;
  667.                     backup_name
  668.                 end
  669.                 send msg_write
  670.             end
  671.         set changed_state to false
  672.     end_procedure
  673.  
  674.     procedure Cut_Marked_Area
  675.         send cut true clipboard true
  676.     end_procedure
  677.  
  678.     procedure Copy_Marked_Area
  679.         send cut true clipboard false
  680.     end_procedure
  681.  
  682.     procedure Paste_clipboard
  683.         send Beginning_of_Data to clipboard
  684.         send Mark_On to clipboard
  685.         send end_of_Data to clipboard
  686.         send key to clipboard kLeftArrow 
  687.         send cut to clipboard false current_object false
  688.         send paint
  689.     end_procedure
  690.  
  691.     procedure Mark_Block
  692.         set column_mode to false
  693.         send Mark_On
  694.     end_procedure
  695.  
  696.     procedure Mark_Column
  697.         set column_mode to true
  698.         send Mark_On
  699.     end_procedure
  700.  
  701.     procedure set_status
  702.         if ( status_line_state(current_object) ) ne 0 procedure_return
  703.         send page_object to file_editor.status_line true
  704.         set status_line_state to 2
  705.     end_procedure
  706.  
  707.     procedure reset_status
  708.         if ( status_line_state(current_object) ) eq 0 procedure_return
  709.         set status_line_state to false
  710.         send page_object to file_editor.status_line false
  711.     end_procedure
  712.  
  713.     procedure insert_mode
  714.         set insert_mode to true
  715.     end_procedure
  716.  
  717.     procedure overstrike_mode
  718.         set insert_mode to false
  719.     end_procedure
  720.  
  721.     procedure change_margin
  722.         send deactivate to file_editor.right_margin
  723.         set right_margin to (value(file_editor.right_margin.obj,0))
  724.         set right_margin of clipboard to (value(file_editor.right_margin.obj,0))
  725.     end_procedure
  726.  
  727.     procedure reset_margin
  728.         set value of file_editor.right_margin item 0 to (right_margin(current_object))
  729.         send activate
  730.         send activate to file_editor.right_margin
  731.     end_procedure
  732.  
  733.     procedure search_file
  734.         send activate
  735.         send activate to file_editor.search_for
  736.     end_procedure
  737.  
  738.     procedure do_search
  739.         send deactivate to file_editor.search_for
  740.         send repeat_search_file
  741.     end_procedure
  742.  
  743.     procedure repeat_search_file
  744.         local integer find_ok
  745.         send find (value(file_editor.search_for.obj,0)) find_ok
  746.         if find_ok eq 0 send not_found_message
  747.     end_procedure
  748.  
  749.     procedure goto_user_line
  750.         send activate
  751.         send activate to file_editor.go_line
  752.     end_procedure
  753.  
  754.     procedure do_goto
  755.         send deactivate to file_editor.go_line
  756.         send goto_line (value(file_editor.go_line.obj,0)-1)
  757.     end_procedure
  758.  
  759.     procedure do_translates
  760.         send activate
  761.         send activate to file_editor.transobj
  762.     end_procedure
  763.  
  764.     procedure not_found_message
  765.         gotoxy screenend 0
  766.         send bell to desktop
  767.         show '** Not Found **'
  768.         sleep 1
  769.         clearxy screenend 0
  770.     end_procedure
  771.  
  772.     procedure next
  773.         send key KNEXT_ITEM
  774.     end_procedure
  775.  
  776. end_class
  777.  
  778. object file_buffer is a file_editor
  779.     set size to (screenend-3) 77
  780.     set location to 2 1 absolute
  781.     set right_margin to 132
  782.     set right_margin of clipboard to 132
  783.     set object_color 1 120
  784.     send accelerator_keys
  785.     on_key key_alt+key_a    send repeat_search_file to file_buffer
  786.     on_key key_alt+key_t    send do_translates to file_buffer
  787.     on_key key_ctrl+key_f   send search_file to file_buffer
  788. end_object
  789.  
  790. object prn_buffer is an edit
  791.     set size to 18 70
  792.     set right_margin to 132
  793.     set location to 3 3 absolute
  794.     set object_color 112 2
  795.     set block_mouse_state to true
  796.     set read_only_state to true
  797.     on_key KCANCEL send stop_ui
  798. end_object
  799.  
  800. object error_buffer is an edit
  801.     set size to 5 77
  802.     set right_margin to 132
  803.     set location to (screenend - 6) 1 absolute
  804.     set object_color 112 2
  805.     set read_only_state to true
  806.     set column_mode to 2  // line mode
  807.     on_key KCANCEL send stop_ui
  808.     send accelerator_keys
  809.  
  810.     procedure mouse_click
  811.         send key kenter
  812.     end_procedure
  813.  
  814.     procedure mouse_down integer line
  815.         send activate
  816.         send goto_line (line-1)
  817.         send mark_on
  818.     end_procedure
  819.  
  820.     procedure key integer key_val
  821.         local string eline
  822.         local integer posn new_pos
  823.         if key_val eq Kenter begin
  824.             get value to eline          
  825.             pos 'of File:' in eline to posn
  826.             if posn eq 0 procedure_return
  827.             send add_file to pick_file (mid(eline,40,posn+9))
  828.             send file_picked to pick_file
  829.             pos 'ON LINE:' in eline to posn
  830.             send goto_line to file_buffer ;
  831.                     ((int_cvt(desktop,eline,posn+9))-1)
  832.         end
  833.         else begin
  834.             set dynamic_update_state to false
  835.             forward send key key_val
  836.             if (hi(position(current_object))+1) gt (line_count(current_object)) begin
  837.                 send goto_line (line_count(current_object)-1)
  838.                 send mark_on
  839.             end
  840.             set dynamic_update_state to true
  841.         end
  842.     end_procedure
  843.  
  844.     procedure previous_error
  845.         send key Kuparrow
  846.         send key Kenter
  847.     end_procedure
  848.  
  849.     procedure next_error
  850.         send key Kdownarrow
  851.         send key Kenter
  852.     end_procedure
  853.  
  854. end_object
  855.  
  856. object load_buffer is a file_frame
  857.     set location to 3 17 absolute
  858.  
  859.     procedure activating
  860.         set value of (open_title(current_object)) item 0 to 'Open Source File'
  861.         set value of (file_name_form(current_object)) to '*.src'
  862.         forward send activating
  863.     end_procedure
  864.  
  865.     procedure load_it string file_spec
  866.         if (file_change_confirm(file_buffer.obj)) eq MSG_OK begin
  867.             send read_buffer to file_buffer file_spec
  868.             send add_file to pick_file file_spec
  869.         end
  870.         send deactivate
  871.         send activate to file_buffer
  872.     end_procedure
  873.  
  874. end_object
  875.  
  876. object include_buffer is a file_frame load_buffer
  877.     set location to 3 17 absolute
  878.  
  879.     procedure activating
  880.         set value of (open_title(current_object)) item 0 to 'Include Source File'
  881.         set value of (file_name_form(current_object)) to '*.src'
  882.         forward send activating
  883.     end_procedure
  884.  
  885.     procedure load_it string file_spec
  886.         send include_file to file_buffer file_spec
  887.         send deactivate
  888.         send activate to file_buffer
  889.     end_procedure
  890.  
  891. end_object
  892.  
  893. object run_flx is a file_frame load_buffer // use same image
  894.     set location to 3 17 absolute
  895.  
  896.     procedure activating
  897.         set value of (open_title(current_object)) item 0 to 'Run DataFlex Program'
  898.         set value of (file_name_form(current_object)) to '*.flx'
  899.         forward send activating
  900.     end_procedure
  901.  
  902.     procedure load_it string file_spec
  903.         send deactivate
  904.         send activate to file_buffer
  905.         if (file_change_confirm(file_buffer.obj)) eq MSG_OK ;
  906.                send write_current to file_buffer
  907.         clearscreen
  908.         chain wait (strip_extn(desktop,file_spec))
  909.         send refresh_screen
  910.     end_procedure
  911.  
  912. end_object
  913.  
  914. object about is a button
  915.     set location to 5 11 absolute
  916.     set BLOCK_MOUSE_STATE to true
  917.     set auto_top_item_state to false
  918.  
  919.     item_list
  920.         on_item 'DataFlex Program Development System' send none
  921.             set center_state to true
  922.         on_item '' send none
  923.         on_item 'OK' send about_exit
  924.         on_item 'HELP' send help
  925.     end_item_list
  926.  
  927.     set current_item to 2
  928.  
  929.     procedure item_change integer i_from integer i_to returns integer
  930.         if i_to ge 2 procedure_return i_to
  931.         procedure_return 2
  932.     end_procedure
  933.  
  934.     procedure about_exit
  935.         send deactivate
  936.         send activate to file_buffer
  937.     end_procedure
  938.  
  939.     procedure activating
  940.         integer mem
  941.         memory mem
  942.         set value item 1 to mem
  943.     end_procedure
  944.  
  945. end_object
  946.  
  947. object title_bar is a button
  948.     set LOCATION to 0 1 absolute
  949.     set center_state item 0 to true
  950.     item_list
  951.         on_item 'DataFlex Program Development System' send none
  952.     end_item_list
  953. end_object
  954.  
  955. object save_buffer is a client
  956.     set BLOCK_MOUSE_STATE to true
  957.     set location to 4 17 absolute
  958.     on_key kcancel send exit_save
  959.  
  960.     object save_title is a title
  961.         set center_state item 0 to true
  962.         set value item 0 to 'Save'
  963.         set focus_mode to NONFOCUSABLE
  964.     end_object
  965.  
  966.     object save_name_form is a form
  967.         item_list
  968.             on_item '' send save_it
  969.         end_item_list
  970.     end_object
  971.  
  972.     object save_buttons is a button
  973.         item_list
  974.             on_item 'OK' send save_it
  975.             on_item 'CANCEL' send exit_save
  976.             on_item 'HELP' send help
  977.         end_item_list
  978.     end_object
  979.  
  980.     procedure activating
  981.         set value of (save_name_form(current_object)) item 0 to ;
  982.                 (file_name(file_buffer.obj))
  983.     end_procedure
  984.  
  985.     procedure exit_save
  986.         send deactivate
  987.         send activate to file_buffer
  988.     end_procedure
  989.  
  990.     procedure save_it
  991.         send write_current to file_buffer (value(save_name_form(current_object),0))
  992.         send exit_save
  993.     end_procedure
  994.  
  995. end_object
  996.  
  997. object pick_file is a client
  998.     set BLOCK_MOUSE_STATE to true
  999.     set location to 5 5 absolute
  1000.     on_key kcancel send deactivate to pick_file
  1001.  
  1002.     object pick_title is a title
  1003.         set center_state item 0 to true
  1004.         set value item 0 to 'Recent files'
  1005.         set focus_mode to NONFOCUSABLE
  1006.     end_object
  1007.  
  1008.     object pick_list is a list
  1009.         set select_mode to auto_select
  1010.     end_object
  1011.  
  1012.     object pick_buttons is a button
  1013.         item_list
  1014.             on_item 'OK' send item_selected
  1015.             on_item 'CANCEL' send deactivate to pick_file
  1016.             on_item 'HELP' send help
  1017.         end_item_list
  1018.     end_object
  1019.  
  1020.     procedure item_selected
  1021.         send (message(pick_list(current_object),current))
  1022.     end_procedure
  1023.  
  1024.     procedure file_picked
  1025.         send deactivate
  1026.         if ( file_name( file_buffer.obj ) <> ;
  1027.                 value(pick_list(current_object),current) and ;
  1028.                 file_change_confirm(file_buffer.obj) = MSG_OK ) begin
  1029.             send read_buffer to file_buffer ;
  1030.                     ( value( pick_list( current_object ), current ))
  1031.         end
  1032.         send activate to file_buffer
  1033.     end_procedure
  1034.  
  1035.     procedure add_file string fname
  1036.         local integer match
  1037.         move 0 to match
  1038.         trim fname to fname
  1039.         get item_matching of (pick_list(current_object)) to fname match
  1040.         if match eq -1 ;
  1041.             send insert_item to (pick_list(current_object)) ;
  1042.                     msg_file_picked fname 0
  1043.         move 0 to match
  1044.         set top_item of (pick_list(current_object)) to 0
  1045.         get item_matching of (pick_list(current_object)) to fname match
  1046.         set current_item of (pick_list(current_object)) to match
  1047.     end_procedure
  1048.  
  1049.     procedure load_new
  1050.         send deactivate
  1051.         send activate to load_buffer
  1052.     end_procedure
  1053.  
  1054.     send add_item to (pick_list(current_object)) msg_load_new ;
  1055.             '   -- Load file --    '
  1056. end_object
  1057.  
  1058. object exit_confirm is a client
  1059.     set BLOCK_MOUSE_STATE to true
  1060.     set attach_parent_state to true
  1061.     set location to 6 18 absolute
  1062.     on_key kcancel send msg_cancel
  1063.  
  1064.     object exit_title is a title
  1065.         set center_state item 0 to true
  1066.         set value item 0 to 'DFPDS'
  1067.         set focus_mode to NONFOCUSABLE
  1068.     end_object
  1069.  
  1070.     object exit_name_form is a message
  1071.         set center_state item 0 to true
  1072.         set focus_mode to NONFOCUSABLE
  1073.     end_object
  1074.  
  1075.     object exit_buttons is a button
  1076.         item_list
  1077.             on_item 'Yes' send save_it
  1078.             on_item 'No' send msg_ok
  1079.             on_item 'Cancel' send msg_cancel
  1080.         end_item_list
  1081.     end_object
  1082.  
  1083.     procedure activating
  1084.         set value of (exit_name_form(current_object)) item 0 to ;
  1085.                 ( file_name( file_buffer.obj ))
  1086.     end_procedure
  1087.  
  1088.     procedure save_it
  1089.         send write_current to file_buffer
  1090.         send deactivate
  1091.         procedure_return msg_ok
  1092.     end_procedure
  1093.  
  1094. end_object
  1095.  
  1096. object compile_msg is a message
  1097.     set location to 6 13 absolute
  1098.     set center_state item 0 to true
  1099.     set center_state item 3 to true
  1100.     set value item 0 to 'Compilation'
  1101.     set value item 1 ''
  1102.     set value item 2 ''
  1103.     set value item 3 ''
  1104. end_object
  1105.  
  1106. object arguments is a client
  1107.     set BLOCK_MOUSE_STATE to true
  1108.     set location to 4 16 absolute
  1109.     on_key kcancel send exit_save
  1110.  
  1111.     object arg_title is a title
  1112.         set center_state item 0 to true
  1113.         set value item 0 to 'Program Arguments'
  1114.         set focus_mode to NONFOCUSABLE
  1115.     end_object
  1116.  
  1117.     object arg_value is a form
  1118.         item_list
  1119.             on_item '' send save_it
  1120.         end_item_list
  1121.     end_object
  1122.  
  1123.     object arg_buttons is a button
  1124.         item_list
  1125.             on_item 'OK' send save_it
  1126.             on_item 'CANCEL' send exit_save
  1127.             on_item 'HELP' send help
  1128.         end_item_list
  1129.     end_object
  1130.  
  1131.     procedure activating
  1132.         move ( value( arg_value( arguments.obj ), 0 )) to old_arg_val
  1133.     end_procedure
  1134.  
  1135.     procedure exit_save
  1136.         send save_it
  1137.         set value of ( arg_value( arguments.obj )) item 0 to old_arg_val
  1138.     end_procedure
  1139.  
  1140.     procedure save_it
  1141.         send deactivate
  1142.         send activate to file_buffer
  1143.     end_procedure
  1144.  
  1145. end_object
  1146.  
  1147. create_menu action_bar location 1 1 absolute
  1148.     on_item 'File' begin_pull_down file_pull_down
  1149.         on_item "New"                send clear_buffer to file_buffer
  1150.         on_item "Open...     Ctrl+O" send activate to load_buffer
  1151.         on_item "Include..."         send activate to include_buffer
  1152.         on_item "Pick...     F4"     send activate to pick_file
  1153.         on_item "Save"               send write_current
  1154.         on_item "Save as...  Alt+S"  send activate to save_buffer
  1155.         on_item "Print"              send print
  1156.         on_item "Exit        Alt+F4" send stop_ui
  1157.     end_pull_down
  1158.     on_item "Edit" begin_pull_down edit_pull_down
  1159.         on_item "Block operations..." begin_pull_down block_ops_pull_down
  1160.             on_item "Cut            Alt+Minus"  send cut_marked_area
  1161.             on_item "Copy           Ctrl+Minus" send copy_marked_area
  1162.             on_item "Paste          Alt+Equals" send paste_clipboard
  1163.             on_item "Remove line"               SEND delete_line
  1164.             on_item "Delete to EOL  Ctrl+BS"    SEND delete_to_eol
  1165.             on_item "Block mark     Ctrl+\"     SEND mark_block
  1166.             on_item "Column mark"               SEND mark_column
  1167.         end_pull_down
  1168.         on_item "Navigation..." begin_pull_down nav_ops_pull_down
  1169.             on_item "Start of text      Ctrl+Home" SEND beginning_of_data
  1170.             on_item "End of text        Ctrl+End"  SEND end_of_data
  1171.             on_item "Previous page      PgUp"      SEND page_up
  1172.             on_item "Next page          PgDn"      SEND page_down
  1173.             on_item "Top of window      Ctrl+Up"   SEND beginning_of_panel
  1174.             on_item "End of window      Ctrl+Dn"   SEND end_of_panel
  1175.             on_item "Beginning of line  Home"      SEND beginning_of_line
  1176.             on_item "End of line        End"       SEND end_of_line
  1177.             on_item "Line#..."                     SEND goto_user_line
  1178.         end_pull_down
  1179.         on_item "Search..." begin_pull_down search_ops_pull_down
  1180.             on_item "Search text...    Ctrl+F"     SEND search_file
  1181.             on_item "Repeat search     Alt+A"      SEND repeat_search_file
  1182.             on_item "Translate text... Alt+T"      SEND do_translates
  1183.         end_pull_down
  1184.         on_item "Miscellaneous..." begin_pull_down misc_ops_pull_down
  1185.             on_item "Change margin..."  SEND reset_margin
  1186.             on_item "Status line off"   SEND reset_status
  1187.             on_item "Status line on"    SEND set_status
  1188.             on_item "Insert mode"       SEND insert_mode
  1189.             on_item "Overwrite mode"    SEND overstrike_mode
  1190.         end_pull_down
  1191.     end_pull_down
  1192.     on_item 'View' begin_pull_down view_pull_down
  1193.         on_item "View PRN Listing     Alt+L"    send view_prn_file
  1194.         on_item "Zoom message area    Alt+Z"    send zoom_message_area
  1195.         on_item "Switch Message area  F6"       send switch_client_areas
  1196.         on_item "Previous error       Alt+P"    send previous_error to error_buffer
  1197.         on_item "Next error           Alt+N"    send next_error to error_buffer
  1198.     end_pull_down
  1199.     on_item 'Run' begin_pull_down Run_pull_down
  1200.         on_item "Compile only       Alt+C" send run_compiler
  1201.         on_item "Precompile program"       send precomp_prg
  1202.         on_item "Run (and compile)  Alt+G" send test_program
  1203.         on_item "Run program..."           send activate to run_flx
  1204.         on_item "OS Shell"                 send rp_wait
  1205.         on_item "File definition"          send run_dffile
  1206.         on_item "Query databases"          send run_query
  1207.         on_item "Menu definition"          send run_menudef
  1208.         on_item "Fmac maintenance"         send run_dfpack
  1209.     end_pull_down
  1210.     on_item 'Options' begin_pull_down options_pull_down
  1211.         on_item "Load compiler options"         send load_defaults
  1212.         on_item "Compiler options...     Alt+D" send activate to options
  1213.         on_item "Environment options..."        send activate to environment_screen
  1214.         on_item "Save compiler options"         send save_defaults
  1215.         on_item "Arguments..."                  send activate to arguments
  1216.     end_pull_down
  1217.     on_item 'Help' begin_pull_down help_pull_down
  1218.         on_item "Help for help..." send Help_For_Help
  1219.         on_item "Extended help..." send Extended_Help
  1220.         on_item "Keys help..."     send Keys_Help
  1221.         on_item "Help Index..."    send Help_Index
  1222.         on_item "About..."         send activate to about
  1223.         move current_object to windowindex
  1224.     end_pull_down
  1225.     on_key kcancel send stop_ui
  1226. end_menu
  1227.  
  1228. object options is a client
  1229.     set location to 3 17 absolute
  1230.     set BLOCK_MOUSE_STATE to true
  1231.     on_key kcancel send options_done
  1232.  
  1233.     object options_title is a title
  1234.         set center_state item 0 to true
  1235.         set value item 0 to 'Compiler Options'
  1236.         set focus_mode to NONFOCUSABLE
  1237.     end_object
  1238.  
  1239.     object listings is a checkbox
  1240.         set select_mode to auto_select
  1241.         item_list
  1242.             repeat_item 3 times '' send options_done
  1243.         end_item_list
  1244.     end_object
  1245.  
  1246.     object error_stop is a checkbox
  1247.         set select_mode to auto_select
  1248.         item_list
  1249.             repeat_item 2 times '' send options_done
  1250.         end_item_list
  1251.     end_object
  1252.  
  1253.     object check_opts is a checkbox
  1254.         set select_mode to multi_select
  1255.         item_list
  1256.             repeat_item 4 times '' send options_done
  1257.         end_item_list
  1258.     end_object
  1259.  
  1260.    object entry_opts is a form
  1261.         item_list
  1262.             on_item '0' send options_done
  1263.             on_item '' send options_done
  1264.             on_item '30' send options_done
  1265.             on_item '20' send options_done
  1266.         end_item_list
  1267.     end_object
  1268.  
  1269.     object options_buttons is a button
  1270.         item_list
  1271.             on_item 'OK' send options_done
  1272.             on_item 'HELP' send help
  1273.         end_item_list
  1274.     end_object
  1275.   
  1276.     procedure options_done
  1277.         set shadow_state of ( view_pull_down( action_bar.obj )) item 0 to ;
  1278.                 ( select_state( listings( options.obj ), 1 ) - 1)
  1279.         send deactivate
  1280.         send activate to file_buffer
  1281.     end_procedure
  1282.  
  1283. end_object
  1284.  
  1285. object environment_screen is a client
  1286.     set location to 7 10 relative
  1287.     set BLOCK_MOUSE_STATE to true
  1288.  
  1289.     object environment_title is a title
  1290.         set CENTER_STATE item 0 to true
  1291.         set value to "Environment Options"
  1292.     end_object
  1293.  
  1294.     object environment_options is a checkbox
  1295.         set select_mode to multi_select
  1296.         item_list
  1297.             on_item "Create backup file"   send next
  1298.             on_item "Prompt on file saves" send next
  1299.             set select_state to true
  1300.         end_item_list
  1301.     end_object
  1302.  
  1303.     object environment_buttons is a button
  1304.         item_list
  1305.             on_item "OK"     send deactivate to environment_screen
  1306.             on_item "HELP"   send help
  1307.         end_item_list
  1308.     end_object
  1309.  
  1310.     on_key kcancel send deactivate to environment_screen
  1311.  
  1312. end_object
  1313.  
  1314. object read_msg is a message
  1315.     set visible_state to false
  1316. end_object
  1317.  
  1318. procedure accelerator_keys
  1319.     on_key key_alt+key_n    send next_error to error_buffer PRIVATE
  1320.     on_key key_alt+key_p    send previous_error to error_buffer PRIVATE
  1321.     on_key key_alt+key_z    send zoom_message_area PRIVATE
  1322.     on_key key_alt+key_c    send run_compiler PRIVATE
  1323.     on_key key_alt+key_s    send activate to save_buffer PRIVATE
  1324.     on_key key_alt+key_l    send view_prn_file PRIVATE
  1325.     on_key key_alt+key_d    send activate to options PRIVATE
  1326.     on_key key_alt+key_g    send test_program PRIVATE
  1327.     on_key key_ctrl+key_o   send activate to load_buffer PRIVATE
  1328.  
  1329.     on_key key_alt+key_F    send activate to (file_pull_down(action_bar.obj)) PRIVATE
  1330.     on_key key_alt+key_E    send activate to (edit_pull_down(action_bar.obj)) PRIVATE
  1331.     on_key key_alt+key_V    send activate to (view_pull_down(action_bar.obj)) PRIVATE
  1332.     on_key key_alt+key_R    send activate to (run_pull_down(action_bar.obj)) PRIVATE
  1333.     on_key key_alt+key_O    send activate to (options_pull_down(action_bar.obj)) PRIVATE
  1334.     on_key key_alt+key_H    send activate to (help_pull_down(action_bar.obj)) PRIVATE
  1335.  
  1336.     on_key kaction_bar    send menu_switch PRIVATE
  1337.     on_key kcancel        send menu_switch PRIVATE
  1338.     on_key kswitch        send switch_client_areas PRIVATE
  1339.     on_key kprompt        send activate to pick_file PRIVATE
  1340. end_procedure
  1341.  
  1342. on_key kexit_application  send stop_ui
  1343.  
  1344. procedure switch_client_areas
  1345.     if (active_state(error_buffer.obj)) begin
  1346.         if (focus(desktop)) eq (file_buffer(desktop)) ;
  1347.                 send activate to error_buffer
  1348.         else if (focus(desktop)) eq (error_buffer(desktop)) ;
  1349.                 send activate to file_buffer
  1350.     end         
  1351. end_procedure
  1352.  
  1353. procedure menu_switch
  1354.     local integer foc
  1355.     get focus to foc
  1356.     if foc ne (action_bar(desktop)) ;
  1357.         if (parent(foc)) ne (action_bar(desktop)) ;
  1358.                 send activate to action_bar
  1359.         else send activate to file_buffer
  1360. end_procedure
  1361.  
  1362. function compiler_options_string integer precomp returns string
  1363.     local string comp
  1364.     move (mid('FL', 1, current_item(listings(options.obj)) )) to comp
  1365.     append comp (mid('EC', 1, current_item(error_stop(options.obj))+1 ))
  1366.     if (select_state(check_opts(options.obj),0)) append comp 'Q'
  1367.     if (select_state(check_opts(options.obj),1)) append comp 'K'
  1368.     if (select_state(check_opts(options.obj),2)) append comp 'W'
  1369.     if (select_state(check_opts(options.obj),3)) append comp 'S'
  1370.     append comp ('V'+(value(entry_opts(options.obj),0)))
  1371.     if (value(entry_opts(options.obj),1)) gt '' append comp ('D'+(value(entry_opts(options.obj),1)))
  1372.     append comp ('X'+(value(entry_opts(options.obj),2)))
  1373.     append comp ('M'+(value(entry_opts(options.obj),3)))
  1374.     if precomp ne 0 append comp 'P'
  1375.     function_return comp
  1376. end_function
  1377.  
  1378. function run_compiler_msg integer pause_mode integer precomp returns integer
  1379.  
  1380.     local string comp
  1381.     local integer err_cnt
  1382.     move 0 to err_cnt
  1383.     send write_current to file_buffer
  1384.     move ('dfcomp '+(file_name(file_buffer.obj))+' -') to comp
  1385.     append comp (compiler_options_string(desktop,precomp))
  1386.     set value of compile_msg item 1 to (file_name(file_buffer.obj))
  1387.     set value of compile_msg item 2 to '0'
  1388.     set value of compile_msg item 3 to ''
  1389.     move 0 to minimum_memory
  1390.     send activate to file_buffer
  1391.     send activate to compile_msg
  1392.  
  1393.     screen_optimize false
  1394.     clearscreen
  1395.     screen_optimize true
  1396.  
  1397.     runprogram wait comp
  1398.     send refresh_screen
  1399.     send delete_data to error_buffer
  1400.     send mark_off to error_buffer
  1401.  
  1402.     if (select_state(check_opts(options.obj),2)) begin
  1403.         move (strip_extn(desktop,file_name(file_buffer.obj))) to comp
  1404.         set file_name of error_buffer to (comp+'.err')
  1405.         send read to error_buffer ''
  1406.         send beginning_of_data to error_buffer
  1407.         repeat
  1408.             send find to error_buffer 'RROR: ' windowindex
  1409.             if windowindex eq 1 increment err_cnt
  1410.             set value of compile_msg item 2 to err_cnt
  1411.         until windowindex eq 0
  1412.     end
  1413.     send beginning_of_data to error_buffer
  1414.     if err_cnt gt 0 begin
  1415.         send bell
  1416.         set value of compile_msg item 3 to ;
  1417.                 'Errors found                            Press any key'
  1418.     end
  1419.     else set value of compile_msg item 3 to ;
  1420.             'Success                                 Press any key'
  1421.     if (err_cnt + pause_mode) gt 0 inkey windowindex
  1422.     send deactivate to compile_msg
  1423.     if err_cnt gt 0 begin
  1424.         send mark_on to error_buffer
  1425.         if (active_state(error_buffer.obj) = 0) send zoom_message_area
  1426.         send previous_error to error_buffer
  1427.     end
  1428.     function_return err_cnt
  1429. end_function
  1430.  
  1431. procedure run_compiler
  1432.     move (run_compiler_msg(desktop,1,0)) to windowindex
  1433. end_procedure
  1434.  
  1435. procedure precomp_prg
  1436.     move (run_compiler_msg(desktop,1,1)) to windowindex
  1437. end_procedure
  1438.  
  1439. procedure Test_program
  1440.     send activate to file_buffer
  1441.     if (changed_state(file_buffer.obj)) eq 1 ;
  1442.             send write_current to file_buffer
  1443.     if (run_compiler_msg(desktop,0,0)) procedure_return
  1444.     clearscreen
  1445.     chain wait ( (strip_extn(desktop,file_name(file_buffer.obj))) + " " + ;
  1446.             (value(arg_value(arguments.obj),0)) )
  1447.     send refresh_screen
  1448. end_procedure
  1449.  
  1450. procedure view_prn_file
  1451.     if (select_state(listings(options.obj),1)) begin
  1452.         send delete_data to prn_buffer
  1453.         set file_name of prn_buffer to ;
  1454.                 ( (strip_extn(desktop,file_name(file_buffer.obj))) + '.prn' )
  1455.         send read to prn_buffer ''
  1456.         send beginning_of_data to prn_buffer
  1457.         send activate to file_buffer
  1458.         if (line_count(prn_buffer.obj)) gt 0 ;
  1459.                 ui_accept prn_buffer object to windowindex
  1460.         else send bell
  1461.     end
  1462.     else send bell
  1463. end_procedure
  1464.  
  1465. procedure zoom_message_area
  1466.     if (active_state(error_buffer.obj)) eq 1 begin
  1467.         send deactivate to error_buffer
  1468.         set size of file_buffer to (screenend-3) 77
  1469.         send activate to file_buffer
  1470.     end
  1471.     else begin
  1472.         send activate to file_buffer
  1473.         set size of file_buffer to (screenend-8) 77
  1474.         send activate to error_buffer
  1475.         send activate to file_buffer
  1476.     end
  1477. end_procedure
  1478.  
  1479. procedure rp_wait_proc string file_name
  1480.     send activate to file_buffer
  1481.     screen_optimize false
  1482.     clearscreen
  1483.     if file_name eq '' showln 'Enter "EXIT" to return to DFPDS.'
  1484.     screen_optimize true
  1485.     runprogram wait file_name
  1486.     send refresh_screen
  1487. end_procedure
  1488.  
  1489. procedure load_defaults
  1490.     local string dflt cmd
  1491.     local integer count
  1492.     direct_input 'dfpds.cfg'
  1493.     [not seqeof] begin
  1494.         readln dflt
  1495.         close_input
  1496.         move 1 to count
  1497.         while count le (length(dflt))
  1498.             move (mid(dflt,1,count)) to cmd
  1499.             if cmd eq 'F' set current_item of (listings(options.obj)) to 1
  1500.             else if cmd eq 'L' set current_item of (listings(options.obj)) to 2
  1501.             else if cmd eq 'E' ;
  1502.                     set current_item of (error_stop(options.obj)) to 0
  1503.             else if cmd eq 'C' ;
  1504.                     set current_item of (error_stop(options.obj)) to 1
  1505.             else if cmd eq 'Q' ;
  1506.                     set select_state of (check_opts(options.obj)) item 0 to true
  1507.             else if cmd eq 'K' ;
  1508.                     set select_state of (check_opts(options.obj)) item 1 to true
  1509.             else if cmd eq 'W' ;
  1510.                     set select_state of (check_opts(options.obj)) item 2 to true
  1511.             else if cmd eq 'S' ;
  1512.                     set select_state of (check_opts(options.obj)) item 3 to true
  1513.             else if cmd eq 'V' ;
  1514.                     set value of (entry_opts(options.obj)) item 0 to ;
  1515.                             (int_cvt(desktop,dflt,count+1))
  1516.             else if cmd eq 'D' begin
  1517.                 increment count
  1518.                 set value of (entry_opts(options.obj)) item 1 to (mid(dflt,1,count))
  1519.             end                             
  1520.             else if cmd eq 'X' ;
  1521.                     set value of (entry_opts(options.obj)) item 2 to ;
  1522.                             (int_cvt(desktop,dflt,count+1))
  1523.              else if cmd eq 'M' ;
  1524.                     set value of (entry_opts(options.obj)) item 3 to ;
  1525.                             (int_cvt(desktop,dflt,count+1))
  1526.              increment count
  1527.         end
  1528.     end
  1529.     set shadow_state of (view_pull_down(action_bar.obj)) item 0 to ;
  1530.             (select_state(listings(options.obj),1) - 1)
  1531.  
  1532. end_procedure
  1533.  
  1534. procedure save_defaults
  1535.     direct_output 'dfpds.cfg'
  1536.     writeln (compiler_options_string(desktop,0))
  1537.     close_output
  1538. end_procedure
  1539.  
  1540. procedure rp_wait
  1541.     send rp_wait_proc ''
  1542. end_procedure
  1543.  
  1544. procedure run_dffile
  1545.     send rp_wait_proc 'dffile'
  1546. end_procedure
  1547.  
  1548. procedure run_query
  1549.     send rp_wait_proc 'dfquery'
  1550. end_procedure
  1551.  
  1552. procedure run_dfpack
  1553.     send rp_wait_proc 'dfpack'
  1554. end_procedure
  1555.  
  1556. procedure run_menudef
  1557.         send activate to file_buffer
  1558.         clearscreen
  1559.         chain wait 'menudef'
  1560.         send refresh_screen
  1561. end_procedure
  1562.  
  1563.  
  1564. string in_line
  1565.  
  1566. clearscreen
  1567. send load_defaults
  1568. clearscreen
  1569. send page_object to title_bar true
  1570. send activate to action_bar     // put the action bar in the list
  1571.  
  1572. indicate first_file true
  1573. cmdline in_line
  1574. if in_line eq '' set file_name of file_buffer to 'NONAME'
  1575. while in_line gt ''
  1576.     send add_file to pick_file in_line
  1577.     [first_file] send file_picked to pick_file
  1578.     cmdline in_line
  1579.     indicate first_file false
  1580. end
  1581.  
  1582. repeat
  1583.     start_ui file_buffer
  1584. until (file_change_confirm(file_buffer.obj)) eq MSG_OK
  1585.  
  1586. clearscreen                     // clear the screen before exit
  1587. abort
  1588.  
  1589.  
  1590.