![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to xfns.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to xfns.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 ! root 1: /* Functions for the X window system. ! 2: Copyright (C) 1985, 1986, 1987 Free Software Foundation. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is distributed in the hope that it will be useful, ! 7: but WITHOUT ANY WARRANTY. No author or distributor ! 8: accepts responsibility to anyone for the consequences of using it ! 9: or for whether it serves any particular purpose or works at all, ! 10: unless he says so in writing. Refer to the GNU Emacs General Public ! 11: License for full details. ! 12: ! 13: Everyone is granted permission to copy, modify and redistribute ! 14: GNU Emacs, but only under the conditions described in the ! 15: GNU Emacs General Public License. A copy of this license is ! 16: supposed to have been given to you along with GNU Emacs so you ! 17: can know your rights and responsibilities. It should be in a ! 18: file named COPYING. Among other things, the copyright notice ! 19: and this notice must be preserved on all copies. */ ! 20: ! 21: /* Written by Yakim Martillo; rearranged by Richard Stallman. */ ! 22: /* Color and other features added by Robert Krawitz*/ ! 23: ! 24: /*#include <stdio.h>*/ ! 25: #include <signal.h> ! 26: #include "config.h" ! 27: #include "lisp.h" ! 28: #include "window.h" ! 29: #include "xterm.h" ! 30: #include "dispextern.h" ! 31: #include "termchar.h" ! 32: #include <fcntl.h> ! 33: #include <setjmp.h> ! 34: ! 35: #ifdef HAVE_TIMEVAL ! 36: #ifndef USG ! 37: #include <sys/time.h> ! 38: #else ! 39: #include <time.h> ! 40: #endif /* USG */ ! 41: #endif ! 42: ! 43: #ifdef HAVE_X_WINDOWS ! 44: ! 45: #define abs(x) ((x < 0) ? ((x)) : (x)) ! 46: #define sgn(x) ((x < 0) ? (-1) : (1)) ! 47: #define min(a,b) ((a) < (b) ? (a) : (b)) ! 48: #define max(a,b) ((a) > (b) ? (a) : (b)) ! 49: ! 50: #define CROSS_WIDTH 16 ! 51: #define CROSS_HEIGHT 16 ! 52: ! 53: static short cross_bits[] = ! 54: { ! 55: 0x0000, 0x0180, 0x0180, 0x0180, ! 56: 0x0180, 0x0180, 0x0180, 0x7ffe, ! 57: 0x7ffe, 0x0180, 0x0180, 0x0180, ! 58: 0x0180, 0x0180, 0x0180, 0x0000, ! 59: }; ! 60: ! 61: static short gray_bits[] = { ! 62: 0xaaaa, 0x5555, 0xaaaa, 0x5555, ! 63: 0xaaaa, 0x5555, 0xaaaa, 0x5555, ! 64: 0xaaaa, 0x5555, 0xaaaa, 0x5555, ! 65: 0xaaaa, 0x5555, 0xaaaa, 0x5555}; ! 66: ! 67: #define CROSS_MASK_WIDTH 16 ! 68: #define CROSS_MASK_HEIGHT 16 ! 69: static short cross_mask_bits[] = ! 70: { ! 71: 0x03c0, 0x03c0, 0x03c0, 0x03c0, ! 72: 0x03c0, 0x03c0, 0xffff, 0xffff, ! 73: 0xffff, 0xffff, 0x03c0, 0x03c0, ! 74: 0x03c0, 0x03c0, 0x03c0, 0x03c0, ! 75: }; ! 76: ! 77: extern short sink_bits[]; ! 78: extern short sink_mask_bits[]; ! 79: #define sink_width 48 ! 80: #define sink_height 48 ! 81: #define sink_mask_width 48 ! 82: #define sink_mask_height 48 ! 83: ! 84: extern XREPBUFFER Xxrepbuffer; ! 85: ! 86: /* Non-nil if Emacs is running with an X window for display. ! 87: Nil if Emacs is run on an ordinary terminal. ! 88: Initialized in dispnew.c. */ ! 89: ! 90: Lisp_Object Vxterm; ! 91: ! 92: Lisp_Object Vx_mouse_pos, Vx_mouse_abs_pos; ! 93: ! 94: Lisp_Object Vx_mouse_item; ! 95: ! 96: extern struct Lisp_Vector *MouseMap; ! 97: ! 98: extern char *fore_color; ! 99: extern char *back_color; ! 100: extern char *brdr_color; ! 101: extern char *mous_color; ! 102: extern char *curs_color; ! 103: ! 104: extern int fore; ! 105: extern int back; ! 106: extern int brdr; ! 107: extern int mous; ! 108: extern int curs; ! 109: ! 110: extern int XXborder; ! 111: extern int XXInternalBorder; ! 112: ! 113: extern int (*handler) (); ! 114: ! 115: extern FontInfo *fontinfo; ! 116: ! 117: extern int PendingExposure; ! 118: extern char *default_window; ! 119: ! 120: extern Window XXwindow; ! 121: extern Cursor EmacsCursor; ! 122: extern short MouseCursor[], MouseMask[]; ! 123: extern char *XXcurrentfont; ! 124: extern int informflag; ! 125: ! 126: extern int WindowMapped; ! 127: extern char iconidentity[]; ! 128: extern int CurHL; ! 129: extern int pixelwidth, pixelheight; ! 130: extern int XXxoffset, XXyoffset; ! 131: extern int XXpid; ! 132: ! 133: extern Display *XXdisplay; ! 134: extern Window XXIconWindow; ! 135: extern int IconWindow; ! 136: extern Bitmap XXIconMask; ! 137: extern int bitblt, CursorExists, VisibleX, VisibleY; ! 138: extern WindowInfo rootwindowinfo; ! 139: ! 140: extern void x_init_1 (); ! 141: ! 142: /* Nonzero if x-set-window-edges has been called ! 143: or x-rubber-band has been called. ! 144: If it is zero when x-pop-up-window is called, ! 145: x-rubber-band is called at that point. */ ! 146: ! 147: int x_edges_specified; ! 148: ! 149: check_xterm () ! 150: { ! 151: if (NULL (Vxterm)) ! 152: error ("Terminal does not understand X protocol."); ! 153: } ! 154: ! 155: DEFUN ("x-pop-up-window", Fx_pop_up_window, Sx_pop_up_window, 0, 0, 0, ! 156: "Make the X window appear on the screen.") ! 157: () ! 158: { ! 159: check_xterm (); ! 160: XPopUpWindow (); ! 161: return Qnil; ! 162: } ! 163: ! 164: DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P", ! 165: "For X window system, set audible vs visible bell.\n\ ! 166: With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.") ! 167: (arg) ! 168: Lisp_Object arg; ! 169: { ! 170: BLOCK_INPUT_DECLARE () ! 171: ! 172: check_xterm (); ! 173: BLOCK_INPUT (); ! 174: if (!NULL (arg)) ! 175: XSetFlash (); ! 176: else ! 177: XSetFeep (); ! 178: UNBLOCK_INPUT (); ! 179: return arg; ! 180: } ! 181: ! 182: DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "", ! 183: "Toggle the background and foreground colors") ! 184: () ! 185: { ! 186: check_xterm (); ! 187: XFlipColor (); ! 188: return Qt; ! 189: } ! 190: ! 191: DEFUN ("x-set-foreground-color", Fx_set_foreground_color, ! 192: Sx_set_foreground_color, 1, 1, "sSet foregroud color: ", ! 193: "Set foreground (text) color to COLOR.") ! 194: (arg) ! 195: Lisp_Object arg; ! 196: { ! 197: Color cdef; ! 198: BLOCK_INPUT_DECLARE () ! 199: char *save_color; ! 200: ! 201: save_color = fore_color; ! 202: check_xterm (); ! 203: CHECK_STRING (arg,1); ! 204: fore_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 205: BLOCK_INPUT (); ! 206: bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1); ! 207: if (fore_color && DisplayCells () > 2 && ! 208: XParseColor (fore_color, &cdef) && XGetHardwareColor (&cdef)) ! 209: { ! 210: fore = cdef.pixel; ! 211: } ! 212: else if (fore_color && strcmp (fore_color, "black") == 0) ! 213: { ! 214: fore = BlackPixel; ! 215: } ! 216: else if (fore_color && strcmp (fore_color, "white") == 0) ! 217: { ! 218: fore = WhitePixel; ! 219: } ! 220: else ! 221: { ! 222: fore_color = save_color; ! 223: } ! 224: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width, ! 225: screen_height * fontinfo->height, back, ClipModeClipped, ! 226: GXcopy, AllPlanes);*/ ! 227: Fredraw_display (); ! 228: /* dumprectangle (0, 0, screen_height * fontinfo->height, ! 229: screen_width * fontinfo -> width);*/ ! 230: /* PendingExposure = 1; ! 231: xfixscreen ();*/ ! 232: UNBLOCK_INPUT (); ! 233: XFlush (); ! 234: return Qt; ! 235: } ! 236: ! 237: DEFUN ("x-set-background-color", Fx_set_background_color, ! 238: Sx_set_background_color, 1, 1, "sSet background color: ", ! 239: "Set background color to COLOR.") ! 240: (arg) ! 241: Lisp_Object arg; ! 242: { ! 243: Color cdef; ! 244: Pixmap temp; ! 245: BLOCK_INPUT_DECLARE () ! 246: char *save_color; ! 247: ! 248: check_xterm (); ! 249: CHECK_STRING (arg,1); ! 250: save_color = back_color; ! 251: back_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 252: bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1); ! 253: BLOCK_INPUT (); ! 254: if (back_color && DisplayCells () > 2 && ! 255: XParseColor (back_color, &cdef) && XGetHardwareColor (&cdef)) ! 256: { ! 257: back = cdef.pixel; ! 258: } ! 259: else if (back_color && strcmp (back_color, "white") == 0) ! 260: { ! 261: back = WhitePixel; ! 262: } ! 263: else if (back_color && strcmp (back_color, "black") == 0) ! 264: { ! 265: back = BlackPixel; ! 266: } ! 267: else ! 268: { ! 269: back_color = save_color; ! 270: } ! 271: temp = XMakeTile (back); ! 272: XChangeBackground (XXwindow, temp); ! 273: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width, ! 274: screen_height * fontinfo->height, back, ClipModeClipped, ! 275: GXcopy, AllPlanes);*/ ! 276: UNBLOCK_INPUT (); ! 277: Fredraw_display (); ! 278: /* dumprectangle (0, 0, screen_height * fontinfo->height, ! 279: screen_width * fontinfo -> width);*/ ! 280: /* PendingExposure = 1; ! 281: xfixscreen ();*/ ! 282: XFlush (); ! 283: XFreePixmap (temp); ! 284: return Qt; ! 285: } ! 286: ! 287: DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1, ! 288: "sSet border color: ", ! 289: "Set border color to COLOR.") ! 290: (arg) ! 291: Lisp_Object arg; ! 292: { ! 293: Color cdef; ! 294: Pixmap temp; ! 295: BLOCK_INPUT_DECLARE () ! 296: ! 297: check_xterm (); ! 298: CHECK_STRING (arg,1); ! 299: brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1); ! 300: bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1); ! 301: BLOCK_INPUT (); ! 302: if (brdr_color && DisplayCells () > 2 && ! 303: XParseColor (brdr_color, &cdef) && XGetHardwareColor (&cdef)) ! 304: { ! 305: temp = XMakeTile (cdef.pixel); ! 306: brdr = cdef.pixel; ! 307: } ! 308: else if (brdr_color && strcmp (brdr_color, "black") == 0) ! 309: { ! 310: temp = BlackPixmap; ! 311: brdr = BlackPixel; ! 312: } ! 313: else if (brdr_color && strcmp (brdr_color, "white") == 0) ! 314: { ! 315: temp = WhitePixmap; ! 316: brdr = WhitePixel; ! 317: } ! 318: else ! 319: { ! 320: temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), ! 321: BlackPixel, WhitePixel); ! 322: brdr = BlackPixel; ! 323: brdr_color = "gray"; ! 324: } ! 325: if (XXborder) ! 326: XChangeBorder (XXwindow, temp); ! 327: UNBLOCK_INPUT (); ! 328: XFreePixmap (temp); ! 329: return Qt; ! 330: } ! 331: ! 332: DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1, ! 333: "sSet text cursor color: ", ! 334: "Set text cursor color to COLOR.") ! 335: (arg) ! 336: Lisp_Object arg; ! 337: { ! 338: Color cdef; ! 339: BLOCK_INPUT_DECLARE () ! 340: char *save_color; ! 341: ! 342: check_xterm (); ! 343: CHECK_STRING (arg,1); ! 344: save_color = curs_color; ! 345: curs_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 346: BLOCK_INPUT (); ! 347: bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1); ! 348: if (curs_color && DisplayCells () > 2 && ! 349: XParseColor (curs_color, &cdef) && XGetHardwareColor (&cdef)) ! 350: { ! 351: curs = cdef.pixel; ! 352: } ! 353: else if (curs_color && strcmp (curs_color, "black") == 0) ! 354: { ! 355: curs = BlackPixel; ! 356: } ! 357: else if (curs_color && strcmp (curs_color, "white") == 0) ! 358: { ! 359: curs = WhitePixel; ! 360: } ! 361: else ! 362: { ! 363: curs_color = save_color; ! 364: } ! 365: CursorToggle (); ! 366: CursorToggle (); ! 367: UNBLOCK_INPUT (); ! 368: return Qt; ! 369: } ! 370: ! 371: DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1, ! 372: "sSet mouse cursor color: ", ! 373: "Set mouse cursor color to COLOR.") ! 374: (arg) ! 375: Lisp_Object arg; ! 376: { ! 377: Cursor temp; ! 378: BLOCK_INPUT_DECLARE () ! 379: Color cdef; ! 380: char *save_color; ! 381: ! 382: check_xterm (); ! 383: CHECK_STRING (arg,1); ! 384: save_color = mous_color; ! 385: mous_color = (char *) xmalloc (XSTRING (arg)->size + 1); ! 386: BLOCK_INPUT (); ! 387: bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1); ! 388: ! 389: if (mous_color && DisplayCells () > 2 ! 390: && XParseColor (mous_color, &cdef) && XGetHardwareColor (&cdef)) ! 391: { ! 392: mous = cdef.pixel; ! 393: } ! 394: else if (mous_color && strcmp (mous_color, "black") == 0) ! 395: { ! 396: mous = BlackPixel; ! 397: } ! 398: else if (mous_color && strcmp (mous_color, "white") == 0) ! 399: { ! 400: mous = WhitePixel; ! 401: } ! 402: else ! 403: { ! 404: mous_color = save_color; ! 405: } ! 406: temp = XCreateCursor (16, 16, MouseCursor, MouseMask, 0, 0, ! 407: mous, back, GXcopy); ! 408: XDefineCursor (XXwindow, temp); ! 409: XFreeCursor (EmacsCursor); ! 410: UNBLOCK_INPUT (); ! 411: bcopy (&temp, &EmacsCursor, sizeof (Cursor)); ! 412: return Qt; ! 413: } ! 414: ! 415: DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0, ! 416: "Returns t if the display is a color X terminal.") ! 417: () ! 418: { ! 419: check_xterm (); ! 420: if (DisplayCells () > 2) ! 421: return Qt; ! 422: else ! 423: return Qnil; ! 424: } ! 425: ! 426: DEFUN ("x-get-foreground-color", Fx_get_foreground_color, ! 427: Sx_get_foreground_color, 0, 0, 0, ! 428: "Returns the color of the foreground, as a string.") ! 429: () ! 430: { ! 431: Lisp_Object string; ! 432: string = build_string (fore_color); ! 433: return string; ! 434: } ! 435: ! 436: DEFUN ("x-get-background-color", Fx_get_background_color, ! 437: Sx_get_background_color, 0, 0, 0, ! 438: "Returns the color of the background, as a string.") ! 439: () ! 440: { ! 441: Lisp_Object string; ! 442: string = build_string (back_color); ! 443: return string; ! 444: } ! 445: ! 446: DEFUN ("x-get-border-color", Fx_get_border_color, ! 447: Sx_get_border_color, 0, 0, 0, ! 448: "Returns the color of the border, as a string.") ! 449: () ! 450: { ! 451: Lisp_Object string; ! 452: string = build_string (brdr_color); ! 453: return string; ! 454: } ! 455: ! 456: DEFUN ("x-get-cursor-color", Fx_get_cursor_color, ! 457: Sx_get_cursor_color, 0, 0, 0, ! 458: "Returns the color of the cursor, as a string.") ! 459: () ! 460: { ! 461: Lisp_Object string; ! 462: string = build_string (curs_color); ! 463: return string; ! 464: } ! 465: ! 466: DEFUN ("x-get-mouse-color", Fx_get_mouse_color, ! 467: Sx_get_mouse_color, 0, 0, 0, ! 468: "Returns the color of the mouse cursor, as a string.") ! 469: () ! 470: { ! 471: Lisp_Object string; ! 472: string = build_string (mous_color); ! 473: return string; ! 474: } ! 475: ! 476: DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0, ! 477: "Get X default ATTRIBUTE from the system. Returns nil if\n\ ! 478: attribute does not exist.") ! 479: (arg) ! 480: Lisp_Object arg; ! 481: { ! 482: unsigned char *default_name, *value; ! 483: ! 484: CHECK_STRING (arg, 1); ! 485: default_name = XSTRING (arg)->data; ! 486: ! 487: value = (unsigned char *) XGetDefault ("emacs", default_name); ! 488: /* if (value == 0) ! 489: value = XGetDefault ("", default_name); */ ! 490: if (value) ! 491: return build_string (value); ! 492: else ! 493: return (Qnil); ! 494: } ! 495: ! 496: DEFUN ("x-set-icon", Fx_set_icon, Sx_set_icon, 1, 1, "P", ! 497: "Set type of icon used by X for Emacs's window.\n\ ! 498: ARG non-nil means use kitchen-sink icon;\n\ ! 499: nil means use generic window manager icon.") ! 500: (arg) ! 501: Lisp_Object arg; ! 502: { ! 503: check_xterm (); ! 504: if (NULL (arg)) ! 505: XTextIcon (); ! 506: else ! 507: XBitmapIcon (); ! 508: return arg; ! 509: } ! 510: ! 511: DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ", ! 512: "At initialization sets the font to be used for the X window.") ! 513: (arg) ! 514: Lisp_Object arg; ! 515: { ! 516: register char *newfontname; ! 517: ! 518: CHECK_STRING (arg, 1); ! 519: check_xterm (); ! 520: ! 521: newfontname = (char *) xmalloc (XSTRING (arg)->size + 1); ! 522: bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1); ! 523: if (XSTRING (arg)->size == 0) ! 524: /* XOpenFont ("") gets a badarg error rather than a badfont error. ! 525: I believe this is an X bug. ! 526: In emacs, badarg errors cause emacs to die, whilst badfont errors ! 527: are caught. This kludge prevents us from dying. ! 528: */ ! 529: goto badfont; ! 530: ! 531: if (!XNewFont (newfontname)) ! 532: { ! 533: free (XXcurrentfont); ! 534: XXcurrentfont = newfontname; ! 535: return Qt; ! 536: } ! 537: else ! 538: { ! 539: badfont: ! 540: error ("Font \"%s\" is not defined", newfontname); ! 541: free (newfontname); ! 542: } ! 543: ! 544: return Qnil; ! 545: } ! 546: ! 547: DEFUN ("x-set-window-edges", Fx_set_window_edges, Sx_set_window_edges, 4, 4, ! 548: "nNumber of Columns: \nnNumber of Rows: \nnX Offset in Pixels: \n\ ! 549: nY Offset in Pixels: ", ! 550: "Sets X window size/position: size COLS by ROWS, positions XOFF and YOFF.\n\ ! 551: To get \"minus zero\" for XOFF or YOFF, supply -1.") ! 552: (cols, rows, xoffset, yoffset) ! 553: Lisp_Object rows, cols, xoffset, yoffset; ! 554: { ! 555: BLOCK_INPUT_DECLARE () ! 556: ! 557: CHECK_NUMBER (rows, 1); ! 558: CHECK_NUMBER (cols, 2); ! 559: CHECK_NUMBER (xoffset, 3); ! 560: CHECK_NUMBER (yoffset, 4); ! 561: check_xterm (); ! 562: ! 563: BLOCK_INPUT (); ! 564: x_edges_specified = 1; ! 565: if (XINT (rows) != screen_width || XINT (cols) != screen_height) ! 566: { ! 567: XSetWindowSize (XINT (rows), XINT (cols)); ! 568: } ! 569: XSetOffset (XINT (xoffset), XINT (yoffset)); ! 570: XFlush (); ! 571: UNBLOCK_INPUT (); ! 572: return Qt; ! 573: } ! 574: ! 575: DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p, ! 576: Scoordinates_in_window_p, 2, 2, 0, ! 577: "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\ ! 578: Returned value is list of positions expressed\n\ ! 579: relative to window upper left corner.") ! 580: (coordinate, window) ! 581: register Lisp_Object coordinate, window; ! 582: { ! 583: register Lisp_Object xcoord, ycoord; ! 584: ! 585: if (!CONSP (coordinate)) wrong_type_argument (Qlistp, coordinate); ! 586: CHECK_WINDOW (window, 2); ! 587: xcoord = Fcar (coordinate); ! 588: ycoord = Fcar (Fcdr (coordinate)); ! 589: CHECK_NUMBER (xcoord, 0); ! 590: CHECK_NUMBER (ycoord, 1); ! 591: if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) || ! 592: (XINT (xcoord) >= (XINT (XWINDOW (window)->left) + ! 593: XINT (XWINDOW (window)->width)))) ! 594: { ! 595: return Qnil; ! 596: } ! 597: XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left); ! 598: if (XINT (ycoord) == (screen_height - 1)) ! 599: return Qnil; ! 600: if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) || ! 601: (XINT (ycoord) >= (XINT (XWINDOW (window)->top) + ! 602: XINT (XWINDOW (window)->height)) - 1)) ! 603: { ! 604: return Qnil; ! 605: } ! 606: XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top); ! 607: return Fcons (xcoord, Fcons (ycoord, Qnil)); ! 608: } ! 609: ! 610: DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0, ! 611: "Return number of pending mouse events from X window system.") ! 612: () ! 613: { ! 614: register Lisp_Object tem; ! 615: register int windex, rindex, mindex; ! 616: ! 617: check_xterm (); ! 618: windex = Xxrepbuffer.windex; ! 619: rindex = Xxrepbuffer.rindex; ! 620: mindex = Xxrepbuffer.mindex; ! 621: ! 622: if (windex >= rindex) ! 623: { ! 624: XSET (tem, Lisp_Int, windex - rindex); ! 625: } ! 626: else ! 627: { ! 628: XSET (tem, Lisp_Int, mindex + 1 - (rindex - windex)); ! 629: } ! 630: return tem; ! 631: } ! 632: ! 633: DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event, ! 634: 0, 0, 0, ! 635: "Pulls a mouse event out of the mouse event buffer and dispatches\n\ ! 636: the appropriate function to act upon this event.") ! 637: () ! 638: { ! 639: XButtonEvent xrep; ! 640: register Lisp_Object Mouse_Cmd; ! 641: register char com_letter; ! 642: register char key_mask; ! 643: register Lisp_Object tempx; ! 644: register Lisp_Object tempy; ! 645: extern Lisp_Object get_keyelt (); ! 646: ! 647: check_xterm (); ! 648: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) ! 649: { ! 650: com_letter = xrep.detail & 3; ! 651: key_mask = (xrep.detail >> 8) & 0xf0; ! 652: com_letter |= key_mask; ! 653: #ifndef HPUX ! 654: if (xrep.type == ButtonReleased) com_letter |= 0x04; ! 655: #endif ! 656: XSET (tempx, Lisp_Int, min (screen_width-1, max (0, (xrep.x - XXInternalBorder)/fontinfo->width))); ! 657: XSET (tempy, Lisp_Int, min (screen_height-1, max (0, (xrep.y - XXInternalBorder)/fontinfo->height))); ! 658: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 659: XSET (tempx, Lisp_Int, xrep.x + XXxoffset); ! 660: XSET (tempy, Lisp_Int, xrep.y + XXyoffset); ! 661: Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 662: Vx_mouse_item = make_number (com_letter); ! 663: Mouse_Cmd = get_keyelt (access_keymap (MouseMap, com_letter)); ! 664: if (NULL (Mouse_Cmd)) ! 665: { ! 666: #ifndef HPUX ! 667: if (xrep.type != ButtonReleased) ! 668: Ding (); ! 669: #endif ! 670: Vx_mouse_pos = Qnil; ! 671: Vx_mouse_abs_pos = Qnil; ! 672: } ! 673: else ! 674: { ! 675: return call1 (Mouse_Cmd, Vx_mouse_pos); ! 676: } ! 677: } ! 678: return Qnil; ! 679: } ! 680: ! 681: DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event, ! 682: 1, 1, 0, ! 683: "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\ ! 684: ARG non-nil means return nil immediately if no pending event;\n\ ! 685: otherwise, wait for an event.") ! 686: (arg) ! 687: Lisp_Object arg; ! 688: { ! 689: XButtonEvent xrep; ! 690: register Lisp_Object Mouse_Cmd; ! 691: register char com_letter; ! 692: register char key_mask; ! 693: ! 694: register Lisp_Object tempx; ! 695: register Lisp_Object tempy; ! 696: extern Lisp_Object get_keyelt (); ! 697: ! 698: check_xterm (); ! 699: ! 700: if (NULL (arg)) ! 701: while (Xxrepbuffer.windex == Xxrepbuffer.rindex); ! 702: /*** ??? Surely you don't mean to busy wait??? */ ! 703: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) ! 704: { ! 705: com_letter = *((char *)&xrep.detail); ! 706: com_letter &= 3; ! 707: key_mask = *((char *)&xrep.detail + 1); ! 708: key_mask &= 0xf0; ! 709: com_letter |= key_mask; ! 710: #ifndef HPUX ! 711: if (xrep.type == ButtonReleased) com_letter |= 0x04; ! 712: #endif ! 713: XSET (tempx, Lisp_Int, min (screen_width, max (0, (xrep.x - XXInternalBorder)/fontinfo->width))); ! 714: XSET (tempy, Lisp_Int, min (screen_height, max (0, (xrep.y - XXInternalBorder)/fontinfo->height))); ! 715: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 716: XSET (tempx, Lisp_Int, xrep.x + XXxoffset); ! 717: XSET (tempy, Lisp_Int, xrep.y + XXyoffset); ! 718: Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil)); ! 719: return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil)); ! 720: } ! 721: return Qnil; ! 722: } ! 723: ! 724: DEFUN ("x-set-keyboard-enable", Fx_set_keyboard_enable, ! 725: Sx_set_keyboard_enable, 1, 1, 0, ! 726: "In the X window system, set the flag that permite keyboard input.\n\ ! 727: Permit input if ARG is non-nil.") ! 728: (arg) ! 729: Lisp_Object arg; ! 730: { ! 731: BLOCK_INPUT_DECLARE () ! 732: ! 733: check_xterm (); ! 734: ! 735: BLOCK_INPUT (); ! 736: XSelectInput (XXwindow, ! 737: ExposeWindow | ButtonPressed ! 738: #ifndef HPUX ! 739: | ButtonReleased ! 740: #endif ! 741: | ExposeRegion | ExposeCopy | (!NULL (arg) ? KeyPressed : 0)); ! 742: UNBLOCK_INPUT (); ! 743: return arg; ! 744: } ! 745: ! 746: DEFUN ("x-set-mouse-inform-flag", Fx_set_mouse_inform_flag, ! 747: Sx_set_mouse_inform_flag, 1, 1, 0, ! 748: "Set inform-of-mouse-events flag in X window system on if ARG is non-nil.") ! 749: (arg) ! 750: Lisp_Object arg; ! 751: { ! 752: informflag = !NULL (arg); ! 753: return arg; ! 754: } ! 755: ! 756: DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer, ! 757: 1, 1, "sSend string to X:", ! 758: "Store contents of STRING into the cut buffer of the X window system.") ! 759: (string) ! 760: register Lisp_Object string; ! 761: { ! 762: BLOCK_INPUT_DECLARE () ! 763: ! 764: CHECK_STRING (string, 1); ! 765: check_xterm (); ! 766: ! 767: BLOCK_INPUT (); ! 768: XStoreBytes (XSTRING (string)->data, XSTRING (string)->size); ! 769: UNBLOCK_INPUT (); ! 770: ! 771: return Qnil; ! 772: } ! 773: ! 774: DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0, ! 775: "Return contents of cut buffer of the X window system, as a string.") ! 776: () ! 777: { ! 778: int len; ! 779: register Lisp_Object string; ! 780: BLOCK_INPUT_DECLARE () ! 781: register char *d; ! 782: ! 783: BLOCK_INPUT (); ! 784: d = XFetchBytes (&len); ! 785: string = make_string (d, len); ! 786: UNBLOCK_INPUT (); ! 787: return string; ! 788: } ! 789: ! 790: DEFUN ("x-rubber-band", Fx_rubber_band, Sx_rubber_band, 0, 0, "", ! 791: "Ask user to specify Emacs window position and size with mouse.\n\ ! 792: This is done automatically if the data has not been specified\n\ ! 793: when Emacs needs the window to be displayed.") ! 794: () ! 795: { ! 796: int x, y, width, height; ! 797: BLOCK_INPUT_DECLARE () ! 798: ! 799: x_edges_specified = 1; ! 800: ! 801: check_xterm (); ! 802: BLOCK_INPUT (); ! 803: window_fetch (fontinfo->id, &x, &y, &width, &height, "", default_window, ! 804: XXborder, "GNU Emacs"); ! 805: XSetWindowSize (height, width); ! 806: XSetOffset (x, y); ! 807: XFlush (); ! 808: ++screen_garbaged; ! 809: UNBLOCK_INPUT (); ! 810: return Qnil; ! 811: } ! 812: ! 813: DEFUN ("x-create-x-window", Fx_create_x_window, Sx_create_x_window, ! 814: 1, 1, 0, ! 815: "Create window for GNU Emacs from a valid GEOMETRY specification.") ! 816: (arg) ! 817: Lisp_Object arg; ! 818: { ! 819: int x, y, width, height; ! 820: char *geometry; ! 821: BLOCK_INPUT_DECLARE () ! 822: ! 823: x_edges_specified = 1; ! 824: ! 825: check_xterm (); ! 826: CHECK_STRING (arg, 1); ! 827: geometry= (char *) xmalloc (XSTRING (arg)->size + 1); ! 828: bcopy (XSTRING (arg)->data, geometry, XSTRING (arg)->size + 1); ! 829: BLOCK_INPUT (); ! 830: window_fetch (fontinfo->id, &x, &y, &width, &height, geometry, ! 831: default_window, XXborder, "GNU Emacs"); ! 832: XSetWindowSize (height, width); ! 833: /* XSetWindowSize ((height - (2 * XXborder))/fontinfo -> height, ! 834: (width - (2 * XXborder))/fontinfo -> width);*/ ! 835: XSetOffset (x, y); ! 836: XMapWindow (XXwindow); ! 837: XFlush (); ! 838: UNBLOCK_INPUT (); ! 839: return Qnil; ! 840: } ! 841: ! 842: ! 843: static int ! 844: grey_p (colour) ! 845: char *colour; ! 846: { ! 847: return (!strcmp (colour, "grey") || !strcmp (colour, "Grey") || ! 848: !strcmp (colour, "gray") || !strcmp (colour, "Gray")); ! 849: } ! 850: ! 851: DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width, ! 852: 1, 1, "NSet border width: ", ! 853: "Set width of border to WIDTH, in the X window system.") ! 854: (borderwidth) ! 855: register Lisp_Object borderwidth; ! 856: { ! 857: WindowInfo WinInfo; ! 858: BLOCK_INPUT_DECLARE () ! 859: Window tempwindow; ! 860: register int temppixelwidth; ! 861: register int temppixelheight; ! 862: register int tempx; ! 863: register int tempy; ! 864: Pixmap temp_brdr, temp_back; ! 865: ! 866: CHECK_NUMBER (borderwidth, 0); ! 867: ! 868: check_xterm (); ! 869: ! 870: if (XINT (borderwidth) < 0) XSETINT (borderwidth, 0); ! 871: ! 872: temppixelwidth = screen_width * fontinfo->width + 2 * XXInternalBorder; ! 873: temppixelheight = screen_height * fontinfo->height + 2 * XXInternalBorder; ! 874: BLOCK_INPUT (); ! 875: XQueryWindow (XXwindow, &WinInfo); ! 876: tempx = WinInfo.x; ! 877: tempy = WinInfo.y; ! 878: if (grey_p (brdr_color)) ! 879: temp_brdr = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), ! 880: BlackPixel, WhitePixel); ! 881: else ! 882: temp_brdr = XMakeTile (brdr); ! 883: temp_back = XMakeTile (back); ! 884: tempwindow = XCreateWindow (RootWindow, ! 885: tempx /* Absolute horizontal offset */, ! 886: tempy /* Absolute Vertical offset */, ! 887: temppixelwidth, temppixelheight, ! 888: XINT (borderwidth), ! 889: temp_brdr, temp_back); ! 890: if (tempwindow) ! 891: { ! 892: XDestroyWindow (XXwindow); ! 893: XXwindow = tempwindow; ! 894: pixelwidth = temppixelwidth; ! 895: pixelheight = temppixelheight; ! 896: XXborder = XINT (borderwidth); ! 897: XSelectInput (XXwindow, NoEvent); ! 898: XSetResizeHint (XXwindow, 2 * XXInternalBorder, 2 * XXInternalBorder, ! 899: /* fontinfo->width * 1, fontinfo->height * 1, */ ! 900: fontinfo->width, fontinfo->height); ! 901: XStoreName (XXwindow, &iconidentity[0]); ! 902: XDefineCursor (XXwindow, EmacsCursor); ! 903: XFreePixmap (temp_brdr); ! 904: XFreePixmap (temp_back); ! 905: UNBLOCK_INPUT_RESIGNAL (); ! 906: if (WindowMapped) ! 907: { ! 908: XMapWindow (XXwindow); ! 909: XSelectInput (XXwindow, KeyPressed | ExposeWindow | ButtonPressed ! 910: #ifndef HPUX ! 911: | ButtonReleased ! 912: #endif ! 913: | ExposeRegion | ExposeCopy); ! 914: ++screen_garbaged; ! 915: XFlush (); ! 916: } ! 917: return Qt; ! 918: } ! 919: else ! 920: { ! 921: UNBLOCK_INPUT_RESIGNAL (); ! 922: message ("Could not recreate window."); ! 923: return Qnil; ! 924: } ! 925: } ! 926: ! 927: ! 928: DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width, ! 929: Sx_set_internal_border_width, 1, 1, "NSet internal border width: ", ! 930: "Set width of internal border to WIDTH, in the X window system.") ! 931: (internalborderwidth) ! 932: register Lisp_Object internalborderwidth; ! 933: { ! 934: WindowInfo WinInfo; ! 935: BLOCK_INPUT_DECLARE () ! 936: Window tempwindow; ! 937: register int temppixelwidth; ! 938: register int temppixelheight; ! 939: register int tempx; ! 940: register int tempy; ! 941: register int intbord; ! 942: Pixmap temp_brdr, temp_back; ! 943: ! 944: CHECK_NUMBER (internalborderwidth, 0); ! 945: ! 946: check_xterm (); ! 947: ! 948: if (XINT (internalborderwidth) < 0) XSETINT (internalborderwidth, 0); ! 949: intbord = XINT (internalborderwidth); ! 950: temppixelwidth = screen_width * fontinfo->width + 2 * intbord; ! 951: temppixelheight = screen_height * fontinfo->height + 2 * intbord; ! 952: BLOCK_INPUT (); ! 953: XQueryWindow (XXwindow, &WinInfo); ! 954: tempx = WinInfo.x; ! 955: tempy = WinInfo.y; ! 956: if (grey_p (brdr_color)) ! 957: temp_brdr = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), ! 958: BlackPixel, WhitePixel); ! 959: else ! 960: temp_brdr = XMakeTile (brdr); ! 961: temp_back = XMakeTile (back); ! 962: tempwindow = XCreateWindow (RootWindow, ! 963: tempx /* Absolute horizontal offset */, ! 964: tempy /* Absolute Vertical offset */, ! 965: temppixelwidth, temppixelheight, ! 966: XXborder, ! 967: temp_brdr, temp_back); ! 968: if (tempwindow) ! 969: { ! 970: XDestroyWindow (XXwindow); ! 971: XXwindow = tempwindow; ! 972: pixelwidth = temppixelwidth; ! 973: pixelheight = temppixelheight; ! 974: XXInternalBorder = intbord; ! 975: XSelectInput (XXwindow, NoEvent); ! 976: XSetResizeHint (XXwindow, 2 * XXInternalBorder, 2 * XXInternalBorder, ! 977: /* fontinfo->width * 1, fontinfo->height * 1, */ ! 978: fontinfo->width, fontinfo->height); ! 979: XStoreName (XXwindow, &iconidentity[0]); ! 980: XDefineCursor (XXwindow, EmacsCursor); ! 981: XFreePixmap (temp_brdr); ! 982: XFreePixmap (temp_back); ! 983: UNBLOCK_INPUT_RESIGNAL (); ! 984: if (WindowMapped) ! 985: { ! 986: XMapWindow (XXwindow); ! 987: XSelectInput (XXwindow, KeyPressed | ExposeWindow | ButtonPressed ! 988: #ifndef HPUX ! 989: | ButtonReleased ! 990: #endif ! 991: | ExposeRegion | ExposeCopy); ! 992: ++screen_garbaged; ! 993: XFlush (); ! 994: } ! 995: return Qt; ! 996: } ! 997: else ! 998: { ! 999: UNBLOCK_INPUT_RESIGNAL (); ! 1000: message ("Could not recreate window."); ! 1001: return Qnil; ! 1002: } ! 1003: } ! 1004: ! 1005: jmp_buf dispenv; ! 1006: Display *OldDisplay; ! 1007: FontInfo *OldFontInfo; ! 1008: Window OldWindow; ! 1009: ! 1010: XRestoreDisplay () ! 1011: { ! 1012: longjmp (dispenv, "Unable to access display (probably)"); ! 1013: } ! 1014: ! 1015: DEFUN ("x-change-display", Fx_change_display, Sx_change_display, 1, 1, ! 1016: "sNew display name: ", ! 1017: "This function takes one argument, the display where you wish to\n\ ! 1018: continue your editing session. Your current window will be unmapped and\n\ ! 1019: the current display will be closed. The new X display will be opened and\n\ ! 1020: the rubber-band outline of the new window will appear on the new X display.\n\ ! 1021: This function does not look at your .Xdefaults file, so you should use the\n\ ! 1022: function x-new-display instead.") ! 1023: (new_display) ! 1024: register Lisp_Object new_display; ! 1025: { ! 1026: Cursor OldEmacsCursor; ! 1027: BLOCK_INPUT_DECLARE () ! 1028: register int (*pipefunc) (); ! 1029: register char *newdisplayname = 0; ! 1030: int x, y, width, height; ! 1031: int temp_icon; ! 1032: int XRestoreDisplay (); ! 1033: Pixmap temp_brdr, temp_back; ! 1034: register char *XXerrorcode; ! 1035: ! 1036: CHECK_STRING (new_display, 1); ! 1037: check_xterm (); ! 1038: ! 1039: /* newdisplayname = xmalloc (XSTRING (new_display)->size + 1); */ ! 1040: /* bcopy (XSTRING (new_display)->data, newdisplayname, */ ! 1041: /* XSTRING (new_display)->size + 1); */ ! 1042: /* Since this was freed at the end, why not just use the original? */ ! 1043: newdisplayname = (char *) XSTRING (new_display)->data; ! 1044: BLOCK_INPUT (); ! 1045: XIOErrorHandler (XRestoreDisplay); ! 1046: if (XXerrorcode = (char *) setjmp (dispenv)) ! 1047: { ! 1048: /* free (&newdisplayname[0]); */ ! 1049: if (fontinfo) ! 1050: XCloseFont (fontinfo); ! 1051: if (XXwindow) ! 1052: XDestroyWindow (XXwindow); ! 1053: if (XXdisplay) ! 1054: XCloseDisplay (XXdisplay); ! 1055: XXdisplay = OldDisplay; ! 1056: fontinfo = OldFontInfo; ! 1057: XXwindow = OldWindow; ! 1058: EmacsCursor = OldEmacsCursor; ! 1059: XIOErrorHandler (handler); ! 1060: XSetDisplay (XXdisplay); ! 1061: UNBLOCK_INPUT_RESIGNAL (); ! 1062: error ("Display change problem: %s", XXerrorcode); ! 1063: } ! 1064: else ! 1065: { ! 1066: OldEmacsCursor = EmacsCursor; ! 1067: OldDisplay = XXdisplay; ! 1068: OldFontInfo = fontinfo; ! 1069: OldWindow = XXwindow; ! 1070: XXwindow = 0; ! 1071: fontinfo = 0; ! 1072: XXdisplay = 0; ! 1073: } ! 1074: XXdisplay = XOpenDisplay (newdisplayname); ! 1075: if (!XXdisplay) ! 1076: { ! 1077: longjmp (dispenv, "Probably nonexistant display"); ! 1078: } ! 1079: XQueryWindow (RootWindow, &rootwindowinfo); ! 1080: fontinfo = XOpenFont (XXcurrentfont); ! 1081: if (!fontinfo) ! 1082: { ! 1083: longjmp (dispenv, "Bad font"); ! 1084: } ! 1085: /* pixelwidth and pixelheight are correct*/ ! 1086: XXwindow = XCreateWindow (RootWindow, ! 1087: XXxoffset, ! 1088: XXyoffset, ! 1089: pixelwidth, pixelheight, ! 1090: XXborder, BlackPixmap, WhitePixmap); ! 1091: if (!XXwindow) ! 1092: { ! 1093: longjmp (dispenv, "Could not create window"); ! 1094: } ! 1095: fore = BlackPixel; ! 1096: back = WhitePixel; ! 1097: brdr = BlackPixel; ! 1098: mous = BlackPixel; ! 1099: curs = BlackPixel; ! 1100: ! 1101: fore_color = "black"; ! 1102: back_color = "white"; ! 1103: brdr_color = "black"; ! 1104: mous_color = "black"; ! 1105: curs_color = "black"; ! 1106: ! 1107: XSelectInput (XXwindow, NoEvent); ! 1108: EmacsCursor = XCreateCursor (16, 16, MouseCursor, MouseMask, ! 1109: 0, 0, mous, back, GXcopy); ! 1110: XDefineCursor (XXwindow, EmacsCursor); ! 1111: XSetResizeHint (XXwindow, 2 * XXInternalBorder, 2 * XXInternalBorder, ! 1112: /* fontinfo->width * 1, fontinfo->height * 1, */ ! 1113: fontinfo->width, fontinfo->height); ! 1114: XStoreName (XXwindow, iconidentity); ! 1115: /* WindowMapped = 0;*/ ! 1116: x_edges_specified = 0; ! 1117: bitblt = 0; ! 1118: CursorExists = 0; ! 1119: VisibleX = 0; ! 1120: VisibleY = 0; ! 1121: XSetDisplay (XXdisplay); ! 1122: /* XQueryWindow (RootWindow, &rootwindowinfo);*/ ! 1123: /* if (WindowMapped) ! 1124: {*/ ! 1125: XXIconWindow = XCreateWindow (RootWindow, 0, 0, sink_width, sink_height, ! 1126: 2, WhitePixmap, BlackPixmap); ! 1127: XXIconMask = XStoreBitmap (sink_mask_width, sink_mask_height, sink_mask_bits); ! 1128: WindowMapped = 0; ! 1129: XPopUpWindow (); ! 1130: /* }*/ ! 1131: WindowMapped = 1; ! 1132: XSetDisplay (OldDisplay); ! 1133: XCloseFont (OldFontInfo); ! 1134: XFreeCursor (OldEmacsCursor); ! 1135: XDestroyWindow (OldWindow); ! 1136: XSetDisplay (XXdisplay); ! 1137: XCloseDisplay (OldDisplay); ! 1138: ! 1139: x_init_1 (0); ! 1140: UNBLOCK_INPUT_RESIGNAL (); ! 1141: /* free (newdisplayname); */ ! 1142: /* x_edges_specified = 0;*/ ! 1143: ++screen_garbaged; ! 1144: Fredraw_display (); ! 1145: return Qt; ! 1146: } ! 1147: ! 1148: /* ! 1149: Grabs mouse, outlines a window, etc. ! 1150: if left button pressed, sizes a wd x hd window (in characters) ! 1151: if right button pressed, sizes wd x what will fit window (in characters) ! 1152: if middle button pressed, allows user to size window in font increments ! 1153: (+ border * 2 for inner border); ! 1154: While sizing, dimensions of window are displayed in upper left of root. ! 1155: str is also displayed there. ! 1156: In all cases, x and y are the desired coordinates for the upper lefthand ! 1157: corner, *width = width desired, *height = height desired ! 1158: (min for both is 1 font char). ! 1159: ! 1160: */ ! 1161: /* ! 1162: This routine is a total crock. It makes a window using XCreateTerm ! 1163: purely for return value, destroying the temporary window created in ! 1164: the process. If XCreateTerm were broken into smaller, more easily ! 1165: digestible pieces, it would be useful. As such, the constraints of ! 1166: time, emacs, and X conventions force me into this crock. --rlk ! 1167: */ ! 1168: ! 1169: window_fetch (font, x, y, width, height, geo, deflt, border, str) ! 1170: Font font; ! 1171: int *x, *y, *width, *height; ! 1172: char *geo, *deflt; ! 1173: int border; ! 1174: char *str; ! 1175: { ! 1176: OpaqueFrame frame; ! 1177: Window tempwindow; ! 1178: WindowInfo WinInfo; ! 1179: register int temppixelwidth; ! 1180: register int temppixelheight; ! 1181: Pixmap temp_brdr, temp_back; ! 1182: ! 1183: temp_brdr = XMakeTile (brdr); ! 1184: temp_back = XMakeTile (back); ! 1185: frame.bdrwidth = border; ! 1186: if (grey_p (brdr_color)) ! 1187: frame.border = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), ! 1188: BlackPixel, WhitePixel); ! 1189: else ! 1190: frame.border = XMakeTile (brdr); ! 1191: frame.background = XMakeTile (back); ! 1192: tempwindow = XCreateTerm (str, "emacs", geo, deflt, &frame, 10, 5, ! 1193: 2 * XXInternalBorder, 2 * XXInternalBorder, ! 1194: width, height, fontinfo, fontinfo->width, ! 1195: fontinfo->height); ! 1196: if (tempwindow) ! 1197: { ! 1198: XDestroyWindow (XXwindow); ! 1199: XXwindow = tempwindow; ! 1200: XSelectInput (XXwindow, NoEvent); ! 1201: XSetResizeHint (XXwindow, 2 * XXInternalBorder, 2 * XXInternalBorder, ! 1202: /* fontinfo->width * 1, fontinfo->height * 1, */ ! 1203: fontinfo->width, fontinfo->height); ! 1204: XStoreName (XXwindow, &iconidentity[0]); ! 1205: XDefineCursor (XXwindow, EmacsCursor); ! 1206: XQueryWindow (XXwindow, &WinInfo); ! 1207: *x = WinInfo.x; ! 1208: *y = WinInfo.y; ! 1209: XFreePixmap (temp_brdr); ! 1210: XFreePixmap (temp_back); ! 1211: RESIGNAL_INPUT (); ! 1212: if (WindowMapped) ! 1213: { ! 1214: XMapWindow (XXwindow); ! 1215: XSelectInput (XXwindow, KeyPressed | ExposeWindow | ButtonPressed ! 1216: #ifndef HPUX ! 1217: | ButtonReleased ! 1218: #endif ! 1219: | ExposeRegion | ExposeCopy); ! 1220: ++screen_garbaged; ! 1221: XFlush (); ! 1222: } ! 1223: return Qt; ! 1224: } ! 1225: else ! 1226: { ! 1227: RESIGNAL_INPUT (); ! 1228: message ("Could not recreate window."); ! 1229: return Qnil; ! 1230: } ! 1231: } ! 1232: ! 1233: DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0, ! 1234: "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\ ! 1235: KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\ ! 1236: and shift mask respectively. NEWSTRING is an arbitrary string of keystrokes.\n\ ! 1237: If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\ ! 1238: all shift combinations.\n\ ! 1239: Shift Lock 1 Shift 2\n\ ! 1240: Meta 4 Control 8\n\ ! 1241: \n\ ! 1242: For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\ ! 1243: in that file are in octal!)\n\ ! 1244: \n\ ! 1245: NOTE: due to an X bug, this function will not take effect unless one has\n\ ! 1246: a ~/.Xkeymap file. (See the documentation for the \"keycomp\" program.)\n\ ! 1247: This problem will be fixed in X version 11.") ! 1248: ! 1249: (keycode, shift_mask, newstring) ! 1250: register Lisp_Object keycode; ! 1251: register Lisp_Object shift_mask; ! 1252: register Lisp_Object newstring; ! 1253: { ! 1254: char *rawstring; ! 1255: int rawkey, rawshift; ! 1256: int i; ! 1257: int strsize; ! 1258: ! 1259: CHECK_NUMBER (keycode, 1); ! 1260: if (!NULL (shift_mask)) ! 1261: CHECK_NUMBER (shift_mask, 2); ! 1262: CHECK_STRING (newstring, 3); ! 1263: strsize = XSTRING (newstring) ->size; ! 1264: rawstring = (char *) xmalloc (strsize); ! 1265: bcopy (XSTRING (newstring)->data, rawstring, strsize); ! 1266: rawkey = ((unsigned) (XINT (keycode))) & 255; ! 1267: if (NULL (shift_mask)) ! 1268: for (i = 0; i <= 15; i++) ! 1269: XRebindCode (rawkey, i<<11, rawstring, strsize); ! 1270: else ! 1271: { ! 1272: rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11; ! 1273: XRebindCode (rawkey, rawshift, rawstring, strsize); ! 1274: } ! 1275: return Qnil; ! 1276: } ! 1277: ! 1278: DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0, ! 1279: "Rebind KEYCODE to list of strings STRINGS.\n\ ! 1280: STRINGS should be a list of 16 elements, one for each all shift combination.\n\ ! 1281: nil as element means don't change.\n\ ! 1282: See the documentation of x-rebind-key for more information.") ! 1283: (keycode, strings) ! 1284: register Lisp_Object keycode; ! 1285: register Lisp_Object strings; ! 1286: { ! 1287: register Lisp_Object item; ! 1288: register char *rawstring; ! 1289: int rawkey, strsize; ! 1290: register unsigned i; ! 1291: ! 1292: CHECK_NUMBER (keycode, 1); ! 1293: CHECK_CONS (strings, 2); ! 1294: rawkey = ((unsigned) (XINT (keycode))) & 255; ! 1295: for (i = 0; i <= 15; strings = Fcdr (strings), i++) ! 1296: { ! 1297: item = Fcar (strings); ! 1298: if (!NULL (item)) ! 1299: { ! 1300: CHECK_STRING (item, 2); ! 1301: strsize = XSTRING (item)->size; ! 1302: rawstring = (char *) xmalloc (strsize); ! 1303: bcopy (XSTRING (item)->data, rawstring, strsize); ! 1304: XRebindCode (rawkey, i << 11, rawstring, strsize); ! 1305: } ! 1306: } ! 1307: return Qnil; ! 1308: } ! 1309: ! 1310: XExitWithCoreDump (Disp, Event) ! 1311: Display *Disp; ! 1312: XErrorEvent *Event; ! 1313: { ! 1314: XCleanUp (); ! 1315: abort (); ! 1316: } ! 1317: ! 1318: DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0, ! 1319: "ARG non-nil means that X errors should generate a coredump.") ! 1320: (arg) ! 1321: register Lisp_Object arg; ! 1322: { ! 1323: if (!NULL (arg)) ! 1324: handler = XExitWithCoreDump; ! 1325: else ! 1326: { ! 1327: extern int XExitGracefully (); ! 1328: handler = XExitGracefully; ! 1329: } ! 1330: XErrorHandler (handler); ! 1331: XIOErrorHandler (handler); ! 1332: return (Qnil); ! 1333: } ! 1334: ! 1335: XRedrawDisplay () ! 1336: { ! 1337: Fredraw_display (); ! 1338: } ! 1339: ! 1340: XCleanUp () ! 1341: { ! 1342: Fdo_auto_save (Qt); ! 1343: #ifdef subprocesses ! 1344: kill_buffer_processes (Qnil); ! 1345: #endif /* subprocesses */ ! 1346: } ! 1347: ! 1348: ! 1349: syms_of_xfns () ! 1350: { ! 1351: x_edges_specified = 0; ! 1352: ! 1353: DEFVAR_LISP ("x-mouse-item", &Vx_mouse_item, ! 1354: "Encoded representation of last mouse click, corresponding to\n\ ! 1355: numerical entries in x-mouse-map."); ! 1356: Vx_mouse_item = Qnil; ! 1357: DEFVAR_LISP ("x-mouse-pos", &Vx_mouse_pos, ! 1358: "Current x-y position of mouse by row, column as specified by font."); ! 1359: Vx_mouse_pos = Qnil; ! 1360: DEFVAR_LISP ("x-mouse-abs-pos", &Vx_mouse_abs_pos, ! 1361: "Current x-y position of mouse by row, column in pixels, wrt root window."); ! 1362: Vx_mouse_abs_pos = Qnil; ! 1363: ! 1364: defsubr (&Sx_pop_up_window); ! 1365: defsubr (&Sx_set_bell); ! 1366: defsubr (&Sx_flip_color); ! 1367: defsubr (&Sx_set_icon); ! 1368: defsubr (&Sx_set_font); ! 1369: defsubr (&Sx_set_window_edges); ! 1370: defsubr (&Scoordinates_in_window_p); ! 1371: defsubr (&Sx_mouse_events); ! 1372: defsubr (&Sx_proc_mouse_event); ! 1373: defsubr (&Sx_get_mouse_event); ! 1374: defsubr (&Sx_set_keyboard_enable); ! 1375: defsubr (&Sx_set_mouse_inform_flag); ! 1376: defsubr (&Sx_store_cut_buffer); ! 1377: defsubr (&Sx_get_cut_buffer); ! 1378: defsubr (&Sx_rubber_band); ! 1379: defsubr (&Sx_create_x_window); ! 1380: defsubr (&Sx_set_border_width); ! 1381: defsubr (&Sx_set_internal_border_width); ! 1382: defsubr (&Sx_change_display); ! 1383: defsubr (&Sx_set_foreground_color); ! 1384: defsubr (&Sx_set_background_color); ! 1385: defsubr (&Sx_set_border_color); ! 1386: defsubr (&Sx_set_cursor_color); ! 1387: defsubr (&Sx_set_mouse_color); ! 1388: defsubr (&Sx_get_foreground_color); ! 1389: defsubr (&Sx_get_background_color); ! 1390: defsubr (&Sx_get_border_color); ! 1391: defsubr (&Sx_get_cursor_color); ! 1392: defsubr (&Sx_get_mouse_color); ! 1393: defsubr (&Sx_color_p); ! 1394: defsubr (&Sx_get_default); ! 1395: defsubr (&Sx_rebind_key); ! 1396: defsubr (&Sx_rebind_keys); ! 1397: defsubr (&Sx_debug); ! 1398: } ! 1399: ! 1400: #endif /* HAVE_X_WINDOWS */ ! 1401:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.