Menu
▾
▴
[Win32forth-cvs] win32forth/src paths.f,1.27,1.28
|
From: Dirk B. <db...@us...> - 2006-12-02 10:14:56
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15124/src Modified Files: paths.f Log Message: - Backport of my search-path implementation from the STC-Version. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** paths.f 23 Nov 2006 10:53:16 -0000 1.27 --- paths.f 2 Dec 2006 10:14:51 -0000 1.28 *************** *** 49,52 **** --- 49,54 ---- IF $current-dir! THEN drop ; + IN-SYSTEM + : .dir ( -- ) \ *G Print the current directory. *************** *** 60,100 **** IN-APPLICATION ! : path: ( -- ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by null. \n ! \ ** At runtime it returns address of the counted string of a path create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path ) [ 2 cells ] literal + ; - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ Multiple directory path search capability for file open - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - INTERNAL ! create path-file$ MAX-PATH 1+ allot ! ! : path-source ( path -- 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this address. 2 cells- ; EXTERNAL ! path: path-ptr deprecated ! \ *G The old functionality had the bad habbit to pass a pointer through a ! \ ** value instead of passing the parameter over the stack. \n ! \ ** Use win32forth\src\Compat\OldPaths.f for the old functionality. \n ! \ ** Words like first-path" and next-path" are now able to handle ! \ ** each path separately without saving and restoring a path-ptr. ! ! path: search-path ! \ *G search-path defines the path buffer for Forth.\n Applications that let Forth ! \ ** compile should not change it in a way that Forth is not able to compile. ! ! : next-path" ( path -- a1 n1 ) \ *G Get the next path from dir list. dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! --- 62,91 ---- IN-APPLICATION ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Multiple directory path search capability for file open ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! IN-APPLICATION ! ! : path: ( - ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by 0. \n ! \ ** In runtime it returns adres of the counted string of a path create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path ) [ 2 cells ] literal + ; INTERNAL ! : path-source ( path - 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this adress. 2 cells- ; EXTERNAL ! : next-path" ( path -- a1 n1 ) \ w32f path \ *G Get the next path from dir list. dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! *************** *** 106,118 **** ; ! : reset-path-source ( path -- ) \ *G Points the path-source to the whole path. dup>r count r> path-source 2! ; ! : first-path" ( path -- a1 n1 ) \ *G Get the first forth directory path. dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path -- ) \ *G Append a directory to a path. >r 2dup upper --- 97,109 ---- ; ! : reset-path-source ( path -- ) \ w32f path \ *G Points the path-source to the whole path. dup>r count r> path-source 2! ; ! : first-path" ( path -- a1 n1 ) \ w32f path \ *G Get the first forth directory path. dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path -- ) \ w32f path \ *G Append a directory to a path. >r 2dup upper *************** *** 129,216 **** then r>drop ; ! : "fpath+ ( a1 n1 -- ) ! \ *G Append a directory to the Forth path. ! search-path "path+ ; - : fpath+ ( -<directory>- ) - \ *G Append a directory to the Forth path. - /parse-s$ count "fpath+ ; ! : .path ( path -- ) ! \ *G Display a directory search path list. ! count ! begin ?dup ! while 2dup ';' scan 2dup 2>r nip - dup char+ ?cr type ! 2r> 1 /string dup ! if ." ;" ! then ! repeat drop ; ! : .fpath ( -- ) ! \ *G Display the Forth directory search path list. ! search-path .path ; ! INTERNAL ! : volume-indication? ( addr -- flag ) ! \ *G True when the counted string at addr starts with x: or \\name ! dup 2 + c@ ascii : <> ! if count drop 2 s" \\" compare 0= ! else drop true ! then ! ; 6 PROC SearchPath ! : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } ! \ *G Find file a1,n1 in a path and return the full path. \n ! \ ** a2,n2 and f1=false, succeeded. ! a1 n1 MAX-PATH 1+ localalloc ascii-z to filename$ ! MAX-PATH 1+ localalloc: searchpath$ MAX_PATH 1+ LocalAlloc: current$ ! current-dir$ count current$ place current$ +null \ save current dir path first-path" ! begin dup>r searchpath$ place searchpath$ +null ! searchpath$ volume-indication? \ Test for another volume ! if searchpath$ char+ $current-dir! \ 0 fails, then try next ! else true ! then ! if 0 \ file component ! path-file$ \ found file name buffer ! max-path \ size of buffer ! defextz$ \ file extension ! filename$ \ file name ! searchpath$ char+ \ search path ! call SearchPath ! 0<> if path-file$ zcount false \ path found ! current$ char+ $current-dir! ! not abort" $current-dir!" \ restore current dir ! r>drop exit \ clear the retun stack and exit ! then ! then ! r> ! while searchpath$ off path next-path" ! repeat a1 n1 path-file$ place path-file$ count true \ return input file and error flag ! current$ char+ $current-dir! not abort" $current-dir!" \ restore current dir ! ; ! EXTERNAL : program-path-init ( -- ) \ *G Initialize the Forth directory search path list. Automatically done at program \ ** initialization and when Paths.f is loaded. ! search-path off \ clear path list ! s" %CURRENTDIR%" "fpath+ ! s" %FORTHDIR%" "fpath+ ! s" %APPDIR%" "fpath+ s" src" "fpath+ s" src\lib" "fpath+ - \ s" src\tools" "fpath+ \ this is causing problems when compiling the IDE... s" src\gdi" "fpath+ \ GDI class library s" src\res" "fpath+ s" src\console" "fpath+ s" doc" "fpath+ \ last ; --- 120,299 ---- then r>drop ; ! in-system + : .path ( path -- ) \ w32f path system + \ *G Display a directory search path list. + \ ** Note: The path source will be resetted for this path. + dup >r first-path" + begin dup + if 2dup cr type + then nip + while r@ next-path" + repeat r> reset-path-source ; + in-application ! INTERNAL ! : volume-indication? ( addr - flag ) ! \ True when the counted string at adr starts with x: or \\name ! dup 2 + c@ [char] : <> ! if count drop 2 s" \\" compare 0= ! else drop true ! then ; + : save-current ( current$ -- ) + \ save current dir + dup current-dir$ count rot place +null ; ! : restore-current ( current$ -- ) ! \ Restore current dir ! char+ $current-dir! not abort" $current-dir!" ; ! create path-file$ MAX-PATH 1+ allot ! ! : search-error ( addr -- ) ! \ return input file and error flag ! count path-file$ place path-file$ count ! true ; 6 PROC SearchPath ! ! EXTERNAL ! ! : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } ! \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. ! a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name ! MAX_PATH 1+ LocalAlloc: current$ ! current$ save-current \ save current dir ! ! MAX-PATH 1+ LocalAlloc: searchpath$ ! path first-path" ! begin dup ! if searchpath$ place searchpath$ +null ! searchpath$ volume-indication? \ Test for another volume ! if searchpath$ char+ $current-dir! \ 0 fails, then try next ! else true ! then ! ! if path-file$ off ! 0 \ file component ! path-file$ \ found file name buffer ! max-path \ size of buffer ! defextz$ \ file extension ! filename$ \ file name ! searchpath$ char+ \ search path ! call SearchPath 0<> ! if path-file$ zcount false \ path found ! current$ restore-current \ restore current dir ! exit \ and exit ! else true \ try next path... ! then ! then ! else nip ! then ! while path next-path" ! repeat ! ! current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag ! ! : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } ! \ *G Find the file \i a1,n1 \d in the path \i basepath \d by scanning the sub folders ! \ ** defined in \i path \d. Returns the full path of the file if possible. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. ! ! \ Note: We have to save the file name in a temporay buffer, ! \ because a1 n2 can point to the internal buffer new$ and ! \ this buffer can be changed during the search (by current-dir$ ! \ for example). ! MAX-PATH 1+ LocalAlloc: filename$ ! a1 n1 filename$ place \ save file name ! ! MAX_PATH 1+ LocalAlloc: current$ ! current$ save-current \ save current dir ! ! MAX_PATH 1+ LocalAlloc: search-current$ ! ! basepath first-path" ! begin dup ! if \ set the next base folder we shall look in ! search-current$ place search-current$ +null ! search-current$ char+ $current-dir! ! ! \ and try to find the file in this folder ! if filename$ count path full-path 0= ! if current$ restore-current ! 0 exit \ we found the file !!! ! else 2drop true \ try the next folder... ! then ! then ! else nip ! then ! while basepath next-path" ! repeat ! ! current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ "open with Multiple directory path search ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! path: search-base-path \ w32f path ! \ *G The path buffer for the base search folders for Forth.\n ! \ ** Applications that let Forth compile should not change it. ! ! path: search-path \ w32f path ! \ *G The path buffer for the sub folders to search in. ! \ ** Applications that let Forth compile should not change it. ! ! : "fbase-path+ ( a1 n1 -- ) \ w32f path ! \ *G Append a directory to the Forth search base path. ! search-base-path "path+ ; ! ! : "fpath+ ( a1 n1 -- ) \ w32f path ! \ *G Append a directory to the Forth search path. ! search-path "path+ ; ! ! in-system ! ! : fbase-path+ ( -<directory>- -- ) \ w32f path system ! \ *G Append a directory to the Forth search base path. ! /parse-s$ count "fbase-path+ ; ! ! : fpath+ ( -<directory>- -- ) \ w32f path system ! \ *G Append a directory to the Forth search path. ! /parse-s$ count "fpath+ ; ! ! : .fpath ( -- ) \ w32f path system ! \ *G Display the Forth directory search path list. ! cr ." Base path: " search-base-path .path ! cr ." Search path: " search-path .path ; ! ! in-application : program-path-init ( -- ) \ *G Initialize the Forth directory search path list. Automatically done at program \ ** initialization and when Paths.f is loaded. ! search-base-path off \ clear path list ! s" %CURRENTDIR%" "fbase-path+ ! s" %FORTHDIR%" "fbase-path+ ! s" %APPDIR%" "fbase-path+ + search-path off \ clear path list + s" ." "fpath+ \ current dir is first s" src" "fpath+ s" src\lib" "fpath+ s" src\gdi" "fpath+ \ GDI class library + s" src\tools" "fpath+ s" src\res" "fpath+ s" src\console" "fpath+ + s" demos" "fpath+ s" doc" "fpath+ \ last ; *************** *** 219,235 **** INITIALIZATION-CHAIN CHAIN-ADD PROGRAM-PATH-INIT ! : "path-file { a1 n1 \ current$ -- a2 n2 f1 } ! \ *G Find file a1,n1 in the Forth path and return the full path. \n \ ** a2,n2 and f1=false, succeeded. ! \ first try it in the current directory ! a1 n1 search-path full-path ! -if 3drop \ then try it in the forth directory ! a1 n1 search-path full-path ! then ; ! ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ "open with Multiple directory path search ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ create open-path$ MAXSTRING allot --- 302,309 ---- INITIALIZATION-CHAIN CHAIN-ADD PROGRAM-PATH-INIT ! : "path-file ( a1 n1 -- a2 n2 f1 ) ! \ *G Find file a1,n1 in the Forth search path and return the full path. \n \ ** a2,n2 and f1=false, succeeded. ! search-base-path search-path find-path ; create open-path$ MAXSTRING allot |
