/* Functions for Sun Windows menus and selection buffer.
- Copyright (C) 1987 Free Software Foundation, Inc.
+ Copyright (C) 1987, 1999, 2001 Free Software Foundation, Inc.
+
+This file is probably totally obsolete. In any case, the FSF is
+unwilling to support it. We agreed to include it in our distribution
+only on the understanding that we would spend no time at all on it.
+
+If you have complaints about this file, send them to peck@sun.com.
+If no one at Sun wants to maintain this, then consider it not
+maintained at all. It would be a bad thing for the GNU project if
+this file took our effort away from higher-priority things.
+
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
-Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
+
/* Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
Original ideas by David Kastan and Eric Negaard, SRI International
Major help from: Steve Greenbaum, Reasoning Systems, Inc.
<froud@kestrel.arpa>
/*
* Emacs Lisp-Callable functions for sunwindows
*/
-#include "config.h"
+#include <config.h>
#include <stdio.h>
#include <errno.h>
#include "buffer.h"
#include "termhooks.h"
-/* conversion to/from character & screen coordinates */
+/* conversion to/from character & frame coordinates */
/* From Gosling Emacs SunWindow driver by Chris Torek */
-/* Chars to screen coords. Note that we speak in zero origin. */
+/* Chars to frame coords. Note that we speak in zero origin. */
#define CtoSX(cx) ((cx) * Sun_Font_Xsize)
#define CtoSY(cy) ((cy) * Sun_Font_Ysize)
-/* Screen coords to chars */
+/* Frame coords to chars */
#define StoCX(sx) ((sx) / Sun_Font_Xsize)
#define StoCY(sy) ((sy) / Sun_Font_Ysize)
struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
#else
-/* The default left-arror cursor, with XOR drawing. */
+/* The default left-arrow cursor, with XOR drawing. */
static short ArrowCursorData[16] = {
0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000,
0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300};
* Initialize window
*/
DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0,
- "One time setup for using Sun Windows with mouse.\n\
-Unless optional argument FORCE is non-nil, is a noop after its first call.\n\
-Returns a number representing the file descriptor of the open Sun Window,\n\
-or -1 if can not open it.")
- (force)
- Lisp_Object force;
+ doc: /* One time setup for using Sun Windows with mouse.
+Unless optional argument FORCE is non-nil, is a noop after its first call.
+Returns a number representing the file descriptor of the open Sun Window,
+or -1 if can not open it. */)
+ (force)
+ Lisp_Object force;
{
char *cp;
static int already_initialized = 0;
if ((! already_initialized) || (!NILP(force))) {
cp = getenv("WINDOW_GFX");
- if (cp != 0) win_fd = open(cp, 2);
+ if (cp != 0) win_fd = emacs_open (cp, O_RDWR, 0);
if (win_fd > 0)
{
Sun_Font = pf_default();
* and can be interrupted by the mouse)
*/
DEFUN ("sit-for-millisecs", Fsit_for_millisecs, Ssit_for_millisecs, 1, 1, 0,
- "Like sit-for, but ARG is milliseconds. \n\
-Perform redisplay, then wait for ARG milliseconds or until\n\
-input is available. Returns t if wait completed with no input.\n\
-Redisplay does not happen if input is available before it starts.")
- (n)
- Lisp_Object n;
+ doc: /* Like sit-for, but ARG is milliseconds.
+Perform redisplay, then wait for ARG milliseconds or until
+input is available. Returns t if wait completed with no input.
+Redisplay does not happen if input is available before it starts. */)
+ (n)
+ Lisp_Object n;
{
struct timeval Timeout;
int waitmask = 1;
-
- CHECK_NUMBER (n, 0);
+
+ CHECK_NUMBER (n);
Timeout.tv_sec = XINT(n) / 1000;
Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000;
if (detect_input_pending()) return(Qnil);
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (16);
/*
* Check for queued keyboard input/mouse hits again
* (A bit screen update can take some time!)
/*
* Sun sleep-for (allows a shorter interval than the regular sleep-for)
*/
-DEFUN ("sleep-for-millisecs",
- Fsleep_for_millisecs,
- Ssleep_for_millisecs, 1, 1, 0,
- "Pause, without updating display, for ARG milliseconds.")
- (n)
- Lisp_Object n;
+DEFUN ("sleep-for-millisecs",
+ Fsleep_for_millisecs,
+ Ssleep_for_millisecs, 1, 1, 0,
+ doc: /* Pause, without updating display, for ARG milliseconds. */)
+ (n)
+ Lisp_Object n;
{
unsigned useconds;
- CHECK_NUMBER (n, 0);
+ CHECK_NUMBER (n);
useconds = XINT(n) * 1000;
usleep(useconds);
return(Qt);
}
DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
- "Perform redisplay.")
+ doc: /* Perform redisplay. */)
()
{
- redisplay_preserve_echo_area ();
+ redisplay_preserve_echo_area (17);
return(Qt);
}
* Change the Sun mouse icon
*/
DEFUN ("sun-change-cursor-icon",
- Fsun_change_cursor_icon,
- Ssun_change_cursor_icon, 1, 1, 0,
- "Change the Sun mouse cursor icon. ICON is a lisp vector whose 1st element\n\
-is the X offset of the cursor hot-point, whose 2nd element is the Y offset\n\
-of the cursor hot-point and whose 3rd element is the cursor pixel data\n\
-expressed as a string. If ICON is nil then the original arrow cursor is used")
+ Fsun_change_cursor_icon,
+ Ssun_change_cursor_icon, 1, 1, 0,
+ doc: /* Change the Sun mouse cursor icon.
+ICON is a lisp vector whose 1st element
+is the X offset of the cursor hot-point, whose 2nd element is the Y offset
+of the cursor hot-point and whose 3rd element is the cursor pixel data
+expressed as a string. If ICON is nil then the original arrow cursor is used. */)
(Icon)
Lisp_Object Icon;
{
register short *p;
register int i;
Lisp_Object X_Hot, Y_Hot, Data;
-
+
CHECK_GFX (Qnil);
/*
* If the icon is null, we just restore the DefaultCursor
*/
- if (NILP(Icon))
+ if (NILP(Icon))
CurrentCursor = DefaultCursor;
else {
/*
* extract the data from the vector
*/
- CHECK_VECTOR (Icon, 0);
+ CHECK_VECTOR (Icon);
if (XVECTOR(Icon)->size < 3) return(Qnil);
X_Hot = XVECTOR(Icon)->contents[0];
Y_Hot = XVECTOR(Icon)->contents[1];
Data = XVECTOR(Icon)->contents[2];
-
- CHECK_NUMBER (X_Hot, 0);
- CHECK_NUMBER (Y_Hot, 0);
- CHECK_STRING (Data, 0);
- if (XSTRING(Data)->size != 32) return(Qnil);
+
+ CHECK_NUMBER (X_Hot);
+ CHECK_NUMBER (Y_Hot);
+ CHECK_STRING (Data);
+ if (SCHARS (Data) != 32) return(Qnil);
/*
* Setup the new cursor
*/
NewCursor.cur_xhot = X_Hot;
NewCursor.cur_yhot = Y_Hot;
- cp = XSTRING(Data)->data;
+ cp = SDATA (Data);
p = CursorData;
i = 16;
while(--i >= 0)
struct selection *sel;
FILE *file;
{
- fwrite (XSTRING (Current_Selection)->data, sizeof (char),
+ fwrite (SDATA (Current_Selection), sizeof (char),
sel->sel_items, file);
}
{
register int i, n;
register char *cp;
-
+
Current_Selection = make_string ("", 0);
if (sel->sel_items <= 0)
return (0);
error("fread botch in sel_read");
return(-1);
} else if (n < 0) {
- error("Error reading selection.");
+ error("Error reading selection");
return(-1);
}
/*
- * The shelltool select saves newlines as carrige returns,
+ * The shelltool select saves newlines as carriage returns,
* but emacs wants newlines.
*/
- for (i = 0; i < n; i++)
+ for (i = 0; i < n; i++)
if (cp[i] == '\r') cp[i] = '\n';
Current_Selection = make_string (cp, n);
*/
DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1,
"sSet selection to: ",
- "Set the current sunwindow selection to STRING.")
+ doc: /* Set the current sunwindow selection to STRING. */)
(str)
Lisp_Object str;
{
struct selection selection;
- CHECK_STRING (str, 0);
+ CHECK_STRING (str);
Current_Selection = str;
CHECK_GFX (Qnil);
selection.sel_type = SELTYPE_CHAR;
- selection.sel_items = XSTRING (str)->size;
+ selection.sel_items = SCHARS (str);
selection.sel_itembytes = 1;
selection.sel_pubflags = 1;
selection_set(&selection, sel_write, sel_clear, win_fd);
* Stuff the current window system selection into the current buffer
*/
DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0,
- "Return the current sunwindows selection as a string.")
+ doc: /* Return the current sunwindows selection as a string. */)
()
{
CHECK_GFX (Current_Selection);
if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair);
String = Fcar(Pair);
- CHECK_STRING(String, 0);
+ CHECK_STRING(String);
Value = Fcdr(Pair);
- if(XTYPE(Value) == Lisp_Symbol)
- Value = XSYMBOL(Value)->value;
- if(XTYPE(Value) == Lisp_Vector) {
+ if (SYMBOLP (Value))
+ Value = SYMBOL_VALUE (Value);
+ if (VECTORP (Value)) {
submenu = sun_menu_create (Value);
menu_item = menu_create_item
- (MENU_RELEASE, MENU_PULLRIGHT_ITEM, XSTRING(String)->data, submenu, 0);
+ (MENU_RELEASE, MENU_PULLRIGHT_ITEM, SDATA (String), submenu, 0);
} else {
menu_item = menu_create_item
- (MENU_RELEASE, MENU_STRING_ITEM, XSTRING(String)->data, Value, 0);
+ (MENU_RELEASE, MENU_STRING_ITEM, SDATA (String), Value, 0);
}
return menu_item;
}
-Menu
+Menu
sun_menu_create (Vector)
Lisp_Object Vector;
{
Menu menu;
int i;
- CHECK_VECTOR(Vector,0);
- menu=menu_create(0);
+ CHECK_VECTOR(Vector);
+ menu=menu_create(0);
for(i = 0; i < XVECTOR(Vector)->size; i++) {
- menu_set (menu, MENU_APPEND_ITEM,
+ menu_set (menu, MENU_APPEND_ITEM,
sun_item_create(XVECTOR(Vector)->contents[i]), 0);
}
return menu;
DEFUN ("sun-menu-internal",
Fsun_menu_internal,
Ssun_menu_internal, 5, 5, 0,
- "Set up a SunView pop-up menu and return the user's choice.\n\
-Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
-*** User code should generally use sun-menu-evaluate ***\n\
-\n\
-Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
-Put MENU up in WINDOW at position X, Y.\n\
-The BUTTON argument specifies the button to be released that selects an item:\n\
- 1 = LEFT BUTTON\n\
- 2 = MIDDLE BUTTON\n\
- 4 = RIGHT BUTTON\n\
-The MENU argument is a vector containing (STRING . VALUE) pairs.\n\
-The VALUE of the selected item is returned.\n\
-If the VALUE of the first pair is nil, then the first STRING will be used\n\
-as a menu label.")
- (window, X_Position, Y_Position, Button, MEnu)
- Lisp_Object window, X_Position, Y_Position, Button, MEnu;
+ doc: /* Set up a SunView pop-up menu and return the user's choice.
+Arguments WINDOW, X, Y, BUTTON, and MENU.
+*** User code should generally use sun-menu-evaluate ***
+
+Arguments WINDOW, X, Y, BUTTON, and MENU.
+Put MENU up in WINDOW at position X, Y.
+The BUTTON argument specifies the button to be released that selects an item:
+ 1 = LEFT BUTTON
+ 2 = MIDDLE BUTTON
+ 4 = RIGHT BUTTON
+The MENU argument is a vector containing (STRING . VALUE) pairs.
+The VALUE of the selected item is returned.
+If the VALUE of the first pair is nil, then the first STRING will be used
+as a menu label. */)
+ (window, X_Position, Y_Position, Button, MEnu)
+ Lisp_Object window, X_Position, Y_Position, Button, MEnu;
{
Menu menu;
int button, xpos, ypos;
Event event0;
Event *event = &event0;
Lisp_Object Value, Pair;
-
- CHECK_NUMBER(X_Position, 0);
- CHECK_NUMBER(Y_Position, 1);
- CHECK_WINDOW(window, 2);
- CHECK_NUMBER(Button, 3);
- CHECK_VECTOR(MEnu, 4);
+
+ CHECK_NUMBER(X_Position);
+ CHECK_NUMBER(Y_Position);
+ CHECK_LIVE_WINDOW(window);
+ CHECK_NUMBER(Button);
+ CHECK_VECTOR(MEnu);
CHECK_GFX (Qnil);
- xpos = CtoSX (XWINDOW(window)->left + XINT(X_Position));
- ypos = CtoSY (XWINDOW(window)->top + XINT(Y_Position));
+ xpos = CtoSX (WINDOW_LEFT_EDGE_COL (XWINDOW (window))
+ + WINDOW_LEFT_SCROLL_BAR_COLS (XWINDOW (window))
+ + XINT(X_Position));
+ ypos = CtoSY (WINDOW_TOP_EDGE_LINE (XWINDOW(window)) + XINT(Y_Position));
#ifdef Menu_Base_Kludge
{static Lisp_Object symbol[2];
symbol[0] = Fintern (sm_kludge_string, Qnil);
Pair = Ffuncall (1, symbol);
- xpos += XINT (XCONS (Pair)->cdr);
- ypos += XINT (XCONS (Pair)->car);
+ xpos += XINT (XCDR (Pair));
+ ypos += XINT (XCAR (Pair));
}
#endif
#ifdef Menu_Base_Kludge
/* i'm just too lazy to re-write this into C code */
/* so we will call this elisp function from C */
- sm_kludge_string = make_pure_string ("sm::menu-kludge", 15);
+ sm_kludge_string = make_pure_string ("sm::menu-kludge", 15, 15, 0);
#endif /* Menu_Base_Kludge */
defsubr(&Ssun_window_init);
defsubr(&Ssun_get_selection);
defsubr(&Ssun_menu_internal);
}
+
+/* arch-tag: 2d7decb7-58f6-41aa-b45b-077ccfab7158
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff