Return to x11fns.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

Annotation of 43BSDReno/contrib/emacs-18.55/src/x11fns.c, revision 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 */

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