Annotation of 43BSDReno/contrib/emacs-18.55/src/x11fns.c, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.