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