/* 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
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 "lisp.h"
#include "blockinput.h"
#include "nsterm.h"
#include "keyboard.h"
#include "termhooks.h"
#include "fontset.h"
-
#include "character.h"
#include "font.h"
/* 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;
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;
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);
}
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;
}
-/* 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)
+x_set_cursor_type (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
}
\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 ()
+{
+ 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 ()
+{
+#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
};
+
+/* ==========================================================================
+
+ 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.
}
-/* ==========================================================================
-
- 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. */)
}
-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. */)
}
-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)
static id fileDelegate = nil;
int ret;
id panel;
- NSString *fname;
+ Lisp_Object fname;
NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
[NSString stringWithUTF8String: SDATA (prompt)];
[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;
}
CHECK_NUMBER_OR_FLOAT (alpha);
if (ns_lisp_to_color (color, &col))
- error ("Unknown color.");
+ error ("Unknown color");
a = XFLOATINT (alpha);
if (a < 0.0 || a > 1.0)
- error ("Alpha value should be between 0 and 1 inclusive.");
+ error ("Alpha value should be between 0 and 1 inclusive");
col = [col colorWithAlphaComponent: a];
return ns_color_to_lisp (col);
(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'. */)
+If omitted or nil, that stands for the selected frame's display. */)
(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 ("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. */)
+The argument DISPLAY is currently ignored. */)
(display)
Lisp_Object display;
{
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. */)
()
{
check_ns ();
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;
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. */)
+ doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
(str)
Lisp_Object str;
{
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. */)
+ 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;
{
========================================================================== */
-/* 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;
}
-/* 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)
{
toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0);
/*fprintf (stderr, "Checking '%s'\n", toCheck); */
-
- res = [[[NSUserDefaults standardUserDefaults] objectForKey:
- [NSString stringWithUTF8String: toCheck]] UTF8String];
+
+ res = ns_no_defaults ? NULL :
+ [[[NSUserDefaults standardUserDefaults] objectForKey:
+ [NSString stringWithUTF8String: toCheck]] UTF8String];
return !res ? NULL :
(!strncasecmp (res, "YES", 3) ? "true" :
(!strncasecmp (res, "NO", 2) ? "false" : res));
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. */)
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. */)
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.
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. */)
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))
/* Ensure in bounds. (Note, screen origin = lower left.) */
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)
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.
#endif
+
/* ==========================================================================
Lisp interface declaration
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 (&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);