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