|
|
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.