![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to xfns.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to xfns.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* Functions for the X window system.
2: Copyright (C) 1985 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 added by Robert Krawitz*/
23:
24: /*#include <stdio.h>*/
25: #include "config.h"
26: #include "lisp.h"
27: #include "window.h"
28: #include "xterm.h"
29: #include "dispextern.h"
30: #include "termchar.h"
31: #include <signal.h>
32: #include "sink.h"
33: #include "sinkmask.h"
34: #include <sys/time.h>
35: #include <fcntl.h>
36: #include <setjmp.h>
37:
38: #define abs(x) ((x < 0) ? ((x)) : (x))
39: #define sgn(x) ((x < 0) ? (-1) : (1))
40:
41: #define CROSS_WIDTH 16
42: #define CROSS_HEIGHT 16
43:
44: static short cross_bits[] =
45: {
46: 0x0000, 0x0180, 0x0180, 0x0180,
47: 0x0180, 0x0180, 0x0180, 0x7ffe,
48: 0x7ffe, 0x0180, 0x0180, 0x0180,
49: 0x0180, 0x0180, 0x0180, 0x0000,
50: };
51:
52: static short gray_bits[] = {
53: 0xaaaa, 0x5555, 0xaaaa, 0x5555,
54: 0xaaaa, 0x5555, 0xaaaa, 0x5555,
55: 0xaaaa, 0x5555, 0xaaaa, 0x5555,
56: 0xaaaa, 0x5555, 0xaaaa, 0x5555};
57:
58: #define CROSS_MASK_WIDTH 16
59: #define CROSS_MASK_HEIGHT 16
60: static short cross_mask_bits[] =
61: {
62: 0x03c0, 0x03c0, 0x03c0, 0x03c0,
63: 0x03c0, 0x03c0, 0xffff, 0xffff,
64: 0xffff, 0xffff, 0x03c0, 0x03c0,
65: 0x03c0, 0x03c0, 0x03c0, 0x03c0,
66: };
67:
68: extern XREPBUFFER Xxrepbuffer;
69:
70: /* Non-nil if Emacs is running with an X window for display.
71: Nil if Emacs is run on an ordinary terminal. */
72:
73: Lisp_Object Vxterm;
74:
75: Lisp_Object Vx_mouse_pos;
76:
77: extern struct Lisp_Vector *MouseMap;
78:
79: extern char *fore_color;
80: extern char *back_color;
81: extern char *brdr_color;
82: extern char *mous_color;
83: extern char *curs_color;
84:
85: extern int fore;
86: extern int back;
87: extern int brdr;
88: extern int mous;
89: extern int curs;
90:
91: /* Nonzero if x-set-window-edges has been called
92: or x-rubber-band has been called.
93: If it is zero when x-pop-up-window is called,
94: x-rubber-band is called at that point. */
95:
96: int x_edges_specified;
97:
98: check_xterm ()
99: {
100: if (NULL (Vxterm))
101: error ("Terminal does not understand X protocol.");
102: }
103:
104: DEFUN ("x-pop-up-window", Fx_pop_up_window, Sx_pop_up_window, 0, 0, 0,
105: "Make the X window appear on the screen.")
106: ()
107: {
108: check_xterm();
109: XPopUpWindow();
110: return Qnil;
111: }
112:
113: DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P",
114: "For X window system, set audible vs visible bell.\n\
115: With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.")
116: (arg)
117: Lisp_Object arg;
118: {
119: check_xterm ();
120: if (!NULL (arg))
121: XSetFlash ();
122: else
123: XSetFeep ();
124: return arg;
125: }
126:
127: DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "",
128: "Toggle the background and foreground colors (currently only black \n\
129: and white -- by default background is white -- Only effective at init")
130: ()
131: {
132: check_xterm ();
133: XFlipColor ();
134: return Qt;
135: }
136:
137: DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
138: Sx_set_foreground_color, 1, 1, "sSet foregroud color: ",
139: "Set foreground (text) color to COLOR.")
140: (arg)
141: Lisp_Object arg;
142: {
143: Color cdef;
144: extern int PendingExposure;
145: int (*func) ();
146: extern Window XXwindow;
147: extern FontInfo *fontinfo;
148: char *save_color;
149: save_color = fore_color;
150: check_xterm ();
151: CHECK_STRING (arg,1);
152: fore_color = (char *) xmalloc (XSTRING (arg)->size + 1);
153: func = signal (SIGIO, SIG_IGN);
154: bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1);
155: if (fore_color && DisplayCells() > 2 &&
156: XParseColor(fore_color, &cdef) && XGetHardwareColor(&cdef)) {
157: fore = cdef.pixel;
158: } else if (fore_color && strcmp(fore_color, "black") == 0) {
159: fore = BlackPixel;
160: } else if (fore_color && strcmp(fore_color, "white") == 0) {
161: fore = WhitePixel;
162: }
163: else
164: {
165: fore_color = save_color;
166: }
167: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width,
168: screen_height * fontinfo->height, back, ClipModeClipped,
169: GXcopy, AllPlanes);*/
170: Fredraw_display ();
171: /* dumprectangle(0, 0, screen_height * fontinfo->height,
172: screen_width * fontinfo -> width);*/
173: /* PendingExposure = 1;
174: xfixscreen ();*/
175: (void) signal (SIGIO, func);
176: XFlush();
177: return Qt;
178: }
179:
180: DEFUN ("x-set-background-color", Fx_set_background_color,
181: Sx_set_background_color, 1, 1, "sSet background color: ",
182: "Set background color to COLOR.")
183: (arg)
184: Lisp_Object arg;
185: {
186: Color cdef;
187: extern int PendingExposure;
188: Pixmap temp;
189: int (*func) ();
190: char *save_color;
191: extern Window XXwindow;
192: check_xterm ();
193: CHECK_STRING (arg,1);
194: back_color = (char *) xmalloc (XSTRING (arg)->size + 1);
195: bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1);
196: func = signal (SIGIO, SIG_IGN);
197: if (back_color && DisplayCells() > 2 &&
198: XParseColor(back_color, &cdef) && XGetHardwareColor(&cdef)) {
199: back = cdef.pixel;
200: } else if (back_color && strcmp(back_color, "white") == 0) {
201: back = WhitePixel;
202: } else if (back_color && strcmp(back_color, "black") == 0) {
203: back = BlackPixel;
204: }
205: else
206: {
207: back_color = save_color;
208: }
209: temp = XMakeTile(back);
210: XChangeBackground (XXwindow, temp);
211: /* XPixFill (XXwindow, 0, 0, screen_width * fontinfo->width,
212: screen_height * fontinfo->height, back, ClipModeClipped,
213: GXcopy, AllPlanes);*/
214: (void) signal (SIGIO, func);
215: Fredraw_display();
216: /* dumprectangle(0, 0, screen_height * fontinfo->height,
217: screen_width * fontinfo -> width);*/
218: /* PendingExposure = 1;
219: xfixscreen ();*/
220: XFlush();
221: XFreePixmap (temp);
222: return Qt;
223: }
224:
225: DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1,
226: "sSet border color: ",
227: "Set border color to COLOR.")
228: (arg)
229: Lisp_Object arg;
230: {
231: Color cdef;
232: Pixmap temp;
233: extern int XXborder;
234: int (*func) ();
235: extern Window XXwindow;
236: check_xterm ();
237: CHECK_STRING (arg,1);
238: brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1);
239: bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1);
240: func = signal (SIGIO, SIG_IGN);
241: if (brdr_color && DisplayCells() > 2 &&
242: XParseColor(brdr_color, &cdef) && XGetHardwareColor(&cdef))
243: {
244: temp = XMakeTile(cdef.pixel);
245: brdr = cdef.pixel;
246: }
247: else if (brdr_color && strcmp(brdr_color, "black") == 0)
248: {
249: temp = BlackPixmap;
250: brdr = BlackPixel;
251: }
252: else if (brdr_color && strcmp(brdr_color, "white") == 0)
253: {
254: temp = WhitePixmap;
255: brdr = WhitePixel;
256: }
257: else
258: {
259: temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits),
260: BlackPixel, WhitePixel);
261: brdr = BlackPixel;
262: brdr_color = "gray";
263: }
264: if (XXborder)
265: XChangeBorder (XXwindow, temp);
266: (void) signal (SIGIO, func);
267: XFreePixmap (temp);
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: Color cdef;
278: extern Window XXwindow;
279: int (*func) ();
280: char *save_color;
281: check_xterm ();
282: CHECK_STRING (arg,1);
283: curs_color = (char *) xmalloc (XSTRING (arg)->size + 1);
284: func = signal (SIGIO, SIG_IGN);
285: bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1);
286: if (curs_color && DisplayCells() > 2 &&
287: XParseColor(curs_color, &cdef) && XGetHardwareColor(&cdef)) {
288: curs = cdef.pixel;
289: } else if (curs_color && strcmp(curs_color, "black") == 0) {
290: curs = BlackPixel;
291: } else if (curs_color && strcmp(curs_color, "white") == 0) {
292: curs = WhitePixel;
293: }
294: else
295: {
296: curs_color = save_color;
297: }
298: (void) signal (SIGIO, func);
299: CursorToggle();
300: CursorToggle();
301: return Qt;
302: }
303:
304: DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1,
305: "sSet mouse cursor color: ",
306: "Set mouse cursor color to COLOR.")
307: (arg)
308: Lisp_Object arg;
309: {
310: extern Cursor EmacsCursor;
311: extern char MouseCursor[], MouseMask[];
312: Cursor temp;
313: int (*func) ();
314: Color cdef;
315: char *save_color;
316: extern Window XXwindow;
317: check_xterm ();
318: CHECK_STRING (arg,1);
319: mous_color = (char *) xmalloc (XSTRING (arg)->size + 1);
320: func = signal (SIGIO, SIG_IGN);
321: bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1);
322: if (mous_color && DisplayCells() > 2 &&
323: XParseColor(mous_color, &cdef) && XGetHardwareColor(&cdef)) {
324: mous = cdef.pixel;
325: } else if (mous_color && strcmp(mous_color, "black") == 0) {
326: mous = BlackPixel;
327: } else if (mous_color && strcmp(mous_color, "white") == 0) {
328: mous = WhitePixel;
329: }
330: else
331: {
332: mous_color = save_color;
333: }
334: temp = XCreateCursor(16, 16, MouseCursor, MouseMask, 0, 0,
335: mous, back, GXcopy);
336: XDefineCursor (XXwindow, temp);
337: XFreeCursor (EmacsCursor);
338: (void) signal (SIGIO, func);
339: bcopy(&temp, &EmacsCursor, sizeof(Cursor));
340: return Qt;
341: }
342:
343: DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, "",
344: "Returns t if the display is a color X terminal.")
345: ()
346: {
347: check_xterm ();
348: if (DisplayCells() > 2)
349: return Qt;
350: else
351: return Qnil;
352: }
353:
354: DEFUN ("x-get-foreground-color", Fx_get_foreground_color,
355: Sx_get_foreground_color, 0, 0, "",
356: "Returns the color of the foreground, as a string.")
357: ()
358: {
359: Lisp_Object string;
360: string = make_string(fore_color, strlen (fore_color));
361: return string;
362: }
363:
364: DEFUN ("x-get-background-color", Fx_get_background_color,
365: Sx_get_background_color, 0, 0, "",
366: "Returns the color of the background, as a string.")
367: ()
368: {
369: Lisp_Object string;
370: string = make_string(back_color, strlen (back_color));
371: return string;
372: }
373:
374: DEFUN ("x-get-border-color", Fx_get_border_color,
375: Sx_get_border_color, 0, 0, "",
376: "Returns the color of the border, as a string.")
377: ()
378: {
379: Lisp_Object string;
380: string = make_string(brdr_color, strlen (brdr_color));
381: return string;
382: }
383:
384: DEFUN ("x-get-cursor-color", Fx_get_cursor_color,
385: Sx_get_cursor_color, 0, 0, "",
386: "Returns the color of the cursor, as a string.")
387: ()
388: {
389: Lisp_Object string;
390: string = make_string(curs_color, strlen (curs_color));
391: return string;
392: }
393:
394: DEFUN ("x-get-mouse-color", Fx_get_mouse_color,
395: Sx_get_mouse_color, 0, 0, "",
396: "Returns the color of the mouse cursor, as a string.")
397: ()
398: {
399: Lisp_Object string;
400: string = make_string(mous_color, strlen (mous_color));
401: return string;
402: }
403:
404: DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1,
405: "sGet X default name: ",
406: "Get X default ATTRIBUTE from the system. Returns nil if\n\
407: attribute does not exist.")
408: (arg)
409: Lisp_Object arg;
410: {
411: char *default_name, *value;
412: Lisp_Object return_string;
413: extern char *malloc(), strcpy();
414: check_xterm ();
415: CHECK_STRING (arg,1);
416: default_name = (char *) xmalloc (XSTRING (arg) -> size + 1);
417: if (default_name == 0)
418: {
419: return Qnil;
420: }
421: else
422: {
423: bcopy (XSTRING (arg) -> data, default_name,
424: XSTRING (arg) -> size + 1);
425: value = XGetDefault("emacs", default_name);
426: if (value == 0)
427: value = XGetDefault("", default_name);
428: return make_string (value, value ? strlen (value) : 0);
429: }
430: }
431:
432: DEFUN ("x-set-icon", Fx_set_icon, Sx_set_icon, 1, 1, "P",
433: "Set type of icon used by X for Emacs's window.\n\
434: ARG non-nil means use kitchen-sink icon;\n\
435: nil means use generic window manager icon.")
436: (arg)
437: Lisp_Object arg;
438: {
439: check_xterm ();
440: if (NULL (arg))
441: XTextIcon ();
442: else
443: XBitmapIcon ();
444: return arg;
445: }
446:
447: DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ",
448: "At initialization sets the font to be used for the X window.")
449: (arg)
450: Lisp_Object arg;
451: {
452: register char *newfontname;
453: extern char *XXcurrentfont;
454:
455: CHECK_STRING (arg, 1);
456: check_xterm ();
457:
458: newfontname = (char *) xmalloc (XSTRING (arg)->size + 1);
459: bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1);
460: if (!XNewFont (newfontname))
461: {
462: free (XXcurrentfont);
463: XXcurrentfont = newfontname;
464: return Qt;
465: }
466: else
467: {
468: error ("Font %s is not defined", newfontname);
469: free (newfontname);
470: }
471:
472: return Qnil;
473: }
474:
475: DEFUN ("x-set-window-edges", Fx_set_window_edges, Sx_set_window_edges, 4, 4,
476: "nNumber of Columns: \nnNumber of Rows: \nnX Offset in Pixels: \n\
477: nY Offset in Pixels: ",
478: "Sets X window size/position: size COLS by ROWS, positions XOFF and YOFF.\n\
479: To get \"minus zero\" for XOFF or YOFF, supply -1.")
480: (cols, rows, xoffset, yoffset)
481: Lisp_Object rows, cols, xoffset, yoffset;
482: {
483: CHECK_NUMBER (rows, 1);
484: CHECK_NUMBER (cols, 2);
485: CHECK_NUMBER (xoffset, 3);
486: CHECK_NUMBER (yoffset, 4);
487: check_xterm ();
488:
489: x_edges_specified = 1;
490: if (XINT (rows) != screen_width || XINT (cols) != screen_height)
491: {
492: XSetWindowSize (XINT (rows), XINT (cols));
493: }
494: XSetOffset (XINT (xoffset), XINT (yoffset));
495: XFlush ();
496: return Qt;
497: }
498:
499: DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
500: Scoordinates_in_window_p, 2, 2,
501: "xSpecify coordinate pair: \nXExpression which evals to window: ",
502: "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
503: Returned value is list of positions expressed\n\
504: relative to window upper left corner.")
505: (coordinate, window)
506: register Lisp_Object coordinate, window;
507: {
508: register Lisp_Object xcoord, ycoord;
509:
510: if (!LISTP (coordinate)) wrong_type_argument (Qlistp, coordinate);
511: CHECK_WINDOW (window, 2);
512: xcoord = Fcar (coordinate);
513: ycoord = Fcar (Fcdr (coordinate));
514: CHECK_NUMBER (xcoord, 0);
515: CHECK_NUMBER (ycoord, 1);
516: if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) ||
517: (XINT (xcoord) >= (XINT (XWINDOW (window)->left) +
518: XINT (XWINDOW (window)->width))))
519: {
520: return Qnil;
521: }
522: XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left);
523: if (XINT (ycoord) == (screen_height - 1))
524: return Qnil;
525: if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) ||
526: (XINT (ycoord) >= (XINT (XWINDOW (window)->top) +
527: XINT (XWINDOW (window)->height)) - 1))
528: {
529: return Qnil;
530: }
531: XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top);
532: return (Fcons (xcoord, Fcons (ycoord, Qnil)));
533: }
534:
535: DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
536: "Return number of pending mouse events from X window system.")
537: ()
538: {
539: register Lisp_Object tem;
540: register int windex, rindex, mindex;
541:
542: check_xterm ();
543: windex = Xxrepbuffer.windex;
544: rindex = Xxrepbuffer.rindex;
545: mindex = Xxrepbuffer.mindex;
546:
547: if (windex >= rindex)
548: {
549: XSET (tem, Lisp_Int, windex - rindex);
550: }
551: else
552: {
553: XSET (tem, Lisp_Int, mindex + 1 - (rindex - windex));
554: }
555: return tem;
556: }
557:
558: DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event,
559: 0, 0, 0,
560: "Pulls a mouse event out of the mouse event buffer and dispatches\n\
561: the appropriate function to act upon this event.")
562: ()
563: {
564: XButtonEvent xrep;
565: extern FontInfo *fontinfo;
566: register Lisp_Object Mouse_Cmd;
567: register char com_letter;
568: register char key_mask;
569: register Lisp_Object tempx;
570: register Lisp_Object tempy;
571: extern Lisp_Object get_keyelt ();
572:
573: check_xterm ();
574: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0)
575: {
576: com_letter = xrep.detail & 3;
577: key_mask = (xrep.detail >> 8) & 0xf0;
578: com_letter |= key_mask;
579: XSET (tempx, Lisp_Int, xrep.x/fontinfo->width);
580: XSET (tempy, Lisp_Int, xrep.y/fontinfo->height);
581: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
582: Mouse_Cmd = get_keyelt (access_keymap (MouseMap, com_letter));
583: if (NULL (Mouse_Cmd))
584: {
585: Ding ();
586: Vx_mouse_pos = Qnil;
587: }
588: else
589: {
590: return (call1 (Mouse_Cmd, Vx_mouse_pos));
591: }
592: }
593: return Qnil;
594: }
595:
596: DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
597: 1, 1, 0,
598: "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
599: ARG non-nil means return nil immediately if no pending event;\n\
600: otherwise, wait for an event.")
601: (arg)
602: Lisp_Object arg;
603: {
604: XButtonEvent xrep;
605: extern FontInfo *fontinfo;
606: register Lisp_Object Mouse_Cmd;
607: register char com_letter;
608: register char key_mask;
609:
610: register Lisp_Object tempx;
611: register Lisp_Object tempy;
612: extern Lisp_Object get_keyelt ();
613:
614: check_xterm ();
615:
616: if (NULL (arg))
617: while (Xxrepbuffer.windex == Xxrepbuffer.rindex);
618: /*** ??? Surely you don't mean to busy wait??? */
619: if (unloadxrepbuffer (&xrep, &Xxrepbuffer) == 0)
620: {
621: com_letter = *((char *)&xrep.detail);
622: com_letter &= 3;
623: key_mask = *((char *)&xrep.detail + 1);
624: key_mask &= 0xf0;
625: com_letter |= key_mask;
626: XSET (tempx, Lisp_Int, xrep.x/fontinfo->width);
627: XSET (tempy, Lisp_Int, xrep.y/fontinfo->height);
628: Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
629: return (Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil)));
630: }
631: return Qnil;
632: }
633:
634: DEFUN ("x-set-keyboard-enable", Fx_set_keyboard_enable,
635: Sx_set_keyboard_enable, 1, 1, 0,
636: "In the X window system, set the flag that permite keyboard input.\n\
637: Permit input if ARG is non-nil.")
638: (arg)
639: Lisp_Object arg;
640: {
641: extern Window XXwindow;
642: check_xterm ();
643:
644: XSelectInput (XXwindow,
645: ExposeWindow | ButtonPressed | ExposeRegion | ExposeCopy
646: | (!NULL (arg) ? KeyPressed : 0));
647: return arg;
648: }
649:
650: DEFUN ("x-set-mouse-inform-flag", Fx_set_mouse_inform_flag,
651: Sx_set_mouse_inform_flag, 1, 1, 0,
652: "Set inform-of-mouse-events flag in X window system on if ARG is non-nil.")
653: (arg)
654: Lisp_Object arg;
655: {
656: extern int informflag;
657: informflag = !NULL (arg);
658: return arg;
659: }
660:
661: DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
662: 1, 1, "sSend string to X:",
663: "Store contents of STRING into the cut buffer of the X window system.")
664: (string)
665: register Lisp_Object string;
666: {
667: CHECK_STRING (string, 1);
668: check_xterm ();
669:
670: XStoreBytes (XSTRING (string)->data, XSTRING (string)->size);
671:
672: return Qnil;
673: }
674:
675: DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
676: "Return contents of cut buffer of the X window system, as a string.")
677: ()
678: {
679: int len;
680: register Lisp_Object string;
681: register int (*func) ();
682: register char *d;
683:
684: func = (int (*)()) (signal (SIGIO, SIG_IGN));
685: d = XFetchBytes (&len);
686: string = make_string (d, len);
687: signal (SIGIO, func);
688: return string;
689: }
690:
691: DEFUN ("x-rubber-band", Fx_rubber_band, Sx_rubber_band, 0, 0, 0,
692: "Ask user to specify Emacs window position and size with mouse.\n\
693: This is done automatically if the data has not been specified\n\
694: when Emacs needs the window to be displayed.")
695: ()
696: {
697: int x, y, width, height;
698: extern int XXborder;
699: extern int PendingExposure;
700: extern char *default_window;
701: register int (*handle) ();
702: x_edges_specified = 1;
703:
704: check_xterm ();
705: handle = signal (SIGIO, SIG_IGN);
706: window_fetch (fontinfo->id, &x, &y, &width, &height, "", default_window,
707: XXborder, "Gnuemacs");
708: (void) signal (SIGIO, handle);
709: XSetWindowSize (height, width);
710: XSetOffset (x, y);
711: XFlush();
712: return Qnil;
713: }
714:
715: DEFUN ("x-create-x-window", Fx_create_x_window, Sx_create_x_window,
716: 1, 1, 0,
717: "Create window for gnuemacs from a valid GEOMETRY specification.")
718: (arg)
719: Lisp_Object arg;
720: {
721: int x, y, width, height;
722: extern int XXborder;
723: extern int PendingExposure;
724: char *geometry;
725: register int (*handle) ();
726: x_edges_specified = 1;
727:
728: check_xterm ();
729: CHECK_STRING(arg, 1);
730: geometry= (char *) xmalloc (XSTRING (arg)->size + 1);
731: bcopy (XSTRING (arg)->data, geometry, XSTRING (arg)->size + 1);
732: handle = signal (SIGIO, SIG_IGN);
733: window_fetch (fontinfo->id, &x, &y, &width, &height, geometry,
734: default_window, XXborder, "Gnuemacs");
735: (void) signal (SIGIO, handle);
736: XSetWindowSize (height, width);
737: /* XSetWindowSize ((height - (2 * XXborder))/fontinfo -> height,
738: (width - (2 * XXborder))/fontinfo -> width);*/
739: XSetOffset (x, y);
740: XMapWindow (XXwindow);
741: XFlush();
742: return Qnil;
743: }
744:
745: DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width,
746: 1, 1, 0,
747: "Set width of border to WIDTH, in the X window system.\n\
748: Works only before the window has been mapped.")
749: (borderwidth)
750: register Lisp_Object borderwidth;
751: {
752: extern int WindowMapped;
753: extern int XXborder;
754: WindowInfo WinInfo;
755: extern Window XXwindow;
756: extern FontInfo *fontinfo;
757: extern Cursor EmacsCursor;
758: extern char iconidentity[];
759: register int (*func) ();
760: extern int CurHL;
761: Window tempwindow;
762: extern int pixelwidth, pixelheight;
763: register int temppixelwidth;
764: register int temppixelheight;
765: register int tempx;
766: register int tempy;
767: extern int XXxoffset, XXyoffset;
768: extern int XXpid;
769: Pixmap temp_brdr, temp_back;
770:
771: CHECK_NUMBER (borderwidth, 1);
772:
773: check_xterm ();
774:
775: if (XINT (borderwidth) < 0) XSETINT (borderwidth, 0);
776:
777: temppixelwidth = screen_width * fontinfo->width;
778: temppixelheight = screen_height * fontinfo->height;
779: func = signal (SIGIO, SIG_IGN);
780: XQueryWindow (XXwindow, &WinInfo);
781: tempx = WinInfo.x;
782: tempy = WinInfo.y;
783: if (strcmp (brdr_color, "gray") == 0)
784: temp_brdr = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits),
785: BlackPixel, WhitePixel);
786: else
787: temp_brdr = XMakeTile(brdr);
788: temp_back = XMakeTile(back);
789: tempwindow = XCreateWindow (RootWindow,
790: tempx /* Absolute horizontal offset */,
791: tempy /* Absolute Vertical offset */,
792: temppixelwidth, temppixelheight,
793: XINT (borderwidth),
794: temp_brdr, temp_back);
795: if (tempwindow)
796: {
797: XDestroyWindow (XXwindow);
798: XXwindow = tempwindow;
799: pixelwidth = temppixelwidth;
800: pixelheight = temppixelheight;
801: XXborder = XINT (borderwidth);
802: XSelectInput (XXwindow, NoEvent);
803: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height *5,
804: fontinfo->width, fontinfo->height);
805: XStoreName (XXwindow, &iconidentity[0]);
806: XDefineCursor (XXwindow, EmacsCursor);
807: XFreePixmap(temp_brdr);
808: XFreePixmap(temp_back);
809: (void)signal (SIGIO, func);
810: if (QLength () > 0)
811: {
812: kill (XXpid, SIGIO);
813: }
814: if (WindowMapped)
815: {
816: XMapWindow (XXwindow);
817: XSelectInput (XXwindow, KeyPressed | ExposeWindow |
818: ButtonPressed | ExposeRegion |
819: ExposeCopy);
820: ++screen_garbaged;
821: XFlush ();
822: }
823: return Qt;
824: }
825: else
826: {
827: (void) signal (SIGIO, func);
828: if (QLength () > 0)
829: {
830: kill (XXpid, SIGIO);
831: }
832: message ("Could not recreate window.");
833: return Qnil;
834: }
835: }
836:
837: jmp_buf dispenv;
838: Display *OldDisplay;
839: FontInfo *OldFontInfo;
840: Window OldWindow;
841:
842: XRestoreDisplay ()
843: {
844: longjmp (dispenv, "Unable to access display (probably)");
845: }
846:
847: DEFUN ("x-change-display", Fx_change_display, Sx_change_display, 1, 1,
848: "sNew display name: ",
849: "This function takes one argument, the display where you wish to\n\
850: continue your editing session. Your current window will be unmapped and\n\
851: the current display will be closed. The new X display will be opened and\n\
852: the rubber-band outline of the new window will appear on the new X display.\n\
853: This function does not look at your .Xdefaults file, so you should use the\n\
854: function x-new-display instead.")
855: (new_display)
856: register Lisp_Object new_display;
857: {
858: extern Cursor EmacsCursor;
859: Cursor OldEmacsCursor;
860: register int (*sigfunc) (), (*pipefunc) ();
861: register char *newdisplayname = 0;
862: extern char iconidentity[];
863: extern Display *XXdisplay;
864: extern Window XXwindow;
865: extern Window XXIconWindow;
866: extern int IconWindow;
867: extern Bitmap XXIconMask;
868: extern int pixelwidth, pixelheight, XXborder, CurHL;
869: extern FontInfo *fontinfo;
870: extern int bitblt, CursorExists, VisibleX, VisibleY;
871: extern WindowInfo rootwindowinfo;
872: extern char MouseCursor[], MouseMask[];
873: int old_fcntl_flags, old_fcntl_owner;
874: int x, y, width, height;
875: int temp_icon;
876: Pixmap temp_brdr, temp_back;
877: register char *XXerrorcode;
878: extern int XXxoffset, XXyoffset;
879:
880: CHECK_STRING (new_display, 1);
881: check_xterm ();
882:
883: /* newdisplayname = xmalloc (XSTRING (new_display)->size + 1); */
884: /* bcopy (XSTRING (new_display)->data, newdisplayname, */
885: /* XSTRING (new_display)->size + 1); */
886: /* Since this was freed at the end, why not just use the original? */
887: newdisplayname = (char *) XSTRING (new_display)->data;
888: sigfunc = signal (SIGIO, SIG_IGN);
889: XIOErrorHandler(XRestoreDisplay);
890: if (XXerrorcode = (char *) setjmp (dispenv))
891: {
892: /* free (&newdisplayname[0]); */
893: if (fontinfo)
894: XCloseFont (fontinfo);
895: if (XXwindow)
896: XDestroyWindow (XXwindow);
897: if (XXdisplay)
898: XCloseDisplay (XXdisplay);
899: XXdisplay = OldDisplay;
900: fontinfo = OldFontInfo;
901: XXwindow = OldWindow;
902: EmacsCursor = OldEmacsCursor;
903: XIOErrorHandler (0);
904: XSetDisplay (XXdisplay);
905: (void)signal (SIGIO, sigfunc);
906: if (QLength () > 0)
907: {
908: kill (XXpid, SIGIO);
909: }
910: error ("Display change problem: %s", XXerrorcode);
911: }
912: else
913: {
914: OldEmacsCursor = EmacsCursor;
915: OldDisplay = XXdisplay;
916: OldFontInfo = fontinfo;
917: OldWindow = XXwindow;
918: XXwindow = 0;
919: fontinfo = 0;
920: XXdisplay = 0;
921: }
922: XXdisplay = XOpenDisplay (newdisplayname);
923: if (!XXdisplay)
924: {
925: longjmp (dispenv, "Probably nonexistant display");
926: }
927: XQueryWindow (RootWindow, &rootwindowinfo);
928: fontinfo = XOpenFont (XXcurrentfont);
929: if (!fontinfo)
930: {
931: longjmp (dispenv, "Bad font");
932: }
933: /* pixelwidth and pixelheight are correct*/
934: XXwindow = XCreateWindow (RootWindow,
935: XXxoffset,
936: XXyoffset,
937: pixelwidth, pixelheight,
938: XXborder, BlackPixmap, WhitePixmap);
939: if (!XXwindow)
940: {
941: longjmp (dispenv, "Could not create window");
942: }
943: fore = BlackPixel;
944: back = WhitePixel;
945: brdr = BlackPixel;
946: mous = BlackPixel;
947: curs = BlackPixel;
948:
949: fore_color = "black";
950: back_color = "white";
951: brdr_color = "black";
952: mous_color = "black";
953: curs_color = "black";
954:
955: XSelectInput (XXwindow, NoEvent);
956: EmacsCursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
957: 0, 0, mous, back, GXcopy);
958: XDefineCursor (XXwindow, EmacsCursor);
959:
960: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height * 5,
961: fontinfo->width, fontinfo->height);
962: XStoreName (XXwindow, iconidentity);
963: /* WindowMapped = 0;*/
964: x_edges_specified = 0;
965: bitblt = 0;
966: CursorExists = 0;
967: VisibleX = 0;
968: VisibleY = 0;
969: XSetDisplay (XXdisplay);
970: /* XQueryWindow (RootWindow, &rootwindowinfo);*/
971: /* if (WindowMapped)
972: {*/
973: WindowMapped = 0;
974: XPopUpWindow ();
975: /* }*/
976: WindowMapped = 1;
977: XXIconWindow = XCreateWindow (RootWindow, 0, 0, sink_width, sink_height,
978: 2, WhitePixmap, BlackPixmap);
979: XXIconMask = XStoreBitmap(sink_mask_width, sink_mask_height, sink_mask_bits);
980: XSetDisplay (OldDisplay);
981: XCloseFont (OldFontInfo);
982: XFreeCursor (OldEmacsCursor);
983: XDestroyWindow (OldWindow);
984: XSetDisplay (XXdisplay);
985: XCloseDisplay (OldDisplay);
986: temp_icon = IconWindow;
987: XBitmapIcon;
988: XTextIcon;
989: if (temp_icon)
990: {
991: IconWindow = 0;
992: XBitmapIcon;
993: }
994: XErrorHandler (0);
995: dup2 (dpyno (), 0);
996: close (dpyno ());
997: dpyno () = 0; /* Looks a little strange? */
998: /* check the def of the */
999: /* macro, it is a genuine */
1000: /* lvalue */
1001: old_fcntl_flags = fcntl (0, F_GETFL, 0);
1002: fcntl (0, F_SETFL, old_fcntl_flags | FASYNC);
1003: old_fcntl_owner = fcntl (0, F_GETOWN, 0);
1004: fcntl (0, F_SETOWN, getpid ());
1005: (void)signal (SIGIO, sigfunc);
1006: if (QLength () > 0)
1007: {
1008: kill (XXpid, SIGIO);
1009: }
1010: /* free (newdisplayname); */
1011: /* x_edges_specified = 0;*/
1012: ++screen_garbaged;
1013: Fredraw_display();
1014: return Qt;
1015: }
1016:
1017: /*
1018: Grabs mouse, outlines a window, etc.
1019: if left button pressed, sizes a wd x hd window (in characters)
1020: if right button pressed, sizes wd x what will fit window (in characters)
1021: if middle button pressed, allows user to size window in font increments
1022: (+ border * 2 for inner border);
1023: While sizing, dimensions of window are displayed in upper left of root.
1024: str is also displayed there.
1025: In all cases, x and y are the desired coordinates for the upper lefthand
1026: corner, *width = width desired, *height = height desired
1027: (min for both is 1 font char).
1028:
1029: */
1030: /*
1031: This routine is a total crock. It makes a window using XCreateTerm
1032: purely for return value, destroying the temporary window created in
1033: the process. If XCreateTerm were broken into smaller, more easily
1034: digestible pieces, it would be useful. As such, the constraints of
1035: time, emacs, and X conventions force me into this crock. --rlk
1036: */
1037:
1038: window_fetch(font, x, y, width, height, geo, deflt, border, str)
1039: Font font;
1040: int *x, *y, *width, *height;
1041: char *geo, *deflt;
1042: int border;
1043: char *str;
1044: {
1045: extern int WindowMapped;
1046: extern int XXborder;
1047: extern Window XXwindow;
1048: extern FontInfo *fontinfo;
1049: extern Cursor EmacsCursor;
1050: OpaqueFrame frame;
1051: extern char iconidentity[];
1052: register int (*func) ();
1053: Window tempwindow;
1054: WindowInfo WinInfo;
1055: extern int pixelwidth, pixelheight;
1056: register int temppixelwidth;
1057: register int temppixelheight;
1058: extern int XXxoffset, XXyoffset;
1059: extern int XXpid;
1060: Pixmap temp_brdr, temp_back;
1061:
1062: func = signal (SIGIO, SIG_IGN);
1063: temp_brdr = XMakeTile(brdr);
1064: temp_back = XMakeTile(back);
1065: frame.bdrwidth = border;
1066: frame.border = XMakeTile (brdr);
1067: frame.background = XMakeTile (back);
1068: tempwindow = XCreateTerm(str, "emacs", geo, deflt, &frame, 10, 5, 0, 0,
1069: width, height, fontinfo, fontinfo->width,
1070: fontinfo->height);
1071: if (tempwindow)
1072: {
1073: XDestroyWindow (XXwindow);
1074: XXwindow = tempwindow;
1075: XSelectInput (XXwindow, NoEvent);
1076: XSetResizeHint (XXwindow, fontinfo->width * 10, fontinfo->height *5,
1077: fontinfo->width, fontinfo->height);
1078: XStoreName (XXwindow, &iconidentity[0]);
1079: XDefineCursor (XXwindow, EmacsCursor);
1080: XQueryWindow (XXwindow, &WinInfo);
1081: *x = WinInfo.x;
1082: *y = WinInfo.y;
1083: XFreePixmap(temp_brdr);
1084: XFreePixmap(temp_back);
1085: (void)signal (SIGIO, func);
1086: if (QLength () > 0)
1087: {
1088: kill (XXpid, SIGIO);
1089: }
1090: if (WindowMapped)
1091: {
1092: XMapWindow (XXwindow);
1093: XSelectInput (XXwindow, KeyPressed | ExposeWindow |
1094: ButtonPressed | ExposeRegion |
1095: ExposeCopy);
1096: ++screen_garbaged;
1097: XFlush ();
1098: }
1099: return Qt;
1100: }
1101: else
1102: {
1103: (void) signal (SIGIO, func);
1104: if (QLength () > 0)
1105: {
1106: kill (XXpid, SIGIO);
1107: }
1108: message ("Could not recreate window.");
1109: return Qnil;
1110: }
1111: }
1112:
1113: setxterm ()
1114: {
1115: Vxterm = Qt;
1116: }
1117:
1118: XRedrawDisplay()
1119: {
1120: Fredraw_display();
1121: }
1122:
1123: XAutoSave()
1124: {
1125: Fdo_auto_save();
1126: }
1127:
1128:
1129: syms_of_xfns ()
1130: {
1131: x_edges_specified = 0;
1132:
1133: DefLispVar("xterm", &Vxterm,
1134: "True if using xterm, nil otherwise.");
1135: Vxterm = Qnil;
1136: DefLispVar("x-mouse-pos", &Vx_mouse_pos,
1137: "Current x-y position of mouse by row, column as specified by font.");
1138: Vx_mouse_pos = Qnil;
1139:
1140: defsubr (&Sx_pop_up_window);
1141: defsubr (&Sx_set_bell);
1142: defsubr (&Sx_flip_color);
1143: defsubr (&Sx_set_icon);
1144: defsubr (&Sx_set_font);
1145: defsubr (&Sx_set_window_edges);
1146: defsubr (&Scoordinates_in_window_p);
1147: defsubr (&Sx_mouse_events);
1148: defsubr (&Sx_proc_mouse_event);
1149: defsubr (&Sx_get_mouse_event);
1150: defsubr (&Sx_set_keyboard_enable);
1151: defsubr (&Sx_set_mouse_inform_flag);
1152: defsubr (&Sx_store_cut_buffer);
1153: defsubr (&Sx_get_cut_buffer);
1154: defsubr (&Sx_rubber_band);
1155: defsubr (&Sx_create_x_window);
1156: defsubr (&Sx_set_border_width);
1157: defsubr (&Sx_change_display);
1158: defsubr (&Sx_set_foreground_color);
1159: defsubr (&Sx_set_background_color);
1160: defsubr (&Sx_set_border_color);
1161: defsubr (&Sx_set_cursor_color);
1162: defsubr (&Sx_set_mouse_color);
1163: defsubr (&Sx_get_foreground_color);
1164: defsubr (&Sx_get_background_color);
1165: defsubr (&Sx_get_border_color);
1166: defsubr (&Sx_get_cursor_color);
1167: defsubr (&Sx_get_mouse_color);
1168: defsubr (&Sx_color_p);
1169: defsubr (&Sx_get_default);
1170: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.