home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Tools / EasyGUI / freq / myreq.e next >
Encoding:
Text File  |  1995-07-06  |  8.7 KB  |  357 lines
  1. OPT OSVERSION=37, PREPROCESS
  2.  
  3. -> Comment out this #define if you don't have/want to use sortlist.m
  4. #define SORTLIST
  5.  
  6. MODULE 'tools/EasyGUI', 'tools/exceptions', 'amigalib/lists', 'utility',
  7.        'gadtools', 'libraries/gadtools', 'exec/lists', 'exec/nodes',
  8.        'dos/dos', 'dos/exall', 'dos/dosextens'
  9.  
  10. #ifdef SORTLIST
  11. MODULE '*sortlist'
  12. #endif
  13.  
  14. ENUM ERR_NONE, ERR_NEW, ERR_STR, ERR_LOCK, ERR_ADO, ERR_NODE, ERR_LIB, ERR_PATT,
  15.      ERR_OK, ERR_CANCEL
  16.  
  17. RAISE ERR_NEW  IF New()=NIL,
  18.       ERR_STR  IF String()=NIL,
  19.       ERR_LOCK IF Lock()=NIL,
  20.       ERR_ADO  IF AllocDosObject()=NIL,
  21.       ERR_LIB  IF OpenLibrary()=NIL,
  22.       ERR_PATT IF ParsePatternNoCase()=-1
  23.  
  24. #define DIRSTR '<DIR> '
  25. #define VOLSTR '<VOL> '
  26. #define ASNSTR '<ASN> '
  27. CONST DIRSTRLEN=6
  28.  
  29. CONST BUF_SIZE=1024, FILENAME_SIZE=300
  30. CONST PATTERNBUFF_SIZE=FILENAME_SIZE*2+2
  31. ENUM DIR_NODE, POS_NODE, VOL_NODE, ASN_NODE, FILE_NODE, MAX_TYPE
  32.  
  33. DEF pathStr[FILENAME_SIZE]:STRING, currPath[FILENAME_SIZE]:STRING,
  34.     fileStr[FILENAME_SIZE]:STRING, patternStr[FILENAME_SIZE]:STRING,
  35.     patternBuff[PATTERNBUFF_SIZE]:ARRAY,
  36.     listGad, pathGad, fileGad, patternGad, secs, micros, oldSel=-1,
  37.     nameList=NIL:PTR TO lh, posList=NIL:PTR TO lh
  38.  
  39. DEF gh=NIL:PTR TO guihandle
  40.  
  41. -> Store the contents of path directory in list
  42. PROC getDir() HANDLE
  43.   DEF success, eacontrol=NIL:PTR TO exallcontrol, lock=NIL,
  44.       dlock=NIL, dl:PTR TO doslist, buffer[BUF_SIZE]:ARRAY, items=0
  45. #ifndef SORTLIST
  46.   freeNodes(nameList)
  47. #endif
  48. #ifdef SORTLIST
  49.   emptySortedList(nameList)
  50. #endif
  51.   IF currPath[]  -> Valid path
  52.     lock:=Lock(currPath, ACCESS_READ)
  53.     eacontrol:=AllocDosObject(DOS_EXALLCONTROL, NIL)
  54.     eacontrol.lastkey:=0
  55.     eacontrol.matchstring:=patternBuff
  56.     REPEAT
  57.       success:=ExAll(lock, buffer, BUF_SIZE, ED_TYPE, eacontrol)
  58.       IF eacontrol.entries<>0 THEN items:=items+addItems(buffer)
  59.     UNTIL success=FALSE
  60.   ELSE  -> Do a volume and assign list
  61.     dl:=(dlock:=LockDosList(LDF_VOLUMES OR LDF_ASSIGNS OR LDF_READ))
  62.     WHILE dl:=NextDosEntry(dl, LDF_VOLUMES OR LDF_ASSIGNS)
  63.       addEntry(BADDR(dl.name),IF dl.type=DLT_VOLUME THEN VOL_NODE ELSE ASN_NODE)
  64.       INC items
  65.     ENDWHILE
  66.   ENDIF
  67. #ifdef SORTLIST
  68.   IF items THEN makeSortedList(nameList, items, SIZEOF ln)  -> Sort it
  69. #endif
  70. EXCEPT DO
  71.   IF eacontrol THEN FreeDosObject(DOS_EXALLCONTROL, eacontrol)
  72.   IF lock THEN UnLock(lock)
  73.   IF dlock THEN UnLockDosList(LDF_VOLUMES OR LDF_ASSIGNS OR LDF_READ)
  74.   IF exception=ERR_LOCK
  75.     DisplayBeep(NIL)
  76.   ELSE
  77.     ReThrow()
  78.   ENDIF
  79. ENDPROC
  80.  
  81. -> Add a Dos List entry
  82. PROC addEntry(bname, type)
  83.   addNode(nameList, bname+1, type, 0, bname[])
  84. ENDPROC
  85.  
  86. -> Add the items from one call to ExAll
  87. PROC addItems(buffer)
  88.   DEF eabuf:PTR TO exalldata, items=0
  89.   eabuf:=buffer
  90.   WHILE eabuf
  91.     addNode(nameList, eabuf.name,
  92.             IF eabuf.type>0 THEN DIR_NODE ELSE FILE_NODE, 0)
  93.     INC items
  94.     eabuf:=eabuf.next
  95.   ENDWHILE
  96. ENDPROC items
  97.  
  98. -> Free a normal list of nodes and empty it
  99. PROC freeNodes(list:PTR TO lh)
  100.   DEF worknode:PTR TO ln, nextnode
  101.   worknode:=list.head  -> First node
  102.   WHILE nextnode:=worknode.succ
  103.     IF worknode.name THEN DisposeLink(worknode.name)
  104.     END worknode
  105.     worknode:=nextnode
  106.   ENDWHILE
  107.   newList(list)
  108. ENDPROC
  109.  
  110. -> Add a new node to the list
  111. PROC addNode(list, name, type, pri, len=0) HANDLE
  112.   DEF node=NIL:PTR TO ln, s=NIL
  113.   NEW node
  114.   IF name
  115.     SELECT MAX_TYPE OF type
  116.     CASE FILE_NODE
  117.       s:=StrCopy(String(StrLen(name)), name)
  118.     CASE DIR_NODE
  119.       s:=String(StrLen(name)+DIRSTRLEN)
  120.       StrCopy(s, DIRSTR)
  121.       StrAdd(s, name)
  122.     CASE VOL_NODE
  123.       s:=String(len+DIRSTRLEN+1)
  124.       StrCopy(s, VOLSTR)
  125.       StrAdd(s, name, len)
  126.       StrAdd(s, ':')
  127.     CASE ASN_NODE
  128.       s:=String(len+DIRSTRLEN+1)
  129.       StrCopy(s, ASNSTR)
  130.       StrAdd(s, name, len)
  131.       StrAdd(s, ':')
  132.     ENDSELECT
  133.   ENDIF
  134.   node.name:=s
  135.   node.type:=type
  136.   node.pri:=pri
  137.   AddTail(list, node)
  138. EXCEPT
  139.   IF node THEN END node
  140.   IF s THEN DisposeLink(s)
  141.   Throw(ERR_NODE, type)
  142. ENDPROC
  143.  
  144. -> Change the list to be a listing of volumes and assigns
  145. PROC volsList()
  146.   freeNodes(posList)
  147.   SetStr(currPath, 0)
  148.   changeList()
  149. ENDPROC
  150.  
  151. -> Add dir to path and change list
  152. PROC addDir(dir) HANDLE
  153.   addNode(posList, NIL, POS_NODE, EstrLen(currPath))
  154.   IF currPath[] AND (currPath[EstrLen(currPath)-1]<>":")
  155.     StrAdd(currPath, '/')
  156.   ENDIF
  157.   StrAdd(currPath, dir)
  158.   changeList()
  159. EXCEPT
  160.   -> Fix plist if exception not from first line (addNode to plist)
  161.   IF (exception<>ERR_NODE) OR (exceptioninfo<>POS_NODE) THEN parentPos()
  162.   ReThrow()
  163. ENDPROC
  164.  
  165. -> Set path to be its parent
  166. PROC parentPos()
  167.   DEF node:PTR TO ln
  168.   IF node:=RemTail(posList)
  169.     SetStr(currPath, node.pri)
  170.     END node
  171.     RETURN TRUE
  172.   ELSE
  173.     RETURN FALSE
  174.   ENDIF
  175. ENDPROC
  176.  
  177. -> Change the displayed list
  178. PROC changeList() HANDLE
  179.   DEF realgad
  180.   -> Deselect
  181.   oldSel:=-1
  182.   -> Remove list (without display glitch)
  183.   setlistvlabels(gh, listGad, -1)
  184.   -> Change list contents
  185.   getDir()
  186. EXCEPT DO
  187.   setstr(gh, pathGad, currPath)
  188.   -> Reattach list
  189.   setlistvlabels(gh, listGad, nameList)
  190.   IF realgad:=findgadget(gh, listGad)
  191.     Gt_SetGadgetAttrsA(realgad, gh.wnd, NIL, [GTLV_TOP, 0, NIL])
  192.   ENDIF
  193.   ReThrow()
  194. ENDPROC
  195.  
  196. -> Split path into directory positions
  197. PROC splitDir() HANDLE
  198.   DEF i
  199.   freeNodes(posList)
  200.   addNode(posList, NIL, POS_NODE, 0)
  201.   IF -1<>(i:=InStr(currPath, ':'))
  202.     IF currPath[i+1]
  203.       addNode(posList, NIL, POS_NODE, i+1)
  204.       WHILE -1<>(i:=InStr(currPath, '/', i+1))
  205.         addNode(posList, NIL, POS_NODE, i)
  206.       ENDWHILE
  207.     ENDIF
  208.   ENDIF
  209. EXCEPT
  210.   SetStr(currPath, 0)
  211. ENDPROC
  212.  
  213. -> Parse the directory from a lock, set up plist
  214. PROC setDir(lock)
  215.   IF NameFromLock(lock, pathStr, FILENAME_SIZE)
  216.     SetStr(pathStr, StrLen(pathStr))
  217.     StrCopy(currPath, pathStr)
  218.     splitDir()
  219.   ENDIF
  220. ENDPROC
  221.  
  222. -> Check this string is a real directory and set it
  223. PROC checkDir(dir) HANDLE
  224.   DEF lock=NIL, fib=NIL:PTR TO fileinfoblock
  225.   lock:=Lock(dir, ACCESS_READ)
  226.   fib:=AllocDosObject(DOS_FIB, NIL)
  227.   IF Examine(lock, fib)
  228.     IF fib.direntrytype>0
  229.       setDir(lock)
  230.       changeList()
  231.       Raise(ERR_NONE)  -> Finished, clean up
  232.     ENDIF
  233.   ENDIF
  234.   DisplayBeep(NIL)  -> Something minor went wrong...
  235. EXCEPT DO
  236.   IF fib THEN FreeDosObject(DOS_FIB, fib)
  237.   IF lock THEN UnLock(lock)
  238.   IF exception=ERR_LOCK
  239.     DisplayBeep(NIL)
  240.   ELSE
  241.     ReThrow()
  242.   ENDIF
  243. ENDPROC
  244.  
  245. PROC setPattern(s)
  246.   ParsePatternNoCase(s, patternBuff, PATTERNBUFF_SIZE)
  247.   changeList()
  248. ENDPROC
  249.  
  250.  
  251. -> GUI actions:
  252.  
  253. PROC a_pattern(info, str) IS setPattern(IF str[] THEN str ELSE '#?')
  254.  
  255. PROC a_path(info, str) IS checkDir(str)
  256.  
  257. PROC a_file(info, str) IS Raise(ERR_OK)
  258.  
  259. PROC a_list(info, sel)
  260.   DEF node:PTR TO ln, s, m, i=0
  261.   CurrentTime({s}, {m})
  262.   node:=nameList.head  -> First node
  263.   WHILE node.succ AND (i<sel)
  264.     node:=node.succ
  265.     INC i
  266.   ENDWHILE
  267.   IF node.type<>FILE_NODE
  268.     addDir(node.name+DIRSTRLEN)
  269.     sel:=-1
  270.   ELSE
  271.     IF node.type=FILE_NODE THEN setstr(gh, fileGad, node.name)
  272.     IF (sel=oldSel) AND DoubleClick(secs, micros, s, m)
  273.       Raise(ERR_OK)  -> Double click on file
  274.     ENDIF
  275.   ENDIF
  276.   secs:=s; micros:=m; oldSel:=sel
  277. ENDPROC
  278.  
  279. PROC b_ok(info) IS Raise(ERR_OK)
  280.  
  281. PROC b_cancel(info) IS Raise(ERR_CANCEL)
  282.  
  283. PROC b_vols(info) IS volsList()
  284.  
  285. PROC b_parent(info)
  286.   IF parentPos()
  287.     changeList()
  288.   ELSE
  289.     DisplayBeep(NIL)
  290.   ENDIF
  291. ENDPROC
  292.  
  293. -> GUI definition
  294. PROC fileRequester()
  295.   myeasygui('Select a file:',
  296.     [EQROWS,
  297.       listGad:=[LISTV,{a_list},NIL,13,10,nameList,0,NIL,0],
  298.       patternGad:=[STR,{a_pattern},'Pattern',patternStr,FILENAME_SIZE,5],
  299.       pathGad:=[STR,{a_path},'Drawer',pathStr,FILENAME_SIZE,5],
  300.       fileGad:=[STR,{a_file},'File',fileStr,200,5],
  301.       [COLS,
  302.         [BUTTON,{b_ok},'Ok'],
  303.         [SPACEH],
  304.         [BUTTON,{b_vols},'Disks'],
  305.         [SPACEH],
  306.         [BUTTON,{b_parent},'Parent'],
  307.         [SPACEH],
  308.         [BUTTON,{b_cancel},'Cancel']
  309.       ]
  310.     ]
  311.   )
  312. ENDPROC
  313.  
  314. -> Use global gh instead of a local one
  315. PROC myeasygui(windowtitle,gui,info=NIL,screen=NIL,textattr=NIL) HANDLE
  316.   DEF res=-1
  317.   gh:=guiinit(windowtitle,gui,info,screen,textattr)
  318.   WHILE res<0
  319.     Wait(gh.sig)
  320.     res:=guimessage(gh)
  321.   ENDWHILE
  322. EXCEPT DO
  323.   cleangui(gh)
  324.   ReThrow()
  325. ENDPROC res
  326.  
  327. PROC main() HANDLE
  328.   DEF here=NIL
  329.   utilitybase:=OpenLibrary('utility.library', 37)
  330.   gadtoolsbase:=OpenLibrary('gadtools.library', 37)
  331.   NEW nameList, posList
  332.   newList(nameList)
  333.   newList(posList)
  334.   StrCopy(patternStr, '~(#?.info)')
  335.   ParsePatternNoCase(patternStr, patternBuff, PATTERNBUFF_SIZE)
  336.   here:=CurrentDir(NIL)
  337.   setDir(here)
  338.   CurrentDir(here)
  339.   getDir()
  340.   fileRequester()
  341. EXCEPT DO
  342.   END nameList, posList
  343.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  344.   IF utilitybase THEN CloseLibrary(utilitybase)
  345.   SELECT exception
  346.   CASE ERR_OK
  347.     WriteF('User selected "\s\s\s"\n', currPath,
  348.        IF currPath[] AND (currPath[EstrLen(currPath)-1]<>":") THEN '/' ELSE '',
  349.        fileStr)
  350.   CASE ERR_CANCEL
  351.     WriteF('User cancelled requester\n')
  352.   DEFAULT
  353.     report_exception()
  354.   ENDSELECT
  355. ENDPROC
  356.  
  357.