Diff for /gforth/kernel/paths.fs between versions 1.4 and 1.5

version 1.4, 1998/05/31 19:29:33 version 1.5, 1998/06/17 16:55:17
Line 18 Line 18
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   
 0 [IF]  \ -Changing the search-path:
   \ fpath+ <path>                 adds a directory to the searchpath
 -Changing the search-path:  \ fpath= <path>|<path>  makes complete now searchpath
 fpath+ <path>           adds a directory to the searchpath  \                       seperator is |
 fpath= <path>|<path>    makes complete now searchpath  \ .fpath                        displays the search path
                         seperator is |  \ remark I: 
 .fpath                  displays the search path  \ a ./ in the beginning of filename is expanded to the directory the
 remark I:   \ current file comes from. ./ can also be included in the search-path!
 a ./ in the beginning of filename is expanded to the directory the  \ ~+/ loads from the current working directory
 current file comes from. ./ can also be included in the search-path!  
 ~+/ loads from the current directory  \ remark II:
   \ if there is no sufficient space for the search path increase it!
 remark II:  
 if there is no sufficient space for the search path increase it!  
   \ -Creating custom paths:
   
 -Creating custom paths:  \ It is possible to use the search mechanism on yourself.
   
 It is possible to use the search mechanism on yourself.  \ Make a buffer for the path:
   \ create mypath 100 chars ,     \ maximum length (is checked)
 Make a buffer for the path:  \               0 ,             \ real len
 create mypath   100 chars ,     \ maximum length (is checked)  \               100 chars allot \ space for path
                 0 ,             \ real len  \ use the same functions as above with:
                 100 chars allot \ space for path  \ mypath path+ 
 use the same functions as above with:  \ mypath path=
 mypath path+   \ mypath .path
 mypath path=  
 mypath .path  \ do a open with the search path:
   \ open-path-file ( adr len path -- fd adr len ior )
 do a open with the search path:  \ the file is opened read-only; if the file is not found an error is generated
 open-path-file ( adr len path -- fd adr len ior )  
 the file is opened read-only; if the file is not found an error is generated  
   
 \ questions to: wilke@jwdt.com  \ questions to: wilke@jwdt.com
 [THEN]  
   
 [IFUNDEF] +place  [IFUNDEF] +place
 : +place ( adr len adr )  : +place ( adr len adr )
Line 116  sourcepath avalue fpath Line 113  sourcepath avalue fpath
   path>counted    path>counted
   BEGIN next-path dup WHILE type space REPEAT 2drop 2drop ;    BEGIN next-path dup WHILE type space REPEAT 2drop 2drop ;
   
 : .fpath ( ) \ gforth  : .fpath ( -- ) \ gforth
 \G displays the contents of the forth search patch  \G displays the contents of the forth search patch
   fpath .path ;    fpath .path ;
   
 : absolut-path? ( addr u -- flag ) \ gforth  : absolut-path? ( addr u -- flag ) \ gforth
     \G a path is absolute, if it starts with a / or a ~ (~ expansion),      \G a path is absolute, if it starts with a / or a ~ (~ expansion),
     \G or if it is in the form ./* or ../*, extended regexp: ^[/~]|./|../      \G or if it is in the form ./*, extended regexp: ^[/~]|./, or if
     \G Pathes simply containing a / are not absolute!      \G it has a colon as second character ("C:...").  Paths simply
       \G containing a / are not absolute!
     2dup 2 u> swap 1+ c@ ': = and >r \ dos absoulte: c:/....      2dup 2 u> swap 1+ c@ ': = and >r \ dos absoulte: c:/....
     over c@ '/ = >r      over c@ '/ = >r
     over c@ '~ = >r      over c@ '~ = >r
     2dup 2 min S" ./" compare 0= >r      \ 2dup 3 min S" ../" compare 0= r> or >r \ not catered for in expandtopic
          3 min S" ../" compare 0=      2 min S" ./" compare 0=
     r> r> r> r> or or or or ;      r> r> r> or or or ;
   
 Create ofile 0 c, 255 chars allot  Create ofile 0 c, 255 chars allot
 Create tfile 0 c, 255 chars allot  Create tfile 0 c, 255 chars allot
Line 149  Create tfile 0 c, 255 chars allot Line 147  Create tfile 0 c, 255 chars allot
         ofile count 3 /string ofile place          ofile count 3 /string ofile place
     THEN ;      THEN ;
   
 : expandtopic  : expandtopic ( -- ) \ stack effect correct? - anton
   ofile count 2 min s" ./" compare 0=      \ expands "./" into an absolute name
   IF    ofile count 1 /string tfile place      ofile count 2 min s" ./" compare 0=
       IF
           ofile count 1 /string tfile place
         0 ofile c! sourcefilename extractpath ofile place need/          0 ofile c! sourcefilename extractpath ofile place need/
         tfile count over c@ pathsep? IF 1 /string THEN          tfile count over c@ pathsep? IF 1 /string THEN
         ofile +place          ofile +place
   THEN ;      THEN ;
                   
 : compact// ( adr len -- adr2 len2 )  : compact// ( adr len -- adr2 len2 )
 \ deletes phrases like "//" out of our directory name 2dec97jaw  \ deletes phrases like "//" out of our directory name 2dec97jaw
Line 193  Create tfile 0 c, 255 chars allot Line 193  Create tfile 0 c, 255 chars allot
   r> drop     r> drop 
   drop r> tuck - ;    drop r> tuck - ;
   
 : reworkdir  : reworkdir ( -- )
   remove~+    remove~+
   ofile count compact// compact..    ofile count compact// compact..
   nip ofile c! ;    nip ofile c! ;
   
   : open-ofile ( -- fid ior )
       \ opens the file whose name is in ofile
       expandtopic reworkdir
       ofile count r/o open-file ;
   
 : check-path ( adr1 len1 adr2 len2 -- fd 0 | 0 <>0 )  : check-path ( adr1 len1 adr2 len2 -- fd 0 | 0 <>0 )
   0 ofile ! >r >r ofile place need/    0 ofile ! >r >r ofile place need/
   r> r> ofile +place    r> r> ofile +place
   reworkdir    open-ofile ;
   ofile count r/o open-file ;  
   
 : open-path-file ( adr len path-addr -- fd adr1 len2 0 | ior ) \ gforth  : open-path-file ( adr len path-addr -- fd adr1 len2 0 | ior ) \ gforth
 \G looks in path path-addr for the file specified by adr len  \G looks in path path-addr for the file specified by adr len
Line 211  Create tfile 0 c, 255 chars allot Line 215  Create tfile 0 c, 255 chars allot
   >r    >r
   2dup absolut-path?    2dup absolut-path?
   IF    rdrop    IF    rdrop
         ofile place expandtopic reworkdir ofile count r/o open-file          ofile place open-ofile
         dup 0= IF >r ofile count r> THEN EXIT          dup 0= IF >r ofile count r> THEN EXIT
   ELSE  r> path>counted    ELSE  r> path>counted
         BEGIN  next-path dup          BEGIN  next-path dup

Removed from v.1.4  
changed lines
  Added in v.1.5


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>