diff options
Diffstat (limited to 'app/xedit/lisp')
28 files changed, 1297 insertions, 346 deletions
diff --git a/app/xedit/lisp/bytecode.c b/app/xedit/lisp/bytecode.c index 3e824d251..cc7d1c5b4 100644 --- a/app/xedit/lisp/bytecode.c +++ b/app/xedit/lisp/bytecode.c @@ -551,6 +551,8 @@ Lisp_Disassemble(LispBuiltin *builtin) name = bytecode = NULL; switch (OBJECT_TYPE(function)) { + case LispFunction_t: + function = function->data.atom->object; case LispAtom_t: name = function; atom = function->data.atom; @@ -627,8 +629,8 @@ Lisp_Disassemble(LispBuiltin *builtin) for (i = 0; i < alist->normals.num_symbols; i++) { LispWriteChar(NIL, i ? ',' : ':'); LispWriteChar(NIL, ' '); - LispWriteStr(NIL, ATOMID(alist->normals.symbols[i]), - strlen(ATOMID(alist->normals.symbols[i]))); + LispWriteStr(NIL, ATOMID(alist->normals.symbols[i])->value, + ATOMID(alist->normals.symbols[i])->length); } LispWriteChar(NIL, '\n'); @@ -639,8 +641,8 @@ Lisp_Disassemble(LispBuiltin *builtin) for (i = 0; i < alist->optionals.num_symbols; i++) { LispWriteChar(NIL, i ? ',' : ':'); LispWriteChar(NIL, ' '); - LispWriteStr(NIL, ATOMID(alist->optionals.symbols[i]), - strlen(ATOMID(alist->optionals.symbols[i]))); + LispWriteStr(NIL, ATOMID(alist->optionals.symbols[i])->value, + ATOMID(alist->optionals.symbols[i])->length); } LispWriteChar(NIL, '\n'); @@ -657,8 +659,8 @@ Lisp_Disassemble(LispBuiltin *builtin) if (alist->rest) { LispWriteStr(NIL, "Rest argument: ", 15); - LispWriteStr(NIL, ATOMID(alist->rest), - strlen(ATOMID(alist->rest))); + LispWriteStr(NIL, ATOMID(alist->rest)->value, + ATOMID(alist->rest)->length); LispWriteChar(NIL, '\n'); } else @@ -666,6 +668,7 @@ Lisp_Disassemble(LispBuiltin *builtin) } if (bytecode) { + Atom_id id; char *ptr; int *offsets[4]; int i, done, j, sym0, sym1, con0, con1, bui0, byt0, strd, strf; @@ -724,11 +727,11 @@ Lisp_Disassemble(LispBuiltin *builtin) * and called as XSTRING(atom->object) * it would also print the package name were the symbol was first defined, * but for local variables, only the symbol string is important. */ -#define XSTRING(string) string ? string : "#<UNBOUND>" +#define XSTRING(key) key ? key->value : "#<UNBOUND>" for (i = 0; i < num_symbols; i++) { sprintf(buffer, "Symbol %d = %s\n", - i, XSTRING(symbols[i]->string)); + i, XSTRING(symbols[i]->key)); LispWriteStr(NIL, buffer, strlen(buffer)); } for (i = 0; i < num_builtins; i++) { @@ -756,24 +759,24 @@ Lisp_Disassemble(LispBuiltin *builtin) for (i = 0; i < alist->normals.num_symbols; i++, j++) { sprintf(buffer, "%d = ", j); LispWriteStr(NIL, buffer, strlen(buffer)); - ptr = alist->normals.symbols[i]->data.atom->string; - LispWriteStr(NIL, ptr, strlen(ptr)); + id = alist->normals.symbols[i]->data.atom->key; + LispWriteStr(NIL, id->value, id->length); LispWriteChar(NIL, '\n'); } for (i = 0; i < alist->optionals.num_symbols; i++, j++) { sprintf(buffer, "%d = ", j); LispWriteStr(NIL, buffer, strlen(buffer)); - ptr = alist->optionals.symbols[i]->data.atom->string; - LispWriteStr(NIL, ptr, strlen(ptr)); + id = alist->optionals.symbols[i]->data.atom->key; + LispWriteStr(NIL, id->value, id->length); LispWriteChar(NIL, '\n'); if (alist->optionals.sforms[i]) { sprintf(buffer, "%d = ", j); len1 = strlen(buffer); LispWriteStr(NIL, buffer, len1); - ptr = alist->optionals.sforms[i]->data.atom->string; - len2 = strlen(ptr); - LispWriteStr(NIL, ptr, len2); + id = alist->optionals.sforms[i]->data.atom->key; + len2 = id->length; + LispWriteStr(NIL, id->value, len2); LispWriteChars(NIL, ' ', 28 - (len1 + len2)); LispWriteStr(NIL, "; sform\n", 9); j++; @@ -785,24 +788,24 @@ Lisp_Disassemble(LispBuiltin *builtin) len1 = strlen(buffer); LispWriteStr(NIL, buffer, len1); if (alist->keys.keys[i]) { - ptr = alist->keys.keys[i]->data.atom->string; - len2 = strlen(ptr); - LispWriteStr(NIL, ptr, strlen(ptr)); + id = alist->keys.keys[i]->data.atom->key; + len2 = id->length; + LispWriteStr(NIL, id->value, id->length); LispWriteChars(NIL, ' ', 28 - (len1 + len2)); LispWriteStr(NIL, "; special key", 14); } else { - ptr = alist->keys.symbols[i]->data.atom->string; - LispWriteStr(NIL, ptr, strlen(ptr)); + id = alist->keys.symbols[i]->data.atom->key; + LispWriteStr(NIL, id->value, id->length); } LispWriteChar(NIL, '\n'); if (alist->keys.sforms[i]) { sprintf(buffer, "%d = ", j); len1 = strlen(buffer); LispWriteStr(NIL, buffer, len1); - ptr = alist->keys.sforms[i]->data.atom->string; - len2 = strlen(ptr); - LispWriteStr(NIL, ptr, len2); + id = alist->keys.sforms[i]->data.atom->key; + len2 = id->length; + LispWriteStr(NIL, id->value, len2); LispWriteChars(NIL, ' ', 28 - (len1 + len2)); LispWriteStr(NIL, "; sform\n", 9); j++; @@ -813,9 +816,9 @@ Lisp_Disassemble(LispBuiltin *builtin) sprintf(buffer, "%d = ", j); len1 = strlen(buffer); LispWriteStr(NIL, buffer, len1); - ptr = alist->rest->data.atom->string; - len2 = strlen(ptr); - LispWriteStr(NIL, ptr, len2); + id = alist->rest->data.atom->key; + len2 = id->length; + LispWriteStr(NIL, id->value, len2); LispWriteChar(NIL, '\n'); j++; } @@ -824,9 +827,9 @@ Lisp_Disassemble(LispBuiltin *builtin) sprintf(buffer, "%d = ", j); len1 = strlen(buffer); LispWriteStr(NIL, buffer, len1); - ptr = alist->auxs.symbols[i]->data.atom->string; - len2 = strlen(ptr); - LispWriteStr(NIL, ptr, len2); + id = alist->auxs.symbols[i]->data.atom->key; + len2 = id->length; + LispWriteStr(NIL, id->value, len2); LispWriteChars(NIL, ' ', 28 - (len1 + len2)); LispWriteStr(NIL, "; aux\n", 7); } @@ -1116,7 +1119,7 @@ integer: for (; strf >= 0; strf--) fields = CDR(fields); strcpy(ptr, " "); ptr += 2; - strcpy(ptr, CAR(fields)->data.atom->string); + strcpy(ptr, CAR(fields)->data.atom->key->value); ptr += strlen(ptr); } if (strd >= 0) { @@ -1154,11 +1157,11 @@ integer: /* Symbols */ if (sym0 >= 0) { strcpy(ptr, " "); ptr += 2; - strcpy(ptr, XSTRING(symbols[sym0]->string)); + strcpy(ptr, XSTRING(symbols[sym0]->key)); ptr += strlen(ptr); if (sym1 >= 0) { strcpy(ptr, " "); ptr += 2; - strcpy(ptr, XSTRING(symbols[sym1]->string)); + strcpy(ptr, XSTRING(symbols[sym1]->key)); ptr += strlen(ptr); } } @@ -1658,7 +1661,7 @@ LinkWarnUnused(LispCom *com, CodeBlock *block) if (!(block->variables.flags[i] & (VARIABLE_USED | VARIABLE_ARGUMENT))) { ++com->warnings; LispWarning("the variable %s is unused", - block->variables.symbols[i]->string); + block->variables.symbols[i]->key->value); } } @@ -3274,7 +3277,7 @@ let_argument: * atom->constant field. */ atom = symbols[*stream++]; atom->offset = lisp__data.env.length; - lisp__data.env.names[lisp__data.env.length] = atom->string; + lisp__data.env.names[lisp__data.env.length] = atom->key; lisp__data.env.values[lisp__data.env.length++] = reg0; NEXT_OPCODE(); @@ -3282,7 +3285,7 @@ OPCODE_LABEL(XBC_LETX): letx_argument: atom = symbols[*stream++]; atom->offset = lisp__data.env.length; - lisp__data.env.names[lisp__data.env.length] = atom->string; + lisp__data.env.names[lisp__data.env.length] = atom->key; lisp__data.env.values[lisp__data.env.length++] = reg0; lisp__data.env.head++; NEXT_OPCODE(); @@ -3290,14 +3293,14 @@ letx_argument: OPCODE_LABEL(XBC_LET_NIL): atom = symbols[*stream++]; atom->offset = lisp__data.env.length; - lisp__data.env.names[lisp__data.env.length] = atom->string; + lisp__data.env.names[lisp__data.env.length] = atom->key; lisp__data.env.values[lisp__data.env.length++] = NIL; NEXT_OPCODE(); OPCODE_LABEL(XBC_LETX_NIL): atom = symbols[*stream++]; atom->offset = lisp__data.env.length; - lisp__data.env.names[lisp__data.env.length] = atom->string; + lisp__data.env.names[lisp__data.env.length] = atom->key; lisp__data.env.values[lisp__data.env.length++] = NIL; lisp__data.env.head++; NEXT_OPCODE(); @@ -3445,7 +3448,7 @@ OPCODE_LABEL(XBC_SETSYM): /* atom->dyn and atom->constant are exclusive, no * need to check if variable declared as constant. */ if (atom->offset < lisp__data.env.head && - lisp__data.env.names[atom->offset] == atom->string) + lisp__data.env.names[atom->offset] == atom->key) lisp__data.env.values[atom->offset] = reg0; else { if (atom->watch) @@ -3468,7 +3471,7 @@ OPCODE_LABEL(XBC_SETSYM): LispPackage *pack; LispWarning("the variable %s was not declared", - atom->string); + atom->key->value); LispSetAtomObjectProperty(atom, reg0); pack = atom->package->data.package.package; if (pack->glb.length >= pack->glb.space) @@ -3482,7 +3485,7 @@ OPCODE_LABEL(XBC_SETSYM): atom = symbols[*stream++]; \ if (atom->dyn) { \ if (atom->offset < lisp__data.env.head && \ - lisp__data.env.names[atom->offset] == atom->string) \ + lisp__data.env.names[atom->offset] == atom->key) \ reg0 = lisp__data.env.values[atom->offset]; \ else { \ reg0 = atom->property->value; \ @@ -3631,12 +3634,12 @@ OPCODE_LABEL(XBC_STRUCT): offset = *stream++; reg1 = constants[*stream++]; if (!STRUCTP(reg0) || reg0->data.struc.def != reg1) { - char *name = ATOMID(CAR(reg1)); + char *name = ATOMID(CAR(reg1))->value; for (reg1 = CDR(reg1); offset; offset--) reg1 = CDR(reg1); LispDestroy("%s-%s: %s is not a %s", - name, ATOMID(CAR(reg1)), STROBJ(reg0), name); + name, ATOMID(CAR(reg1))->value, STROBJ(reg0), name); } for (reg0 = reg0->data.struc.fields; offset; offset--) reg0 = CDR(reg0); diff --git a/app/xedit/lisp/compile.c b/app/xedit/lisp/compile.c index 6058c67a0..829baea85 100644 --- a/app/xedit/lisp/compile.c +++ b/app/xedit/lisp/compile.c @@ -1175,7 +1175,7 @@ ComAddVariable(LispCom *com, LispObj *symbol, LispObj *value) { LispAtom *atom = symbol->data.atom; - if (atom && atom->string && !com->macro) { + if (atom && atom->key && !com->macro) { int i, length = com->block->variables.length; i = BuildTablePointer(atom, (void***)&com->block->variables.symbols, @@ -1216,7 +1216,7 @@ ComGetVariable(LispCom *com, LispObj *symbol) } offset = name->offset; - id = name->string; + id = name->key; base = lisp__data.env.lex; i = lisp__data.env.head - 1; @@ -1238,7 +1238,7 @@ ComGetVariable(LispCom *com, LispObj *symbol) if (!name->a_object) { ++com->warnings; LispWarning("variable %s is neither declared nor bound", - name->string); + name->key->value); } /* Not found, resolve <symbol> at run time */ @@ -1645,7 +1645,7 @@ rest_label: constantp = 0; } - string = builtin ? ATOMID(name) : NULL; + string = builtin ? ATOMID(name)->value : NULL; /* XXX FIXME should have a flag indicating if function call * change the &REST arguments even if it is a constant list * (or if the returned value may be changed). */ @@ -1845,7 +1845,7 @@ ComFuncall(LispCom *com, LispObj *function, LispObj *arguments, int eval) LispObj *definition = atom->property->structure.definition; if (!CONSP(arguments) || CONSP(CDR(arguments))) - LispDestroy("%s: too %s arguments", atom->string, + LispDestroy("%s: too %s arguments", atom->key->value, CONSP(arguments) ? "many" : "few"); ComEval(com, CAR(arguments)); @@ -1870,7 +1870,7 @@ ComFuncall(LispCom *com, LispObj *function, LispObj *arguments, int eval) else { /* Not yet defined function/macro. */ ++com->warnings; - LispWarning("call to undefined function %s", atom->string); + LispWarning("call to undefined function %s", atom->key->value); com_Funcall(com, function, arguments); } break; diff --git a/app/xedit/lisp/core.c b/app/xedit/lisp/core.c index 684081af5..89f5d5c3c 100644 --- a/app/xedit/lisp/core.c +++ b/app/xedit/lisp/core.c @@ -1070,7 +1070,7 @@ Lisp_Defmacro(LispBuiltin *builtin) name = ARGUMENT(0); CHECK_SYMBOL(name); - alist = LispCheckArguments(LispMacro, lambda_list, ATOMID(name), 0); + alist = LispCheckArguments(LispMacro, lambda_list, ATOMID(name)->value, 0); if (CONSP(body) && STRINGP(CAR(body))) { LispAddDocumentation(name, CAR(body), LispDocFunction); @@ -1086,7 +1086,8 @@ Lisp_Defmacro(LispBuiltin *builtin) } /* redefining these may cause surprises if bytecode * compiled functions references them */ - LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name)); + LispWarning("%s: %s is being redefined", STRFUN(builtin), + ATOMID(name)->value); LispRemAtomBuiltinProperty(name->data.atom); } @@ -1112,7 +1113,7 @@ Lisp_Defun(LispBuiltin *builtin) name = ARGUMENT(0); CHECK_SYMBOL(name); - alist = LispCheckArguments(LispFunction, lambda_list, ATOMID(name), 0); + alist = LispCheckArguments(LispFunction, lambda_list, ATOMID(name)->value, 0); if (CONSP(body) && STRINGP(CAR(body))) { LispAddDocumentation(name, CAR(body), LispDocFunction); @@ -1128,7 +1129,8 @@ Lisp_Defun(LispBuiltin *builtin) } /* redefining these may cause surprises if bytecode * compiled functions references them */ - LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name)); + LispWarning("%s: %s is being redefined", STRFUN(builtin), + ATOMID(name)->value); LispRemAtomBuiltinProperty(name->data.atom); } @@ -1166,7 +1168,7 @@ Lisp_Defsetf(LispBuiltin *builtin) return (function); } - alist = LispCheckArguments(LispSetf, lambda_list, ATOMID(function), 0); + alist = LispCheckArguments(LispSetf, lambda_list, ATOMID(function)->value, 0); store = CAR(body); if (!CONSP(store)) @@ -2050,7 +2052,7 @@ Lisp_Lambda(LispBuiltin *builtin) body = ARGUMENT(1); lambda_list = ARGUMENT(0); - alist = LispCheckArguments(LispLambda, lambda_list, Snil, 0); + alist = LispCheckArguments(LispLambda, lambda_list, Snil->value, 0); name = OPAQUE(alist, LispArgList_t); lambda_list = LispListProtectedArguments(alist); @@ -2675,7 +2677,7 @@ Lisp_MakeArray(LispBuiltin *builtin) type = LispOpaque_t; else LispDestroy("%s: unsupported element type %s", - STRFUN(builtin), ATOMID(element_type)); + STRFUN(builtin), ATOMID(element_type)->value); } } @@ -3240,7 +3242,7 @@ Lisp_Member(LispBuiltin *builtin) } else { for (; CONSP(list); list = CDR(list)) - if (FCOMPARE(lambda, item, CAR(list), code) == expect) + if ((FCOMPARE(lambda, item, CAR(list), code)) == expect) return (list); } } @@ -3253,7 +3255,7 @@ Lisp_Member(LispBuiltin *builtin) else { for (; CONSP(list); list = CDR(list)) { compare = APPLY1(key, CAR(list)); - if (FCOMPARE(lambda, item, compare, code) == expect) + if ((FCOMPARE(lambda, item, compare, code)) == expect) return (list); } } @@ -3942,7 +3944,7 @@ Lisp_Proclaim(LispBuiltin *builtin) object = CAR(arguments); CHECK_SYMBOL(object); - operation = ATOMID(object); + operation = ATOMID(object)->value; if (strcmp(operation, "SPECIAL") == 0) { for (arguments = CDR(arguments); CONSP(arguments); arguments = CDR(arguments)) { @@ -4988,7 +4990,7 @@ LispDeleteRemoveXSubstitute(LispBuiltin *builtin, } /* Skip initial removed elements, if any */ - for (i = 0; objects[i] == NULL && i < xlength; i++) + for (i = 0; i < xlength && objects[i] == NULL; i++) ; for (i = 0; i < xlength; i++, object = CDR(object)) { diff --git a/app/xedit/lisp/format.c b/app/xedit/lisp/format.c index abbb49db4..ab855655d 100644 --- a/app/xedit/lisp/format.c +++ b/app/xedit/lisp/format.c @@ -556,7 +556,7 @@ format_ascii(LispObj *stream, LispObj *object, FmtArgs *args) if (collon) LispWriteStr(stream, "()", 2); else - LispWriteStr(stream, Snil, 3); + LispWriteStr(stream, Snil->value, 3); } else { /* if string is not NIL, atsign was specified diff --git a/app/xedit/lisp/hash.c b/app/xedit/lisp/hash.c index 595933086..a6b91ec37 100644 --- a/app/xedit/lisp/hash.c +++ b/app/xedit/lisp/hash.c @@ -153,8 +153,6 @@ LispHashKey(LispObj *object, int function) case LispString_t: string = THESTR(object); length = STRLEN(object); - if (length > 32) - length = 32; for (i = 0, key = 0; i < length; i++) key = (key << 1) ^ string[i]; break; diff --git a/app/xedit/lisp/helper.c b/app/xedit/lisp/helper.c index 100ed2e08..be3ee7b62 100644 --- a/app/xedit/lisp/helper.c +++ b/app/xedit/lisp/helper.c @@ -343,8 +343,8 @@ LispCharacterCoerce(LispBuiltin *builtin, LispObj *object) return (object); else if (STRINGP(object) && STRLEN(object) == 1) return (SCHAR(THESTR(object)[0])); - else if (SYMBOLP(object) && ATOMID(object)[1] == '\0') - return (SCHAR(ATOMID(object)[0])); + else if (SYMBOLP(object) && ATOMID(object)->value[1] == '\0') + return (SCHAR(ATOMID(object)->value[0])); else if (INDEXP(object)) { int c = FIXNUM_VALUE(object); @@ -374,9 +374,9 @@ LispStringCoerce(LispBuiltin *builtin, LispObj *object) return (LSTRING(string, 1)); } else if (object == NIL) - return (LSTRING(Snil, 3)); + return (LSTRING(Snil->value, 3)); else if (object == T) - return (LSTRING(St, 1)); + return (LSTRING(St->value, 1)); else LispDestroy("%s: cannot convert %s to string", STRFUN(builtin), STROBJ(object)); @@ -442,7 +442,7 @@ LispCoerce(LispBuiltin *builtin, type = LispPathname_t; else LispDestroy("%s: invalid type specification %s", - STRFUN(builtin), ATOMID(result_type)); + STRFUN(builtin), ATOMID(result_type)->value); } if (OBJECT_TYPE(object) == LispOpaque_t) { @@ -559,7 +559,7 @@ LispCoerce(LispBuiltin *builtin, coerce_fail: LispDestroy("%s: cannot convert %s to %s", - STRFUN(builtin), STROBJ(object), ATOMID(result_type)); + STRFUN(builtin), STROBJ(object), ATOMID(result_type)->value); /* NOTREACHED */ return (NIL); } diff --git a/app/xedit/lisp/internal.h b/app/xedit/lisp/internal.h index 68c8be2fd..2ca499196 100644 --- a/app/xedit/lisp/internal.h +++ b/app/xedit/lisp/internal.h @@ -1,4 +1,4 @@ -/* $XdotOrg: app/xedit/lisp/internal.h,v 1.3 2004/12/04 00:43:13 kuhn Exp $ */ +/* $XdotOrg: xc/programs/xedit/lisp/internal.h,v 1.2 2004/04/23 19:54:44 eich Exp $ */ /* * Copyright (c) 2001 by The XFree86 Project, Inc. * @@ -39,6 +39,8 @@ #include "mp.h" #include "re.h" +#include "util.h" + /* * Defines */ @@ -110,14 +112,14 @@ typedef struct _LispMac LispMac; #define UPROTECT(key, list) LispUProtect(key, list) /* create a new unique static atom string */ -#define GETATOMID(string) LispGetAtomString(string, 1) +#define GETATOMID(string) LispGetAtomKey(string, 1) #define GCDisable() ++gcpro #define GCEnable() --gcpro /* pointer to something unique to all atoms with the same print representation */ -#define ATOMID(object) (object)->data.atom->string +#define ATOMID(object) (object)->data.atom->key @@ -432,7 +434,7 @@ typedef struct _LispMac LispMac; #define LispFileno(file) ((file)->descriptor) -#define STRFUN(builtin) ATOMID(builtin->symbol) +#define STRFUN(builtin) ATOMID(builtin->symbol)->value #define STROBJ(obj) LispStrObj(obj) /* fetch builtin function/macro argument value @@ -457,9 +459,9 @@ typedef struct _LispMac LispMac; #define ERROR_CHECK_SPECIAL_FORM(atom) \ - if (atom->property->fun.builtin->compile) \ + if ((atom)->property->fun.builtin->compile) \ LispDestroy("%s: the special form %s cannot be redefined", \ - STRFUN(builtin), atom->string) + STRFUN(builtin), (atom)->key->value) @@ -489,7 +491,7 @@ typedef struct _LispHashTable LispHashTable; /* Bytecode compiler data */ typedef struct _LispCom LispCom; -typedef char *Atom_id; +typedef hash_key *Atom_id; typedef enum _LispType { /* objects encoded in the LispObj pointer */ diff --git a/app/xedit/lisp/io.c b/app/xedit/lisp/io.c index 56da49bdb..3a338558e 100644 --- a/app/xedit/lisp/io.c +++ b/app/xedit/lisp/io.c @@ -633,26 +633,34 @@ LispFwrite(LispFile *file, void *data, int size) int LispSwrite(LispString *string, void *data, int size) { + int bytes; + if (size < 0) return (EOF); if (string->output + size >= string->space) { if (string->fixed) { /* leave space for a ending nul character */ - size = string->space - string->output - 1; + bytes = string->space - string->output - 1; + + if (bytes < size) + size = bytes; if (size <= 0) return (-1); } else { - char *tmp = realloc(string->string, string->space + - (size / pagesize) * pagesize + pagesize); + char *tmp; + + bytes = string->space + size; + bytes += pagesize - (bytes % pagesize); + tmp = realloc(string->string, bytes); if (tmp == NULL) return (-1); string->string = tmp; - string->space += pagesize; + string->space = bytes; } } memcpy(string->string + string->output, data, size); diff --git a/app/xedit/lisp/lisp.c b/app/xedit/lisp/lisp.c index 87bf2cf6c..4b393c136 100644 --- a/app/xedit/lisp/lisp.c +++ b/app/xedit/lisp/lisp.c @@ -935,22 +935,20 @@ Lisp__GC(LispObj *car, LispObj *cdr) /* Traverse atom list, protecting properties, and function/structure * definitions if lisp__data.gc.immutablebits set */ - for (i = 0; i < STRTBLSZ; i++) { - atom = pack->atoms[i]; - while (atom) { - if (atom->property != NOPROPERTY) { - if (atom->a_property) - LispMark(atom->property->properties); - if (lisp__data.gc.immutablebits) { - if (atom->a_function || atom->a_compiled) - LispProt(atom->property->fun.function); - if (atom->a_defsetf) - LispProt(atom->property->setf); - if (atom->a_defstruct) - LispProt(atom->property->structure.definition); - } + for (atom = (LispAtom *)hash_iter_first(pack->atoms); + atom; + atom = (LispAtom *)hash_iter_next(pack->atoms)) { + if (atom->property != NOPROPERTY) { + if (atom->a_property) + LispMark(atom->property->properties); + if (lisp__data.gc.immutablebits) { + if (atom->a_function || atom->a_compiled) + LispProt(atom->property->fun.function); + if (atom->a_defsetf) + LispProt(atom->property->setf); + if (atom->a_defstruct) + LispProt(atom->property->structure.definition); } - atom = atom->next; } } } @@ -1285,97 +1283,88 @@ LispSetVariable(LispObj *var, LispObj *val, char *fname, int eval) int LispRegisterOpaqueType(char *desc) { + int length; LispOpaque *opaque; - int ii = STRHASH(desc); - for (opaque = lisp__data.opqs[ii]; opaque; opaque = opaque->next) - if (strcmp(opaque->desc, desc) == 0) - return (opaque->type); - opaque = (LispOpaque*)LispMalloc(sizeof(LispOpaque)); - opaque->desc = LispStrdup(desc); - opaque->next = lisp__data.opqs[ii]; - lisp__data.opqs[ii] = opaque; - LispMused(opaque->desc); - LispMused(opaque); + length = strlen(desc); + opaque = (LispOpaque *)hash_check(lisp__data.opqs, desc, length); + + if (opaque == NULL) { + opaque = (LispOpaque*)LispMalloc(sizeof(LispOpaque)); + opaque->desc = (hash_key*)LispCalloc(1, sizeof(hash_key)); + opaque->desc->value = LispStrdup(desc); + opaque->desc->length = length; + hash_put(lisp__data.opqs, (hash_entry *)opaque); + LispMused(opaque->desc->value); + LispMused(opaque->desc); + LispMused(opaque); + opaque->type = ++lisp__data.opaque; + } - return (opaque->type = ++lisp__data.opaque); + return (opaque->type); } char * LispIntToOpaqueType(int type) { - int i; LispOpaque *opaque; if (type) { - for (i = 0; i < STRTBLSZ; i++) { - opaque = lisp__data.opqs[i]; - while (opaque) { - if (opaque->type == type) - return (opaque->desc); - opaque = opaque->next; - } + for (opaque = (LispOpaque *)hash_iter_first(lisp__data.opqs); + opaque; + opaque = (LispOpaque *)hash_iter_next(lisp__data.opqs)) { + if (opaque->type == type) + return (opaque->desc->value); } LispDestroy("Opaque type %d not registered", type); } - return (Snil); -} - -int -LispDoHashString(char *string) -{ - char *pp; - int ii, count; - - for (pp = string, ii = count = 0; *pp && count < 32; pp++, count++) - ii = (ii << 1) ^ *pp; - if (ii < 0) - ii = -ii; - - return (ii % STRTBLSZ); + return (Snil->value); } -char * -LispGetAtomString(char *string, int perm) +hash_key * +LispGetAtomKey(char *string, int perm) { - LispStringHash *entry; - int ii = STRHASH(string); - - for (entry = lisp__data.strings[ii]; entry != NULL; entry = entry->next) - if (strcmp(entry->string, string) == 0) - return (entry->string); - - entry = (LispStringHash*)LispCalloc(1, sizeof(LispStringHash)); - if (perm) - entry->string = string; - else - entry->string = LispStrdup(string); - LispMused(entry); - if (!perm) - LispMused(entry->string); - entry->next = lisp__data.strings[ii]; - lisp__data.strings[ii] = entry; + int length; + hash_entry *entry; + + length = strlen(string); + entry = hash_check(lisp__data.strings, string, length); + if (entry == NULL) { + entry = LispCalloc(1, sizeof(hash_entry)); + entry->key = LispCalloc(1, sizeof(hash_key)); + if (perm) + entry->key->value = string; + else + entry->key->value = LispStrdup(string); + entry->key->length = length; + + hash_put(lisp__data.strings, entry); + if (!perm) + LispMused(entry->key->value); + LispMused(entry->key); + LispMused(entry); + } - return (entry->string); + return (entry->key); } LispAtom * LispDoGetAtom(char *str, int perm) { + int length; LispAtom *atom; - int ii = STRHASH(str); - for (atom = lisp__data.pack->atoms[ii]; atom; atom = atom->next) - if (strcmp(atom->string, str) == 0) - return (atom); + length = strlen(str); + atom = (LispAtom *)hash_check(lisp__data.pack->atoms, str, length); - atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom)); - atom->string = LispGetAtomString(str, perm); - LispMused(atom); - atom->next = lisp__data.pack->atoms[ii]; - lisp__data.pack->atoms[ii] = atom; - atom->property = NOPROPERTY; + if (atom == NULL) { + atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom)); + atom->key = LispGetAtomKey(str, perm); + hash_put(lisp__data.pack->atoms, (hash_entry *)atom); + atom->property = NOPROPERTY; + LispMused(atom); + } return (atom); } @@ -1464,7 +1453,7 @@ LispSetAtomObjectProperty(LispAtom *atom, LispObj *object) if (atom->object == lisp__data.package) { if (!PACKAGEP(object)) LispDestroy("Symbol %s must be a package, not %s", - ATOMID(lisp__data.package), STROBJ(object)); + ATOMID(lisp__data.package)->value, STROBJ(object)); lisp__data.pack = object->data.package.package; } } @@ -1752,7 +1741,7 @@ LispCheckKeyword(LispObj *keyword) if (KEYWORDP(keyword)) return (keyword); - return (KEYWORD(ATOMID(keyword))); + return (KEYWORD(ATOMID(keyword)->value)); } void @@ -1904,7 +1893,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) if (list != NIL) LispDestroy("%s %s: %s cannot be a %s argument list", fnames[type], name, STROBJ(list), types[type]); - alist->description = GETATOMID(""); + alist->description = GETATOMID("")->value; return (alist); } @@ -2048,14 +2037,14 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) else { Atom_id atom = ATOMID(spec); - if (atom[0] == '&') { + if (atom->value[0] == '&') { if (atom == Srest) { if (rest || aux || CDR(list) == NIL || !SYMBOLP(CADR(list)) /* only &aux allowed after &rest */ || (CDDR(list) != NIL && !SYMBOLP(CAR(CDDR(list))) && ATOMID(CAR(CDDR(list))) != Saux)) LispDestroy("%s %s: syntax error parsing %s", - fnames[type], name, ATOMID(spec)); + fnames[type], name, ATOMID(spec)->value); if (key) LispDestroy("%s %s: %s not allowed after %s", fnames[type], name, keys[IREST], keys[IKEY]); @@ -2066,7 +2055,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) else if (atom == Skey) { if (rest || aux) LispDestroy("%s %s: %s not allowed after %s", - fnames[type], name, ATOMID(spec), + fnames[type], name, ATOMID(spec)->value, rest ? keys[IREST] : keys[IAUX]); key = 1; continue; @@ -2075,7 +2064,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) else if (atom == Soptional) { if (rest || optional || aux || key) LispDestroy("%s %s: %s not allowed after %s", - fnames[type], name, ATOMID(spec), + fnames[type], name, ATOMID(spec)->value, rest ? keys[IREST] : optional ? keys[IOPTIONAL] : @@ -2088,7 +2077,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) /* &AUX must be the last keyword parameter */ if (aux) LispDestroy("%s %s: syntax error parsing %s", - fnames[type], name, ATOMID(spec)); + fnames[type], name, ATOMID(spec)->value); else if (builtin) LispDestroy("builtin function cannot have &AUX arguments"); aux = 1; @@ -2099,7 +2088,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) * argument names starting with the '&' character */ else LispDestroy("%s %s: %s not allowed/implemented", - fnames[type], name, ATOMID(spec)); + fnames[type], name, ATOMID(spec)->value); } /* Add argument to alist */ @@ -2170,7 +2159,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin) fnames[type], name, STROBJ(list), types[type]); *desc = '\0'; - alist->description = LispGetAtomString(description, 0); + alist->description = LispGetAtomKey(description, 0)->value; return (alist); } @@ -2214,7 +2203,7 @@ LispAddBuiltinFunction(LispBuiltin *builtin) LispPopInput(&stream); atom = name->data.atom; - alist = LispCheckArguments(builtin->type, CDR(list), atom->string, 1); + alist = LispCheckArguments(builtin->type, CDR(list), atom->key->value, 1); builtin->symbol = CAR(list); LispSetAtomBuiltinProperty(atom, builtin, alist); LispUseArgList(alist); @@ -2758,8 +2747,8 @@ LispSymbolName(LispObj *symbol) --atomseg.nfree; name->type = LispString_t; - THESTR(name) = atom->string; - STRLEN(name) = strlen(atom->string); + THESTR(name) = atom->key->value; + STRLEN(name) = atom->key->length; name->data.string.writable = 0; atom->name = name; @@ -3156,6 +3145,8 @@ LispNewPackage(LispObj *name, LispObj *nicknames) package->data.package.nicknames = nicknames; package->data.package.package = pack; + package->data.package.package->atoms = hash_new(STRTBLSZ, NULL); + LispMused(pack); return (package); @@ -3185,30 +3176,18 @@ LispSymbolFunction(LispObj *symbol) static INLINE LispObj * LispGetVarPack(LispObj *symbol) { - int ii; - char *string; LispAtom *atom; - string = ATOMID(symbol); - ii = STRHASH(string); - - atom = lisp__data.pack->atoms[ii]; - while (atom) { - if (strcmp(atom->string, string) == 0) - return (atom->object); + atom = (LispAtom *)hash_get(lisp__data.pack->atoms, + symbol->data.atom->key); - atom = atom->next; - } - - /* Symbol not found, just import it */ - return (NULL); + return (atom ? atom->object : NULL); } /* package must be of type LispPackage_t */ void LispUsePackage(LispObj *package) { - unsigned i; LispAtom *atom; LispPackage *pack; LispObj **pentry, **eentry; @@ -3242,13 +3221,11 @@ LispUsePackage(LispObj *package) pack = package->data.package.package; /* Traverse atom list, searching for extern symbols */ - for (i = 0; i < STRTBLSZ; i++) { - atom = pack->atoms[i]; - while (atom) { - if (atom->ext) - LispImportSymbol(atom->object); - atom = atom->next; - } + for (atom = (LispAtom *)hash_iter_first(pack->atoms); + atom; + atom = (LispAtom *)hash_iter_next(pack->atoms)) { + if (atom->ext) + LispImportSymbol(atom->object); } } @@ -3272,7 +3249,7 @@ LispImportSymbol(LispObj *symbol) } /* Create copy of atom in current package */ - atom = LispDoGetAtom(ATOMID(symbol), 0); + atom = LispDoGetAtom(ATOMID(symbol)->value, 0); /* Need to create a copy because if anything new is atached to the * property, the current package is the owner, not the previous one. */ @@ -3285,7 +3262,7 @@ LispImportSymbol(LispObj *symbol) /* Symbol already exists in the current package, * but does not reference the same variable */ LispContinuable("Symbol %s already defined in package %s. Redefine?", - ATOMID(symbol), THESTR(PACKAGE->data.package.name)); + ATOMID(symbol)->value, THESTR(PACKAGE->data.package.name)); atom = current->data.atom; @@ -3375,7 +3352,7 @@ LispGetVar(LispObj *atom) * binding if it is not -1, and if no binding is found, because the * lexical scope was left, reset offset to -1. */ offset = name->offset; - id = name->string; + id = name->key; base = lisp__data.env.lex; i = lisp__data.env.head - 1; @@ -3496,7 +3473,7 @@ LispDoAddVar(LispObj *symbol, LispObj *value) atom->offset = lisp__data.env.length; lisp__data.env.values[lisp__data.env.length] = value; - lisp__data.env.names[lisp__data.env.length++] = atom->string; + lisp__data.env.names[lisp__data.env.length++] = atom->key; } LispObj * @@ -3509,7 +3486,7 @@ LispSetVar(LispObj *atom, LispObj *obj) name = atom->data.atom; offset = name->offset; - id = name->string; + id = name->key; base = lisp__data.env.lex; i = lisp__data.env.head - 1; @@ -5192,6 +5169,9 @@ LispBegin(void) pagesize = LispGetPageSize(); segsize = pagesize / sizeof(LispObj); + lisp__data.strings = hash_new(STRTBLSZ, NULL); + lisp__data.opqs = hash_new(STRTBLSZ, NULL); + /* Initialize memory management */ lisp__data.mem.mem = (void**)calloc(lisp__data.mem.space = 16, sizeof(void*)); @@ -5275,7 +5255,7 @@ LispBegin(void) /* Create the KEYWORD package */ Skeyword = GETATOMID("KEYWORD"); - object = LispNewPackage(STRING(Skeyword), + object = LispNewPackage(STRING(Skeyword->value), CONS(STRING(""), NIL)); /* Update list of packages */ @@ -5474,7 +5454,7 @@ LispBegin(void) } void -LispEnd() +LispEnd(void) { /* XXX needs to free all used memory, not just close file descriptors */ } diff --git a/app/xedit/lisp/math.c b/app/xedit/lisp/math.c index f9b69529c..bdca0348e 100644 --- a/app/xedit/lisp/math.c +++ b/app/xedit/lisp/math.c @@ -71,7 +71,7 @@ LispMathInit(void) obj_one = FIXNUM(1); Oequal_ = STATIC_ATOM("="); - Ocomplex = STATIC_ATOM(Scomplex); + Ocomplex = STATIC_ATOM(Scomplex->value); Oshort_float = STATIC_ATOM("SHORT-FLOAT"); LispExportSymbol(Oshort_float); Osingle_float = STATIC_ATOM("SINGLE-FLOAT"); diff --git a/app/xedit/lisp/modules/indent.lsp b/app/xedit/lisp/modules/indent.lsp index 6fd32a9c6..1ba8b72c7 100644 --- a/app/xedit/lisp/modules/indent.lsp +++ b/app/xedit/lisp/modules/indent.lsp @@ -1038,6 +1038,12 @@ ;; Initial input already read (go :ind-loop) + ;; Just to avoid a warning about unused variable, as this + ;; variable is somewhat redundant as code should already + ;; know before entering indent parser, but useful inside + ;; indent macros. + *ind-point* + ;------------------------------------------------------------------------ ; Read a text line :ind-read diff --git a/app/xedit/lisp/modules/progmodes/auto.lsp b/app/xedit/lisp/modules/progmodes/auto.lsp new file mode 100644 index 000000000..aa4543ef9 --- /dev/null +++ b/app/xedit/lisp/modules/progmodes/auto.lsp @@ -0,0 +1,110 @@ +;; Copyright (c) 2007,2008 Paulo Cesar Pereira de Andrade +;; +;; 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 (including the next +;; paragraph) 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 AUTHORS OR COPYRIGHT HOLDERS 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. +;; +;; Author: Paulo Cesar Pereira de Andrade +;; + +;; Mode for editing autoconf/automake m4 files + +(require "syntax") +(in-package "XEDIT") + +(defsynprop *prop-macro* + "macro" + :font "*courier-bold-r*-12-*" + :foreground "green4") + +(defsynprop *prop-separator* + "separator" + :font "*courier-bold-r*-12-*" + :foreground "Red3") + +(defsynprop *prop-variable* + "variable" + :font "*lucidatypewriter-medium-r*-12-*" + :foreground "Gold4") + +(defsynprop *prop-escape* + "escape" + :font "*lucidatypewriter-medium-r*-12-*" + :foreground "Red3") + +(defsyntax *auto-mode* :main nil nil nil + ;; dont consider dnl a macro call at top level + (syntoken "(#.*|\\<dnl($|\\>.*))" :property *prop-comment*) + + ;; shell keywords + (syntoken + (string-concat + "\\<(" + "if|then|else|elif|else|fi|case|in|esac|do|done" + ")\\>") :property *prop-keyword*) + + ;; toplevel no arguments macro + (syntoken "^[a-zA-Z0-9_]+$" :property *prop-macro*) + + (syntable :string *prop-string* nil + ;; ignore escaped characters + (syntoken "\\\\.") + (syntoken "\"" :nospec t :switch -1) + (synaugment :variables)) + (syntable :constant *prop-constant* nil + (syntoken "\\\\.") + (syntoken "'" :nospec t :switch -1) + (synaugment :variables)) + (syntable :escape *prop-escape* nil + (syntoken "\\\\.") + (syntoken "`" :nospec t :switch -1) + (synaugment :variables)) + + (syntable :quoted-string *prop-string* nil + (syntoken "\\\"" :nospec t :switch -1)) + + (syntable :macro *prop-default* nil + (syntoken "," :property *prop-separator*) + (syntoken "[" :nospec t :property *prop-separator* :begin :quoted) + (syntable :quoted *prop-default* nil + ;; allow nesting + (syntoken "[" :nospec t :property *prop-separator* :begin :quoted) + (syntoken "]" :nospec t :property *prop-separator* :switch -1) + (synaugment :shared :variables)) + (syntoken ")" :nospec t :property *prop-macro* :switch -1) + (synaugment :shared :variables :comments)) + + (syntable :shared nil nil + (syntoken "[a-zA-Z0-9_]+\\(" :property *prop-macro* :begin :macro) + ;; variable assignment + (syntoken "[a-zA-Z0-9_-]+=" :property *prop-keyword*) + (syntoken "\"" :nospec t :begin :string :contained t) + (syntoken "'" :nospec t :begin :constant :contained t) + (syntoken "`" :nospec t :begin :escape :contained t) + (syntoken "\\\"" :nospec t :begin :quoted-string :contained t) + ) + + (syntable :variables nil nil + (syntoken "\\$[a-zA-Z0-9_-]+" :property *prop-variable*) + (syntoken "\\$\\{[a-zA-Z0-9_-]+\\}" :property *prop-variable*) + (syntoken "\\$\\([a-zA-Z0-9_-]+\\)" :property *prop-variable*)) + + (syntable :comments nil nil + (syntoken "(#.*|\\<dnl($|\\>.*))" :property *prop-comment*)) + + (synaugment :shared :variables)) diff --git a/app/xedit/lisp/modules/progmodes/c.lsp b/app/xedit/lisp/modules/progmodes/c.lsp index e49630ea3..fba6b99b1 100644 --- a/app/xedit/lisp/modules/progmodes/c.lsp +++ b/app/xedit/lisp/modules/progmodes/c.lsp @@ -1099,9 +1099,33 @@ ;; Preprocessor includes comments. (syntoken "/*" :nospec t :begin :comment :contained t) + ;; Ignore strings and constants in the same line and finishes table + ;; This is kind hackish, but must be done because the current parser + ;; will not flag eol. Maybe it could be extended to properly handle + ;; and have an internal flag to tell it to pass again if there + ;; is a regex that can match eol on an empty string. + ;; A test is already done (but at compile time) to not allow patterns + ;; that match an empty string (but allow patterns matching + ;; bol, eol or both on an empty string). + (syntoken "\"([^\\\"]|\\\\.)*\"$" :property *prop-string* :switch -1) + (syntoken "'([^']|\\\\.)*'$" :property *prop-constant* :switch -1) + + ;; Ignore strings and constants in the same line + (syntoken "\"([^\\\"]|\\\\.)*\"" :property *prop-string*) + (syntoken "'([^']|\\\\.)*'" :property *prop-constant*) + ;; Ignore lines finishing with a backslash. (syntoken "\\\\$") + ;; multiline strings + (syntoken "\"" :nospec t :begin :string) + + ;; multiline constants + (syntoken "'" :nospec t :begin :character) + + ;; C++ style comments + (syntoken "//.*$" :property *prop-comment* :switch -1) + ;; Return to previous state if end of line found. (syntoken ".?$" :switch -1) ) diff --git a/app/xedit/lisp/modules/progmodes/lisp.lsp b/app/xedit/lisp/modules/progmodes/lisp.lsp index c15352b3f..2472b723a 100644 --- a/app/xedit/lisp/modules/progmodes/lisp.lsp +++ b/app/xedit/lisp/modules/progmodes/lisp.lsp @@ -43,7 +43,7 @@ (defsynprop *prop-quote* "quote" :font "*courier-bold-r*-12-*" - :foreground "Red3" + :foreground "Red4" ) (defsynprop *prop-package* diff --git a/app/xedit/lisp/modules/progmodes/perl.lsp b/app/xedit/lisp/modules/progmodes/perl.lsp new file mode 100644 index 000000000..25a62c530 --- /dev/null +++ b/app/xedit/lisp/modules/progmodes/perl.lsp @@ -0,0 +1,507 @@ +;; Copyright (c) 2007,2008 Paulo Cesar Pereira de Andrade +;; +;; 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 (including the next +;; paragraph) 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 AUTHORS OR COPYRIGHT HOLDERS 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. +;; +;; Author: Paulo Cesar Pereira de Andrade +;; + +;; Perl syntax and indentation mode +;; Based on the C/C++ and Lisp modes. Attempting to make simple +;; syntax/indentation rules, that should work correctly with most +;; perl code. + +;; *cont-indent* is somewhat buggy, that if pressing C-A,Tab, will +;; not generate the same output as when normally typing the expression. +;; This is because the parser doesn't search for a matching ';', '{', +;; '[' or '(' to know where the expression starts. The C mode has the +;; same problem. Example: +;; a + +;; b; <-- if pressing C-A,Tab will align "b;" with "a +" + +;; Maybe most of the code here, and some code in the C mode could be +;; merged to have a single "default mode" parser for languages that +;; basically only depend on { and } for indentation. + +(require "syntax") +(require "indent") +(in-package "XEDIT") + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsynprop *prop-string-escape* + "string-escape" + :font "*lucidatypewriter-bold-r*-12-*" + :foreground "RoyalBlue2" + :underline t) + +(defsynprop *prop-string-keyword-bold* + "string-variable-bold" + :font "*lucidatypewriter-bold-r*-12-*" + :foreground "RoyalBlue4") + +(defsynprop *prop-string-keyword* + "string-variable" + :font "*lucidatypewriter-medium-r*-12-*" + :foreground "RoyalBlue4") + +(defsynprop *prop-constant-escape* + "constant-escape" + :font "*lucidatypewriter-medium-r*-12-*" + :foreground "VioletRed3" + :underline t) + +(defsynprop *prop-regex* + "regex" + :font "*courier-medium-o*-12-*" + :foreground "black") + +(defsynprop *prop-shell* + "shell" + :font "*lucidatypewriter-medium-r*-12-*" + :foreground "red3") + +(defsynprop *prop-shell-escape* + "shell-escape" + :font "*lucidatypewriter-bold-r*-12-*" + :foreground "red3" + :underline t) + +(defsynprop *prop-documentation* + "documentation" + :font "fixed" + :foreground "black" + :background "rgb:e/e/e" +) + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsynoptions *perl-DEFAULT-style* + ;; Positive number. Basic indentation + (:indentation . 4) + + ;; Boolean. Add one indentation level to continuations? + (:cont-indent . t) + + ;; Boolean. Move cursor to the indent column after pressing <Enter>? + (:newline-indent . t) + + ;; Boolean. Set to T if tabs shouldn't be used to fill indentation. + (:emulate-tabs . nil) + + ;; Boolean. Only calculate indentation after pressing <Enter>? + ;; This may be useful if the parser does not always + ;; do what the user expects... + (:only-newline-indent . nil) + + ;; Boolean. Remove extra spaces from previous line. + ;; This should default to T when newline-indent is not NIL. + (:trim-blank-lines . t) + + ;; Boolean. If this hash-table entry is set, no indentation is done. + ;; Useful to temporarily disable indentation. + (:disable-indent . nil)) + + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defvar *perl-mode-options* *perl-DEFAULT-style*) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +;; Parenthesis are usually not required, just distinguish as: +;; expression: code without an ending ';' +;; statement: code ending in a ';' +;; block: code enclosed in '{' and '}' +;; In Perl a simpler logic can be used, unlikely the C mode, as in +;; perl braces are mandatory +(defindent *perl-mode-indent* :main + ;; this must be the first token + (indtoken "^\\s*" :indent + :code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*)))) + ;; this may cause some other patterns to fail, due to matching single \' + (indtoken "(&?(\\w+)|&(\\w+)?)'\\w+" :expression) + ;; special variables + (indtoken "\\$(\\d|^\\u|[][0-9!#$*()_@<>?/|,\"'])" :expression) + ;; ignore comments + (indtoken "#.*$" nil) + ;; treat regex as expressions to avoid confusing parser + (indtoken "m?/([^/]|\\\\/)+/\\w*" :expression) + (indtoken "m\\{[^}]+\\}\\w*" :expression) + (indtoken "m<[^>]+>\\w*" :expression) + (indtoken "(s|tr)/[^/]+/([^/]|\\\\/)*/\\w*" :expression) + (indtoken "//" :expression :nospec t) + ;; fast resolve deferences to expressions + (indtoken "[$@%&*]?\\{\\$?\\S+\\}" :expression) + + (indtoken "($%@*)?\\w+" :expression) + (indtoken ";" :semi :nospec t) + (indinit (braces 0)) + (indtoken "{" :obrace :nospec t + :code (decf braces)) + (indtoken "}" :cbrace :nospec t + :code (incf braces)) + (indinit (parens&bracks 0)) + (indtoken ")" :cparen :nospec t :code (incf parens&bracks)) + (indtoken "(" :oparen :nospec t :code (decf parens&bracks)) + (indtoken "]" :cbrack :nospec t :code (incf parens&bracks)) + (indtoken "[" :obrack :nospec t :code (decf parens&bracks)) + ;; if in the same line, reduce now, this must be done because the + ;; delimiters are identical + (indtoken "'([^\\']|\\\\.)*'" :expression) + (indtoken "\"([^\\\"]|\\\\.)*\"" :expression) + (indtoken "\"" :cstring1 :nospec t :begin :string1) + (indtoken "'" :cstring2 :nospec t :begin :string2) + ;; This must be the last rule + (indtoken "\\s*$" :eol) + + (indtable :string1 + ;; Ignore escaped characters + (indtoken "\\." nil) + ;; Return to the toplevel when the start of the string is found + (indtoken "\"" :ostring1 :nospec t :switch -1)) + (indtable :string2 + (indtoken "\\." nil) + (indtoken "'" :ostring2 :nospec t :switch -1)) + + ;; This avoids some problems with *cont-indent* adding an indentation + ;; level to an expression after an empty line + (indreduce nil + t + ((:indent :eol))) + + ;; Reduce to a single expression token + (indreduce :expression + t + ((:indent :expression) + (:expression :eol) + (:expression :parens) + (:expression :bracks) + (:expression :expression) + ;; multiline strings + (:ostring1 (not :ostring1) :cstring1) + (:ostring2 (not :ostring2) :cstring2) + ;; parenthesis and brackets + (:oparen (not :oparen) :cparen) + (:obrack (not :obrack) :cbrack))) + + ;; Statements end in a semicollon + (indreduce :statement + t + ((:semi) + (:indent :semi) + (:expression :statement) + (:statement :eol) + ;; Doesn't necessarily end in a semicollon + (:expression :block))) + + (indreduce :block + t + ((:obrace (not :obrace) :cbrace) + (:block :eol))) + (indreduce :obrace + (< *ind-offset* *ind-start*) + ((:indent :obrace)) + (setq *indent* (offset-indentation (+ *ind-offset* *ind-length*) :resolve t)) + (indent-macro-reject-left)) + + ;; Try to do an smart indentation on open parenthesis and brackets + (indreduce :parens + t + ((:oparen (not :oparen) :cparen)) + (when (and + (< *ind-offset* *ind-start*) + (> (+ *ind-offset* *ind-length*) *ind-start*)) + (setq *indent* (1+ (offset-indentation *ind-offset* :align t))) + (indent-macro-reject-left))) + (indreduce :bracks + t + ((:obrack (not :obrack) :cbrack)) + (when (and + (< *ind-offset* *ind-start*) + (> (+ *ind-offset* *ind-length*) *ind-start*)) + (setq *indent* (1+ (offset-indentation *ind-offset* :align t))) + (indent-macro-reject-left))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Assuming previous lines have correct indentation, try to + ;; fast resolve brace indentation + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Line ended with an open brace + (indreduce :obrace + (< *ind-offset* *ind-start*) + ((:expression :obrace)) + (setq *indent* (offset-indentation *ind-offset* :resolve t)) + (indent-macro-reject-left)) + ;; Line starts with an open brace + (indreduce nil + (< *ind-offset* *ind-start* (+ *ind-offset* *ind-length*)) + ;; Just set initial indentation + ((:indent :obrace)) + (setq + *indent* (- (offset-indentation *ind-offset* :resolve t) *base-indent*)) + (indent-macro-reject-left)) + + (indresolve :statement + (when (< *ind-offset* *ind-start*) + (while (> braces 0) + (setq + *indent* (- *indent* *base-indent*) + braces (1- braces))))) + + (indresolve :obrace + (and (< *ind-offset* *ind-start*) + (incf *indent* *base-indent*))) + (indresolve :cbrace + (decf *indent* *base-indent*)) + (indresolve :expression + (and + *cont-indent* + (> *indent* 0) + (zerop parens&bracks) + (< *ind-offset* *ind-start*) + (> (+ *ind-offset* *ind-length*) *ind-start*) + (incf *indent* *base-indent*))) + + (indresolve (:oparen :obrack) + (and (< *ind-offset* *ind-start*) + (setq *indent* (1+ (offset-indentation *ind-offset* :align t))))) +) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun perl-offset-indent (&aux char (point (point))) + ;; Skip spaces forward + (while (member (setq char (char-after point)) indent-spaces) + (incf point)) + (if (member char '(#\})) (1+ point) point)) + +(compile 'perl-offset-indent) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun perl-should-indent (options &aux char point start offset) + (when (hash-table-p options) + ;; check if previous line has extra spaces + (and (gethash :trim-blank-lines options) + (indent-clear-empty-line)) + + ;; indentation disabled? + (and (gethash :disable-indent options) + (return-from perl-should-indent)) + + (setq + point (point) + char (char-before point) + start (scan point :eol :left)) + + ;; if at bol and should indent only when starting a line + (and (gethash :only-newline-indent options) + (return-from perl-should-indent (= point start))) + + ;; at the start of a line + (and (= point start) + (return-from perl-should-indent (gethash :newline-indent options))) + + ;; if first character + (and (= point (1+ start)) + (return-from perl-should-indent t)) + + ;; check if is the first non-blank character in a new line + (when (and + (gethash :cont-indent options) + (= point (scan point :eol :right)) + (alphanumericp char)) + (setq offset (1- point)) + (while (and + (> offset start) + (member (char-before offset) indent-spaces)) + (decf offset)) + ;; line has only one character with possible spaces before it + (and (<= offset start) + (return-from perl-should-indent t))) + + ;; if one of these was typed, should check indentation + (if (member char '(#\})) (return-from perl-should-indent t)) + ) + ;; Should not indent + nil) + +(compile 'perl-should-indent) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun perl-indent (syntax syntable) + (let* + ((options (syntax-options syntax)) + *base-indent* + *cont-indent*) + + (or (perl-should-indent options) (return-from perl-indent)) + (setq + *base-indent* (gethash :indentation options 4) + *cont-indent* (gethash :cont-indent options t)) + + (indent-macro + *perl-mode-indent* + (perl-offset-indent) + (gethash :emulate-tabs options)))) + +(compile 'perl-indent) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +;; some example macros to easily add new patterns for strings and possibly +;; regex or other patterns +(defmacro perl-q-string-token (token) + `(syntoken (string-concat "\\<q(q|w)?\\s*\\" ,token) + :icase t :contained t :begin + (intern (string-concat "string" ,token) 'keyword))) +(defmacro perl-q-string-table (start end) + `(syntable (intern (string-concat "string" ,start) 'keyword) + *prop-string* #'default-indent + (syntoken ,end :nospec t :switch -1) + (synaugment :inside-string))) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsyntax *perl-mode* :main nil #'perl-indent *perl-mode-options* + ;; keywords + (syntoken + (string-concat + "\\<(" + "and|for|foreach|gt|if|else|elsif|eq|goto|le|lt|last|ne|" + "neg|next|not|or|return|shift|sub|unless|unshift|until|while" + ")\\>") + :property *prop-keyword*) + + ;; pseudo keywords + (syntoken + (string-concat + "\\<(" + "BEGIN|END|bless|blessed|defined|delete|eval|local|my|our|" + "package|require|undef|use" + ")\\>") + :property *prop-preprocessor*) + ;; this may cause some other patterns to fail, due to matching single \' + (syntoken "(&?(\\w+)|&(\\w+)?)'\\w+" :property *prop-preprocessor*) + + ;; numbers + (syntoken + (string-concat + "\\<(" + ;; Integers + "(\\d+|0x\\x+)|" + ;; Floats + "\\d+\\.?\\d*(e[+-]?\\d+)?" + ")\\>") + :icase t + :property *prop-number*) + + ;; special variables + (syntoken "\\$(\\d|^\\u|[][0-9!#$*()_@<>?/|,\"'])" :property *prop-keyword*) + + ;; also match variables + (syntable :inside-string nil nil + ;; escaped characters + + ;; XXX This pattern was matching the empty string and entering an + ;; infinite loop in code like: +#| +---%<--- +" <-- *** if an backslash is added it fails. Inverting +a"; *** the pattern fixed the problem, but was the wrong +---%<--- *** solution. Note that C-G stops the interpreter, and + *** special care must be taken with patterns matching + *** empty strings. +|# + + (syntoken "\\\\\\d{3}|\\\\." :property *prop-string-escape*) + (syntoken "(\\{\\$|\\$\\{)" :property *prop-string-keyword-bold* :begin :string-varbrace) + (syntoken "[$@]" :property *prop-string-keyword-bold* :begin :string-variable) + (syntoken "\\$(\\d|^\\u|[][0-9!#$*()_@<>?/|,\"'])" :property *prop-string-keyword-bold*)) + + ;; variables insided strings + (syntable :string-variable *prop-string-keyword* nil + (syntoken "\\w+" :switch -1)) + (syntable :string-varbrace *prop-string-keyword* nil + (syntoken "}" + :nospec t + :property *prop-string-keyword-bold* + :switch -1) + (synaugment :inside-string)) + + ;; comments + (syntoken "#.*$" :property *prop-comment*) + + ;; regex + (syntoken "(\\<m)?/([^/]|\\\\/)+/\\w*" :property *prop-regex*) + (syntoken "\\<m\\{[^}]+\\}\\w*" :property *prop-regex*) + (syntoken "\\<m<[^>]+>\\w*" :property *prop-regex*) + (syntoken "\\<(s|tr)/[^/]+/([^/]|\\\\/)*/\\w*":property *prop-regex*) + ;; just to avoid confusing the parser on something like split //, ... + (syntoken "//" :nospec t :property *prop-regex*) + + ;; strings + (syntoken "\"" :nospec t :contained t :begin :string) + (syntable :string *prop-string* #'default-indent + (syntoken "\"" :nospec t :switch -1) + (synaugment :inside-string)) + + ;; more strings + (perl-q-string-token "{") + (perl-q-string-table "{" "}") + (perl-q-string-token "[") + (perl-q-string-table "[" "]") + (perl-q-string-token "(") + (perl-q-string-table "(" ")") + (perl-q-string-token "/") + (perl-q-string-table "/" "/") + + ;; yet more strings + (syntoken "'" :nospec t :contained t :begin :constant) + (syntable :constant *prop-constant* #'default-indent + (syntoken "'" :nospec t :switch -1) + (syntoken "\\\\." :property *prop-string-escape*)) + + ;; shell commands + (syntoken "`" :nospec t :contained t :begin :shell) + (syntable :shell *prop-shell* #'default-indent + (syntoken "`" :nospec t :switch -1) + (synaugment :inside-string)) + + ;; punctuation + (syntoken "[][$@%(){}/*+:;=<>,&!|^~\\.?-]" :property *prop-punctuation*) + (syntoken "\\<x\\>" :property *prop-punctuation*) + + ;; primitive faked heredoc support, doesn't match the proper string, just + ;; expects an uppercase identifier in a single line + (syntoken "<<\"[A-Z][A-Z0-9_]+\"" :property *prop-string* :begin :heredoc) + (syntoken "<<'[A-Z][A-Z0-9_]+'" :property *prop-constant* :begin :heredoc) + (syntoken "<<[A-Z][A-Z0-9_]+" :property *prop-preprocessor* :begin :heredoc) + (syntable :heredoc *prop-documentation* #'default-indent + (syntoken "^[A-Z][A-Z0-9_]+$" :switch -1)) + + (syntoken "^=(pod|item|over|head\\d)\\>.*$" :property *prop-documentation* :begin :info) + (syntable :info *prop-documentation* nil + (syntoken "^=cut\\>.*$" :switch -1) + (syntoken "^.*$")) + + (syntoken "^(__END__|__DATA__)$" :property *prop-documentation* + :begin :documentation) + + (syntoken "__\\u+__" :property *prop-preprocessor*) + + (syntable :documentation *prop-documentation* nil + (syntoken "^.*$")) + +) diff --git a/app/xedit/lisp/modules/progmodes/python.lsp b/app/xedit/lisp/modules/progmodes/python.lsp new file mode 100644 index 000000000..ff708567b --- /dev/null +++ b/app/xedit/lisp/modules/progmodes/python.lsp @@ -0,0 +1,306 @@ +;; Copyright (c) 2008 Paulo Cesar Pereira de Andrade +;; +;; 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 (including the next +;; paragraph) 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 AUTHORS OR COPYRIGHT HOLDERS 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. +;; +;; Author: Paulo Cesar Pereira de Andrade +;; + +(require "syntax") +(require "indent") +(in-package "XEDIT") + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsynprop *prop-indent* + "indent" + :font "*courier-medium-r*-12-*" + :background "Gray92") + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsynoptions *python-DEFAULT-options* + ;; Positive number. Basic indentation + (:indentation . 4) + + ;; Boolean. Move cursor to the indent column after pressing <Enter>? + (:newline-indent . t) + + ;; Boolean. Set to T if tabs shouldn't be used to fill indentation. + (:emulate-tabs . t) + + ;; Boolean. Only calculate indentation after pressing <Enter>? + ;; This may be useful if the parser does not always + ;; do what the user expects... + (:only-newline-indent . nil) + + ;; Boolean. Remove extra spaces from previous line. + ;; This should default to T when newline-indent is not NIL. + (:trim-blank-lines . nil) + + ;; Boolean. If this hash-table entry is set, no indentation is done. + ;; Useful to temporarily disable indentation. + (:disable-indent . nil)) + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +;; Not doing "special" indentation of multiline ( because it is attempting +;; to do a "smart" indentation and usually don't read more then one line +;; back to resolve indentation. +;; Code for multiline { and [, usually declaring vector/hash like variables +;; should be working properly. +;; Note that the indent lisp hook is only run on character additions, so +;; it doesn't do a "smart" tabbing when pressing backspace, but it will +;; properly align to the "closest tab stop" when typping a character. +(defindent *python-mode-indent* :main + ;; this must be the first token + (indtoken "^\\s*" :indent + :code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*)))) + + ;; ignore comments + (indtoken "#.*$" nil) + + (indtoken ":" :collon :nospec t) + + ;; don't directly match {}, [], () strings, and : + (indtoken "[a-zA-Z0-9+*/%^&<>=.,|!~-]+" :expression) + + ;; if in the same line, reduce now, as delimiters are identical + (indtoken "'([^\\']|\\\\.)*'" :expression) + (indtoken "\"([^\\\"]|\\\\.)*\"" :expression) + ;; otherwise, use a table + (indtoken "\"" :cstring :nospec t :begin :string) + (indtoken "'" :cconstant :nospec t :begin :constant) + (indtoken "\"\"\"" :cstring3 :nospec t :begin :string3) + (indtoken "'''" :cconstant :nospec t :begin :constant3) + + (indinit (braces 0)) + (indtoken "}" :cbrace :nospec t :code (incf braces)) + (indtoken "{" :obrace :nospec t :code (decf braces)) + (indtoken ")" :cparen :nospec t :code (incf braces)) + (indtoken "(" :oparen :nospec t :code (decf braces)) + (indtoken "]" :cbrack :nospec t :code (incf braces)) + (indtoken "[" :obrack :nospec t :code (decf braces)) + + ;; This must be the last token + (indtoken "$" :eol) + + (indtable :string + ;; Ignore escaped characters + (indtoken "\\." nil) + ;; Return to the toplevel when the start of the string is found + (indtoken "\"" :ostring :nospec t :switch -1)) + (indtable :constant + (indtoken "\\." nil) + (indtoken "'" :oconstant :nospec t :switch -1)) + + (indtable :string3 + (indtoken "\"\"\"" :ostring3 :nospec t :switch -1)) + (indtable :constant3 + (indtoken "'''" :oconstant3 :nospec t :switch -1)) + + ;; Reduce what isn't reduced in regex pattern match + (indreduce :expression + t + ((:expression :expression) + ;; multiline strings + (:ostring (not :ostring) :cstring) + (:oconstant (not :oconstant) :cconstant) + (:ostring3 (not :ostring3) :cstring3) + (:oconstant3 (not :oconstant3) :cconstant3) + ;; braces, parenthesis and brackets + (:obrace (not :obrace) :cbrace) + (:oparen (not :oparen) :cparen) + (:obrack (not :obrack) :cbrack))) + + ;; This should be the most common exit point; + ;; just copy previous line indentation. + (indreduce :align + (< *ind-offset* *ind-start*) + ((:indent :eol) + (:indent :expression :eol)) + (setq *indent* (offset-indentation *offset* :resolve t)) + + ;; If cursor is not in an indentation tab, assume user is trying to align + ;; to another block, and just use the resolve code to round it down + (unless (/= (mod *indent* *base-indent*) 0) + ;; else use "previous-line" indentation. + (setq *indent* (offset-indentation *ind-offset* :resolve t))) + (indent-macro-reject-left)) + + ;; This should be second most common exit point; + ;; add one indentation level. + (indreduce :align + (< *ind-offset* *ind-start*) + ((:indent :expression :collon :eol)) + (setq *indent* (+ *base-indent* (offset-indentation *ind-offset* :resolve t))) + (indent-macro-reject-left)) + + (indresolve :align + (setq *indent* (- *indent* (mod *indent* *base-indent*)))) + + ;; Calculate special indentation for [ and { + (indresolve (:obrack :obrace) + (and + (< *ind-offset* *ind-start*) + (setq *indent* (+ *base-indent* + (offset-indentation *ind-offset* :resolve t))))) + (indresolve (:cbrack :cbrace) + (setq *indent* (- (offset-indentation *ind-offset* :resolve t) + (if (>= *ind-offset* *ind-start*) + *base-indent* 0)))) +) + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun python-offset-indent (&aux char (point (point))) + ;; Skip spaces forward + (while (member (setq char (char-after point)) indent-spaces) + (incf point)) + point) + +(compile 'python-offset-indent) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun python-should-indent (options &aux point start end offset) + (when (hash-table-p options) + ;; check if previous line has extra spaces + (and (gethash :trim-blank-lines options) + (indent-clear-empty-line)) + + ;; indentation disabled? + (and (gethash :disable-indent options) + (return-from python-should-indent)) + + (setq + point (point) + start (scan point :eol :left) + end (scan point :eol :right)) + + ;; if at bol and should indent only when starting a line + (and (gethash :only-newline-indent options) + (return-from python-should-indent (= point start))) + + ;; at the start of a line + (and (= point start) + (return-from python-should-indent (gethash :newline-indent options))) + + ;; if first character + (and (= point (1+ start)) + (return-from python-should-indent t)) + + (setq offset start) + (while (and + (< offset end) + (member (char-after offset) indent-spaces)) + (incf offset)) + + ;; cursor is at first character in line, with possible spaces before it + (return-from python-should-indent (or (= offset end) (= offset (1- point)))) + ) + ;; Should not indent + nil) + +(compile 'python-should-indent) + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defun python-indent (syntax syntable) + (let* + ((options (syntax-options syntax)) + *base-indent*) + + (or (python-should-indent options) (return-from python-indent)) + (setq + *base-indent* (gethash :indentation options 4)) + + (indent-macro + *python-mode-indent* + (python-offset-indent) + (gethash :emulate-tabs options)))) + +(compile 'python-indent) + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defvar *python-mode-options* *python-DEFAULT-options*) + + +;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +(defsyntax *python-mode* :main nil #'python-indent *python-mode-options* + ;; keywords + (syntoken + (string-concat + "\\<(" + "and|break|class|continue|def|del|enumerate|except|False|for|" + "elif|else|if|in|is|len|None|not|or|pass|print|raise|range|" + "return|self|True|try|type|while|yield" + ")\\>") + :property *prop-keyword*) + + (syntoken "^\\s+" :property *prop-indent*) + + ;; preprocessor like + (syntoken + (string-concat + "\\<(" + "from|import" + ")\\>") + :property *prop-preprocessor*) + + ;; namespaces/accessors + (syntoken "(\\w+\\.)+" :property *prop-preprocessor*) + + ;; more preprocessor like + (syntoken "\\<__[a-zA-Z0-9]+__\\>" :property *prop-keyword*) + + ;; numbers + (syntoken + (string-concat + "\\<(" + ;; Integers + "(\\d+|0x\\x+)L?|" + ;; Floats + "\\d+\\.?\\d*(e[+-]?\\d+)?" + ")\\>") + :icase t + :property *prop-number*) + + ;; comments + (syntoken "#.*" :property *prop-comment*) + + ;; punctuation + (syntoken "[][(){}+*/%^&<>=.,|!~:-]+" :property *prop-punctuation*) + + ;; constant or constant like + (syntoken "'" :nospec t :property *prop-constant* :begin :constant) + (syntoken "'''" :nospec t :property *prop-constant* :begin :constant3) + + ;; strings + (syntoken "\"" :nospec t :property *prop-string* :begin :string) + (syntoken "\"\"\"" :nospec t :property *prop-string* :begin :string3) + + (syntable :constant *prop-constant* nil + (syntoken "\\\\.") + (syntoken "'" :nospec t :switch -1)) + (syntable :constant3 *prop-constant* nil + (syntoken "'''" :nospec t :switch -1)) + (syntable :string *prop-string* nil + (syntoken "\\\\.") + (syntoken "\"" :nospec t :switch -1)) + (syntable :string3 *prop-string* nil + (syntoken "\"\"\"" :nospec t :switch -1)) +) diff --git a/app/xedit/lisp/modules/xedit.lsp b/app/xedit/lisp/modules/xedit.lsp index fa43d1e62..9b916d58c 100644 --- a/app/xedit/lisp/modules/xedit.lsp +++ b/app/xedit/lisp/modules/xedit.lsp @@ -27,7 +27,7 @@ ;; Author: Paulo César Pereira de Andrade ;; ;; -;; $XdotOrg: app/xedit/lisp/modules/xedit.lsp,v 1.3 2004/12/04 00:43:14 kuhn Exp $ +;; $XdotOrg: xc/programs/xedit/lisp/modules/xedit.lsp,v 1.2 2004/04/23 19:54:45 eich Exp $ ;; $XFree86: xc/programs/xedit/lisp/modules/xedit.lsp,v 1.9 2003/01/16 03:50:46 paulo Exp $ ;; @@ -54,17 +54,25 @@ ;; syntax-p, the entry is removed. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar *auto-modes* '( - ("\\.(c|cc|C|cxx|h|bm|xbm|xpm|l|y)$" + ("\\.(c|cc|C|cxx|cpp|h|hpp|bm|xbm|xpm|y|h\\.in)$" "C/C++" "c" . *c-mode*) - ("\\.(li?sp|scm)$" + ("\\.(l|li?sp|scm)$" "Lisp/Scheme" "lisp" . *lisp-mode*) - ("Imakefile|(\\.(cf|rules|tmpl|def|cpp)$)" - "X imake" "imake" . *imake-mode*) - ("[Mm]akefile.*|\\.mk$" - "Makefile" "make" . *make-mode*) ("\\.sh$" "Unix shell" "sh" . *sh-mode*) - ("\\.sgml?$" + ("\\.(diff|patch)" + "Patch file" "patch" . *patch-mode*) + ("/[Mm]akefile.*|\\.mk$" + "Makefile" "make" . *make-mode*) + ("\\.(ac|in|m4)$" + "Autotools" "auto" . *auto-mode*) + ("\\.spec$" + "RPM spec" "rpm" . *rpm-mode*) + ("\\.(pl|pm|ph)$" + "Perl" "perl" . *perl-mode*) + ("\\.(py)$" + "Python" "python". *python-mode*) + ("\\.(sgml?|dtd)$" "SGML" "sgml" . *sgml-mode*) ("\\.html?$" "HTML" "html" . *html-mode*) @@ -72,14 +80,12 @@ "Man page" "man" . *man-mode*) ("app-defaults/\\w+|\\u[A-Za-z0-9_-]+\\.ad" "X resource" "xrdb" . *xrdb-mode*) - ("\\<XF86Config[^/]*" + ("\\<(XF86Config|xorg.conf)[^/]*" "XF86Config" "xconf" . *xconf-mode*) - ("\\.spec$" - "RPM spec" "rpm" . *rpm-mode*) - ("\\<XFree86\\.\\d+\\.log$" + ("\\<(XFree86|Xorg)\\.\\d+\\.log(\\..*|$)" "XFree86 log" "xlog" . *xlog-mode*) - ("\\.(diff|patch)" - "Patch file" "patch" . *patch-mode*) + ("Imakefile|(\\.(cf|rules|tmpl|def)$)" + "X imake" "imake" . *imake-mode*) )) diff --git a/app/xedit/lisp/package.c b/app/xedit/lisp/package.c index 6ba23c9ee..8b941ecda 100644 --- a/app/xedit/lisp/package.c +++ b/app/xedit/lisp/package.c @@ -87,7 +87,7 @@ LispFindPackage(LispObj *name) return (name); if (SYMBOLP(name)) - string = ATOMID(name); + string = ATOMID(name)->value; else if (STRINGP(name)) string = THESTR(name); else @@ -169,22 +169,18 @@ LispDoExport(LispBuiltin *builtin, if (package == PACKAGE) symbol->data.atom->ext = export ? 1 : 0; else { - int i; - char *string; + Atom_id string; LispAtom *atom; LispPackage *pack; string = ATOMID(symbol); pack = package->data.package.package; - i = STRHASH(string); - atom = pack->atoms[i]; - while (atom) { - if (strcmp(atom->string, string) == 0) { - atom->ext = export ? 1 : 0; - return; - } + atom = (LispAtom *)hash_check(pack->atoms, + string->value, string->length); - atom = atom->next; + if (atom) { + atom->ext = export ? 1 : 0; + return; } LispDestroy("%s: the symbol %s is not available in package %s", @@ -203,9 +199,9 @@ LispDoImport(LispBuiltin *builtin, LispObj *symbol) static LispObj * LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols) { - int i, head = lisp__data.env.length; + int head = lisp__data.env.length; LispPackage *pack = NULL; - LispAtom *atom, *next_atom; + LispAtom *atom; LispObj *variable, *package = NULL, *list, *code, *result_form; LispObj *init, *body; @@ -251,21 +247,17 @@ LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols) } /* Traverse the symbol list, executing body */ - for (i = 0; i < STRTBLSZ; i++) { - atom = pack->atoms[i]; - while (atom) { + for (atom = (LispAtom *)hash_iter_first(pack->atoms); + atom; + atom = (LispAtom *)hash_iter_next(pack->atoms)) { /* Save pointer to next atom. If variable is removed, * predicatable result is only guaranteed if the bound * variable is removed. */ - next_atom = atom->next; - - if (LispDoSymbol(package, atom, only_externs, all_symbols)) { - LispSetVar(variable, atom->object); - for (code = body; CONSP(code); code = CDR(code)) - EVAL(CAR(code)); - } - atom = next_atom; + if (LispDoSymbol(package, atom, only_externs, all_symbols)) { + LispSetVar(variable, atom->object); + for (code = body; CONSP(code); code = CDR(code)) + EVAL(CAR(code)); } } @@ -306,7 +298,6 @@ LispDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols) LispObj * LispFindSymbol(LispBuiltin *builtin, int intern) { - int i; char *ptr; LispAtom *atom; LispObj *symbol; @@ -342,15 +333,9 @@ LispFindSymbol(LispBuiltin *builtin, int intern) return (symbol); } - i = STRHASH(ptr); - atom = pack->atoms[i]; - while (atom) { - if (strcmp(atom->string, ptr) == 0) { - symbol = atom->object; - break; - } - atom = atom->next; - } + atom = (LispAtom *)hash_check(pack->atoms, ptr, strlen(ptr)); + if (atom) + symbol = atom->object; if (symbol == NULL || symbol->data.atom->package == NULL) { RETURN(0) = NIL; @@ -436,46 +421,45 @@ Lisp_FindAllSymbols(LispBuiltin *builtin) LispAtom *atom; LispPackage *pack; LispObj *list, *package, *result; - int i; + int length = 0; LispObj *string_or_symbol; string_or_symbol = ARGUMENT(0); - if (STRINGP(string_or_symbol)) + if (STRINGP(string_or_symbol)) { string = THESTR(string_or_symbol); - else if (SYMBOLP(string_or_symbol)) - string = ATOMID(string_or_symbol); + length = STRLEN(string_or_symbol); + } + else if (SYMBOLP(string_or_symbol)) { + string = ATOMID(string_or_symbol)->value; + length = ATOMID(string_or_symbol)->length; + } else LispDestroy("%s: %s is not a string or symbol", STRFUN(builtin), STROBJ(string_or_symbol)); result = NIL; - i = STRHASH(string); /* Traverse all packages, searching for symbols matching specified string */ for (list = PACK; CONSP(list); list = CDR(list)) { package = CAR(list); pack = package->data.package.package; - atom = pack->atoms[i]; - while (atom) { - if (strcmp(atom->string, string) == 0 && - LispDoSymbol(package, atom, 0, 1)) { - /* Return only one pointer to a matching symbol */ + atom = (LispAtom *)hash_check(pack->atoms, string, length); + if (atom && LispDoSymbol(package, atom, 0, 1)) { + /* Return only one pointer to a matching symbol */ - if (result == NIL) { - result = CONS(atom->object, NIL); - GC_PROTECT(result); - } - else { - /* Put symbols defined first in the - * beginning of the result list */ - RPLACD(result, CONS(CAR(result), CDR(result))); - RPLACA(result, atom->object); - } + if (result == NIL) { + result = CONS(atom->object, NIL); + GC_PROTECT(result); + } + else { + /* Put symbols defined first in the + * beginning of the result list */ + RPLACD(result, CONS(CAR(result), CDR(result))); + RPLACA(result, atom->object); } - atom = atom->next; } } GC_LEAVE(); @@ -651,7 +635,7 @@ Lisp_MakePackage(LispBuiltin *builtin) /* Error checks done, package_name is either a symbol or string */ if (!XSTRINGP(package_name)) - package_name = STRING(ATOMID(package_name)); + package_name = STRING(ATOMID(package_name)->value); GC_PROTECT(package_name); @@ -667,7 +651,7 @@ Lisp_MakePackage(LispBuiltin *builtin) /* Store all nicknames as strings */ package = CAR(list); if (!XSTRINGP(package)) - package = STRING(ATOMID(package)); + package = STRING(ATOMID(package)->value); if (nicks == NIL) { nicks = cons = CONS(package, NIL); GC_PROTECT(nicks); diff --git a/app/xedit/lisp/private.h b/app/xedit/lisp/private.h index b4f683e46..ef44ab235 100644 --- a/app/xedit/lisp/private.h +++ b/app/xedit/lisp/private.h @@ -27,7 +27,7 @@ * Author: Paulo César Pereira de Andrade */ -/* $XdotOrg: app/xedit/lisp/private.h,v 1.3 2004/12/04 00:43:13 kuhn Exp $ */ +/* $XdotOrg: xc/programs/xedit/lisp/private.h,v 1.2 2004/04/23 19:54:44 eich Exp $ */ /* $XFree86: xc/programs/xedit/lisp/private.h,v 1.41 2003/05/27 22:27:04 tsi Exp $ */ #ifndef Lisp_private_h @@ -192,6 +192,9 @@ struct _LispProperty { }; struct _LispAtom { + hash_key *key; + struct _LispAtom *next; + /* hint: dynamically binded variable */ unsigned int dyn : 1; @@ -222,14 +225,12 @@ struct _LispAtom { /* Symbol value is constant, cannot be changed */ unsigned int constant : 1; - char *string; LispObj *object; /* backpointer to object ATOM */ int offset; /* in the environment list */ LispObj *package; /* package home of symbol */ LispObj *function; /* symbol function */ LispObj *name; /* symbol string */ LispProperty *property; - struct _LispAtom *next; LispObj *documentation[5]; }; @@ -243,20 +244,13 @@ struct _LispObjList { struct _LispPackage { LispObjList glb; /* global symbols in package */ LispObjList use; /* inherited packages */ - LispAtom *atoms[STRTBLSZ]; /* atoms in this package */ + hash_table *atoms; /* atoms in this package */ }; struct _LispOpaque { - int type; - char *desc; + hash_key *desc; LispOpaque *next; -}; - -/* These strings are never released, they are used to avoid - * the need of strcmp() on two symbol names, just compare pointers */ -struct _LispStringHash { - char *string; - LispStringHash *next; + int type; }; typedef enum _LispBlockType { @@ -357,8 +351,8 @@ struct _LispMac { int average; /* of cells freed after gc calls */ } gc; - LispStringHash *strings[STRTBLSZ]; - LispOpaque *opqs[STRTBLSZ]; + hash_table *strings; + hash_table *opqs; int opaque; LispObj *standard_input, *input, *input_list; @@ -452,6 +446,7 @@ void LispExportSymbol(LispObj*); void LispImportSymbol(LispObj*); /* always returns the same string */ +hash_key *LispGetAtomKey(char*, int); char *LispGetAtomString(char*, int); /* destructive fast reverse, note that don't receive a LispMac* argument */ @@ -474,8 +469,6 @@ void LispBlockUnwind(LispBlock*); void LispUpdateResults(LispObj*, LispObj*); void LispTopLevel(void); -#define STRHASH(string) LispDoHashString(string) -int LispDoHashString(char*); LispAtom *LispDoGetAtom(char *str, int); /* get value from atom's property list */ LispObj *LispGetAtomProperty(LispAtom*, LispObj*); diff --git a/app/xedit/lisp/re/re.c b/app/xedit/lisp/re/re.c index abf5cc4af..fca7e2856 100644 --- a/app/xedit/lisp/re/re.c +++ b/app/xedit/lisp/re/re.c @@ -782,7 +782,8 @@ next_lcstl:; case Re_AltNext: bas = eng.off - 1; /* Check if matched and if it is a better match */ - if (eng.sv[eng.off] - eng.so[eng.off] < + if (eng.eo[eng.off] >= eng.so[eng.off] && + eng.sv[eng.off] - eng.so[eng.off] < eng.eo[eng.off] - eng.so[eng.off]) eng.sv[eng.off] = eng.eo[eng.off]; diff --git a/app/xedit/lisp/re/tests.c b/app/xedit/lisp/re/tests.c index 6a82d413f..21b1e1028 100644 --- a/app/xedit/lisp/re/tests.c +++ b/app/xedit/lisp/re/tests.c @@ -164,7 +164,7 @@ main(int argc, char *argv[]) else { if (failed) { reerror(failed, &cod, buf, sizeof(buf)); - fprintf(stderr, "%s, at line %d\n", line); + fprintf(stderr, "%s, at line %d\n", buf, line); break; } if (sscanf(buf, "%ld,%ld:", &so, &eo) != 2) { diff --git a/app/xedit/lisp/re/tests.txt b/app/xedit/lisp/re/tests.txt index b8d3e22b3..35fd90bba 100644 --- a/app/xedit/lisp/re/tests.txt +++ b/app/xedit/lisp/re/tests.txt @@ -459,3 +459,12 @@ /.*(\d+)/ :BADRPT + +# Regression fix, was matching empty string +/\\\d{3}|\\./ +>\\ +:NOMATCH + +/\\.|\\\d{3}/ +>\\ +:NOMATCH diff --git a/app/xedit/lisp/read.c b/app/xedit/lisp/read.c index 3c5df3ed1..9c70b6433 100644 --- a/app/xedit/lisp/read.c +++ b/app/xedit/lisp/read.c @@ -1127,6 +1127,13 @@ LispReadObject(int unintern, read_info *info) collon = 1; string[length++] = ch; symbol = string + 1; + ch = LispGet(); + if (ch == '|') { + quote = ch; + unreadable = 1; + } + else if (ch != EOF) + LispUnget(ch); } else if (ch) { if (islower(ch)) @@ -1220,12 +1227,6 @@ LispReadObject(int unintern, read_info *info) else if (quote == '"') object = LSTRING(string, length); - else if (quote == '|' || (unreadable && !collon)) { - /* Set unreadable field, this atom needs quoting to be read back */ - object = ATOM(string); - object->data.atom->unreadable = 1; - } - else if (collon) { /* Package specified in object name */ symbol[-1] = '\0'; @@ -1236,6 +1237,12 @@ LispReadObject(int unintern, read_info *info) read__stream, read__line); } + else if (quote == '|' || (unreadable && !collon)) { + /* Set unreadable field, this atom needs quoting to be read back */ + object = ATOM(string); + object->data.atom->unreadable = 1; + } + /* Check some common symbols */ else if (length == 1 && string[0] == 'T') /* The T */ @@ -1322,7 +1329,7 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable, /* Get the object pointer */ if (pack == lisp__data.key) - object = KEYWORD(LispDoGetAtom(symbol, 0)->string); + object = KEYWORD(LispDoGetAtom(symbol, 0)->key->value); else object = ATOM(symbol); if (unreadable) @@ -1336,19 +1343,11 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable, else { /* Symbol must exist (and be extern) in the specified package */ - int i; LispAtom *atom; - i = STRHASH(symbol); - atom = pack->atoms[i]; - while (atom) { - if (strcmp(atom->string, symbol) == 0) { - object = atom->object; - break; - } - - atom = atom->next; - } + atom = (LispAtom *)hash_check(pack->atoms, symbol, strlen(symbol)); + if (atom) + object = atom->object; /* No object found */ if (object == NULL || object->data.atom->ext == 0) @@ -1875,13 +1874,13 @@ LispReadStruct(read_info *info) GC_PROTECT(fields); - len = strlen(ATOMID(CAR(fields))); + len = ATOMID(CAR(fields))->length; /* MAKE- */ if (len + 6 > sizeof(stk)) str = LispMalloc(len + 6); else str = stk; - sprintf(str, "MAKE-%s", ATOMID(CAR(fields))); + sprintf(str, "MAKE-%s", ATOMID(CAR(fields))->value); RPLACA(fields, ATOM(str)); if (str != stk) LispFree(str); diff --git a/app/xedit/lisp/stream.c b/app/xedit/lisp/stream.c index a43e711bc..aad89cf1c 100644 --- a/app/xedit/lisp/stream.c +++ b/app/xedit/lisp/stream.c @@ -303,7 +303,7 @@ Lisp_Open(LispBuiltin *builtin) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s", - STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type)); + STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type)); } if (if_exists != UNSPEC) { @@ -360,7 +360,7 @@ Lisp_Open(LispBuiltin *builtin) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s", - STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format)); + STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format)); } /* string representation of pathname */ @@ -600,7 +600,7 @@ Lisp_MakeStringOutputStream(LispBuiltin *builtin) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s", - STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type)); + STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type)); } return (LSTRINGSTREAM("", STREAM_WRITE, 1)); @@ -695,7 +695,7 @@ Lisp_MakePipe(LispBuiltin *builtin) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s", - STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type)); + STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type)); } if (external_format != UNSPEC) { @@ -707,7 +707,7 @@ Lisp_MakePipe(LispBuiltin *builtin) ; /* do nothing */ else LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s", - STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format)); + STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format)); } string = THESTR(command_line); diff --git a/app/xedit/lisp/string.c b/app/xedit/lisp/string.c index b5151ece5..604fb6c95 100644 --- a/app/xedit/lisp/string.c +++ b/app/xedit/lisp/string.c @@ -27,7 +27,7 @@ * Author: Paulo César Pereira de Andrade */ -/* $XdotOrg: app/xedit/lisp/string.c,v 1.3 2004/12/04 00:43:13 kuhn Exp $ */ +/* $XdotOrg: xc/programs/xedit/lisp/string.c,v 1.2 2004/04/23 19:54:44 eich Exp $ */ /* $XFree86: xc/programs/xedit/lisp/string.c,v 1.24tsi Exp $ */ #include "lisp/helper.h" diff --git a/app/xedit/lisp/struct.c b/app/xedit/lisp/struct.c index 7fbb4866c..b6ecf140e 100644 --- a/app/xedit/lisp/struct.c +++ b/app/xedit/lisp/struct.c @@ -55,7 +55,7 @@ Lisp_Defstruct(LispBuiltin *builtin) int intern; LispAtom *atom; int i, size, length, slength; - char *name, *strname, *sname; + char *name, *strname; LispObj *list, *cons, *object, *definition, *documentation; LispObj *oname, *description; @@ -65,8 +65,8 @@ Lisp_Defstruct(LispBuiltin *builtin) CHECK_SYMBOL(oname); - strname = ATOMID(oname); - length = strlen(strname); + strname = ATOMID(oname)->value; + length = ATOMID(oname)->length; /* MAKE- */ size = length + 6; @@ -101,13 +101,13 @@ Lisp_Defstruct(LispBuiltin *builtin) cons = object; object = CAR(object); } - if (!SYMBOLP(object) || strcmp(ATOMID(object), "P") == 0) + if (!SYMBOLP(object) || strcmp(ATOMID(object)->value, "P") == 0) /* p is invalid as a field name due to `type'-p */ LispDestroy("%s: %s cannot be a field for %s", - STRFUN(builtin), STROBJ(object), ATOMID(oname)); + STRFUN(builtin), STROBJ(object), ATOMID(oname)->value); if (!KEYWORDP(object)) - CAR(cons) = KEYWORD(ATOMID(object)); + CAR(cons) = KEYWORD(ATOMID(object)->value); /* check for repeated field names */ for (object = description; object != list; object = CDR(object)) { @@ -143,16 +143,18 @@ Lisp_Defstruct(LispBuiltin *builtin) LispExportSymbol(object); for (i = 0, list = description; CONSP(list); i++, list = CDR(list)) { + Atom_id id; + if (CONSP(CAR(list))) - sname = ATOMID(CAR(CAR(list))); + id = ATOMID(CAR(CAR(list))); else - sname = ATOMID(CAR(list)); - slength = strlen(sname); + id = ATOMID(CAR(list)); + slength = id->length; if (length + slength + 2 > size) { size = length + slength + 2; name = LispRealloc(name, size); } - sprintf(name, "%s-%s", strname, sname); + sprintf(name, "%s-%s", strname, id->value); atom = (object = ATOM(name))->data.atom; LispSetAtomStructProperty(atom, definition, i); if (!intern) @@ -202,7 +204,7 @@ Lisp_XeditMakeStruct(LispBuiltin *builtin) CHECK_KEYWORD(CAR(list)); if (!CONSP(CDR(list))) LispDestroy("%s: values must be provided as pairs", - ATOMID(struc)); + ATOMID(struc)->value); nfld++; list = CDR(list); } @@ -272,8 +274,8 @@ Lisp_XeditMakeStruct(LispBuiltin *builtin) } if (!CONSP(object)) LispDestroy("%s: %s is not a field for %s", - ATOMID(struc), STROBJ(CAR(list)), - ATOMID(CAR(definition))); + ATOMID(struc)->value, STROBJ(CAR(list)), + ATOMID(CAR(definition))->value); list = CDR(list); } } @@ -316,7 +318,7 @@ LispStructAccessOrStore(LispBuiltin *builtin, int store) /* check if the object is of the required type */ if (!STRUCTP(struc) || struc->data.struc.def != definition) LispDestroy("%s: %s is not a %s", - ATOMID(name), STROBJ(struc), ATOMID(CAR(definition))); + ATOMID(name)->value, STROBJ(struc), ATOMID(CAR(definition))->value); for (list = struc->data.struc.fields; offset; list = CDR(list), offset--) ; diff --git a/app/xedit/lisp/test/regex.lsp b/app/xedit/lisp/test/regex.lsp index fa6b2feb7..9e28efaa7 100644 --- a/app/xedit/lisp/test/regex.lsp +++ b/app/xedit/lisp/test/regex.lsp @@ -438,3 +438,14 @@ foo" :notbol t :noteol t) (setq re (re-comp "(.*a)?")) (re-test '((0 . 1)) re "aaaa") ; expected, minimal match (re-test '((0 . 1) (0 . 1)) re "aaaa" :count 2) + + +;; Tue Dec 11 22:22:51 BRST 2007 Fix a regression with the pattern below +;; returning a match to an empty string. +;; Note that inverting the order of the "alternatives" works with the +;; versions of libre prior to this (one line) fix +(setq re (re-comp "\\\\\\d{3}|\\\\.")) +(re-test :nomatch re "\\") +;; previous version should work with the pattern inverted +(setq re (re-comp "\\\\.|\\\\\\d{3}")) +(re-test :nomatch re "\\") diff --git a/app/xedit/lisp/write.c b/app/xedit/lisp/write.c index c5d7f24a8..6c7d979c0 100644 --- a/app/xedit/lisp/write.c +++ b/app/xedit/lisp/write.c @@ -522,15 +522,15 @@ LispPrintCircle(LispObj *stream, LispObj *object, long circle, static int LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) { - char *name; + Atom_id name; int i, length = 0, need_space = 0; #define WRITE_ATOM(object) \ name = ATOMID(object); \ - length += LispDoWriteAtom(stream, name, strlen(name), \ + length += LispDoWriteAtom(stream, name->value, name->length, \ info->print_case) -#define WRITE_STRING(string) \ - length += LispDoWriteAtom(stream, string, strlen(string), \ +#define WRITE_ATOMID(atomid) \ + length += LispDoWriteAtom(stream, atomid->value, atomid->length, \ info->print_case) #define WRITE_OBJECT(object) \ length += LispDoWriteObject(stream, object, info, 1) @@ -552,7 +552,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) if (alist->optionals.num_symbols) { if (need_space) WRITE_SPACE(); - WRITE_STRING(Soptional); + WRITE_ATOMID(Soptional); WRITE_SPACE(); for (i = 0; i < alist->optionals.num_symbols; i++) { WRITE_OPAREN(); @@ -572,7 +572,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) if (alist->keys.num_symbols) { if (need_space) WRITE_SPACE(); - length += LispDoWriteAtom(stream, Skey, 4, info->print_case); + length += LispDoWriteAtom(stream, Skey->value, 4, info->print_case); WRITE_SPACE(); for (i = 0; i < alist->keys.num_symbols; i++) { WRITE_OPAREN(); @@ -599,7 +599,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) if (alist->rest) { if (need_space) WRITE_SPACE(); - WRITE_STRING(Srest); + WRITE_ATOMID(Srest); WRITE_SPACE(); WRITE_ATOM(alist->rest); need_space = 1; @@ -607,7 +607,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) if (alist->auxs.num_symbols) { if (need_space) WRITE_SPACE(); - WRITE_STRING(Saux); + WRITE_ATOMID(Saux); WRITE_SPACE(); for (i = 0; i < alist->auxs.num_symbols; i++) { WRITE_OPAREN(); @@ -622,7 +622,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info) WRITE_CPAREN(); #undef WRITE_ATOM -#undef WRITE_STRING +#undef WRITE_ATOMID #undef WRITE_OBJECT #undef WRITE_OPAREN #undef WRITE_SPACE @@ -867,9 +867,9 @@ write_again: switch (OBJECT_TYPE(object)) { case LispNil_t: if (object == NIL) - string = Snil; + string = Snil->value; else if (object == T) - string = St; + string = St->value; else if (object == DOT) string = "#<DOT>"; else if (object == UNSPEC) @@ -1017,7 +1017,7 @@ write_again: ->data.atom->property->alist, info); } else { - length += LispDoWriteAtom(stream, Snil, 3, info->print_case); + length += LispDoWriteAtom(stream, "NIL", 3, info->print_case); length += LispWriteChar(stream, ' '); length += LispWriteAlist(stream, (LispArgList*)object-> data.lambda.name->data.opaque.data, @@ -1264,7 +1264,7 @@ LispWriteAtom(LispObj *stream, LispObj *object, write_info *info) { int length = 0; LispAtom *atom = object->data.atom; - Atom_id id = atom->string; + Atom_id id = atom->key; if (atom->package != PACKAGE) { if (atom->package == lisp__data.keyword) @@ -1299,7 +1299,7 @@ LispWriteAtom(LispObj *stream, LispObj *object, write_info *info) } if (atom->unreadable) length += LispWriteChar(stream, '|'); - length += LispDoWriteAtom(stream, id, strlen(id), + length += LispDoWriteAtom(stream, id->value, id->length, atom->unreadable ? UPCASE : info->print_case); if (atom->unreadable) length += LispWriteChar(stream, '|'); |