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