Menu
▾
▴
[Win32forth-cvs] win32forth/src paths.f,1.8,1.9
|
From: Jos v.d.V. <jo...@us...> - 2006-07-08 17:50:41
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8995/src Modified Files: paths.f Log Message: Jos: Made multiple search path's possible and changed subdirs. Now it will not destroy the search path when sdir is used. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** paths.f 2 Jul 2006 13:18:43 -0000 1.8 --- paths.f 8 Jul 2006 17:50:36 -0000 1.9 *************** *** 55,94 **** create path-file$ MAX-PATH 1+ allot ! create &fpath MAX-PATH 1+ allot \ a static forth path buffer ! &fpath off ! 2variable path-source EXTERNAL ! &fpath value path-ptr \ initialize the path buffer pointer ! : next-path" ( -- a1 n1 ) \ get the next path from dir list ! path-source 2@ 2dup ';' scan 2dup 1 /string path-source 2! nip - ; ! : reset-path-source ( -- ) path-ptr count path-source 2! ; ! : first-path" ( -- a1 n1 ) \ get the first forth directory path ! reset-path-source next-path" ; ! : "fpath+ ( a1 n1 -- ) \ append a directory to forth path ! 2dup upper 2dup + 1- c@ '\' = \ end in '\'? if 1- 0max \ if so, delete it ! then first-path" \ get first path begin dup 0> >r 2over compare 0<> dup r> and \ check it ! while drop next-path" \ and remaining paths repeat 0= \ -- f1=true if already in list if 2drop ! else dup path-ptr c@ if char+ then MAX-PATH >= abort" Path overflow" ! path-ptr c@ if path-ptr ?+; then ! path-ptr +place ! then ; : fpath+ ( -<directory>- ) \ append a directory to forth path ! /parse-s$ count "fpath+ ; ! : .fpath ( -- ) \ display the forth directory search path list ! path-ptr count begin ?dup while 2dup ';' scan 2dup 2>r nip - dup char+ ?cr type --- 55,103 ---- create path-file$ MAX-PATH 1+ allot ! ! : path: ( - ) \ map: 2variable_path-source counted_path ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path-ptr ) ! [ 2 cells ] literal + ! ; ! ! : 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 '\'? if 1- 0max \ if so, delete it ! then r@ first-path" \ get first path begin dup 0> >r 2over compare 0<> dup r> and \ check it ! while drop r@ next-path" \ and remaining paths repeat 0= \ -- f1=true if already in list if 2drop ! else dup r@ c@ if char+ then MAX-PATH >= abort" Path overflow" ! r@ c@ if r@ ?+; then ! r@ +place ! 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 while 2dup ';' scan 2dup 2>r nip - dup char+ ?cr type *************** *** 98,110 **** repeat drop ; INTERNAL 6 PROC SearchPath ! : ("path-file) { a1 n1 \ 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$ ! first-path" begin dup>r searchpath$ place searchpath$ +null --- 107,123 ---- repeat drop ; + : .fpath ( -- ) \ display the forth directory search path list + path-ptr .path ; + + INTERNAL 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 *************** *** 122,126 **** r> ! while next-path" repeat a1 n1 path-file$ place path-file$ count true \ return input file and error flag ; --- 135,139 ---- r> ! while path-ptr next-path" repeat a1 n1 path-file$ place path-file$ count true \ return input file and error flag ; *************** *** 147,151 **** \ first try it in the current directory ! a1 n1 ("path-file) -if 3drop \ then try it in the forth directory --- 160,164 ---- \ first try it in the current directory ! a1 n1 path-ptr full-path -if 3drop \ then try it in the forth directory *************** *** 155,163 **** char+ $current-dir! not abort" $current-dir!" \ set current dir to forth dir ! a1 n1 ("path-file) current$ char+ $current-dir! not abort" $current-dir!" \ restore current dir then ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ "open with Multiple directory path search --- 168,177 ---- 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 ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ "open with Multiple directory path search *************** *** 207,224 **** <AbsRelPath$> ; ! : FindRelativePath ( a1 n1 - a2 n2 ) \ n2=0 means not in search path ! reset-path-source ! begin path-source 2@ nip 0> ! if next-path" 4dup IsPathRelativeTo? not else over 0 false then while 2drop repeat ! 2nip ; ! : FindRelativeName ( a1 n1 - a2 n2 f ) ! 2dup FindRelativePath dup 0> ! if nip 1+ /string true else 2drop false then --- 221,241 ---- <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> ! if r@ next-path" 4dup IsPathRelativeTo? not else over 0 false then while 2drop repeat ! 2nip r>drop ; ! : FindRelativeName ( a1 n1 path-ptr - a2 n2 f ) ! >r 2dup r> FindRelativePath dup 0> ! if nip dup 3 > ! if 1+ ! then ! /string true else 2drop false then *************** *** 255,259 **** new$ >r /parse-s$ count r@ place \ store file name r@ ?defext r> count \ add default ext if needed ! "path-file drop \ extend to full path "loaded? ; --- 272,276 ---- new$ >r /parse-s$ count r@ place \ store file name r@ ?defext r> count \ add default ext if needed ! "path-file drop cr 2dup type \ extend to full path "loaded? ; |
