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