home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / dirdg10.zip / DirDialg.VRX < prev    next >
Text File  |  1994-08-21  |  8KB  |  281 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         0_Copyright
  67. */
  68. 0_Copyright:
  69. /*
  70.     This is DirDialog V1.0. (C) 1994 by Ralf G. R. Bergs
  71.  
  72.     E-mail:     rabe@pool.informatik.rwth-aachen.de
  73.     Snail mail: Hueckeswagener Str. 42, 51647 Gummersbach, FR of Germany
  74.     Phone/fax:  +49 2261 21968
  75.  
  76.  
  77.     License:
  78.     =======
  79.     "This library is free software; you can redistribute it and/or
  80.     modify it under the terms of the GNU Library General Public
  81.     License as published by the Free Software Foundation; either
  82.     version 2 of the License, or (at your option) any later version.
  83.  
  84.     This library is distributed in the hope that it will be useful,
  85.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  86.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  87.     Library General Public License for more details.
  88.  
  89.     You should have received a copy of the GNU Library General Public
  90.     License along with this library; if not, write to the Free
  91.     Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA."
  92.  
  93.  
  94.     Purpose:
  95.     =======
  96.     DirDialg() is a dialog similar to the system file dialog. In contrast
  97.     to the latter it is NOT used to select individual files, but a directory
  98.     from a list.
  99.  
  100.  
  101.     Usage:
  102.     =====
  103.     dir = DirDialg( caption, startdir )
  104.  
  105.         caption:  the dialog window's title (default: "Select a directory")
  106.         startdir: the directory initially displayed when you call DirDialg()
  107.                     (default: the current working directory at the time your
  108.                     application was started)
  109.         dir:      either a directory you selected or "" if you pressed
  110.                     "Cancel."
  111.  
  112.     History:
  113.     =======
  114.     08/21/94    First public release V1.0
  115.  
  116. */
  117. return
  118.  
  119. /*:VRX         Fini
  120. */
  121. Fini:
  122.     window = VRWindow()
  123.     call VRSet window, "Visible", 0
  124.     drop window
  125. return RetCode                  /* return selected directory */
  126. /*:VRX         Halt
  127. */
  128. Halt:
  129.     signal _VREHalt
  130. return
  131.  
  132. /*:VRX         Init
  133. */
  134. Init:
  135. /* Arguments to DirDialg:
  136.     1: Caption (the dir dialog's title header)
  137.     2: startDir (the starting directory to be displayed in the dir dialog)
  138. */
  139.  
  140.     retcode = ""                    /* used to return selected directory */
  141.  
  142.     if InitArgs.0 >= 1 then do
  143.         call VRSet "W_DirDialog", "Caption", InitArgs.1
  144.     end
  145.  
  146.     if InitArgs.0 = 2 then do
  147.         startDir = InitArgs.2
  148.     end
  149.     else do                         /* if no start dir given, use current */
  150.                                     /* working directory */
  151.         startDir = VRGet( "Application", "WorkingDirectory" )
  152.     end
  153.  
  154.     window = VRWindow()
  155.     call VRMethod window, "CenterWindow"
  156.     call VRSet window, "Visible", 1
  157.     call VRMethod window, "Activate"
  158.     drop window
  159.  
  160.     call InitDriveList
  161.     call InitDirList startDir
  162.  
  163.     drop startDir
  164. return
  165.  
  166. /*:VRX         InitDirList
  167. */
  168. InitDirList: procedure
  169. parse arg cwd
  170.     Call VRSet "EF_CurrDir", "Value", cwd
  171.  
  172.     call VRSet "W_DirDialog", "Enabled", 0      /* prevent input into window */
  173.     call VRSet "W_DirDialog", "Pointer", "Wait" /* show "Busy" mouse pointer */
  174.  
  175.     call VRMethod "LB_Dirs", "Clear"
  176.     call UpdateDirList cwd
  177.  
  178.     call VRSet "EF_CurrDir", "SelectedStart", 1 /* pre-select EntryField's */
  179.     call VRSet "EF_CurrDir", "SelectedEnd", ,   /* contents */
  180.             Length(cwd)+1
  181.     call VRMethod  "EF_CurrDir", "SetFocus"
  182.  
  183.     call VRSet "W_DirDialog", "Pointer", "<Default>"
  184.     call VRSet "W_DirDialog", "Enabled", 1      /* allow input again */
  185. return
  186.  
  187. /*:VRX         InitDriveList
  188. */
  189. InitDriveList: procedure
  190. /* get currently available drives and update drive list box accordingly */
  191.  
  192.     notRegistered = RxFuncQuery( "SysDriveMap" )
  193.     if notRegistered then do
  194.         call RxFuncAdd "SysDriveMap", "RexxUtil", "SysDriveMap"
  195.     end
  196.     DriveMap = SysDriveMap( "A:", "USED" )      /* returns available drives */
  197.     if notRegistered then do
  198.         call RxFuncDrop( "SysDriveMap" )
  199.     end
  200.  
  201.     ok = VRMethod( "LB_Drives", "Clear" )       /* clear all list items */
  202.  
  203.     do until DriveMap = ""                      /* "unpack" drive map */
  204.         parse var DriveMap Drive DriveMap
  205.         if Drive \= "A:" & Drive \= "B:" then do
  206.             Drive = Drive || " [" || VRDiskLabel( Drive ) || "]"
  207.         end
  208.         ok = VRMethod( "LB_Drives", "AddString", ,
  209.                 Drive )                         /* add drive to list box */
  210.     end
  211. return
  212. /*:VRX         LB_Dirs_DoubleClick
  213. */
  214. LB_Dirs_DoubleClick: procedure
  215.     cwd = VRGet( "EF_CurrDir", "Value" )
  216.     dir = VRExpandFileName( cwd || "\" || VRGet( "LB_Dirs", "SelectedString" ),
  217.              || "\" )
  218.     Call InitDirList dir
  219. return
  220.  
  221. /*:VRX         LB_Drives_DoubleClick
  222. */
  223. LB_Drives_DoubleClick: procedure
  224.     drive = word( VRGet( "LB_Drives", "SelectedString" ), 1)
  225.     cwd = VRExpandFileName( drive || VRCurrDir( drive ) )
  226.     Call InitDirList cwd
  227. return
  228.  
  229. /*:VRX         PB_Cancel_Click
  230. */
  231. PB_Cancel_Click:
  232.     call Quit
  233. return
  234.  
  235. /*:VRX         PB_Ok_Click
  236. */
  237. PB_Ok_Click:
  238.     Dir = VRGet( "EF_CurrDir", "Value" )
  239.     if VRIsDir( Dir ) then do
  240.         Retcode = Dir
  241.         call Quit
  242.     end
  243.     else do
  244.         call VRMethod  "EF_CurrDir", "SetFocus"
  245.     end
  246. return
  247.  
  248. /*:VRX         Quit
  249. */
  250. Quit:
  251.     window = VRWindow()
  252.     call VRSet window, "Shutdown", 1
  253.     drop window
  254. return
  255.  
  256. /*:VRX         UpdateDirList
  257. */
  258. UpdateDirList: procedure
  259. /* Arguments:
  260.     dir:    path for which to return an array with all subdirectory names in it
  261.             WITHOUT trailing backslash
  262. */
  263. arg dir
  264.  
  265. d = VRDir( dir || "\*", "N", "D" )
  266. do while d \= ""  
  267.     if d \= "." & VRIsDir( dir || "\" || d) then do
  268.         call VRMethod "LB_Dirs", "AddString", d
  269.     end
  270.     d = VRDir( , "N", )
  271. end
  272.  
  273. return
  274.  
  275. /*:VRX         W_DirDialog_Close
  276. */
  277. W_DirDialog_Close:
  278.     call Quit
  279. return
  280.  
  281.