Return to xfns.c CVS log

Up to [Research Unix] / researchv9 / X11 / src / X.V11R1 / clients / emacs

Annotation of researchv9/X11/src/X.V11R1/clients/emacs/xfns.c, revision 1.1

1.1     ! root        1: /* Functions for the X window system.
        !             2:    Copyright (C) 1985, 1986, 1987 Free Software Foundation.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is distributed in the hope that it will be useful,
        !             7: but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: accepts responsibility to anyone for the consequences of using it
        !             9: or for whether it serves any particular purpose or works at all,
        !            10: unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: License for full details.
        !            12: 
        !            13: Everyone is granted permission to copy, modify and redistribute
        !            14: GNU Emacs, but only under the conditions described in the
        !            15: GNU Emacs General Public License.   A copy of this license is
        !            16: supposed to have been given to you along with GNU Emacs so you
        !            17: can know your rights and responsibilities.  It should be in a
        !            18: file named COPYING.  Among other things, the copyright notice
        !            19: and this notice must be preserved on all copies.  */
        !            20: 
        !            21: /* Written by Yakim Martillo; rearranged by Richard Stallman.  */
        !            22: /* Color and other features added by Robert Krawitz*/
        !            23: /* Converted to X11 by Robert French */
        !            24: 
        !            25: #define XXZ printf
        !            26: 
        !            27: #include <stdio.h>
        !            28: #ifdef NULL
        !            29: #undef NULL
        !            30: #endif
        !            31: #include <signal.h>
        !            32: #include "config.h"
        !            33: #include "lisp.h"
        !            34: #include "window.h"
        !            35: #include "xterm.h"
        !            36: #include "dispextern.h"
        !            37: #include "termchar.h"
        !            38: #include <sys/time.h>
        !            39: #include <fcntl.h>
        !            40: #include <setjmp.h>
        !            41: 
        !            42: #ifdef HAVE_X_WINDOWS
        !            43: 
        !            44: #define abs(x) ((x < 0) ? ((x)) : (x))
        !            45: #define sgn(x) ((x < 0) ? (-1) : (1))
        !            46: #define min(a,b) ((a) < (b) ? (a) : (b))
        !            47: #define max(a,b) ((a) > (b) ? (a) : (b))
        !            48:   
        !            49: /* Non-nil if Emacs is running with an X window for display.
        !            50:    Nil if Emacs is run on an ordinary terminal.  */
        !            51: 
        !            52: Lisp_Object Vxterm;
        !            53: 
        !            54: /* Vxterm1 is what the Lisp variable xterm actually refers to.
        !            55:    This prevents the user from altering Vxterm.  */
        !            56: 
        !            57: Lisp_Object Vxterm1;
        !            58: 
        !            59: Lisp_Object Vx_mouse_pos;
        !            60: Lisp_Object Vx_mouse_abs_pos;
        !            61: 
        !            62: Lisp_Object Vx_mouse_item;
        !            63: 
        !            64: extern struct Lisp_Vector *MouseMap;
        !            65: 
        !            66: extern XEvent *XXm_queue[XMOUSEBUFSIZE];
        !            67: extern int XXm_queue_num;
        !            68: extern char *fore_color;
        !            69: extern char *back_color;
        !            70: extern char *brdr_color;
        !            71: extern char *mous_color;
        !            72: extern char *curs_color;
        !            73: 
        !            74: extern unsigned long fore;
        !            75: extern unsigned long back;
        !            76: extern unsigned long brdr;
        !            77: extern unsigned long mous;
        !            78: extern unsigned long curs;
        !            79: 
        !            80: extern int XXborder;
        !            81: extern int XXInternalBorder;
        !            82: 
        !            83: extern char *progname;
        !            84: 
        !            85: extern XFontStruct *fontinfo;
        !            86: extern Font XXfid;
        !            87: extern GC XXgc_norm,XXgc_rev,XXgc_curs,XXgc_temp;
        !            88: extern XGCValues XXgcv;
        !            89: extern int XXfontw,XXfonth,XXbase,XXisColor;
        !            90: extern Colormap XXColorMap;
        !            91: 
        !            92: extern int PendingExposure;
        !            93: extern char *default_window;
        !            94: extern char *desiredwindow;
        !            95: 
        !            96: extern Window XXwindow;
        !            97: extern Cursor EmacsCursor;
        !            98: extern short MouseCursor[], MouseMask[];
        !            99: extern char *XXcurrentfont;
        !           100: extern int informflag;
        !           101: 
        !           102: extern int WindowMapped;
        !           103: extern int CurHL;
        !           104: extern int pixelwidth, pixelheight;
        !           105: extern int XXxoffset, XXyoffset;
        !           106: extern int XXpid;
        !           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:        int mask;
        !           124: 
        !           125:        check_xterm ();
        !           126:        mask = sigblock (sigmask (SIGIO));
        !           127:        if (!NULL (arg))
        !           128:                XSetFlash ();
        !           129:        else
        !           130:                XSetFeep ();
        !           131:        sigsetmask (mask);
        !           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:        int mask;
        !           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:        mask = sigblock (sigmask (SIGIO));
        !           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, 0);
        !           169:                else
        !           170:                        if (fore_color && !strcmp (fore_color, "white"))
        !           171:                                fore = WhitePixel(XXdisplay,0);
        !           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:        sigsetmask (mask);
        !           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:        int mask;
        !           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:        mask = sigblock (sigmask (SIGIO));
        !           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,0);
        !           210:                else
        !           211:                        if (back_color && !strcmp (back_color, "black"))
        !           212:                                back = BlackPixel(XXdisplay,0);
        !           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:        sigsetmask (mask);
        !           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:        int mask;
        !           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:        mask = sigblock (sigmask (SIGIO));
        !           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,0);
        !           253:                else
        !           254:                        if (brdr_color && !strcmp (brdr_color, "white"))
        !           255:                                brdr = WhitePixel(XXdisplay,0);
        !           256:                        else {
        !           257:                                brdr_color = "black";
        !           258:                                brdr = BlackPixel(XXdisplay,0);
        !           259:                        }
        !           260: 
        !           261:        if (XXborder) {
        !           262:                XSetWindowBorder(XXdisplay, XXwindow, brdr);
        !           263:                XFlush (XXdisplay);
        !           264:        }
        !           265:        
        !           266:        sigsetmask (mask);
        !           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:        int mask;
        !           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:        mask = sigblock (sigmask (SIGIO));
        !           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,0);
        !           296:                else
        !           297:                        if (curs_color && !strcmp (curs_color, "white"))
        !           298:                                curs = WhitePixel(XXdisplay,0);
        !           299:                        else
        !           300:                                curs_color = save_color;
        !           301: 
        !           302:        XSetBackground(XXdisplay, XXgc_curs, curs);
        !           303:        
        !           304:        CursorToggle ();
        !           305:        CursorToggle ();
        !           306: 
        !           307:        sigsetmask (mask);
        !           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:        int mask;
        !           318:        XColor cdef;
        !           319:        char *save_color;
        !           320: 
        !           321:        check_xterm ();
        !           322:        CHECK_STRING (arg,1);
        !           323:        save_color = mous_color;
        !           324:        mous_color = (char *) xmalloc (XSTRING (arg)->size + 1);
        !           325:        bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1);
        !           326: 
        !           327:        mask = sigblock (sigmask (SIGIO));
        !           328: 
        !           329:        if (mous_color && XXisColor &&
        !           330:            XParseColor (XXdisplay, XXColorMap, mous_color, &cdef) &&
        !           331:            XAllocColor (XXdisplay, XXColorMap, &cdef))
        !           332:                mous = cdef.pixel;
        !           333:        else
        !           334:                if (mous_color && !strcmp (mous_color, "black"))
        !           335:                        mous = BlackPixel(XXdisplay,0);
        !           336:                else
        !           337:                        if (mous_color && !strcmp (mous_color, "white"))
        !           338:                                mous = WhitePixel(XXdisplay,0);
        !           339:                        else
        !           340:                                mous_color = save_color;
        !           341: 
        !           342:        XRecolorCursor (XXdisplay, EmacsCursor, mous, back);
        !           343:        XFlush (XXdisplay);
        !           344:        
        !           345:        sigsetmask (mask);
        !           346:        return Qt;
        !           347: }   
        !           348: 
        !           349: DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0,
        !           350:        "Returns t if the display is a color X terminal.")
        !           351:   ()
        !           352: {
        !           353:        check_xterm ();
        !           354: 
        !           355:        if (XXisColor)
        !           356:                return Qt;
        !           357:        else
        !           358:                return Qnil;
        !           359: }
        !           360:        
        !           361: DEFUN ("x-get-foreground-color", Fx_get_foreground_color,
        !           362:        Sx_get_foreground_color, 0, 0, 0,
        !           363:        "Returns the color of the foreground, as a string.")
        !           364:   ()
        !           365: {
        !           366:        Lisp_Object string;
        !           367: 
        !           368:        string = build_string (fore_color);
        !           369:        return string;
        !           370: }
        !           371: 
        !           372: DEFUN ("x-get-background-color", Fx_get_background_color,
        !           373:        Sx_get_background_color, 0, 0, 0,
        !           374:        "Returns the color of the background, as a string.")
        !           375:   ()
        !           376: {
        !           377:        Lisp_Object string;
        !           378: 
        !           379:        string = build_string (back_color);
        !           380:        return string;
        !           381: }
        !           382: 
        !           383: DEFUN ("x-get-border-color", Fx_get_border_color,
        !           384:        Sx_get_border_color, 0, 0, 0,
        !           385:        "Returns the color of the border, as a string.")
        !           386:   ()
        !           387: {
        !           388:        Lisp_Object string;
        !           389: 
        !           390:        string = build_string (brdr_color);
        !           391:        return string;
        !           392: }
        !           393: 
        !           394: DEFUN ("x-get-cursor-color", Fx_get_cursor_color,
        !           395:        Sx_get_cursor_color, 0, 0, 0,
        !           396:        "Returns the color of the cursor, as a string.")
        !           397:   ()
        !           398: {
        !           399:        Lisp_Object string;
        !           400: 
        !           401:        string = build_string (curs_color);
        !           402:        return string;
        !           403: }
        !           404: 
        !           405: DEFUN ("x-get-mouse-color", Fx_get_mouse_color,
        !           406:        Sx_get_mouse_color, 0, 0, 0,
        !           407:        "Returns the color of the mouse cursor, as a string.")
        !           408:   ()
        !           409: {
        !           410:        Lisp_Object string;
        !           411: 
        !           412:        string = build_string (mous_color);
        !           413:        return string;
        !           414: }
        !           415: 
        !           416: DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
        !           417:        "Get X default ATTRIBUTE from the system.  Returns nil if\n\
        !           418: attribute does not exist.")
        !           419:   (arg)
        !           420:      Lisp_Object arg;
        !           421: {
        !           422:        char *default_name, *value;
        !           423: 
        !           424:        check_xterm ();
        !           425:        CHECK_STRING (arg, 1);
        !           426:        default_name = (char *) XSTRING (arg)->data;
        !           427: 
        !           428:        value = XGetDefault (XXdisplay, progname, default_name);
        !           429:        if (value)
        !           430:                return build_string (value);
        !           431:        return (Qnil);
        !           432: }
        !           433: 
        !           434: #ifdef notdef
        !           435: DEFUN ("x-set-icon", Fx_set_icon, Sx_set_icon, 1, 1, "P",
        !           436:   "Set type of icon used by X for Emacs's window.\n\
        !           437: ARG non-nil means use kitchen-sink icon;\n\
        !           438: nil means use generic window manager icon.")
        !           439:   (arg)
        !           440:      Lisp_Object arg;
        !           441: {
        !           442:        check_xterm ();
        !           443:        if (NULL (arg))
        !           444:                XTextIcon ();
        !           445:        else
        !           446:                XBitmapIcon ();
        !           447:        return arg;
        !           448: }
        !           449: #endif notdef
        !           450: 
        !           451: DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ",
        !           452:       "Sets the font to be used for the X window.")
        !           453:   (arg)
        !           454:      Lisp_Object arg;
        !           455: {
        !           456:        register char *newfontname;
        !           457:        
        !           458:        CHECK_STRING (arg, 1);
        !           459:        check_xterm ();
        !           460: 
        !           461:        newfontname = (char *) xmalloc (XSTRING (arg)->size + 1);
        !           462:        bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1);
        !           463:        if (XSTRING (arg)->size == 0)
        !           464:                goto badfont;
        !           465: 
        !           466:        if (!XNewFont (newfontname)) {
        !           467:                free (XXcurrentfont);
        !           468:                XXcurrentfont = newfontname;
        !           469:                return Qt;
        !           470:        }
        !           471: badfont:
        !           472:        error ("Font \"%s\" is not defined", newfontname);
        !           473:        free (newfontname);
        !           474: 
        !           475:        return Qnil;
        !           476: }
        !           477: 
        !           478: DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
        !           479:   Scoordinates_in_window_p, 2, 2, 0,
        !           480:   "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
        !           481: Returned value is list of positions expressed\n\
        !           482: relative to window upper left corner.")
        !           483:   (coordinate, window)
        !           484:      register Lisp_Object coordinate, window;
        !           485: {
        !           486:        register Lisp_Object xcoord, ycoord;
        !           487:        
        !           488:        if (!CONSP (coordinate))
        !           489:                wrong_type_argument (Qlistp, coordinate);
        !           490: 
        !           491:        CHECK_WINDOW (window, 2);
        !           492:        xcoord = Fcar (coordinate);
        !           493:        ycoord = Fcar (Fcdr (coordinate));
        !           494:        CHECK_NUMBER (xcoord, 0);
        !           495:        CHECK_NUMBER (ycoord, 1);
        !           496:        if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) ||
        !           497:            (XINT (xcoord) >= (XINT (XWINDOW (window)->left) +
        !           498:                               XINT (XWINDOW (window)->width))))
        !           499:                return Qnil;
        !           500: 
        !           501:        XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left);
        !           502:        if (XINT (ycoord) == (screen_height - 1))
        !           503:                return Qnil;
        !           504: 
        !           505:        if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) ||
        !           506:            (XINT (ycoord) >= (XINT (XWINDOW (window)->top) +
        !           507:                               XINT (XWINDOW (window)->height)) - 1))
        !           508:                return Qnil;
        !           509: 
        !           510:        XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top);
        !           511:        return Fcons (xcoord, Fcons (ycoord, Qnil));
        !           512: }
        !           513: 
        !           514: DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
        !           515:   "Return number of pending mouse events from X window system.")
        !           516:   ()
        !           517: {
        !           518:        register Lisp_Object tem;
        !           519: 
        !           520:        check_xterm ();
        !           521: 
        !           522:        XSET (tem, Lisp_Int, XXm_queue_num);
        !           523:        
        !           524:        return tem;
        !           525: }
        !           526: 
        !           527: DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event,
        !           528:   0, 0, 0,
        !           529:   "Pulls a mouse event out of the mouse event buffer and dispatches\n\
        !           530: the appropriate function to act upon this event.")
        !           531:   ()
        !           532: {
        !           533:        XEvent event;
        !           534:        register Lisp_Object Mouse_Cmd;
        !           535:        register char com_letter;
        !           536:        register char key_mask;
        !           537:        register Lisp_Object tempx;
        !           538:        register Lisp_Object tempy;
        !           539:        extern Lisp_Object get_keyelt ();
        !           540:        
        !           541:        check_xterm ();
        !           542: 
        !           543:        if (XXm_queue_num) {
        !           544:                event = *XXm_queue[XXm_queue_num-1];
        !           545:                free (XXm_queue[--XXm_queue_num]);
        !           546:                com_letter = 3-(event.xbutton.button & 3);
        !           547:                key_mask = (event.xbutton.state & 15) << 4;
        !           548:                com_letter |= key_mask;
        !           549:                if (event.type == ButtonRelease)
        !           550:                        com_letter |= 0x04;
        !           551:                XSET (tempx, Lisp_Int,
        !           552:                      min (screen_width-1,
        !           553:                           max (0, (event.xbutton.x-XXInternalBorder)/
        !           554:                                XXfontw)));
        !           555:                XSET (tempy, Lisp_Int,
        !           556:                      min (screen_height-1,
        !           557:                           max (0, (event.xbutton.y-XXInternalBorder)/
        !           558:                                XXfonth)));
        !           559:                Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
        !           560:                XSET (tempx, Lisp_Int, event.xbutton.x+XXxoffset);
        !           561:                XSET (tempy, Lisp_Int, event.xbutton.y+XXyoffset);
        !           562:                Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
        !           563:                Vx_mouse_item = make_number (com_letter);
        !           564:                Mouse_Cmd = get_keyelt (access_keymap (MouseMap, com_letter));
        !           565:                if (NULL (Mouse_Cmd)) {
        !           566:                        if (event.type != ButtonRelease)
        !           567:                                Ding ();
        !           568:                        Vx_mouse_pos = Qnil;
        !           569:                }
        !           570:                else
        !           571:                        return call1 (Mouse_Cmd, Vx_mouse_pos);
        !           572:        }
        !           573:        return Qnil;
        !           574: }
        !           575: 
        !           576: DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
        !           577:   1, 1, 0,
        !           578:   "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
        !           579: ARG non-nil means return nil immediately if no pending event;\n\
        !           580: otherwise, wait for an event.")
        !           581:   (arg)
        !           582:      Lisp_Object arg;
        !           583: {
        !           584:        XEvent event;
        !           585:        register char com_letter;
        !           586:        register char key_mask;
        !           587: 
        !           588:        register Lisp_Object tempx;
        !           589:        register Lisp_Object tempy;
        !           590:        
        !           591:        check_xterm ();
        !           592: 
        !           593:        if (NULL (arg))
        !           594:                while (!XXm_queue_num)
        !           595:                        sleep(1);
        !           596:        /*** ??? Surely you don't mean to busy wait??? */
        !           597: 
        !           598:        if (XXm_queue_num) {
        !           599:                event = *XXm_queue[XXm_queue_num-1];
        !           600:                free (XXm_queue[--XXm_queue_num]);
        !           601:                com_letter = 3-(event.xbutton.button & 3);
        !           602:                key_mask = (event.xbutton.state & 15) << 4;
        !           603:                com_letter |= key_mask;
        !           604:                if (event.type == ButtonRelease)
        !           605:                        com_letter |= 0x04;
        !           606:                XSET (tempx, Lisp_Int,
        !           607:                      min (screen_width-1,
        !           608:                           max (0, (event.xbutton.x-XXInternalBorder)/
        !           609:                                XXfontw)));
        !           610:                XSET (tempy, Lisp_Int,
        !           611:                      min (screen_height-1,
        !           612:                           max (0, (event.xbutton.y-XXInternalBorder)/
        !           613:                                XXfonth)));
        !           614:                Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
        !           615:                XSET (tempx, Lisp_Int, event.xbutton.x+XXxoffset);
        !           616:                XSET (tempy, Lisp_Int, event.xbutton.y+XXyoffset);
        !           617:                Vx_mouse_abs_pos = Fcond (tempx, Fcons (tempy, Qnil));
        !           618:                return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil));
        !           619:        }
        !           620:        return Qnil;
        !           621: }
        !           622: 
        !           623: DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
        !           624:   1, 1, "sSend string to X:",
        !           625:   "Store contents of STRING into the cut buffer of the X window system.")
        !           626:   (string)
        !           627:      register Lisp_Object string;
        !           628: {
        !           629:        int mask;
        !           630: 
        !           631:        CHECK_STRING (string, 1);
        !           632:        check_xterm ();
        !           633: 
        !           634:        mask = sigblock (sigmask (SIGIO));
        !           635:        XStoreBytes (XXdisplay, XSTRING (string)->data,
        !           636:                     XSTRING (string)->size);
        !           637:        sigsetmask (mask);
        !           638: 
        !           639:        return Qnil;
        !           640: }
        !           641: 
        !           642: DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
        !           643:   "Return contents of cut buffer of the X window system, as a string.")
        !           644:   ()
        !           645: {
        !           646:        int len;
        !           647:        register Lisp_Object string;
        !           648:        int mask;
        !           649:        register char *d;
        !           650: 
        !           651:        mask = sigblock (sigmask (SIGIO));
        !           652:        d = XFetchBytes (XXdisplay, &len);
        !           653:        string = make_string (d, len);
        !           654:        sigsetmask (mask);
        !           655: 
        !           656:        return string;
        !           657: }
        !           658: 
        !           659: DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width,
        !           660:   1, 1, "nBorder width: ",
        !           661:   "Set width of border to WIDTH, in the X window system.")
        !           662:   (borderwidth)
        !           663:      register Lisp_Object borderwidth;
        !           664: {
        !           665:        register int mask;
        !           666: 
        !           667:        CHECK_NUMBER (borderwidth, 0);
        !           668: 
        !           669:        check_xterm ();
        !           670:   
        !           671:        if (XINT (borderwidth) < 0)
        !           672:                XSETINT (borderwidth, 0);
        !           673:   
        !           674:        mask = sigblock (sigmask (SIGIO));
        !           675:        XSetWindowBorderWidth(XXdisplay, XXwindow, XINT(borderwidth));
        !           676:        XFlush(XXdisplay);
        !           677:        sigsetmask (mask);
        !           678: 
        !           679:        if (QLength(XXdisplay) > 0)
        !           680:                read_events_block ();
        !           681: 
        !           682:        return Qt;
        !           683: }
        !           684: 
        !           685: 
        !           686: DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width,
        !           687:        Sx_set_internal_border_width, 1, 1, "nInternal border width: ",
        !           688:   "Set width of internal border to WIDTH, in the X window system.")
        !           689:   (internalborderwidth)
        !           690:      register Lisp_Object internalborderwidth;
        !           691: {
        !           692:        register int mask;
        !           693: 
        !           694:        CHECK_NUMBER (internalborderwidth, 0);
        !           695: 
        !           696:        check_xterm ();
        !           697:   
        !           698:        if (XINT (internalborderwidth) < 0)
        !           699:                XSETINT (internalborderwidth, 0);
        !           700: 
        !           701:        mask = sigblock (sigmask (SIGIO));
        !           702:        XXInternalBorder = XINT(internalborderwidth);
        !           703:        XSetWindowSize(screen_height,screen_width);
        !           704:        sigsetmask (mask);
        !           705: 
        !           706:        if (QLength(XXdisplay) > 0)
        !           707:                read_events_block ();
        !           708: 
        !           709:        return Qt;
        !           710: }
        !           711: 
        !           712: #ifdef foobar
        !           713: DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
        !           714:   "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
        !           715: KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
        !           716: and shift mask respectively.  NEWSTRING is an arbitrary string of keystrokes.\n\
        !           717: If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
        !           718: all shift combinations.\n\
        !           719: Shift Lock  1     Shift    2\n\
        !           720: Meta       4      Control  8\n\
        !           721: \n\
        !           722: For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
        !           723: in that file are in octal!)\n")
        !           724: 
        !           725:   (keycode, shift_mask, newstring)
        !           726:      register Lisp_Object keycode;
        !           727:      register Lisp_Object shift_mask;
        !           728:      register Lisp_Object newstring;
        !           729: {
        !           730: #ifdef notdef
        !           731:        char *rawstring;
        !           732:        int rawkey, rawshift;
        !           733:        int i;
        !           734:        int strsize;
        !           735: 
        !           736:        CHECK_NUMBER (keycode, 1);
        !           737:        if (!NULL (shift_mask))
        !           738:                CHECK_NUMBER (shift_mask, 2);
        !           739:        CHECK_STRING (newstring, 3);
        !           740:        strsize = XSTRING (newstring) ->size;
        !           741:        rawstring = (char *) xmalloc (strsize);
        !           742:        bcopy (XSTRING (newstring)->data, rawstring, strsize);
        !           743:        rawkey = ((unsigned) (XINT (keycode))) & 255;
        !           744:        if (NULL (shift_mask))
        !           745:                for (i = 0; i <= 15; i++)
        !           746:                        XRebindCode (rawkey, i<<11, rawstring, strsize);
        !           747:        else
        !           748:        {
        !           749:                rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
        !           750:                XRebindCode (rawkey, rawshift, rawstring, strsize);
        !           751:        }
        !           752: #endif notdef
        !           753:        return Qnil;
        !           754: }
        !           755:   
        !           756: DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
        !           757:   "Rebind KEYCODE to list of strings STRINGS.\n\
        !           758: STRINGS should be a list of 16 elements, one for each all shift combination.\n\
        !           759: nil as element means don't change.\n\
        !           760: See the documentation of x-rebind-key for more information.")
        !           761:   (keycode, strings)
        !           762:      register Lisp_Object keycode;
        !           763:      register Lisp_Object strings;
        !           764: {
        !           765: #ifdef notdef
        !           766:        register Lisp_Object item;
        !           767:        register char *rawstring;
        !           768:        int rawkey, strsize;
        !           769:        register unsigned i;
        !           770: 
        !           771:        CHECK_NUMBER (keycode, 1);
        !           772:        CHECK_CONS (strings, 2);
        !           773:        rawkey = ((unsigned) (XINT (keycode))) & 255;
        !           774:        for (i = 0; i <= 15; strings = Fcdr (strings), i++)
        !           775:        {
        !           776:                item = Fcar (strings);
        !           777:                if (!NULL (item))
        !           778:                {
        !           779:                        CHECK_STRING (item, 2);
        !           780:                        strsize = XSTRING (item)->size;
        !           781:                        rawstring = (char *) xmalloc (strsize);
        !           782:                        bcopy (XSTRING (item)->data, rawstring, strsize);
        !           783:                        XRebindCode (rawkey, i << 11, rawstring, strsize);
        !           784:                }
        !           785:        }
        !           786: #endif notdef
        !           787:        return Qnil;
        !           788: }
        !           789: 
        !           790: #endif foobar
        !           791: 
        !           792: XExitWithCoreDump ()
        !           793: {
        !           794:        XCleanUp ();
        !           795:        abort ();
        !           796: }
        !           797: 
        !           798: DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0,
        !           799:   "ARG non-nil means that X errors should generate a coredump.")
        !           800:   (arg)
        !           801:      register Lisp_Object arg;
        !           802: {
        !           803:        int (*handler)();
        !           804: 
        !           805:        if (!NULL (arg))
        !           806:                handler = XExitWithCoreDump;
        !           807:        else
        !           808:        {
        !           809:                extern int XIgnoreError ();
        !           810:                handler = XIgnoreError;
        !           811:        }
        !           812:        XSetErrorHandler(handler);
        !           813:        XSetIOErrorHandler(handler);
        !           814:        return (Qnil);
        !           815: }
        !           816: 
        !           817: XRedrawDisplay ()
        !           818: {
        !           819:        Fredraw_display ();
        !           820: }
        !           821: 
        !           822: XCleanUp ()
        !           823: {
        !           824:        Fdo_auto_save (Qt);
        !           825: 
        !           826: #ifdef subprocesses
        !           827:        kill_buffer_processes (Qnil);
        !           828: #endif                         /* subprocesses */
        !           829: }
        !           830: 
        !           831: syms_of_xfns ()
        !           832: {
        !           833:        DEFVAR_LISP ("xterm", &Vxterm1,
        !           834:                     "t if using xterm, nil otherwise.\n\
        !           835: This variable is obsolete; you should use (eq window-system 'x).");
        !           836:        Vxterm1 = Qnil;
        !           837:        Vxterm = Qnil;
        !           838:        DEFVAR_LISP ("x-mouse-item", &Vx_mouse_item,
        !           839:                     "Encoded representation of last mouse click, corresponding to\n\
        !           840: numerical entries in x-mouse-map.");
        !           841:        Vx_mouse_item = Qnil;
        !           842:        DEFVAR_LISP ("x-mouse-pos", &Vx_mouse_pos,
        !           843:                     "Current x-y position of mouse by row, column as specified by font.");
        !           844:        Vx_mouse_pos = Qnil;
        !           845:        DEFVAR_LISP ("x-mouse-abs-pos", &Vx_mouse_abs_pos,
        !           846:                     "Current x-y position of mouse relative to root window.");
        !           847: 
        !           848:        defsubr (&Sx_set_bell);
        !           849:        defsubr (&Sx_flip_color);
        !           850:        defsubr (&Sx_set_font);
        !           851: #ifdef notdef
        !           852:        defsubr (&Sx_set_icon);
        !           853: #endif notdef
        !           854:        defsubr (&Scoordinates_in_window_p);
        !           855:        defsubr (&Sx_mouse_events);
        !           856:        defsubr (&Sx_proc_mouse_event);
        !           857:        defsubr (&Sx_get_mouse_event);
        !           858:        defsubr (&Sx_store_cut_buffer);
        !           859:        defsubr (&Sx_get_cut_buffer);
        !           860:        defsubr (&Sx_set_border_width);
        !           861:        defsubr (&Sx_set_internal_border_width);
        !           862:        defsubr (&Sx_set_foreground_color);
        !           863:        defsubr (&Sx_set_background_color);
        !           864:        defsubr (&Sx_set_border_color);
        !           865:        defsubr (&Sx_set_cursor_color);
        !           866:        defsubr (&Sx_set_mouse_color);
        !           867:        defsubr (&Sx_get_foreground_color);
        !           868:        defsubr (&Sx_get_background_color);
        !           869:        defsubr (&Sx_get_border_color);
        !           870:        defsubr (&Sx_get_cursor_color);
        !           871:        defsubr (&Sx_get_mouse_color);
        !           872:        defsubr (&Sx_color_p);
        !           873:        defsubr (&Sx_get_default);
        !           874: #ifdef notdef
        !           875:        defsubr (&Sx_rebind_key);
        !           876:        defsubr (&Sx_rebind_keys);
        !           877: #endif notdef
        !           878:        defsubr (&Sx_debug);
        !           879: }
        !           880: 
        !           881: #endif /* HAVE_X_WINDOWS */

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