1: /* Functions for the X window system. 2: Copyright (C) 1985 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 added by Robert Krawitz*/ 23: 24: /*#include <stdio.h>*/ 25: #include "config.h" 26: #include "lisp.h" 27: #include "window.h" 28: #include "xterm.h" 29: #include "dispextern.h" 30: #include "termchar.h" 31: #include <signal.h> 32: #include "sink.h" 33: #include "sinkmask.h" 34: #include <sys/time.h> 35: #include <fcntl.h> 36: #include <setjmp.h> 37: 38: #define abs(x) ((x < 0) ? ((x)) : (x)) 39: #define sgn(x) ((x < 0) ? (-1) : (1)) 40: 41: #define CROSS_WIDTH 16 42: #define CROSS_HEIGHT 16 43: 44: static short cross_bits[] = 45: { 46: 0x0000, 0x0180, 0x0180, 0x0180, 47: 0x0180, 0x0180, 0x0180, 0x7ffe, 48: 0x7ffe, 0x0180, 0x0180, 0x0180, 49: 0x0180, 0x0180, 0x0180, 0x0000, 50: }; 51: 52: static short gray_bits[] = { 53: 0xaaaa, 0x5555, 0xaaaa, 0x5555, 54: 0xaaaa, 0x5555, 0xaaaa, 0x5555, 55: 0xaaaa, 0x5555, 0xaaaa, 0x5555, 56: 0xaaaa, 0x5555, 0xaaaa, 0x5555}; 57: 58: #define CROSS_MASK_WIDTH 16 59: #define CROSS_MASK_HEIGHT 16 60: static short cross_mask_bits[] = 61: { 62: 0x03c0, 0x03c0, 0x03c0, 0x03c0, 63: 0x03c0, 0x03c0, 0xffff, 0xffff, 64: 0xffff, 0xffff, 0x03c0, 0x03c0, 65: 0x03c0, 0x03c0, 0x03c0, 0x03c0, 66: }; 67: 68: extern XREPBUFFER Xxrepbuffer; 69: 70: /* Non-nil if Emacs is running with an X window for display. 71: Nil if Emacs is run on an ordinary terminal. */ 72: 73: Lisp_Object Vxterm; 74: 75: Lisp_Object Vx_mouse_pos; 76: 77: extern struct Lisp_Vector *MouseMap; 78: 79: extern char *fore_color; 80: extern char *back_color; 81: extern char *brdr_color; 82: extern char *mous_color; 83: extern char *curs_color; 84: 85: extern int fore; 86: extern int back; 87: extern int brdr; 88: extern int mous; 89: extern int curs; 90: 91: /* Nonzero if x-set-window-edges has been called 92: or x-rubber-band has been called. 93: If it is zero when x-pop-up-window is called, 94: x-rubber-band is called at that point. */ 95: 96: int x_edges_specified; 97: 98: check_xterm () 99: { 100: if (NULL (Vxterm)) 101: error ("Terminal does not understand X protocol."); 102: } 103: 104: DEFUN ("x-pop-up-window", Fx_pop_up_window, Sx_pop_up_window, 0, 0, 0, 105: "Make the X window appear on the screen.") 106: () 107: { 108: check_xterm(); 109: XPopUpWindow(); 110: return Qnil; 111: } 112: 113: DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P", 114: "For X window system, set audible vs visible bell.\n\ 115: With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.") 116: (arg) 117: Lisp_Object arg; 118: { 119: check_xterm (); 120: if (!NULL (arg)) 121: XSetFlash (); 122: else 123: XSetFeep (); 124: return arg; 125: } 126: 127: DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "", 128: "Toggle the background and foreground colors (currently only black \n\ 129: and white -- by default background is white -- Only effective at init") 130: () 131: { 132: check_xterm (); 133: XFlipColor (); 134: return Qt; 135: } 136: 137: DEFUN ("x-set-foreground-color", Fx_set_foreground_color, 138: Sx_set_foreground_color, 1, 1, "sSet foregroud color: ", 139: "Set foreground (text) color to COLOR.") 140: (arg) 141: Lisp_Object arg; 142: { 143: Color cdef; 144: extern int PendingExposure; 145: int (*func) (); 146: extern Window XXwindow; 147: extern FontInfo *fontinfo; 148: char *save_color; 149: save_color = fore_color; 150: check_xterm (); 151: CHECK_STRING (arg,1); 152: fore_color = (char *) xmalloc (XSTRING (arg)->size + 1); 153: func = signal (SIGIO, SIG_IGN); 154: bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1); 155: if (fore_color && DisplayCells() > 2 && 156: XParseColor(fore_color, &cdef) && XGetHardwareColor(&cdef)) { 157: fore = cdef.pixel; 158: } else if (fore_color && strcmp(fore_color, "black") == 0) { 159: fore = BlackPixel; 160: } else if (fore_color && strcmp(fore_color, "white") == 0) { 161: fore = WhitePixel; 162: } 163: else 164: { 165: fore_color = save_color; 166: } 167: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width, 168: screen_height * fontinfo->height, back, ClipModeClipped, 169: GXcopy, AllPlanes);*/ 170: Fredraw_display (); 171: /* dumprectangle(0, 0, screen_height * fontinfo->height, 172: screen_width * fontinfo -> width);*/ 173: /* PendingExposure = 1; 174: xfixscreen ();*/ 175: (void) signal (SIGIO, func); 176: XFlush(); 177: return Qt; 178: } 179: 180: DEFUN ("x-set-background-color", Fx_set_background_color, 181: Sx_set_background_color, 1, 1, "sSet background color: ", 182: "Set background color to COLOR.") 183: (arg) 184: Lisp_Object arg; 185: { 186: Color cdef; 187: extern int PendingExposure; 188: Pixmap temp; 189: int (*func) (); 190: char *save_color; 191: extern Window XXwindow; 192: check_xterm (); 193: CHECK_STRING (arg,1); 194: back_color = (char *) xmalloc (XSTRING (arg)->size + 1); 195: bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1); 196: func = signal (SIGIO, SIG_IGN); 197: if (back_color && DisplayCells() > 2 && 198: XParseColor(back_color, &cdef) && XGetHardwareColor(&cdef)) { 199: back = cdef.pixel; 200: } else if (back_color && strcmp(back_color, "white") == 0) { 201: back = WhitePixel; 202: } else if (back_color && strcmp(back_color, "black") == 0) { 203: back = BlackPixel; 204: } 205: else 206: { 207: back_color = save_color; 208: } 209: temp = XMakeTile(back); 210: XChangeBackground (XXwindow, temp); 211: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width, 212: screen_height * fontinfo->height, back, ClipModeClipped, 213: GXcopy, AllPlanes);*/ 214: (void) signal (SIGIO, func); 215: Fredraw_display(); 216: /* dumprectangle(0, 0, screen_height * fontinfo->height, 217: screen_width * fontinfo -> width);*/ 218: /* PendingExposure = 1; 219: xfixscreen ();*/ 220: XFlush(); 221: XFreePixmap (temp); 222: return Qt; 223: } 224: 225: DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1, 226: "sSet border color: ", 227: "Set border color to COLOR.") 228: (arg) 229: Lisp_Object arg; 230: { 231: Color cdef; 232: Pixmap temp; 233: extern int XXborder; 234: int (*func) (); 235: extern Window XXwindow; 236: check_xterm (); 237: CHECK_STRING (arg,1); 238: brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1); 239: bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1); 240: func = signal (SIGIO, SIG_IGN); 241: if (brdr_color && DisplayCells() > 2 && 242: XParseColor(brdr_color, &cdef) && XGetHardwareColor(&cdef)) 243: { 244: temp = XMakeTile(cdef.pixel); 245: brdr = cdef.pixel; 246: } 247: else if (brdr_color && strcmp(brdr_color, "black") == 0) 248: { 249: temp = BlackPixmap; 250: brdr = BlackPixel; 251: } 252: else if (brdr_color && strcmp(brdr_color, "white") == 0) 253: { 254: temp = WhitePixmap; 255: brdr = WhitePixel; 256: } 257: else 258: { 259: temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), 260: BlackPixel, WhitePixel); 261: brdr = BlackPixel; 262: brdr_color = "gray"; 263: } 264: if (XXborder) 265: XChangeBorder (XXwindow, temp); 266: (void) signal (SIGIO, func); 267: XFreePixmap (temp); 268: return Qt; 269: } 270: 271: DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1, 272: "sSet text cursor color: ", 273: "Set text cursor color to COLOR.") 274: (arg) 275: Lisp_Object arg; 276: { 277: Color cdef; 278: extern Window XXwindow; 279: int (*func) (); 280: char *save_color; 281: check_xterm (); 282: CHECK_STRING (arg,1); 283: curs_color = (char *) xmalloc (XSTRING (arg)->size + 1); 284: func = signal (SIGIO, SIG_IGN); 285: bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1); 286: if (curs_color && DisplayCells() > 2 && 287: XParseColor(curs_color, &cdef) && XGetHardwareColor(&cdef)) { 288: curs = cdef.pixel; 289: } else if (curs_color && strcmp(curs_color, "black") == 0) { 290: curs = BlackPixel; 291: } else if (curs_color && strcmp(curs_color, "white") == 0) { 292: curs = WhitePixel; 293: } 294: else 295: { 296: curs_color = save_color; 297: } 298: (void) signal (SIGIO, func); 299: CursorToggle(); 300: CursorToggle(); 301: return Qt; 302: } 303: 304: DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1, 305: "sSet mouse cursor color: ", 306: "Set mouse cursor color to COLOR.") 307: (arg) 308: Lisp_Object arg; 309: { 310: extern Cursor EmacsCursor; 311: extern char MouseCursor[], MouseMask[]; 312: Cursor temp; 313: int (*func) (); 314: Color cdef; 315: char *save_color; 316: extern Window XXwindow; 317: check_xterm (); 318: CHECK_STRING (arg,1); 319: mous_color = (char *) xmalloc (XSTRING (arg)->size + 1); 320: func = signal (SIGIO, SIG_IGN); 321: bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1); 322: if (mous_color && DisplayCells() > 2 && 323: XParseColor(mous_color, &cdef) && XGetHardwareColor(&cdef)) { 324: mous = cdef.pixel; 325: } else if (mous_color && strcmp(mous_color, "black") == 0) { 326: mous = BlackPixel; 327: } else if (mous_color && strcmp(mous_color, "white") == 0) { 328: mous = WhitePixel; 329: } 330: else 331: { 332: mous_color = save_color; 333: } 334: temp = XCreateCursor(16, 16, MouseCursor, MouseMask, 0, 0, 335: mous, back, GXcopy); 336: XDefineCursor (XXwindow, temp); 337: XFreeCursor (EmacsCursor); 338: (void) signal (SIGIO, func); 339: bcopy(&temp, &EmacsCursor, sizeof(Cursor)); 340: return Qt; 341: } 342: 343: DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, "", 344: "Returns t if the display is a color X terminal.") 345: () 346: { 347: check_xterm (); 348: if (DisplayCells() > 2) 349: return Qt; 350: else 351: return Qnil; 352: } 353: 354: DEFUN ("x-get-foreground-color", Fx_get_foreground_color, 355: Sx_get_foreground_color, 0, 0, "", 356: "Returns the color of the foreground, as a string.") 357: () 358: { 359: Lisp_Object string; 360: string = make_string(fore_color, strlen (fore_color)); 361: return string; 362: } 363: 364: DEFUN ("x-get-background-color", Fx_get_background_color, 365: Sx_get_background_color, 0, 0, "", 366: "Returns the color of the background, as a string.") 367: () 368: { 369: Lisp_Object string; 370: string = make_string(back_color, strlen (back_color)); 371: return string; 372: } 373: 374: DEFUN ("x-get-border-color", Fx_get_border_color, 375: Sx_get_border_color, 0, 0, "", 376: "Returns the color of the border, as a string.") 377: () 378: { 379: Lisp_Object string; 380: string = make_string(brdr_color, strlen (brdr_color)); 381: return string; 382: } 383: 384: DEFUN ("x-get-cursor-color", Fx_get_cursor_color, 385: Sx_get_cursor_color, 0, 0, "", 386: "Returns the color of the cursor, as a string.") 387: () 388: { 389: Lisp_Object string; 390: string = make_string(curs_color, strlen (curs_color)); 391: return string; 392: } 393: 394: DEFUN ("x-get-mouse-color", Fx_get_mouse_color, 395: Sx_get_mouse_color, 0, 0, "", 396: "Returns the color of the mouse cursor, as a string.") 397: () 398: { 399: Lisp_Object string; 400: string = make_string(mous_color, strlen (mous_color)); 401: return string; 402: } 403: 404: DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 405: "sGet X default name: ", 406: "Get X default ATTRIBUTE from the system. Returns nil if\n\ 407: attribute does not exist.") 408: (arg) 409: Lisp_Object arg; 410: { 411: char *default_name, *value; 412: Lisp_Object return_string; 413: extern char *malloc(), strcpy(); 414: check_xterm (); 415: CHECK_STRING (arg,1); 416: default_name = (char *) xmalloc (XSTRING (arg) -> size + 1); 417: if (default_name == 0) 418: { 419: return Qnil; 420: } 421: else 422: { 423: bcopy (XSTRING (arg) -> data, default_name, 424: XSTRING (arg) -> size + 1); 425: value = XGetDefault("emacs", default_name); 426: if (value == 0) 427: value = XGetDefault("", default_name); 428: return make_string (value, value ? strlen (value) : 0); 429: } 430: } 431: 432: DEFUN ("x-set-icon", Fx_set_icon, Sx_set_icon, 1, 1, "P", 433: "Set type of icon used by X for Emacs's window.\n\ 434: ARG non-nil means use kitchen-sink icon;\n\ 435: nil means use generic window manager icon.") 436: (arg) 437: Lisp_Object arg; 438: { 439: check_xterm (); 440: if (NULL (arg)) 441: XTextIcon (); 442: else 443: XBitmapIcon (); 444: return arg; 445: } 446: 447: DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ", 448: "At initialization sets the font to be used for the X window.") 449: (arg) 450: Lisp_Object arg; 451: { 452: register char *newfontname; 453: extern char *XXcurrentfont; 454: 455: CHECK_STRING (arg, 1); 456: check_xterm (); 457: 458: newfontname = (char *) xmalloc (XSTRING (arg)->size + 1); 459: bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1); 460: if (!XNewFont (newfontname)) 461: { 462: free (XXcurrentfont); 463: XXcurrentfont = newfontname; 464: return Qt; 465: } 466: else 467: { 468: error ("Font %s is not defined", newfontname); 469: free (newfontname); 470: } 471: 472: return Qnil; 473: } 474: 475: DEFUN ("x-set-window-edges", Fx_set_window_edges, Sx_set_window_edges, 4, 4, 476: "nNumber of Columns: \nnNumber of Rows: \nnX Offset in Pixels: \n\ 477: nY Offset in Pixels: ", 478: "Sets X window size/position: size COLS by ROWS, positions XOFF and YOFF.\n\ 479: To get \"minus zero\" for XOFF or YOFF, supply -1.") 480: (cols, rows, xoffset, yoffset) 481: Lisp_Object rows, cols, xoffset, yoffset; 482: { 483: CHECK_NUMBER (rows, 1); 484: CHECK_NUMBER (cols, 2); 485: CHECK_NUMBER (xoffset, 3); 486: CHECK_NUMBER (yoffset, 4); 487: check_xterm (); 488: 489: x_edges_specified = 1; 490: if (XINT (rows) != screen_width || XINT (cols) != screen_height) 491: { 492: XSetWindowSize (XINT (rows), XINT (cols)); 493: } 494: XSetOffset (XINT (xoffset), XINT (yoffset)); 495: XFlush (); 496: return Qt; 497: } 498: 499: DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p, 500: Scoordinates_in_window_p, 2, 2, 501: "xSpecify coordinate pair: \nXExpression which evals to window: ", 502: "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\ 503: Returned value is list of positions expressed\n\ 504: relative to window upper left corner.") 505: (coordinate, window) 506: register Lisp_Object coordinate, window; 507: { 508: register Lisp_Object xcoord, ycoord; 509: 510: if (!LISTP (coordinate)) wrong_type_argument (Qlistp, coordinate); 511: CHECK_WINDOW (window, 2); 512: xcoord = Fcar (coordinate); 513: ycoord = Fcar (Fcdr (coordinate)); 514: CHECK_NUMBER (xcoord, 0); 515: CHECK_NUMBER (ycoord, 1); 516: if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) || 517: (XINT (xcoord) >= (XINT (XWINDOW (window)->left) + 518: XINT (XWINDOW (window)->width)))) 519: { 520: return Qnil; 521: } 522: XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left); 523: if (XINT (ycoord) == (screen_height - 1)) 524: return Qnil; 525: if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) || 526: (XINT (ycoord) >= (XINT (XWINDOW (window)->top) + 527: XINT (XWINDOW (window)->height)) - 1)) 528: { 529: return Qnil; 530: } 531: XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top); 532: return (Fcons (xcoord, Fcons (ycoord, Qnil))); 533: } 534: 535: DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0, 536: "Return number of pending mouse events from X window system.") 537: () 538: { 539: register Lisp_Object tem; 540: register int windex, rindex, mindex; 541: 542: check_xterm (); 543: windex = Xxrepbuffer.windex; 544: rindex = Xxrepbuffer.rindex; 545: mindex = Xxrepbuffer.mindex; 546: 547: if (windex >= rindex) 548: { 549: XSET (tem, Lisp_Int, windex - rindex); 550: } 551: else 552: { 553: XSET (tem, Lisp_Int, mindex + 1 - (rindex - windex)); 554: } 555: return tem; 556: } 557: 558: DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event, 559: 0, 0, 0, 560: "Pulls a mouse event out of the mouse event buffer and dispatches\n\ 561: the appropriate function to act upon this event.") 562: () 563: { 564: XButtonEvent xrep; 565: extern FontInfo *fontinfo; 566: register Lisp_Object Mouse_Cmd; 567: register char com_letter; 568: register char key_mask; 569: register Lisp_Object tempx; 570: register Lisp_Object tempy; 571: extern Lisp_Object get_keyelt (); 572: 573: check_xterm (); 574: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) 575: { 576: com_letter = xrep.detail & 3; 577: key_mask = (xrep.detail >> 8) & 0xf0; 578: com_letter |= key_mask; 579: XSET (tempx, Lisp_Int, xrep.x/fontinfo->width); 580: XSET (tempy, Lisp_Int, xrep.y/fontinfo->height); 581: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); 582: Mouse_Cmd = get_keyelt (access_keymap (MouseMap, com_letter)); 583: if (NULL (Mouse_Cmd)) 584: { 585: Ding (); 586: Vx_mouse_pos = Qnil; 587: } 588: else 589: { 590: return (call1 (Mouse_Cmd, Vx_mouse_pos)); 591: } 592: } 593: return Qnil; 594: } 595: 596: DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event, 597: 1, 1, 0, 598: "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\ 599: ARG non-nil means return nil immediately if no pending event;\n\ 600: otherwise, wait for an event.") 601: (arg) 602: Lisp_Object arg; 603: { 604: XButtonEvent xrep; 605: extern FontInfo *fontinfo; 606: register Lisp_Object Mouse_Cmd; 607: register char com_letter; 608: register char key_mask; 609: 610: register Lisp_Object tempx; 611: register Lisp_Object tempy; 612: extern Lisp_Object get_keyelt (); 613: 614: check_xterm (); 615: 616: if (NULL (arg)) 617: while (Xxrepbuffer.windex == Xxrepbuffer.rindex); 618: /*** ??? Surely you don't mean to busy wait??? */ 619: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0) 620: { 621: com_letter = *((char *)&xrep.detail); 622: com_letter &= 3; 623: key_mask = *((char *)&xrep.detail + 1); 624: key_mask &= 0xf0; 625: com_letter |= key_mask; 626: XSET (tempx, Lisp_Int, xrep.x/fontinfo->width); 627: XSET (tempy, Lisp_Int, xrep.y/fontinfo->height); 628: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil)); 629: return (Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil))); 630: } 631: return Qnil; 632: } 633: 634: DEFUN ("x-set-keyboard-enable", Fx_set_keyboard_enable, 635: Sx_set_keyboard_enable, 1, 1, 0, 636: "In the X window system, set the flag that permite keyboard input.\n\ 637: Permit input if ARG is non-nil.") 638: (arg) 639: Lisp_Object arg; 640: { 641: extern Window XXwindow; 642: check_xterm (); 643: 644: XSelectInput (XXwindow, 645: ExposeWindow | ButtonPressed | ExposeRegion | ExposeCopy 646: | (!NULL (arg) ? KeyPressed : 0)); 647: return arg; 648: } 649: 650: DEFUN ("x-set-mouse-inform-flag", Fx_set_mouse_inform_flag, 651: Sx_set_mouse_inform_flag, 1, 1, 0, 652: "Set inform-of-mouse-events flag in X window system on if ARG is non-nil.") 653: (arg) 654: Lisp_Object arg; 655: { 656: extern int informflag; 657: informflag = !NULL (arg); 658: return arg; 659: } 660: 661: DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer, 662: 1, 1, "sSend string to X:", 663: "Store contents of STRING into the cut buffer of the X window system.") 664: (string) 665: register Lisp_Object string; 666: { 667: CHECK_STRING (string, 1); 668: check_xterm (); 669: 670: XStoreBytes (XSTRING (string)->data, XSTRING (string)->size); 671: 672: return Qnil; 673: } 674: 675: DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0, 676: "Return contents of cut buffer of the X window system, as a string.") 677: () 678: { 679: int len; 680: register Lisp_Object string; 681: register int (*func) (); 682: register char *d; 683: 684: func = (int (*)()) (signal (SIGIO, SIG_IGN)); 685: d = XFetchBytes (&len); 686: string = make_string (d, len); 687: signal (SIGIO, func); 688: return string; 689: } 690: 691: DEFUN ("x-rubber-band", Fx_rubber_band, Sx_rubber_band, 0, 0, 0, 692: "Ask user to specify Emacs window position and size with mouse.\n\ 693: This is done automatically if the data has not been specified\n\ 694: when Emacs needs the window to be displayed.") 695: () 696: { 697: int x, y, width, height; 698: extern int XXborder; 699: extern int PendingExposure; 700: extern char *default_window; 701: register int (*handle) (); 702: x_edges_specified = 1; 703: 704: check_xterm (); 705: handle = signal (SIGIO, SIG_IGN); 706: window_fetch (fontinfo->id, &x, &y, &width, &height, "", default_window, 707: XXborder, "Gnuemacs"); 708: (void) signal (SIGIO, handle); 709: XSetWindowSize (height, width); 710: XSetOffset (x, y); 711: XFlush(); 712: return Qnil; 713: } 714: 715: DEFUN ("x-create-x-window", Fx_create_x_window, Sx_create_x_window, 716: 1, 1, 0, 717: "Create window for gnuemacs from a valid GEOMETRY specification.") 718: (arg) 719: Lisp_Object arg; 720: { 721: int x, y, width, height; 722: extern int XXborder; 723: extern int PendingExposure; 724: char *geometry; 725: register int (*handle) (); 726: x_edges_specified = 1; 727: 728: check_xterm (); 729: CHECK_STRING(arg, 1); 730: geometry= (char *) xmalloc (XSTRING (arg)->size + 1); 731: bcopy (XSTRING (arg)->data, geometry, XSTRING (arg)->size + 1); 732: handle = signal (SIGIO, SIG_IGN); 733: window_fetch (fontinfo->id, &x, &y, &width, &height, geometry, 734: default_window, XXborder, "Gnuemacs"); 735: (void) signal (SIGIO, handle); 736: XSetWindowSize (height, width); 737: /* XSetWindowSize ((height - (2 * XXborder))/fontinfo -> height, 738: (width - (2 * XXborder))/fontinfo -> width);*/ 739: XSetOffset (x, y); 740: XMapWindow (XXwindow); 741: XFlush(); 742: return Qnil; 743: } 744: 745: DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width, 746: 1, 1, 0, 747: "Set width of border to WIDTH, in the X window system.\n\ 748: Works only before the window has been mapped.") 749: (borderwidth) 750: register Lisp_Object borderwidth; 751: { 752: extern int WindowMapped; 753: extern int XXborder; 754: WindowInfo WinInfo; 755: extern Window XXwindow; 756: extern FontInfo *fontinfo; 757: extern Cursor EmacsCursor; 758: extern char iconidentity[]; 759: register int (*func) (); 760: extern int CurHL; 761: Window tempwindow; 762: extern int pixelwidth, pixelheight; 763: register int temppixelwidth; 764: register int temppixelheight; 765: register int tempx; 766: register int tempy; 767: extern int XXxoffset, XXyoffset; 768: extern int XXpid; 769: Pixmap temp_brdr, temp_back; 770: 771: CHECK_NUMBER (borderwidth, 1); 772: 773: check_xterm (); 774: 775: if (XINT (borderwidth) < 0) XSETINT (borderwidth, 0); 776: 777: temppixelwidth = screen_width * fontinfo->width; 778: temppixelheight = screen_height * fontinfo->height; 779: func = signal (SIGIO, SIG_IGN); 780: XQueryWindow (XXwindow, &WinInfo); 781: tempx = WinInfo.x; 782: tempy = WinInfo.y; 783: if (strcmp (brdr_color, "gray") == 0) 784: temp_brdr = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), 785: BlackPixel, WhitePixel); 786: else 787: temp_brdr = XMakeTile(brdr); 788: temp_back = XMakeTile(back); 789: tempwindow = XCreateWindow (RootWindow, 790: tempx /* Absolute horizontal offset */, 791: tempy /* Absolute Vertical offset */, 792: temppixelwidth, temppixelheight, 793: XINT (borderwidth), 794: temp_brdr, temp_back); 795: if (tempwindow) 796: { 797: XDestroyWindow (XXwindow); 798: XXwindow = tempwindow; 799: pixelwidth = temppixelwidth; 800: pixelheight = temppixelheight; 801: XXborder = XINT (borderwidth); 802: XSelectInput (XXwindow, NoEvent); 803: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height *5, 804: fontinfo->width, fontinfo->height); 805: XStoreName (XXwindow, &iconidentity[0]); 806: XDefineCursor (XXwindow, EmacsCursor); 807: XFreePixmap(temp_brdr); 808: XFreePixmap(temp_back); 809: (void)signal (SIGIO, func); 810: if (QLength () > 0) 811: { 812: kill (XXpid, SIGIO); 813: } 814: if (WindowMapped) 815: { 816: XMapWindow (XXwindow); 817: XSelectInput (XXwindow, KeyPressed | ExposeWindow | 818: ButtonPressed | ExposeRegion | 819: ExposeCopy); 820: ++screen_garbaged; 821: XFlush (); 822: } 823: return Qt; 824: } 825: else 826: { 827: (void) signal (SIGIO, func); 828: if (QLength () > 0) 829: { 830: kill (XXpid, SIGIO); 831: } 832: message ("Could not recreate window."); 833: return Qnil; 834: } 835: } 836: 837: jmp_buf dispenv; 838: Display *OldDisplay; 839: FontInfo *OldFontInfo; 840: Window OldWindow; 841: 842: XRestoreDisplay () 843: { 844: longjmp (dispenv, "Unable to access display (probably)"); 845: } 846: 847: DEFUN ("x-change-display", Fx_change_display, Sx_change_display, 1, 1, 848: "sNew display name: ", 849: "This function takes one argument, the display where you wish to\n\ 850: continue your editing session. Your current window will be unmapped and\n\ 851: the current display will be closed. The new X display will be opened and\n\ 852: the rubber-band outline of the new window will appear on the new X display.\n\ 853: This function does not look at your .Xdefaults file, so you should use the\n\ 854: function x-new-display instead.") 855: (new_display) 856: register Lisp_Object new_display; 857: { 858: extern Cursor EmacsCursor; 859: Cursor OldEmacsCursor; 860: register int (*sigfunc) (), (*pipefunc) (); 861: register char *newdisplayname = 0; 862: extern char iconidentity[]; 863: extern Display *XXdisplay; 864: extern Window XXwindow; 865: extern Window XXIconWindow; 866: extern int IconWindow; 867: extern Bitmap XXIconMask; 868: extern int pixelwidth, pixelheight, XXborder, CurHL; 869: extern FontInfo *fontinfo; 870: extern int bitblt, CursorExists, VisibleX, VisibleY; 871: extern WindowInfo rootwindowinfo; 872: extern char MouseCursor[], MouseMask[]; 873: int old_fcntl_flags, old_fcntl_owner; 874: int x, y, width, height; 875: int temp_icon; 876: Pixmap temp_brdr, temp_back; 877: register char *XXerrorcode; 878: extern int XXxoffset, XXyoffset; 879: 880: CHECK_STRING (new_display, 1); 881: check_xterm (); 882: 883: /* newdisplayname = xmalloc (XSTRING (new_display)->size + 1); */ 884: /* bcopy (XSTRING (new_display)->data, newdisplayname, */ 885: /* XSTRING (new_display)->size + 1); */ 886: /* Since this was freed at the end, why not just use the original? */ 887: newdisplayname = (char *) XSTRING (new_display)->data; 888: sigfunc = signal (SIGIO, SIG_IGN); 889: XIOErrorHandler(XRestoreDisplay); 890: if (XXerrorcode = (char *) setjmp (dispenv)) 891: { 892: /* free (&newdisplayname[0]); */ 893: if (fontinfo) 894: XCloseFont (fontinfo); 895: if (XXwindow) 896: XDestroyWindow (XXwindow); 897: if (XXdisplay) 898: XCloseDisplay (XXdisplay); 899: XXdisplay = OldDisplay; 900: fontinfo = OldFontInfo; 901: XXwindow = OldWindow; 902: EmacsCursor = OldEmacsCursor; 903: XIOErrorHandler (0); 904: XSetDisplay (XXdisplay); 905: (void)signal (SIGIO, sigfunc); 906: if (QLength () > 0) 907: { 908: kill (XXpid, SIGIO); 909: } 910: error ("Display change problem: %s", XXerrorcode); 911: } 912: else 913: { 914: OldEmacsCursor = EmacsCursor; 915: OldDisplay = XXdisplay; 916: OldFontInfo = fontinfo; 917: OldWindow = XXwindow; 918: XXwindow = 0; 919: fontinfo = 0; 920: XXdisplay = 0; 921: } 922: XXdisplay = XOpenDisplay (newdisplayname); 923: if (!XXdisplay) 924: { 925: longjmp (dispenv, "Probably nonexistant display"); 926: } 927: XQueryWindow (RootWindow, &rootwindowinfo); 928: fontinfo = XOpenFont (XXcurrentfont); 929: if (!fontinfo) 930: { 931: longjmp (dispenv, "Bad font"); 932: } 933: /* pixelwidth and pixelheight are correct*/ 934: XXwindow = XCreateWindow (RootWindow, 935: XXxoffset, 936: XXyoffset, 937: pixelwidth, pixelheight, 938: XXborder, BlackPixmap, WhitePixmap); 939: if (!XXwindow) 940: { 941: longjmp (dispenv, "Could not create window"); 942: } 943: fore = BlackPixel; 944: back = WhitePixel; 945: brdr = BlackPixel; 946: mous = BlackPixel; 947: curs = BlackPixel; 948: 949: fore_color = "black"; 950: back_color = "white"; 951: brdr_color = "black"; 952: mous_color = "black"; 953: curs_color = "black"; 954: 955: XSelectInput (XXwindow, NoEvent); 956: EmacsCursor = XCreateCursor (16, 16, MouseCursor, MouseMask, 957: 0, 0, mous, back, GXcopy); 958: XDefineCursor (XXwindow, EmacsCursor); 959: 960: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height * 5, 961: fontinfo->width, fontinfo->height); 962: XStoreName (XXwindow, iconidentity); 963: /* WindowMapped = 0;*/ 964: x_edges_specified = 0; 965: bitblt = 0; 966: CursorExists = 0; 967: VisibleX = 0; 968: VisibleY = 0; 969: XSetDisplay (XXdisplay); 970: /* XQueryWindow (RootWindow, &rootwindowinfo);*/ 971: /* if (WindowMapped) 972: {*/ 973: WindowMapped = 0; 974: XPopUpWindow (); 975: /* }*/ 976: WindowMapped = 1; 977: XXIconWindow = XCreateWindow (RootWindow, 0, 0, sink_width, sink_height, 978: 2, WhitePixmap, BlackPixmap); 979: XXIconMask = XStoreBitmap(sink_mask_width, sink_mask_height, sink_mask_bits); 980: XSetDisplay (OldDisplay); 981: XCloseFont (OldFontInfo); 982: XFreeCursor (OldEmacsCursor); 983: XDestroyWindow (OldWindow); 984: XSetDisplay (XXdisplay); 985: XCloseDisplay (OldDisplay); 986: temp_icon = IconWindow; 987: XBitmapIcon; 988: XTextIcon; 989: if (temp_icon) 990: { 991: IconWindow = 0; 992: XBitmapIcon; 993: } 994: XErrorHandler (0); 995: dup2 (dpyno (), 0); 996: close (dpyno ()); 997: dpyno () = 0; /* Looks a little strange? */ 998: /* check the def of the */ 999: /* macro, it is a genuine */ 1000: /* lvalue */ 1001: old_fcntl_flags = fcntl (0, F_GETFL, 0); 1002: fcntl (0, F_SETFL, old_fcntl_flags | FASYNC); 1003: old_fcntl_owner = fcntl (0, F_GETOWN, 0); 1004: fcntl (0, F_SETOWN, getpid ()); 1005: (void)signal (SIGIO, sigfunc); 1006: if (QLength () > 0) 1007: { 1008: kill (XXpid, SIGIO); 1009: } 1010: /* free (newdisplayname); */ 1011: /* x_edges_specified = 0;*/ 1012: ++screen_garbaged; 1013: Fredraw_display(); 1014: return Qt; 1015: } 1016: 1017: /* 1018: Grabs mouse, outlines a window, etc. 1019: if left button pressed, sizes a wd x hd window (in characters) 1020: if right button pressed, sizes wd x what will fit window (in characters) 1021: if middle button pressed, allows user to size window in font increments 1022: (+ border * 2 for inner border); 1023: While sizing, dimensions of window are displayed in upper left of root. 1024: str is also displayed there. 1025: In all cases, x and y are the desired coordinates for the upper lefthand 1026: corner, *width = width desired, *height = height desired 1027: (min for both is 1 font char). 1028: 1029: */ 1030: /* 1031: This routine is a total crock. It makes a window using XCreateTerm 1032: purely for return value, destroying the temporary window created in 1033: the process. If XCreateTerm were broken into smaller, more easily 1034: digestible pieces, it would be useful. As such, the constraints of 1035: time, emacs, and X conventions force me into this crock. --rlk 1036: */ 1037: 1038: window_fetch(font, x, y, width, height, geo, deflt, border, str) 1039: Font font; 1040: int *x, *y, *width, *height; 1041: char *geo, *deflt; 1042: int border; 1043: char *str; 1044: { 1045: extern int WindowMapped; 1046: extern int XXborder; 1047: extern Window XXwindow; 1048: extern FontInfo *fontinfo; 1049: extern Cursor EmacsCursor; 1050: OpaqueFrame frame; 1051: extern char iconidentity[]; 1052: register int (*func) (); 1053: Window tempwindow; 1054: WindowInfo WinInfo; 1055: extern int pixelwidth, pixelheight; 1056: register int temppixelwidth; 1057: register int temppixelheight; 1058: extern int XXxoffset, XXyoffset; 1059: extern int XXpid; 1060: Pixmap temp_brdr, temp_back; 1061: 1062: func = signal (SIGIO, SIG_IGN); 1063: temp_brdr = XMakeTile(brdr); 1064: temp_back = XMakeTile(back); 1065: frame.bdrwidth = border; 1066: frame.border = XMakeTile (brdr); 1067: frame.background = XMakeTile (back); 1068: tempwindow = XCreateTerm(str, "emacs", geo, deflt, &frame, 10, 5, 0, 0, 1069: width, height, fontinfo, fontinfo->width, 1070: fontinfo->height); 1071: if (tempwindow) 1072: { 1073: XDestroyWindow (XXwindow); 1074: XXwindow = tempwindow; 1075: XSelectInput (XXwindow, NoEvent); 1076: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height *5, 1077: fontinfo->width, fontinfo->height); 1078: XStoreName (XXwindow, &iconidentity[0]); 1079: XDefineCursor (XXwindow, EmacsCursor); 1080: XQueryWindow (XXwindow, &WinInfo); 1081: *x = WinInfo.x; 1082: *y = WinInfo.y; 1083: XFreePixmap(temp_brdr); 1084: XFreePixmap(temp_back); 1085: (void)signal (SIGIO, func); 1086: if (QLength () > 0) 1087: { 1088: kill (XXpid, SIGIO); 1089: } 1090: if (WindowMapped) 1091: { 1092: XMapWindow (XXwindow); 1093: XSelectInput (XXwindow, KeyPressed | ExposeWindow | 1094: ButtonPressed | ExposeRegion | 1095: ExposeCopy); 1096: ++screen_garbaged; 1097: XFlush (); 1098: } 1099: return Qt; 1100: } 1101: else 1102: { 1103: (void) signal (SIGIO, func); 1104: if (QLength () > 0) 1105: { 1106: kill (XXpid, SIGIO); 1107: } 1108: message ("Could not recreate window."); 1109: return Qnil; 1110: } 1111: } 1112: 1113: setxterm () 1114: { 1115: Vxterm = Qt; 1116: } 1117: 1118: XRedrawDisplay() 1119: { 1120: Fredraw_display(); 1121: } 1122: 1123: XAutoSave() 1124: { 1125: Fdo_auto_save(); 1126: } 1127: 1128: 1129: syms_of_xfns () 1130: { 1131: x_edges_specified = 0; 1132: 1133: DefLispVar("xterm", &Vxterm, 1134: "True if using xterm, nil otherwise."); 1135: Vxterm = Qnil; 1136: DefLispVar("x-mouse-pos", &Vx_mouse_pos, 1137: "Current x-y position of mouse by row, column as specified by font."); 1138: Vx_mouse_pos = Qnil; 1139: 1140: defsubr (&Sx_pop_up_window); 1141: defsubr (&Sx_set_bell); 1142: defsubr (&Sx_flip_color); 1143: defsubr (&Sx_set_icon); 1144: defsubr (&Sx_set_font); 1145: defsubr (&Sx_set_window_edges); 1146: defsubr (&Scoordinates_in_window_p); 1147: defsubr (&Sx_mouse_events); 1148: defsubr (&Sx_proc_mouse_event); 1149: defsubr (&Sx_get_mouse_event); 1150: defsubr (&Sx_set_keyboard_enable); 1151: defsubr (&Sx_set_mouse_inform_flag); 1152: defsubr (&Sx_store_cut_buffer); 1153: defsubr (&Sx_get_cut_buffer); 1154: defsubr (&Sx_rubber_band); 1155: defsubr (&Sx_create_x_window); 1156: defsubr (&Sx_set_border_width); 1157: defsubr (&Sx_change_display); 1158: defsubr (&Sx_set_foreground_color); 1159: defsubr (&Sx_set_background_color); 1160: defsubr (&Sx_set_border_color); 1161: defsubr (&Sx_set_cursor_color); 1162: defsubr (&Sx_set_mouse_color); 1163: defsubr (&Sx_get_foreground_color); 1164: defsubr (&Sx_get_background_color); 1165: defsubr (&Sx_get_border_color); 1166: defsubr (&Sx_get_cursor_color); 1167: defsubr (&Sx_get_mouse_color); 1168: defsubr (&Sx_color_p); 1169: defsubr (&Sx_get_default); 1170: }