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