![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sunfns.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to sunfns.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Functions for Sun Windows menus and selection buffer.
2: Copyright (C) 1987 Free Software Foundation, Inc.
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.
11:
12: Everyone is granted permission to copy, modify and redistribute
13: GNU Emacs, but only under the conditions described in the
14: document "GNU Emacs copying permission notice". An exact copy
15: of the document is supposed to have been given to you along with
16: GNU Emacs so that you can know how you may redistribute it all.
17: It should be in a file named COPYING. Among other things, the
18: copyright notice and this notice must be preserved on all copies.
19:
20: Author: Jeff Peck, Sun Microsystems, Inc. <[email protected]>
21: Original ideas by David Kastan and Eric Negaard, SRI International
22: Major help from: Steve Greenbaum, Reasoning Systems, Inc.
23: <[email protected]>
24: who first discovered the Menu_Base_Kludge.
25: */
26:
27: /*
28: * Emacs Lisp-Callable functions for sunwindows
29: */
30: #include "config.h"
31:
32: #include <stdio.h>
33: #include <errno.h>
34: #include <signal.h>
35: #include <sunwindow/window_hs.h>
36: #include <suntool/selection.h>
37: #include <suntool/menu.h>
38: #include <suntool/walkmenu.h>
39: #include <suntool/frame.h>
40: #include <suntool/window.h>
41:
42: #include <fcntl.h>
43: #undef NULL /* We don't need sunview's idea of NULL */
44: #include "lisp.h"
45: #include "window.h"
46: #include "buffer.h"
47: #include "termhooks.h"
48:
49: /* conversion to/from character & screen coordinates */
50: /* From Gosling Emacs SunWindow driver by Chris Torek */
51:
52: /* Chars to screen coords. Note that we speak in zero origin. */
53: #define CtoSX(cx) ((cx) * Sun_Font_Xsize)
54: #define CtoSY(cy) ((cy) * Sun_Font_Ysize)
55:
56: /* Screen coords to chars */
57: #define StoCX(sx) ((sx) / Sun_Font_Xsize)
58: #define StoCY(sy) ((sy) / Sun_Font_Ysize)
59:
60: #define CHECK_GFX(x) if((win_fd<0)&&(Fsun_window_init(),(win_fd<0)))return(x)
61: int win_fd = -1;
62: struct pixfont *Sun_Font; /* The font */
63: int Sun_Font_Xsize; /* Width of font */
64: int Sun_Font_Ysize; /* Height of font */
65:
66: #define Menu_Base_Kludge /* until menu_show_using_fd gets fixed */
67: #ifdef Menu_Base_Kludge
68: static Frame Menu_Base_Frame;
69: static int Menu_Base_fd;
70: static Lisp_Object sm_kludge_string;
71: #endif
72: struct cursor CurrentCursor; /* The current cursor */
73:
74: static short CursorData[16]; /* Build cursor here */
75: static mpr_static(CursorMpr, 16, 16, 1, CursorData);
76: static struct cursor NewCursor = {0, 0, PIX_SRC ^ PIX_DST, &CursorMpr};
77:
78: #define RIGHT_ARROW_CURSOR /* if you want the right arrow */
79: #ifdef RIGHT_ARROW_CURSOR
80: /* The default right-arrow cursor, with XOR drawing. */
81: static short ArrowCursorData[16] = {
82: 0x0001,0x0003,0x0007,0x000F,0x001F,0x003F,0x007F,0x000F,
83: 0x001B,0x0019,0x0030,0x0030,0x0060,0x0060,0x00C0,0x00C0};
84: static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
85: struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
86:
87: #else
88: /* The default left-arror cursor, with XOR drawing. */
89: static short ArrowCursorData[16] = {
90: 0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000,
91: 0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300};
92: static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
93: struct cursor DefaultCursor = {0, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
94: #endif
95:
96: /*
97: * Initialize window
98: */
99: DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0,
100: "One time setup for using Sun Windows with mouse.\n\
101: Unless optional argument FORCE is non-nil, is a noop after its first call.\n\
102: Returns a number representing the file descriptor of the open Sun Window,\n\
103: or -1 if can not open it.")
104: (force)
105: Lisp_Object force;
106: {
107: char *cp;
108: static int already_initialized = 0;
109:
110: if ((! already_initialized) || (!NULL(force))) {
111: cp = getenv("WINDOW_GFX");
112: if (cp != 0) win_fd = open(cp, 2);
113: if (win_fd > 0)
114: {
115: Sun_Font = pf_default();
116: Sun_Font_Xsize = Sun_Font->pf_defaultsize.x;
117: Sun_Font_Ysize = Sun_Font->pf_defaultsize.y;
118: Fsun_change_cursor_icon (Qnil); /* set up the default cursor */
119: already_initialized = 1;
120: #ifdef Menu_Base_Kludge
121:
122: /* Make a frame to use for putting the menu on, and get its fd. */
123: Menu_Base_Frame = window_create(0, FRAME,
124: WIN_X, 0, WIN_Y, 0,
125: WIN_ROWS, 1, WIN_COLUMNS, 1,
126: WIN_SHOW, FALSE,
127: FRAME_NO_CONFIRM, 1,
128: 0);
129: Menu_Base_fd = (int) window_get(Menu_Base_Frame, WIN_FD);
130: #endif
131: }
132: }
133: return(make_number(win_fd));
134: }
135:
136: /*
137: * Mouse sit-for (allows a shorter interval than the regular sit-for
138: * and can be interrupted by the mouse)
139: */
140: DEFUN ("sit-for-millisecs", Fsit_for_millisecs, Ssit_for_millisecs, 1, 1, 0,
141: "Like sit-for, but ARG is milliseconds. \n\
142: Perform redisplay, then wait for ARG milliseconds or until\n\
143: input is available. Returns t if wait completed with no input.\n\
144: Redisplay does not happen if input is available before it starts.")
145: (n)
146: Lisp_Object n;
147: {
148: struct timeval Timeout;
149: int waitmask = 1;
150:
151: CHECK_NUMBER (n, 0);
152: Timeout.tv_sec = XINT(n) / 1000;
153: Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000;
154:
155: if (detect_input_pending()) return(Qnil);
156: DoDsp(1);
157: /*
158: * Check for queued keyboard input/mouse hits again
159: * (A bit screen update can take some time!)
160: */
161: if (detect_input_pending()) return(Qnil);
162: select(1,&waitmask,0,0,&Timeout);
163: if (detect_input_pending()) return(Qnil);
164: return(Qt);
165: }
166:
167: /*
168: * Sun sleep-for (allows a shorter interval than the regular sleep-for)
169: */
170: DEFUN ("sleep-for-millisecs",
171: Fsleep_for_millisecs,
172: Ssleep_for_millisecs, 1, 1, 0,
173: "Pause, without updating display, for ARG milliseconds.")
174: (n)
175: Lisp_Object n;
176: {
177: unsigned useconds;
178:
179: CHECK_NUMBER (n, 0);
180: useconds = XINT(n) * 1000;
181: usleep(useconds);
182: return(Qt);
183: }
184:
185: DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
186: "Perform redisplay.")
187: ()
188: {
189: DoDsp(1);
190: return(Qt);
191: }
192:
193:
194: /*
195: * Change the Sun mouse icon
196: */
197: DEFUN ("sun-change-cursor-icon",
198: Fsun_change_cursor_icon,
199: Ssun_change_cursor_icon, 1, 1, 0,
200: "Change the Sun mouse cursor icon. ICON is a lisp vector whose 1st element\n\
201: is the X offset of the cursor hot-point, whose 2nd element is the Y offset\n\
202: of the cursor hot-point and whose 3rd element is the cursor pixel data\n\
203: expressed as a string. If ICON is nil then the original arrow cursor is used")
204: (Icon)
205: Lisp_Object Icon;
206: {
207: register unsigned char *cp;
208: register short *p;
209: register int i;
210: Lisp_Object X_Hot, Y_Hot, Data;
211:
212: CHECK_GFX (Qnil);
213: /*
214: * If the icon is null, we just restore the DefaultCursor
215: */
216: if (NULL(Icon))
217: CurrentCursor = DefaultCursor;
218: else {
219: /*
220: * extract the data from the vector
221: */
222: CHECK_VECTOR (Icon, 0);
223: if (XVECTOR(Icon)->size < 3) return(Qnil);
224: X_Hot = XVECTOR(Icon)->contents[0];
225: Y_Hot = XVECTOR(Icon)->contents[1];
226: Data = XVECTOR(Icon)->contents[2];
227:
228: CHECK_NUMBER (X_Hot, 0);
229: CHECK_NUMBER (Y_Hot, 0);
230: CHECK_STRING (Data, 0);
231: if (XSTRING(Data)->size != 32) return(Qnil);
232: /*
233: * Setup the new cursor
234: */
235: NewCursor.cur_xhot = X_Hot;
236: NewCursor.cur_yhot = Y_Hot;
237: cp = XSTRING(Data)->data;
238: p = CursorData;
239: i = 16;
240: while(--i >= 0)
241: *p++ = (cp[0] << 8) | cp[1], cp += 2;
242: CurrentCursor = NewCursor;
243: }
244: win_setcursor(win_fd, &CurrentCursor);
245: return(Qt);
246: }
247:
248: /*
249: * Interface for sunwindows selection
250: */
251: static Lisp_Object Current_Selection;
252:
253: static
254: sel_write (sel, file)
255: struct selection *sel;
256: FILE *file;
257: {
258: fwrite (XSTRING (Current_Selection)->data, sizeof (char),
259: sel->sel_items, file);
260: }
261:
262: static
263: sel_clear (sel, windowfd)
264: struct selection *sel;
265: int windowfd;
266: {
267: }
268:
269: static
270: sel_read (sel, file)
271: struct selection *sel;
272: FILE *file;
273: {
274: register int i, n;
275: register char *cp;
276:
277: Current_Selection = make_string ("", 0);
278: if (sel->sel_items <= 0)
279: return (0);
280: cp = (char *) malloc(sel->sel_items);
281: if (cp == (char *)0) {
282: error("malloc failed in sel_read");
283: return(-1);
284: }
285: n = fread(cp, sizeof(char), sel->sel_items, file);
286: if (n > sel->sel_items) {
287: error("fread botch in sel_read");
288: return(-1);
289: } else if (n < 0) {
290: error("Error reading selection.");
291: return(-1);
292: }
293: /*
294: * The shelltool select saves newlines as carrige returns,
295: * but emacs wants newlines.
296: */
297: for (i = 0; i < n; i++)
298: if (cp[i] == '\r') cp[i] = '\n';
299:
300: Current_Selection = make_string (cp, n);
301: free (cp);
302: return (0);
303: }
304:
305: /*
306: * Set the window system "selection" to be the arg STRING
307: */
308: DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1,
309: "sSet selection to: ",
310: "Set the current sunwindow selection to STRING.")
311: (str)
312: Lisp_Object str;
313: {
314: struct selection selection;
315:
316: CHECK_STRING (str, 0);
317: Current_Selection = str;
318:
319: CHECK_GFX (Qnil);
320: selection.sel_type = SELTYPE_CHAR;
321: selection.sel_items = XSTRING (str)->size;
322: selection.sel_itembytes = 1;
323: selection.sel_pubflags = 1;
324: selection_set(&selection, sel_write, sel_clear, win_fd);
325: return (Qt);
326: }
327: /*
328: * Stuff the current window system selection into the current buffer
329: */
330: DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0,
331: "Return the current sunwindows selection as a string.")
332: ()
333: {
334: CHECK_GFX (Current_Selection);
335: selection_get (sel_read, win_fd);
336: return (Current_Selection);
337: }
338:
339: Menu sun_menu_create();
340:
341: Menu_item
342: sun_item_create (Pair)
343: Lisp_Object Pair;
344: {
345: /* In here, we depend on Lisp supplying zero terminated strings in the data*/
346: /* so we can just pass the pointers, and not recopy anything */
347:
348: Menu_item menu_item;
349: Menu submenu;
350: Lisp_Object String;
351: Lisp_Object Value;
352:
353: if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair);
354: String = Fcar(Pair);
355: CHECK_STRING(String, 0);
356: Value = Fcdr(Pair);
357: if(XTYPE(Value) == Lisp_Symbol)
358: Value = XSYMBOL(Value)->value;
359: if(XTYPE(Value) == Lisp_Vector) {
360: submenu = sun_menu_create (Value);
361: menu_item = menu_create_item
362: (MENU_RELEASE, MENU_PULLRIGHT_ITEM, XSTRING(String)->data, submenu, 0);
363: } else {
364: menu_item = menu_create_item
365: (MENU_RELEASE, MENU_STRING_ITEM, XSTRING(String)->data, Value, 0);
366: }
367: return menu_item;
368: }
369:
370: Menu
371: sun_menu_create (Vector)
372: Lisp_Object Vector;
373: {
374: Menu menu;
375: int i;
376: CHECK_VECTOR(Vector,0);
377: menu=menu_create(0);
378: for(i = 0; i < XVECTOR(Vector)->size; i++) {
379: menu_set (menu, MENU_APPEND_ITEM,
380: sun_item_create(XVECTOR(Vector)->contents[i]), 0);
381: }
382: return menu;
383: }
384:
385: /*
386: * If the first item of the menu has nil as its value, then make the
387: * item look like a label by inverting it and making it unselectable.
388: * Returns 1 if the label was made, 0 otherwise.
389: */
390: int
391: make_menu_label (menu)
392: Menu menu;
393: {
394: int made_label_p = 0;
395:
396: if (( menu_get(menu, MENU_NITEMS) > 0 ) && /* At least one item */
397: ((Lisp_Object) menu_get(menu_get(menu, MENU_NTH_ITEM, 1),
398: MENU_VALUE) == Qnil )) {
399: menu_set(menu_get(menu, MENU_NTH_ITEM, 1),
400: MENU_INVERT, TRUE,
401: MENU_FEEDBACK, FALSE,
402: 0);
403: made_label_p = 1;
404: }
405: return made_label_p;
406: }
407:
408: /*
409: * Do a pop-up menu and return the selected value
410: */
411: DEFUN ("sun-menu-internal",
412: Fsun_menu_internal,
413: Ssun_menu_internal, 5, 5, 0,
414: "Set up a SunView pop-up menu and return the user's choice.\n\
415: Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
416: *** User code should generally use sun-menu-evaluate ***\n\
417: \n\
418: Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
419: Put MENU up in WINDOW at position X, Y.\n\
420: The BUTTON argument specifies the button to be released that selects an item:\n\
421: 1 = LEFT BUTTON\n\
422: 2 = MIDDLE BUTTON\n\
423: 4 = RIGHT BUTTON\n\
424: The MENU argument is a vector containing (STRING . VALUE) pairs.\n\
425: The VALUE of the selected item is returned.\n\
426: If the VALUE of the first pair is nil, then the first STRING will be used\n\
427: as a menu label.")
428: (window, X_Position, Y_Position, Button, MEnu)
429: Lisp_Object window, X_Position, Y_Position, Button, MEnu;
430: {
431: Menu menu;
432: int button, xpos, ypos;
433: Event event0;
434: Event *event = &event0;
435: Lisp_Object Value, Pair;
436:
437: CHECK_NUMBER(X_Position, 0);
438: CHECK_NUMBER(Y_Position, 1);
439: CHECK_WINDOW(window, 2);
440: CHECK_NUMBER(Button, 3);
441: CHECK_VECTOR(MEnu, 4);
442:
443: CHECK_GFX (Qnil);
444:
445: xpos = CtoSX (XWINDOW(window)->left + XINT(X_Position));
446: ypos = CtoSY (XWINDOW(window)->top + XINT(Y_Position));
447: #ifdef Menu_Base_Kludge
448: {static Lisp_Object symbol[2];
449: symbol[0] = Fintern (sm_kludge_string, Qnil);
450: Pair = Ffuncall (1, symbol);
451: xpos += XINT (XCONS (Pair)->cdr);
452: ypos += XINT (XCONS (Pair)->car);
453: }
454: #endif
455:
456: button = XINT(Button);
457: if(button == 4) button = 3;
458: event_set_id (event, BUT(button));
459: event_set_down (event);
460: event_set_x (event, xpos);
461: event_set_y (event, ypos);
462:
463: menu = sun_menu_create(MEnu);
464: make_menu_label(menu);
465:
466: #ifdef Menu_Base_Kludge
467: Value = (Lisp_Object) menu_show(menu, Menu_Base_Frame, event, 0);
468: #else
469: /* This confuses the notifier or something: */
470: Value = (Lisp_Object) menu_show_using_fd(menu, win_fd, event, 0);
471: /*
472: * Right button gets lost, and event sequencing or delivery gets mixed up
473: * So, until that gets fixed, we use this <Menu_Base_Frame> kludge:
474: */
475: #endif
476: menu_destroy (menu);
477:
478: return ((int)Value ? Value : Qnil);
479: }
480:
481:
482: /*
483: * Define everything
484: */
485: syms_of_sunfns()
486: {
487: #ifdef Menu_Base_Kludge
488: /* i'm just too lazy to re-write this into C code */
489: /* so we will call this elisp function from C */
490: sm_kludge_string = make_pure_string ("sm::menu-kludge", 15);
491: #endif /* Menu_Base_Kludge */
492:
493: defsubr(&Ssun_window_init);
494: defsubr(&Ssit_for_millisecs);
495: defsubr(&Ssleep_for_millisecs);
496: defsubr(&Supdate_display);
497: defsubr(&Ssun_change_cursor_icon);
498: defsubr(&Ssun_set_selection);
499: defsubr(&Ssun_get_selection);
500: defsubr(&Ssun_menu_internal);
501: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.