/* Functions for the NeXT/Open/GNUstep and MacOSX window system.
- Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008
+ Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008, 2009, 2010
Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
*/
+/* This should be the first include, as it may set up #defines affecting
+ interpretation of even the system includes. */
+#include <config.h>
+
#include <signal.h>
#include <math.h>
-#include "config.h"
+#include <setjmp.h>
+
#include "lisp.h"
#include "blockinput.h"
#include "nsterm.h"
#include "keyboard.h"
#include "termhooks.h"
#include "fontset.h"
-
#include "character.h"
#include "font.h"
extern Lisp_Object Qunderline, Qundefined;
extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
+extern Lisp_Object Qnone;
+extern Lisp_Object Vframe_title_format;
+
+/* The below are defined in frame.c. */
+
+extern Lisp_Object Vmenu_bar_mode, Vtool_bar_mode;
-Lisp_Object Qnone;
-Lisp_Object Qns_frame_parameter;
Lisp_Object Qbuffered;
Lisp_Object Qfontsize;
/* Alist of elements (REGEXP . IMAGE) for images of icons associated
to frames.*/
-Lisp_Object Vns_icon_type_alist;
+static Lisp_Object Vns_icon_type_alist;
+
+/* Toolkit version support. */
+static Lisp_Object Vns_version_string;
EmacsTooltip *ns_tooltip;
/* Need forward declaration here to preserve organizational integrity of file */
-Lisp_Object Fns_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
+Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
extern BOOL ns_in_resize;
/* Nonzero if we can use mouse menus. */
int
-have_menus_p ()
+have_menus_p (void)
{
return NSApp != nil;
}
struct frame *f = SELECTED_FRAME ();
if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
return FRAME_NS_DISPLAY_INFO (f);
- else if (ns_display_list != 0)
- return ns_display_list;
+ else if (x_display_list != 0)
+ return x_display_list;
else
error ("Nextstep windows are not in use or not initialized");
}
static NSScreen *
-ns_get_screen (Lisp_Object anythingUnderTheSun)
+ns_get_screen (Lisp_Object screen)
{
- id window =nil;
- NSScreen *screen = 0;
-
+ struct frame *f;
struct terminal *terminal;
- struct ns_display_info *dpyinfo;
- struct frame *f = NULL;
- Lisp_Object frame;
-
- if (INTEGERP (anythingUnderTheSun)) {
- /* we got a terminal */
- terminal = get_terminal (anythingUnderTheSun, 1);
- dpyinfo = terminal->display_info.ns;
- f = dpyinfo->ns_focus_frame;
- if (!f)
- f = dpyinfo->ns_highlight_frame;
-
- } else if (FRAMEP (anythingUnderTheSun) &&
- FRAME_NS_P (XFRAME (anythingUnderTheSun))) {
- /* we got a frame */
- f = XFRAME (anythingUnderTheSun);
-
- } else if (STRINGP (anythingUnderTheSun)) { /* FIXME/cl for multi-display */
- }
- if (!f)
+ if (EQ (Qt, screen)) /* not documented */
+ return [NSScreen mainScreen];
+
+ terminal = get_terminal (screen, 1);
+ if (terminal->type != output_ns)
+ return NULL;
+
+ if (NILP (screen))
f = SELECTED_FRAME ();
- if (f)
+ else if (FRAMEP (screen))
+ f = XFRAME (screen);
+ else
{
- XSETFRAME (frame, f);
- window = ns_get_window (frame);
+ struct ns_display_info *dpyinfo = terminal->display_info.ns;
+ f = dpyinfo->x_focus_frame
+ ? dpyinfo->x_focus_frame : dpyinfo->x_highlight_frame;
}
- if (window)
- screen = [window screen];
- if (!screen)
- screen = [NSScreen mainScreen];
-
- return screen;
+ return ((f && FRAME_NS_P (f)) ? [[FRAME_NS_VIEW (f) window] screen]
+ : NULL);
}
/* Return the X display structure for the display named NAME.
Open a new connection if necessary. */
struct ns_display_info *
-ns_display_info_for_name (name)
- Lisp_Object name;
+ns_display_info_for_name (Lisp_Object name)
{
Lisp_Object names;
struct ns_display_info *dpyinfo;
CHECK_STRING (name);
- for (dpyinfo = ns_display_list, names = ns_display_name_list;
+ for (dpyinfo = x_display_list, names = ns_display_name_list;
dpyinfo;
dpyinfo = dpyinfo->next, names = XCDR (names))
{
error ("Emacs for OpenStep does not yet support multi-display.");
- Fns_open_connection (name, Qnil, Qnil);
- dpyinfo = ns_display_list;
+ Fx_open_connection (name, Qnil, Qnil);
+ dpyinfo = x_display_list;
if (dpyinfo == 0)
error ("OpenStep on %s not responding.\n", SDATA (name));
-------------------------------------------------------------------------- */
{
int i, count;
- id<NSMenuItem> item;
+ NSMenuItem *item;
const char *name;
Lisp_Object nameStr;
unsigned short key;
static void
-ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
NSColor *col;
static void
-ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
struct face *face;
NSColor *col;
[[view window] setBackgroundColor: col];
alpha = [col alphaComponent];
-#ifdef NS_IMPL_COCOA
- /* the alpha code below only works on 10.4, so we need to do something
- else (albeit less good) otherwise.
- Check NSApplication.h for useful NSAppKitVersionNumber values. */
- if (NSAppKitVersionNumber < 744.0)
- [[view window] setAlphaValue: alpha];
-#endif
-
if (alpha != 1.0)
[[view window] setOpaque: NO];
else
static void
-ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
NSColor *col;
error ("Unknown color");
}
- [f->output_data.ns->desired_cursor_color release];
- f->output_data.ns->desired_cursor_color = [col retain];
+ [FRAME_CURSOR_COLOR (f) release];
+ FRAME_CURSOR_COLOR (f) = [col retain];
if (FRAME_VISIBLE_P (f))
{
static void
-ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
NSView *view = FRAME_NS_VIEW (f);
- NSTRACE (ns_set_icon_name);
+ NSTRACE (x_set_icon_name);
if (ns_in_resize)
return;
name = f->icon_name;
if (NILP (name))
- name = build_string
- ([[[NSProcessInfo processInfo] processName] UTF8String]);
+ name = build_string([ns_app_name UTF8String]);
else
CHECK_STRING (name);
static void
ns_set_name (struct frame *f, Lisp_Object name, int explicit)
{
- NSView *view = FRAME_NS_VIEW (f);
+ NSView *view;
NSTRACE (ns_set_name);
if (ns_in_resize)
return;
if (NILP (name))
- name = build_string
- ([[[NSProcessInfo processInfo] processName] UTF8String]);
+ name = build_string([ns_app_name UTF8String]);
f->name = name;
CHECK_STRING (name);
+ view = FRAME_NS_VIEW (f);
+
/* Don't change the name if it's already NAME. */
if ([[[view window] title]
isEqualToString: [NSString stringWithUTF8String:
specified a name for the frame; the name will override any set by the
redisplay code. */
static void
-ns_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
+x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
{
- NSTRACE (ns_explicitly_set_name);
+ NSTRACE (x_explicitly_set_name);
ns_set_name_iconic (f, arg, 1);
ns_set_name (f, arg, 1);
}
NSTRACE (x_implicitly_set_name);
if (FRAME_ICONIFIED_P (f))
ns_set_name_iconic (f, arg, 0);
+ else if (FRAME_NS_P (f) && EQ (Vframe_title_format, Qt))
+ ns_set_name_as_filename (f);
else
ns_set_name (f, arg, 0);
}
suggesting a new name, which lisp code should override; if
F->explicit_name is set, ignore the new name; otherwise, set it. */
static void
-ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
+x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
{
- NSTRACE (ns_set_title);
+ NSTRACE (x_set_title);
/* Don't change the title if it's already NAME. */
if (EQ (name, f->title))
return;
void
ns_set_name_as_filename (struct frame *f)
{
- NSView *view = FRAME_NS_VIEW (f);
+ NSView *view;
Lisp_Object name;
Lisp_Object buf = XWINDOW (f->selected_window)->buffer;
const char *title;
BLOCK_INPUT;
pool = [[NSAutoreleasePool alloc] init];
- name =XBUFFER (buf)->filename;
+ name = XBUFFER (buf)->filename;
if (NILP (name) || FRAME_ICONIFIED_P (f)) name =XBUFFER (buf)->name;
if (FRAME_ICONIFIED_P (f) && !NILP (f->icon_name))
name = f->icon_name;
if (NILP (name))
- name = build_string
- ([[[NSProcessInfo processInfo] processName] UTF8String]);
+ name = build_string ([ns_app_name UTF8String]);
else
CHECK_STRING (name);
+ view = FRAME_NS_VIEW (f);
+
title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
: [[[view window] title] UTF8String];
void
-ns_set_doc_edited (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+ns_set_doc_edited (struct frame *f, Lisp_Object arg)
{
NSView *view = FRAME_NS_VIEW (f);
NSAutoreleasePool *pool;
- BLOCK_INPUT;
- pool = [[NSAutoreleasePool alloc] init];
- [[view window] setDocumentEdited: !NILP (arg)];
- [pool release];
- UNBLOCK_INPUT;
+ if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
+ {
+ BLOCK_INPUT;
+ pool = [[NSAutoreleasePool alloc] init];
+ [[view window] setDocumentEdited: !NILP (arg)];
+ [pool release];
+ UNBLOCK_INPUT;
+ }
}
-static void
-ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
+void
+x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
int olines = FRAME_MENU_BAR_LINES (f);
if (nlines)
{
FRAME_EXTERNAL_MENU_BAR (f) = 1;
-/* does for all frames, whereas we just want for one frame
- [NSMenu setMenuBarVisible: YES]; */
+ /* does for all frames, whereas we just want for one frame
+ [NSMenu setMenuBarVisible: YES]; */
}
else
{
if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
free_frame_menubar (f);
-/* [NSMenu setMenuBarVisible: NO]; */
+ /* [NSMenu setMenuBarVisible: NO]; */
FRAME_EXTERNAL_MENU_BAR (f) = 0;
}
}
-/* 23: XXX: there is an erroneous direct call in window.c to this fn */
+/* toolbar support */
void
-x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
-{
- ns_set_menu_bar_lines (f, value, oldval);
-}
-
-
-/* 23: toolbar support */
-static void
-ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
+x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
int nlines;
Lisp_Object root_window;
}
-/* 23: XXX: there is an erroneous direct call in window.c to this fn */
-void
-x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
-{
- ns_set_tool_bar_lines (f, value, oldval);
-}
-
-
void
ns_implicitly_set_icon_type (struct frame *f)
{
static void
-ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
EmacsView *view = FRAME_NS_VIEW (f);
id image = nil;
BOOL setMini = YES;
- NSTRACE (ns_set_icon_type);
+ NSTRACE (x_set_icon_type);
if (!NILP (arg) && SYMBOLP (arg))
{
}
-/* 23: added Xism; we stub out (we do implement this in ns-win.el) */
+/* Xism; we stub out (we do implement this in ns-win.el) */
int
XParseGeometry (char *string, int *x, int *y,
unsigned int *width, unsigned int *height)
else if (XTYPE (arg) == Lisp_Symbol)
str = SDATA (SYMBOL_NAME (arg));
else return -1;
- if (!strcmp (str, "box")) return filled_box;
- if (!strcmp (str, "hollow")) return hollow_box;
- if (!strcmp (str, "underscore")) return underscore;
- if (!strcmp (str, "bar")) return bar;
- if (!strcmp (str, "no")) return no_highlight;
+ if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
+ if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
+ if (!strcmp (str, "hbar")) return HBAR_CURSOR;
+ if (!strcmp (str, "bar")) return BAR_CURSOR;
+ if (!strcmp (str, "no")) return NO_CURSOR;
return -1;
}
{
switch (arg)
{
- case filled_box: return Qbox;
- case hollow_box: return intern ("hollow");
- case underscore: return intern ("underscore");
- case bar: return intern ("bar");
- case no_highlight:
- default: return intern ("no");
+ case FILLED_BOX_CURSOR: return Qbox;
+ case HOLLOW_BOX_CURSOR: return intern ("hollow");
+ case HBAR_CURSOR: return intern ("hbar");
+ case BAR_CURSOR: return intern ("bar");
+ case NO_CURSOR:
+ default: return intern ("no");
}
}
+/* This is the same as the xfns.c definition. */
+void
+x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
+{
+ set_frame_cursor_types (f, arg);
+ /* Make sure the cursor gets redrawn. */
+ cursor_type_changed = 1;
+}
+\f
+
+/* called to set mouse pointer color, but all other terms use it to
+ initialize pointer types (and don't set the color ;) */
static void
-ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
- int val;
+ /* don't think we can do this on Nextstep */
+}
- val = ns_lisp_to_cursor_type (arg);
- if (val >= 0)
- {
- f->output_data.ns->desired_cursor =val;
- }
- else
- {
- store_frame_param (f, Qcursor_type, oldval);
- error ("the `cursor-type' frame parameter should be either `no', `box', \
-`hollow', `underscore' or `bar'.");
- }
- update_mode_lines++;
+#define Str(x) #x
+#define Xstr(x) Str(x)
+
+static Lisp_Object
+ns_appkit_version_str (void)
+{
+ char tmp[80];
+
+#ifdef NS_IMPL_GNUSTEP
+ sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
+#elif defined(NS_IMPL_COCOA)
+ sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
+#else
+ tmp = "ns-unknown";
+#endif
+ return build_string (tmp);
}
-/* 23: called to set mouse pointer color, but all other terms use it to
- initialize pointer types (and don't set the color ;) */
-static void
-ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+/* This is for use by x-server-version and collapses all version info we
+ have into a single int. For a better picture of the implementation
+ running, use ns_appkit_version_str.*/
+static int
+ns_appkit_version_int (void)
{
- /* don't think we can do this on Nextstep */
+#ifdef NS_IMPL_GNUSTEP
+ return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
+#elif defined(NS_IMPL_COCOA)
+ return (int)NSAppKitVersionNumber;
+#endif
+ return 0;
}
static void
-ns_icon (struct frame *f, Lisp_Object parms)
+x_icon (struct frame *f, Lisp_Object parms)
/* --------------------------------------------------------------------------
Strangely-named function to set icon position parameters in frame.
This is irrelevant under OS X, but might be needed under GNUstep,
}
-/* 23 Note: commented out ns_... entries are no longer used in 23.
- commented out x_... entries have not been implemented yet.
- see frame.c for template, also where all generic OK functions are impl */
+/* Note: see frame.c for template, also where generic functions are impl */
frame_parm_handler ns_frame_parm_handlers[] =
{
x_set_autoraise, /* generic OK */
x_set_autolower, /* generic OK */
- ns_set_background_color,
+ x_set_background_color,
0, /* x_set_border_color, may be impossible under Nextstep */
0, /* x_set_border_width, may be impossible under Nextstep */
- ns_set_cursor_color,
- ns_set_cursor_type,
+ x_set_cursor_color,
+ x_set_cursor_type,
x_set_font, /* generic OK */
- ns_set_foreground_color,
- ns_set_icon_name,
- ns_set_icon_type,
+ x_set_foreground_color,
+ x_set_icon_name,
+ x_set_icon_type,
x_set_internal_border_width, /* generic OK */
- ns_set_menu_bar_lines,
- ns_set_mouse_color,
- ns_explicitly_set_name,
+ x_set_menu_bar_lines,
+ x_set_mouse_color,
+ x_explicitly_set_name,
x_set_scroll_bar_width, /* generic OK */
- ns_set_title,
+ x_set_title,
x_set_unsplittable, /* generic OK */
x_set_vertical_scroll_bars, /* generic OK */
x_set_visibility, /* generic OK */
- ns_set_tool_bar_lines,
+ x_set_tool_bar_lines,
0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
x_set_screen_gamma, /* generic OK */
x_set_fringe_width, /* generic OK */
0, /* x_set_wait_for_wm, will ignore */
0, /* x_set_fullscreen will ignore */
- x_set_font_backend /* generic OK */
+ x_set_font_backend, /* generic OK */
+ x_set_alpha,
+ 0, /* x_set_sticky */
+ 0, /* x_set_tool_bar_position */
};
-DEFUN ("x-create-frame", Fns_create_frame, Sns_create_frame,
+
+/* ==========================================================================
+
+ Lisp definitions
+
+ ========================================================================== */
+
+DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
- "Make a new Nextstep window, called a \"frame\" in Emacs terms.
+ doc: /* Make a new Nextstep window, called a \"frame\" in Emacs terms.
Return an Emacs frame object.
PARMS is an alist of frame parameters.
If the parameters specify that the frame should not have a minibuffer,
and do not specify a specific minibuffer window to use,
then `default-minibuffer-frame' must be a frame whose minibuffer can
-be shared by the new frame.")
- (parms)
- Lisp_Object parms;
+be shared by the new frame. */)
+ (Lisp_Object parms)
{
static int desc_ctr = 1;
struct frame *f;
check_ns ();
+ /* Seems a little strange, but other terms do it. Perhaps the code below
+ is modifying something? */
+ parms = Fcopy_alist (parms);
+
display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
if (EQ (display, Qunbound))
display = Qnil;
if (STRINGP (name))
Vx_resource_name = name;
+ else
+ Vx_resource_name = Vinvocation_name;
parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
if (EQ (parent, Qunbound))
be set. */
if (EQ (name, Qunbound) || NILP (name) || (XTYPE (name) != Lisp_String))
{
- f->name
- = build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
+ f->name = build_string ([ns_app_name UTF8String]);
f->explicit_name =0;
}
else
f->output_method = output_ns;
f->output_data.ns = (struct ns_output *)xmalloc (sizeof *(f->output_data.ns));
- bzero (f->output_data.ns, sizeof (*(f->output_data.ns)));
+ memset (f->output_data.ns, 0, sizeof (*(f->output_data.ns)));
FRAME_FONTSET (f) = -1;
f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
RES_TYPE_STRING);
- if (EQ (f->icon_name, Qunbound) || (XTYPE (f->icon_name) != Lisp_String))
+ if (! STRINGP (f->icon_name))
f->icon_name = Qnil;
FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
init_frame_faces (f);
- x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0), "menuBar",
- "menuBar", RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qtool_bar_lines, make_number (0), "toolBar",
- "toolBar", RES_TYPE_NUMBER);
+ /* The X resources controlling the menu-bar and tool-bar are
+ processed specially at startup, and reflected in the mode
+ variables; ignore them here. */
+ x_default_parameter (f, parms, Qmenu_bar_lines,
+ NILP (Vmenu_bar_mode)
+ ? make_number (0) : make_number (1),
+ NULL, NULL, RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qtool_bar_lines,
+ NILP (Vtool_bar_mode)
+ ? make_number (0) : make_number (1),
+ NULL, NULL, RES_TYPE_NUMBER);
+
x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
"BufferPredicate", RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
[[EmacsView alloc] initFrameFromEmacs: f];
- ns_icon (f, parms);
+ x_icon (f, parms);
/* It is now ok to make the frame official even if we get an error below.
The frame needs to be on Vframe_list or making it visible won't work. */
Vframe_list = Fcons (frame, Vframe_list);
/*FRAME_NS_DISPLAY_INFO (f)->reference_count++; */
- x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
- RES_TYPE_SYMBOL);
- x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
- "ScrollBarWidth", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon",
RES_TYPE_SYMBOL);
- x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaise",
+ x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaiseLower",
RES_TYPE_BOOLEAN);
x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoLower",
RES_TYPE_BOOLEAN);
- x_default_parameter (f, parms, Qbuffered, Qt, "buffered", "Buffered",
- RES_TYPE_BOOLEAN);
+ x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
+ RES_TYPE_SYMBOL);
+ x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
+ "ScrollBarWidth", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha",
+ RES_TYPE_NUMBER);
width = FRAME_COLS (f);
height = FRAME_LINES (f);
if (! f->output_data.ns->explicit_parent)
{
- tem = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_BOOLEAN);
- if (EQ (tem, Qunbound))
- tem = Qnil;
-
- x_set_visibility (f, tem, Qnil);
- if (EQ (tem, Qt))
- [[FRAME_NS_VIEW (f) window] makeKeyWindow];
+ tem = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
+ if (EQ (tem, Qunbound))
+ tem = Qt;
+ x_set_visibility (f, tem, Qnil);
+ if (EQ (tem, Qicon))
+ x_iconify_frame (f);
+ else if (! NILP (tem))
+ {
+ x_make_frame_visible (f);
+ f->async_visible = 1;
+ [[FRAME_NS_VIEW (f) window] makeKeyWindow];
+ }
+ else
+ f->async_visible = 0;
}
if (FRAME_HAS_MINIBUF_P (f)
}
-/* ==========================================================================
-
- Lisp definitions
-
- ========================================================================== */
-
-DEFUN ("ns-focus-frame", Fns_focus_frame, Sns_focus_frame, 1, 1, 0,
+DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
doc: /* Set the input focus to FRAME.
FRAME nil means use the selected frame. */)
- (frame)
- Lisp_Object frame;
+ (Lisp_Object frame)
{
struct frame *f = check_ns_frame (frame);
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
- if (dpyinfo->ns_focus_frame != f)
+ if (dpyinfo->x_focus_frame != f)
{
EmacsView *view = FRAME_NS_VIEW (f);
BLOCK_INPUT;
+ [NSApp activateIgnoringOtherApps: YES];
[[view window] makeKeyAndOrderFront: view];
UNBLOCK_INPUT;
}
}
-DEFUN ("ns-popup-prefs-panel", Fns_popup_prefs_panel, Sns_popup_prefs_panel,
- 0, 0, "", "Pop up the preferences panel.")
- ()
-{
- check_ns ();
- [(EmacsApp *)NSApp showPreferencesWindow: NSApp];
- return Qnil;
-}
-
-
DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
- 0, 1, "", "Pop up the font panel.")
- (frame)
- Lisp_Object frame;
+ 0, 1, "",
+ doc: /* Pop up the font panel. */)
+ (Lisp_Object frame)
{
id fm;
struct frame *f;
check_ns ();
- fm = [NSFontManager new];
+ fm = [NSFontManager sharedFontManager];
if (NILP (frame))
f = SELECTED_FRAME ();
else
}
-DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
- 0, 1, "", "Pop up the color panel.")
- (frame)
- Lisp_Object frame;
+DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
+ 0, 1, "",
+ doc: /* Pop up the color panel. */)
+ (Lisp_Object frame)
{
struct frame *f;
DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
- "Use a graphical panel to read a file name, using prompt PROMPT.
+ doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
Optional arg DIR, if non-nil, supplies a default directory.
Optional arg ISLOAD, if non-nil, means read a file name for saving.
-Optional arg INIT, if non-nil, provides a default file name to use.")
- (prompt, dir, isLoad, init)
- Lisp_Object prompt, dir, isLoad, init;
+Optional arg INIT, if non-nil, provides a default file name to use. */)
+ (Lisp_Object prompt, Lisp_Object dir, Lisp_Object isLoad, Lisp_Object init)
{
static id fileDelegate = nil;
int ret;
id panel;
- NSString *fname;
+ Lisp_Object fname;
NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
[NSString stringWithUTF8String: SDATA (prompt)];
dirS = [dirS stringByExpandingTildeInPath];
panel = NILP (isLoad) ?
- [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel];
+ (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
[panel setTitle: promptS];
[panel setDelegate: fileDelegate];
panelOK = 0;
+ BLOCK_INPUT;
if (NILP (isLoad))
{
ret = [panel runModalForDirectory: dirS file: initS];
ret = [panel runModalForDirectory: dirS file: initS types: nil];
}
- ret = (ret = NSOKButton) || panelOK;
+ ret = (ret == NSOKButton) || panelOK;
- fname = [panel filename];
+ if (ret)
+ fname = build_string ([[panel filename] UTF8String]);
[[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
+ UNBLOCK_INPUT;
- return ret ? build_string ([fname UTF8String]) : Qnil;
+ return ret ? fname : Qnil;
}
DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
- "Return the value of the property NAME of OWNER from the defaults database.
-If OWNER is nil, Emacs is assumed.")
- (owner, name)
- Lisp_Object owner, name;
+ doc: /* Return the value of the property NAME of OWNER from the defaults database.
+If OWNER is nil, Emacs is assumed. */)
+ (Lisp_Object owner, Lisp_Object name)
{
const char *value;
check_ns ();
if (NILP (owner))
- owner = build_string
- ([[[NSProcessInfo processInfo] processName] UTF8String]);
- /* CHECK_STRING (owner); this should be just "Emacs" */
+ owner = build_string([ns_app_name UTF8String]);
CHECK_STRING (name);
/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
- "Set property NAME of OWNER to VALUE, from the defaults database.
+ doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
If OWNER is nil, Emacs is assumed.
-If VALUE is nil, the default is removed.")
- (owner, name, value)
- Lisp_Object owner, name, value;
+If VALUE is nil, the default is removed. */)
+ (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
{
check_ns ();
if (NILP (owner))
- owner
- = build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
- CHECK_STRING (owner);
+ owner = build_string ([ns_app_name UTF8String]);
CHECK_STRING (name);
if (NILP (value))
{
}
-DEFUN ("ns-set-alpha", Fns_set_alpha, Sns_set_alpha, 2, 2, 0,
- "Return a color equivalent to COLOR with alpha setting ALPHA.
-The argument ALPHA should be a number between 0 and 1, where 0 is full
-transparency and 1 is opaque.")
- (color, alpha)
- Lisp_Object color;
- Lisp_Object alpha;
-{
- NSColor *col;
- float a;
-
- CHECK_STRING (color);
- CHECK_NUMBER_OR_FLOAT (alpha);
-
- if (ns_lisp_to_color (color, &col))
- error ("Unknown color.");
-
- a = XFLOATINT (alpha);
- if (a < 0.0 || a > 1.0)
- error ("Alpha value should be between 0 and 1 inclusive.");
-
- col = [col colorWithAlphaComponent: a];
- return ns_color_to_lisp (col);
-}
-
-
-DEFUN ("ns-server-max-request-size", Fns_server_max_request_size,
- Sns_server_max_request_size,
+DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
+ Sx_server_max_request_size,
0, 1, 0,
- "This function is a no-op. It is only present for completeness.")
- (display)
- Lisp_Object display;
+ doc: /* This function is a no-op. It is only present for completeness. */)
+ (Lisp_Object display)
{
check_ns ();
/* This function has no real equivalent under NeXTstep. Return nil to
}
-DEFUN ("ns-server-vendor", Fns_server_vendor, Sns_server_vendor, 0, 1, 0,
- "Return the vendor ID string of Nextstep display server DISPLAY.
+DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
+ doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
- check_ns ();
#ifdef NS_IMPL_GNUSTEP
return build_string ("GNU");
#else
}
-DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0,
- "Return the version number of Nextstep display server DISPLAY.
+DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
+ doc: /* Return the version numbers of the server of DISPLAY.
+The value is a list of three integers: the major and minor
+version numbers of the X Protocol in use, and the distributor-specific
+release number. See also the function `x-server-vendor'.
+
+The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
-If omitted or nil, the selected frame's display is used.
-See also the function `ns-server-vendor'.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
- /* FIXME: return GUI version on GNUSTEP, ?? on OS X */
- return build_string ("1.0");
+ /*NOTE: it is unclear what would best correspond with "protocol";
+ we return 10.3, meaning Panther, since this is roughly the
+ level that GNUstep's APIs correspond to.
+ The last number is where we distinguish between the Apple
+ and GNUstep implementations ("distributor-specific release
+ number") and give int'ized versions of major.minor. */
+ return Fcons (make_number (10),
+ Fcons (make_number (3),
+ Fcons (make_number (ns_appkit_version_int()), Qnil)));
}
-DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0,
- "Return the number of screens on Nextstep display server DISPLAY.
+DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
+ doc: /* Return the number of screens on Nextstep display server DISPLAY.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
int num;
}
-DEFUN ("ns-display-mm-height", Fns_display_mm_height, Sns_display_mm_height,
+DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height,
0, 1, 0,
- "Return the height of Nextstep display server DISPLAY, in millimeters.
+ doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int)
}
-DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width,
+DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width,
0, 1, 0,
- "Return the width of Nextstep display server DISPLAY, in millimeters.
+ doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int)
}
-DEFUN ("ns-display-backing-store", Fns_display_backing_store,
- Sns_display_backing_store, 0, 1, 0,
- "Return whether the Nexstep display DISPLAY supports backing store.
+DEFUN ("x-display-backing-store", Fx_display_backing_store,
+ Sx_display_backing_store, 0, 1, 0,
+ doc: /* Return whether the Nexstep display DISPLAY supports backing store.
The value may be `buffered', `retained', or `non-retained'.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
check_ns ();
switch ([ns_get_window (display) backingType])
}
-DEFUN ("ns-display-visual-class", Fns_display_visual_class,
- Sns_display_visual_class, 0, 1, 0,
- "Return the visual class of the Nextstep display server DISPLAY.
+DEFUN ("x-display-visual-class", Fx_display_visual_class,
+ Sx_display_visual_class, 0, 1, 0,
+ doc: /* Return the visual class of the Nextstep display server DISPLAY.
The value is one of the symbols `static-gray', `gray-scale',
`static-color', `pseudo-color', `true-color', or `direct-color'.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
}
-DEFUN ("ns-display-save-under", Fns_display_save_under,
- Sns_display_save_under, 0, 1, 0,
- "Non-nil if the Nextstep display server supports the save-under feature.
+DEFUN ("x-display-save-under", Fx_display_save_under,
+ Sx_display_save_under, 0, 1, 0,
+ doc: /* Non-nil if the Nextstep display server supports the save-under feature.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be a frame, the display name as a string, or a terminal ID.
-If omitted or nil, the selected frame's display is used.")
- (display)
- Lisp_Object display;
+If omitted or nil, the selected frame's display is used. */)
+ (Lisp_Object display)
{
check_ns ();
switch ([ns_get_window (display) backingType])
}
-DEFUN ("ns-open-connection", Fns_open_connection, Sns_open_connection,
- 1, 3, 0, "Open a connection to a Nextstep display server.
+DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
+ 1, 3, 0,
+ doc: /* Open a connection to a Nextstep display server.
DISPLAY is the name of the display to connect to.
-Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored.")
- (display, resource_string, must_succeed)
- Lisp_Object display, resource_string, must_succeed;
+Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored. */)
+ (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
{
struct ns_display_info *dpyinfo;
}
-DEFUN ("ns-close-connection", Fns_close_connection, Sns_close_connection,
- 1, 1, 0, "Close the connection to the current Nextstep display server.
-The second argument DISPLAY is currently ignored.")
- (display)
- Lisp_Object display;
+DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
+ 1, 1, 0,
+ doc: /* Close the connection to the current Nextstep display server.
+The argument DISPLAY is currently ignored. */)
+ (Lisp_Object display)
{
check_ns ();
-#ifdef NS_IMPL_COCOA
- PSFlush ();
-#endif
/*ns_delete_terminal (dpyinfo->terminal); */
[NSApp terminate: NSApp];
return Qnil;
}
-DEFUN ("ns-display-list", Fns_display_list, Sns_display_list, 0, 0, 0,
- "Return the list of display names that Emacs has connections to.")
- ()
+DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
+ doc: /* Return the list of display names that Emacs has connections to. */)
+ (void)
{
Lisp_Object tail, result;
DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
- 0, 0, 0, "Hides all applications other than emacs.")
- ()
+ 0, 0, 0,
+ doc: /* Hides all applications other than Emacs. */)
+ (void)
{
check_ns ();
[NSApp hideOtherApplications: NSApp];
}
DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
- 1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.
-Otherwise if emacs is hidden, it is unhidden.
-If ON is equal to `activate', emacs is unhidden and becomes
-the active application.")
- (on)
- Lisp_Object on;
+ 1, 1, 0,
+ doc: /* If ON is non-nil, the entire Emacs application is hidden.
+Otherwise if Emacs is hidden, it is unhidden.
+If ON is equal to `activate', Emacs is unhidden and becomes
+the active application. */)
+ (Lisp_Object on)
{
check_ns ();
if (EQ (on, intern ("activate")))
DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
- 0, 0, 0, "Shows the 'Info' or 'About' panel for Emacs.")
- ()
+ 0, 0, 0,
+ doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
+ (void)
{
check_ns ();
[NSApp orderFrontStandardAboutPanel: nil];
}
-DEFUN ("x-list-fonts", Fns_list_fonts, Sns_list_fonts, 1, 4, 0,
- doc: /* Return a list of the names of available fonts matching PATTERN.
-If optional arguments FACE and FRAME are specified, return only fonts
-the same size as FACE on FRAME.
-If optional argument MAX is specified, return at most MAX matches.
-
-PATTERN is a regular expression; FACE is a face name - a symbol.
-
-The return value is a list of strings, suitable as arguments to
-set-face-font.
-
-The font names are _NOT_ X names. */)
- (pattern, face, frame, max)
- Lisp_Object pattern, face, frame, max;
-{
- Lisp_Object flist, olist = Qnil, tem;
- struct frame *f;
- int maxnames;
-
- /* We can't simply call check_x_frame because this function may be
- called before any frame is created. */
- if (NILP (frame))
- f = SELECTED_FRAME ();
- else
- {
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
- }
- if (! FRAME_WINDOW_P (f))
- {
- /* Perhaps we have not yet created any frame. */
- f = NULL;
- }
-
- if (NILP (max))
- maxnames = 4;
- else
- {
- CHECK_NATNUM (max);
- maxnames = XFASTINT (max);
- }
-
- /* get XLFD names */
- flist = ns_list_fonts (f, pattern, 0, maxnames);
-
- /* convert list into regular names */
- for (tem = flist; CONSP (tem); tem = XCDR (tem))
- {
- Lisp_Object fname = XCAR (tem);
- olist = Fcons (build_string (ns_xlfd_to_fontname (SDATA (fname))),
- olist);
- }
-
- return olist;
-}
-
-
DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
- "Determine font postscript or family name for font NAME.
+ doc: /* Determine font postscript or family name for font NAME.
NAME should be a string containing either the font name or an XLFD
font descriptor. If string contains `fontset' and not
-`fontset-startup', it is left alone.")
- (name)
- Lisp_Object name;
+`fontset-startup', it is left alone. */)
+ (Lisp_Object name)
{
char *nm;
CHECK_STRING (name);
DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
- "Return a list of all available colors.
-The optional argument FRAME is currently ignored.")
- (frame)
- Lisp_Object frame;
+ doc: /* Return a list of all available colors.
+The optional argument FRAME is currently ignored. */)
+ (Lisp_Object frame)
{
Lisp_Object list = Qnil;
NSEnumerator *colorlists;
DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
- "List available Nextstep services by querying NSApp.")
- ()
+ doc: /* List available Nextstep services by querying NSApp. */)
+ (void)
{
Lisp_Object ret = Qnil;
NSMenu *svcs;
DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
- 2, 2, 0, "Perform Nextstep SERVICE on SEND.
+ 2, 2, 0,
+ doc: /* Perform Nextstep SERVICE on SEND.
SEND should be either a string or nil.
The return value is the result of the service, as string, or nil if
-there was no result.")
- (service, send)
- Lisp_Object service, send;
+there was no result. */)
+ (Lisp_Object service, Lisp_Object send)
{
id pb;
NSString *svcName;
DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
- "Return an NFC string that matches the UTF-8 NFD string STR.")
- (str)
- Lisp_Object str;
+ doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
+ (Lisp_Object str)
{
+/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
+ remove this. */
NSString *utfStr;
CHECK_STRING (str);
- utfStr = [[NSString stringWithUTF8String: SDATA (str)]
- precomposedStringWithCanonicalMapping];
+ utfStr = [NSString stringWithUTF8String: SDATA (str)];
+ if (![utfStr respondsToSelector:
+ @selector (precomposedStringWithCanonicalMapping)])
+ {
+ message1
+ ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
+ return Qnil;
+ }
+ else
+ utfStr = [utfStr precomposedStringWithCanonicalMapping];
return build_string ([utfStr UTF8String]);
}
+#ifdef NS_IMPL_COCOA
+
+/* Compile and execute the AppleScript SCRIPT and return the error
+ status as function value. A zero is returned if compilation and
+ execution is successful, in which case *RESULT is set to a Lisp
+ string or a number containing the resulting script value. Otherwise,
+ 1 is returned. */
+static int
+ns_do_applescript (Lisp_Object script, Lisp_Object *result)
+{
+ NSAppleEventDescriptor *desc;
+ NSDictionary* errorDict;
+ NSAppleEventDescriptor* returnDescriptor = NULL;
+
+ NSAppleScript* scriptObject =
+ [[NSAppleScript alloc] initWithSource:
+ [NSString stringWithUTF8String: SDATA (script)]];
+
+ returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
+ [scriptObject release];
+
+ *result = Qnil;
+
+ if (returnDescriptor != NULL)
+ {
+ // successful execution
+ if (kAENullEvent != [returnDescriptor descriptorType])
+ {
+ *result = Qt;
+ // script returned an AppleScript result
+ if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
+ (typeUTF16ExternalRepresentation
+ == [returnDescriptor descriptorType]) ||
+#endif
+ (typeUTF8Text == [returnDescriptor descriptorType]) ||
+ (typeCString == [returnDescriptor descriptorType]))
+ {
+ desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
+ if (desc)
+ *result = build_string([[desc stringValue] UTF8String]);
+ }
+ else
+ {
+ /* use typeUTF16ExternalRepresentation? */
+ // coerce the result to the appropriate ObjC type
+ desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
+ if (desc)
+ *result = make_number([desc int32Value]);
+ }
+ }
+ }
+ else
+ {
+ // no script result, return error
+ return 1;
+ }
+ return 0;
+}
+
+DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
+ doc: /* Execute AppleScript SCRIPT and return the result.
+If compilation and execution are successful, the resulting script value
+is returned as a string, a number or, in the case of other constructs, t.
+In case the execution fails, an error is signaled. */)
+ (Lisp_Object script)
+{
+ Lisp_Object result;
+ long status;
+
+ CHECK_STRING (script);
+ check_ns ();
+
+ BLOCK_INPUT;
+ status = ns_do_applescript (script, &result);
+ UNBLOCK_INPUT;
+ if (status == 0)
+ return result;
+ else if (!STRINGP (result))
+ error ("AppleScript error %d", status);
+ else
+ error ("%s", SDATA (result));
+}
+#endif
+
+
+
/* ==========================================================================
Miscellaneous functions not called through hooks
========================================================================== */
-/* 23: call in image.c */
+/* called from image.c */
FRAME_PTR
check_x_frame (Lisp_Object frame)
{
return check_ns_frame (frame);
}
-/* 23: added, due to call in frame.c */
+
+/* called from frame.c */
struct ns_display_info *
check_x_display_info (Lisp_Object frame)
{
}
-/* 23: new function; we don't have much in the way of flexibility though */
void
-x_set_scroll_bar_default_width (f)
- struct frame *f;
+x_set_scroll_bar_default_width (struct frame *f)
{
int wid = FRAME_COLUMN_WIDTH (f);
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
}
-/* 23: terms now impl this instead of x-get-resource directly */
+/* terms impl this instead of x-get-resource directly */
const char *
x_get_string_resource (XrmDatabase rdb, char *name, char *class)
{
const char *res;
check_ns ();
- /* Support emacs-20-style face resources for backwards compatibility */
- if (!strncmp (toCheck, "Face", 4))
- toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0);
+ if (inhibit_x_resources)
+ /* --quick was passed, so this is a no-op. */
+ return NULL;
-/*fprintf (stderr, "Checking '%s'\n", toCheck); */
-
res = [[[NSUserDefaults standardUserDefaults] objectForKey:
- [NSString stringWithUTF8String: toCheck]] UTF8String];
+ [NSString stringWithUTF8String: toCheck]] UTF8String];
return !res ? NULL :
(!strncasecmp (res, "YES", 3) ? "true" :
(!strncasecmp (res, "NO", 2) ? "false" : res));
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
Lisp_Object nsfocus;
- if (!dpyinfo->ns_focus_frame)
+ if (!dpyinfo->x_focus_frame)
return Qnil;
- XSETFRAME (nsfocus, dpyinfo->ns_focus_frame);
+ XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
return nsfocus;
}
void
-x_sync (Lisp_Object frame)
+x_sync (struct frame *f)
{
/* XXX Not implemented XXX */
return;
========================================================================== */
-DEFUN ("xw-color-defined-p", Fns_color_defined_p, Sns_color_defined_p, 1, 2, 0,
- "Return t if the current Nextstep display supports the color COLOR.
-The optional argument FRAME is currently ignored.")
- (color, frame)
- Lisp_Object color, frame;
+DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
+ doc: /* Return t if the current Nextstep display supports the color COLOR.
+The optional argument FRAME is currently ignored. */)
+ (Lisp_Object color, Lisp_Object frame)
{
NSColor * col;
check_ns ();
}
-DEFUN ("xw-color-values", Fns_color_values, Sns_color_values, 1, 2, 0,
- "Return a description of the color named COLOR.
-The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).
-These values appear to range from 0 to 65280; white is (65280 65280 65280 0).
-The optional argument FRAME is currently ignored.")
- (color, frame)
- Lisp_Object color, frame;
+DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
+ doc: /* Internal function called by `color-values', which see. */)
+ (Lisp_Object color, Lisp_Object frame)
{
NSColor * col;
- float red, green, blue, alpha;
- Lisp_Object rgba[4];
+ CGFloat red, green, blue, alpha;
check_ns ();
CHECK_STRING (color);
[[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
getRed: &red green: &green blue: &blue alpha: &alpha];
- rgba[0] = make_number (lrint (red*65280));
- rgba[1] = make_number (lrint (green*65280));
- rgba[2] = make_number (lrint (blue*65280));
- rgba[3] = make_number (lrint (alpha*65280));
-
- return Flist (4, rgba);
+ return list3 (make_number (lrint (red*65280)),
+ make_number (lrint (green*65280)),
+ make_number (lrint (blue*65280)));
}
DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
- "Return t if the Nextstep display supports color.
+ doc: /* Return t if the Nextstep display supports color.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
NSWindowDepth depth;
NSString *colorSpace;
DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
Sx_display_grayscale_p, 0, 1, 0,
- "Return t if the Nextstep display supports shades of gray.
+ doc: /* Return t if the Nextstep display supports shades of gray.
Note that color displays do support shades of gray.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
}
-DEFUN ("x-display-pixel-width", Fns_display_pixel_width, Sns_display_pixel_width,
+DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
0, 1, 0,
- "Returns the width in pixels of the Nextstep display DISPLAY.
+ doc: /* Return the width in pixels of the Nextstep display DISPLAY.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int) [ns_get_screen (display) frame].size.width);
}
-DEFUN ("x-display-pixel-height", Fns_display_pixel_height,
- Sns_display_pixel_height, 0, 1, 0,
- "Returns the height in pixels of the Nextstep display DISPLAY.
+DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
+ Sx_display_pixel_height, 0, 1, 0,
+ doc: /* Return the height in pixels of the Nextstep display DISPLAY.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int) [ns_get_screen (display) frame].size.height);
}
+
DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
Sns_display_usable_bounds, 0, 1, 0,
- "Return the bounds of the usable part of the screen.
+ doc: /* Return the bounds of the usable part of the screen.
The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
are the boundaries of the usable part of the screen, excluding areas
reserved for the Mac menu, dock, and so forth.
The screen queried corresponds to DISPLAY, which should be either a
frame, a display name (a string), or terminal ID. If omitted or nil,
-that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
int top;
+ NSScreen *screen;
NSRect vScreen;
check_ns ();
- vScreen = [ns_get_screen (display) visibleFrame];
- top = vScreen.origin.y == 0.0 ?
- (int) [ns_get_screen (display) frame].size.height - vScreen.size.height : 0;
+ screen = ns_get_screen (display);
+ if (!screen)
+ return Qnil;
+ vScreen = [screen visibleFrame];
+
+ /* NS coordinate system is upside-down.
+ Transform to screen-specific coordinates. */
return list4 (make_number ((int) vScreen.origin.x),
- make_number (top),
+ make_number ((int) [screen frame].size.height
+ - vScreen.size.height - vScreen.origin.y),
make_number ((int) vScreen.size.width),
make_number ((int) vScreen.size.height));
}
-DEFUN ("x-display-planes", Fx_display_planes, Sns_display_planes,
+DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
0, 1, 0,
- "Returns the number of bitplanes of the Nextstep display DISPLAY.
+ doc: /* Return the number of bitplanes of the Nextstep display DISPLAY.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
check_ns ();
return make_number
- (NSBitsPerSampleFromDepth ([ns_get_screen (display) depth]));
+ (NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
}
-DEFUN ("x-display-color-cells", Fns_display_color_cells,
- Sns_display_color_cells, 0, 1, 0,
- "Returns the number of color cells of the Nextstep display DISPLAY.
+DEFUN ("x-display-color-cells", Fx_display_color_cells,
+ Sx_display_color_cells, 0, 1, 0,
+ doc: /* Returns the number of color cells of the Nextstep display DISPLAY.
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame, a display name (a string), or terminal ID.
-If omitted or nil, that stands for the selected frame's display.")
- (display)
- Lisp_Object display;
+If omitted or nil, that stands for the selected frame's display. */)
+ (Lisp_Object display)
{
+ struct ns_display_info *dpyinfo;
check_ns ();
- struct ns_display_info *dpyinfo = check_ns_display_info (display);
-
+
+ dpyinfo = check_ns_display_info (display);
/* We force 24+ bit depths to 24-bit to prevent an overflow. */
return make_number (1 << min (dpyinfo->n_planes, 24));
}
/* TODO: move to xdisp or similar */
static void
-compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
- struct frame *f;
- Lisp_Object parms, dx, dy;
- int width, height;
- int *root_x, *root_y;
+compute_tip_xy (struct frame *f,
+ Lisp_Object parms,
+ Lisp_Object dx,
+ Lisp_Object dy,
+ int width,
+ int height,
+ int *root_x,
+ int *root_y)
{
Lisp_Object left, top;
EmacsView *view = FRAME_NS_VIEW (f);
NSPoint pt;
-
+
/* Start with user-specified or mouse position. */
left = Fcdr (Fassq (Qleft, parms));
- if (INTEGERP (left))
- pt.x = XINT (left);
- else
- pt.x = last_mouse_motion_position.x;
top = Fcdr (Fassq (Qtop, parms));
- if (INTEGERP (top))
- pt.y = XINT (top);
- else
- pt.y = last_mouse_motion_position.y;
-
- /* Convert to screen coordinates */
- pt = [view convertPoint: pt toView: nil];
- pt = [[view window] convertBaseToScreen: pt];
+ if (!INTEGERP (left) || !INTEGERP (top))
+ {
+ pt = last_mouse_motion_position;
+ /* Convert to screen coordinates */
+ pt = [view convertPoint: pt toView: nil];
+ pt = [[view window] convertBaseToScreen: pt];
+ }
+ else
+ {
+ /* Absolute coordinates. */
+ pt.x = XINT (left);
+ pt.y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - XINT (top)
+ - height;
+ }
+
/* Ensure in bounds. (Note, screen origin = lower left.) */
- if (pt.x + XINT (dx) <= 0)
+ if (INTEGERP (left))
+ *root_x = pt.x;
+ else if (pt.x + XINT (dx) <= 0)
*root_x = 0; /* Can happen for negative dx */
- else if (pt.x + XINT (dx) + width <= FRAME_NS_DISPLAY_INFO (f)->width)
+ else if (pt.x + XINT (dx) + width
+ <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
/* It fits to the right of the pointer. */
*root_x = pt.x + XINT (dx);
else if (width + XINT (dx) <= pt.x)
/* Put it left justified on the screen -- it ought to fit that way. */
*root_x = 0;
- if (pt.y - XINT (dy) - height >= 0)
+ if (INTEGERP (top))
+ *root_y = pt.y;
+ else if (pt.y - XINT (dy) - height >= 0)
/* It fits below the pointer. */
*root_y = pt.y - height - XINT (dy);
- else if (pt.y + XINT (dy) + height <= FRAME_NS_DISPLAY_INFO (f)->height)
+ else if (pt.y + XINT (dy) + height
+ <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
/* It fits above the pointer */
*root_y = pt.y + XINT (dy);
else
/* Put it on the top. */
- *root_y = FRAME_NS_DISPLAY_INFO (f)->height - height;
+ *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
}
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
- doc: /* Show STRING in a "tooltip" window on frame FRAME.
+ doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
A tooltip window is a small window displaying a string.
FRAME nil or omitted means use the selected frame.
A tooltip's maximum size is specified by `x-max-tooltip-size'.
Text larger than the specified size is clipped. */)
- (string, frame, parms, timeout, dx, dy)
- Lisp_Object string, frame, parms, timeout, dx, dy;
+ (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
int root_x, root_y;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
doc: /* Hide the current tooltip window, if there is any.
Value is t if tooltip was open, nil otherwise. */)
- ()
+ (void)
{
if (ns_tooltip == nil || ![ns_tooltip isActive])
return Qnil;
}
-/* ==========================================================================
-
- Lisp interface declaration
-
- ========================================================================== */
-
-
-void
-syms_of_nsfns ()
-{
- int i;
-
- Qns_frame_parameter = intern ("ns-frame-parameter");
- staticpro (&Qns_frame_parameter);
- Qnone = intern ("none");
- staticpro (&Qnone);
- Qbuffered = intern ("bufferd");
- staticpro (&Qbuffered);
- Qfontsize = intern ("fontsize");
- staticpro (&Qfontsize);
-
- DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
- "Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
-If the title of a frame matches REGEXP, then IMAGE.tiff is
-selected as the image of the icon representing the frame when it's
-miniaturized. If an element is t, then Emacs tries to select an icon
-based on the filetype of the visited file.
-
-The images have to be installed in a folder called English.lproj in the
-Emacs folder. You have to restart Emacs after installing new icons.
-
-Example: Install an icon Gnus.tiff and execute the following code
-
- (setq ns-icon-type-alist
- (append ns-icon-type-alist
- '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
- . \"Gnus\"))))
-
-When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
-be used as the image of the icon representing the frame.");
- Vns_icon_type_alist = Fcons (Qt, Qnil);
-
- defsubr (&Sns_read_file_name);
- defsubr (&Sns_get_resource);
- defsubr (&Sns_set_resource);
- defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
- defsubr (&Sx_display_grayscale_p);
- defsubr (&Sns_list_fonts);
- defsubr (&Sns_font_name);
- defsubr (&Sns_list_colors);
- defsubr (&Sns_color_defined_p);
- defsubr (&Sns_color_values);
- defsubr (&Sns_server_max_request_size);
- defsubr (&Sns_server_vendor);
- defsubr (&Sns_server_version);
- defsubr (&Sns_display_pixel_width);
- defsubr (&Sns_display_pixel_height);
- defsubr (&Sns_display_usable_bounds);
- defsubr (&Sns_display_mm_width);
- defsubr (&Sns_display_mm_height);
- defsubr (&Sns_display_screens);
- defsubr (&Sns_display_planes);
- defsubr (&Sns_display_color_cells);
- defsubr (&Sns_display_visual_class);
- defsubr (&Sns_display_backing_store);
- defsubr (&Sns_display_save_under);
- defsubr (&Sns_create_frame);
- defsubr (&Sns_set_alpha);
- defsubr (&Sns_open_connection);
- defsubr (&Sns_close_connection);
- defsubr (&Sns_display_list);
-
- defsubr (&Sns_hide_others);
- defsubr (&Sns_hide_emacs);
- defsubr (&Sns_emacs_info_panel);
- defsubr (&Sns_list_services);
- defsubr (&Sns_perform_service);
- defsubr (&Sns_convert_utf8_nfd_to_nfc);
- defsubr (&Sns_focus_frame);
- defsubr (&Sns_popup_prefs_panel);
- defsubr (&Sns_popup_font_panel);
- defsubr (&Sns_popup_color_panel);
-
- defsubr (&Sx_show_tip);
- defsubr (&Sx_hide_tip);
-
- /* used only in fontset.c */
- check_window_system_func = check_ns;
-
-}
-
-
-
/* ==========================================================================
Class implementations
#endif
+
+/* ==========================================================================
+
+ Lisp interface declaration
+
+ ========================================================================== */
+
+
+void
+syms_of_nsfns (void)
+{
+ int i;
+
+ Qfontsize = intern ("fontsize");
+ staticpro (&Qfontsize);
+
+ DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
+ doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
+If the title of a frame matches REGEXP, then IMAGE.tiff is
+selected as the image of the icon representing the frame when it's
+miniaturized. If an element is t, then Emacs tries to select an icon
+based on the filetype of the visited file.
+
+The images have to be installed in a folder called English.lproj in the
+Emacs folder. You have to restart Emacs after installing new icons.
+
+Example: Install an icon Gnus.tiff and execute the following code
+
+ (setq ns-icon-type-alist
+ (append ns-icon-type-alist
+ '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
+ . \"Gnus\"))))
+
+When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
+be used as the image of the icon representing the frame. */);
+ Vns_icon_type_alist = Fcons (Qt, Qnil);
+
+ DEFVAR_LISP ("ns-version-string", &Vns_version_string,
+ doc: /* Toolkit version for NS Windowing. */);
+ Vns_version_string = ns_appkit_version_str ();
+
+ defsubr (&Sns_read_file_name);
+ defsubr (&Sns_get_resource);
+ defsubr (&Sns_set_resource);
+ defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
+ defsubr (&Sx_display_grayscale_p);
+ defsubr (&Sns_font_name);
+ defsubr (&Sns_list_colors);
+#ifdef NS_IMPL_COCOA
+ defsubr (&Sns_do_applescript);
+#endif
+ defsubr (&Sxw_color_defined_p);
+ defsubr (&Sxw_color_values);
+ defsubr (&Sx_server_max_request_size);
+ defsubr (&Sx_server_vendor);
+ defsubr (&Sx_server_version);
+ defsubr (&Sx_display_pixel_width);
+ defsubr (&Sx_display_pixel_height);
+ defsubr (&Sns_display_usable_bounds);
+ defsubr (&Sx_display_mm_width);
+ defsubr (&Sx_display_mm_height);
+ defsubr (&Sx_display_screens);
+ defsubr (&Sx_display_planes);
+ defsubr (&Sx_display_color_cells);
+ defsubr (&Sx_display_visual_class);
+ defsubr (&Sx_display_backing_store);
+ defsubr (&Sx_display_save_under);
+ defsubr (&Sx_create_frame);
+ defsubr (&Sx_open_connection);
+ defsubr (&Sx_close_connection);
+ defsubr (&Sx_display_list);
+
+ defsubr (&Sns_hide_others);
+ defsubr (&Sns_hide_emacs);
+ defsubr (&Sns_emacs_info_panel);
+ defsubr (&Sns_list_services);
+ defsubr (&Sns_perform_service);
+ defsubr (&Sns_convert_utf8_nfd_to_nfc);
+ defsubr (&Sx_focus_frame);
+ defsubr (&Sns_popup_font_panel);
+ defsubr (&Sns_popup_color_panel);
+
+ defsubr (&Sx_show_tip);
+ defsubr (&Sx_hide_tip);
+
+ /* used only in fontset.c */
+ check_window_system_func = check_ns;
+
+}
+
// arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642
HCoop / bpt / emacs.git / blobdiff