home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / vxdemo.zip / SCAN.$$$ / SCAN.VRX < prev    next >
Text File  |  1993-08-20  |  5KB  |  220 lines
  1. /*:VRX         Main
  2. */
  3. /*  Main
  4. */
  5. Main:
  6. /*  Process the arguments.
  7.     Get the parent window.
  8. */
  9.     parse source . calledAs .
  10.     parent = ""
  11.     argCount = arg()
  12.     argOff = 0
  13.     if( calledAs \= "COMMAND" )then do
  14.         if argCount >= 1 then do
  15.             parent = arg(1)
  16.             argCount = argCount - 1
  17.             argOff = 1
  18.         end
  19.     end
  20.     InitArgs.0 = argCount
  21.     if( argCount > 0 )then do i = 1 to argCount
  22.         InitArgs.i = arg( i + argOff )
  23.     end
  24.     drop calledAs argCount argOff
  25.  
  26. /*  Load the windows
  27. */
  28.     call VRInit
  29.     parse source . . spec
  30.     _VREPrimaryWindowPath = ,
  31.         VRParseFileName( spec, "dpn" ) || ".VRW"
  32.     _VREPrimaryWindow = ,
  33.         VRLoad( parent, _VREPrimaryWindowPath )
  34.     drop parent spec
  35.     if( _VREPrimaryWindow == "" )then do
  36.         call VRMessage "", "Cannot load window:" VRError(), ,
  37.             "Error!"
  38.         _VREReturnValue = 32000
  39.         signal _VRELeaveMain
  40.     end
  41.  
  42. /*  Process events
  43. */
  44.     call Init
  45.     signal on halt
  46.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  47.         _VREEvent = VREvent()
  48.         interpret _VREEvent
  49.     end
  50. _VREHalt:
  51.     _VREReturnValue = Fini()
  52.     call VRDestroy _VREPrimaryWindow
  53. _VRELeaveMain:
  54.     call VRFini
  55. exit _VREReturnValue
  56.  
  57. VRLoadSecondary: procedure
  58.     name = arg( 1 )
  59.  
  60.     window = VRLoad( VRWindow(), VRWindowPath(), name )
  61.     call VRMethod window, "CenterWindow"
  62.     call VRSet window, "Visible", 1
  63.     call VRMethod window, "Activate"
  64. return window
  65.  
  66. /*:VRX         Cancel_Click
  67. */
  68. Cancel_Click:
  69.     newLine = 0
  70.     call Quit
  71. return
  72.  
  73. /*:VRX         Fini
  74. */
  75. Fini:
  76.     window = VRWindow()
  77.     call VRSet window, 'visible', 'false'
  78.     drop window
  79.     
  80.     if newLine = 0 then do
  81.         call etksetfilefield 'line', oldLine
  82.     end
  83.     else do
  84.         'top'
  85.         'locate /' || selectedLabel || ':/'
  86.      end
  87.  
  88. return 0
  89.  
  90. /*:VRX         Halt
  91. */
  92. Halt:
  93.     signal _VREHalt
  94. return
  95.  
  96. /*:VRX         Init
  97. */
  98. Init:
  99.     window = VRWindow()
  100.     addr = address()
  101.     if addr == "EPM" then do
  102.         call VRMethod window, "CenterWindow"
  103.         call VRSet window, "Visible", 1
  104.         call VRMethod window, "Activate"
  105.         call InitLabels
  106.     end
  107.     else do
  108.         call VRMessage window,,
  109.              "You must run this macro from EPM.",,
  110.              "Error!"
  111.         exit        
  112.     end
  113.     drop window
  114. return
  115.  
  116. InitLabels: procedure expose oldLine newLine lastLine
  117.  
  118. /*  Uncomment to debug the macro.
  119.     call VRRedirectStdio
  120. */
  121.     "sayerror Locating labels"
  122.  
  123.     'extract /line'
  124.     oldLine = line.1
  125.     newLine = 0
  126.  
  127.     'extract /last'
  128.     lastLine = last.1
  129.  
  130.     count = init_all_at_once() 
  131. /*  count = init_one_at_a_time()  */
  132.  
  133.     'sayerror Found' count 'labels'
  134.    
  135. return
  136.  
  137. init_all_at_once: procedure
  138.     'all /^[abcdefghijklmnopqrstuvwxyz0123456789_]+:/g c'
  139.     if rc = 0 then return 0
  140.  
  141.     'sayerror Extracting labels'
  142.  
  143.     'extract /last'
  144.     curLast = last.1
  145.    
  146.     'top'
  147.     curLine = 1
  148.     call VRSet 'listbox', 'painting', 0
  149.     do forever
  150.         'extract /getline'
  151.         parse var getline.1 lineNumber label ':' .
  152.         call vrmethod 'listbox', 'addstring', label
  153.         if curLine = curLast then leave
  154.         '+1'
  155.         curLine = curLine + 1
  156.     end /* do */
  157.     call VRSet 'listbox', 'painting', 1
  158.  
  159.     'quit'
  160.  
  161. return curLast
  162.  
  163. init_one_at_a_time: procedure expose lastLine
  164.     'top'
  165.     curLine = 1
  166.     count = 0
  167.     call VRSet 'listbox', 'painting', 0
  168.     do forever
  169.          'sayerror Line' curLine 'of' lastLine
  170.          'locate /^[abcdefghijklmnopqrstuvwxyz0123456789_]+:/g c'
  171.          if rc \= 0 then leave
  172.          count = count + 1
  173.          'extract /getline'
  174.          parse var getline.1 label ':' .
  175.          call vrmethod 'listbox', 'addstring', label
  176.          'extract /line'
  177.          curLine = line.1
  178.          '+1'
  179.     end /* do */
  180.     call VRSet 'listbox', 'painting', 1
  181.  
  182. return count
  183.  
  184. /*:VRX         ListBox_Click
  185. */
  186. ListBox_Click:
  187.     call VRMethod "ListBox", "GetSelectedStringList", "sel."
  188.     if( sel.0 = 1 )then do
  189.         newLine = 1
  190.         selectedLabel = sel.1
  191.     end
  192. return
  193.  
  194. /*:VRX         ListBox_DoubleClick
  195. */
  196. ListBox_DoubleClick:
  197.     call OK_Click
  198. return
  199.  
  200. /*:VRX         Ok_Click
  201. */
  202. Ok_Click:
  203.     call Quit
  204. return
  205.  
  206. /*:VRX         Quit
  207. */
  208. Quit: 
  209.     window = VRWindow()
  210.     call VRSet window, 'shutdown', 'true'
  211.     drop window
  212. return
  213.  
  214. /*:VRX         Window1_Close
  215. */
  216. Window1_Close:
  217.     call Quit
  218. return
  219.  
  220.