(Info-unescape-quotes, Info-split-parameter-string)
[emacs.git] / src / sunfns.c
blob13fdfd3a1b7aada70fd6410932ffb7b41e24b16b
1 /* Functions for Sun Windows menus and selection buffer.
2 Copyright (C) 1987, 1999, 2001 Free Software Foundation, Inc.
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.
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.
14 This file is part of GNU Emacs.
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
18 the Free Software Foundation; either version 2, or (at your option)
19 any later version.
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.
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, Inc., 59 Temple Place - Suite 330,
29 Boston, MA 02111-1307, USA. */
31 /* Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
32 Original ideas by David Kastan and Eric Negaard, SRI International
33 Major help from: Steve Greenbaum, Reasoning Systems, Inc.
34 <froud@kestrel.arpa>
35 who first discovered the Menu_Base_Kludge.
39 * Emacs Lisp-Callable functions for sunwindows
41 #include <config.h>
43 #include <stdio.h>
44 #include <errno.h>
45 #include <signal.h>
46 #include <sunwindow/window_hs.h>
47 #include <suntool/selection.h>
48 #include <suntool/menu.h>
49 #include <suntool/walkmenu.h>
50 #include <suntool/frame.h>
51 #include <suntool/window.h>
53 #include <fcntl.h>
54 #undef NULL /* We don't need sunview's idea of NULL */
55 #include "lisp.h"
56 #include "window.h"
57 #include "buffer.h"
58 #include "termhooks.h"
60 /* conversion to/from character & frame coordinates */
61 /* From Gosling Emacs SunWindow driver by Chris Torek */
63 /* Chars to frame coords. Note that we speak in zero origin. */
64 #define CtoSX(cx) ((cx) * Sun_Font_Xsize)
65 #define CtoSY(cy) ((cy) * Sun_Font_Ysize)
67 /* Frame coords to chars */
68 #define StoCX(sx) ((sx) / Sun_Font_Xsize)
69 #define StoCY(sy) ((sy) / Sun_Font_Ysize)
71 #define CHECK_GFX(x) if((win_fd<0)&&(Fsun_window_init(),(win_fd<0)))return(x)
72 int win_fd = -1;
73 struct pixfont *Sun_Font; /* The font */
74 int Sun_Font_Xsize; /* Width of font */
75 int Sun_Font_Ysize; /* Height of font */
77 #define Menu_Base_Kludge /* until menu_show_using_fd gets fixed */
78 #ifdef Menu_Base_Kludge
79 static Frame Menu_Base_Frame;
80 static int Menu_Base_fd;
81 static Lisp_Object sm_kludge_string;
82 #endif
83 struct cursor CurrentCursor; /* The current cursor */
85 static short CursorData[16]; /* Build cursor here */
86 static mpr_static(CursorMpr, 16, 16, 1, CursorData);
87 static struct cursor NewCursor = {0, 0, PIX_SRC ^ PIX_DST, &CursorMpr};
89 #define RIGHT_ARROW_CURSOR /* if you want the right arrow */
90 #ifdef RIGHT_ARROW_CURSOR
91 /* The default right-arrow cursor, with XOR drawing. */
92 static short ArrowCursorData[16] = {
93 0x0001,0x0003,0x0007,0x000F,0x001F,0x003F,0x007F,0x000F,
94 0x001B,0x0019,0x0030,0x0030,0x0060,0x0060,0x00C0,0x00C0};
95 static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
96 struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
98 #else
99 /* The default left-arrow cursor, with XOR drawing. */
100 static short ArrowCursorData[16] = {
101 0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000,
102 0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300};
103 static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
104 struct cursor DefaultCursor = {0, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
105 #endif
108 * Initialize window
110 DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0,
111 doc: /* One time setup for using Sun Windows with mouse.
112 Unless optional argument FORCE is non-nil, is a noop after its first call.
113 Returns a number representing the file descriptor of the open Sun Window,
114 or -1 if can not open it. */)
115 (force)
116 Lisp_Object force;
118 char *cp;
119 static int already_initialized = 0;
121 if ((! already_initialized) || (!NILP(force))) {
122 cp = getenv("WINDOW_GFX");
123 if (cp != 0) win_fd = emacs_open (cp, O_RDWR, 0);
124 if (win_fd > 0)
126 Sun_Font = pf_default();
127 Sun_Font_Xsize = Sun_Font->pf_defaultsize.x;
128 Sun_Font_Ysize = Sun_Font->pf_defaultsize.y;
129 Fsun_change_cursor_icon (Qnil); /* set up the default cursor */
130 already_initialized = 1;
131 #ifdef Menu_Base_Kludge
133 /* Make a frame to use for putting the menu on, and get its fd. */
134 Menu_Base_Frame = window_create(0, FRAME,
135 WIN_X, 0, WIN_Y, 0,
136 WIN_ROWS, 1, WIN_COLUMNS, 1,
137 WIN_SHOW, FALSE,
138 FRAME_NO_CONFIRM, 1,
140 Menu_Base_fd = (int) window_get(Menu_Base_Frame, WIN_FD);
141 #endif
144 return(make_number(win_fd));
148 * Mouse sit-for (allows a shorter interval than the regular sit-for
149 * and can be interrupted by the mouse)
151 DEFUN ("sit-for-millisecs", Fsit_for_millisecs, Ssit_for_millisecs, 1, 1, 0,
152 doc: /* Like sit-for, but ARG is milliseconds.
153 Perform redisplay, then wait for ARG milliseconds or until
154 input is available. Returns t if wait completed with no input.
155 Redisplay does not happen if input is available before it starts. */)
157 Lisp_Object n;
159 struct timeval Timeout;
160 int waitmask = 1;
162 CHECK_NUMBER (n);
163 Timeout.tv_sec = XINT(n) / 1000;
164 Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000;
166 if (detect_input_pending()) return(Qnil);
167 redisplay_preserve_echo_area (16);
169 * Check for queued keyboard input/mouse hits again
170 * (A bit screen update can take some time!)
172 if (detect_input_pending()) return(Qnil);
173 select(1,&waitmask,0,0,&Timeout);
174 if (detect_input_pending()) return(Qnil);
175 return(Qt);
179 * Sun sleep-for (allows a shorter interval than the regular sleep-for)
181 DEFUN ("sleep-for-millisecs",
182 Fsleep_for_millisecs,
183 Ssleep_for_millisecs, 1, 1, 0,
184 doc: /* Pause, without updating display, for ARG milliseconds. */)
186 Lisp_Object n;
188 unsigned useconds;
190 CHECK_NUMBER (n);
191 useconds = XINT(n) * 1000;
192 usleep(useconds);
193 return(Qt);
196 DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
197 doc: /* Perform redisplay. */)
200 redisplay_preserve_echo_area (17);
201 return(Qt);
206 * Change the Sun mouse icon
208 DEFUN ("sun-change-cursor-icon",
209 Fsun_change_cursor_icon,
210 Ssun_change_cursor_icon, 1, 1, 0,
211 doc: /* Change the Sun mouse cursor icon.
212 ICON is a lisp vector whose 1st element
213 is the X offset of the cursor hot-point, whose 2nd element is the Y offset
214 of the cursor hot-point and whose 3rd element is the cursor pixel data
215 expressed as a string. If ICON is nil then the original arrow cursor is used. */)
216 (Icon)
217 Lisp_Object Icon;
219 register unsigned char *cp;
220 register short *p;
221 register int i;
222 Lisp_Object X_Hot, Y_Hot, Data;
224 CHECK_GFX (Qnil);
226 * If the icon is null, we just restore the DefaultCursor
228 if (NILP(Icon))
229 CurrentCursor = DefaultCursor;
230 else {
232 * extract the data from the vector
234 CHECK_VECTOR (Icon);
235 if (XVECTOR(Icon)->size < 3) return(Qnil);
236 X_Hot = XVECTOR(Icon)->contents[0];
237 Y_Hot = XVECTOR(Icon)->contents[1];
238 Data = XVECTOR(Icon)->contents[2];
240 CHECK_NUMBER (X_Hot);
241 CHECK_NUMBER (Y_Hot);
242 CHECK_STRING (Data);
243 if (SCHARS (Data) != 32) return(Qnil);
245 * Setup the new cursor
247 NewCursor.cur_xhot = X_Hot;
248 NewCursor.cur_yhot = Y_Hot;
249 cp = SDATA (Data);
250 p = CursorData;
251 i = 16;
252 while(--i >= 0)
253 *p++ = (cp[0] << 8) | cp[1], cp += 2;
254 CurrentCursor = NewCursor;
256 win_setcursor(win_fd, &CurrentCursor);
257 return(Qt);
261 * Interface for sunwindows selection
263 static Lisp_Object Current_Selection;
265 static
266 sel_write (sel, file)
267 struct selection *sel;
268 FILE *file;
270 fwrite (SDATA (Current_Selection), sizeof (char),
271 sel->sel_items, file);
274 static
275 sel_clear (sel, windowfd)
276 struct selection *sel;
277 int windowfd;
281 static
282 sel_read (sel, file)
283 struct selection *sel;
284 FILE *file;
286 register int i, n;
287 register char *cp;
289 Current_Selection = make_string ("", 0);
290 if (sel->sel_items <= 0)
291 return (0);
292 cp = (char *) malloc(sel->sel_items);
293 if (cp == (char *)0) {
294 error("malloc failed in sel_read");
295 return(-1);
297 n = fread(cp, sizeof(char), sel->sel_items, file);
298 if (n > sel->sel_items) {
299 error("fread botch in sel_read");
300 return(-1);
301 } else if (n < 0) {
302 error("Error reading selection");
303 return(-1);
306 * The shelltool select saves newlines as carriage returns,
307 * but emacs wants newlines.
309 for (i = 0; i < n; i++)
310 if (cp[i] == '\r') cp[i] = '\n';
312 Current_Selection = make_string (cp, n);
313 free (cp);
314 return (0);
318 * Set the window system "selection" to be the arg STRING
320 DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1,
321 "sSet selection to: ",
322 doc: /* Set the current sunwindow selection to STRING. */)
323 (str)
324 Lisp_Object str;
326 struct selection selection;
328 CHECK_STRING (str);
329 Current_Selection = str;
331 CHECK_GFX (Qnil);
332 selection.sel_type = SELTYPE_CHAR;
333 selection.sel_items = SCHARS (str);
334 selection.sel_itembytes = 1;
335 selection.sel_pubflags = 1;
336 selection_set(&selection, sel_write, sel_clear, win_fd);
337 return (Qt);
340 * Stuff the current window system selection into the current buffer
342 DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0,
343 doc: /* Return the current sunwindows selection as a string. */)
346 CHECK_GFX (Current_Selection);
347 selection_get (sel_read, win_fd);
348 return (Current_Selection);
351 Menu sun_menu_create();
353 Menu_item
354 sun_item_create (Pair)
355 Lisp_Object Pair;
357 /* In here, we depend on Lisp supplying zero terminated strings in the data*/
358 /* so we can just pass the pointers, and not recopy anything */
360 Menu_item menu_item;
361 Menu submenu;
362 Lisp_Object String;
363 Lisp_Object Value;
365 if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair);
366 String = Fcar(Pair);
367 CHECK_STRING(String);
368 Value = Fcdr(Pair);
369 if (SYMBOLP (Value))
370 Value = SYMBOL_VALUE (Value);
371 if (VECTORP (Value)) {
372 submenu = sun_menu_create (Value);
373 menu_item = menu_create_item
374 (MENU_RELEASE, MENU_PULLRIGHT_ITEM, SDATA (String), submenu, 0);
375 } else {
376 menu_item = menu_create_item
377 (MENU_RELEASE, MENU_STRING_ITEM, SDATA (String), Value, 0);
379 return menu_item;
382 Menu
383 sun_menu_create (Vector)
384 Lisp_Object Vector;
386 Menu menu;
387 int i;
388 CHECK_VECTOR(Vector);
389 menu=menu_create(0);
390 for(i = 0; i < XVECTOR(Vector)->size; i++) {
391 menu_set (menu, MENU_APPEND_ITEM,
392 sun_item_create(XVECTOR(Vector)->contents[i]), 0);
394 return menu;
398 * If the first item of the menu has nil as its value, then make the
399 * item look like a label by inverting it and making it unselectable.
400 * Returns 1 if the label was made, 0 otherwise.
403 make_menu_label (menu)
404 Menu menu;
406 int made_label_p = 0;
408 if (( menu_get(menu, MENU_NITEMS) > 0 ) && /* At least one item */
409 ((Lisp_Object) menu_get(menu_get(menu, MENU_NTH_ITEM, 1),
410 MENU_VALUE) == Qnil )) {
411 menu_set(menu_get(menu, MENU_NTH_ITEM, 1),
412 MENU_INVERT, TRUE,
413 MENU_FEEDBACK, FALSE,
415 made_label_p = 1;
417 return made_label_p;
421 * Do a pop-up menu and return the selected value
423 DEFUN ("sun-menu-internal",
424 Fsun_menu_internal,
425 Ssun_menu_internal, 5, 5, 0,
426 doc: /* Set up a SunView pop-up menu and return the user's choice.
427 Arguments WINDOW, X, Y, BUTTON, and MENU.
428 *** User code should generally use sun-menu-evaluate ***
430 Arguments WINDOW, X, Y, BUTTON, and MENU.
431 Put MENU up in WINDOW at position X, Y.
432 The BUTTON argument specifies the button to be released that selects an item:
433 1 = LEFT BUTTON
434 2 = MIDDLE BUTTON
435 4 = RIGHT BUTTON
436 The MENU argument is a vector containing (STRING . VALUE) pairs.
437 The VALUE of the selected item is returned.
438 If the VALUE of the first pair is nil, then the first STRING will be used
439 as a menu label. */)
440 (window, X_Position, Y_Position, Button, MEnu)
441 Lisp_Object window, X_Position, Y_Position, Button, MEnu;
443 Menu menu;
444 int button, xpos, ypos;
445 Event event0;
446 Event *event = &event0;
447 Lisp_Object Value, Pair;
449 CHECK_NUMBER(X_Position);
450 CHECK_NUMBER(Y_Position);
451 CHECK_LIVE_WINDOW(window);
452 CHECK_NUMBER(Button);
453 CHECK_VECTOR(MEnu);
455 CHECK_GFX (Qnil);
457 xpos = CtoSX (WINDOW_LEFT_EDGE_COL (XWINDOW (window))
458 + WINDOW_LEFT_SCROLL_BAR_COLS (XWINDOW (window))
459 + XINT(X_Position));
460 ypos = CtoSY (WINDOW_TOP_EDGE_LINE (XWINDOW(window)) + XINT(Y_Position));
461 #ifdef Menu_Base_Kludge
462 {static Lisp_Object symbol[2];
463 symbol[0] = Fintern (sm_kludge_string, Qnil);
464 Pair = Ffuncall (1, symbol);
465 xpos += XINT (XCDR (Pair));
466 ypos += XINT (XCAR (Pair));
468 #endif
470 button = XINT(Button);
471 if(button == 4) button = 3;
472 event_set_id (event, BUT(button));
473 event_set_down (event);
474 event_set_x (event, xpos);
475 event_set_y (event, ypos);
477 menu = sun_menu_create(MEnu);
478 make_menu_label(menu);
480 #ifdef Menu_Base_Kludge
481 Value = (Lisp_Object) menu_show(menu, Menu_Base_Frame, event, 0);
482 #else
483 /* This confuses the notifier or something: */
484 Value = (Lisp_Object) menu_show_using_fd(menu, win_fd, event, 0);
486 * Right button gets lost, and event sequencing or delivery gets mixed up
487 * So, until that gets fixed, we use this <Menu_Base_Frame> kludge:
489 #endif
490 menu_destroy (menu);
492 return ((int)Value ? Value : Qnil);
497 * Define everything
499 syms_of_sunfns()
501 #ifdef Menu_Base_Kludge
502 /* i'm just too lazy to re-write this into C code */
503 /* so we will call this elisp function from C */
504 sm_kludge_string = make_pure_string ("sm::menu-kludge", 15, 15, 0);
505 #endif /* Menu_Base_Kludge */
507 defsubr(&Ssun_window_init);
508 defsubr(&Ssit_for_millisecs);
509 defsubr(&Ssleep_for_millisecs);
510 defsubr(&Supdate_display);
511 defsubr(&Ssun_change_cursor_icon);
512 defsubr(&Ssun_set_selection);
513 defsubr(&Ssun_get_selection);
514 defsubr(&Ssun_menu_internal);
517 /* arch-tag: 2d7decb7-58f6-41aa-b45b-077ccfab7158
518 (do not change this comment) */