Mercurial > emacs
diff src/nsfns.m @ 96675:d45acf0c8d23
merging Emacs.app (NeXTstep port)
author | Adrian Robert <Adrian.B.Robert@gmail.com> |
---|---|
date | Tue, 15 Jul 2008 18:15:18 +0000 |
parents | |
children | e869d0172660 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/nsfns.m Tue Jul 15 18:15:18 2008 +0000 @@ -0,0 +1,2668 @@ +/* Functions for the NeXT/Open/GNUstep and MacOSX window system. + + Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008 + Free Software Foundation, Inc.. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. + +Originally by Carl Edman +Updated by Christian Limpach (chris@nice.ch) +OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) +MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net) +GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) + +*/ + +#include <signal.h> +#include <math.h> +#include "config.h" +#include "lisp.h" +#include "blockinput.h" +#include "nsterm.h" +#include "window.h" +#include "buffer.h" +#include "keyboard.h" +#include "termhooks.h" +#include "fontset.h" + +#include "character.h" +#include "font.h" + +#if 0 +int fns_trace_num = 1; +#define NSTRACE(x) fprintf (stderr, "%s:%d: [%d] " #x "\n", \ + __FILE__, __LINE__, ++fns_trace_num) +#else +#define NSTRACE(x) +#endif + +#ifdef HAVE_NS + +extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types; + +extern Lisp_Object Qforeground_color; +extern Lisp_Object Qbackground_color; +extern Lisp_Object Qcursor_color; +extern Lisp_Object Qinternal_border_width; +extern Lisp_Object Qvisibility; +extern Lisp_Object Qcursor_type; +extern Lisp_Object Qicon_type; +extern Lisp_Object Qicon_name; +extern Lisp_Object Qicon_left; +extern Lisp_Object Qicon_top; +extern Lisp_Object Qleft; +extern Lisp_Object Qright; +extern Lisp_Object Qtop; +extern Lisp_Object Qdisplay; +extern Lisp_Object Qvertical_scroll_bars; +extern Lisp_Object Qauto_raise; +extern Lisp_Object Qauto_lower; +extern Lisp_Object Qbox; +extern Lisp_Object Qscroll_bar_width; +extern Lisp_Object Qx_resource_name; +extern Lisp_Object Qface_set_after_frame_default; +extern Lisp_Object Qunderline, Qundefined; +extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; +extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; + +Lisp_Object Qnone; +Lisp_Object Qns_frame_parameter; +Lisp_Object Qbuffered; +Lisp_Object Qfontsize; + +/* hack for OS X file panels */ +char panelOK = 0; + +/* Alist of elements (REGEXP . IMAGE) for images of icons associated + to frames.*/ +Lisp_Object Vns_icon_type_alist; + +EmacsTooltip *ns_tooltip; + +/* Need forward declaration here to preserve organizational integrity of file */ +Lisp_Object Fns_open_connection (Lisp_Object, Lisp_Object, Lisp_Object); + +extern BOOL ns_in_resize; + + +/* ========================================================================== + + Internal utility functions + + ========================================================================== */ + + +void +check_ns (void) +{ + if (NSApp == nil) + error ("OpenStep is not in use or not initialized"); +} + + +/* Nonzero if we can use mouse menus. */ +int +have_menus_p () +{ + return NSApp != nil; +} + + +/* Extract a frame as a FRAME_PTR, defaulting to the selected frame + and checking validity for NS. */ +static FRAME_PTR +check_ns_frame (Lisp_Object frame) +{ + FRAME_PTR f; + + if (NILP (frame)) + f = SELECTED_FRAME (); + else + { + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + } + if (! FRAME_NS_P (f)) + error ("non-NS frame used"); + return f; +} + + +/* Let the user specify an NS display with a frame. + nil stands for the selected frame--or, if that is not an NS frame, + the first NS display on the list. */ +static struct ns_display_info * +check_ns_display_info (Lisp_Object frame) +{ + if (NILP (frame)) + { + 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 + error ("NS windows are not in use or not initialized"); + } + else if (INTEGERP (frame)) + { + struct terminal *t = get_terminal (frame, 1); + + if (t->type != output_ns) + error ("Terminal %d is not an NS display", XINT (frame)); + + return t->display_info.ns; + } + else if (STRINGP (frame)) + return ns_display_info_for_name (frame); + else + { + FRAME_PTR f; + + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + if (! FRAME_NS_P (f)) + error ("non-NS frame used"); + return FRAME_NS_DISPLAY_INFO (f); + } + return NULL; /* shut compiler up */ +} + + +static id +ns_get_window (Lisp_Object maybeFrame) +{ + id view =nil, window =nil; + + if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame))) + maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */ + + if (!NILP (maybeFrame)) + view = FRAME_NS_VIEW (XFRAME (maybeFrame)); + if (view) window =[view window]; + + return window; +} + + +static NSScreen * +ns_get_screen (Lisp_Object anythingUnderTheSun) +{ + id window =nil; + NSScreen *screen = 0; + + 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) + f = SELECTED_FRAME (); + if (f) + { + XSETFRAME (frame, f); + window = ns_get_window (frame); + } + + if (window) + screen = [window screen]; + if (!screen) + screen = [NSScreen mainScreen]; + + return screen; +} + + +/* 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; +{ + Lisp_Object names; + struct ns_display_info *dpyinfo; + + CHECK_STRING (name); + + for (dpyinfo = ns_display_list, names = ns_display_name_list; + dpyinfo; + dpyinfo = dpyinfo->next, names = XCDR (names)) + { + Lisp_Object tem; + tem = Fstring_equal (XCAR (XCAR (names)), name); + if (!NILP (tem)) + return dpyinfo; + } + + error ("Emacs for OpenStep does not yet support multi-display."); + + Fns_open_connection (name, Qnil, Qnil); + dpyinfo = ns_display_list; + + if (dpyinfo == 0) + error ("OpenStep on %s not responding.\n", XSTRING (name)->data); + + return dpyinfo; +} + + +static Lisp_Object +interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old) +/* -------------------------------------------------------------------------- + Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side + -------------------------------------------------------------------------- */ +{ + int i, count; + id<NSMenuItem> item; + const char *name; + Lisp_Object nameStr; + unsigned short key; + NSString *keys; + Lisp_Object res; + + count = [menu numberOfItems]; + for (i = 0; i<count; i++) + { + item = [menu itemAtIndex: i]; + name = [[item title] UTF8String]; + if (!name) continue; + + nameStr = build_string (name); + + if ([item hasSubmenu]) + { + old = interpret_services_menu ([item submenu], + Fcons (nameStr, prefix), old); + } + else + { + keys = [item keyEquivalent]; + if (keys && [keys length] ) + { + key = [keys characterAtIndex: 0]; + res = make_number (key|super_modifier); + } + else + { + res = Qundefined; + } + old = Fcons (Fcons (res, + Freverse (Fcons (nameStr, + prefix))), + old); + } + } + return old; +} + + + +/* ========================================================================== + + Frame parameter setters + + ========================================================================== */ + + +static void +ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + NSColor *col; + + if (ns_lisp_to_color (arg, &col)) + { + store_frame_param (f, Qforeground_color, oldval); + error ("Unknown color"); + } + + [col retain]; + [f->output_data.ns->foreground_color release]; + f->output_data.ns->foreground_color = col; + + if (FRAME_NS_VIEW (f)) + { + update_face_from_frame_parameter (f, Qforeground_color, arg); + /*recompute_basic_faces (f); */ + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + + +static void +ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct face *face; + NSColor *col; + NSView *view = FRAME_NS_VIEW (f); + float alpha; + + if (ns_lisp_to_color (arg, &col)) + { + store_frame_param (f, Qbackground_color, oldval); + error ("Unknown color"); + } + + /* clear the frame; in some instances the NS-internal GC appears not to + update, or it does update and cannot clear old text properly */ + if (FRAME_VISIBLE_P (f)) + ns_clear_frame (f); + + [col retain]; + [f->output_data.ns->background_color release]; + f->output_data.ns->background_color = col; + if (view != nil) + { + [[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 + [[view window] setOpaque: YES]; + + face = FRAME_DEFAULT_FACE (f); + if (face) + { + col = NS_FACE_BACKGROUND (face); + face->background = + (EMACS_UINT) [[col colorWithAlphaComponent: alpha] retain]; + [col release]; + + update_face_from_frame_parameter (f, Qbackground_color, arg); + } + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + + +static void +ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + NSColor *col; + + if (ns_lisp_to_color (arg, &col)) + { + store_frame_param (f, Qcursor_color, oldval); + error ("Unknown color"); + } + + [f->output_data.ns->desired_cursor_color release]; + f->output_data.ns->desired_cursor_color = [col retain]; + + if (FRAME_VISIBLE_P (f)) + { + x_update_cursor (f, 0); + x_update_cursor (f, 1); + } + update_face_from_frame_parameter (f, Qcursor_color, arg); +} + + +static void +ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + NSView *view = FRAME_NS_VIEW (f); + NSTRACE (ns_set_icon_name); + + if (ns_in_resize) + return; + + /* see if it's changed */ + if (STRINGP (arg)) + { + if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + return; + } + else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) + return; + + f->icon_name = arg; + + if (NILP (arg)) + { + if (!NILP (f->title)) + arg = f->title; + else + /* explicit name and no icon-name -> explicit_name */ + if (f->explicit_name) + arg = f->name; + else + { + /* no explicit name and no icon-name -> + name has to be rebuild from icon_title_format */ + windows_or_buffers_changed++; + return; + } + } + + /* Don't change the name if it's already NAME. */ + if ([[view window] miniwindowTitle] && + ([[[view window] miniwindowTitle] + isEqualToString: [NSString stringWithUTF8String: + XSTRING (arg)->data]])) + return; + + [[view window] setMiniwindowTitle: + [NSString stringWithUTF8String: XSTRING (arg)->data]]; +} + + +static void +ns_set_name_iconic (struct frame *f, Lisp_Object name, int explicit) +{ + NSView *view = FRAME_NS_VIEW (f); + NSTRACE (ns_set_name_iconic); + + if (ns_in_resize) + return; + + /* Make sure that requests from lisp code override requests from + Emacs redisplay code. */ + if (explicit) + { + /* If we're switching from explicit to implicit, we had better + update the mode lines and thereby update the title. */ + if (f->explicit_name && NILP (name)) + update_mode_lines = 1; + + f->explicit_name = ! NILP (name); + } + else if (f->explicit_name) + name = f->name; + + /* title overrides explicit name */ + if (! NILP (f->title)) + name = f->title; + + /* icon_name overrides title and explicit name */ + if (! NILP (f->icon_name)) + name = f->icon_name; + + if (NILP (name)) + name = build_string + ([[[NSProcessInfo processInfo] processName] UTF8String]); + else + CHECK_STRING (name); + + /* Don't change the name if it's already NAME. */ + if ([[view window] miniwindowTitle] && + ([[[view window] miniwindowTitle] + isEqualToString: [NSString stringWithUTF8String: + XSTRING (name)->data]])) + return; + + [[view window] setMiniwindowTitle: + [NSString stringWithUTF8String: XSTRING (name)->data]]; +} + + +static void +ns_set_name (struct frame *f, Lisp_Object name, int explicit) +{ + NSView *view = FRAME_NS_VIEW (f); + NSTRACE (ns_set_name); + + if (ns_in_resize) + return; + + /* Make sure that requests from lisp code override requests from + Emacs redisplay code. */ + if (explicit) + { + /* If we're switching from explicit to implicit, we had better + update the mode lines and thereby update the title. */ + if (f->explicit_name && NILP (name)) + update_mode_lines = 1; + + f->explicit_name = ! NILP (name); + } + else if (f->explicit_name) + return; + + if (NILP (name)) + name = build_string + ([[[NSProcessInfo processInfo] processName] UTF8String]); + + f->name = name; + + /* title overrides explicit name */ + if (! NILP (f->title)) + name = f->title; + + CHECK_STRING (name); + + /* Don't change the name if it's already NAME. */ + if ([[[view window] title] + isEqualToString: [NSString stringWithUTF8String: + XSTRING (name)->data]]) + return; + [[view window] setTitle: [NSString stringWithUTF8String: + XSTRING (name)->data]]; +} + + +/* This function should be called when the user's lisp code has + 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) +{ + NSTRACE (ns_explicitly_set_name); + ns_set_name_iconic (f, arg, 1); + ns_set_name (f, arg, 1); +} + + +/* This function should be called by Emacs redisplay code to set the + name; names set this way will never override names set by the user's + lisp code. */ +void +x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval) +{ + NSTRACE (x_implicitly_set_name); + if (FRAME_ICONIFIED_P (f)) + ns_set_name_iconic (f, arg, 0); + else + ns_set_name (f, arg, 0); +} + + +/* Change the title of frame F to NAME. + If NAME is nil, use the frame name as the title. + + If EXPLICIT is non-zero, that indicates that lisp code is setting the + name; if NAME is a string, set F's name to NAME and set + F->explicit_name; if NAME is Qnil, then clear F->explicit_name. + + If EXPLICIT is zero, that indicates that Emacs redisplay code is + 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) +{ + NSTRACE (ns_set_title); + /* Don't change the title if it's already NAME. */ + if (EQ (name, f->title)) + return; + + update_mode_lines = 1; + + f->title = name; +} + + +void +ns_set_name_as_filename (struct frame *f) +{ + NSView *view = FRAME_NS_VIEW (f); + Lisp_Object name; + Lisp_Object buf = XWINDOW (f->selected_window)->buffer; + const char *title; + NSAutoreleasePool *pool; + NSTRACE (ns_set_name_as_filename); + + if (f->explicit_name || ! NILP (f->title) || ns_in_resize) + return; + + BLOCK_INPUT; + pool = [[NSAutoreleasePool alloc] init]; + 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]); + else + CHECK_STRING (name); + + title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String] + : [[[view window] title] UTF8String]; + + if (title && (! strcmp (title, XSTRING (name)->data))) + { + [pool release]; + UNBLOCK_INPUT; + return; + } + + if (! FRAME_ICONIFIED_P (f)) + { +#ifdef NS_IMPL_COCOA + /* work around a bug observed on 10.3 where + setTitleWithRepresentedFilename does not clear out previous state + if given filename does not exist */ + NSString *str = [NSString stringWithUTF8String: XSTRING (name)->data]; + if (![[NSFileManager defaultManager] fileExistsAtPath: str]) + { + [[view window] setTitleWithRepresentedFilename: @""]; + [[view window] setTitle: str]; + } + else + { + [[view window] setTitleWithRepresentedFilename: str]; + } +#else + [[view window] setTitleWithRepresentedFilename: + [NSString stringWithUTF8String: XSTRING (name)->data]]; +#endif + f->name = name; + } + else + { + [[view window] setMiniwindowTitle: + [NSString stringWithUTF8String: XSTRING (name)->data]]; + } + [pool release]; + UNBLOCK_INPUT; +} + + +void +ns_set_doc_edited (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + NSView *view = FRAME_NS_VIEW (f); + NSAutoreleasePool *pool; + 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) +{ + int nlines; + int olines = FRAME_MENU_BAR_LINES (f); + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + if (INTEGERP (value)) + nlines = XINT (value); + else + nlines = 0; + + FRAME_MENU_BAR_LINES (f) = 0; + if (nlines) + { + FRAME_EXTERNAL_MENU_BAR (f) = 1; +/* 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]; */ + FRAME_EXTERNAL_MENU_BAR (f) = 0; + } +} + + +/* 23: PENDING: there is an erroneous direct call in window.c to this fn */ +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) +{ + int nlines; + Lisp_Object root_window; + + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + if (INTEGERP (value) && XINT (value) >= 0) + nlines = XFASTINT (value); + else + nlines = 0; + + if (nlines) + { + FRAME_EXTERNAL_TOOL_BAR (f) = 1; + update_frame_tool_bar (f); + } + else + { + if (FRAME_EXTERNAL_TOOL_BAR (f)) + { + free_frame_tool_bar (f); + FRAME_EXTERNAL_TOOL_BAR (f) = 0; + } + } + + x_set_window_size (f, 0, f->text_cols, f->text_lines); +} + + +/* 23: PENDING: 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) +{ + Lisp_Object tem; + EmacsView *view = FRAME_NS_VIEW (f); + id image =nil; + Lisp_Object chain, elt; + NSAutoreleasePool *pool; + BOOL setMini = YES; + + NSTRACE (ns_implicitly_set_icon_type); + + BLOCK_INPUT; + pool = [[NSAutoreleasePool alloc] init]; + if (f->output_data.ns->miniimage + && [[NSString stringWithUTF8String: XSTRING (f->name)->data] + isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]]) + { + [pool release]; + UNBLOCK_INPUT; + return; + } + + tem = assq_no_quit (Qicon_type, f->param_alist); + if (CONSP (tem) && ! NILP (XCDR (tem))) + { + [pool release]; + UNBLOCK_INPUT; + return; + } + + for (chain = Vns_icon_type_alist; + (image = nil) && CONSP (chain); + chain = XCDR (chain)) + { + elt = XCAR (chain); + /* special case: 't' means go by file type */ + if (SYMBOLP (elt) && elt == Qt && XSTRING (f->name)->data[0] == '/') + { + NSString *str = + [NSString stringWithUTF8String: XSTRING (f->name)->data]; + if ([[NSFileManager defaultManager] fileExistsAtPath: str]) + image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain]; + } + else if (CONSP (elt) && + STRINGP (XCAR (elt)) && + STRINGP (XCDR (elt)) && + fast_string_match (XCAR (elt), f->name) >= 0) + { + image = [EmacsImage allocInitFromFile: XCDR (elt)]; + if (image == nil) + image = [[NSImage imageNamed: + [NSString stringWithUTF8String: + XSTRING (XCDR (elt))->data]] retain]; + } + } + + if (image == nil) + { + image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain]; + setMini = NO; + } + + [f->output_data.ns->miniimage release]; + f->output_data.ns->miniimage = image; + [view setMiniwindowImage: setMini]; + [pool release]; + UNBLOCK_INPUT; +} + + +static void +ns_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); + + if (!NILP (arg) && SYMBOLP (arg)) + { + arg =build_string (XSTRING (XSYMBOL (arg)->xname)->data); + store_frame_param (f, Qicon_type, arg); + } + + /* do it the implicit way */ + if (NILP (arg)) + { + ns_implicitly_set_icon_type (f); + return; + } + + CHECK_STRING (arg); + + image = [EmacsImage allocInitFromFile: arg]; + if (image == nil) + image =[NSImage imageNamed: [NSString stringWithUTF8String: + XSTRING (arg)->data]]; + + if (image == nil) + { + image = [NSImage imageNamed: @"text"]; + setMini = NO; + } + + f->output_data.ns->miniimage = image; + [view setMiniwindowImage: setMini]; +} + + +/* 23: added 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) +{ + message1 ("Warning: XParseGeometry not supported under NS.\n"); + return 0; +} + + +/*PENDING: move to nsterm? */ +int +ns_lisp_to_cursor_type (Lisp_Object arg) +{ + char *str; + if (XTYPE (arg) == Lisp_String) + str =XSTRING (arg)->data; + else if (XTYPE (arg) == Lisp_Symbol) + str =XSTRING (XSYMBOL (arg)->xname)->data; + 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; + return -1; +} + + +Lisp_Object +ns_cursor_type_to_lisp (int arg) +{ + 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"); + } +} + + +static void +ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + int val; + + 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++; +} + + +/* 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) +{ + /* don't think we can do this on NS */ +} + + +static void +ns_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, + depending on the window manager used. Note, this is not a standard + frame parameter-setter; it is called directly from x-create-frame. + -------------------------------------------------------------------------- */ +{ + Lisp_Object icon_x, icon_y; + struct ns_display_info *dpyinfo = check_ns_display_info (Qnil); + + f->output_data.ns->icon_top = Qnil; + f->output_data.ns->icon_left = Qnil; + + /* Set the position of the icon. */ + icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); + icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); + if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) + { + CHECK_NUMBER (icon_x); + CHECK_NUMBER (icon_y); + f->output_data.ns->icon_top = icon_y; + f->output_data.ns->icon_left = icon_x; + } + else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) + error ("Both left and top icon corners of icon must be specified"); +} + + +/* 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 */ +frame_parm_handler ns_frame_parm_handlers[] = +{ + x_set_autoraise, /* generic OK */ + x_set_autolower, /* generic OK */ + ns_set_background_color, + 0, /* x_set_border_color, may be impossible under NS */ + 0, /* x_set_border_width, may be impossible under NS */ + ns_set_cursor_color, + ns_set_cursor_type, + x_set_font, /* generic OK */ + ns_set_foreground_color, + ns_set_icon_name, + ns_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_scroll_bar_width, /* generic OK */ + ns_set_title, + x_set_unsplittable, /* generic OK */ + x_set_vertical_scroll_bars, /* generic OK */ + x_set_visibility, /* generic OK */ + ns_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_line_spacing, /* generic OK, sets f->extra_line_spacing to int */ + x_set_fringe_width, /* 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 */ +}; + + +DEFUN ("x-create-frame", Fns_create_frame, Sns_create_frame, + 1, 1, 0, + "Make a new NS window, which is called a \"frame\" in Emacs terms.\n\ +Return an Emacs frame object representing the X window.\n\ +ALIST is an alist of frame parameters.\n\ +If the parameters specify that the frame should not have a minibuffer,\n\ +and do not specify a specific minibuffer window to use,\n\ +then `default-minibuffer-frame' must be a frame whose minibuffer can\n\ +be shared by the new frame.") + (parms) + Lisp_Object parms; +{ + static int desc_ctr = 1; + struct frame *f; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + Lisp_Object frame, tem; + Lisp_Object name; + int minibuffer_only = 0; + int count = specpdl_ptr - specpdl; + Lisp_Object display; + struct ns_display_info *dpyinfo = NULL; + Lisp_Object parent; + struct kboard *kb; + Lisp_Object tfont, tfontsize; + int window_prompting = 0; + int width, height; + + check_ns (); + + display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING); + if (EQ (display, Qunbound)) + display = Qnil; + dpyinfo = check_ns_display_info (display); + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + kb = dpyinfo->terminal->kboard; + + name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING); + if (!STRINGP (name) + && ! EQ (name, Qunbound) + && ! NILP (name)) + error ("Invalid frame name--not a string or nil"); + + if (STRINGP (name)) + Vx_resource_name = name; + + parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER); + if (EQ (parent, Qunbound)) + parent = Qnil; + if (! NILP (parent)) + CHECK_NUMBER (parent); + + frame = Qnil; + GCPRO4 (parms, parent, name, frame); + + tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", + RES_TYPE_SYMBOL); + if (EQ (tem, Qnone) || NILP (tem)) + { + f = make_frame_without_minibuffer (Qnil, kb, display); + } + else if (EQ (tem, Qonly)) + { + f = make_minibuffer_frame (); + minibuffer_only = 1; + } + else if (WINDOWP (tem)) + { + f = make_frame_without_minibuffer (tem, kb, display); + } + else + { + f = make_frame (1); + } + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name) || (XTYPE (name) != Lisp_String)) + { + f->name = + build_string ([[[NSProcessInfo processInfo] processName] UTF8String]); + f->explicit_name =0; + } + else + { + f->name = name; + f->explicit_name = 1; + specbind (Qx_resource_name, name); + } + + XSETFRAME (frame, f); + FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; + + f->terminal = dpyinfo->terminal; + f->terminal->reference_count++; + + 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))); + + FRAME_FONTSET (f) = -1; + + /* record_unwind_protect (unwind_create_frame, frame); safety; maybe later? */ + + 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)) + f->icon_name = Qnil; + + FRAME_NS_DISPLAY_INFO (f) = dpyinfo; + + f->output_data.ns->window_desc = desc_ctr++; + if (!NILP (parent)) + { + f->output_data.ns->parent_desc = (Window) XFASTINT (parent); + f->output_data.ns->explicit_parent = 1; + } + else + { + f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window; + f->output_data.ns->explicit_parent = 0; + } + + f->resx = dpyinfo->resx; + f->resy = dpyinfo->resy; + + BLOCK_INPUT; + register_font_driver (&nsfont_driver, f); + x_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + { + /* use for default font name */ + id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ + tfontsize = x_default_parameter (f, parms, Qfontsize, + make_number (0 /*(int)[font pointSize]*/), + "fontSize", "FontSize", RES_TYPE_NUMBER); + tfont = x_default_parameter (f, parms, Qfont, + build_string ([[font fontName] UTF8String]), + "font", "Font", RES_TYPE_STRING); + } + UNBLOCK_INPUT; + + x_default_parameter (f, parms, Qborder_width, make_number (0), + "borderwidth", "BorderWidth", RES_TYPE_NUMBER); + x_default_parameter (f, parms, Qinternal_border_width, make_number (2), + "internalBorderWidth", "InternalBorderWidth", + RES_TYPE_NUMBER); + + /* default scrollbars on right on Mac */ + { + Lisp_Object spos = +#ifdef NS_IMPL_GNUSTEP + Qt; +#else + Qright; +#endif + x_default_parameter (f, parms, Qvertical_scroll_bars, spos, + "verticalScrollBars", "VerticalScrollBars", + RES_TYPE_SYMBOL); + } + x_default_parameter (f, parms, Qforeground_color, build_string ("Black"), + "foreground", "Foreground", RES_TYPE_STRING); + x_default_parameter (f, parms, Qbackground_color, build_string ("White"), + "background", "Background", RES_TYPE_STRING); + x_default_parameter (f, parms, Qcursor_color, build_string ("grey"), + "cursorColor", "CursorColor", RES_TYPE_STRING); + /*PENDING: not suppported yet in NS */ + x_default_parameter (f, parms, Qline_spacing, Qnil, + "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); + x_default_parameter (f, parms, Qleft_fringe, Qnil, + "leftFringe", "LeftFringe", RES_TYPE_NUMBER); + x_default_parameter (f, parms, Qright_fringe, Qnil, + "rightFringe", "RightFringe", RES_TYPE_NUMBER); + /* end PENDING */ + + 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); + x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", + "BufferPredicate", RES_TYPE_SYMBOL); + x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title", + RES_TYPE_STRING); + +/*PENDING: other terms seem to get away w/o this complexity.. */ + if (NILP (Fassq (Qwidth, parms))) + { + Lisp_Object value = + x_get_arg (dpyinfo, parms, Qwidth, "width", "Width", RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qwidth, value), parms); + } + if (NILP (Fassq (Qheight, parms))) + { + Lisp_Object value = + x_get_arg (dpyinfo, parms, Qheight, "height", "Height", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qheight, value), parms); + } + if (NILP (Fassq (Qleft, parms))) + { + Lisp_Object value = + x_get_arg (dpyinfo, parms, Qleft, "left", "Left", RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qleft, value), parms); + } + if (NILP (Fassq (Qtop, parms))) + { + Lisp_Object value = + x_get_arg (dpyinfo, parms, Qtop, "top", "Top", RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qtop, value), parms); + } + + window_prompting = x_figure_window_size (f, parms, 1); + + tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN); + f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil)); + + /* NOTE: on other terms, this is done in set_mouse_color, however this + was not getting called under NS */ + f->output_data.ns->text_cursor = [NSCursor IBeamCursor]; + f->output_data.ns->nontext_cursor = [NSCursor arrowCursor]; + f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor]; + f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor]; + f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor]; + f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor]; + FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor = + [NSCursor arrowCursor]; + f->output_data.ns->current_pointer = f->output_data.ns->text_cursor; + + [[EmacsView alloc] initFrameFromEmacs: f]; + + ns_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", + 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); + + width = FRAME_COLS (f); + height = FRAME_LINES (f); + + SET_FRAME_COLS (f, 0); + FRAME_LINES (f) = 0; + change_frame_size (f, height, width, 1, 0, 0); + + 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]; + } + + if (FRAME_HAS_MINIBUF_P (f) + && (!FRAMEP (kb->Vdefault_minibuffer_frame) + || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) + kb->Vdefault_minibuffer_frame = frame; + + /* All remaining specified parameters, which have not been "used" + by x_get_arg and friends, now go in the misc. alist of the frame. */ + for (tem = parms; CONSP (tem); tem = XCDR (tem)) + if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) + f->param_alist = Fcons (XCAR (tem), f->param_alist); + + UNGCPRO; + Vwindow_list = Qnil; + + return unbind_to (count, frame); +} + + +/* ========================================================================== + + Lisp definitions + + ========================================================================== */ + +DEFUN ("ns-focus-frame", Fns_focus_frame, Sns_focus_frame, 1, 1, 0, + doc: /* Set the input focus to FRAME. +FRAME nil means use the selected frame. */) + (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) + { + EmacsView *view = FRAME_NS_VIEW (f); + BLOCK_INPUT; + [[view window] makeKeyAndOrderFront: view]; + UNBLOCK_INPUT; + } + + return Qnil; +} + + +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; +{ + id fm; + struct frame *f; + + check_ns (); + fm = [NSFontManager new]; + if (NILP (frame)) + f = SELECTED_FRAME (); + else + { + CHECK_FRAME (frame); + f = XFRAME (frame); + } + + [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont + isMultiple: NO]; + [fm orderFrontFontPanel: NSApp]; + return Qnil; +} + + +DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, + 0, 1, "", "Pop up the color panel.") + (frame) + Lisp_Object frame; +{ + struct frame *f; + + check_ns (); + if (NILP (frame)) + f = SELECTED_FRAME (); + else + { + CHECK_FRAME (frame); + f = XFRAME (frame); + } + + [NSApp orderFrontColorPanel: NSApp]; + return Qnil; +} + + +DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0, + "As read-file-name except that NS panels are used for querying, and\n\ +args are slightly different. Nil returned if no selection made.\n\ +Set ISLOAD non-nil if file being read for a save.") + (prompt, dir, isLoad, init) + Lisp_Object prompt, dir, isLoad, init; +{ + static id fileDelegate = nil; + int ret; + id panel; + NSString *fname; + + NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : + [NSString stringWithUTF8String: XSTRING (prompt)->data]; + NSString *dirS = NILP (dir) || !STRINGP (dir) ? + [NSString stringWithUTF8String: XSTRING (current_buffer->directory)->data] : + [NSString stringWithUTF8String: XSTRING (dir)->data]; + NSString *initS = NILP (init) || !STRINGP (init) ? nil : + [NSString stringWithUTF8String: XSTRING (init)->data]; + + check_ns (); + + if (fileDelegate == nil) + fileDelegate = [EmacsFileDelegate new]; + + [NSCursor setHiddenUntilMouseMoves: NO]; + + if ([dirS characterAtIndex: 0] == '~') + dirS = [dirS stringByExpandingTildeInPath]; + + panel = NILP (isLoad) ? + [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel]; + + [panel setTitle: promptS]; + + /* Puma (10.1) does not have */ + if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)]) + [panel setAllowsOtherFileTypes: YES]; + + [panel setTreatsFilePackagesAsDirectories: YES]; + [panel setDelegate: fileDelegate]; + + panelOK = 0; + if (NILP (isLoad)) + { + ret = [panel runModalForDirectory: dirS file: initS]; + } + else + { + [panel setCanChooseDirectories: YES]; + ret = [panel runModalForDirectory: dirS file: initS types: nil]; + } + + ret = (ret = NSOKButton) || panelOK; + + fname = [panel filename]; + + [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; + + return ret ? build_string ([fname UTF8String]) : 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.\n\ +If OWNER is nil, Emacs is assumed.") + (owner, name) + Lisp_Object owner, name; +{ + const char *value; + + check_ns (); + if (NILP (owner)) + owner = build_string + ([[[NSProcessInfo processInfo] processName] UTF8String]); + /* CHECK_STRING (owner); this should be just "Emacs" */ + CHECK_STRING (name); +/*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */ + + value =[[[NSUserDefaults standardUserDefaults] + objectForKey: [NSString stringWithUTF8String: XSTRING (name)->data]] + UTF8String]; + + if (value) + return build_string (value); +/*fprintf (stderr, "Nothing found for NS resource '%s'.\n", XSTRING (name)->data); */ + return Qnil; +} + + +DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0, + "Set property NAME of OWNER to VALUE, from the defaults database.\n\ +If OWNER is nil, Emacs is assumed.\n\ +If VALUE is nil, the default is removed.") + (owner, name, value) + Lisp_Object owner, name, value; +{ + check_ns (); + if (NILP (owner)) + owner = + build_string ([[[NSProcessInfo processInfo] processName] UTF8String]); + CHECK_STRING (owner); + CHECK_STRING (name); + if (NILP (value)) + { + [[NSUserDefaults standardUserDefaults] removeObjectForKey: + [NSString stringWithUTF8String: XSTRING (name)->data]]; + } + else + { + CHECK_STRING (value); + [[NSUserDefaults standardUserDefaults] setObject: + [NSString stringWithUTF8String: XSTRING (value)->data] + forKey: [NSString stringWithUTF8String: + XSTRING (name)->data]]; + } + + return Qnil; +} + + +DEFUN ("ns-set-alpha", Fns_set_alpha, Sns_set_alpha, 2, 2, 0, + "Return a color same as given with alpha set to given value\n\ +from 0 to 1, where 1 is fully 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, + 0, 1, 0, + "This function is only present for completeness. It does not return\n\ +a usable result for NS windows.") + (display) + Lisp_Object display; +{ + check_ns (); + /* This function has no real equivalent under NeXTstep. Return nil to + indicate this. */ + return Qnil; +} + + +DEFUN ("ns-server-vendor", Fns_server_vendor, Sns_server_vendor, 0, 1, 0, + "Returns the vendor ID string of the NS server of display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame or a display name (a string).\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + check_ns (); +#ifdef NS_IMPL_GNUSTEP + return build_string ("GNU"); +#else + return build_string ("Apple"); +#endif +} + + +DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0, + "Returns the version number of the NS release of display DISPLAY.\n\ +See also the function `ns-server-vendor'.\n\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame or a display name (a string).\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + /*PENDING: return GUI version on GNUSTEP, ?? on OS X */ + return build_string ("1.0"); +} + + +DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0, + "Returns the number of screens on the NS server of display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + int num; + + check_ns (); + num = [[NSScreen screens] count]; + + return (num != 0) ? make_number (num) : Qnil; +} + + +DEFUN ("ns-display-mm-height", Fns_display_mm_height, Sns_display_mm_height, + 0, 1, 0, + "Returns the height in millimeters of the NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + check_ns (); + return make_number ((int) + ([ns_get_screen (display) frame].size.height/(92.0/25.4))); +} + + +DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width, + 0, 1, 0, + "Returns the width in millimeters of the NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + check_ns (); + return make_number ((int) + ([ns_get_screen (display) frame].size.width/(92.0/25.4))); +} + + +DEFUN ("ns-display-backing-store", Fns_display_backing_store, + Sns_display_backing_store, 0, 1, 0, + "Returns an indication of whether NS display DISPLAY does backing store.\n\ +The value may be `buffered', `retained', or `non-retained'.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.\n\ +Under NS, this may differ for each frame.") + (display) + Lisp_Object display; +{ + check_ns (); + switch ([ns_get_window (display) backingType]) + { + case NSBackingStoreBuffered: + return intern ("buffered"); + case NSBackingStoreRetained: + return intern ("retained"); + case NSBackingStoreNonretained: + return intern ("non-retained"); + default: + error ("Strange value for backingType parameter of frame"); + } + return Qnil; /* not reached, shut compiler up */ +} + + +DEFUN ("ns-display-visual-class", Fns_display_visual_class, + Sns_display_visual_class, 0, 1, 0, + "Returns the visual class of the NS display DISPLAY.\n\ +The value is one of the symbols `static-gray', `gray-scale',\n\ +`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + NSWindowDepth depth; + check_ns (); + depth = [ns_get_screen (display) depth]; + + if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL)) + return intern ("static-gray"); + else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL)) + return intern ("gray-scale"); + else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL)) + return intern ("pseudo-color"); + else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL)) + return intern ("true-color"); + else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL)) + return intern ("direct-color"); + else + /* color mgmt as far as we do it is really handled by NS itself anyway */ + return intern ("direct-color"); +} + + +DEFUN ("ns-display-save-under", Fns_display_save_under, + Sns_display_save_under, 0, 1, 0, + "Returns t if the NS display DISPLAY supports the save-under feature.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.\n\ +Under NS, this may differ for each frame.") + (display) + Lisp_Object display; +{ + check_ns (); + switch ([ns_get_window (display) backingType]) + { + case NSBackingStoreBuffered: + return Qt; + + case NSBackingStoreRetained: + case NSBackingStoreNonretained: + return Qnil; + + default: + error ("Strange value for backingType parameter of frame"); + } + return Qnil; /* not reached, shut compiler up */ +} + + +DEFUN ("ns-open-connection", Fns_open_connection, Sns_open_connection, + 1, 3, 0, "Open a connection to a NS server.\n\ +DISPLAY is the name of the display to connect to.\n\ +Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored.") + (display, resource_string, must_succeed) + Lisp_Object display, resource_string, must_succeed; +{ + struct ns_display_info *dpyinfo; + + CHECK_STRING (display); + + nxatoms_of_nsselect (); + dpyinfo = ns_term_init (display); + if (dpyinfo == 0) + { + if (!NILP (must_succeed)) + fatal ("OpenStep on %s not responding.\n", + XSTRING (display)->data); + else + error ("OpenStep on %s not responding.\n", + XSTRING (display)->data); + } + + /* Register our external input/output types, used for determining + applicable services and also drag/drop eligibility. */ + ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain]; + ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain]; + ns_drag_types = [[NSArray arrayWithObjects: + NSStringPboardType, + NSTabularTextPboardType, + NSFilenamesPboardType, + NSURLPboardType, + NSColorPboardType, + NSFontPboardType, nil] retain]; + + return Qnil; +} + + +DEFUN ("ns-close-connection", Fns_close_connection, Sns_close_connection, + 1, 1, 0, "Close the connection to the current NS server.\n\ +The second argument DISPLAY is currently ignored, but nil would stand for\n\ +the selected frame's display.") + (display) + 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.") + () +{ + Lisp_Object tail, result; + + result = Qnil; + for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail)) + result = Fcons (XCAR (XCAR (tail)), result); + + return result; +} + + +DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others, + 0, 0, 0, "Hides all applications other than emacs.") + () +{ + check_ns (); + [NSApp hideOtherApplications: NSApp]; + return Qnil; +} + +DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs, + 1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.\n\ +Otherwise if emacs is hidden, it is unhidden.\n\ +If ON is equal to 'activate, emacs is unhidden and becomes\n\ +the active application.") + (on) + Lisp_Object on; +{ + check_ns (); + if (EQ (on, intern ("activate"))) + { + [NSApp unhide: NSApp]; + [NSApp activateIgnoringOtherApps: YES]; + } + else if (NILP (on)) + [NSApp unhide: NSApp]; + else + [NSApp hide: NSApp]; + return Qnil; +} + + +DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel, + 0, 0, 0, "Shows the 'Info' or 'About' panel for Emacs.") + () +{ + check_ns (); + [NSApp orderFrontStandardAboutPanel: nil]; + return Qnil; +} + + +DEFUN ("x-list-fonts", Fns_list_fonts, Sns_list_fonts, 1, 4, 0, + "Return a list of the names of available fonts matching PATTERN.\n\ +If optional arguments FACE and FRAME are specified, return only fonts\n\ +the same size as FACE on FRAME.\n\ +If optional argument MAX is specified, return at most MAX matches.\n\ +\n\ +PATTERN is a regular expression; FACE is a face name - a symbol.\n\ +\n\ +The return value is a list of strings, suitable as arguments to\n\ +set-face-font.\n\ +\n\ +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 (XSTRING (fname)->data)), + olist); + } + + return olist; +} + + +DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0, + "Determine font postscript or family name from a font name string or\n\ +XLFD string. If string contains fontset' and not 'fontset-startup' it is\n\ +left alone.") + (name) + Lisp_Object name; +{ + char *nm; + CHECK_STRING (name); + nm = SDATA (name); + + if (nm[0] != '-') + return name; + if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup")) + return name; + + return build_string (ns_xlfd_to_fontname (SDATA (name))); +} + + +DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0, + "Return a list of all available colors.\n\ +The optional argument FRAME is currently ignored.") + (frame) + Lisp_Object frame; +{ + Lisp_Object list = Qnil; + NSEnumerator *colorlists; + NSColorList *clist; + + if (!NILP (frame)) + { + CHECK_FRAME (frame); + if (! FRAME_NS_P (XFRAME (frame))) + error ("non-NS frame used in `ns-list-colors'"); + } + + BLOCK_INPUT; + + colorlists = [[NSColorList availableColorLists] objectEnumerator]; + while (clist = [colorlists nextObject]) + { + if ([[clist name] length] < 7 || + [[clist name] rangeOfString: @"PANTONE"].location == 0) + { + NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator]; + NSString *cname; + while (cname = [cnames nextObject]) + list = Fcons (build_string ([cname UTF8String]), list); +/* for (i = [[clist allKeys] count] - 1; i >= 0; i--) + list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i] + UTF8String]), list); */ + } + } + + UNBLOCK_INPUT; + + return list; +} + + +DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0, + "List NS services by querying NSApp.") + () +{ + Lisp_Object ret = Qnil; + NSMenu *svcs; + id delegate; + + check_ns (); + svcs = [[NSMenu alloc] initWithTitle: @"Services"]; + [NSApp setServicesMenu: svcs]; /* this and next rebuild on <10.4 */ + [NSApp registerServicesMenuSendTypes: ns_send_types + returnTypes: ns_return_types]; + +/* On Tiger, services menu updating was made lazier (waits for user to + actually click on the menu), so we have to force things along: */ +#ifdef NS_IMPL_COCOA + if (NSAppKitVersionNumber >= 744.0) + { + delegate = [svcs delegate]; + if (delegate != nil) + { + if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)]) + [delegate menuNeedsUpdate: svcs]; + if ([delegate respondsToSelector: + @selector (menu:updateItem:atIndex:shouldCancel:)]) + { + int i, len = [delegate numberOfItemsInMenu: svcs]; + for (i =0; i<len; i++) + [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""]; + for (i =0; i<len; i++) + if (![delegate menu: svcs + updateItem: (NSMenuItem *)[svcs itemAtIndex: i] + atIndex: i shouldCancel: NO]) + break; + } + } + } +#endif + + [svcs setAutoenablesItems: NO]; +#ifdef NS_IMPL_COCOA + [svcs update]; /* on OS X, converts from '/' structure */ +#endif + + ret = interpret_services_menu (svcs, Qnil, ret); + return ret; +} + + +DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service, + 2, 2, 0, "Perform NS SERVICE on SEND which is either a string or nil.\n\ +Returns result of service as string or nil if no result.") + (service, send) + Lisp_Object service, send; +{ + id pb; + NSString *svcName; + char *utfStr; + int len; + + CHECK_STRING (service); + check_ns (); + + utfStr = XSTRING (service)->data; + svcName = [NSString stringWithUTF8String: utfStr]; + + pb =[NSPasteboard pasteboardWithUniqueName]; + ns_string_to_pasteboard (pb, send); + + if (NSPerformService (svcName, pb) == NO) + Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil)); + + if ([[pb types] count] == 0) + return build_string (""); + return ns_string_from_pasteboard (pb); +} + + +DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc, + Sns_convert_utf8_nfd_to_nfc, 1, 1, 0, + "Composes character sequences in UTF-8 normal form NFD string STR to produce a normal (composed normal form NFC) string.") + (str) + Lisp_Object str; +{ + NSString *utfStr; + + CHECK_STRING (str); + utfStr = [[NSString stringWithUTF8String: XSTRING (str)->data] + precomposedStringWithCanonicalMapping]; + return build_string ([utfStr UTF8String]); +} + + +/* ========================================================================== + + Miscellaneous functions not called through hooks + + ========================================================================== */ + + +/* 23: call in image.c */ +FRAME_PTR +check_x_frame (Lisp_Object frame) +{ + return check_ns_frame (frame); +} + +/* 23: added, due to call in frame.c */ +struct ns_display_info * +check_x_display_info (Lisp_Object frame) +{ + return check_ns_display_info (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; +{ + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT; + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + + wid - 1) / wid; +} + + +/* 23: terms now impl this instead of x-get-resource directly */ +const char * +x_get_string_resource (XrmDatabase rdb, char *name, char *class) +{ + /* remove appname prefix; PENDING: allow for !="Emacs" */ + char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0); + 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); + +/*fprintf (stderr, "Checking '%s'\n", toCheck); */ + + res = [[[NSUserDefaults standardUserDefaults] objectForKey: + [NSString stringWithUTF8String: toCheck]] UTF8String]; + return !res ? NULL : + (!strncasecmp (res, "YES", 3) ? "true" : + (!strncasecmp (res, "NO", 2) ? "false" : res)); +} + + +Lisp_Object +x_get_focus_frame (struct frame *frame) +{ + struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame); + Lisp_Object nsfocus; + + if (!dpyinfo->ns_focus_frame) + return Qnil; + + XSETFRAME (nsfocus, dpyinfo->ns_focus_frame); + return nsfocus; +} + + +int +x_pixel_width (struct frame *f) +{ + return FRAME_PIXEL_WIDTH (f); +} + + +int +x_pixel_height (struct frame *f) +{ + return FRAME_PIXEL_HEIGHT (f); +} + + +int +x_char_width (struct frame *f) +{ + return FRAME_COLUMN_WIDTH (f); +} + + +int +x_char_height (struct frame *f) +{ + return FRAME_LINE_HEIGHT (f); +} + + +int +x_screen_planes (struct frame *f) +{ + return FRAME_NS_DISPLAY_INFO (f)->n_planes; +} + + +void +x_sync (Lisp_Object frame) +{ + /* XXX Not implemented XXX */ + return; +} + + + +/* ========================================================================== + + Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'. + + ========================================================================== */ + + +DEFUN ("xw-color-defined-p", Fns_color_defined_p, Sns_color_defined_p, 1, 2, 0, + "Return t if the current NS display supports the color named COLOR.\n\ +The optional argument FRAME is currently ignored.") + (color, frame) + Lisp_Object color, frame; +{ + NSColor * col; + check_ns (); + return ns_lisp_to_color (color, &col) ? Qnil : Qt; +} + + +DEFUN ("xw-color-values", Fns_color_values, Sns_color_values, 1, 2, 0, + "Return a description of the color named COLOR.\n\ +The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).\n\ +These values appear to range from 0 to 65280; white is (65280 65280 65280 0).\n\ +The optional argument FRAME is currently ignored.") + (color, frame) + Lisp_Object color, frame; +{ + NSColor * col; + float red, green, blue, alpha; + Lisp_Object rgba[4]; + + check_ns (); + CHECK_STRING (color); + + if (ns_lisp_to_color (color, &col)) + return Qnil; + + [[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); +} + + +DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, + "Return t if the NS display supports color.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + NSWindowDepth depth; + NSString *colorSpace; + check_ns (); + depth = [ns_get_screen (display) depth]; + colorSpace = NSColorSpaceFromDepth (depth); + + return [colorSpace isEqualToString: NSDeviceWhiteColorSpace] + || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace] + ? Qnil : Qt; +} + + +DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, + Sx_display_grayscale_p, 0, 1, 0, + "Return t if the NS display supports shades of gray.\n\ +Note that color displays do support shades of gray.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + NSWindowDepth depth; + check_ns (); + depth = [ns_get_screen (display) depth]; + + return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil; +} + + +DEFUN ("x-display-pixel-width", Fns_display_pixel_width, Sns_display_pixel_width, + 0, 1, 0, + "Returns the width in pixels of the NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (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 NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (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, + "Returns a list of integers in form (left top width height) describing the \ +usable screen area excluding reserved areas such as the Mac menu and doc, or \ +the Windows task bar.\n \ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + int top; + 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; + + return list4 (make_number ((int) vScreen.origin.x), + make_number (top), + make_number ((int) vScreen.size.width), + make_number ((int) vScreen.size.height)); +} + + +DEFUN ("x-display-planes", Fx_display_planes, Sns_display_planes, + 0, 1, 0, + "Returns the number of bitplanes of the NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + check_ns (); + return make_number + (NSBitsPerSampleFromDepth ([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 NS display DISPLAY.\n\ +The optional argument DISPLAY specifies which display to ask about.\n\ +DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\ +If omitted or nil, that stands for the selected frame's display.") + (display) + Lisp_Object display; +{ + check_ns (); + struct ns_display_info *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)); +} + + +/* Unused dummy def needed for compatibility. */ +Lisp_Object tip_frame; + +/*PENDING: 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; +{ + 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]; + + /* 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) + /* It fits to the right of the pointer. */ + *root_x = pt.x + XINT (dx); + else if (width + XINT (dx) <= pt.x) + /* It fits to the left of the pointer. */ + *root_x = pt.x - width - XINT (dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = 0; + + 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) + /* 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; +} + + +DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, + 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. + +PARMS is an optional list of frame parameters which can be used to +change the tooltip's appearance. + +Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil +means use the default timeout of 5 seconds. + +If the list of frame parameters PARMS contains a `left' parameter, +the tooltip is displayed at that x-position. Otherwise it is +displayed at the mouse position, with offset DX added (default is 5 if +DX isn't specified). Likewise for the y-position; if a `top' frame +parameter is specified, it determines the y-position of the tooltip +window, otherwise it is displayed at the mouse position, with offset +DY added (default is -10). + +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; +{ + int root_x, root_y; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + int count = SPECPDL_INDEX (); + struct frame *f; + char *str; + NSSize size; + + specbind (Qinhibit_redisplay, Qt); + + GCPRO4 (string, parms, frame, timeout); + + CHECK_STRING (string); + str = XSTRING (string)->data; + f = check_x_frame (frame); + if (NILP (timeout)) + timeout = make_number (5); + else + CHECK_NATNUM (timeout); + + if (NILP (dx)) + dx = make_number (5); + else + CHECK_NUMBER (dx); + + if (NILP (dy)) + dy = make_number (-10); + else + CHECK_NUMBER (dy); + + BLOCK_INPUT; + if (ns_tooltip == nil) + ns_tooltip = [[EmacsTooltip alloc] init]; + else + Fx_hide_tip (); + + [ns_tooltip setText: str]; + size = [ns_tooltip frame].size; + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height, + &root_x, &root_y); + + [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)]; + UNBLOCK_INPUT; + + UNGCPRO; + return unbind_to (count, Qnil); +} + + +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. */) + () +{ + if (ns_tooltip == nil || ![ns_tooltip isActive]) + return Qnil; + [ns_tooltip hide]; + return Qt; +} + + +/* ========================================================================== + + 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\n\ +frames. If the title of a frame matches REGEXP, then IMAGE.tiff is\n\ +selected as the image of the icon representing the frame when it's\n\ +miniaturized. If an element is t, then Emacs tries to select an icon\n\ +based on the filetype of the visited file.\n\ +\n\ +The images have to be installed in a folder called English.lproj in the\n\ +Emacs.app folder. You have to restart Emacs after installing new icons.\n\ +\n\ +Example: Install an icon Gnus.tiff and execute the following code\n\ +\n\ + (setq ns-icon-type-alist\n\ + (append ns-icon-type-alist\n\ + '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"\n\ + . \"Gnus\"))))\n\ +\n\ +When you miniaturize a Group, Summary or Article frame, Gnus.tiff will\n\ +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 + + ========================================================================== */ + + +@implementation EmacsSavePanel +#ifdef NS_IMPL_COCOA +/* -------------------------------------------------------------------------- + These are overridden to intercept on OS X: ending panel restarts NSApp + event loop if it is stopped. Not sure if this is correct behavior, + perhaps should check if running and if so send an appdefined. + -------------------------------------------------------------------------- */ +- (void) ok: (id)sender +{ + [super ok: sender]; + panelOK = 1; + [NSApp stop: self]; +} +- (void) cancel: (id)sender +{ + [super cancel: sender]; + [NSApp stop: self]; +} +#endif +@end + + +@implementation EmacsOpenPanel +#ifdef NS_IMPL_COCOA +/* -------------------------------------------------------------------------- + These are overridden to intercept on OS X: ending panel restarts NSApp + event loop if it is stopped. Not sure if this is correct behavior, + perhaps should check if running and if so send an appdefined. + -------------------------------------------------------------------------- */ +- (void) ok: (id)sender +{ + [super ok: sender]; + panelOK = 1; + [NSApp stop: self]; +} +- (void) cancel: (id)sender +{ + [super cancel: sender]; + [NSApp stop: self]; +} +#endif +@end + + +@implementation EmacsFileDelegate +/* -------------------------------------------------------------------------- + Delegate methods for Open/Save panels + -------------------------------------------------------------------------- */ +- (BOOL)panel: (id)sender isValidFilename: (NSString *)filename +{ + return YES; +} +- (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename +{ + return YES; +} +- (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename + confirmed: (BOOL)okFlag +{ + return filename; +} +@end + +#endif