Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8536/src
Modified Files:
paths.f
Log Message:
Jos: Added FindRelativeName.
Index: paths.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** paths.f 24 Dec 2005 11:52:08 -0000 1.7
--- paths.f 2 Jul 2006 13:18:43 -0000 1.8
***************
*** 67,73 ****
nip - ;
: first-path" ( -- a1 n1 ) \ get the first forth directory path
! path-ptr count path-source 2!
! next-path" ;
: "fpath+ ( a1 n1 -- ) \ append a directory to forth path
--- 67,74 ----
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
***************
*** 159,163 ****
then ;
-
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ "open with Multiple directory path search
--- 160,163 ----
***************
*** 207,210 ****
--- 207,227 ----
<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
+ ;
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
|
