Annotation of researchv9/X11/src/X.V11R1/clients/emacs/xfns.c, revision 1.1.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 */

unix.superglobalmegacorp.com

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