![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to x11fns.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to x11fns.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 ! root 1: /* Functions for the X window system. ! 2: Copyright (C) 1988, 1990, 1992 Free Software Foundation. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is free software; you can redistribute it and/or modify ! 7: it under the terms of the GNU General Public License as published by ! 8: the Free Software Foundation; either version 1, or (at your option) ! 9: any later version. ! 10: ! 11: GNU Emacs is distributed in the hope that it will be useful, ! 12: but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: GNU General Public License for more details. ! 15: ! 16: You should have received a copy of the GNU General Public License ! 17: along with GNU Emacs; see the file COPYING. If not, write to ! 18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ ! 19: ! 20: /* Written by Yakim Martillo; rearranged by Richard Stallman. */ ! 21: /* Color and other features added by Robert Krawitz*/ ! 22: /* Converted to X11 by Robert French */ ! 23: ! 24: #include <stdio.h> ! 25: #include <signal.h> ! 26: #include "config.h" ! 27: ! 28: /* Get FIONREAD, if it is available. */ ! 29: #ifdef USG ! 30: #include <termio.h> ! 31: #endif /* USG */ ! 32: #include <fcntl.h> ! 33: ! 34: #ifndef VMS ! 35: #include <sys/ioctl.h> ! 36: #endif /* not VMS */ ! 37: ! 38: /* Allow m- file to inhibit use of interrupt-driven input. */ ! 39: #ifdef BROKEN_FIONREAD ! 40: #undef FIONREAD ! 41: #endif ! 42: ! 43: /* We are unable to use interrupts if FIONREAD is not available, ! 44: so flush SIGIO so we won't try. */ ! 45: #ifndef FIONREAD ! 46: #ifdef SIGIO ! 47: #undef SIGIO ! 48: #endif ! 49: #endif ! 50: ! 51: #include "x11term.h" ! 52: #include "dispextern.h" ! 53: #include "termchar.h" ! 54: ! 55: #ifdef HAVE_SOCKETS ! 56: #include <sys/socket.h> /* Must be done before gettime.h. */ ! 57: #endif ! 58: /* Include time.h or sys/time.h or both. */ ! 59: #include "gettime.h" ! 60: #include <setjmp.h> ! 61: ! 62: /* Prepare for lisp.h definition of NULL. ! 63: Sometimes x11term.h includes stddef.h. */ ! 64: #ifdef NULL ! 65: #undef NULL ! 66: #endif ! 67: ! 68: #include "lisp.h" ! 69: #include "window.h" ! 70: ! 71: #ifdef HAVE_X_WINDOWS ! 72: ! 73: #define abs(x) ((x < 0) ? ((x)) : (x)) ! 74: #define sgn(x) ((x < 0) ? (-1) : (1)) ! 75: #define min(a,b) ((a) < (b) ? (a) : (b)) ! 76: #define max(a,b) ((a) > (b) ? (a) : (b)) ! 77: ! 78: /* Non-nil if Emacs is running with an X window for display. ! 79: Nil if Emacs is run on an ordinary terminal. */ ! 80: ! 81: Lisp_Object Vxterm; ! 82: ! 83: Lisp_Object Vx_mouse_pos; ! 84: Lisp_Object Vx_mouse_abs_pos; ! 85: ! 86: Lisp_Object Vx_mouse_item; ! 87: ! 88: /* These are standard "white" and "black" strings, used in the ! 89: *_color variables when the color was not specially allocated for them. */ ! 90: char *white_color = "white"; ! 91: char *black_color = "black"; ! 92: ! 93: extern Lisp_Object MouseMap; ! 94: ! 95: extern Lisp_Object minibuf_window; ! 96: extern int minibuf_prompt_width; ! 97: ! 98: extern XEvent *XXm_queue[XMOUSEBUFSIZE]; ! 99: extern int XXm_queue_num; ! 100: extern int XXm_queue_in; ! 101: extern int XXm_queue_out; ! 102: extern char *fore_color; ! 103: extern char *back_color; ! 104: extern char *brdr_color; ! 105: extern char *mous_color; ! 106: extern char *curs_color; ! 107: ! 108: extern unsigned long fore; ! 109: extern unsigned long back; ! 110: extern unsigned long brdr; ! 111: extern unsigned long curs; ! 112: ! 113: extern int XXborder; ! 114: extern int XXInternalBorder; ! 115: ! 116: extern char *progname; ! 117: ! 118: extern XFontStruct *fontinfo; ! 119: extern Font XXfid; ! 120: extern GC XXgc_norm,XXgc_rev,XXgc_curs,XXgc_temp,XXgc_curs_rev; ! 121: extern XGCValues XXgcv; ! 122: extern int XXfontw,XXfonth,XXbase,XXisColor; ! 123: extern Colormap XXColorMap; ! 124: ! 125: extern int PendingExposure; ! 126: extern char *default_window; ! 127: extern char *desiredwindow; ! 128: ! 129: extern int XXscreen; ! 130: extern Window XXwindow; ! 131: extern Cursor EmacsCursor; ! 132: extern short MouseCursor[], MouseMask[]; ! 133: extern char *XXcurrentfont; ! 134: extern int informflag; ! 135: ! 136: extern int WindowMapped; ! 137: extern int CurHL; ! 138: extern int pixelwidth, pixelheight; ! 139: extern int XXpid; ! 140: ! 141: extern char *XXidentity; ! 142: ! 143: extern Display *XXdisplay; ! 144: extern int bitblt, CursorExists, VisibleX, VisibleY; ! 145: ! 146: check_xterm () ! 147: { ! 148: if (NULL (Vxterm)) ! 149: error ("Terminal does not understand X protocol."); ! 150: } ! 151: ! 152: DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P", ! 153: "For X window system, set audible vs visible bell.\n\ ! 154: With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.") ! 155: (arg) ! 156: Lisp_Object arg; ! 157: { ! 158: BLOCK_INPUT_DECLARE (); ! 159: ! 160: check_xterm (); ! 161: BLOCK_INPUT (); ! 162: if (!NULL (arg)) ! 163: XSetFlash (); ! 164: else ! 165: XSetFeep (); ! 166: UNBLOCK_INPUT (); ! 167: return arg; ! 168: } ! 169: ! 170: DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "", ! 171: "Toggle the background and foreground colors") ! 172: () ! 173: { ! 174: check_xterm (); ! 175: XFlipColor (); ! 176: return Qt; ! 177: } ! 178: ! 179: DEFUN ("x-set-foreground-color", Fx_set_foreground_color, ! 180: Sx_set_foreground_color, 1, 1, "sSet foreground color: ", ! 181: "Set foreground (text) color to COLOR.") ! 182: (arg) ! 183: Lisp_Object arg; ! 184: { ! 185: XColor cdef; ! 186: BLOCK_INPUT_DECLARE (); ! 187: char *save_color; ! 188: unsigned long save; ! 189: ! 190: save_color = fore_color; ! 191: save = fore; ! 192: check_xterm (); ! 193: CHECK_STRING (arg,1); ! 194: fore_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 195: bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1); ! 196: ! 197: BLOCK_INPUT (); ! 198: ! 199: if (fore_color && XXisColor && ! 200: XParseColor (XXdisplay, XXColorMap, fore_color, &cdef) && ! 201: XAllocColor(XXdisplay, XXColorMap, &cdef)) ! 202: fore = cdef.pixel; ! 203: else if (fore_color && !strcmp (fore_color, "white")) ! 204: fore = WhitePixel (XXdisplay, XXscreen), fore_color = white_color; ! 205: else if (fore_color && !strcmp (fore_color, "black")) ! 206: fore = BlackPixel (XXdisplay, XXscreen), fore_color = black_color; ! 207: else ! 208: fore_color = save_color; ! 209: ! 210: /* Now free the old background color ! 211: if it was specially allocated and we are not still using it. */ ! 212: if (save_color != white_color && save_color != black_color ! 213: && save_color != fore_color) ! 214: { ! 215: XFreeColors (XXdisplay, XXColorMap, &save, 1, 0); ! 216: free (save_color); ! 217: } ! 218: ! 219: XSetForeground(XXdisplay, XXgc_norm, fore); ! 220: XSetBackground(XXdisplay, XXgc_rev, fore); ! 221: ! 222: Fredraw_display (); ! 223: UNBLOCK_INPUT (); ! 224: ! 225: XFlush (XXdisplay); ! 226: return Qt; ! 227: } ! 228: ! 229: DEFUN ("x-set-background-color", Fx_set_background_color, ! 230: Sx_set_background_color, 1, 1, "sSet background color: ", ! 231: "Set background color to COLOR.") ! 232: (arg) ! 233: Lisp_Object arg; ! 234: { ! 235: XColor cdef; ! 236: BLOCK_INPUT_DECLARE (); ! 237: char *save_color; ! 238: unsigned long save; ! 239: ! 240: check_xterm (); ! 241: CHECK_STRING (arg,1); ! 242: save_color = back_color; ! 243: save = back; ! 244: back_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 245: bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1); ! 246: ! 247: BLOCK_INPUT (); ! 248: ! 249: if (back_color && XXisColor && ! 250: XParseColor (XXdisplay, XXColorMap, back_color, &cdef) && ! 251: XAllocColor(XXdisplay, XXColorMap, &cdef)) ! 252: back = cdef.pixel; ! 253: else if (back_color && !strcmp (back_color, "white")) ! 254: back = WhitePixel (XXdisplay, XXscreen), back_color = white_color; ! 255: else if (back_color && !strcmp (back_color, "black")) ! 256: back = BlackPixel (XXdisplay, XXscreen), back_color = black_color; ! 257: else ! 258: back_color = save_color; ! 259: ! 260: /* Now free the old background color ! 261: if it was specially allocated and we are not still using it. */ ! 262: if (save_color != white_color && save_color != black_color ! 263: && save_color != back_color) ! 264: { ! 265: XFreeColors (XXdisplay, XXColorMap, &save, 1, 0); ! 266: free (save_color); ! 267: } ! 268: ! 269: XSetBackground (XXdisplay, XXgc_norm, back); ! 270: XSetForeground (XXdisplay, XXgc_rev, back); ! 271: XSetForeground (XXdisplay, XXgc_curs, back); ! 272: XSetBackground (XXdisplay, XXgc_curs_rev, back); ! 273: XSetWindowBackground(XXdisplay, XXwindow, back); ! 274: XClearArea (XXdisplay, XXwindow, 0, 0, ! 275: screen_width*XXfontw+2*XXInternalBorder, ! 276: screen_height*XXfonth+2*XXInternalBorder, 0); ! 277: ! 278: UNBLOCK_INPUT (); ! 279: Fredraw_display (); ! 280: ! 281: XFlush (XXdisplay); ! 282: return Qt; ! 283: } ! 284: ! 285: DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1, ! 286: "sSet border color: ", ! 287: "Set border color to COLOR.") ! 288: (arg) ! 289: Lisp_Object arg; ! 290: { ! 291: XColor cdef; ! 292: BLOCK_INPUT_DECLARE (); ! 293: unsigned long save; ! 294: char *save_color; ! 295: ! 296: check_xterm (); ! 297: CHECK_STRING (arg,1); ! 298: brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1); ! 299: save = brdr; ! 300: save_color = brdr_color; ! 301: bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1); ! 302: ! 303: BLOCK_INPUT (); ! 304: ! 305: if (brdr_color && XXisColor && ! 306: XParseColor (XXdisplay, XXColorMap, brdr_color, &cdef) && ! 307: XAllocColor(XXdisplay, XXColorMap, &cdef)) ! 308: brdr = cdef.pixel; ! 309: else ! 310: { ! 311: if (brdr_color && !strcmp (brdr_color, "black")) ! 312: { ! 313: brdr = BlackPixel (XXdisplay, XXscreen); ! 314: brdr_color = black_color; ! 315: } ! 316: else ! 317: if (brdr_color && !strcmp (brdr_color, "white")) ! 318: { ! 319: brdr = WhitePixel (XXdisplay, XXscreen); ! 320: brdr_color = white_color; ! 321: } ! 322: else { ! 323: brdr_color = black_color; ! 324: brdr = BlackPixel (XXdisplay, XXscreen); ! 325: } ! 326: } ! 327: ! 328: /* Now free the old background color ! 329: if it was specially allocated and we are not still using it. */ ! 330: if (save_color != white_color && save_color != black_color ! 331: && save_color != brdr_color) ! 332: { ! 333: XFreeColors (XXdisplay, XXColorMap, &save, 1, 0); ! 334: free (save_color); ! 335: } ! 336: ! 337: if (XXborder) { ! 338: XSetWindowBorder(XXdisplay, XXwindow, brdr); ! 339: XFlush (XXdisplay); ! 340: } ! 341: ! 342: UNBLOCK_INPUT (); ! 343: ! 344: return Qt; ! 345: } ! 346: ! 347: DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1, ! 348: "sSet text cursor color: ", ! 349: "Set text cursor color to COLOR.") ! 350: (arg) ! 351: Lisp_Object arg; ! 352: { ! 353: XColor cdef; ! 354: BLOCK_INPUT_DECLARE (); ! 355: char *save_color; ! 356: unsigned long save; ! 357: ! 358: check_xterm (); ! 359: CHECK_STRING (arg,1); ! 360: save_color = curs_color; ! 361: save = curs; ! 362: curs_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 363: bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1); ! 364: ! 365: BLOCK_INPUT (); ! 366: ! 367: if (curs_color && XXisColor && ! 368: XParseColor (XXdisplay, XXColorMap, curs_color, &cdef) && ! 369: XAllocColor(XXdisplay, XXColorMap, &cdef)) ! 370: curs = cdef.pixel; ! 371: else if (curs_color && !strcmp (curs_color, "white")) ! 372: curs = WhitePixel (XXdisplay, XXscreen), curs_color = white_color; ! 373: else if (curs_color && !strcmp (curs_color, "black")) ! 374: curs = BlackPixel (XXdisplay, XXscreen), curs_color = black_color; ! 375: else ! 376: curs_color = save_color; ! 377: ! 378: /* Now free the old background color ! 379: if it was specially allocated and we are not still using it. */ ! 380: if (save_color != white_color && save_color != black_color ! 381: && save_color != curs_color) ! 382: { ! 383: XFreeColors (XXdisplay, XXColorMap, &save, 1, 0); ! 384: free (save_color); ! 385: } ! 386: ! 387: XSetBackground(XXdisplay, XXgc_curs, curs); ! 388: XSetForeground(XXdisplay, XXgc_curs_rev, curs); ! 389: ! 390: CursorToggle (); ! 391: CursorToggle (); ! 392: ! 393: UNBLOCK_INPUT (); ! 394: return Qt; ! 395: } ! 396: ! 397: DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1, ! 398: "sSet mouse cursor color: ", ! 399: "Set mouse cursor color to COLOR.") ! 400: (arg) ! 401: Lisp_Object arg; ! 402: { ! 403: BLOCK_INPUT_DECLARE (); ! 404: char *save_color; ! 405: ! 406: check_xterm (); ! 407: CHECK_STRING (arg,1); ! 408: save_color = mous_color; ! 409: mous_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 410: bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1); ! 411: ! 412: BLOCK_INPUT (); ! 413: ! 414: if (! x_set_cursor_colors ()) ! 415: mous_color = save_color; ! 416: else if (save_color != white_color && save_color != black_color ! 417: && save_color != mous_color) ! 418: free (save_color); ! 419: ! 420: XFlush (XXdisplay); ! 421: ! 422: UNBLOCK_INPUT (); ! 423: return Qt; ! 424: } ! 425: ! 426: /* Set the actual X cursor colors from `mous_color' and `back_color'. */ ! 427: ! 428: int ! 429: x_set_cursor_colors () ! 430: { ! 431: XColor forec, backc; ! 432: ! 433: char *useback; ! 434: ! 435: /* USEBACK is the background color, but on monochrome screens ! 436: changed if necessary not to match the mouse. */ ! 437: ! 438: useback = back_color; ! 439: ! 440: if (!XXisColor && !strcmp (mous_color, back_color)) ! 441: { ! 442: if (strcmp (back_color, "white")) ! 443: useback = white_color; ! 444: else ! 445: useback = black_color; ! 446: } ! 447: ! 448: if (XXisColor && mous_color ! 449: && XParseColor (XXdisplay, XXColorMap, mous_color, &forec) ! 450: && XParseColor (XXdisplay, XXColorMap, useback, &backc)) ! 451: { ! 452: XRecolorCursor (XXdisplay, EmacsCursor, &forec, &backc); ! 453: return 1; ! 454: } ! 455: else return 0; ! 456: } ! 457: ! 458: DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0, ! 459: "Returns t if the display is a color X terminal.") ! 460: () ! 461: { ! 462: check_xterm (); ! 463: ! 464: if (XXisColor) ! 465: return Qt; ! 466: else ! 467: return Qnil; ! 468: } ! 469: ! 470: DEFUN ("x-get-foreground-color", Fx_get_foreground_color, ! 471: Sx_get_foreground_color, 0, 0, 0, ! 472: "Returns the color of the foreground, as a string.") ! 473: () ! 474: { ! 475: Lisp_Object string; ! 476: ! 477: check_xterm (); ! 478: string = build_string (fore_color); ! 479: return string; ! 480: } ! 481: ! 482: DEFUN ("x-get-background-color", Fx_get_background_color, ! 483: Sx_get_background_color, 0, 0, 0, ! 484: "Returns the color of the background, as a string.") ! 485: () ! 486: { ! 487: Lisp_Object string; ! 488: ! 489: check_xterm (); ! 490: string = build_string (back_color); ! 491: return string; ! 492: } ! 493: ! 494: DEFUN ("x-get-border-color", Fx_get_border_color, ! 495: Sx_get_border_color, 0, 0, 0, ! 496: "Returns the color of the border, as a string.") ! 497: () ! 498: { ! 499: Lisp_Object string; ! 500: ! 501: check_xterm (); ! 502: string = build_string (brdr_color); ! 503: return string; ! 504: } ! 505: ! 506: DEFUN ("x-get-cursor-color", Fx_get_cursor_color, ! 507: Sx_get_cursor_color, 0, 0, 0, ! 508: "Returns the color of the cursor, as a string.") ! 509: () ! 510: { ! 511: Lisp_Object string; ! 512: ! 513: check_xterm (); ! 514: string = build_string (curs_color); ! 515: return string; ! 516: } ! 517: ! 518: DEFUN ("x-get-mouse-color", Fx_get_mouse_color, ! 519: Sx_get_mouse_color, 0, 0, 0, ! 520: "Returns the color of the mouse cursor, as a string.") ! 521: () ! 522: { ! 523: Lisp_Object string; ! 524: ! 525: check_xterm (); ! 526: string = build_string (mous_color); ! 527: return string; ! 528: } ! 529: ! 530: DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0, ! 531: "Get default for X-window attribute ATTRIBUTE from the system.\n\ ! 532: ATTRIBUTE must be a string.\n\ ! 533: Returns nil if attribute default isn't specified.") ! 534: (arg) ! 535: Lisp_Object arg; ! 536: { ! 537: char *default_name, *value; ! 538: ! 539: check_xterm (); ! 540: CHECK_STRING (arg, 1); ! 541: default_name = (char *) XSTRING (arg)->data; ! 542: ! 543: #ifdef XBACKWARDS ! 544: /* Some versions of X11R4, at least, have the args backwards. */ ! 545: if (XXidentity && *XXidentity) ! 546: value = XGetDefault (XXdisplay, default_name, XXidentity); ! 547: else ! 548: value = XGetDefault (XXdisplay, default_name, CLASS); ! 549: #else ! 550: if (XXidentity && *XXidentity) ! 551: value = XGetDefault (XXdisplay, XXidentity, default_name); ! 552: else ! 553: value = XGetDefault (XXdisplay, CLASS, default_name); ! 554: #endif ! 555: ! 556: if (value) ! 557: return build_string (value); ! 558: return (Qnil); ! 559: } ! 560: ! 561: DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ", ! 562: "Sets the font to be used for the X window.") ! 563: (arg) ! 564: Lisp_Object arg; ! 565: { ! 566: register char *newfontname; ! 567: ! 568: CHECK_STRING (arg, 1); ! 569: check_xterm (); ! 570: ! 571: newfontname = (char *) xmalloc (XSTRING (arg)->size + 1); ! 572: bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1); ! 573: if (XSTRING (arg)->size == 0) ! 574: goto badfont; ! 575: ! 576: if (!XNewFont (newfontname)) { ! 577: free (XXcurrentfont); ! 578: XXcurrentfont = newfontname; ! 579: return Qt; ! 580: } ! 581: badfont: ! 582: error ("Font \"%s\" is not defined", newfontname); ! 583: free (newfontname); ! 584: ! 585: return Qnil; ! 586: } ! 587: ! 588: DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p, ! 589: Scoordinates_in_window_p, 2, 2, 0, ! 590: "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\ ! 591: Returned value is list of positions expressed\n\ ! 592: relative to window upper left corner.") ! 593: (coordinate, window) ! 594: register Lisp_Object coordinate, window; ! 595: { ! 596: register Lisp_Object xcoord, ycoord; ! 597: int height; ! 598: ! 599: if (!CONSP (coordinate)) ! 600: wrong_type_argument (Qlistp, coordinate); ! 601: ! 602: CHECK_WINDOW (window, 2); ! 603: xcoord = Fcar (coordinate); ! 604: ycoord = Fcar (Fcdr (coordinate)); ! 605: CHECK_NUMBER (xcoord, 0); ! 606: CHECK_NUMBER (ycoord, 1); ! 607: if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) || ! 608: (XINT (xcoord) >= (XINT (XWINDOW (window)->left) + ! 609: XINT (XWINDOW (window)->width)))) ! 610: return Qnil; ! 611: ! 612: XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left); ! 613: ! 614: height = XINT (XWINDOW (window)->height); ! 615: ! 616: if (window != minibuf_window) ! 617: height --; ! 618: ! 619: if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) || ! 620: (XINT (ycoord) >= XINT (XWINDOW (window)->top) + height)) ! 621: return Qnil; ! 622: ! 623: XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top); ! 624: return Fcons (xcoord, Fcons (ycoord, Qnil)); ! 625: } ! 626: ! 627: DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0, ! 628: "Return number of pending mouse events from X window system.") ! 629: () ! 630: { ! 631: register Lisp_Object tem; ! 632: ! 633: check_xterm (); ! 634: ! 635: XSET (tem, Lisp_Int, XXm_queue_num); ! 636: ! 637: return tem; ! 638: } ! 639: ! 640: DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event, ! 641: 0, 0, 0, ! 642: "Pulls a mouse event out of the mouse event buffer and dispatches\n\ ! 643: the appropriate function to act upon this event.") ! 644: () ! 645: { ! 646: XEvent event; ! 647: register Lisp_Object mouse_cmd; ! 648: register char com_letter; ! 649: register char key_mask; ! 650: register Lisp_Object tempx; ! 651: register Lisp_Object tempy; ! 652: extern Lisp_Object get_keyelt (); ! 653: extern int meta_prefix_char; ! 654: ! 655: check_xterm (); ! 656: ! 657: if (XXm_queue_num) { ! 658: event = *XXm_queue[XXm_queue_out]; ! 659: free (XXm_queue[XXm_queue_out]); ! 660: XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE; ! 661: XXm_queue_num--; ! 662: com_letter = 3-(event.xbutton.button & 3); ! 663: key_mask = (event.xbutton.state & 15) << 4; ! 664: /* Get rid of the shift-lock bit. */ ! 665: key_mask &= ~0x20; ! 666: /* Report meta in 2 bit, not in 8 bit. */ ! 667: if (key_mask & 0x80) ! 668: { ! 669: key_mask |= 0x20; ! 670: key_mask &= ~0x80; ! 671: } ! 672: com_letter |= key_mask; ! 673: if (event.type == ButtonRelease) ! 674: com_letter |= 0x04; ! 675: XSET (tempx, Lisp_Int, ! 676: min (screen_width-1, ! 677: max (0, (event.xbutton.x-XXInternalBorder)/ ! 678: XXfontw))); ! 679: XSET (tempy, Lisp_Int, ! 680: min (screen_height-1, ! 681: max (0, (event.xbutton.y-XXInternalBorder)/ ! 682: XXfonth))); ! 683: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 684: XSET (tempx, Lisp_Int, event.xbutton.x_root); ! 685: XSET (tempy, Lisp_Int, event.xbutton.y_root); ! 686: Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 687: Vx_mouse_item = make_number (com_letter); ! 688: mouse_cmd ! 689: = get_keyelt (access_keymap (MouseMap, com_letter)); ! 690: if (NULL (mouse_cmd)) { ! 691: if (event.type != ButtonRelease) ! 692: bell (); ! 693: Vx_mouse_pos = Qnil; ! 694: } ! 695: else ! 696: return call1 (mouse_cmd, Vx_mouse_pos); ! 697: } ! 698: return Qnil; ! 699: } ! 700: ! 701: DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event, ! 702: 1, 1, 0, ! 703: "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\ ! 704: ARG non-nil means return nil immediately if no pending event;\n\ ! 705: otherwise, wait for an event.") ! 706: (arg) ! 707: Lisp_Object arg; ! 708: { ! 709: XEvent event; ! 710: register char com_letter; ! 711: register char key_mask; ! 712: ! 713: register Lisp_Object tempx; ! 714: register Lisp_Object tempy; ! 715: ! 716: check_xterm (); ! 717: ! 718: if (NULL (arg)) ! 719: while (!XXm_queue_num) ! 720: { ! 721: consume_available_input (); ! 722: Fsleep_for (make_number (1)); ! 723: } ! 724: /*** ??? Surely you don't mean to busy wait??? */ ! 725: ! 726: if (XXm_queue_num) { ! 727: event = *XXm_queue[XXm_queue_out]; ! 728: free (XXm_queue[XXm_queue_out]); ! 729: XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE; ! 730: XXm_queue_num--; ! 731: com_letter = 3-(event.xbutton.button & 3); ! 732: key_mask = (event.xbutton.state & 15) << 4; ! 733: /* Report meta in 2 bit, not in 8 bit. */ ! 734: if (key_mask & 0x80) ! 735: { ! 736: key_mask |= 0x20; ! 737: key_mask &= ~0x80; ! 738: } ! 739: com_letter |= key_mask; ! 740: if (event.type == ButtonRelease) ! 741: com_letter |= 0x04; ! 742: XSET (tempx, Lisp_Int, ! 743: min (screen_width-1, ! 744: max (0, (event.xbutton.x-XXInternalBorder)/ ! 745: XXfontw))); ! 746: XSET (tempy, Lisp_Int, ! 747: min (screen_height-1, ! 748: max (0, (event.xbutton.y-XXInternalBorder)/ ! 749: XXfonth))); ! 750: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 751: XSET (tempx, Lisp_Int, event.xbutton.x_root); ! 752: XSET (tempy, Lisp_Int, event.xbutton.y_root); ! 753: Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 754: Vx_mouse_item = make_number (com_letter); ! 755: return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil)); ! 756: } ! 757: return Qnil; ! 758: } ! 759: ! 760: DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer, ! 761: 1, 1, "sSend string to X:", ! 762: "Store contents of STRING into the cut buffer of the X window system.") ! 763: (string) ! 764: register Lisp_Object string; ! 765: { ! 766: BLOCK_INPUT_DECLARE (); ! 767: ! 768: CHECK_STRING (string, 1); ! 769: check_xterm (); ! 770: ! 771: BLOCK_INPUT (); ! 772: XStoreBytes (XXdisplay, (char *) XSTRING (string)->data, ! 773: XSTRING (string)->size); ! 774: /* Clear the selection owner, so that other applications ! 775: will use the cut buffer rather than a selection. */ ! 776: XSetSelectionOwner (XXdisplay, XA_PRIMARY, None, CurrentTime); ! 777: UNBLOCK_INPUT (); ! 778: ! 779: return Qnil; ! 780: } ! 781: ! 782: DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0, ! 783: "Return contents of cut buffer of the X window system, as a string.") ! 784: () ! 785: { ! 786: int len; ! 787: register Lisp_Object string; ! 788: BLOCK_INPUT_DECLARE (); ! 789: register char *d; ! 790: ! 791: check_xterm (); ! 792: BLOCK_INPUT (); ! 793: d = XFetchBytes (XXdisplay, &len); ! 794: string = make_string (d, len); ! 795: UNBLOCK_INPUT (); ! 796: ! 797: return string; ! 798: } ! 799: ! 800: DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width, ! 801: 1, 1, "nBorder width: ", ! 802: "Set width of border to WIDTH, in the X window system.") ! 803: (borderwidth) ! 804: register Lisp_Object borderwidth; ! 805: { ! 806: BLOCK_INPUT_DECLARE (); ! 807: ! 808: CHECK_NUMBER (borderwidth, 0); ! 809: ! 810: check_xterm (); ! 811: ! 812: if (XINT (borderwidth) < 0) ! 813: XSETINT (borderwidth, 0); ! 814: ! 815: BLOCK_INPUT (); ! 816: XSetWindowBorderWidth(XXdisplay, XXwindow, XINT(borderwidth)); ! 817: XFlush(XXdisplay); ! 818: UNBLOCK_INPUT (); ! 819: ! 820: return Qt; ! 821: } ! 822: ! 823: ! 824: DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width, ! 825: Sx_set_internal_border_width, 1, 1, "nInternal border width: ", ! 826: "Set width of internal border to WIDTH, in the X window system.") ! 827: (internalborderwidth) ! 828: register Lisp_Object internalborderwidth; ! 829: { ! 830: BLOCK_INPUT_DECLARE (); ! 831: ! 832: CHECK_NUMBER (internalborderwidth, 0); ! 833: ! 834: check_xterm (); ! 835: ! 836: if (XINT (internalborderwidth) < 0) ! 837: XSETINT (internalborderwidth, 0); ! 838: ! 839: BLOCK_INPUT (); ! 840: XXInternalBorder = XINT(internalborderwidth); ! 841: XSetWindowSize(screen_height,screen_width); ! 842: UNBLOCK_INPUT (); ! 843: ! 844: return Qt; ! 845: } ! 846: ! 847: #ifdef foobar ! 848: DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0, ! 849: "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\ ! 850: KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\ ! 851: and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\ ! 852: If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\ ! 853: all shift combinations.\n\ ! 854: Shift Lock 1 Shift 2\n\ ! 855: Meta 4 Control 8\n\ ! 856: \n\ ! 857: For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\ ! 858: in that file are in octal!)\n") ! 859: ! 860: (keycode, shift_mask, newstring) ! 861: register Lisp_Object keycode; ! 862: register Lisp_Object shift_mask; ! 863: register Lisp_Object newstring; ! 864: { ! 865: #ifdef notdef ! 866: char *rawstring; ! 867: int rawkey, rawshift; ! 868: int i; ! 869: int strsize; ! 870: ! 871: CHECK_NUMBER (keycode, 1); ! 872: if (!NULL (shift_mask)) ! 873: CHECK_NUMBER (shift_mask, 2); ! 874: CHECK_STRING (newstring, 3); ! 875: strsize = XSTRING (newstring) ->size; ! 876: rawstring = (char *) xmalloc (strsize); ! 877: bcopy (XSTRING (newstring)->data, rawstring, strsize); ! 878: rawkey = ((unsigned) (XINT (keycode))) & 255; ! 879: if (NULL (shift_mask)) ! 880: for (i = 0; i <= 15; i++) ! 881: XRebindCode (rawkey, i<<11, rawstring, strsize); ! 882: else ! 883: { ! 884: rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11; ! 885: XRebindCode (rawkey, rawshift, rawstring, strsize); ! 886: } ! 887: #endif notdef ! 888: return Qnil; ! 889: } ! 890: ! 891: DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0, ! 892: "Rebind KEYCODE to list of strings STRINGS.\n\ ! 893: STRINGS should be a list of 16 elements, one for each all shift combination.\n\ ! 894: nil as element means don't change.\n\ ! 895: See the documentation of x-rebind-key for more information.") ! 896: (keycode, strings) ! 897: register Lisp_Object keycode; ! 898: register Lisp_Object strings; ! 899: { ! 900: #ifdef notdef ! 901: register Lisp_Object item; ! 902: register char *rawstring; ! 903: int rawkey, strsize; ! 904: register unsigned i; ! 905: ! 906: CHECK_NUMBER (keycode, 1); ! 907: CHECK_CONS (strings, 2); ! 908: rawkey = ((unsigned) (XINT (keycode))) & 255; ! 909: for (i = 0; i <= 15; strings = Fcdr (strings), i++) ! 910: { ! 911: item = Fcar (strings); ! 912: if (!NULL (item)) ! 913: { ! 914: CHECK_STRING (item, 2); ! 915: strsize = XSTRING (item)->size; ! 916: rawstring = (char *) xmalloc (strsize); ! 917: bcopy (XSTRING (item)->data, rawstring, strsize); ! 918: XRebindCode (rawkey, i << 11, rawstring, strsize); ! 919: } ! 920: } ! 921: #endif notdef ! 922: return Qnil; ! 923: } ! 924: ! 925: #endif foobar ! 926: ! 927: XExitWithCoreDump () ! 928: { ! 929: XCleanUp (); ! 930: abort (); ! 931: } ! 932: ! 933: DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0, ! 934: "ARG non-nil means that X errors should generate a coredump.") ! 935: (arg) ! 936: register Lisp_Object arg; ! 937: { ! 938: int (*handler)(); ! 939: ! 940: check_xterm (); ! 941: if (!NULL (arg)) ! 942: handler = XExitWithCoreDump; ! 943: else ! 944: { ! 945: extern int XIgnoreError (); ! 946: handler = XIgnoreError; ! 947: } ! 948: XSetErrorHandler(handler); ! 949: XSetIOErrorHandler(handler); ! 950: return (Qnil); ! 951: } ! 952: ! 953: XRedrawDisplay () ! 954: { ! 955: Fredraw_display (); ! 956: } ! 957: ! 958: XCleanUp () ! 959: { ! 960: Fdo_auto_save (Qt); ! 961: ! 962: #ifdef subprocesses ! 963: kill_buffer_processes (Qnil); ! 964: #endif /* subprocesses */ ! 965: } ! 966: ! 967: syms_of_xfns () ! 968: { ! 969: /* If not dumping, init_display ran before us, so don't override it. */ ! 970: #ifdef CANNOT_DUMP ! 971: if (noninteractive) ! 972: #endif ! 973: Vxterm = Qnil; ! 974: ! 975: DEFVAR_LISP ("x-mouse-item", &Vx_mouse_item, ! 976: "Encoded representation of last mouse click, corresponding to\n\ ! 977: numerical entries in x-mouse-map."); ! 978: Vx_mouse_item = Qnil; ! 979: DEFVAR_LISP ("x-mouse-pos", &Vx_mouse_pos, ! 980: "Current x-y position of mouse by row, column as specified by font."); ! 981: Vx_mouse_pos = Qnil; ! 982: DEFVAR_LISP ("x-mouse-abs-pos", &Vx_mouse_abs_pos, ! 983: "Current x-y position of mouse relative to root window."); ! 984: Vx_mouse_abs_pos = Qnil; ! 985: ! 986: defsubr (&Sx_set_bell); ! 987: defsubr (&Sx_flip_color); ! 988: defsubr (&Sx_set_font); ! 989: #ifdef notdef ! 990: defsubr (&Sx_set_icon); ! 991: #endif notdef ! 992: defsubr (&Scoordinates_in_window_p); ! 993: defsubr (&Sx_mouse_events); ! 994: defsubr (&Sx_proc_mouse_event); ! 995: defsubr (&Sx_get_mouse_event); ! 996: defsubr (&Sx_store_cut_buffer); ! 997: defsubr (&Sx_get_cut_buffer); ! 998: defsubr (&Sx_set_border_width); ! 999: defsubr (&Sx_set_internal_border_width); ! 1000: defsubr (&Sx_set_foreground_color); ! 1001: defsubr (&Sx_set_background_color); ! 1002: defsubr (&Sx_set_border_color); ! 1003: defsubr (&Sx_set_cursor_color); ! 1004: defsubr (&Sx_set_mouse_color); ! 1005: defsubr (&Sx_get_foreground_color); ! 1006: defsubr (&Sx_get_background_color); ! 1007: defsubr (&Sx_get_border_color); ! 1008: defsubr (&Sx_get_cursor_color); ! 1009: defsubr (&Sx_get_mouse_color); ! 1010: defsubr (&Sx_color_p); ! 1011: defsubr (&Sx_get_default); ! 1012: #ifdef notdef ! 1013: defsubr (&Sx_rebind_key); ! 1014: defsubr (&Sx_rebind_keys); ! 1015: #endif notdef ! 1016: defsubr (&Sx_debug); ! 1017: } ! 1018: ! 1019: #endif /* HAVE_X_WINDOWS */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.