qbit/xenocara
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
948a98459f
xenocara/app/xedit/lisp/pathname.c
matthieu 616b6f15ab Importing from X.Org 7.2RC2
2006-11-25 20:07:29 +00:00

1097 lines
26 KiB
C
Raw Blame History

/*
* Copyright (c) 2001 by The XFree86 Project, Inc.
*
* Permission is hereby granted, free of charge, to any person obtaining a
* copy of this software and associated documentation files (the "Software"),
* to deal in the Software without restriction, including without limitation
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
* and/or sell copies of the Software, and to permit persons to whom the
* Software is furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
* THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
* OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
* SOFTWARE.
*
* Except as contained in this notice, the name of the XFree86 Project shall
* not be used in advertising or otherwise to promote the sale, use or other
* dealings in this Software without prior written authorization from the
* XFree86 Project.
*
* Author: Paulo César Pereira de Andrade
*/
/* $XFree86: xc/programs/xedit/lisp/pathname.c,v 1.17tsi Exp $ */
#include <stdio.h> /* including dirent.h first may cause problems */
#include <sys/types.h>
#include <dirent.h>
#include <errno.h>
#include <sys/stat.h>
#include "lisp/pathname.h"
#include "lisp/private.h"
#define NOREAD_SKIP 0
#define NOREAD_ERROR 1
/*
* Initialization
*/
LispObj *Oparse_namestring, *Kerror, *Kabsolute, *Krelative, *Kskip;
/*
* Implementation
*/
void
LispPathnameInit(void)
{
Kerror = KEYWORD("ERROR");
Oparse_namestring = STATIC_ATOM("PARSE-NAMESTRING");
Kabsolute = KEYWORD("ABSOLUTE");
Krelative = KEYWORD("RELATIVE");
}
static int
glob_match(char *cmp1, char *cmp2)
/*
* Note: this code was written from scratch, and may generate incorrect
* results for very complex glob masks.
*/
{
for (;;) {
while (*cmp1 && *cmp1 == *cmp2) {
++cmp1;
++cmp2;
}
if (*cmp2) {
if (*cmp1 == '*') {
while (*cmp1 == '*')
++cmp1;
if (*cmp1) {
int count = 0, settmp = 1;
char *tmp = cmp2, *sav2;
while (*cmp1 && *cmp1 == '?') {
++cmp1;
++count;
}
/* need to recurse here to make sure
* all cases are tested.
*/
while (*cmp2 && *cmp2 != *cmp1)
++cmp2;
if (!*cmp1 && cmp2 - tmp < count)
return (0);
sav2 = cmp2;
/* if recursive calls fails, make sure all '?'
* following '*' are processed */
while (*sav2 && sav2 - tmp < count)
++sav2;
for (; *cmp2;) {
if (settmp) /* repeated letters: *?o? => boot, root */
tmp = cmp2;
else
settmp = 1;
while (*cmp2 && *cmp2 != *cmp1)
++cmp2;
if (cmp2 - tmp < count) {
if (*cmp2)
++cmp2;
settmp = 0;
continue;
}
if (*cmp2) {
if (glob_match(cmp1, cmp2))
return (1);
++cmp2;
}
}
cmp2 = sav2;
}
else {
while (*cmp2)
++cmp2;
break;
}
}
else if (*cmp1 == '?') {
while (*cmp1 == '?' && *cmp2) {
++cmp1;
++cmp2;
}
continue;
}
else
break;
}
else {
while (*cmp1 == '*')
++cmp1;
break;
}
}
return (*cmp1 == '\0' && *cmp2 == '\0');
}
/*
* Since directory is a function to be extended by the implementation,
* current extensions are:
* all => list files and directories
* it is an error to call
* (directory "<pathname-spec>/" :all t)
* if non nil, it is like the shell command
* echo <pathname-spec>, but normally, not in the
* same order, as the code does not sort the result.
* !=nil => list files and directories
* (default) nil => list only files, or only directories if
* <pathname-spec> ends with PATH_SEP char.
* if-cannot-read => if opendir fails on a directory
* :error => generate an error
* (default) :skip => skip search in this directory
*/
LispObj *
Lisp_Directory(LispBuiltin *builtin)
/*
directory pathname &key all if-cannot-read
*/
{
GC_ENTER();
DIR *dir;
struct stat st;
struct dirent *ent;
int length, listdirs, i, ndirs, nmatches;
char name[PATH_MAX + 1], path[PATH_MAX + 2], directory[PATH_MAX + 2];
char *sep, *base, *ptr, **dirs, **matches,
dot[] = {'.', PATH_SEP, '\0'},
dotdot[] = {'.', '.', PATH_SEP, '\0'};
int cannot_read;
LispObj *pathname, *all, *if_cannot_read, *result, *cons, *object;
if_cannot_read = ARGUMENT(2);
all = ARGUMENT(1);
pathname = ARGUMENT(0);
result = NIL;
cons = NIL;
if (if_cannot_read != UNSPEC) {
if (!KEYWORDP(if_cannot_read) ||
(if_cannot_read != Kskip &&
if_cannot_read != Kerror))
LispDestroy("%s: bad :IF-CANNOT-READ %s",
STRFUN(builtin), STROBJ(if_cannot_read));
if (if_cannot_read != Kskip)
cannot_read = NOREAD_SKIP;
else
cannot_read = NOREAD_ERROR;
}
else
cannot_read = NOREAD_SKIP;
if (PATHNAMEP(pathname))
pathname = CAR(pathname->data.pathname);
else if (STREAMP(pathname) && pathname->data.stream.type == LispStreamFile)
pathname = CAR(pathname->data.stream.pathname->data.pathname);
else if (!STRINGP(pathname))
LispDestroy("%s: %s is not a pathname",
STRFUN(builtin), STROBJ(pathname));
strncpy(name, THESTR(pathname), sizeof(name) - 1);
name[sizeof(name) - 1] = '\0';
length = strlen(name);
if (length < STRLEN(pathname))
LispDestroy("%s: pathname too long %s",
STRFUN(builtin), name);
if (length == 0) {
if (getcwd(path, sizeof(path) - 2) == NULL)
LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
length = strlen(path);
if (!length || path[length - 1] != PATH_SEP) {
path[length++] = PATH_SEP;
path[length] = '\0';
}
result = APPLY1(Oparse_namestring, LSTRING(path, length));
GC_LEAVE();
return (result);
}
if (name[length - 1] == PATH_SEP) {
listdirs = 1;
if (length > 1) {
--length;
name[length] = '\0';
}
}
else
listdirs = 0;
if (name[0] != PATH_SEP) {
if (getcwd(path, sizeof(path) - 2) == NULL)
LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
length = strlen(path);
if (!length || path[length - 1] != PATH_SEP) {
path[length++] = PATH_SEP;
path[length] = '\0';
}
}
else
path[0] = '\0';
result = NIL;
/* list intermediate directories */
matches = NULL;
nmatches = 0;
dirs = LispMalloc(sizeof(char*));
ndirs = 1;
if (snprintf(directory, sizeof(directory), "%s%s%c",
path, name, PATH_SEP) > PATH_MAX)
LispDestroy("%s: pathname too long %s", STRFUN(builtin), directory);
/* Remove ../ */
sep = directory;
for (sep = strstr(sep, dotdot); sep; sep = strstr(sep, dotdot)) {
if (sep <= directory + 1)
strcpy(directory, sep + 2);
else if (sep[-1] == PATH_SEP) {
for (base = sep - 2; base > directory; base--)
if (*base == PATH_SEP)
break;
strcpy(base, sep + 2);
sep = base;
}
else
++sep;
}
/* Remove "./" */
sep = directory;
for (sep = strstr(sep, dot); sep; sep = strstr(sep, dot)) {
if (sep == directory || sep[-1] == PATH_SEP)
strcpy(sep, sep + 2);
else
++sep;
}
/* This will happen when there are too many '../' in the path */
if (directory[1] == '\0') {
directory[1] = PATH_SEP;
directory[2] = '\0';
}
base = directory;
sep = strchr(base + 1, PATH_SEP);
dirs[0] = LispMalloc(2);
dirs[0][0] = PATH_SEP;
dirs[0][1] = '\0';
for (base = directory + 1, sep = strchr(base, PATH_SEP); ;
base = sep + 1, sep = strchr(base, PATH_SEP)) {
*sep = '\0';
if (sep[1] == '\0')
sep = NULL;
length = strlen(base);
if (length == 0) {
if (sep)
*sep = PATH_SEP;
else
break;
continue;
}
for (i = 0; i < ndirs; i++) {
length = strlen(dirs[i]);
if (length > 1)
dirs[i][length - 1] = '\0'; /* remove trailing / */
if ((dir = opendir(dirs[i])) != NULL) {
(void)readdir(dir); /* "." */
(void)readdir(dir); /* ".." */
if (length > 1)
dirs[i][length - 1] = PATH_SEP; /* add trailing / again */
snprintf(path, sizeof(path), "%s", dirs[i]);
length = strlen(path);
ptr = path + length;
while ((ent = readdir(dir)) != NULL) {
int isdir;
unsigned d_namlen = strlen(ent->d_name);
if (length + d_namlen + 2 < sizeof(path))
strcpy(ptr, ent->d_name);
else {
closedir(dir);
LispDestroy("%s: pathname too long %s",
STRFUN(builtin), dirs[i]);
}
if (stat(path, &st) != 0)
isdir = 0;
else
isdir = S_ISDIR(st.st_mode);
if (all != UNSPEC || ((isdir && (listdirs || sep)) ||
(!listdirs && !sep && !isdir))) {
if (glob_match(base, ent->d_name)) {
if (isdir) {
length = strlen(ptr);
ptr[length++] = PATH_SEP;
ptr[length] = '\0';
}
/* XXX won't closedir on memory allocation failure! */
matches = LispRealloc(matches, sizeof(char*) *
nmatches + 1);
matches[nmatches++] = LispStrdup(ptr);
}
}
}
closedir(dir);
if (nmatches == 0) {
if (sep || !listdirs || *base) {
LispFree(dirs[i]);
if (i + 1 < ndirs)
memmove(dirs + i, dirs + i + 1,
sizeof(char*) * (ndirs - (i + 1)));
--ndirs;
--i; /* XXX playing with for loop */
}
}
else {
int j;
length = strlen(dirs[i]);
if (nmatches > 1) {
dirs = LispRealloc(dirs, sizeof(char*) *
(ndirs + nmatches));
if (i + 1 < ndirs)
memmove(dirs + i + nmatches, dirs + i + 1,
sizeof(char*) * (ndirs - (i + 1)));
}
for (j = 1; j < nmatches; j++) {
dirs[i + j] = LispMalloc(length +
strlen(matches[j]) + 1);
sprintf(dirs[i + j], "%s%s", dirs[i], matches[j]);
}
dirs[i] = LispRealloc(dirs[i],
length + strlen(matches[0]) + 1);
strcpy(dirs[i] + length, matches[0]);
i += nmatches - 1; /* XXX playing with for loop */
ndirs += nmatches - 1;
for (j = 0; j < nmatches; j++)
LispFree(matches[j]);
LispFree(matches);
matches = NULL;
nmatches = 0;
}
}
else {
if (cannot_read == NOREAD_ERROR)
LispDestroy("%s: opendir(%s): %s",
STRFUN(builtin), dirs[i], strerror(errno));
else {
LispFree(dirs[i]);
if (i + 1 < ndirs)
memmove(dirs + i, dirs + i + 1,
sizeof(char*) * (ndirs - (i + 1)));
--ndirs;
--i; /* XXX playing with for loop */
}
}
}
if (sep)
*sep = PATH_SEP;
else
break;
}
for (i = 0; i < ndirs; i++) {
object = APPLY1(Oparse_namestring, STRING2(dirs[i]));
if (result == NIL) {
result = cons = CONS(object, NIL);
GC_PROTECT(result);
}
else {
RPLACD(cons, CONS(object, NIL));
cons = CDR(cons);
}
}
LispFree(dirs);
GC_LEAVE();
return (result);
}
LispObj *
Lisp_ParseNamestring(LispBuiltin *builtin)
/*
parse-namestring object &optional host defaults &key start end junk-allowed
*/
{
GC_ENTER();
LispObj *result;
LispObj *object, *host, *defaults, *ostart, *oend, *junk_allowed;
junk_allowed = ARGUMENT(5);
oend = ARGUMENT(4);
ostart = ARGUMENT(3);
defaults = ARGUMENT(2);
host = ARGUMENT(1);
object = ARGUMENT(0);
if (host == UNSPEC)
host = NIL;
if (defaults == UNSPEC)
defaults = NIL;
RETURN_COUNT = 1;
if (STREAMP(object)) {
if (object->data.stream.type == LispStreamFile)
object = object->data.stream.pathname;
/* else just check for JUNK-ALLOWED... */
}
if (PATHNAMEP(object)) {
RETURN(0) = FIXNUM(0);
return (object);
}
if (host != NIL) {
CHECK_STRING(host);
}
if (defaults != NIL) {
if (!PATHNAMEP(defaults)) {
defaults = APPLY1(Oparse_namestring, defaults);
GC_PROTECT(defaults);
}
}
result = NIL;
if (STRINGP(object)) {
LispObj *cons, *cdr;
char *name = THESTR(object), *ptr, *str, data[PATH_MAX + 1],
string[PATH_MAX + 1], *namestr, *typestr, *send;
long start, end, length, alength, namelen, typelen;
LispCheckSequenceStartEnd(builtin, object, ostart, oend,
&start, &end, &length);
alength = end - start;
if (alength > sizeof(data) - 1)
LispDestroy("%s: string %s too large",
STRFUN(builtin), STROBJ(object));
memcpy(data, name + start, alength);
#ifndef KEEP_EXTRA_PATH_SEP
ptr = data;
send = ptr + alength;
while (ptr < send) {
if (*ptr++ == PATH_SEP) {
for (str = ptr; str < send && *str == PATH_SEP; str++)
;
if (str - ptr) {
memmove(ptr, str, alength - (str - data));
alength -= str - ptr;
send -= str - ptr;
}
}
}
#endif
data[alength] = '\0';
memcpy(string, data, alength + 1);
if (PATHNAMEP(defaults))
defaults = defaults->data.pathname;
/* string name */
result = cons = CONS(NIL, NIL);
GC_PROTECT(result);
/* host */
if (defaults != NIL)
defaults = CDR(defaults);
cdr = defaults == NIL ? NIL : CAR(defaults);
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* device */
if (defaults != NIL)
defaults = CDR(defaults);
cdr = defaults == NIL ? NIL : CAR(defaults);
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* directory */
if (defaults != NIL)
defaults = CDR(defaults);
if (*data == PATH_SEP)
cdr = CONS(Kabsolute, NIL);
else
cdr = CONS(Krelative, NIL);
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* directory components */
ptr = data;
send = data + alength;
if (*ptr == PATH_SEP)
++ptr;
for (str = ptr; str < send; str++) {
if (*str == PATH_SEP)
break;
}
while (str < send) {
*str++ = '\0';
if (str - ptr > NAME_MAX)
LispDestroy("%s: directory name too long %s",
STRFUN(builtin), ptr);
RPLACD(cdr, CONS(LSTRING(ptr, str - ptr - 1), NIL));
cdr = CDR(cdr);
for (ptr = str; str < send; str++) {
if (*str == PATH_SEP)
break;
}
}
if (str - ptr > NAME_MAX)
LispDestroy("%s: file name too long %s", STRFUN(builtin), ptr);
if (CAAR(cons) == Krelative &&
defaults != NIL && CAAR(defaults) == Kabsolute) {
/* defaults specify directory and pathname doesn't */
char *tstring;
long dlength, tlength;
LispObj *dir = CDAR(defaults);
for (dlength = 1; CONSP(dir); dir = CDR(dir))
dlength += STRLEN(CAR(dir)) + 1;
if (alength + dlength < PATH_MAX) {
memmove(data + dlength, data, alength + 1);
memmove(string + dlength, string, alength + 1);
alength += dlength;
ptr += dlength;
send += dlength;
CAAR(cons) = Kabsolute;
for (dir = CDAR(defaults), cdr = CAR(cons);
CONSP(dir);
dir = CDR(dir)) {
RPLACD(cdr, CONS(CAR(dir), CDR(cdr)));
cdr = CDR(cdr);
}
dir = CDAR(defaults);
data[0] = string[0] = PATH_SEP;
for (dlength = 1; CONSP(dir); dir = CDR(dir)) {
tstring = THESTR(CAR(dir));
tlength = STRLEN(CAR(dir));
memcpy(data + dlength, tstring, tlength);
memcpy(string + dlength, tstring, tlength);
dlength += tlength;
data[dlength] = string[dlength] = PATH_SEP;
++dlength;
}
}
}
/* name */
if (defaults != NIL)
defaults = CDR(defaults);
cdr = defaults == NIL ? NIL : CAR(defaults);
for (typelen = 0, str = ptr; str < send; str++) {
if (*str == PATH_TYPESEP) {
typelen = 1;
break;
}
}
if (*ptr)
cdr = LSTRING(ptr, str - ptr);
if (STRINGP(cdr)) {
namestr = THESTR(cdr);
namelen = STRLEN(cdr);
}
else {
namestr = "";
namelen = 0;
}
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* type */
if (defaults != NIL)
defaults = CDR(defaults);
cdr = defaults == NIL ? NIL : CAR(defaults);
ptr = str + typelen;
if (*ptr)
cdr = LSTRING(ptr, send - ptr);
if (STRINGP(cdr)) {
typestr = THESTR(cdr);
typelen = STRLEN(cdr);
}
else {
typestr = "";
typelen = 0;
}
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* version */
if (defaults != NIL)
defaults = CDR(defaults);
cdr = defaults == NIL ? NIL : CAR(defaults);
RPLACD(cons, CONS(cdr, NIL));
/* string representation, must be done here to use defaults */
for (ptr = string + alength; ptr >= string; ptr--) {
if (*ptr == PATH_SEP)
break;
}
if (ptr >= string)
++ptr;
else
ptr = string;
*ptr = '\0';
length = ptr - string;
alength = namelen;
if (alength) {
if (length + alength + 2 > sizeof(string))
alength = sizeof(string) - length - 2;
memcpy(string + length, namestr, alength);
length += alength;
}
alength = typelen;
if (alength) {
if (length + 2 < sizeof(string))
string[length++] = PATH_TYPESEP;
if (length + alength + 2 > sizeof(string))
alength = sizeof(string) - length - 2;
memcpy(string + length, typestr, alength);
length += alength;
}
string[length] = '\0';
RPLACA(result, LSTRING(string, length));
RETURN(0) = FIXNUM(end);
result = PATHNAME(result);
}
else if (junk_allowed == UNSPEC || junk_allowed == NIL)
LispDestroy("%s: bad argument %s", STRFUN(builtin), STROBJ(object));
else
RETURN(0) = NIL;
GC_LEAVE();
return (result);
}
LispObj *
Lisp_MakePathname(LispBuiltin *builtin)
/*
make-pathname &key host device directory name type version defaults
*/
{
GC_ENTER();
int length, alength;
char *string, pathname[PATH_MAX + 1];
LispObj *result, *cdr, *cons;
LispObj *host, *device, *directory, *name, *type, *version, *defaults;
defaults = ARGUMENT(6);
version = ARGUMENT(5);
type = ARGUMENT(4);
name = ARGUMENT(3);
directory = ARGUMENT(2);
device = ARGUMENT(1);
host = ARGUMENT(0);
if (host != UNSPEC) {
CHECK_STRING(host);
}
if (device != UNSPEC) {
CHECK_STRING(device);
}
if (directory != UNSPEC) {
LispObj *dir;
CHECK_CONS(directory);
dir = CAR(directory);
CHECK_KEYWORD(dir);
if (dir != Kabsolute && dir != Krelative)
LispDestroy("%s: directory type %s unknown",
STRFUN(builtin), STROBJ(dir));
}
if (name != UNSPEC) {
CHECK_STRING(name);
}
if (type != UNSPEC) {
CHECK_STRING(type);
}
if (version != UNSPEC && version != NIL) {
switch (OBJECT_TYPE(version)) {
case LispFixnum_t:
if (FIXNUM_VALUE(version) >= 0)
goto version_ok;
case LispInteger_t:
if (INT_VALUE(version) >= 0)
goto version_ok;
break;
case LispDFloat_t:
if (DFLOAT_VALUE(version) >= 0.0)
goto version_ok;
break;
default:
break;
}
LispDestroy("%s: %s is not a positive real number",
STRFUN(builtin), STROBJ(version));
}
version_ok:
if (defaults != UNSPEC && !PATHNAMEP(defaults) &&
(host == UNSPEC || device == UNSPEC || directory == UNSPEC ||
name == UNSPEC || type == UNSPEC || version == UNSPEC)) {
defaults = APPLY1(Oparse_namestring, defaults);
GC_PROTECT(defaults);
}
if (defaults != UNSPEC) {
defaults = defaults->data.pathname;
defaults = CDR(defaults); /* host */
if (host == UNSPEC)
host = CAR(defaults);
defaults = CDR(defaults); /* device */
if (device == UNSPEC)
device = CAR(defaults);
defaults = CDR(defaults); /* directory */
if (directory == UNSPEC)
directory = CAR(defaults);
defaults = CDR(defaults); /* name */
if (name == UNSPEC)
name = CAR(defaults);
defaults = CDR(defaults); /* type */
if (type == UNSPEC)
type = CAR(defaults);
defaults = CDR(defaults); /* version */
if (version == UNSPEC)
version = CAR(defaults);
}
/* string representation */
length = 0;
if (CONSP(directory)) {
if (CAR(directory) == Kabsolute)
pathname[length++] = PATH_SEP;
for (cdr = CDR(directory); CONSP(cdr); cdr = CDR(cdr)) {
CHECK_STRING(CAR(cdr));
string = THESTR(CAR(cdr));
alength = STRLEN(CAR(cdr));
if (alength > NAME_MAX)
LispDestroy("%s: directory name too long %s",
STRFUN(builtin), string);
if (length + alength + 2 > sizeof(pathname))
alength = sizeof(pathname) - length - 2;
memcpy(pathname + length, string, alength);
length += alength;
pathname[length++] = PATH_SEP;
}
}
if (STRINGP(name)) {
int xlength = 0;
if (STRINGP(type))
xlength = STRLEN(type) + 1;
string = THESTR(name);
alength = STRLEN(name);
if (alength + xlength > NAME_MAX)
LispDestroy("%s: file name too long %s",
STRFUN(builtin), string);
if (length + alength + 2 > sizeof(pathname))
alength = sizeof(pathname) - length - 2;
memcpy(pathname + length, string, alength);
length += alength;
}
if (STRINGP(type)) {
if (length + 2 < sizeof(pathname))
pathname[length++] = PATH_TYPESEP;
string = THESTR(type);
alength = STRLEN(type);
if (length + alength + 2 > sizeof(pathname))
alength = sizeof(pathname) - length - 2;
memcpy(pathname + length, string, alength);
length += alength;
}
pathname[length] = '\0';
result = cons = CONS(LSTRING(pathname, length), NIL);
GC_PROTECT(result);
/* host */
RPLACD(cons, CONS(host == UNSPEC ? NIL : host, NIL));
cons = CDR(cons);
/* device */
RPLACD(cons, CONS(device == UNSPEC ? NIL : device, NIL));
cons = CDR(cons);
/* directory */
if (directory == UNSPEC)
cdr = CONS(Krelative, NIL);
else
cdr = directory;
RPLACD(cons, CONS(cdr, NIL));
cons = CDR(cons);
/* name */
RPLACD(cons, CONS(name == UNSPEC ? NIL : name, NIL));
cons = CDR(cons);
/* type */
RPLACD(cons, CONS(type == UNSPEC ? NIL : type, NIL));
cons = CDR(cons);
/* version */
RPLACD(cons, CONS(version == UNSPEC ? NIL : version, NIL));
GC_LEAVE();
return (PATHNAME(result));
}
LispObj *
Lisp_PathnameHost(LispBuiltin *builtin)
/*
pathname-host pathname
*/
{
return (LispPathnameField(PATH_HOST, 0));
}
LispObj *
Lisp_PathnameDevice(LispBuiltin *builtin)
/*
pathname-device pathname
*/
{
return (LispPathnameField(PATH_DEVICE, 0));
}
LispObj *
Lisp_PathnameDirectory(LispBuiltin *builtin)
/*
pathname-device pathname
*/
{
return (LispPathnameField(PATH_DIRECTORY, 0));
}
LispObj *
Lisp_PathnameName(LispBuiltin *builtin)
/*
pathname-name pathname
*/
{
return (LispPathnameField(PATH_NAME, 0));
}
LispObj *
Lisp_PathnameType(LispBuiltin *builtin)
/*
pathname-type pathname
*/
{
return (LispPathnameField(PATH_TYPE, 0));
}
LispObj *
Lisp_PathnameVersion(LispBuiltin *builtin)
/*
pathname-version pathname
*/
{
return (LispPathnameField(PATH_VERSION, 0));
}
LispObj *
Lisp_FileNamestring(LispBuiltin *builtin)
/*
file-namestring pathname
*/
{
return (LispPathnameField(PATH_NAME, 1));
}
LispObj *
Lisp_DirectoryNamestring(LispBuiltin *builtin)
/*
directory-namestring pathname
*/
{
return (LispPathnameField(PATH_DIRECTORY, 1));
}
LispObj *
Lisp_EnoughNamestring(LispBuiltin *builtin)
/*
enough-pathname pathname &optional defaults
*/
{
LispObj *pathname, *defaults;
defaults = ARGUMENT(1);
pathname = ARGUMENT(0);
if (defaults != UNSPEC && defaults != NIL) {
char *ppathname, *pdefaults, *pp, *pd;
if (!STRINGP(pathname)) {
if (PATHNAMEP(pathname))
pathname = CAR(pathname->data.pathname);
else if (STREAMP(pathname) &&
pathname->data.stream.type == LispStreamFile)
pathname = CAR(pathname->data.stream.pathname->data.pathname);
else
LispDestroy("%s: bad PATHNAME %s",
STRFUN(builtin), STROBJ(pathname));
}
if (!STRINGP(defaults)) {
if (PATHNAMEP(defaults))
defaults = CAR(defaults->data.pathname);
else if (STREAMP(defaults) &&
defaults->data.stream.type == LispStreamFile)
defaults = CAR(defaults->data.stream.pathname->data.pathname);
else
LispDestroy("%s: bad DEFAULTS %s",
STRFUN(builtin), STROBJ(defaults));
}
ppathname = pp = THESTR(pathname);
pdefaults = pd = THESTR(defaults);
while (*ppathname && *pdefaults && *ppathname == *pdefaults) {
ppathname++;
pdefaults++;
}
if (*pdefaults == '\0' && pdefaults > pd)
--pdefaults;
if (*ppathname && *pdefaults && *pdefaults != PATH_SEP) {
--ppathname;
while (*ppathname != PATH_SEP && ppathname > pp)
--ppathname;
if (*ppathname == PATH_SEP)
++ppathname;
}
return (STRING(ppathname));
}
else {
if (STRINGP(pathname))
return (pathname);
else if (PATHNAMEP(pathname))
return (CAR(pathname->data.pathname));
else if (STREAMP(pathname)) {
if (pathname->data.stream.type == LispStreamFile)
return (CAR(pathname->data.stream.pathname->data.pathname));
}
}
LispDestroy("%s: bad PATHNAME %s", STRFUN(builtin), STROBJ(pathname));
return (NIL);
}
LispObj *
Lisp_Namestring(LispBuiltin *builtin)
/*
namestring pathname
*/
{
return (LispPathnameField(PATH_STRING, 1));
}
LispObj *
Lisp_HostNamestring(LispBuiltin *builtin)
/*
host-namestring pathname
*/
{
return (LispPathnameField(PATH_HOST, 1));
}
LispObj *
Lisp_Pathnamep(LispBuiltin *builtin)
/*
pathnamep object
*/
{
LispObj *object;
object = ARGUMENT(0);
return (PATHNAMEP(object) ? T : NIL);
}
/* XXX only checks if host is a string and only checks the HOME enviroment
* variable */
LispObj *
Lisp_UserHomedirPathname(LispBuiltin *builtin)
/*
user-homedir-pathname &optional host
*/
{
GC_ENTER();
int length;
char *home = getenv("HOME"), data[PATH_MAX + 1];
LispObj *result;
LispObj *host;
host = ARGUMENT(0);
if (host != UNSPEC && !STRINGP(host))
LispDestroy("%s: bad hostname %s", STRFUN(builtin), STROBJ(host));
length = 0;
if (home) {
length = strlen(home);
strncpy(data, home, length);
if (length && home[length - 1] != PATH_SEP)
data[length++] = PATH_SEP;
}
data[length] = '\0';
result = LSTRING(data, length);
GC_PROTECT(result);
result = APPLY1(Oparse_namestring, result);
GC_LEAVE();
return (result);
}
LispObj *
Lisp_Truename(LispBuiltin *builtin)
{
return (LispProbeFile(builtin, 0));
}
LispObj *
Lisp_ProbeFile(LispBuiltin *builtin)
{
return (LispProbeFile(builtin, 1));
}
Reference in New Issue View Git Blame Copy Permalink