diff options
Diffstat (limited to 'lisp/xedit.c')
| -rw-r--r-- | lisp/xedit.c | 1636 |
1 files changed, 1636 insertions, 0 deletions
diff --git a/lisp/xedit.c b/lisp/xedit.c new file mode 100644 index 0000000..9ef7f8f --- /dev/null +++ b/lisp/xedit.c @@ -0,0 +1,1636 @@ +/* + * Copyright (c) 2002 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/xedit.c,v 1.24 2003/01/13 03:57:59 paulo Exp $ */ + +#include "../xedit.h" +#include <X11/Xaw/TextSrcP.h> /* Needs some private definitions */ +#include <X11/Xaw/TextSinkP.h> /* Also needs private definitions... */ +#include <X11/Xmu/Xmu.h> +#define XEDIT_LISP_PRIVATE +#include "xedit.h" +#include <signal.h> + +/* Initialize to enter lisp */ +#define LISP_SETUP() \ + int lisp__running = lisp__data.running + +/* XXX Maybe should use ualarm or better, setitimer, but one + * second seens good enough to check for interrupts */ + +#define ENABLE_SIGALRM() \ + old_sigalrm = signal(SIGALRM, SigalrmHandler); \ + alarm(1) + +#define DISABLE_SIGALRM() \ + alarm(0); \ + signal(SIGALRM, old_sigalrm) + +/* Enter lisp */ +#define LISP_ENTER() \ + if (!lisp__running) { \ + lisp__data.running = 1; \ + XFlush(XtDisplay(textwindow)); \ + ENABLE_SIGALRM(); \ + if (sigsetjmp(lisp__data.jmp, 1) != 0) { \ + DISABLE_SIGALRM(); \ + lisp__data.running = 0; \ + return; \ + } \ + } + +/* Leave lisp */ +#define LISP_LEAVE() \ + if (!lisp__running) { \ + DISABLE_SIGALRM(); \ + LispTopLevel(); \ + lisp__data.running = 0; \ + } + +/* + * Types + */ +typedef struct { + XawTextPosition left, right; + XrmQuark property; +} EntityInfo; + +/* + * Prototypes + */ +static Bool ControlGPredicate(Display*, XEvent*, XPointer); +static ssize_t WriteToStdout(int, const void*, size_t); +static ssize_t WriteToStderr(int, const void*, size_t); +static ssize_t WrapWrite(Widget, const void*, size_t); +static void XeditUpdateModeInfos(void); +static void XeditPrint(Widget, LispObj*, int); +static void XeditInteractiveCallback(Widget, XtPointer, XtPointer); +static void XeditIndentationCallback(Widget, XtPointer, XtPointer); +static LispObj *XeditCharAt(LispBuiltin*, int); +static LispObj *XeditSearch(LispBuiltin*, XawTextScanDirection); + +/* + * Initialization + */ +#ifdef SIGNALRETURNSINT +static int (*old_sigalrm)(int); +#else +static void (*old_sigalrm)(int); +#endif + +EditModeInfo *mode_infos; +Cardinal num_mode_infos; + +static LispObj *Oauto_modes, *Oauto_mode, *Osyntax_highlight, *Osyntable_indent; + +/* Just to make calling interactive reparse easier */ +static LispObj interactive_arguments[4]; + +static LispObj *justify_modes[4]; +static LispObj *wrap_modes[3]; +static LispObj *scan_types[5]; +static LispObj *scan_directions[2]; +static LispObj execute_stream; +static LispString execute_string; +static LispObj result_stream; +static LispString result_string; +static XawTextPropertyList **property_lists; +static Cardinal num_property_lists; + +/* Some hacks to (at lest try to) avoid problems reentering Xlib while + * testing for user interrupts */ +static volatile int disable_timeout, request_timeout; + +extern int pagesize; + +static LispBuiltin xeditbuiltins[] = { + {LispFunction, Xedit_AddEntity, "add-entity offset length identifier"}, + {LispFunction, Xedit_AutoFill, "auto-fill &optional value"}, + {LispFunction, Xedit_Background, "background &optional color"}, + {LispFunction, Xedit_CharAfter, "char-after &optional offset"}, + {LispFunction, Xedit_CharBefore, "char-before &optional offset"}, + {LispFunction, Xedit_ClearEntities, "clear-entities left right"}, + {LispFunction, Xedit_ConvertPropertyList, "convert-property-list name definition"}, + {LispFunction, Xedit_Font, "font &optional font"}, + {LispFunction, Xedit_Foreground, "foreground &optional color"}, + {LispFunction, Xedit_GotoChar, "goto-char offset"}, + {LispFunction, Xedit_HorizontalScrollbar, "horizontal-scrollbar &optional state"}, + {LispFunction, Xedit_Insert, "insert text"}, + {LispFunction, Xedit_Justification, "justification &optional value"}, + {LispFunction, Xedit_LeftColumn, "left-column &optional left"}, + {LispFunction, Xedit_Point, "point"}, + {LispFunction, Xedit_PointMax, "point-max"}, + {LispFunction, Xedit_PointMin, "point-min"}, + {LispFunction, Xedit_PropertyList, "property-list &optional value"}, + {LispFunction, Xedit_ReadText, "read-text offset length"}, + {LispFunction, Xedit_ReplaceText, "replace-text left right text"}, + {LispFunction, Xedit_RightColumn, "right-column &optional right"}, + {LispFunction, Xedit_Scan, "scan offset type direction &key count include"}, + {LispFunction, Xedit_SearchBackward, "search-backward string &optional offset ignore-case"}, + {LispFunction, Xedit_SearchForward, "search-forward string &optional offset ignore-case"}, + {LispFunction, Xedit_VerticalScrollbar, "vertical-scrollbar &optional state"}, + {LispFunction, Xedit_WrapMode, "wrap-mode &optional value"}, + + /* This should be available from elsewhere at some time... */ + {LispFunction, Xedit_XrmStringToQuark, "xrm-string-to-quark string"}, +}; + +/* + * Implementation + */ +/*ARGUSED*/ +static Bool +ControlGPredicate(Display *display, XEvent *event, XPointer arguments) +{ + char buffer[2]; + + return ((event->type == KeyPress || event->type == KeyRelease) && + (event->xkey.state & ControlMask) && + XLookupString(&(event->xkey), buffer, sizeof(buffer), NULL, NULL) && + buffer[0] == '\a'); +} + +/*ARGSUSED*/ +static +#ifdef SIGNALRETURNSINT +int +#else +void +#endif +SigalrmHandler(int signum) +{ + XEvent event; + + if (disable_timeout) { + request_timeout = 1; + return; + } + + /* Check if user pressed C-g */ + if (XCheckIfEvent(XtDisplay(textwindow), &event, ControlGPredicate, NULL)) { + XPutBackEvent(XtDisplay(textwindow), &event); + alarm(0); + /* Tell a signal was received, print message for SIGINT */ + LispSignal(SIGINT); + } + else + alarm(1); +#ifdef SIGNALRETURNSINT + return (0); +#endif +} + +static ssize_t +WrapWrite(Widget output, const void *buffer, size_t nbytes) +{ + XawTextBlock block; + XawTextPosition position; + + disable_timeout = 1; + position = XawTextGetInsertionPoint(output); + block.firstPos = 0; + block.format = FMT8BIT; + block.length = nbytes; + block.ptr = (String)buffer; + XawTextReplace(output, position, position, &block); + XawTextSetInsertionPoint(output, position + block.length); + disable_timeout = 0; + + if (request_timeout) { + XFlush(XtDisplay(output)); + request_timeout = 0; + SigalrmHandler(SIGALRM); + } + + return ((ssize_t)nbytes); +} + +static ssize_t +WriteToStdout(int fd, const void *buffer, size_t nbytes) +{ + return (WrapWrite(textwindow, buffer, nbytes)); +} + +static ssize_t +WriteToStderr(int fd, const void *buffer, size_t nbytes) +{ + return (WrapWrite(messwidget, buffer, nbytes)); +} + +void +LispXeditInitialize(void) +{ + int i; + char *string; + LispObj *xedit, *list, *savepackage; + + LispSetFileWrite(Stdout, WriteToStdout); + LispSetFileWrite(Stderr, WriteToStderr); + + justify_modes[0] = KEYWORD("LEFT"); + justify_modes[1] = KEYWORD("RIGHT"); + justify_modes[2] = KEYWORD("CENTER"); + justify_modes[3] = KEYWORD("FULL"); + + wrap_modes[0] = KEYWORD("NEVER"); + wrap_modes[1] = KEYWORD("LINE"); + wrap_modes[2] = KEYWORD("WORD"); + + scan_types[0] = KEYWORD("POSITIONS"); + scan_types[1] = KEYWORD("WHITE-SPACE"); + scan_types[2] = KEYWORD("EOL"); + scan_types[3] = KEYWORD("PARAGRAPH"); + scan_types[4] = KEYWORD("ALL"); + scan_types[5] = KEYWORD("ALPHA-NUMERIC"); + + scan_directions[0] = justify_modes[0]; + scan_directions[1] = justify_modes[1]; + + /* Remember value of current package */ + savepackage = PACKAGE; + + /* Create the XEDIT package */ + xedit = LispNewPackage(STRING("XEDIT"), NIL); + + /* Update list of packages */ + PACK = CONS(xedit, PACK); + + /* Temporarily switch to the XEDIT package */ + lisp__data.pack = lisp__data.savepack = xedit->data.package.package; + PACKAGE = xedit; + + /* Add XEDIT builtin functions */ + for (i = 0; i < sizeof(xeditbuiltins) / sizeof(xeditbuiltins[0]); i++) + LispAddBuiltinFunction(&xeditbuiltins[i]); + + /* Create these objects in the xedit package */ + Oauto_modes = STATIC_ATOM("*AUTO-MODES*"); + Oauto_mode = STATIC_ATOM("AUTO-MODE"); + Osyntax_highlight = STATIC_ATOM("SYNTAX-HIGHLIGHT"); + Osyntable_indent = STATIC_ATOM("SYNTABLE-INDENT"); + + /* Import symbols from the LISP and EXT packages */ + for (list = PACK; CONSP(list); list = CDR(list)) { + string = THESTR(CAR(list)->data.package.name); + if (strcmp(string, "LISP") == 0 || strcmp(string, "EXT") == 0) + LispUsePackage(CAR(list)); + } + + /* Restore previous package */ + lisp__data.pack = savepackage->data.package.package; + PACKAGE = savepackage; + + /* Initialize helper static objects used when executing expressions */ + execute_stream.type = LispStream_t; + execute_stream.data.stream.source.string = &execute_string; + execute_stream.data.stream.pathname = NIL; + execute_stream.data.stream.type = LispStreamString; + execute_stream.data.stream.readable = 1; + execute_stream.data.stream.writable = 0; + execute_string.output = 0; + result_stream.type = LispStream_t; + result_stream.data.stream.source.string = &result_string; + result_stream.data.stream.pathname = NIL; + result_stream.data.stream.type = LispStreamString; + result_stream.data.stream.readable = 0; + result_stream.data.stream.writable = 1; + result_string.string = XtMalloc(pagesize); + result_string.space = pagesize; + + /* Initialize interactive edition function arguments */ + /* first argument is syntax table */ + interactive_arguments[0].type = LispCons_t; + interactive_arguments[0].data.cons.cdr = &interactive_arguments[1]; + /* second argument is where to start reparsing */ + interactive_arguments[1].type = LispCons_t; + interactive_arguments[1].data.cons.cdr = &interactive_arguments[2]; + /* third argument is where to stop reparsing */ + interactive_arguments[2].type = LispCons_t; + interactive_arguments[2].data.cons.cdr = &interactive_arguments[3]; + /* fourth argument is interactive flag */ + interactive_arguments[3].type = LispCons_t; + interactive_arguments[3].data.cons.car = T; + interactive_arguments[3].data.cons.cdr = NIL; + + /* Load extra functions and data type definitions */ + EXECUTE("(require \"xedit\")"); + + + /* + * This assumes that the *auto-modes* variable is a list where every + * item has the format: + * (regexp string-desc load-file-desc . symbol-name) + * Minimal error checking is done. + */ + + if (Oauto_modes->data.atom->a_object) { + LispObj *desc, *modes = Oauto_modes->data.atom->property->value; + + for (; CONSP(modes); modes = CDR(modes)) { + list = CAR(modes); + + desc = NIL; + for (i = 0; i < 3 && CONSP(list); i++, list = CDR(list)) { + if (i == 1) + desc = CAR(list); + } + if (i == 3 && STRINGP(desc)) { + mode_infos = (EditModeInfo*) + XtRealloc((XtPointer)mode_infos, sizeof(EditModeInfo) * + (num_mode_infos + 1)); + mode_infos[num_mode_infos].desc = XtNewString(THESTR(desc)); + mode_infos[num_mode_infos].symbol = list; + mode_infos[num_mode_infos].syntax = NULL; + ++num_mode_infos; + } + } + } +} + +static void +XeditUpdateModeInfos(void) +{ + int i; + + for (i = 0; i < num_mode_infos; i++) { + if (mode_infos[i].symbol && + mode_infos[i].syntax == NULL && + XSYMBOLP(mode_infos[i].symbol) && + mode_infos[i].symbol->data.atom->a_object) + mode_infos[i].syntax = + mode_infos[i].symbol->data.atom->property->value; + } +} + +void +XeditLispExecute(Widget output, XawTextPosition left, XawTextPosition right) +{ + GC_ENTER(); + LISP_SETUP(); + int alloced, return_count; + XawTextBlock block; + XawTextPosition position; + char *string, *ptr; + LispObj *result, *code, *_cod, *returns; + + LISP_ENTER(); + + position = left; + XawTextSourceRead(XawTextGetSource(textwindow), left, &block, right - left); + if (block.length < right - left) { + alloced = 1; + string = ptr = LispMalloc(right - left); + memcpy(ptr, block.ptr, block.length); + position = left + block.length; + ptr += block.length; + for (; position < right;) { + XawTextSourceRead(XawTextGetSource(textwindow), + position, &block, right - position); + memcpy(ptr, block.ptr, block.length); + position += block.length; + ptr += block.length; + } + } + else { + alloced = 0; + string = block.ptr; + } + + execute_string.string = string; + execute_string.length = right - left; + execute_string.input = 0; + LispPushInput(&execute_stream); + _cod = COD; + result = NIL; + if ((code = LispRead()) != NULL) + result = EVAL(code); + COD = _cod; + LispPopInput(&execute_stream); + + returns = NIL; + if (RETURN_COUNT > 0) { + GC_PROTECT(result); + returns = _cod = CONS(RETURN(0), NIL); + GC_PROTECT(returns); + for (return_count = 1; return_count < RETURN_COUNT; return_count++) { + RPLACD(_cod, CONS(RETURN(return_count), NIL)); + _cod = CDR(_cod); + } + } + LispFflush(Stdout); + LispUpdateResults(code, result); + if (RETURN_COUNT >= 0) { + XeditPrint(output, result, 1); + for (; CONSP(returns); returns = CDR(returns)) + XeditPrint(output, CAR(returns), 0); + } + + if (alloced) + LispFree(string); + GC_LEAVE(); + + LISP_LEAVE(); +} + +static void +XeditPrint(Widget output, LispObj *object, int newline) +{ + XawTextBlock block; + XawTextPosition position; + + result_string.length = result_string.output = 0; + if (newline) { + position = XawTextGetInsertionPoint(output); + if (position != XawTextSourceScan(XawTextGetSource(output), + position, XawstEOL, + XawsdLeft, 1, False)) + LispSputc(&result_string, '\n'); + } + LispWriteObject(&result_stream, object); + LispSputc(&result_string, '\n'); + + position = XawTextGetInsertionPoint(output); + block.firstPos = 0; + block.format = FMT8BIT; + block.length = result_string.length; + block.ptr = result_string.string; + XawTextReplace(output, position, position, &block); + XawTextSetInsertionPoint(output, position + block.length); +} + +/* + * This function is defined here to avoid exporting all the lisp interfaces + * to the core xedit code. + */ +void +XeditLispSetEditMode(xedit_flist_item *item, LispObj *symbol) +{ + GC_ENTER(); + LISP_SETUP(); + LispObj *syntax, *name; + + item->xldata = (XeditLispData*)XtCalloc(1, sizeof(XeditLispData)); + + LISP_ENTER(); + + /* Create an object that represents the buffer filename. + * Note that the entire path is passed to the auto-mode + * function, so that directory names may be also be used + * when determining a file type. */ + name = STRING(item->filename); + GC_PROTECT(name); + + /* Call the AUTO-MODE function to check if there is a + * syntax definition for the file being loaded */ + if (symbol == NULL) + syntax = APPLY1(Oauto_mode, name); + else + syntax = APPLY2(Oauto_mode, name, symbol); + + /* Don't need the name object anymore */ + GC_LEAVE(); + + if (syntax != NIL) { + Arg arg[1]; + LispObj arguments; + XawTextPropertyList *property_list; + + item->xldata->syntax = syntax; + + /* Apply the syntax highlight to the current buffer */ + arguments.type = LispCons_t; + arguments.data.cons.car = syntax; + arguments.data.cons.cdr = NIL; + LispFuncall(Osyntax_highlight, &arguments, 1); + + /* The previous call added the property list to the widget, + * remember it when switching sources. */ + XtSetArg(arg[0], XawNtextProperties, &property_list); + XtGetValues(XawTextGetSink(textwindow), arg, 1); + item->properties = property_list; + + /* Add callback for interactive changes */ + XtAddCallback(item->source, XtNpropertyCallback, + XeditInteractiveCallback, item->xldata); + + /* Update information as a new file may have been loaded */ + XeditUpdateModeInfos(); + } + else + item->properties = NULL; + + LISP_LEAVE(); +} + +void +XeditLispUnsetEditMode(xedit_flist_item *item) +{ + if (item->xldata) { + XtRemoveCallback(item->source, XtNpropertyCallback, + XeditInteractiveCallback, item->xldata); + XtFree((XtPointer)item->xldata); + item->xldata = NULL; + } +} + +#define MAX_INFOS 32 +/* + * This callback tries to do it's best in generating correct output while + * also doing minimal work/redrawing of the screen. It probably will fail + * for some syntax-definitions, or will just not properly repaint the + * screen. In the later case, just press Ctrl+L. + * There isn't yet any command to force reparsing of some regions, and if + * the parser becomes confused, you may need to go to a line, press a space + * and undo, just to force it to reparse the line, and possibly some extra + * lines until the parser thinks the display is in sync. + * Sometimes it will repaint a lot more of text than what is being requested + * by this callback, this should be fixed at some time, as for certain cases + * it is also required some redesign in the Xaw interface. + */ +static void +XeditInteractiveCallback(Widget w, XtPointer client_data, XtPointer call_data) +{ + LISP_SETUP(); + XeditLispData *data = (XeditLispData*)client_data; + LispObj *syntax = data->syntax; + XawTextPropertyInfo *info = (XawTextPropertyInfo*)call_data; + LispObj *result, *syntable; + XawTextAnchor *anchor; + XawTextEntity *entity; + XawTextPosition first, last, left, right, begin, next, tmp, position; + int i, j, indent; + TextSrcObject src = (TextSrcObject)w; + EntityInfo oinfo[MAX_INFOS], ninfo[MAX_INFOS]; + XrmQuark props[MAX_INFOS]; + int num_oinfo, num_ninfo, num_props; + XmuScanline *clip, *oclip, *nclip; + XmuSegment segment, *seg; + + if (data->disable_highlight) + return; + + LISP_ENTER(); + + first = XawTextSourceScan(w, 0, XawstAll, XawsdLeft, 1, True); + last = XawTextSourceScan(w, 0, XawstAll, XawsdRight, 1, True); + + left = info->left; + right = left + info->block->length; + + /* For now, only call the indent hook if a single character was typed */ + indent = (info->right == left) && (right == left + 1); + + /* Always reparse full lines */ + left = begin = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, False); + right = next = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 1, False); + + + /* Check properties in the modified text. If a complex nested syntax + * table was parsed, the newline has it's default property, so, while + * the newline has a property, backup a line to make sure everything is + * properly parsed. + * Maybe should limit the number of backuped lines, but if the parsing + * becomes noticeable slow, better to rethink the syntax definition. */ + while (left > first) { + position = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, True); + if (XawTextSourceAnchorAndEntity(w, position, &anchor, &entity)) + left = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 2, False); + else + break; + } + + /* While the newline after the right position has a "hidden" property, + * keep incrementing a line to be reparsed. */ + while (right < last) { + if (XawTextSourceAnchorAndEntity(w, right, &anchor, &entity)) + right = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 2, False); + else + break; + } + +#ifndef MAX +#define MAX(a, b) ((a) > (b) ? (a) : (b)) +#endif + +#ifndef MIN +#define MIN(a, b) ((a) < (b) ? (a) : (b)) +#endif + +#define STORE_STATE(count, info, from, to) \ + (count) = 0; \ + if ((anchor = XawTextSourceFindAnchor(w, (from))) != NULL) { \ + entity = anchor->entities; \ + /* Find first entity in the region to parse */ \ + while (entity && \ + anchor->position + entity->offset + entity->length <= \ + (from)) \ + entity = entity->next; \ + /* Loop storing information */ \ + while (entity && \ + (position = anchor->position + entity->offset) < (to)) { \ + (info)[(count)].left = MAX(position, (from)); \ + position += entity->length; \ + (info)[(count)].right = MIN(position, (to)); \ + (info)[(count)].property = entity->property; \ + /* If the changes are so complex, user need press Ctrl+L */ \ + if (++(count) >= MAX_INFOS) \ + break; \ + if ((entity = entity->next) == NULL && \ + (anchor = XawTextSourceNextAnchor(w, anchor)) != NULL) \ + entity = anchor->entities; \ + } \ + } + + /* Remember old state */ + STORE_STATE(num_oinfo, oinfo, begin, right); + + /* Reparse the lines in the modified/edited range of text */ + interactive_arguments[0].data.cons.car = syntax; + interactive_arguments[1].data.cons.car = FIXNUM(left); + interactive_arguments[2].data.cons.car = FIXNUM(right); + result = APPLY(Osyntax_highlight, &interactive_arguments[0]); + /* Indent table is the second return value */ + if (RETURN_COUNT) + syntable = RETURN(0); + else + syntable = NIL; + + /* This normally is the same value as right, but the parser may have + * continued when the syntax table stack did not finish. */ + if (FIXNUMP(result)) + right = FIXNUM_VALUE(result); + + LISP_LEAVE(); + + /* Check what have changed */ + STORE_STATE(num_ninfo, ninfo, begin, right); + + /* Initialize to redraw everything. */ + clip = XmuNewScanline(0, begin, right); + +#define CLIP_MASK(mask, from, to) \ + if ((from) < (to)) { \ + segment.x1 = (from); \ + segment.x2 = (to); \ + XmuScanlineOrSegment((mask), &segment); \ + } + + oclip = XmuNewScanline(0, 0, 0); + nclip = XmuNewScanline(0, 0, 0); + +#define CLIP_DEFAULT(mask, from, info, num_info) \ + for (tmp = (from), i = 0; i < (num_info); i++) { \ + CLIP_MASK((mask), tmp, (info)[i].left); \ + tmp = (info)[i].right; \ + } + + /* First generate masks of regions with the default property */ + CLIP_DEFAULT(oclip, begin, oinfo, num_oinfo); + CLIP_DEFAULT(nclip, begin, ninfo, num_ninfo); + + /* Store unchanged region in oclip */ + XmuScanlineAnd(oclip, nclip); + + /* Don't need to redraw the region in oclip */ + XmuScanlineXor(clip, oclip); + +#define LIST_PROPERTIES(prop, num_prop, info, num_info) \ + (num_prop) = 0; \ + for (i = 0; i < (num_info); i++) { \ + for (j = 0; j < (num_prop); j++) \ + if ((prop)[j] == (info)[i].property) \ + break; \ + if (j == (num_prop)) \ + (prop)[(num_prop)++] = (info)[i].property; \ + } + + /* Prepare to generate masks of regions of text with defined properties */ + LIST_PROPERTIES(props, num_props, oinfo, num_oinfo); + +#define CLIP_PROPERTY(mask, prop, info, num_info) \ + for (j = 0; j < (num_info); j++) { \ + if ((info)[j].property == (prop)) { \ + CLIP_MASK((mask), (info)[j].left, (info)[j].right); \ + } \ + } + + /* Only care about the old properties, new ones need to be redrawn */ + for (i = 0; i < num_props; i++) { + XrmQuark property = props[i]; + + /* Reset oclip and nclip */ + XmuScanlineXor(oclip, oclip); + XmuScanlineXor(nclip, nclip); + + /* Generate masks */ + CLIP_PROPERTY(oclip, property, oinfo, num_oinfo); + CLIP_PROPERTY(nclip, property, ninfo, num_ninfo); + + /* Store unchanged region in oclip */ + XmuScanlineAnd(oclip, nclip); + + /* Don't need to redraw the region in oclip */ + XmuScanlineXor(clip, oclip); + XmuOptimizeScanline(clip); + } + + XmuDestroyScanline(oclip); + XmuDestroyScanline(nclip); + + /* Tell Xaw that need update some regions */ + for (seg = clip->segment; seg; seg = seg->next) { + for (i = 0; i < src->textSrc.num_text; i++) + /* This really should have an exported interface... */ + _XawTextNeedsUpdating((TextWidget)(src->textSrc.text[i]), + seg->x1, seg->x2 + (seg->x2 > next)); + } + XmuDestroyScanline(clip); + + data->syntable = syntable; + /* XXX check lisp__running to know if at the toplevel parsing state */ + if (indent && syntable != NIL && !lisp__running && + /* Doing an undo, probably will need an exported interface for this + * case. Should not change the text now. */ + (!src->textSrc.enable_undo || !src->textSrc.undo_state)) + XtAddCallback(textwindow, XtNpositionCallback, + XeditIndentationCallback, data); +} + +/* + * This callback is called if the syntax table where the cursor is located + * defines an indentation function. + */ +static void +XeditIndentationCallback(Widget w, XtPointer client_data, XtPointer call_data) +{ + LISP_SETUP(); + LispObj *indentp; + XeditLispData *data = (XeditLispData*)client_data; + + data->disable_highlight = True; + XtRemoveCallback(w, XtNpositionCallback, XeditIndentationCallback, data); + + LISP_ENTER(); + + /* Get pointer to indentation function */ + indentp = APPLY1(Osyntable_indent, data->syntable); + + /* Execute indentation function */ + if (indentp != NIL) + APPLY2(indentp, data->syntax, data->syntable); + + data->disable_highlight = False; + + LISP_LEAVE(); +} + +/************************************************************************ + * Builtin functions + ************************************************************************/ +LispObj * +Xedit_AddEntity(LispBuiltin *builtin) +/* + add-entity offset length identifier + */ +{ + LispObj *offset, *length, *identifier; + + identifier = ARGUMENT(2); + length = ARGUMENT(1); + offset = ARGUMENT(0); + + CHECK_INDEX(offset); + CHECK_INDEX(length); + CHECK_LONGINT(identifier); + + return (XawTextSourceAddEntity(XawTextGetSource(textwindow), 0, 0, NULL, + FIXNUM_VALUE(offset), FIXNUM_VALUE(length), + LONGINT_VALUE(identifier)) ? T : NIL); +} + +LispObj * +Xedit_AutoFill(LispBuiltin *builtin) +/* + auto-fill &optional value + */ +{ + Arg arg[1]; + Boolean state; + + LispObj *value; + + value = ARGUMENT(0); + + if (value != UNSPEC) { + XtSetArg(arg[0], XtNautoFill, value == NIL ? False : True); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNautoFill, &state); + XtGetValues(textwindow, arg, 1); + value = state ? T : NIL; + } + + return (value); +} + +LispObj * +Xedit_Background(LispBuiltin *builtin) +/* + background &optional color + */ +{ + Pixel pixel; + Arg arg[1]; + XrmValue from, to; + + LispObj *color; + + color = ARGUMENT(0); + + if (color != UNSPEC) { + CHECK_STRING(color); + + from.size = STRLEN(color); + from.addr = (XtPointer)THESTR(color); + to.size = sizeof(Pixel); + to.addr = (XtPointer)&pixel; + + if (!XtConvertAndStore(XawTextGetSink(textwindow), + XtRString, &from, XtRPixel, &to)) + LispDestroy("cannot convert %s to Pixel", STROBJ(color)); + + XtSetArg(arg[0], XtNbackground, pixel); + XtSetValues(textwindow, arg, 1); + } + else { + from.size = sizeof(Pixel); + from.addr = (XtPointer)&pixel; + to.size = 0; + to.addr = NULL; + + XtSetArg(arg[0], XtNbackground, &pixel); + XtGetValues(XawTextGetSink(textwindow), arg, 1); + /* This cannot fail */ + XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to); + + color = STRING(to.addr); + } + + return (color); +} + +static LispObj * +XeditCharAt(LispBuiltin *builtin, int before) +{ + Widget source = XawTextGetSource(textwindow); + XawTextPosition first, point, last; + XawTextBlock block; + + LispObj *offset; + + offset = ARGUMENT(0); + if (offset != UNSPEC) { + CHECK_INDEX(offset); + } + + first = XawTextSourceScan(source, 0, XawstAll, XawsdLeft, 1, True); + if (FIXNUMP(offset)) + point = FIXNUM_VALUE(offset); + else + point = XawTextGetInsertionPoint(textwindow); + if (before && point > first) { + XawTextPosition position = + XawTextSourceScan(source, point, XawstPositions, XawsdLeft, 1, True); + + if (position < point) + point = position; + else + return (NIL); + } + last = XawTextSourceScan(source, 0, XawstAll, XawsdRight, 1, True); + + if (point < first || point > last) + return (NIL); + + XawTextSourceRead(source, point, &block, 1); + + return (block.length ? SCHAR(*(unsigned char*)block.ptr) : NIL); +} + +LispObj * +Xedit_CharAfter(LispBuiltin *builtin) +/* + char-after &optional offset + */ +{ + return (XeditCharAt(builtin, 0)); +} + +LispObj * +Xedit_CharBefore(LispBuiltin *builtin) +/* + char-before &optional offset + */ +{ + return (XeditCharAt(builtin, 1)); +} + +LispObj * +Xedit_ClearEntities(LispBuiltin *builtin) +/* + clear-entities left right + */ +{ + LispObj *left, *right; + + right = ARGUMENT(1); + left = ARGUMENT(0); + + CHECK_INDEX(left); + CHECK_INDEX(right); + + XawTextSourceClearEntities(XawTextGetSource(textwindow), + FIXNUM_VALUE(left), FIXNUM_VALUE(right)); + + return (T); +} + +LispObj * +Xedit_ConvertPropertyList(LispBuiltin *builtin) +/* + convert-property-list name definition + */ +{ + LispObj *result; + XawTextPropertyList *property_list; + + LispObj *name, *definition; + + definition = ARGUMENT(1); + name = ARGUMENT(0); + + CHECK_STRING(name); + CHECK_STRING(definition); + + result = NIL; + property_list = XawTextSinkConvertPropertyList(THESTR(name), + THESTR(definition), + topwindow->core.screen, + topwindow->core.colormap, + topwindow->core.depth); + + if (property_list) { + Cardinal i; + + for (i = 0; i < num_property_lists; i++) + /* Check if a new property list was created */ + if (property_lists[i]->identifier == property_list->identifier) + break; + + /* Remember this pointer when asked back for it */ + if (i == num_property_lists) { + property_lists = (XawTextPropertyList**) + XtRealloc((XtPointer)property_lists, + sizeof(XawTextPropertyList) * + (num_property_lists + 1)); + property_lists[num_property_lists++] = property_list; + } + result = INTEGER(property_list->identifier); + } + + return (result); +} + +LispObj * +Xedit_Font(LispBuiltin *builtin) +/* + font &optional font + */ +{ + XFontStruct *font_struct; + Arg arg[1]; + XrmValue from, to; + + LispObj *font; + + font = ARGUMENT(0); + + if (font != UNSPEC) { + CHECK_STRING(font); + + from.size = STRLEN(font); + from.addr = (XtPointer)THESTR(font); + to.size = sizeof(XFontStruct*); + to.addr = (XtPointer)&font_struct; + + if (!XtConvertAndStore(textwindow, XtRString, &from, XtRFontStruct, &to)) + LispDestroy("cannot convert %s to FontStruct", STROBJ(font)); + + XtSetArg(arg[0], XtNfont, font_struct); + XtSetValues(textwindow, arg, 1); + } + else { + from.size = sizeof(XFontStruct*); + from.addr = (XtPointer)&font_struct; + to.size = 0; + to.addr = NULL; + + XtSetArg(arg[0], XtNfont, &font_struct); + XtGetValues(XawTextGetSink(textwindow), arg, 1); + /* This cannot fail */ + XtConvertAndStore(textwindow, XtRFontStruct, &from, XtRString, &to); + + font = STRING(to.addr); + } + + return (font); +} + +LispObj * +Xedit_Foreground(LispBuiltin *builtin) +/* + foreground &optional color + */ +{ + Pixel pixel; + Arg arg[1]; + XrmValue from, to; + + LispObj *color; + + color = ARGUMENT(0); + + if (color != UNSPEC) { + CHECK_STRING(color); + + from.size = STRLEN(color); + from.addr = (XtPointer)THESTR(color); + to.size = sizeof(Pixel); + to.addr = (XtPointer)&pixel; + + if (!XtConvertAndStore(XawTextGetSink(textwindow), + XtRString, &from, XtRPixel, &to)) + LispDestroy("cannot convert %s to Pixel", STROBJ(color)); + + XtSetArg(arg[0], XtNforeground, pixel); + XtSetValues(textwindow, arg, 1); + } + else { + from.size = sizeof(Pixel); + from.addr = (XtPointer)&pixel; + to.size = 0; + to.addr = NULL; + + XtSetArg(arg[0], XtNforeground, &pixel); + XtGetValues(XawTextGetSink(textwindow), arg, 1); + /* This cannot fail */ + XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to); + + color = STRING(to.addr); + } + + return (color); +} + +LispObj * +Xedit_GotoChar(LispBuiltin *builtin) +/* + goto-char offset + */ +{ + LispObj *offset; + XawTextPosition point; + + offset = ARGUMENT(0); + + CHECK_INDEX(offset); + XawTextSetInsertionPoint(textwindow, FIXNUM_VALUE(offset)); + point = XawTextGetInsertionPoint(textwindow); + if (point != FIXNUM_VALUE(offset)) + offset = FIXNUM(point); + + return (offset); +} + +LispObj * +Xedit_HorizontalScrollbar(LispBuiltin *builtin) +/* + horizontal-scrollbar &optional state + */ +{ + Arg arg[1]; + XawTextScrollMode scroll; + + LispObj *state; + + state = ARGUMENT(0); + + if (state != UNSPEC) { + scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways; + XtSetArg(arg[0], XtNscrollHorizontal, scroll); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNscrollHorizontal, &scroll); + XtGetValues(textwindow, arg, 1); + state = scroll == XawtextScrollAlways ? T : NIL; + } + + return (state); +} + +LispObj * +Xedit_Insert(LispBuiltin *builtin) +/* + insert text + */ +{ + XawTextPosition point = XawTextGetInsertionPoint(textwindow); + XawTextBlock block; + + LispObj *text; + + text = ARGUMENT(0); + + CHECK_STRING(text); + + block.firstPos = 0; + block.format = FMT8BIT; + block.length = STRLEN(text); + block.ptr = THESTR(text); + XawTextReplace(textwindow, point, point, &block); + XawTextSetInsertionPoint(textwindow, point + block.length); + + return (text); +} + +LispObj * +Xedit_Justification(LispBuiltin *builtin) +/* + justification &optional value + */ +{ + int i; + Arg arg[1]; + XawTextJustifyMode justify; + + LispObj *value; + + value = ARGUMENT(0); + + if (value != UNSPEC) { + for (i = 0; i < 4; i++) + if (value == justify_modes[i]) + break; + if (i >= 4) + LispDestroy("%s: argument must be " + ":LEFT, :RIGHT, :CENTER, or :FULL, not %s", + STRFUN(builtin), STROBJ(value)); + XtSetArg(arg[0], XtNjustifyMode, (XawTextJustifyMode)i); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNjustifyMode, &justify); + XtGetValues(textwindow, arg, 1); + i = (int)justify; + if (i <= 0 || i >= 4) + i = 0; + value = justify_modes[i]; + } + + return (value); +} + +LispObj * +Xedit_LeftColumn(LispBuiltin *builtin) +/* + left-column &optional left + */ +{ + short left; + Arg arg[1]; + + LispObj *oleft; + + oleft = ARGUMENT(0); + + if (oleft != UNSPEC) { + CHECK_INDEX(oleft); + if (FIXNUM_VALUE(oleft) >= 32767) + left = 32767; + else + left = FIXNUM_VALUE(oleft); + + XtSetArg(arg[0], XtNleftColumn, left); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNleftColumn, &left); + XtGetValues(textwindow, arg, 1); + + oleft = FIXNUM((long)left); + } + + return (oleft); +} + +LispObj * +Xedit_Point(LispBuiltin *builtin) +/* + point + */ +{ + return (FIXNUM(XawTextGetInsertionPoint(textwindow))); +} + +LispObj * +Xedit_PointMax(LispBuiltin *builtin) +/* + point-max + */ +{ + return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0, + XawstAll, XawsdRight, 1, True))); +} + +LispObj * +Xedit_PointMin(LispBuiltin *builtin) +/* + point-min + */ +{ + return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0, + XawstAll, XawsdLeft, 1, True))); +} + +LispObj * +Xedit_PropertyList(LispBuiltin *builtin) +/* + property-list &optional value + */ +{ + Arg arg[1]; + XawTextPropertyList *property_list; + + LispObj *value; + + value = ARGUMENT(0); + + if (value != UNSPEC) { + Cardinal i; + XrmQuark quark; + + CHECK_LONGINT(value); + property_list = NULL; + quark = LONGINT_VALUE(value); + for (i = 0; i < num_property_lists; i++) + if (property_lists[i]->identifier == quark) { + property_list = property_lists[i]; + break; + } + + if (property_list) { + XtSetArg(arg[0], XawNtextProperties, property_list); + XtSetValues(XawTextGetSink(textwindow), arg, 1); + } + else + /* Maybe should generate an error here */ + value = NIL; + } + else { + XtSetArg(arg[0], XawNtextProperties, &property_list); + XtGetValues(XawTextGetSink(textwindow), arg, 1); + if (property_list) + value = INTEGER(property_list->identifier); + } + + return (value); +} + +LispObj * +Xedit_ReadText(LispBuiltin *builtin) +/* + read-text offset length + */ +{ + XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0, + XawstAll, XawsdRight, 1, True); + XawTextPosition from, to, len; + XawTextBlock block; + char *string, *ptr; + + LispObj *offset, *length; + + length = ARGUMENT(1); + offset = ARGUMENT(0); + + CHECK_INDEX(offset); + CHECK_INDEX(length); + + from = FIXNUM_VALUE(offset); + to = from + FIXNUM_VALUE(length); + if (from > last) + from = last; + if (to > last) + to = last; + + if (from == to) + return (STRING("")); + + len = to - from; + string = LispMalloc(len); + + for (ptr = string; from < to;) { + XawTextSourceRead(XawTextGetSource(textwindow), from, &block, to - from); + memcpy(ptr, block.ptr, block.length); + ptr += block.length; + from += block.length; + } + + return (LSTRING2(string, len)); +} + +LispObj * +Xedit_ReplaceText(LispBuiltin *builtin) +/* + replace-text left right text + */ +{ + XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0, + XawstAll, XawsdRight, 1, True); + XawTextPosition left, right; + XawTextBlock block; + + LispObj *oleft, *oright, *text; + + text = ARGUMENT(2); + oright = ARGUMENT(1); + oleft = ARGUMENT(0); + + CHECK_INDEX(oleft); + CHECK_INDEX(oright); + CHECK_STRING(text); + + left = FIXNUM_VALUE(oleft); + right = FIXNUM_VALUE(oright); + if (left > last) + left = last; + if (left > right) + right = left; + else if (right > last) + right = last; + + block.firstPos = 0; + block.format = FMT8BIT; + block.length = STRLEN(text); + block.ptr = THESTR(text); + XawTextReplace(textwindow, left, right, &block); + + return (text); +} + +LispObj * +Xedit_RightColumn(LispBuiltin *builtin) +/* + right-column &optional right + */ +{ + short right; + Arg arg[1]; + + LispObj *oright; + + oright = ARGUMENT(0); + + if (oright != UNSPEC) { + CHECK_INDEX(oright); + if (FIXNUM_VALUE(oright) >= 32767) + right = 32767; + else + right = FIXNUM_VALUE(oright); + + XtSetArg(arg[0], XtNrightColumn, right); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNrightColumn, &right); + XtGetValues(textwindow, arg, 1); + + oright = FIXNUM(right); + } + + return (oright); +} + +LispObj * +Xedit_Scan(LispBuiltin *builtin) +/* + scan offset type direction &key count include + */ +{ + int i; + XawTextPosition offset; + XawTextScanType type; + XawTextScanDirection direction; + int count; + + LispObj *ooffset, *otype, *odirection, *ocount, *include; + + include = ARGUMENT(4); + if (include == UNSPEC) + include = NIL; + ocount = ARGUMENT(3); + odirection = ARGUMENT(2); + otype = ARGUMENT(1); + ooffset = ARGUMENT(0); + + CHECK_INDEX(ooffset); + offset = FIXNUM_VALUE(ooffset); + + for (i = 0; i < 2; i++) + if (odirection == scan_directions[i]) + break; + if (i >= 2) + LispDestroy("%s: direction must be " + ":LEFT or :RIGHT, not %s", + STRFUN(builtin), STROBJ(odirection)); + direction = (XawTextScanDirection)i; + + for (i = 0; i < 5; i++) + if (otype == scan_types[i]) + break; + if (i >= 5) + LispDestroy("%s: direction must be " + ":POSITIONS, :WHITE-SPACE, :EOL, " + ":PARAGRAPH, :ALL, or :ALPHA-NUMERIC, not %s", + STRFUN(builtin), STROBJ(otype)); + type = (XawTextScanType)i; + + if (ocount == UNSPEC) + count = 1; + else { + CHECK_INDEX(ocount); + count = FIXNUM_VALUE(ocount); + } + + offset = XawTextSourceScan(XawTextGetSource(textwindow), + offset, type, direction, count, + include != NIL); + + return (FIXNUM(offset)); +} + +static LispObj * +XeditSearch(LispBuiltin *builtin, XawTextScanDirection direction) +{ + XawTextBlock block; + XawTextPosition position; + + LispObj *string, *offset, *ignore_case; + + ignore_case = ARGUMENT(2); + offset = ARGUMENT(1); + string = ARGUMENT(0); + + CHECK_STRING(string); + if (offset != UNSPEC) { + CHECK_INDEX(offset); + position = FIXNUM_VALUE(offset); + } + else + position = XawTextGetInsertionPoint(textwindow); + + block.firstPos = (ignore_case != UNSPEC && ignore_case != NIL) ? 1 : 0; + block.format = FMT8BIT; + block.length = STRLEN(string); + block.ptr = THESTR(string); + position = XawTextSourceSearch(XawTextGetSource(textwindow), + position, direction, &block); + + return (position != XawTextSearchError ? FIXNUM(position) : NIL); +} + + +LispObj * +Xedit_SearchBackward(LispBuiltin *builtin) +/* + search-backward string &optional offset ignore-case + */ +{ + return (XeditSearch(builtin, XawsdLeft)); +} + +LispObj * +Xedit_SearchForward(LispBuiltin *builtin) +/* + search-forward string &optional offset ignore-case + */ +{ + return (XeditSearch(builtin, XawsdRight)); +} + +LispObj * +Xedit_VerticalScrollbar(LispBuiltin *builtin) +/* + vertical-scrollbar &optional state + */ +{ + Arg arg[1]; + XawTextScrollMode scroll; + + LispObj *state; + + state = ARGUMENT(0); + + if (state != UNSPEC) { + scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways; + XtSetArg(arg[0], XtNscrollVertical, scroll); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNscrollVertical, &scroll); + XtGetValues(textwindow, arg, 1); + state = scroll == XawtextScrollAlways ? T : NIL; + } + + return (state); +} + +LispObj * +Xedit_WrapMode(LispBuiltin *builtin) +/* + wrap-mode &optional value + */ +{ + int i; + Arg arg[1]; + XawTextWrapMode wrap; + + LispObj *value; + + value = ARGUMENT(0); + + if (value != UNSPEC) { + for (i = 0; i < 3; i++) + if (value == wrap_modes[i]) + break; + if (i >= 3) + LispDestroy("%s: argument must be " + ":NEVER, :LINE, or :WORD, not %s", + STRFUN(builtin), STROBJ(value)); + XtSetArg(arg[0], XtNwrap, (XawTextWrapMode)i); + XtSetValues(textwindow, arg, 1); + } + else { + XtSetArg(arg[0], XtNwrap, &wrap); + XtGetValues(textwindow, arg, 1); + i = (int)wrap; + if (i <= 0 || i >= 3) + i = 0; + value = wrap_modes[i]; + } + + return (value); +} + +LispObj * +Xedit_XrmStringToQuark(LispBuiltin *builtin) +/* + xrm-string-to-quark string + */ +{ + LispObj *string; + + string = ARGUMENT(0); + + CHECK_STRING(string); + + return (INTEGER(XrmStringToQuark(THESTR(string)))); +} |