/* 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 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;
/* Nonzero if we can use mouse menus. */
int
-have_menus_p ()
+have_menus_p (void)
{
return NSApp != nil;
}
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->x_focus_frame;
- if (!f)
- f = dpyinfo->x_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;
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
}
-/* FIXME: adapt to generics */
-
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))
{
update_face_from_frame_parameter (f, Qcursor_color, arg);
}
+
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;
+ }
}
}
-/* 23: toolbar support */
+/* toolbar support */
void
x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
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 like x_set_cursor_type defined in xfns.c */
+/* This is the same as the xfns.c definition. */
void
-ns_set_cursor_type (f, arg, oldval)
- FRAME_PTR f;
- Lisp_Object arg, oldval;
+x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
{
set_frame_cursor_types (f, arg);
}
\f
-/* 23: called to set mouse pointer color, but all other terms use it to
- initialize pointer types (and don't set the color ;) */
+/* 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)
+x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
/* don't think we can do this on Nextstep */
}
+#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);
+}
+
+
+/* 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)
+{
+#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
x_icon (struct frame *f, Lisp_Object parms)
/* --------------------------------------------------------------------------
}
-/* 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 */
x_set_menu_bar_lines,
- ns_set_mouse_color,
- ns_explicitly_set_name,
+ 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 */
0, /* x_set_wait_for_wm, will ignore */
0, /* x_set_fullscreen will ignore */
x_set_font_backend, /* generic OK */
- 0
+ x_set_alpha,
+ 0, /* x_set_sticky */
+ 0, /* x_set_tool_bar_position */
};
+
+/* ==========================================================================
+
+ Lisp definitions
+
+ ========================================================================== */
+
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
doc: /* Make a new Nextstep window, called a \"frame\" in Emacs terms.
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;
+ (Lisp_Object parms)
{
static int desc_ctr = 1;
struct frame *f;
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;
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",
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 ("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);
{
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, "",
- doc: /* 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, "",
doc: /* Pop up the font panel. */)
- (frame)
- Lisp_Object frame;
+ (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,
+DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
0, 1, "",
doc: /* Pop up the color panel. */)
- (frame)
- Lisp_Object frame;
+ (Lisp_Object frame)
{
struct frame *f;
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;
+ (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,
doc: /* 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;
+ (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)); */
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;
+ (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,
- doc: /* 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 ("x-server-max-request-size", Fx_server_max_request_size,
Sx_server_max_request_size,
0, 1, 0,
doc: /* This function is a no-op. It is only present for completeness. */)
- (display)
- Lisp_Object display;
+ (Lisp_Object display)
{
check_ns ();
/* This function has no real equivalent under NeXTstep. Return nil to
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;
+ (Lisp_Object display)
{
- check_ns ();
#ifdef NS_IMPL_GNUSTEP
return build_string ("GNU");
#else
DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
- doc: /* Return the version number of Nextstep display server DISPLAY.
+ 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)));
}
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;
+ (Lisp_Object display)
{
int num;
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;
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int)
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;
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int)
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;
+ (Lisp_Object display)
{
check_ns ();
switch ([ns_get_window (display) backingType])
`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;
+ (Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
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;
+ (Lisp_Object display)
{
check_ns ();
switch ([ns_get_window (display) backingType])
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;
+ (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
{
struct ns_display_info *dpyinfo;
DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1, 1, 0,
doc: /* Close the connection to the current Nextstep display server.
-The second argument DISPLAY is currently ignored. */)
- (display)
- Lisp_Object display;
+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 ("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,
- doc: /* Hides all applications other than emacs. */)
- ()
+ 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,
- 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
+ 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. */)
- (on)
- Lisp_Object on;
+ (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,
doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
- ()
+ (void)
{
check_ns ();
[NSApp orderFrontStandardAboutPanel: nil];
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;
+ (Lisp_Object name)
{
char *nm;
CHECK_STRING (name);
DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
doc: /* Return a list of all available colors.
The optional argument FRAME is currently ignored. */)
- (frame)
- Lisp_Object frame;
+ (Lisp_Object frame)
{
Lisp_Object list = Qnil;
NSEnumerator *colorlists;
DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
doc: /* List available Nextstep services by querying NSApp. */)
- ()
+ (void)
{
Lisp_Object ret = Qnil;
NSMenu *svcs;
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;
+ (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,
- doc: /* 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]);
}
string or a number containing the resulting script value. Otherwise,
1 is returned. */
static int
-ns_do_applescript (script, result)
- Lisp_Object script, *result;
+ns_do_applescript (Lisp_Object script, Lisp_Object *result)
{
NSAppleEventDescriptor *desc;
NSDictionary* errorDict;
returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
[scriptObject release];
-
+
*result = Qnil;
-
+
if (returnDescriptor != NULL)
{
// successful execution
*result = Qt;
// script returned an AppleScript result
if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
- (typeUTF16ExternalRepresentation
+#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]))
{
}
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. */)
- (script)
- Lisp_Object script;
+ 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;
========================================================================== */
-/* 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));
void
-x_sync (Lisp_Object frame)
+x_sync (struct frame *f)
{
/* XXX Not implemented XXX */
return;
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. */)
- (color, frame)
- Lisp_Object color, frame;
+ (Lisp_Object color, Lisp_Object frame)
{
NSColor * col;
check_ns ();
DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
- doc: /* 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;
+ 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)));
}
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;
+ (Lisp_Object display)
{
NSWindowDepth depth;
NSString *colorSpace;
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;
+ (Lisp_Object display)
{
NSWindowDepth depth;
check_ns ();
DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
0, 1, 0,
- doc: /* 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;
+ (Lisp_Object display)
{
check_ns ();
return make_number ((int) [ns_get_screen (display) frame].size.width);
DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
Sx_display_pixel_height, 0, 1, 0,
- doc: /* Returns the height in pixels of the Nextstep display DISPLAY.
+ 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;
+ (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,
- doc: /*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;
+ (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, Sx_display_planes,
0, 1, 0,
- doc: /* 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;
+ (Lisp_Object display)
{
check_ns ();
return make_number
- (NSBitsPerSampleFromDepth ([ns_get_screen (display) depth]));
+ (NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
}
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;
+ (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;
#endif
+
/* ==========================================================================
Lisp interface declaration
void
-syms_of_nsfns ()
+syms_of_nsfns (void)
{
int i;
- Qnone = intern ("none");
- staticpro (&Qnone);
- Qbuffered = intern ("bufferd");
- staticpro (&Qbuffered);
Qfontsize = intern ("fontsize");
staticpro (&Qfontsize);
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 (&Sx_display_backing_store);
defsubr (&Sx_display_save_under);
defsubr (&Sx_create_frame);
- defsubr (&Sns_set_alpha);
defsubr (&Sx_open_connection);
defsubr (&Sx_close_connection);
defsubr (&Sx_display_list);
defsubr (&Sns_perform_service);
defsubr (&Sns_convert_utf8_nfd_to_nfc);
defsubr (&Sx_focus_frame);
- defsubr (&Sns_popup_prefs_panel);
defsubr (&Sns_popup_font_panel);
defsubr (&Sns_popup_color_panel);
HCoop / bpt / emacs.git / blobdiff