Return to sunfns.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

Annotation of 43BSDReno/contrib/emacs-18.55/src/sunfns.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.