4.3BSD - /usr/src/new/emacs/src/xfns.c

   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: }

Defined functions

Defined variables

Defined macros