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