Menu
▾
▴
[Win32forth-cvs] win32forth/src paths.f,1.12,1.13
|
From: Jos v.d.V. <jo...@us...> - 2006-07-16 13:42:03
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19756/src Modified Files: paths.f Log Message: Jos: DEXed paths.f Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** paths.f 10 Jul 2006 21:31:36 -0000 1.12 --- paths.f 16 Jul 2006 13:41:59 -0000 1.13 *************** *** 1,3 **** ! \ $Id$ cr .( Loading Path Functions...) --- 1,8 ---- ! \ $Id$ Ed_FileStack.f ! ! \ *D doc\ ! \ *! Paths ! \ *T Paths -- Multiple search path support ! \ *S Glossary cr .( Loading Path Functions...) *************** *** 5,13 **** in-application ! create &forthdir MAXCOUNTED 1+ allot \ static forth installation directory ! &forthdir off : init-Win32fDirectory { \ kernel$ -- } ! \ set &forthdir to the folder of the current forth application &prognam count "path-only" &forthdir place &forthdir c@ 0= --- 10,19 ---- in-application ! create &forthdir ! \ *G A static forth installation directory. ! MAXCOUNTED 1+ allot &forthdir off : init-Win32fDirectory { \ kernel$ -- } ! \ *G Set &forthdir to the folder of the current forth application. \n &prognam count "path-only" &forthdir place &forthdir c@ 0= *************** *** 26,33 **** IN-SYSTEM ! : .program ( -- ) \ type program path &prognam count type ; ! : .forthdir ( -- ) \ type forth directory &forthdir count type ; --- 32,41 ---- IN-SYSTEM ! : .program ( -- ) ! \ *G Type the program path. &prognam count type ; ! : .forthdir ( -- ) ! \ *G Type the forth directory. &forthdir count type ; *************** *** 37,47 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "chdir ( a1 n1 -- ) \ set current directory IF $current-dir! THEN drop ; ! : .dir ( -- ) \ print current directory cr ." Current directory: " current-dir$ count type ; ! : chdir ( -<optional_new_directory>- ) \ set current directory /parse-word count "chdir cr .dir ; --- 45,58 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "chdir ( a1 n1 -- ) ! \ *G Set the current directory. IF $current-dir! THEN drop ; ! : .dir ( -- ) ! \ *G Print the current directory. cr ." Current directory: " current-dir$ count type ; ! : chdir ( -<optional_new_directory>- ) ! \ *G Set the current directory. /parse-word count "chdir cr .dir ; *************** *** 49,53 **** IN-APPLICATION ! : path: ( - ) \ map: 2variable_path-source counted_path create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path-ptr ) [ 2 cells ] literal + --- 60,69 ---- 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-ptr ) [ 2 cells ] literal + *************** *** 62,81 **** create path-file$ MAX-PATH 1+ allot ! : path-source ( path-ptr - 2variable_path-source ) 2 cells- ; EXTERNAL ! path: path-ptr \ initialize the path buffer pointer ! : next-path" ( path-ptr -- a1 n1 ) \ get the next path from dir list dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! nip - ; ! : reset-path-source ( path-ptr -- ) dup>r count r> path-source 2! ; ! : first-path" ( path-ptr -- a1 n1 ) \ get the first forth directory path dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path-ptr -- ) \ append a directory to a path >r 2dup upper 2dup + 1- c@ '\' = \ end in '\'? --- 78,107 ---- create path-file$ MAX-PATH 1+ allot ! : path-source ( path-ptr - 2variable_path-source ) ! \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this adres. ! 2 cells- ; EXTERNAL ! path: path-ptr ! \ *G Path-ptr defines the path buffer for Forth. Applications that let Forth ! \ ** compile should not change it in a way that Forth is not able too compile. ! : next-path" ( path-ptr -- a1 n1 ) ! \ *G Get the next path from dir list. dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! nip - ; ! : reset-path-source ( path-ptr -- ) ! \ *G Points the path-source to the whole path. ! dup>r count r> path-source 2! ; ! : first-path" ( path-ptr -- a1 n1 ) ! \ *G Get the first forth directory path. dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path-ptr -- ) ! \ *G Append a directory to a path. >r 2dup upper 2dup + 1- c@ '\' = \ end in '\'? *************** *** 91,103 **** then r>drop ; ! : "fpath+ ( a1 n1 path-ptr -- ) \ append a directory to forth path path-ptr "path+ ; ! : fpath+ ( -<directory>- ) \ append a directory to forth path /parse-s$ count "fpath+ ; ! : .path ( path-ptr -- ) \ display the a directory search path list count begin ?dup --- 117,132 ---- then r>drop ; ! : "fpath+ ( a1 n1 path-ptr -- ) ! \ *G Append a directory to a path. path-ptr "path+ ; ! : fpath+ ( -<directory>- ) ! \ *G Append a directory to the Forth path. /parse-s$ count "fpath+ ; ! : .path ( path-ptr -- ) ! \ *G Display a directory search path list. count begin ?dup *************** *** 108,112 **** repeat drop ; ! : .fpath ( -- ) \ display the forth directory search path list path-ptr .path ; --- 137,142 ---- repeat drop ; ! : .fpath ( -- ) ! \ *G Display the Forth directory search path list. path-ptr .path ; *************** *** 115,123 **** 6 PROC SearchPath ! : full-path { a1 n1 path-ptr \ searchpath$ filename$ -- a2 n2 f1 } \ find file a1,n1 return full path ! \ a2,n2 and f1=false, succeeded a1 n1 MAX-PATH 1+ localalloc ascii-z to filename$ MAX-PATH 1+ localalloc: searchpath$ - path-ptr first-path" begin dup>r searchpath$ place searchpath$ +null --- 145,153 ---- 6 PROC SearchPath ! : full-path { a1 n1 path-ptr \ searchpath$ filename$ -- 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$ path-ptr first-path" begin dup>r searchpath$ place searchpath$ +null *************** *** 134,138 **** exit then - r> while path-ptr next-path" --- 164,167 ---- *************** *** 142,146 **** EXTERNAL ! : program-path-init ( -- ) \ initialize the forth directory search path list path-ptr off \ clear path list s" ." "fpath+ \ current dir is first --- 171,176 ---- EXTERNAL ! : program-path-init ( -- ) ! \ *G Initialize the Forth directory search path list. path-ptr off \ clear path list s" ." "fpath+ \ current dir is first *************** *** 157,164 **** INITIALIZATION-CHAIN CHAIN-ADD PROGRAM-PATH-INIT ! : "path-file { a1 n1 \ current$ -- a2 n2 f1 } \ find file a1,n1 return full path ! \ a2,n2 and f1=false, succeeded ! ! \ first try it in the current directory a1 n1 path-ptr full-path -if 3drop --- 187,194 ---- 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 path-ptr full-path -if 3drop *************** *** 168,174 **** &forthdir dup +null char+ $current-dir! not abort" $current-dir!" \ set current dir to forth dir - a1 n1 path-ptr full-path - current$ char+ $current-dir! not abort" $current-dir!" \ restore current dir then ; --- 198,202 ---- *************** *** 181,185 **** create open-path$ MAXSTRING allot ! : n"open ( a1 n1 -- handle f1 ) \ open file a1,n1 with path search "path-file if 2drop 0 -1 --- 209,214 ---- create open-path$ MAXSTRING allot ! : n"open ( a1 n1 -- handle f1 ) ! \ *G Open file a1,n1 with a Forth path search. "path-file if 2drop 0 -1 *************** *** 201,205 **** EXTERNAL ! : MakeAbsolutePath ( a1 n1 a2 n2 -- a3 ) \ make path a1 n1 absolute to path a2 n2 ?DUP \ only if a2 n2 point's to a path IF 2OVER IsAbsolutePath? --- 230,235 ---- EXTERNAL ! : MakeAbsolutePath ( a1 n1 a2 n2 -- a3 ) ! \ *G Make path a1 n1 absolute to path a2 n2. ?DUP \ only if a2 n2 point's to a path IF 2OVER IsAbsolutePath? *************** *** 212,219 **** then <AbsRelPath$> dup +null ; ! : IsPathRelativeTo? { a1 n1 a2 n2 -- f } \ return true if path a1 n1 is relative to path a2 n2 a1 n1 n2 MIN a2 OVER ISTR= ; ! : MakePathRelativeTo ( a1 n1 a2 n2 -- a3 ) \ make path a1 n1 relative to path a2 n2 4DUP IsPathRelativeTo? IF NIP DUP>R - SWAP R> + SWAP ( a2 n3 ) --- 242,251 ---- then <AbsRelPath$> dup +null ; ! : IsPathRelativeTo? { a1 n1 a2 n2 -- f } ! \ *G Return true if path a1 n1 is relative to path a2 n2 a1 n1 n2 MIN a2 OVER ISTR= ; ! : MakePathRelativeTo ( a1 n1 a2 n2 -- a3 ) ! \ *G Make path a1 n1 relative to path a2 n2. 4DUP IsPathRelativeTo? IF NIP DUP>R - SWAP R> + SWAP ( a2 n3 ) *************** *** 222,226 **** <AbsRelPath$> ; ! : FindRelativePath ( a1 n1 path-ptr - a2 n2 ) \ n2=0 means not in search path dup>r reset-path-source begin r@ path-source 2@ nip 0> --- 254,260 ---- <AbsRelPath$> ; ! : FindRelativePath ( a1 n1 path-ptr - a2 n2 ) ! \ *G Returns a releative path for file a1 n1 in path-ptr ( first part ). \n ! \ ** n2=0 means not in search path. dup>r reset-path-source begin r@ path-source 2@ nip 0> *************** *** 234,237 **** --- 268,273 ---- : FindRelativeName ( a1 n1 path-ptr - a2 n2 f ) + \ *G Returns a releative name for file a1 n1 in path-ptr ( last-part ). \n + \ ** n2=0 means not in search path. >r 2dup r> FindRelativePath dup 0> if nip dup 3 > *************** *** 257,261 **** in-system ! : "LOADED? ( addr len -- flag ) \ is file loaded? CONTEXT @ >R \ save context files \ set context --- 293,298 ---- in-system ! : "LOADED? ( addr len -- flag ) ! \ *G True if a file addr len is loaded. The filename must cointain a full path. CONTEXT @ >R \ save context files \ set context *************** *** 265,274 **** ; ! : LOADED? ( -<name>- -- flag ) \ is file loaded? ! { \ current$ } MAX_PATH 1+ LocalAlloc: current$ current-dir$ count current$ place \ get current dir current$ ?+\ \ append '\' - new$ >r /parse-s$ count r@ place \ store file name r@ ?defext r> count \ add default ext if needed --- 302,310 ---- ; ! : LOADED? ( -<name>- -- flag ) { \ current$ } ! \ *G True if the following file is loaded. The filename may be relative. MAX_PATH 1+ LocalAlloc: current$ current-dir$ count current$ place \ get current dir current$ ?+\ \ append '\' new$ >r /parse-s$ count r@ place \ store file name r@ ?defext r> count \ add default ext if needed *************** *** 276,280 **** "loaded? ; ! : \LOADED- ( -<name>- ) \ if the following file IS NOT LOADED interpret line >in @ >r loaded? 0= --- 312,317 ---- "loaded? ; ! : \LOADED- ( -<name>- ) ! \ *G If the following file IS NOT LOADED interpret line. >in @ >r loaded? 0= *************** *** 283,287 **** then r>drop ; ! : \LOADED ( -<name>- ) \ if the following file IS LOADED interpret line >in @ >r loaded? --- 320,325 ---- then r>drop ; ! : \LOADED ( -<name>- ) ! \ *G If the following file IS LOADED interpret line. >in @ >r loaded? *************** *** 290,294 **** then r>drop ; ! : NEEDS ( -<name>- ) \ conditionally load file "name" if not loaded >in @ >r loaded? 0= \ if file isn't loaded --- 328,333 ---- then r>drop ; ! : NEEDS ( -<name>- ) ! \ *G Conditionally load file "name" if not loaded. >in @ >r loaded? 0= \ if file isn't loaded *************** *** 302,306 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "file-clip" { adr len limit \ temp$ pre -- 'adr 'len } \ clip filename to limit MAX-PATH LocalAlloc: temp$ limit 20 max to limit \ must be at east 16 --- 341,346 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "file-clip" { adr len limit \ temp$ pre -- 'adr 'len } ! \ *G Clip filename to limit. MAX-PATH LocalAlloc: temp$ limit 20 max to limit \ must be at east 16 *************** *** 315,317 **** then ; ! MODULE --- 355,357 ---- then ; ! MODULE |
