1 /* 2 * Copyright (c) 2002 by The XFree86 Project, Inc. 3 * 4 * Permission is hereby granted, free of charge, to any person obtaining a 5 * copy of this software and associated documentation files (the "Software"), 6 * to deal in the Software without restriction, including without limitation 7 * the rights to use, copy, modify, merge, publish, distribute, sublicense, 8 * and/or sell copies of the Software, and to permit persons to whom the 9 * Software is furnished to do so, subject to the following conditions: 10 * 11 * The above copyright notice and this permission notice shall be included in 12 * all copies or substantial portions of the Software. 13 * 14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF 19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 20 * SOFTWARE. 21 * 22 * Except as contained in this notice, the name of the XFree86 Project shall 23 * not be used in advertising or otherwise to promote the sale, use or other 24 * dealings in this Software without prior written authorization from the 25 * XFree86 Project. 26 * 27 * Author: Paulo Csar Pereira de Andrade 28 */ 29 30 /* $XFree86: xc/programs/xedit/lisp/xedit.c,v 1.25 2003/04/27 18:17:35 tsi Exp $ */ 31 32 #include "../xedit.h" 33 #include <X11/Xaw/TextSrcP.h> /* Needs some private definitions */ 34 #include <X11/Xaw/TextSinkP.h> /* Also needs private definitions... */ 35 #include <X11/Xmu/Xmu.h> 36 #define XEDIT_LISP_PRIVATE 37 #include "xedit.h" 38 #include <signal.h> 39 40 /* Initialize to enter lisp */ 41 #define LISP_SETUP() \ 42 int lisp__running = lisp__data.running 43 44 /* XXX Maybe should use ualarm or better, setitimer, but one 45 * second seens good enough to check for interrupts */ 46 47 #define ENABLE_SIGALRM() \ 48 old_sigalrm = signal(SIGALRM, SigalrmHandler); \ 49 alarm(1) 50 51 #define DISABLE_SIGALRM() \ 52 alarm(0); \ 53 signal(SIGALRM, old_sigalrm) 54 55 /* Enter lisp */ 56 #define LISP_ENTER() \ 57 if (!lisp__running) { \ 58 lisp__data.running = 1; \ 59 XFlush(XtDisplay(textwindow)); \ 60 ENABLE_SIGALRM(); \ 61 if (sigsetjmp(lisp__data.jmp, 1) != 0) { \ 62 DISABLE_SIGALRM(); \ 63 lisp__data.running = 0; \ 64 return; \ 65 } \ 66 } 67 68 /* Leave lisp */ 69 #define LISP_LEAVE() \ 70 if (!lisp__running) { \ 71 DISABLE_SIGALRM(); \ 72 LispTopLevel(); \ 73 lisp__data.running = 0; \ 74 } 75 76 /* 77 * Types 78 */ 79 typedef struct { 80 XawTextPosition left, right; 81 XrmQuark property; 82 } EntityInfo; 83 84 /* 85 * Prototypes 86 */ 87 static Bool ControlGPredicate(Display*, XEvent*, XPointer); 88 static ssize_t WriteToStdout(int, const void*, size_t); 89 static ssize_t WriteToStderr(int, const void*, size_t); 90 static ssize_t WrapWrite(Widget, const void*, size_t); 91 static void XeditUpdateModeInfos(void); 92 static void XeditPrint(Widget, LispObj*, int); 93 static void XeditInteractiveCallback(Widget, XtPointer, XtPointer); 94 static void XeditIndentationCallback(Widget, XtPointer, XtPointer); 95 static LispObj *XeditCharAt(LispBuiltin*, int); 96 static LispObj *XeditSearch(LispBuiltin*, XawTextScanDirection); 97 98 /* 99 * Initialization 100 */ 101 static void (*old_sigalrm)(int); 102 103 EditModeInfo *mode_infos; 104 Cardinal num_mode_infos; 105 106 static LispObj *Oauto_modes, *Oauto_mode, *Osyntax_highlight, *Osyntable_indent; 107 108 /* Just to make calling interactive reparse easier */ 109 static LispObj interactive_arguments[4]; 110 111 static LispObj *justify_modes[4]; 112 static LispObj *wrap_modes[3]; 113 static LispObj *scan_types[6]; 114 static LispObj *scan_directions[2]; 115 static LispObj execute_stream; 116 static LispString execute_string; 117 static LispObj result_stream; 118 static LispString result_string; 119 static XawTextPropertyList **property_lists; 120 static Cardinal num_property_lists; 121 122 /* Some hacks to (at lest try to) avoid problems reentering Xlib while 123 * testing for user interrupts */ 124 static volatile int disable_timeout, request_timeout; 125 126 extern int pagesize; 127 128 static LispBuiltin xeditbuiltins[] = { 129 {LispFunction, Xedit_AddEntity, "add-entity offset length identifier"}, 130 {LispFunction, Xedit_AutoFill, "auto-fill &optional value"}, 131 {LispFunction, Xedit_Background, "background &optional color"}, 132 {LispFunction, Xedit_CharAfter, "char-after &optional offset"}, 133 {LispFunction, Xedit_CharBefore, "char-before &optional offset"}, 134 {LispFunction, Xedit_ClearEntities, "clear-entities left right"}, 135 {LispFunction, Xedit_ConvertPropertyList, "convert-property-list name definition"}, 136 {LispFunction, Xedit_Font, "font &optional font"}, 137 {LispFunction, Xedit_Foreground, "foreground &optional color"}, 138 {LispFunction, Xedit_GotoChar, "goto-char offset"}, 139 {LispFunction, Xedit_HorizontalScrollbar, "horizontal-scrollbar &optional state"}, 140 {LispFunction, Xedit_Insert, "insert text"}, 141 {LispFunction, Xedit_Justification, "justification &optional value"}, 142 {LispFunction, Xedit_LeftColumn, "left-column &optional left"}, 143 {LispFunction, Xedit_Point, "point"}, 144 {LispFunction, Xedit_PointMax, "point-max"}, 145 {LispFunction, Xedit_PointMin, "point-min"}, 146 {LispFunction, Xedit_PropertyList, "property-list &optional value"}, 147 {LispFunction, Xedit_ReadText, "read-text offset length"}, 148 {LispFunction, Xedit_ReplaceText, "replace-text left right text"}, 149 {LispFunction, Xedit_RightColumn, "right-column &optional right"}, 150 {LispFunction, Xedit_Scan, "scan offset type direction &key count include"}, 151 {LispFunction, Xedit_SearchBackward, "search-backward string &optional offset ignore-case"}, 152 {LispFunction, Xedit_SearchForward, "search-forward string &optional offset ignore-case"}, 153 {LispFunction, Xedit_VerticalScrollbar, "vertical-scrollbar &optional state"}, 154 {LispFunction, Xedit_WrapMode, "wrap-mode &optional value"}, 155 156 /* This should be available from elsewhere at some time... */ 157 {LispFunction, Xedit_XrmStringToQuark, "xrm-string-to-quark string"}, 158 }; 159 160 /* 161 * Implementation 162 */ 163 /*ARGUSED*/ 164 static Bool 165 ControlGPredicate(Display *display, XEvent *event, XPointer arguments) 166 { 167 char buffer[2]; 168 169 return ((event->type == KeyPress || event->type == KeyRelease) && 170 (event->xkey.state & ControlMask) && 171 XLookupString(&(event->xkey), buffer, sizeof(buffer), NULL, NULL) && 172 buffer[0] == '\a'); 173 } 174 175 /*ARGSUSED*/ 176 static void 177 SigalrmHandler(int signum) 178 { 179 XEvent event; 180 181 if (disable_timeout) { 182 request_timeout = 1; 183 return; 184 } 185 186 /* Check if user pressed C-g */ 187 if (XCheckIfEvent(XtDisplay(textwindow), &event, ControlGPredicate, NULL)) { 188 XPutBackEvent(XtDisplay(textwindow), &event); 189 alarm(0); 190 /* Tell a signal was received, print message for SIGINT */ 191 LispSignal(SIGINT); 192 } 193 else 194 alarm(1); 195 } 196 197 static ssize_t 198 WrapWrite(Widget output, const void *buffer, size_t nbytes) 199 { 200 XawTextBlock block; 201 XawTextPosition position; 202 203 disable_timeout = 1; 204 position = XawTextGetInsertionPoint(output); 205 block.firstPos = 0; 206 block.format = FMT8BIT; 207 block.length = nbytes; 208 block.ptr = (String)buffer; 209 XawTextReplace(output, position, position, &block); 210 XawTextSetInsertionPoint(output, position + block.length); 211 disable_timeout = 0; 212 213 if (request_timeout) { 214 XFlush(XtDisplay(output)); 215 request_timeout = 0; 216 SigalrmHandler(SIGALRM); 217 } 218 219 return ((ssize_t)nbytes); 220 } 221 222 static ssize_t 223 WriteToStdout(int fd, const void *buffer, size_t nbytes) 224 { 225 return (WrapWrite(textwindow, buffer, nbytes)); 226 } 227 228 static ssize_t 229 WriteToStderr(int fd, const void *buffer, size_t nbytes) 230 { 231 return (WrapWrite(messwidget, buffer, nbytes)); 232 } 233 234 void 235 LispXeditInitialize(void) 236 { 237 int i; 238 char *string; 239 LispObj *xedit, *list, *savepackage; 240 241 LispSetFileWrite(Stdout, WriteToStdout); 242 LispSetFileWrite(Stderr, WriteToStderr); 243 244 justify_modes[0] = KEYWORD("LEFT"); 245 justify_modes[1] = KEYWORD("RIGHT"); 246 justify_modes[2] = KEYWORD("CENTER"); 247 justify_modes[3] = KEYWORD("FULL"); 248 249 wrap_modes[0] = KEYWORD("NEVER"); 250 wrap_modes[1] = KEYWORD("LINE"); 251 wrap_modes[2] = KEYWORD("WORD"); 252 253 scan_types[0] = KEYWORD("POSITIONS"); 254 scan_types[1] = KEYWORD("WHITE-SPACE"); 255 scan_types[2] = KEYWORD("EOL"); 256 scan_types[3] = KEYWORD("PARAGRAPH"); 257 scan_types[4] = KEYWORD("ALL"); 258 scan_types[5] = KEYWORD("ALPHA-NUMERIC"); 259 260 scan_directions[0] = justify_modes[0]; 261 scan_directions[1] = justify_modes[1]; 262 263 /* Remember value of current package */ 264 savepackage = PACKAGE; 265 266 /* Create the XEDIT package */ 267 xedit = LispNewPackage(STRING("XEDIT"), NIL); 268 269 /* Update list of packages */ 270 PACK = CONS(xedit, PACK); 271 272 /* Temporarily switch to the XEDIT package */ 273 lisp__data.pack = lisp__data.savepack = xedit->data.package.package; 274 PACKAGE = xedit; 275 276 /* Add XEDIT builtin functions */ 277 for (i = 0; i < sizeof(xeditbuiltins) / sizeof(xeditbuiltins[0]); i++) 278 LispAddBuiltinFunction(&xeditbuiltins[i]); 279 280 /* Create these objects in the xedit package */ 281 Oauto_modes = STATIC_ATOM("*AUTO-MODES*"); 282 Oauto_mode = STATIC_ATOM("AUTO-MODE"); 283 Osyntax_highlight = STATIC_ATOM("SYNTAX-HIGHLIGHT"); 284 Osyntable_indent = STATIC_ATOM("SYNTABLE-INDENT"); 285 286 /* Import symbols from the LISP and EXT packages */ 287 for (list = PACK; CONSP(list); list = CDR(list)) { 288 string = THESTR(CAR(list)->data.package.name); 289 if (strcmp(string, "LISP") == 0 || strcmp(string, "EXT") == 0) 290 LispUsePackage(CAR(list)); 291 } 292 293 /* Restore previous package */ 294 lisp__data.pack = savepackage->data.package.package; 295 PACKAGE = savepackage; 296 297 /* Initialize helper static objects used when executing expressions */ 298 execute_stream.type = LispStream_t; 299 execute_stream.data.stream.source.string = &execute_string; 300 execute_stream.data.stream.pathname = NIL; 301 execute_stream.data.stream.type = LispStreamString; 302 execute_stream.data.stream.readable = 1; 303 execute_stream.data.stream.writable = 0; 304 execute_string.output = 0; 305 result_stream.type = LispStream_t; 306 result_stream.data.stream.source.string = &result_string; 307 result_stream.data.stream.pathname = NIL; 308 result_stream.data.stream.type = LispStreamString; 309 result_stream.data.stream.readable = 0; 310 result_stream.data.stream.writable = 1; 311 result_string.string = XtMalloc(pagesize); 312 result_string.space = pagesize; 313 314 /* Initialize interactive edition function arguments */ 315 /* first argument is syntax table */ 316 interactive_arguments[0].type = LispCons_t; 317 interactive_arguments[0].data.cons.cdr = &interactive_arguments[1]; 318 /* second argument is where to start reparsing */ 319 interactive_arguments[1].type = LispCons_t; 320 interactive_arguments[1].data.cons.cdr = &interactive_arguments[2]; 321 /* third argument is where to stop reparsing */ 322 interactive_arguments[2].type = LispCons_t; 323 interactive_arguments[2].data.cons.cdr = &interactive_arguments[3]; 324 /* fourth argument is interactive flag */ 325 interactive_arguments[3].type = LispCons_t; 326 interactive_arguments[3].data.cons.car = T; 327 interactive_arguments[3].data.cons.cdr = NIL; 328 329 /* Load extra functions and data type definitions */ 330 EXECUTE("(require \"xedit\")"); 331 332 333 /* 334 * This assumes that the *auto-modes* variable is a list where every 335 * item has the format: 336 * (regexp string-desc load-file-desc . symbol-name) 337 * Minimal error checking is done. 338 */ 339 340 if (Oauto_modes->data.atom->a_object) { 341 LispObj *desc, *modes = Oauto_modes->data.atom->property->value; 342 343 for (; CONSP(modes); modes = CDR(modes)) { 344 list = CAR(modes); 345 346 desc = NIL; 347 for (i = 0; i < 3 && CONSP(list); i++, list = CDR(list)) { 348 if (i == 1) 349 desc = CAR(list); 350 } 351 if (i == 3 && STRINGP(desc)) { 352 mode_infos = (EditModeInfo*) 353 XtRealloc((XtPointer)mode_infos, sizeof(EditModeInfo) * 354 (num_mode_infos + 1)); 355 mode_infos[num_mode_infos].desc = XtNewString(THESTR(desc)); 356 mode_infos[num_mode_infos].symbol = list; 357 mode_infos[num_mode_infos].syntax = NULL; 358 ++num_mode_infos; 359 } 360 } 361 } 362 } 363 364 static void 365 XeditUpdateModeInfos(void) 366 { 367 int i; 368 369 for (i = 0; i < num_mode_infos; i++) { 370 if (mode_infos[i].symbol && 371 mode_infos[i].syntax == NULL && 372 XSYMBOLP(mode_infos[i].symbol) && 373 mode_infos[i].symbol->data.atom->a_object) 374 mode_infos[i].syntax = 375 mode_infos[i].symbol->data.atom->property->value; 376 } 377 } 378 379 void 380 XeditLispExecute(Widget output, XawTextPosition left, XawTextPosition right) 381 { 382 GC_ENTER(); 383 LISP_SETUP(); 384 int alloced, return_count; 385 XawTextBlock block; 386 XawTextPosition position; 387 char *string, *ptr; 388 LispObj *result, *code, *_cod, *returns; 389 390 LISP_ENTER(); 391 392 position = left; 393 XawTextSourceRead(XawTextGetSource(textwindow), left, &block, right - left); 394 if (block.length < right - left) { 395 alloced = 1; 396 string = ptr = LispMalloc(right - left); 397 memcpy(ptr, block.ptr, block.length); 398 position = left + block.length; 399 ptr += block.length; 400 for (; position < right;) { 401 XawTextSourceRead(XawTextGetSource(textwindow), 402 position, &block, right - position); 403 memcpy(ptr, block.ptr, block.length); 404 position += block.length; 405 ptr += block.length; 406 } 407 } 408 else { 409 alloced = 0; 410 string = block.ptr; 411 } 412 413 execute_string.string = string; 414 execute_string.length = right - left; 415 execute_string.input = 0; 416 LispPushInput(&execute_stream); 417 _cod = COD; 418 result = NIL; 419 if ((code = LispRead()) != NULL) 420 result = EVAL(code); 421 COD = _cod; 422 LispPopInput(&execute_stream); 423 424 returns = NIL; 425 if (RETURN_COUNT > 0) { 426 GC_PROTECT(result); 427 returns = _cod = CONS(RETURN(0), NIL); 428 GC_PROTECT(returns); 429 for (return_count = 1; return_count < RETURN_COUNT; return_count++) { 430 RPLACD(_cod, CONS(RETURN(return_count), NIL)); 431 _cod = CDR(_cod); 432 } 433 } 434 LispFflush(Stdout); 435 LispUpdateResults(code, result); 436 if (RETURN_COUNT >= 0) { 437 XeditPrint(output, result, 1); 438 for (; CONSP(returns); returns = CDR(returns)) 439 XeditPrint(output, CAR(returns), 0); 440 } 441 442 if (alloced) 443 LispFree(string); 444 GC_LEAVE(); 445 446 LISP_LEAVE(); 447 } 448 449 static void 450 XeditPrint(Widget output, LispObj *object, int newline) 451 { 452 XawTextBlock block; 453 XawTextPosition position; 454 455 result_string.length = result_string.output = 0; 456 if (newline) { 457 position = XawTextGetInsertionPoint(output); 458 if (position != XawTextSourceScan(XawTextGetSource(output), 459 position, XawstEOL, 460 XawsdLeft, 1, False)) 461 LispSputc(&result_string, '\n'); 462 } 463 LispWriteObject(&result_stream, object); 464 LispSputc(&result_string, '\n'); 465 466 position = XawTextGetInsertionPoint(output); 467 block.firstPos = 0; 468 block.format = FMT8BIT; 469 block.length = result_string.length; 470 block.ptr = result_string.string; 471 XawTextReplace(output, position, position, &block); 472 XawTextSetInsertionPoint(output, position + block.length); 473 } 474 475 /* 476 * This function is defined here to avoid exporting all the lisp interfaces 477 * to the core xedit code. 478 */ 479 void 480 XeditLispSetEditMode(xedit_flist_item *item, LispObj *symbol) 481 { 482 GC_ENTER(); 483 LISP_SETUP(); 484 LispObj *syntax, *name; 485 486 item->xldata = (XeditLispData*)XtCalloc(1, sizeof(XeditLispData)); 487 488 LISP_ENTER(); 489 490 /* Create an object that represents the buffer filename. 491 * Note that the entire path is passed to the auto-mode 492 * function, so that directory names may be also be used 493 * when determining a file type. */ 494 name = STRING(item->filename); 495 GC_PROTECT(name); 496 497 /* Call the AUTO-MODE function to check if there is a 498 * syntax definition for the file being loaded */ 499 if (symbol == NULL) 500 syntax = APPLY1(Oauto_mode, name); 501 else 502 syntax = APPLY2(Oauto_mode, name, symbol); 503 504 /* Don't need the name object anymore */ 505 GC_LEAVE(); 506 507 if (syntax != NIL) { 508 Arg arg[1]; 509 LispObj arguments; 510 XawTextPropertyList *property_list; 511 512 item->xldata->syntax = syntax; 513 514 /* Apply the syntax highlight to the current buffer */ 515 arguments.type = LispCons_t; 516 arguments.data.cons.car = syntax; 517 arguments.data.cons.cdr = NIL; 518 LispFuncall(Osyntax_highlight, &arguments, 1); 519 520 /* The previous call added the property list to the widget, 521 * remember it when switching sources. */ 522 XtSetArg(arg[0], XawNtextProperties, &property_list); 523 XtGetValues(XawTextGetSink(textwindow), arg, 1); 524 item->properties = property_list; 525 526 /* Add callback for interactive changes */ 527 XtAddCallback(item->source, XtNpropertyCallback, 528 XeditInteractiveCallback, item->xldata); 529 530 /* Update information as a new file may have been loaded */ 531 XeditUpdateModeInfos(); 532 } 533 else 534 item->properties = NULL; 535 536 LISP_LEAVE(); 537 } 538 539 void 540 XeditLispUnsetEditMode(xedit_flist_item *item) 541 { 542 if (item->xldata) { 543 XtRemoveCallback(item->source, XtNpropertyCallback, 544 XeditInteractiveCallback, item->xldata); 545 XtFree((XtPointer)item->xldata); 546 item->xldata = NULL; 547 } 548 } 549 550 #define MAX_INFOS 32 551 /* 552 * This callback tries to do it's best in generating correct output while 553 * also doing minimal work/redrawing of the screen. It probably will fail 554 * for some syntax-definitions, or will just not properly repaint the 555 * screen. In the later case, just press Ctrl+L. 556 * There isn't yet any command to force reparsing of some regions, and if 557 * the parser becomes confused, you may need to go to a line, press a space 558 * and undo, just to force it to reparse the line, and possibly some extra 559 * lines until the parser thinks the display is in sync. 560 * Sometimes it will repaint a lot more of text than what is being requested 561 * by this callback, this should be fixed at some time, as for certain cases 562 * it is also required some redesign in the Xaw interface. 563 */ 564 static void 565 XeditInteractiveCallback(Widget w, XtPointer client_data, XtPointer call_data) 566 { 567 LISP_SETUP(); 568 XeditLispData *data = (XeditLispData*)client_data; 569 LispObj *syntax = data->syntax; 570 XawTextPropertyInfo *info = (XawTextPropertyInfo*)call_data; 571 LispObj *result, *syntable; 572 XawTextAnchor *anchor; 573 XawTextEntity *entity; 574 XawTextPosition first, last, left, right, begin, next, tmp, position; 575 int i, j, indent; 576 TextSrcObject src = (TextSrcObject)w; 577 EntityInfo oinfo[MAX_INFOS], ninfo[MAX_INFOS]; 578 XrmQuark props[MAX_INFOS]; 579 int num_oinfo, num_ninfo, num_props; 580 XmuScanline *clip, *oclip, *nclip; 581 XmuSegment segment, *seg; 582 583 if (data->disable_highlight) 584 return; 585 586 LISP_ENTER(); 587 588 first = XawTextSourceScan(w, 0, XawstAll, XawsdLeft, 1, True); 589 last = XawTextSourceScan(w, 0, XawstAll, XawsdRight, 1, True); 590 591 left = info->left; 592 right = left + info->block->length; 593 594 /* For now, only call the indent hook if a single character was typed */ 595 indent = (info->right == left) && (right == left + 1); 596 597 /* Always reparse full lines */ 598 left = begin = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, False); 599 right = next = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 1, False); 600 601 602 /* Check properties in the modified text. If a complex nested syntax 603 * table was parsed, the newline has it's default property, so, while 604 * the newline has a property, backup a line to make sure everything is 605 * properly parsed. 606 * Maybe should limit the number of backuped lines, but if the parsing 607 * becomes noticeable slow, better to rethink the syntax definition. */ 608 while (left > first) { 609 position = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, True); 610 if (XawTextSourceAnchorAndEntity(w, position, &anchor, &entity)) 611 left = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 2, False); 612 else 613 break; 614 } 615 616 /* While the newline after the right position has a "hidden" property, 617 * keep incrementing a line to be reparsed. */ 618 while (right < last) { 619 if (XawTextSourceAnchorAndEntity(w, right, &anchor, &entity)) 620 right = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 2, False); 621 else 622 break; 623 } 624 625 #ifndef MAX 626 #define MAX(a, b) ((a) > (b) ? (a) : (b)) 627 #endif 628 629 #ifndef MIN 630 #define MIN(a, b) ((a) < (b) ? (a) : (b)) 631 #endif 632 633 #define STORE_STATE(count, info, from, to) \ 634 (count) = 0; \ 635 if ((anchor = XawTextSourceFindAnchor(w, (from))) != NULL) { \ 636 entity = anchor->entities; \ 637 /* Find first entity in the region to parse */ \ 638 while (entity && \ 639 anchor->position + entity->offset + entity->length <= \ 640 (from)) \ 641 entity = entity->next; \ 642 /* Loop storing information */ \ 643 while (entity && \ 644 (position = anchor->position + entity->offset) < (to)) { \ 645 (info)[(count)].left = MAX(position, (from)); \ 646 position += entity->length; \ 647 (info)[(count)].right = MIN(position, (to)); \ 648 (info)[(count)].property = entity->property; \ 649 /* If the changes are so complex, user need press Ctrl+L */ \ 650 if (++(count) >= MAX_INFOS) \ 651 break; \ 652 if ((entity = entity->next) == NULL && \ 653 (anchor = XawTextSourceNextAnchor(w, anchor)) != NULL) \ 654 entity = anchor->entities; \ 655 } \ 656 } 657 658 /* Remember old state */ 659 STORE_STATE(num_oinfo, oinfo, begin, right); 660 661 /* Reparse the lines in the modified/edited range of text */ 662 interactive_arguments[0].data.cons.car = syntax; 663 interactive_arguments[1].data.cons.car = FIXNUM(left); 664 interactive_arguments[2].data.cons.car = FIXNUM(right); 665 result = APPLY(Osyntax_highlight, &interactive_arguments[0]); 666 /* Indent table is the second return value */ 667 if (RETURN_COUNT) 668 syntable = RETURN(0); 669 else 670 syntable = NIL; 671 672 /* This normally is the same value as right, but the parser may have 673 * continued when the syntax table stack did not finish. */ 674 if (FIXNUMP(result)) 675 right = FIXNUM_VALUE(result); 676 677 LISP_LEAVE(); 678 679 /* Check what have changed */ 680 STORE_STATE(num_ninfo, ninfo, begin, right); 681 682 /* Initialize to redraw everything. */ 683 clip = XmuNewScanline(0, begin, right); 684 685 #define CLIP_MASK(mask, from, to) \ 686 if ((from) < (to)) { \ 687 segment.x1 = (from); \ 688 segment.x2 = (to); \ 689 XmuScanlineOrSegment((mask), &segment); \ 690 } 691 692 oclip = XmuNewScanline(0, 0, 0); 693 nclip = XmuNewScanline(0, 0, 0); 694 695 #define CLIP_DEFAULT(mask, from, info, num_info) \ 696 for (tmp = (from), i = 0; i < (num_info); i++) { \ 697 CLIP_MASK((mask), tmp, (info)[i].left); \ 698 tmp = (info)[i].right; \ 699 } 700 701 /* First generate masks of regions with the default property */ 702 CLIP_DEFAULT(oclip, begin, oinfo, num_oinfo); 703 CLIP_DEFAULT(nclip, begin, ninfo, num_ninfo); 704 705 /* Store unchanged region in oclip */ 706 XmuScanlineAnd(oclip, nclip); 707 708 /* Don't need to redraw the region in oclip */ 709 XmuScanlineXor(clip, oclip); 710 711 #define LIST_PROPERTIES(prop, num_prop, info, num_info) \ 712 (num_prop) = 0; \ 713 for (i = 0; i < (num_info); i++) { \ 714 for (j = 0; j < (num_prop); j++) \ 715 if ((prop)[j] == (info)[i].property) \ 716 break; \ 717 if (j == (num_prop)) \ 718 (prop)[(num_prop)++] = (info)[i].property; \ 719 } 720 721 /* Prepare to generate masks of regions of text with defined properties */ 722 LIST_PROPERTIES(props, num_props, oinfo, num_oinfo); 723 724 #define CLIP_PROPERTY(mask, prop, info, num_info) \ 725 for (j = 0; j < (num_info); j++) { \ 726 if ((info)[j].property == (prop)) { \ 727 CLIP_MASK((mask), (info)[j].left, (info)[j].right); \ 728 } \ 729 } 730 731 /* Only care about the old properties, new ones need to be redrawn */ 732 for (i = 0; i < num_props; i++) { 733 XrmQuark property = props[i]; 734 735 /* Reset oclip and nclip */ 736 XmuScanlineXor(oclip, oclip); 737 XmuScanlineXor(nclip, nclip); 738 739 /* Generate masks */ 740 CLIP_PROPERTY(oclip, property, oinfo, num_oinfo); 741 CLIP_PROPERTY(nclip, property, ninfo, num_ninfo); 742 743 /* Store unchanged region in oclip */ 744 XmuScanlineAnd(oclip, nclip); 745 746 /* Don't need to redraw the region in oclip */ 747 XmuScanlineXor(clip, oclip); 748 XmuOptimizeScanline(clip); 749 } 750 751 XmuDestroyScanline(oclip); 752 XmuDestroyScanline(nclip); 753 754 /* Tell Xaw that need update some regions */ 755 for (seg = clip->segment; seg; seg = seg->next) { 756 for (i = 0; i < src->textSrc.num_text; i++) 757 /* This really should have an exported interface... */ 758 _XawTextNeedsUpdating((TextWidget)(src->textSrc.text[i]), 759 seg->x1, seg->x2 + (seg->x2 > next)); 760 } 761 XmuDestroyScanline(clip); 762 763 data->syntable = syntable; 764 /* XXX check lisp__running to know if at the toplevel parsing state */ 765 if (indent && syntable != NIL && !lisp__running && 766 /* Doing an undo, probably will need an exported interface for this 767 * case. Should not change the text now. */ 768 (!src->textSrc.enable_undo || !src->textSrc.undo_state)) 769 XtAddCallback(textwindow, XtNpositionCallback, 770 XeditIndentationCallback, data); 771 } 772 773 /* 774 * This callback is called if the syntax table where the cursor is located 775 * defines an indentation function. 776 */ 777 static void 778 XeditIndentationCallback(Widget w, XtPointer client_data, XtPointer call_data) 779 { 780 LISP_SETUP(); 781 LispObj *indentp; 782 XeditLispData *data = (XeditLispData*)client_data; 783 784 data->disable_highlight = True; 785 XtRemoveCallback(w, XtNpositionCallback, XeditIndentationCallback, data); 786 787 LISP_ENTER(); 788 789 /* Get pointer to indentation function */ 790 indentp = APPLY1(Osyntable_indent, data->syntable); 791 792 /* Execute indentation function */ 793 if (indentp != NIL) 794 APPLY2(indentp, data->syntax, data->syntable); 795 796 data->disable_highlight = False; 797 798 LISP_LEAVE(); 799 } 800 801 /************************************************************************ 802 * Builtin functions 803 ************************************************************************/ 804 LispObj * 805 Xedit_AddEntity(LispBuiltin *builtin) 806 /* 807 add-entity offset length identifier 808 */ 809 { 810 LispObj *offset, *length, *identifier; 811 812 identifier = ARGUMENT(2); 813 length = ARGUMENT(1); 814 offset = ARGUMENT(0); 815 816 CHECK_INDEX(offset); 817 CHECK_INDEX(length); 818 CHECK_LONGINT(identifier); 819 820 return (XawTextSourceAddEntity(XawTextGetSource(textwindow), 0, 0, NULL, 821 FIXNUM_VALUE(offset), FIXNUM_VALUE(length), 822 LONGINT_VALUE(identifier)) ? T : NIL); 823 } 824 825 LispObj * 826 Xedit_AutoFill(LispBuiltin *builtin) 827 /* 828 auto-fill &optional value 829 */ 830 { 831 Arg arg[1]; 832 Boolean state; 833 834 LispObj *value; 835 836 value = ARGUMENT(0); 837 838 if (value != UNSPEC) { 839 XtSetArg(arg[0], XtNautoFill, value == NIL ? False : True); 840 XtSetValues(textwindow, arg, 1); 841 } 842 else { 843 XtSetArg(arg[0], XtNautoFill, &state); 844 XtGetValues(textwindow, arg, 1); 845 value = state ? T : NIL; 846 } 847 848 return (value); 849 } 850 851 LispObj * 852 Xedit_Background(LispBuiltin *builtin) 853 /* 854 background &optional color 855 */ 856 { 857 Pixel pixel; 858 Arg arg[1]; 859 XrmValue from, to; 860 861 LispObj *color; 862 863 color = ARGUMENT(0); 864 865 if (color != UNSPEC) { 866 CHECK_STRING(color); 867 868 from.size = STRLEN(color); 869 from.addr = (XtPointer)THESTR(color); 870 to.size = sizeof(Pixel); 871 to.addr = (XtPointer)&pixel; 872 873 if (!XtConvertAndStore(XawTextGetSink(textwindow), 874 XtRString, &from, XtRPixel, &to)) 875 LispDestroy("cannot convert %s to Pixel", STROBJ(color)); 876 877 XtSetArg(arg[0], XtNbackground, pixel); 878 XtSetValues(textwindow, arg, 1); 879 } 880 else { 881 from.size = sizeof(Pixel); 882 from.addr = (XtPointer)&pixel; 883 to.size = 0; 884 to.addr = NULL; 885 886 XtSetArg(arg[0], XtNbackground, &pixel); 887 XtGetValues(XawTextGetSink(textwindow), arg, 1); 888 /* This cannot fail */ 889 XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to); 890 891 color = STRING(to.addr); 892 } 893 894 return (color); 895 } 896 897 static LispObj * 898 XeditCharAt(LispBuiltin *builtin, int before) 899 { 900 Widget source = XawTextGetSource(textwindow); 901 XawTextPosition first, point, last; 902 XawTextBlock block; 903 904 LispObj *offset; 905 906 offset = ARGUMENT(0); 907 if (offset != UNSPEC) { 908 CHECK_INDEX(offset); 909 } 910 911 first = XawTextSourceScan(source, 0, XawstAll, XawsdLeft, 1, True); 912 if (FIXNUMP(offset)) 913 point = FIXNUM_VALUE(offset); 914 else 915 point = XawTextGetInsertionPoint(textwindow); 916 if (before && point > first) { 917 XawTextPosition position = 918 XawTextSourceScan(source, point, XawstPositions, XawsdLeft, 1, True); 919 920 if (position < point) 921 point = position; 922 else 923 return (NIL); 924 } 925 last = XawTextSourceScan(source, 0, XawstAll, XawsdRight, 1, True); 926 927 if (point < first || point > last) 928 return (NIL); 929 930 XawTextSourceRead(source, point, &block, 1); 931 932 return (block.length ? SCHAR(*(unsigned char*)block.ptr) : NIL); 933 } 934 935 LispObj * 936 Xedit_CharAfter(LispBuiltin *builtin) 937 /* 938 char-after &optional offset 939 */ 940 { 941 return (XeditCharAt(builtin, 0)); 942 } 943 944 LispObj * 945 Xedit_CharBefore(LispBuiltin *builtin) 946 /* 947 char-before &optional offset 948 */ 949 { 950 return (XeditCharAt(builtin, 1)); 951 } 952 953 LispObj * 954 Xedit_ClearEntities(LispBuiltin *builtin) 955 /* 956 clear-entities left right 957 */ 958 { 959 LispObj *left, *right; 960 961 right = ARGUMENT(1); 962 left = ARGUMENT(0); 963 964 CHECK_INDEX(left); 965 CHECK_INDEX(right); 966 967 XawTextSourceClearEntities(XawTextGetSource(textwindow), 968 FIXNUM_VALUE(left), FIXNUM_VALUE(right)); 969 970 return (T); 971 } 972 973 LispObj * 974 Xedit_ConvertPropertyList(LispBuiltin *builtin) 975 /* 976 convert-property-list name definition 977 */ 978 { 979 LispObj *result; 980 XawTextPropertyList *property_list; 981 982 LispObj *name, *definition; 983 984 definition = ARGUMENT(1); 985 name = ARGUMENT(0); 986 987 CHECK_STRING(name); 988 CHECK_STRING(definition); 989 990 result = NIL; 991 property_list = XawTextSinkConvertPropertyList(THESTR(name), 992 THESTR(definition), 993 topwindow->core.screen, 994 topwindow->core.colormap, 995 topwindow->core.depth); 996 997 if (property_list) { 998 Cardinal i; 999 1000 for (i = 0; i < num_property_lists; i++) 1001 /* Check if a new property list was created */ 1002 if (property_lists[i]->identifier == property_list->identifier) 1003 break; 1004 1005 /* Remember this pointer when asked back for it */ 1006 if (i == num_property_lists) { 1007 property_lists = (XawTextPropertyList**) 1008 XtRealloc((XtPointer)property_lists, 1009 sizeof(XawTextPropertyList) * 1010 (num_property_lists + 1)); 1011 property_lists[num_property_lists++] = property_list; 1012 } 1013 result = INTEGER(property_list->identifier); 1014 } 1015 1016 return (result); 1017 } 1018 1019 LispObj * 1020 Xedit_Font(LispBuiltin *builtin) 1021 /* 1022 font &optional font 1023 */ 1024 { 1025 XFontStruct *font_struct; 1026 Arg arg[1]; 1027 XrmValue from, to; 1028 1029 LispObj *font; 1030 1031 font = ARGUMENT(0); 1032 1033 if (font != UNSPEC) { 1034 CHECK_STRING(font); 1035 1036 from.size = STRLEN(font); 1037 from.addr = (XtPointer)THESTR(font); 1038 to.size = sizeof(XFontStruct*); 1039 to.addr = (XtPointer)&font_struct; 1040 1041 if (!XtConvertAndStore(textwindow, XtRString, &from, XtRFontStruct, &to)) 1042 LispDestroy("cannot convert %s to FontStruct", STROBJ(font)); 1043 1044 XtSetArg(arg[0], XtNfont, font_struct); 1045 XtSetValues(textwindow, arg, 1); 1046 } 1047 else { 1048 from.size = sizeof(XFontStruct*); 1049 from.addr = (XtPointer)&font_struct; 1050 to.size = 0; 1051 to.addr = NULL; 1052 1053 XtSetArg(arg[0], XtNfont, &font_struct); 1054 XtGetValues(XawTextGetSink(textwindow), arg, 1); 1055 /* This cannot fail */ 1056 XtConvertAndStore(textwindow, XtRFontStruct, &from, XtRString, &to); 1057 1058 font = STRING(to.addr); 1059 } 1060 1061 return (font); 1062 } 1063 1064 LispObj * 1065 Xedit_Foreground(LispBuiltin *builtin) 1066 /* 1067 foreground &optional color 1068 */ 1069 { 1070 Pixel pixel; 1071 Arg arg[1]; 1072 XrmValue from, to; 1073 1074 LispObj *color; 1075 1076 color = ARGUMENT(0); 1077 1078 if (color != UNSPEC) { 1079 CHECK_STRING(color); 1080 1081 from.size = STRLEN(color); 1082 from.addr = (XtPointer)THESTR(color); 1083 to.size = sizeof(Pixel); 1084 to.addr = (XtPointer)&pixel; 1085 1086 if (!XtConvertAndStore(XawTextGetSink(textwindow), 1087 XtRString, &from, XtRPixel, &to)) 1088 LispDestroy("cannot convert %s to Pixel", STROBJ(color)); 1089 1090 XtSetArg(arg[0], XtNforeground, pixel); 1091 XtSetValues(textwindow, arg, 1); 1092 } 1093 else { 1094 from.size = sizeof(Pixel); 1095 from.addr = (XtPointer)&pixel; 1096 to.size = 0; 1097 to.addr = NULL; 1098 1099 XtSetArg(arg[0], XtNforeground, &pixel); 1100 XtGetValues(XawTextGetSink(textwindow), arg, 1); 1101 /* This cannot fail */ 1102 XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to); 1103 1104 color = STRING(to.addr); 1105 } 1106 1107 return (color); 1108 } 1109 1110 LispObj * 1111 Xedit_GotoChar(LispBuiltin *builtin) 1112 /* 1113 goto-char offset 1114 */ 1115 { 1116 LispObj *offset; 1117 XawTextPosition point; 1118 1119 offset = ARGUMENT(0); 1120 1121 CHECK_INDEX(offset); 1122 XawTextSetInsertionPoint(textwindow, FIXNUM_VALUE(offset)); 1123 point = XawTextGetInsertionPoint(textwindow); 1124 if (point != FIXNUM_VALUE(offset)) 1125 offset = FIXNUM(point); 1126 1127 return (offset); 1128 } 1129 1130 LispObj * 1131 Xedit_HorizontalScrollbar(LispBuiltin *builtin) 1132 /* 1133 horizontal-scrollbar &optional state 1134 */ 1135 { 1136 Arg arg[1]; 1137 XawTextScrollMode scroll; 1138 1139 LispObj *state; 1140 1141 state = ARGUMENT(0); 1142 1143 if (state != UNSPEC) { 1144 scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways; 1145 XtSetArg(arg[0], XtNscrollHorizontal, scroll); 1146 XtSetValues(textwindow, arg, 1); 1147 } 1148 else { 1149 XtSetArg(arg[0], XtNscrollHorizontal, &scroll); 1150 XtGetValues(textwindow, arg, 1); 1151 state = scroll == XawtextScrollAlways ? T : NIL; 1152 } 1153 1154 return (state); 1155 } 1156 1157 LispObj * 1158 Xedit_Insert(LispBuiltin *builtin) 1159 /* 1160 insert text 1161 */ 1162 { 1163 XawTextPosition point = XawTextGetInsertionPoint(textwindow); 1164 XawTextBlock block; 1165 1166 LispObj *text; 1167 1168 text = ARGUMENT(0); 1169 1170 CHECK_STRING(text); 1171 1172 block.firstPos = 0; 1173 block.format = FMT8BIT; 1174 block.length = STRLEN(text); 1175 block.ptr = THESTR(text); 1176 XawTextReplace(textwindow, point, point, &block); 1177 XawTextSetInsertionPoint(textwindow, point + block.length); 1178 1179 return (text); 1180 } 1181 1182 LispObj * 1183 Xedit_Justification(LispBuiltin *builtin) 1184 /* 1185 justification &optional value 1186 */ 1187 { 1188 int i; 1189 Arg arg[1]; 1190 XawTextJustifyMode justify; 1191 1192 LispObj *value; 1193 1194 value = ARGUMENT(0); 1195 1196 if (value != UNSPEC) { 1197 for (i = 0; i < 4; i++) 1198 if (value == justify_modes[i]) 1199 break; 1200 if (i >= 4) 1201 LispDestroy("%s: argument must be " 1202 ":LEFT, :RIGHT, :CENTER, or :FULL, not %s", 1203 STRFUN(builtin), STROBJ(value)); 1204 XtSetArg(arg[0], XtNjustifyMode, (XawTextJustifyMode)i); 1205 XtSetValues(textwindow, arg, 1); 1206 } 1207 else { 1208 XtSetArg(arg[0], XtNjustifyMode, &justify); 1209 XtGetValues(textwindow, arg, 1); 1210 i = (int)justify; 1211 if (i <= 0 || i >= 4) 1212 i = 0; 1213 value = justify_modes[i]; 1214 } 1215 1216 return (value); 1217 } 1218 1219 LispObj * 1220 Xedit_LeftColumn(LispBuiltin *builtin) 1221 /* 1222 left-column &optional left 1223 */ 1224 { 1225 short left; 1226 Arg arg[1]; 1227 1228 LispObj *oleft; 1229 1230 oleft = ARGUMENT(0); 1231 1232 if (oleft != UNSPEC) { 1233 CHECK_INDEX(oleft); 1234 if (FIXNUM_VALUE(oleft) >= 32767) 1235 left = 32767; 1236 else 1237 left = FIXNUM_VALUE(oleft); 1238 1239 XtSetArg(arg[0], XtNleftColumn, left); 1240 XtSetValues(textwindow, arg, 1); 1241 } 1242 else { 1243 XtSetArg(arg[0], XtNleftColumn, &left); 1244 XtGetValues(textwindow, arg, 1); 1245 1246 oleft = FIXNUM((long)left); 1247 } 1248 1249 return (oleft); 1250 } 1251 1252 LispObj * 1253 Xedit_Point(LispBuiltin *builtin) 1254 /* 1255 point 1256 */ 1257 { 1258 return (FIXNUM(XawTextGetInsertionPoint(textwindow))); 1259 } 1260 1261 LispObj * 1262 Xedit_PointMax(LispBuiltin *builtin) 1263 /* 1264 point-max 1265 */ 1266 { 1267 return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0, 1268 XawstAll, XawsdRight, 1, True))); 1269 } 1270 1271 LispObj * 1272 Xedit_PointMin(LispBuiltin *builtin) 1273 /* 1274 point-min 1275 */ 1276 { 1277 return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0, 1278 XawstAll, XawsdLeft, 1, True))); 1279 } 1280 1281 LispObj * 1282 Xedit_PropertyList(LispBuiltin *builtin) 1283 /* 1284 property-list &optional value 1285 */ 1286 { 1287 Arg arg[1]; 1288 XawTextPropertyList *property_list; 1289 1290 LispObj *value; 1291 1292 value = ARGUMENT(0); 1293 1294 if (value != UNSPEC) { 1295 Cardinal i; 1296 XrmQuark quark; 1297 1298 CHECK_LONGINT(value); 1299 property_list = NULL; 1300 quark = LONGINT_VALUE(value); 1301 for (i = 0; i < num_property_lists; i++) 1302 if (property_lists[i]->identifier == quark) { 1303 property_list = property_lists[i]; 1304 break; 1305 } 1306 1307 if (property_list) { 1308 XtSetArg(arg[0], XawNtextProperties, property_list); 1309 XtSetValues(XawTextGetSink(textwindow), arg, 1); 1310 } 1311 else 1312 /* Maybe should generate an error here */ 1313 value = NIL; 1314 } 1315 else { 1316 XtSetArg(arg[0], XawNtextProperties, &property_list); 1317 XtGetValues(XawTextGetSink(textwindow), arg, 1); 1318 if (property_list) 1319 value = INTEGER(property_list->identifier); 1320 } 1321 1322 return (value); 1323 } 1324 1325 LispObj * 1326 Xedit_ReadText(LispBuiltin *builtin) 1327 /* 1328 read-text offset length 1329 */ 1330 { 1331 XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0, 1332 XawstAll, XawsdRight, 1, True); 1333 XawTextPosition from, to, len; 1334 XawTextBlock block; 1335 char *string, *ptr; 1336 1337 LispObj *offset, *length; 1338 1339 length = ARGUMENT(1); 1340 offset = ARGUMENT(0); 1341 1342 CHECK_INDEX(offset); 1343 CHECK_INDEX(length); 1344 1345 from = FIXNUM_VALUE(offset); 1346 to = from + FIXNUM_VALUE(length); 1347 if (from > last) 1348 from = last; 1349 if (to > last) 1350 to = last; 1351 1352 if (from == to) 1353 return (STRING("")); 1354 1355 len = to - from; 1356 string = LispMalloc(len); 1357 1358 for (ptr = string; from < to;) { 1359 XawTextSourceRead(XawTextGetSource(textwindow), from, &block, to - from); 1360 memcpy(ptr, block.ptr, block.length); 1361 ptr += block.length; 1362 from += block.length; 1363 } 1364 1365 return (LSTRING2(string, len)); 1366 } 1367 1368 LispObj * 1369 Xedit_ReplaceText(LispBuiltin *builtin) 1370 /* 1371 replace-text left right text 1372 */ 1373 { 1374 XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0, 1375 XawstAll, XawsdRight, 1, True); 1376 XawTextPosition left, right; 1377 XawTextBlock block; 1378 1379 LispObj *oleft, *oright, *text; 1380 1381 text = ARGUMENT(2); 1382 oright = ARGUMENT(1); 1383 oleft = ARGUMENT(0); 1384 1385 CHECK_INDEX(oleft); 1386 CHECK_INDEX(oright); 1387 CHECK_STRING(text); 1388 1389 left = FIXNUM_VALUE(oleft); 1390 right = FIXNUM_VALUE(oright); 1391 if (left > last) 1392 left = last; 1393 if (left > right) 1394 right = left; 1395 else if (right > last) 1396 right = last; 1397 1398 block.firstPos = 0; 1399 block.format = FMT8BIT; 1400 block.length = STRLEN(text); 1401 block.ptr = THESTR(text); 1402 XawTextReplace(textwindow, left, right, &block); 1403 1404 return (text); 1405 } 1406 1407 LispObj * 1408 Xedit_RightColumn(LispBuiltin *builtin) 1409 /* 1410 right-column &optional right 1411 */ 1412 { 1413 short right; 1414 Arg arg[1]; 1415 1416 LispObj *oright; 1417 1418 oright = ARGUMENT(0); 1419 1420 if (oright != UNSPEC) { 1421 CHECK_INDEX(oright); 1422 if (FIXNUM_VALUE(oright) >= 32767) 1423 right = 32767; 1424 else 1425 right = FIXNUM_VALUE(oright); 1426 1427 XtSetArg(arg[0], XtNrightColumn, right); 1428 XtSetValues(textwindow, arg, 1); 1429 } 1430 else { 1431 XtSetArg(arg[0], XtNrightColumn, &right); 1432 XtGetValues(textwindow, arg, 1); 1433 1434 oright = FIXNUM(right); 1435 } 1436 1437 return (oright); 1438 } 1439 1440 LispObj * 1441 Xedit_Scan(LispBuiltin *builtin) 1442 /* 1443 scan offset type direction &key count include 1444 */ 1445 { 1446 int i; 1447 XawTextPosition offset; 1448 XawTextScanType type; 1449 XawTextScanDirection direction; 1450 int count; 1451 1452 LispObj *ooffset, *otype, *odirection, *ocount, *include; 1453 1454 include = ARGUMENT(4); 1455 if (include == UNSPEC) 1456 include = NIL; 1457 ocount = ARGUMENT(3); 1458 odirection = ARGUMENT(2); 1459 otype = ARGUMENT(1); 1460 ooffset = ARGUMENT(0); 1461 1462 CHECK_INDEX(ooffset); 1463 offset = FIXNUM_VALUE(ooffset); 1464 1465 for (i = 0; i < 2; i++) 1466 if (odirection == scan_directions[i]) 1467 break; 1468 if (i >= 2) 1469 LispDestroy("%s: direction must be " 1470 ":LEFT or :RIGHT, not %s", 1471 STRFUN(builtin), STROBJ(odirection)); 1472 direction = (XawTextScanDirection)i; 1473 1474 for (i = 0; i < 6; i++) 1475 if (otype == scan_types[i]) 1476 break; 1477 if (i >= 6) 1478 LispDestroy("%s: direction must be " 1479 ":POSITIONS, :WHITE-SPACE, :EOL, " 1480 ":PARAGRAPH, :ALL, or :ALPHA-NUMERIC, not %s", 1481 STRFUN(builtin), STROBJ(otype)); 1482 type = (XawTextScanType)i; 1483 1484 if (ocount == UNSPEC) 1485 count = 1; 1486 else { 1487 CHECK_INDEX(ocount); 1488 count = FIXNUM_VALUE(ocount); 1489 } 1490 1491 offset = XawTextSourceScan(XawTextGetSource(textwindow), 1492 offset, type, direction, count, 1493 include != NIL); 1494 1495 return (FIXNUM(offset)); 1496 } 1497 1498 static LispObj * 1499 XeditSearch(LispBuiltin *builtin, XawTextScanDirection direction) 1500 { 1501 XawTextBlock block; 1502 XawTextPosition position; 1503 1504 LispObj *string, *offset, *ignore_case; 1505 1506 ignore_case = ARGUMENT(2); 1507 offset = ARGUMENT(1); 1508 string = ARGUMENT(0); 1509 1510 CHECK_STRING(string); 1511 if (offset != UNSPEC) { 1512 CHECK_INDEX(offset); 1513 position = FIXNUM_VALUE(offset); 1514 } 1515 else 1516 position = XawTextGetInsertionPoint(textwindow); 1517 1518 block.firstPos = (ignore_case != UNSPEC && ignore_case != NIL) ? 1 : 0; 1519 block.format = FMT8BIT; 1520 block.length = STRLEN(string); 1521 block.ptr = THESTR(string); 1522 position = XawTextSourceSearch(XawTextGetSource(textwindow), 1523 position, direction, &block); 1524 1525 return (position != XawTextSearchError ? FIXNUM(position) : NIL); 1526 } 1527 1528 1529 LispObj * 1530 Xedit_SearchBackward(LispBuiltin *builtin) 1531 /* 1532 search-backward string &optional offset ignore-case 1533 */ 1534 { 1535 return (XeditSearch(builtin, XawsdLeft)); 1536 } 1537 1538 LispObj * 1539 Xedit_SearchForward(LispBuiltin *builtin) 1540 /* 1541 search-forward string &optional offset ignore-case 1542 */ 1543 { 1544 return (XeditSearch(builtin, XawsdRight)); 1545 } 1546 1547 LispObj * 1548 Xedit_VerticalScrollbar(LispBuiltin *builtin) 1549 /* 1550 vertical-scrollbar &optional state 1551 */ 1552 { 1553 Arg arg[1]; 1554 XawTextScrollMode scroll; 1555 1556 LispObj *state; 1557 1558 state = ARGUMENT(0); 1559 1560 if (state != UNSPEC) { 1561 scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways; 1562 XtSetArg(arg[0], XtNscrollVertical, scroll); 1563 XtSetValues(textwindow, arg, 1); 1564 } 1565 else { 1566 XtSetArg(arg[0], XtNscrollVertical, &scroll); 1567 XtGetValues(textwindow, arg, 1); 1568 state = scroll == XawtextScrollAlways ? T : NIL; 1569 } 1570 1571 return (state); 1572 } 1573 1574 LispObj * 1575 Xedit_WrapMode(LispBuiltin *builtin) 1576 /* 1577 wrap-mode &optional value 1578 */ 1579 { 1580 int i; 1581 Arg arg[1]; 1582 XawTextWrapMode wrap; 1583 1584 LispObj *value; 1585 1586 value = ARGUMENT(0); 1587 1588 if (value != UNSPEC) { 1589 for (i = 0; i < 3; i++) 1590 if (value == wrap_modes[i]) 1591 break; 1592 if (i >= 3) 1593 LispDestroy("%s: argument must be " 1594 ":NEVER, :LINE, or :WORD, not %s", 1595 STRFUN(builtin), STROBJ(value)); 1596 XtSetArg(arg[0], XtNwrap, (XawTextWrapMode)i); 1597 XtSetValues(textwindow, arg, 1); 1598 } 1599 else { 1600 XtSetArg(arg[0], XtNwrap, &wrap); 1601 XtGetValues(textwindow, arg, 1); 1602 i = (int)wrap; 1603 if (i <= 0 || i >= 3) 1604 i = 0; 1605 value = wrap_modes[i]; 1606 } 1607 1608 return (value); 1609 } 1610 1611 LispObj * 1612 Xedit_XrmStringToQuark(LispBuiltin *builtin) 1613 /* 1614 xrm-string-to-quark string 1615 */ 1616 { 1617 LispObj *string; 1618 1619 string = ARGUMENT(0); 1620 1621 CHECK_STRING(string); 1622 1623 return (INTEGER(XrmStringToQuark(THESTR(string)))); 1624 } 1625
Indexes created Wed Jul 01 00:25:26 UTC 2026