version 1.36, 1995/04/30 23:18:23
|
version 1.37, 1995/06/03 14:24:44
|
Line 1215 create nl$ 1 c, A c, 0 c, \ gnu includes
|
Line 1215 create nl$ 1 c, A c, 0 c, \ gnu includes
|
|
|
create pathfilenamebuf 256 chars allot \ !! make this grow on demand |
create pathfilenamebuf 256 chars allot \ !! make this grow on demand |
|
|
: check-file-prefix ( addr len -- addr' len' flag ) |
\ : check-file-prefix ( addr len -- addr' len' flag ) |
dup 0= IF true EXIT THEN |
\ dup 0= IF true EXIT THEN |
over c@ '/ = IF true EXIT THEN |
\ over c@ '/ = IF true EXIT THEN |
over 2 S" ./" compare 0= IF true EXIT THEN |
\ over 2 S" ./" compare 0= IF true EXIT THEN |
over 3 S" ../" compare 0= IF true EXIT THEN |
\ over 3 S" ../" compare 0= IF true EXIT THEN |
over 2 S" ~/" compare 0= |
\ over 2 S" ~/" compare 0= |
IF 1 /string |
\ IF 1 /string |
S" HOME" getenv tuck pathfilenamebuf swap move |
\ S" HOME" getenv tuck pathfilenamebuf swap move |
2dup + >r pathfilenamebuf + swap move |
\ 2dup + >r pathfilenamebuf + swap move |
pathfilenamebuf r> true |
\ pathfilenamebuf r> true |
ELSE false |
\ ELSE false |
THEN ; |
\ THEN ; |
|
|
: open-path-file ( c-addr1 u1 -- file-id c-addr2 u2 ) |
: open-path-file ( c-addr1 u1 -- file-id c-addr2 u2 ) |
\ opens a file for reading, searching in the path for it; c-addr2 |
\ opens a file for reading, searching in the path for it (unless |
\ u2 is the full filename (valid until the next call); if the file |
\ the filename contains a slash); c-addr2 u2 is the full filename |
\ is not found (or in case of other errors for each try), -38 |
\ (valid until the next call); if the file is not found (or in |
\ (non-existant file) is thrown. Opening for other access modes |
\ case of other errors for each try), -38 (non-existant file) is |
\ makes little sense, as the path will usually contain dirs that |
\ thrown. Opening for other access modes makes little sense, as |
\ are only readable for the user |
\ the path will usually contain dirs that are only readable for |
\ !! check for "/", "./", "../" in original filename; check for "~/"? |
\ the user |
check-file-prefix 0= |
\ !! use file-status to determine access mode? |
IF pathdirs 2@ 0 |
2dup [char] / scan nip ( 0<> ) |
|
if \ the filename contains a slash |
|
2dup r/o open-file throw ( c-addr1 u1 file-id ) |
|
-rot >r pathfilenamebuf r@ cmove ( file-id R: u1 ) |
|
pathfilenamebuf r> EXIT |
|
then |
|
pathdirs 2@ 0 |
|
\ check-file-prefix 0= |
|
\ IF pathdirs 2@ 0 |
?DO ( c-addr1 u1 dirnamep ) |
?DO ( c-addr1 u1 dirnamep ) |
dup >r 2@ dup >r pathfilenamebuf swap cmove ( addr u ) |
dup >r 2@ dup >r pathfilenamebuf swap cmove ( addr u ) |
2dup pathfilenamebuf r@ chars + swap cmove ( addr u ) |
2dup pathfilenamebuf r@ chars + swap cmove ( addr u ) |
pathfilenamebuf over r> + dup >r r/o open-file 0= |
pathfilenamebuf over r> + dup >r r/o open-file 0= |
IF ( addr u file-id ) |
IF ( addr u file-id ) |
nip nip r> rdrop 0 leave |
nip nip r> rdrop 0 LEAVE |
THEN |
THEN |
rdrop drop r> cell+ cell+ |
rdrop drop r> cell+ cell+ |
LOOP |
LOOP |
ELSE 2dup open-file throw -rot THEN |
\ ELSE 2dup open-file throw -rot THEN |
0<> -&38 and throw ( file-id u2 ) |
0<> -&38 and throw ( file-id u2 ) |
pathfilenamebuf swap ; |
pathfilenamebuf swap ; |
|
|