Assume GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
[emacs.git] / src / nsfns.m
blob89b9f7c4b62244ba67122c4da0a03c13e11d8ac5
1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2015 Free Software
4 Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
22 Originally by Carl Edman
23 Updated by Christian Limpach (chris@nice.ch)
24 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
25 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
26 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
29 /* This should be the first include, as it may set up #defines affecting
30    interpretation of even the system includes. */
31 #include <config.h>
33 #include <math.h>
34 #include <c-strcase.h>
36 #include "lisp.h"
37 #include "blockinput.h"
38 #include "nsterm.h"
39 #include "window.h"
40 #include "character.h"
41 #include "buffer.h"
42 #include "keyboard.h"
43 #include "termhooks.h"
44 #include "fontset.h"
45 #include "font.h"
47 #ifdef NS_IMPL_COCOA
48 #include <IOKit/graphics/IOGraphicsLib.h>
49 #include "macfont.h"
50 #endif
52 #if 0
53 int fns_trace_num = 1;
54 #define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
55                                   __FILE__, __LINE__, ++fns_trace_num)
56 #else
57 #define NSTRACE(x)
58 #endif
60 #ifdef HAVE_NS
62 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
64 EmacsTooltip *ns_tooltip = nil;
66 /* Need forward declaration here to preserve organizational integrity of file */
67 Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
69 /* Static variables to handle applescript execution.  */
70 static Lisp_Object as_script, *as_result;
71 static int as_status;
73 static ptrdiff_t image_cache_refcount;
76 /* ==========================================================================
78     Internal utility functions
80    ========================================================================== */
82 /* Let the user specify a Nextstep display with a Lisp object.
83    OBJECT may be nil, a frame or a terminal object.
84    nil stands for the selected frame--or, if that is not a Nextstep frame,
85    the first Nextstep display on the list.  */
87 static struct ns_display_info *
88 check_ns_display_info (Lisp_Object object)
90   struct ns_display_info *dpyinfo = NULL;
92   if (NILP (object))
93     {
94       struct frame *sf = XFRAME (selected_frame);
96       if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
97         dpyinfo = FRAME_DISPLAY_INFO (sf);
98       else if (x_display_list != 0)
99         dpyinfo = x_display_list;
100       else
101         error ("Nextstep windows are not in use or not initialized");
102     }
103   else if (TERMINALP (object))
104     {
105       struct terminal *t = decode_live_terminal (object);
107       if (t->type != output_ns)
108         error ("Terminal %d is not a Nextstep display", t->id);
110       dpyinfo = t->display_info.ns;
111     }
112   else if (STRINGP (object))
113     dpyinfo = ns_display_info_for_name (object);
114   else
115     {
116       struct frame *f = decode_window_system_frame (object);
117       dpyinfo = FRAME_DISPLAY_INFO (f);
118     }
120   return dpyinfo;
124 static id
125 ns_get_window (Lisp_Object maybeFrame)
127   id view =nil, window =nil;
129   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
130     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
132   if (!NILP (maybeFrame))
133     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
134   if (view) window =[view window];
136   return window;
140 /* Return the X display structure for the display named NAME.
141    Open a new connection if necessary.  */
142 struct ns_display_info *
143 ns_display_info_for_name (Lisp_Object name)
145   struct ns_display_info *dpyinfo;
147   CHECK_STRING (name);
149   for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
150     if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
151       return dpyinfo;
153   error ("Emacs for Nextstep does not yet support multi-display");
155   Fx_open_connection (name, Qnil, Qnil);
156   dpyinfo = x_display_list;
158   if (dpyinfo == 0)
159     error ("Display on %s not responding.\n", SDATA (name));
161   return dpyinfo;
164 static NSString *
165 ns_filename_from_panel (NSSavePanel *panel)
167 #ifdef NS_IMPL_COCOA
168   NSURL *url = [panel URL];
169   NSString *str = [url path];
170   return str;
171 #else
172   return [panel filename];
173 #endif
176 static NSString *
177 ns_directory_from_panel (NSSavePanel *panel)
179 #ifdef NS_IMPL_COCOA
180   NSURL *url = [panel directoryURL];
181   NSString *str = [url path];
182   return str;
183 #else
184   return [panel directory];
185 #endif
188 static Lisp_Object
189 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
190 /* --------------------------------------------------------------------------
191    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
192    -------------------------------------------------------------------------- */
194   int i, count;
195   NSMenuItem *item;
196   const char *name;
197   Lisp_Object nameStr;
198   unsigned short key;
199   NSString *keys;
200   Lisp_Object res;
202   count = [menu numberOfItems];
203   for (i = 0; i<count; i++)
204     {
205       item = [menu itemAtIndex: i];
206       name = [[item title] UTF8String];
207       if (!name) continue;
209       nameStr = build_string (name);
211       if ([item hasSubmenu])
212         {
213           old = interpret_services_menu ([item submenu],
214                                         Fcons (nameStr, prefix), old);
215         }
216       else
217         {
218           keys = [item keyEquivalent];
219           if (keys && [keys length] )
220             {
221               key = [keys characterAtIndex: 0];
222               res = make_number (key|super_modifier);
223             }
224           else
225             {
226               res = Qundefined;
227             }
228           old = Fcons (Fcons (res,
229                             Freverse (Fcons (nameStr,
230                                            prefix))),
231                     old);
232         }
233     }
234   return old;
239 /* ==========================================================================
241     Frame parameter setters
243    ========================================================================== */
246 static void
247 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
249   NSColor *col;
250   EmacsCGFloat r, g, b, alpha;
252   /* Must block_input, because ns_lisp_to_color does block/unblock_input
253      which means that col may be deallocated in its unblock_input if there
254      is user input, unless we also block_input.  */
255   block_input ();
256   if (ns_lisp_to_color (arg, &col))
257     {
258       store_frame_param (f, Qforeground_color, oldval);
259       unblock_input ();
260       error ("Unknown color");
261     }
263   [col retain];
264   [f->output_data.ns->foreground_color release];
265   f->output_data.ns->foreground_color = col;
267   [col getRed: &r green: &g blue: &b alpha: &alpha];
268   FRAME_FOREGROUND_PIXEL (f) =
269     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
271   if (FRAME_NS_VIEW (f))
272     {
273       update_face_from_frame_parameter (f, Qforeground_color, arg);
274       /*recompute_basic_faces (f); */
275       if (FRAME_VISIBLE_P (f))
276         SET_FRAME_GARBAGED (f);
277     }
278   unblock_input ();
282 static void
283 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
285   struct face *face;
286   NSColor *col;
287   NSView *view = FRAME_NS_VIEW (f);
288   EmacsCGFloat r, g, b, alpha;
290   block_input ();
291   if (ns_lisp_to_color (arg, &col))
292     {
293       store_frame_param (f, Qbackground_color, oldval);
294       unblock_input ();
295       error ("Unknown color");
296     }
298   /* clear the frame; in some instances the NS-internal GC appears not to
299      update, or it does update and cannot clear old text properly */
300   if (FRAME_VISIBLE_P (f))
301     ns_clear_frame (f);
303   [col retain];
304   [f->output_data.ns->background_color release];
305   f->output_data.ns->background_color = col;
307   [col getRed: &r green: &g blue: &b alpha: &alpha];
308   FRAME_BACKGROUND_PIXEL (f) =
309     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
311   if (view != nil)
312     {
313       [[view window] setBackgroundColor: col];
315       if (alpha != (EmacsCGFloat) 1.0)
316           [[view window] setOpaque: NO];
317       else
318           [[view window] setOpaque: YES];
320       face = FRAME_DEFAULT_FACE (f);
321       if (face)
322         {
323           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
324           face->background = ns_index_color
325             ([col colorWithAlphaComponent: alpha], f);
327           update_face_from_frame_parameter (f, Qbackground_color, arg);
328         }
330       if (FRAME_VISIBLE_P (f))
331         SET_FRAME_GARBAGED (f);
332     }
333   unblock_input ();
337 static void
338 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
340   NSColor *col;
342   block_input ();
343   if (ns_lisp_to_color (arg, &col))
344     {
345       store_frame_param (f, Qcursor_color, oldval);
346       unblock_input ();
347       error ("Unknown color");
348     }
350   [FRAME_CURSOR_COLOR (f) release];
351   FRAME_CURSOR_COLOR (f) = [col retain];
353   if (FRAME_VISIBLE_P (f))
354     {
355       x_update_cursor (f, 0);
356       x_update_cursor (f, 1);
357     }
358   update_face_from_frame_parameter (f, Qcursor_color, arg);
359   unblock_input ();
363 static void
364 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
366   NSView *view = FRAME_NS_VIEW (f);
367   NSTRACE (x_set_icon_name);
369   /* see if it's changed */
370   if (STRINGP (arg))
371     {
372       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
373         return;
374     }
375   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
376     return;
378   fset_icon_name (f, arg);
380   if (NILP (arg))
381     {
382       if (!NILP (f->title))
383         arg = f->title;
384       else
385         /* Explicit name and no icon-name -> explicit_name.  */
386         if (f->explicit_name)
387           arg = f->name;
388         else
389           {
390             /* No explicit name and no icon-name ->
391                name has to be rebuild from icon_title_format.  */
392             windows_or_buffers_changed = 62;
393             return;
394           }
395     }
397   /* Don't change the name if it's already NAME.  */
398   if ([[view window] miniwindowTitle]
399       && ([[[view window] miniwindowTitle]
400              isEqualToString: [NSString stringWithUTF8String:
401                                           SSDATA (arg)]]))
402     return;
404   [[view window] setMiniwindowTitle:
405         [NSString stringWithUTF8String: SSDATA (arg)]];
408 static void
409 ns_set_name_internal (struct frame *f, Lisp_Object name)
411   Lisp_Object encoded_name, encoded_icon_name;
412   NSString *str;
413   NSView *view = FRAME_NS_VIEW (f);
415   encoded_name = ENCODE_UTF_8 (name);
417   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
419   /* Don't change the name if it's already NAME.  */
420   if (! [[[view window] title] isEqualToString: str])
421     [[view window] setTitle: str];
423   if (!STRINGP (f->icon_name))
424     encoded_icon_name = encoded_name;
425   else
426     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
428   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
430   if ([[view window] miniwindowTitle]
431       && ! [[[view window] miniwindowTitle] isEqualToString: str])
432     [[view window] setMiniwindowTitle: str];
436 static void
437 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
439   NSTRACE (ns_set_name);
441   /* Make sure that requests from lisp code override requests from
442      Emacs redisplay code.  */
443   if (explicit)
444     {
445       /* If we're switching from explicit to implicit, we had better
446          update the mode lines and thereby update the title.  */
447       if (f->explicit_name && NILP (name))
448         update_mode_lines = 21;
450       f->explicit_name = ! NILP (name);
451     }
452   else if (f->explicit_name)
453     return;
455   if (NILP (name))
456     name = build_string ([ns_app_name UTF8String]);
457   else
458     CHECK_STRING (name);
460   /* Don't change the name if it's already NAME.  */
461   if (! NILP (Fstring_equal (name, f->name)))
462     return;
464   fset_name (f, name);
466   /* Title overrides explicit name.  */
467   if (! NILP (f->title))
468     name = f->title;
470   ns_set_name_internal (f, name);
474 /* This function should be called when the user's lisp code has
475    specified a name for the frame; the name will override any set by the
476    redisplay code.  */
477 static void
478 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
480   NSTRACE (x_explicitly_set_name);
481   ns_set_name (f, arg, 1);
485 /* This function should be called by Emacs redisplay code to set the
486    name; names set this way will never override names set by the user's
487    lisp code.  */
488 void
489 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
491   NSTRACE (x_implicitly_set_name);
493   /* Deal with NS specific format t.  */
494   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
495                          || EQ (Vframe_title_format, Qt)))
496     ns_set_name_as_filename (f);
497   else
498     ns_set_name (f, arg, 0);
502 /* Change the title of frame F to NAME.
503    If NAME is nil, use the frame name as the title.  */
505 static void
506 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
508   NSTRACE (x_set_title);
509   /* Don't change the title if it's already NAME.  */
510   if (EQ (name, f->title))
511     return;
513   update_mode_lines = 22;
515   fset_title (f, name);
517   if (NILP (name))
518     name = f->name;
519   else
520     CHECK_STRING (name);
522   ns_set_name_internal (f, name);
526 void
527 ns_set_name_as_filename (struct frame *f)
529   NSView *view;
530   Lisp_Object name, filename;
531   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
532   const char *title;
533   NSAutoreleasePool *pool;
534   Lisp_Object encoded_name, encoded_filename;
535   NSString *str;
536   NSTRACE (ns_set_name_as_filename);
538   if (f->explicit_name || ! NILP (f->title))
539     return;
541   block_input ();
542   pool = [[NSAutoreleasePool alloc] init];
543   filename = BVAR (XBUFFER (buf), filename);
544   name = BVAR (XBUFFER (buf), name);
546   if (NILP (name))
547     {
548       if (! NILP (filename))
549         name = Ffile_name_nondirectory (filename);
550       else
551         name = build_string ([ns_app_name UTF8String]);
552     }
554   encoded_name = ENCODE_UTF_8 (name);
556   view = FRAME_NS_VIEW (f);
558   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
559                                 : [[[view window] title] UTF8String];
561   if (title && (! strcmp (title, SSDATA (encoded_name))))
562     {
563       [pool release];
564       unblock_input ();
565       return;
566     }
568   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
569   if (str == nil) str = @"Bad coding";
571   if (FRAME_ICONIFIED_P (f))
572     [[view window] setMiniwindowTitle: str];
573   else
574     {
575       NSString *fstr;
577       if (! NILP (filename))
578         {
579           encoded_filename = ENCODE_UTF_8 (filename);
581           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
582           if (fstr == nil) fstr = @"";
583         }
584       else
585         fstr = @"";
587       ns_set_represented_filename (fstr, f);
588       [[view window] setTitle: str];
589       fset_name (f, name);
590     }
592   [pool release];
593   unblock_input ();
597 void
598 ns_set_doc_edited (void)
600   NSAutoreleasePool *pool;
601   Lisp_Object tail, frame;
602   block_input ();
603   pool = [[NSAutoreleasePool alloc] init];
604   FOR_EACH_FRAME (tail, frame)
605     {
606       BOOL edited = NO;
607       struct frame *f = XFRAME (frame);
608       struct window *w;
609       NSView *view;
611       if (! FRAME_NS_P (f)) continue;
612       w = XWINDOW (FRAME_SELECTED_WINDOW (f));
613       view = FRAME_NS_VIEW (f);
614       if (!MINI_WINDOW_P (w))
615         edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
616           ! NILP (Fbuffer_file_name (w->contents));
617       [[view window] setDocumentEdited: edited];
618     }
620   [pool release];
621   unblock_input ();
625 void
626 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
628   int nlines;
629   if (FRAME_MINIBUF_ONLY_P (f))
630     return;
632   if (TYPE_RANGED_INTEGERP (int, value))
633     nlines = XINT (value);
634   else
635     nlines = 0;
637   FRAME_MENU_BAR_LINES (f) = 0;
638   if (nlines)
639     {
640       FRAME_EXTERNAL_MENU_BAR (f) = 1;
641       /* does for all frames, whereas we just want for one frame
642          [NSMenu setMenuBarVisible: YES]; */
643     }
644   else
645     {
646       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
647         free_frame_menubar (f);
648       /*      [NSMenu setMenuBarVisible: NO]; */
649       FRAME_EXTERNAL_MENU_BAR (f) = 0;
650     }
654 /* toolbar support */
655 void
656 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
658   int nlines;
660   if (FRAME_MINIBUF_ONLY_P (f))
661     return;
663   if (RANGED_INTEGERP (0, value, INT_MAX))
664     nlines = XFASTINT (value);
665   else
666     nlines = 0;
668   if (nlines)
669     {
670       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
671       update_frame_tool_bar (f);
672     }
673   else
674     {
675       if (FRAME_EXTERNAL_TOOL_BAR (f))
676         {
677           free_frame_tool_bar (f);
678           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
679         }
680     }
682   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
686 void
687 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
689   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
691   CHECK_TYPE_RANGED_INTEGER (int, arg);
692   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
693   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
694     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
696   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
697     return;
699   if (FRAME_X_WINDOW (f) != 0)
700     adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
702   SET_FRAME_GARBAGED (f);
706 static void
707 ns_implicitly_set_icon_type (struct frame *f)
709   Lisp_Object tem;
710   EmacsView *view = FRAME_NS_VIEW (f);
711   id image = nil;
712   Lisp_Object chain, elt;
713   NSAutoreleasePool *pool;
714   BOOL setMini = YES;
716   NSTRACE (ns_implicitly_set_icon_type);
718   block_input ();
719   pool = [[NSAutoreleasePool alloc] init];
720   if (f->output_data.ns->miniimage
721       && [[NSString stringWithUTF8String: SSDATA (f->name)]
722                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
723     {
724       [pool release];
725       unblock_input ();
726       return;
727     }
729   tem = assq_no_quit (Qicon_type, f->param_alist);
730   if (CONSP (tem) && ! NILP (XCDR (tem)))
731     {
732       [pool release];
733       unblock_input ();
734       return;
735     }
737   for (chain = Vns_icon_type_alist;
738        image == nil && CONSP (chain);
739        chain = XCDR (chain))
740     {
741       elt = XCAR (chain);
742       /* special case: t means go by file type */
743       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
744         {
745           NSString *str
746              = [NSString stringWithUTF8String: SSDATA (f->name)];
747           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
748             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
749         }
750       else if (CONSP (elt) &&
751                STRINGP (XCAR (elt)) &&
752                STRINGP (XCDR (elt)) &&
753                fast_string_match (XCAR (elt), f->name) >= 0)
754         {
755           image = [EmacsImage allocInitFromFile: XCDR (elt)];
756           if (image == nil)
757             image = [[NSImage imageNamed:
758                                [NSString stringWithUTF8String:
759                                             SSDATA (XCDR (elt))]] retain];
760         }
761     }
763   if (image == nil)
764     {
765       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
766       setMini = NO;
767     }
769   [f->output_data.ns->miniimage release];
770   f->output_data.ns->miniimage = image;
771   [view setMiniwindowImage: setMini];
772   [pool release];
773   unblock_input ();
777 static void
778 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
780   EmacsView *view = FRAME_NS_VIEW (f);
781   id image = nil;
782   BOOL setMini = YES;
784   NSTRACE (x_set_icon_type);
786   if (!NILP (arg) && SYMBOLP (arg))
787     {
788       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
789       store_frame_param (f, Qicon_type, arg);
790     }
792   /* do it the implicit way */
793   if (NILP (arg))
794     {
795       ns_implicitly_set_icon_type (f);
796       return;
797     }
799   CHECK_STRING (arg);
801   image = [EmacsImage allocInitFromFile: arg];
802   if (image == nil)
803     image =[NSImage imageNamed: [NSString stringWithUTF8String:
804                                             SSDATA (arg)]];
806   if (image == nil)
807     {
808       image = [NSImage imageNamed: @"text"];
809       setMini = NO;
810     }
812   f->output_data.ns->miniimage = image;
813   [view setMiniwindowImage: setMini];
817 /* TODO: move to nsterm? */
819 ns_lisp_to_cursor_type (Lisp_Object arg)
821   char *str;
822   if (XTYPE (arg) == Lisp_String)
823     str = SSDATA (arg);
824   else if (XTYPE (arg) == Lisp_Symbol)
825     str = SSDATA (SYMBOL_NAME (arg));
826   else return -1;
827   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
828   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
829   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
830   if (!strcmp (str, "bar"))     return BAR_CURSOR;
831   if (!strcmp (str, "no"))      return NO_CURSOR;
832   return -1;
836 Lisp_Object
837 ns_cursor_type_to_lisp (int arg)
839   switch (arg)
840     {
841     case FILLED_BOX_CURSOR: return Qbox;
842     case HOLLOW_BOX_CURSOR: return Qhollow;
843     case HBAR_CURSOR:       return Qhbar;
844     case BAR_CURSOR:        return Qbar;
845     case NO_CURSOR:
846     default:                return intern ("no");
847     }
850 /* This is the same as the xfns.c definition.  */
851 static void
852 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
854   set_frame_cursor_types (f, arg);
857 /* called to set mouse pointer color, but all other terms use it to
858    initialize pointer types (and don't set the color ;) */
859 static void
860 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
862   /* don't think we can do this on Nextstep */
866 #define Str(x) #x
867 #define Xstr(x) Str(x)
869 static Lisp_Object
870 ns_appkit_version_str (void)
872   char tmp[256];
874 #ifdef NS_IMPL_GNUSTEP
875   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
876 #elif defined (NS_IMPL_COCOA)
877   NSString *osversion
878     = [[NSProcessInfo processInfo] operatingSystemVersionString];
879   sprintf(tmp, "appkit-%.2f %s",
880           NSAppKitVersionNumber,
881           [osversion UTF8String]);
882 #else
883   tmp = "ns-unknown";
884 #endif
885   return build_string (tmp);
889 /* This is for use by x-server-version and collapses all version info we
890    have into a single int.  For a better picture of the implementation
891    running, use ns_appkit_version_str.*/
892 static int
893 ns_appkit_version_int (void)
895 #ifdef NS_IMPL_GNUSTEP
896   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
897 #elif defined (NS_IMPL_COCOA)
898   return (int)NSAppKitVersionNumber;
899 #endif
900   return 0;
904 static void
905 x_icon (struct frame *f, Lisp_Object parms)
906 /* --------------------------------------------------------------------------
907    Strangely-named function to set icon position parameters in frame.
908    This is irrelevant under OS X, but might be needed under GNUstep,
909    depending on the window manager used.  Note, this is not a standard
910    frame parameter-setter; it is called directly from x-create-frame.
911    -------------------------------------------------------------------------- */
913   Lisp_Object icon_x, icon_y;
914   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
916   f->output_data.ns->icon_top = -1;
917   f->output_data.ns->icon_left = -1;
919   /* Set the position of the icon.  */
920   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
921   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
922   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
923     {
924       CHECK_NUMBER (icon_x);
925       CHECK_NUMBER (icon_y);
926       f->output_data.ns->icon_top = XINT (icon_y);
927       f->output_data.ns->icon_left = XINT (icon_x);
928     }
929   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
930     error ("Both left and top icon corners of icon must be specified");
934 /* Note: see frame.c for template, also where generic functions are impl */
935 frame_parm_handler ns_frame_parm_handlers[] =
937   x_set_autoraise, /* generic OK */
938   x_set_autolower, /* generic OK */
939   x_set_background_color,
940   0, /* x_set_border_color,  may be impossible under Nextstep */
941   0, /* x_set_border_width,  may be impossible under Nextstep */
942   x_set_cursor_color,
943   x_set_cursor_type,
944   x_set_font, /* generic OK */
945   x_set_foreground_color,
946   x_set_icon_name,
947   x_set_icon_type,
948   x_set_internal_border_width, /* generic OK */
949   0, /* x_set_right_divider_width */
950   0, /* x_set_bottom_divider_width */
951   x_set_menu_bar_lines,
952   x_set_mouse_color,
953   x_explicitly_set_name,
954   x_set_scroll_bar_width, /* generic OK */
955   x_set_scroll_bar_height, /* generic OK */
956   x_set_title,
957   x_set_unsplittable, /* generic OK */
958   x_set_vertical_scroll_bars, /* generic OK */
959   x_set_horizontal_scroll_bars, /* generic OK */
960   x_set_visibility, /* generic OK */
961   x_set_tool_bar_lines,
962   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
963   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
964   x_set_screen_gamma, /* generic OK */
965   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
966   x_set_left_fringe, /* generic OK */
967   x_set_right_fringe, /* generic OK */
968   0, /* x_set_wait_for_wm, will ignore */
969   x_set_fullscreen, /* generic OK */
970   x_set_font_backend, /* generic OK */
971   x_set_alpha,
972   0, /* x_set_sticky */
973   0, /* x_set_tool_bar_position */
977 /* Handler for signals raised during x_create_frame.
978    FRAME is the frame which is partially constructed.  */
980 static void
981 unwind_create_frame (Lisp_Object frame)
983   struct frame *f = XFRAME (frame);
985   /* If frame is already dead, nothing to do.  This can happen if the
986      display is disconnected after the frame has become official, but
987      before x_create_frame removes the unwind protect.  */
988   if (!FRAME_LIVE_P (f))
989     return;
991   /* If frame is ``official'', nothing to do.  */
992   if (NILP (Fmemq (frame, Vframe_list)))
993     {
994 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
995       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
996 #endif
998       /* If the frame's image cache refcount is still the same as our
999          private shadow variable, it means we are unwinding a frame
1000          for which we didn't yet call init_frame_faces, where the
1001          refcount is incremented.  Therefore, we increment it here, so
1002          that free_frame_faces, called in x_free_frame_resources
1003          below, will not mistakenly decrement the counter that was not
1004          incremented yet to account for this new frame.  */
1005       if (FRAME_IMAGE_CACHE (f) != NULL
1006           && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount)
1007         FRAME_IMAGE_CACHE (f)->refcount++;
1009       x_free_frame_resources (f);
1010       free_glyphs (f);
1012 #ifdef GLYPH_DEBUG
1013       /* Check that reference counts are indeed correct.  */
1014       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1015 #endif
1016     }
1020  * Read geometry related parameters from preferences if not in PARMS.
1021  * Returns the union of parms and any preferences read.
1022  */
1024 static Lisp_Object
1025 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1026                                Lisp_Object parms)
1028   struct {
1029     const char *val;
1030     const char *cls;
1031     Lisp_Object tem;
1032   } r[] = {
1033     { "width",  "Width", Qwidth },
1034     { "height", "Height", Qheight },
1035     { "left", "Left", Qleft },
1036     { "top", "Top", Qtop },
1037   };
1039   int i;
1040   for (i = 0; i < ARRAYELTS (r); ++i)
1041     {
1042       if (NILP (Fassq (r[i].tem, parms)))
1043         {
1044           Lisp_Object value
1045             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1046                          RES_TYPE_NUMBER);
1047           if (! EQ (value, Qunbound))
1048             parms = Fcons (Fcons (r[i].tem, value), parms);
1049         }
1050     }
1052   return parms;
1055 /* ==========================================================================
1057     Lisp definitions
1059    ========================================================================== */
1061 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1062        1, 1, 0,
1063        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1064 Return an Emacs frame object.
1065 PARMS is an alist of frame parameters.
1066 If the parameters specify that the frame should not have a minibuffer,
1067 and do not specify a specific minibuffer window to use,
1068 then `default-minibuffer-frame' must be a frame whose minibuffer can
1069 be shared by the new frame.
1071 This function is an internal primitive--use `make-frame' instead.  */)
1072      (Lisp_Object parms)
1074   struct frame *f;
1075   Lisp_Object frame, tem;
1076   Lisp_Object name;
1077   int minibuffer_only = 0;
1078   long window_prompting = 0;
1079   ptrdiff_t count = specpdl_ptr - specpdl;
1080   Lisp_Object display;
1081   struct ns_display_info *dpyinfo = NULL;
1082   Lisp_Object parent;
1083   struct kboard *kb;
1084   static int desc_ctr = 1;
1086   /* x_get_arg modifies parms.  */
1087   parms = Fcopy_alist (parms);
1089   /* Use this general default value to start with
1090      until we know if this frame has a specified name.  */
1091   Vx_resource_name = Vinvocation_name;
1093   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1094   if (EQ (display, Qunbound))
1095     display = Qnil;
1096   dpyinfo = check_ns_display_info (display);
1097   kb = dpyinfo->terminal->kboard;
1099   if (!dpyinfo->terminal->name)
1100     error ("Terminal is not live, can't create new frames on it");
1102   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1103   if (!STRINGP (name)
1104       && ! EQ (name, Qunbound)
1105       && ! NILP (name))
1106     error ("Invalid frame name--not a string or nil");
1108   if (STRINGP (name))
1109     Vx_resource_name = name;
1111   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1112   if (EQ (parent, Qunbound))
1113     parent = Qnil;
1114   if (! NILP (parent))
1115     CHECK_NUMBER (parent);
1117   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1118   /* No need to protect DISPLAY because that's not used after passing
1119      it to make_frame_without_minibuffer.  */
1120   frame = Qnil;
1121   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1122                   RES_TYPE_SYMBOL);
1123   if (EQ (tem, Qnone) || NILP (tem))
1124       f = make_frame_without_minibuffer (Qnil, kb, display);
1125   else if (EQ (tem, Qonly))
1126     {
1127       f = make_minibuffer_frame ();
1128       minibuffer_only = 1;
1129     }
1130   else if (WINDOWP (tem))
1131       f = make_frame_without_minibuffer (tem, kb, display);
1132   else
1133       f = make_frame (1);
1135   XSETFRAME (frame, f);
1137   f->terminal = dpyinfo->terminal;
1139   f->output_method = output_ns;
1140   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1142   FRAME_FONTSET (f) = -1;
1144   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1145                                 "iconName", "Title",
1146                                 RES_TYPE_STRING));
1147   if (! STRINGP (f->icon_name))
1148     fset_icon_name (f, Qnil);
1150   FRAME_DISPLAY_INFO (f) = dpyinfo;
1152   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1153   record_unwind_protect (unwind_create_frame, frame);
1155   f->output_data.ns->window_desc = desc_ctr++;
1156   if (TYPE_RANGED_INTEGERP (Window, parent))
1157     {
1158       f->output_data.ns->parent_desc = XFASTINT (parent);
1159       f->output_data.ns->explicit_parent = 1;
1160     }
1161   else
1162     {
1163       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1164       f->output_data.ns->explicit_parent = 0;
1165     }
1167   /* Set the name; the functions to which we pass f expect the name to
1168      be set.  */
1169   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1170     {
1171       fset_name (f, build_string ([ns_app_name UTF8String]));
1172       f->explicit_name = 0;
1173     }
1174   else
1175     {
1176       fset_name (f, name);
1177       f->explicit_name = 1;
1178       specbind (Qx_resource_name, name);
1179     }
1181   block_input ();
1183 #ifdef NS_IMPL_COCOA
1184     mac_register_font_driver (f);
1185 #else
1186     register_font_driver (&nsfont_driver, f);
1187 #endif
1189   image_cache_refcount =
1190     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1192   x_default_parameter (f, parms, Qfont_backend, Qnil,
1193                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1195   {
1196     /* use for default font name */
1197     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1198     x_default_parameter (f, parms, Qfontsize,
1199                                     make_number (0 /*(int)[font pointSize]*/),
1200                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1201     // Remove ' Regular', not handled by backends.
1202     char *fontname = xstrdup ([[font displayName] UTF8String]);
1203     int len = strlen (fontname);
1204     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1205       fontname[len-8] = '\0';
1206     x_default_parameter (f, parms, Qfont,
1207                                  build_string (fontname),
1208                                  "font", "Font", RES_TYPE_STRING);
1209     xfree (fontname);
1210   }
1211   unblock_input ();
1213   x_default_parameter (f, parms, Qborder_width, make_number (0),
1214                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1215   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1216                       "internalBorderWidth", "InternalBorderWidth",
1217                       RES_TYPE_NUMBER);
1219   /* default vertical scrollbars on right on Mac */
1220   {
1221       Lisp_Object spos
1222 #ifdef NS_IMPL_GNUSTEP
1223           = Qt;
1224 #else
1225           = Qright;
1226 #endif
1227       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1228                            "verticalScrollBars", "VerticalScrollBars",
1229                            RES_TYPE_SYMBOL);
1230   }
1231   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil,
1232                        "horizontalScrollBars", "HorizontalScrollBars",
1233                        RES_TYPE_SYMBOL);
1234   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1235                       "foreground", "Foreground", RES_TYPE_STRING);
1236   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1237                       "background", "Background", RES_TYPE_STRING);
1238   /* FIXME: not supported yet in Nextstep */
1239   x_default_parameter (f, parms, Qline_spacing, Qnil,
1240                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1241   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1242                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1243   x_default_parameter (f, parms, Qright_fringe, Qnil,
1244                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1246   init_frame_faces (f);
1248   /* Read comment about this code in corresponding place in xfns.c.  */
1249   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1250                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
1251                      Qx_create_frame_1);
1253   /* The resources controlling the menu-bar and tool-bar are
1254      processed specially at startup, and reflected in the mode
1255      variables; ignore them here.  */
1256   x_default_parameter (f, parms, Qmenu_bar_lines,
1257                        NILP (Vmenu_bar_mode)
1258                        ? make_number (0) : make_number (1),
1259                        NULL, NULL, RES_TYPE_NUMBER);
1260   x_default_parameter (f, parms, Qtool_bar_lines,
1261                        NILP (Vtool_bar_mode)
1262                        ? make_number (0) : make_number (1),
1263                        NULL, NULL, RES_TYPE_NUMBER);
1265   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1266                        "BufferPredicate", RES_TYPE_SYMBOL);
1267   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1268                        RES_TYPE_STRING);
1270   parms = get_geometry_from_preferences (dpyinfo, parms);
1271   window_prompting = x_figure_window_size (f, parms, 1);
1273   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1274   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1276   /* NOTE: on other terms, this is done in set_mouse_color, however this
1277      was not getting called under Nextstep */
1278   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1279   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1280   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1281   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1282   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1283   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1284   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1285   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1286      = [NSCursor arrowCursor];
1287   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1288      = [NSCursor arrowCursor];
1289   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1291   [[EmacsView alloc] initFrameFromEmacs: f];
1293   x_icon (f, parms);
1295   /* ns_display_info does not have a reference_count.  */
1296   f->terminal->reference_count++;
1298   /* It is now ok to make the frame official even if we get an error below.
1299      The frame needs to be on Vframe_list or making it visible won't work. */
1300   Vframe_list = Fcons (frame, Vframe_list);
1302   x_default_parameter (f, parms, Qicon_type, Qnil,
1303                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1305   x_default_parameter (f, parms, Qauto_raise, Qnil,
1306                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1307   x_default_parameter (f, parms, Qauto_lower, Qnil,
1308                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1309   x_default_parameter (f, parms, Qcursor_type, Qbox,
1310                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1311   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1312                        "scrollBarWidth", "ScrollBarWidth",
1313                        RES_TYPE_NUMBER);
1314   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1315                        "scrollBarHeight", "ScrollBarHeight",
1316                        RES_TYPE_NUMBER);
1317   x_default_parameter (f, parms, Qalpha, Qnil,
1318                        "alpha", "Alpha", RES_TYPE_NUMBER);
1319   x_default_parameter (f, parms, Qfullscreen, Qnil,
1320                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1322   /* Allow x_set_window_size, now.  */
1323   f->can_x_set_window_size = true;
1325   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
1326                      Qx_create_frame_2);
1328   if (! f->output_data.ns->explicit_parent)
1329     {
1330       Lisp_Object visibility;
1332       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1333                               RES_TYPE_SYMBOL);
1334       if (EQ (visibility, Qunbound))
1335         visibility = Qt;
1337       if (EQ (visibility, Qicon))
1338         x_iconify_frame (f);
1339       else if (! NILP (visibility))
1340         {
1341           x_make_frame_visible (f);
1342           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1343         }
1344       else
1345         {
1346           /* Must have been Qnil.  */
1347         }
1348     }
1350   if (FRAME_HAS_MINIBUF_P (f)
1351       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1352           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1353     kset_default_minibuffer_frame (kb, frame);
1355   /* All remaining specified parameters, which have not been "used"
1356      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1357   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1358     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1359       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1361   if (window_prompting & USPosition)
1362     x_set_offset (f, f->left_pos, f->top_pos, 1);
1364   /* Make sure windows on this frame appear in calls to next-window
1365      and similar functions.  */
1366   Vwindow_list = Qnil;
1368   return unbind_to (count, frame);
1371 void
1372 x_focus_frame (struct frame *f)
1374   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1376   if (dpyinfo->x_focus_frame != f)
1377     {
1378       EmacsView *view = FRAME_NS_VIEW (f);
1379       block_input ();
1380       [NSApp activateIgnoringOtherApps: YES];
1381       [[view window] makeKeyAndOrderFront: view];
1382       unblock_input ();
1383     }
1387 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1388        0, 1, "",
1389        doc: /* Pop up the font panel. */)
1390      (Lisp_Object frame)
1392   struct frame *f = decode_window_system_frame (frame);
1393   id fm = [NSFontManager sharedFontManager];
1394   struct font *font = f->output_data.ns->font;
1395   NSFont *nsfont;
1396 #ifdef NS_IMPL_GNUSTEP
1397   nsfont = ((struct nsfont_info *)font)->nsfont;
1398 #endif
1399 #ifdef NS_IMPL_COCOA
1400   nsfont = (NSFont *) macfont_get_nsctfont (font);
1401 #endif
1402   [fm setSelectedFont: nsfont isMultiple: NO];
1403   [fm orderFrontFontPanel: NSApp];
1404   return Qnil;
1408 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1409        0, 1, "",
1410        doc: /* Pop up the color panel.  */)
1411      (Lisp_Object frame)
1413   check_window_system (NULL);
1414   [NSApp orderFrontColorPanel: NSApp];
1415   return Qnil;
1418 static struct
1420   id panel;
1421   BOOL ret;
1422 #ifdef NS_IMPL_GNUSTEP
1423   NSString *dirS, *initS;
1424   BOOL no_types;
1425 #endif
1426 } ns_fd_data;
1428 void
1429 ns_run_file_dialog (void)
1431   if (ns_fd_data.panel == nil) return;
1432 #ifdef NS_IMPL_COCOA
1433   ns_fd_data.ret = [ns_fd_data.panel runModal];
1434 #else
1435   if (ns_fd_data.no_types)
1436     {
1437       ns_fd_data.ret = [ns_fd_data.panel
1438                            runModalForDirectory: ns_fd_data.dirS
1439                            file: ns_fd_data.initS];
1440     }
1441   else
1442     {
1443       ns_fd_data.ret = [ns_fd_data.panel
1444                            runModalForDirectory: ns_fd_data.dirS
1445                            file: ns_fd_data.initS
1446                            types: nil];
1447     }
1448 #endif
1449   ns_fd_data.panel = nil;
1452 #ifdef NS_IMPL_COCOA
1453 #if MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_9
1454 #define MODAL_OK_RESPONSE NSModalResponseOK
1455 #endif
1456 #endif
1457 #ifndef MODAL_OK_RESPONSE
1458 #define MODAL_OK_RESPONSE NSOKButton
1459 #endif
1461 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1462        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1463 Optional arg DIR, if non-nil, supplies a default directory.
1464 Optional arg MUSTMATCH, if non-nil, means the returned file or
1465 directory must exist.
1466 Optional arg INIT, if non-nil, provides a default file name to use.
1467 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1468   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1469    Lisp_Object init, Lisp_Object dir_only_p)
1471   static id fileDelegate = nil;
1472   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1473   id panel;
1474   Lisp_Object fname = Qnil;
1476   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1477     [NSString stringWithUTF8String: SSDATA (prompt)];
1478   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1479     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1480     [NSString stringWithUTF8String: SSDATA (dir)];
1481   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1482     [NSString stringWithUTF8String: SSDATA (init)];
1483   NSEvent *nxev;
1485   check_window_system (NULL);
1487   if (fileDelegate == nil)
1488     fileDelegate = [EmacsFileDelegate new];
1490   [NSCursor setHiddenUntilMouseMoves: NO];
1492   if ([dirS characterAtIndex: 0] == '~')
1493     dirS = [dirS stringByExpandingTildeInPath];
1495   panel = isSave ?
1496     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1498   [panel setTitle: promptS];
1500   [panel setAllowsOtherFileTypes: YES];
1501   [panel setTreatsFilePackagesAsDirectories: YES];
1502   [panel setDelegate: fileDelegate];
1504   if (! NILP (dir_only_p))
1505     {
1506       [panel setCanChooseDirectories: YES];
1507       [panel setCanChooseFiles: NO];
1508     }
1509   else if (! isSave)
1510     {
1511       /* This is not quite what the documentation says, but it is compatible
1512          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1513       [panel setCanChooseDirectories: NO];
1514       [panel setCanChooseFiles: YES];
1515     }
1517   block_input ();
1518   ns_fd_data.panel = panel;
1519   ns_fd_data.ret = NO;
1520 #ifdef NS_IMPL_COCOA
1521   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1522     [panel setAllowedFileTypes: nil];
1523   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1524   if (initS && NILP (Ffile_directory_p (init)))
1525     [panel setNameFieldStringValue: [initS lastPathComponent]];
1526   else
1527     [panel setNameFieldStringValue: @""];
1529 #else
1530   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1531   ns_fd_data.dirS = dirS;
1532   ns_fd_data.initS = initS;
1533 #endif
1535   /* runModalForDirectory/runModal restarts the main event loop when done,
1536      so we must start an event loop and then pop up the file dialog.
1537      The file dialog may pop up a confirm dialog after Ok has been pressed,
1538      so we can not simply pop down on the Ok/Cancel press.
1539    */
1540   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1541                             location: NSMakePoint (0, 0)
1542                        modifierFlags: 0
1543                            timestamp: 0
1544                         windowNumber: [[NSApp mainWindow] windowNumber]
1545                              context: [NSApp context]
1546                              subtype: 0
1547                                data1: 0
1548                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1550   [NSApp postEvent: nxev atStart: NO];
1551   while (ns_fd_data.panel != nil)
1552     [NSApp run];
1554   if (ns_fd_data.ret == MODAL_OK_RESPONSE)
1555     {
1556       NSString *str = ns_filename_from_panel (panel);
1557       if (! str) str = ns_directory_from_panel (panel);
1558       if (str) fname = build_string ([str UTF8String]);
1559     }
1561   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1562   unblock_input ();
1564   return fname;
1567 const char *
1568 ns_get_defaults_value (const char *key)
1570   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1571                     objectForKey: [NSString stringWithUTF8String: key]];
1573   if (!obj) return NULL;
1575   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1579 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1580        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1581 If OWNER is nil, Emacs is assumed.  */)
1582      (Lisp_Object owner, Lisp_Object name)
1584   const char *value;
1586   check_window_system (NULL);
1587   if (NILP (owner))
1588     owner = build_string([ns_app_name UTF8String]);
1589   CHECK_STRING (name);
1591   value = ns_get_defaults_value (SSDATA (name));
1593   if (value)
1594     return build_string (value);
1595   return Qnil;
1599 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1600        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1601 If OWNER is nil, Emacs is assumed.
1602 If VALUE is nil, the default is removed.  */)
1603      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1605   check_window_system (NULL);
1606   if (NILP (owner))
1607     owner = build_string ([ns_app_name UTF8String]);
1608   CHECK_STRING (name);
1609   if (NILP (value))
1610     {
1611       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1612                          [NSString stringWithUTF8String: SSDATA (name)]];
1613     }
1614   else
1615     {
1616       CHECK_STRING (value);
1617       [[NSUserDefaults standardUserDefaults] setObject:
1618                 [NSString stringWithUTF8String: SSDATA (value)]
1619                                         forKey: [NSString stringWithUTF8String:
1620                                                          SSDATA (name)]];
1621     }
1623   return Qnil;
1627 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1628        Sx_server_max_request_size,
1629        0, 1, 0,
1630        doc: /* This function is a no-op.  It is only present for completeness.  */)
1631      (Lisp_Object terminal)
1633   check_ns_display_info (terminal);
1634   /* This function has no real equivalent under NeXTstep.  Return nil to
1635      indicate this. */
1636   return Qnil;
1640 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1641        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1642 \(Labeling every distributor as a "vendor" embodies the false assumption
1643 that operating systems cannot be developed and distributed noncommercially.)
1644 The optional argument TERMINAL specifies which display to ask about.
1645 TERMINAL should be a terminal object, a frame or a display name (a string).
1646 If omitted or nil, that stands for the selected frame's display.  */)
1647   (Lisp_Object terminal)
1649   check_ns_display_info (terminal);
1650 #ifdef NS_IMPL_GNUSTEP
1651   return build_string ("GNU");
1652 #else
1653   return build_string ("Apple");
1654 #endif
1658 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1659        doc: /* Return the version numbers of the server of display TERMINAL.
1660 The value is a list of three integers: the major and minor
1661 version numbers of the X Protocol in use, and the distributor-specific release
1662 number.  See also the function `x-server-vendor'.
1664 The optional argument TERMINAL specifies which display to ask about.
1665 TERMINAL should be a terminal object, a frame or a display name (a string).
1666 If omitted or nil, that stands for the selected frame's display.  */)
1667   (Lisp_Object terminal)
1669   check_ns_display_info (terminal);
1670   /*NOTE: it is unclear what would best correspond with "protocol";
1671           we return 10.3, meaning Panther, since this is roughly the
1672           level that GNUstep's APIs correspond to.
1673           The last number is where we distinguish between the Apple
1674           and GNUstep implementations ("distributor-specific release
1675           number") and give int'ized versions of major.minor. */
1676   return list3i (10, 3, ns_appkit_version_int ());
1680 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1681        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1682 The optional argument TERMINAL specifies which display to ask about.
1683 TERMINAL should be a terminal object, a frame or a display name (a string).
1684 If omitted or nil, that stands for the selected frame's display.
1686 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1687 the number of physical monitors, use `(length
1688 (display-monitor-attributes-list TERMINAL))' instead.  */)
1689   (Lisp_Object terminal)
1691   check_ns_display_info (terminal);
1692   return make_number (1);
1696 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1697        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1698 The optional argument TERMINAL specifies which display to ask about.
1699 TERMINAL should be a terminal object, a frame or a display name (a string).
1700 If omitted or nil, that stands for the selected frame's display.
1702 On \"multi-monitor\" setups this refers to the height in millimeters for
1703 all physical monitors associated with TERMINAL.  To get information
1704 for each physical monitor, use `display-monitor-attributes-list'.  */)
1705   (Lisp_Object terminal)
1707   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1709   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1713 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1714        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1715 The optional argument TERMINAL specifies which display to ask about.
1716 TERMINAL should be a terminal object, a frame or a display name (a string).
1717 If omitted or nil, that stands for the selected frame's display.
1719 On \"multi-monitor\" setups this refers to the width in millimeters for
1720 all physical monitors associated with TERMINAL.  To get information
1721 for each physical monitor, use `display-monitor-attributes-list'.  */)
1722   (Lisp_Object terminal)
1724   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1726   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1730 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1731        Sx_display_backing_store, 0, 1, 0,
1732        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1733 The value may be `buffered', `retained', or `non-retained'.
1734 The optional argument TERMINAL specifies which display to ask about.
1735 TERMINAL should be a terminal object, a frame or a display name (a string).
1736 If omitted or nil, that stands for the selected frame's display.  */)
1737   (Lisp_Object terminal)
1739   check_ns_display_info (terminal);
1740   switch ([ns_get_window (terminal) backingType])
1741     {
1742     case NSBackingStoreBuffered:
1743       return intern ("buffered");
1744     case NSBackingStoreRetained:
1745       return intern ("retained");
1746     case NSBackingStoreNonretained:
1747       return intern ("non-retained");
1748     default:
1749       error ("Strange value for backingType parameter of frame");
1750     }
1751   return Qnil;  /* not reached, shut compiler up */
1755 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1756        Sx_display_visual_class, 0, 1, 0,
1757        doc: /* Return the visual class of the Nextstep display TERMINAL.
1758 The value is one of the symbols `static-gray', `gray-scale',
1759 `static-color', `pseudo-color', `true-color', or `direct-color'.
1761 The optional argument TERMINAL specifies which display to ask about.
1762 TERMINAL should a terminal object, a frame or a display name (a string).
1763 If omitted or nil, that stands for the selected frame's display.  */)
1764   (Lisp_Object terminal)
1766   NSWindowDepth depth;
1768   check_ns_display_info (terminal);
1769   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1771   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1772     return intern ("static-gray");
1773   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1774     return intern ("gray-scale");
1775   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1776     return intern ("pseudo-color");
1777   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1778     return intern ("true-color");
1779   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1780     return intern ("direct-color");
1781   else
1782     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1783     return intern ("direct-color");
1787 DEFUN ("x-display-save-under", Fx_display_save_under,
1788        Sx_display_save_under, 0, 1, 0,
1789        doc: /* Return t if TERMINAL supports the save-under feature.
1790 The optional argument TERMINAL specifies which display to ask about.
1791 TERMINAL should be a terminal object, a frame or a display name (a string).
1792 If omitted or nil, that stands for the selected frame's display.  */)
1793   (Lisp_Object terminal)
1795   check_ns_display_info (terminal);
1796   switch ([ns_get_window (terminal) backingType])
1797     {
1798     case NSBackingStoreBuffered:
1799       return Qt;
1801     case NSBackingStoreRetained:
1802     case NSBackingStoreNonretained:
1803       return Qnil;
1805     default:
1806       error ("Strange value for backingType parameter of frame");
1807     }
1808   return Qnil;  /* not reached, shut compiler up */
1812 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1813        1, 3, 0,
1814        doc: /* Open a connection to a display server.
1815 DISPLAY is the name of the display to connect to.
1816 Optional second arg XRM-STRING is a string of resources in xrdb format.
1817 If the optional third arg MUST-SUCCEED is non-nil,
1818 terminate Emacs if we can't open the connection.
1819 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1820      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1822   struct ns_display_info *dpyinfo;
1824   CHECK_STRING (display);
1826   nxatoms_of_nsselect ();
1827   dpyinfo = ns_term_init (display);
1828   if (dpyinfo == 0)
1829     {
1830       if (!NILP (must_succeed))
1831         fatal ("Display on %s not responding.\n",
1832                SSDATA (display));
1833       else
1834         error ("Display on %s not responding.\n",
1835                SSDATA (display));
1836     }
1838   return Qnil;
1842 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1843        1, 1, 0,
1844        doc: /* Close the connection to TERMINAL's Nextstep display server.
1845 For TERMINAL, specify a terminal object, a frame or a display name (a
1846 string).  If TERMINAL is nil, that stands for the selected frame's
1847 terminal.  */)
1848      (Lisp_Object terminal)
1850   check_ns_display_info (terminal);
1851   [NSApp terminate: NSApp];
1852   return Qnil;
1856 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1857        doc: /* Return the list of display names that Emacs has connections to.  */)
1858      (void)
1860   Lisp_Object result = Qnil;
1861   struct ns_display_info *ndi;
1863   for (ndi = x_display_list; ndi; ndi = ndi->next)
1864     result = Fcons (XCAR (ndi->name_list_element), result);
1866   return result;
1870 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1871        0, 0, 0,
1872        doc: /* Hides all applications other than Emacs.  */)
1873      (void)
1875   check_window_system (NULL);
1876   [NSApp hideOtherApplications: NSApp];
1877   return Qnil;
1880 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1881        1, 1, 0,
1882        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1883 Otherwise if Emacs is hidden, it is unhidden.
1884 If ON is equal to `activate', Emacs is unhidden and becomes
1885 the active application.  */)
1886      (Lisp_Object on)
1888   check_window_system (NULL);
1889   if (EQ (on, intern ("activate")))
1890     {
1891       [NSApp unhide: NSApp];
1892       [NSApp activateIgnoringOtherApps: YES];
1893     }
1894   else if (NILP (on))
1895     [NSApp unhide: NSApp];
1896   else
1897     [NSApp hide: NSApp];
1898   return Qnil;
1902 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1903        0, 0, 0,
1904        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1905      (void)
1907   check_window_system (NULL);
1908   [NSApp orderFrontStandardAboutPanel: nil];
1909   return Qnil;
1913 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1914        doc: /* Determine font PostScript or family name for font NAME.
1915 NAME should be a string containing either the font name or an XLFD
1916 font descriptor.  If string contains `fontset' and not
1917 `fontset-startup', it is left alone. */)
1918      (Lisp_Object name)
1920   char *nm;
1921   CHECK_STRING (name);
1922   nm = SSDATA (name);
1924   if (nm[0] != '-')
1925     return name;
1926   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1927     return name;
1929   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1933 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1934        doc: /* Return a list of all available colors.
1935 The optional argument FRAME is currently ignored.  */)
1936      (Lisp_Object frame)
1938   Lisp_Object list = Qnil;
1939   NSEnumerator *colorlists;
1940   NSColorList *clist;
1942   if (!NILP (frame))
1943     {
1944       CHECK_FRAME (frame);
1945       if (! FRAME_NS_P (XFRAME (frame)))
1946         error ("non-Nextstep frame used in `ns-list-colors'");
1947     }
1949   block_input ();
1951   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1952   while ((clist = [colorlists nextObject]))
1953     {
1954       if ([[clist name] length] < 7 ||
1955           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1956         {
1957           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1958           NSString *cname;
1959           while ((cname = [cnames nextObject]))
1960             list = Fcons (build_string ([cname UTF8String]), list);
1961 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1962                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1963                                              UTF8String]), list); */
1964         }
1965     }
1967   unblock_input ();
1969   return list;
1973 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1974        doc: /* List available Nextstep services by querying NSApp.  */)
1975      (void)
1977 #ifdef NS_IMPL_COCOA
1978   /* You can't get services like this in 10.6+.  */
1979   return Qnil;
1980 #else
1981   Lisp_Object ret = Qnil;
1982   NSMenu *svcs;
1983 #ifdef NS_IMPL_COCOA
1984   id delegate;
1985 #endif
1987   check_window_system (NULL);
1988   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1989   [NSApp setServicesMenu: svcs];
1990   [NSApp registerServicesMenuSendTypes: ns_send_types
1991                            returnTypes: ns_return_types];
1993 /* On Tiger, services menu updating was made lazier (waits for user to
1994    actually click on the menu), so we have to force things along: */
1995 #ifdef NS_IMPL_COCOA
1996   delegate = [svcs delegate];
1997   if (delegate != nil)
1998     {
1999       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2000         [delegate menuNeedsUpdate: svcs];
2001       if ([delegate respondsToSelector:
2002                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2003         {
2004           int i, len = [delegate numberOfItemsInMenu: svcs];
2005           for (i =0; i<len; i++)
2006             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2007           for (i =0; i<len; i++)
2008             if (![delegate menu: svcs
2009                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2010                         atIndex: i shouldCancel: NO])
2011               break;
2012         }
2013     }
2014 #endif
2016   [svcs setAutoenablesItems: NO];
2017 #ifdef NS_IMPL_COCOA
2018   [svcs update]; /* on OS X, converts from '/' structure */
2019 #endif
2021   ret = interpret_services_menu (svcs, Qnil, ret);
2022   return ret;
2023 #endif
2027 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2028        2, 2, 0,
2029        doc: /* Perform Nextstep SERVICE on SEND.
2030 SEND should be either a string or nil.
2031 The return value is the result of the service, as string, or nil if
2032 there was no result.  */)
2033      (Lisp_Object service, Lisp_Object send)
2035   id pb;
2036   NSString *svcName;
2037   char *utfStr;
2039   CHECK_STRING (service);
2040   check_window_system (NULL);
2042   utfStr = SSDATA (service);
2043   svcName = [NSString stringWithUTF8String: utfStr];
2045   pb =[NSPasteboard pasteboardWithUniqueName];
2046   ns_string_to_pasteboard (pb, send);
2048   if (NSPerformService (svcName, pb) == NO)
2049     Fsignal (Qquit, list1 (build_string ("service not available")));
2051   if ([[pb types] count] == 0)
2052     return build_string ("");
2053   return ns_string_from_pasteboard (pb);
2057 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2058        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2059        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2060      (Lisp_Object str)
2062 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2063          remove this. */
2064   NSString *utfStr;
2065   Lisp_Object ret = Qnil;
2066   NSAutoreleasePool *pool;
2068   CHECK_STRING (str);
2069   pool = [[NSAutoreleasePool alloc] init];
2070   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2071 #ifdef NS_IMPL_COCOA
2072   if (utfStr)
2073     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2074 #endif
2075   if (utfStr)
2076     {
2077       const char *cstr = [utfStr UTF8String];
2078       if (cstr)
2079         ret = build_string (cstr);
2080     }
2082   [pool release];
2083   if (NILP (ret))
2084     error ("Invalid UTF-8");
2086   return ret;
2090 #ifdef NS_IMPL_COCOA
2092 /* Compile and execute the AppleScript SCRIPT and return the error
2093    status as function value.  A zero is returned if compilation and
2094    execution is successful, in which case *RESULT is set to a Lisp
2095    string or a number containing the resulting script value.  Otherwise,
2096    1 is returned. */
2097 static int
2098 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2100   NSAppleEventDescriptor *desc;
2101   NSDictionary* errorDict;
2102   NSAppleEventDescriptor* returnDescriptor = NULL;
2104   NSAppleScript* scriptObject =
2105     [[NSAppleScript alloc] initWithSource:
2106                              [NSString stringWithUTF8String: SSDATA (script)]];
2108   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2109   [scriptObject release];
2110   *result = Qnil;
2112   if (returnDescriptor != NULL)
2113     {
2114       // successful execution
2115       if (kAENullEvent != [returnDescriptor descriptorType])
2116         {
2117           *result = Qt;
2118           // script returned an AppleScript result
2119           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2120 #if defined (NS_IMPL_COCOA)
2121               (typeUTF16ExternalRepresentation
2122                == [returnDescriptor descriptorType]) ||
2123 #endif
2124               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2125               (typeCString == [returnDescriptor descriptorType]))
2126             {
2127               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2128               if (desc)
2129                 *result = build_string([[desc stringValue] UTF8String]);
2130             }
2131           else
2132             {
2133               /* use typeUTF16ExternalRepresentation? */
2134               // coerce the result to the appropriate ObjC type
2135               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2136               if (desc)
2137                 *result = make_number([desc int32Value]);
2138             }
2139         }
2140     }
2141   else
2142     {
2143       // no script result, return error
2144       return 1;
2145     }
2146   return 0;
2149 /* Helper function called from sendEvent to run applescript
2150    from within the main event loop.  */
2152 void
2153 ns_run_ascript (void)
2155   if (! NILP (as_script))
2156     as_status = ns_do_applescript (as_script, as_result);
2157   as_script = Qnil;
2160 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2161        doc: /* Execute AppleScript SCRIPT and return the result.
2162 If compilation and execution are successful, the resulting script value
2163 is returned as a string, a number or, in the case of other constructs, t.
2164 In case the execution fails, an error is signaled. */)
2165      (Lisp_Object script)
2167   Lisp_Object result;
2168   int status;
2169   NSEvent *nxev;
2170   struct input_event ev;
2172   CHECK_STRING (script);
2173   check_window_system (NULL);
2175   block_input ();
2177   as_script = script;
2178   as_result = &result;
2180   /* executing apple script requires the event loop to run, otherwise
2181      errors aren't returned and executeAndReturnError hangs forever.
2182      Post an event that runs applescript and then start the event loop.
2183      The event loop is exited when the script is done.  */
2184   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2185                             location: NSMakePoint (0, 0)
2186                        modifierFlags: 0
2187                            timestamp: 0
2188                         windowNumber: [[NSApp mainWindow] windowNumber]
2189                              context: [NSApp context]
2190                              subtype: 0
2191                                data1: 0
2192                                data2: NSAPP_DATA2_RUNASSCRIPT];
2194   [NSApp postEvent: nxev atStart: NO];
2196   // If there are other events, the event loop may exit.  Keep running
2197   // until the script has been handled.  */
2198   ns_init_events (&ev);
2199   while (! NILP (as_script))
2200     [NSApp run];
2201   ns_finish_events ();
2203   status = as_status;
2204   as_status = 0;
2205   as_result = 0;
2206   unblock_input ();
2207   if (status == 0)
2208     return result;
2209   else if (!STRINGP (result))
2210     error ("AppleScript error %d", status);
2211   else
2212     error ("%s", SSDATA (result));
2214 #endif
2218 /* ==========================================================================
2220     Miscellaneous functions not called through hooks
2222    ========================================================================== */
2224 /* called from frame.c */
2225 struct ns_display_info *
2226 check_x_display_info (Lisp_Object frame)
2228   return check_ns_display_info (frame);
2232 void
2233 x_set_scroll_bar_default_width (struct frame *f)
2235   int wid = FRAME_COLUMN_WIDTH (f);
2236   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2237   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2238                                       wid - 1) / wid;
2241 void
2242 x_set_scroll_bar_default_height (struct frame *f)
2244   int height = FRAME_LINE_HEIGHT (f);
2245   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2246   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2247                                        height - 1) / height;
2250 /* terms impl this instead of x-get-resource directly */
2251 char *
2252 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2254   /* remove appname prefix; TODO: allow for !="Emacs" */
2255   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2257   check_window_system (NULL);
2259   if (inhibit_x_resources)
2260     /* --quick was passed, so this is a no-op.  */
2261     return NULL;
2263   res = ns_get_defaults_value (toCheck);
2264   return (!res ? NULL :
2265           (!c_strncasecmp (res, "YES", 3) ? "true" :
2266            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2270 Lisp_Object
2271 x_get_focus_frame (struct frame *frame)
2273   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2274   Lisp_Object nsfocus;
2276   if (!dpyinfo->x_focus_frame)
2277     return Qnil;
2279   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2280   return nsfocus;
2283 /* ==========================================================================
2285     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2287    ========================================================================== */
2290 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2291        doc: /* Internal function called by `color-defined-p', which see.
2292 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2293      (Lisp_Object color, Lisp_Object frame)
2295   NSColor * col;
2296   check_window_system (NULL);
2297   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2301 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2302        doc: /* Internal function called by `color-values', which see.  */)
2303      (Lisp_Object color, Lisp_Object frame)
2305   NSColor * col;
2306   EmacsCGFloat red, green, blue, alpha;
2308   check_window_system (NULL);
2309   CHECK_STRING (color);
2311   block_input ();
2312   if (ns_lisp_to_color (color, &col))
2313     {
2314       unblock_input ();
2315       return Qnil;
2316     }
2318   [[col colorUsingDefaultColorSpace]
2319         getRed: &red green: &green blue: &blue alpha: &alpha];
2320   unblock_input ();
2321   return list3i (lrint (red * 65280), lrint (green * 65280),
2322                  lrint (blue * 65280));
2326 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2327        doc: /* Internal function called by `display-color-p', which see.  */)
2328      (Lisp_Object terminal)
2330   NSWindowDepth depth;
2331   NSString *colorSpace;
2333   check_ns_display_info (terminal);
2334   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2335   colorSpace = NSColorSpaceFromDepth (depth);
2337   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2338          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2339       ? Qnil : Qt;
2343 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2344        0, 1, 0,
2345        doc: /* Return t if the Nextstep display supports shades of gray.
2346 Note that color displays do support shades of gray.
2347 The optional argument TERMINAL specifies which display to ask about.
2348 TERMINAL should be a terminal object, a frame or a display name (a string).
2349 If omitted or nil, that stands for the selected frame's display.  */)
2350   (Lisp_Object terminal)
2352   NSWindowDepth depth;
2354   check_ns_display_info (terminal);
2355   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2357   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2361 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2362        0, 1, 0,
2363        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2364 The optional argument TERMINAL specifies which display to ask about.
2365 TERMINAL should be a terminal object, a frame or a display name (a string).
2366 If omitted or nil, that stands for the selected frame's display.
2368 On \"multi-monitor\" setups this refers to the pixel width for all
2369 physical monitors associated with TERMINAL.  To get information for
2370 each physical monitor, use `display-monitor-attributes-list'.  */)
2371   (Lisp_Object terminal)
2373   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2375   return make_number (x_display_pixel_width (dpyinfo));
2379 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2380        Sx_display_pixel_height, 0, 1, 0,
2381        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2382 The optional argument TERMINAL specifies which display to ask about.
2383 TERMINAL should be a terminal object, a frame or a display name (a string).
2384 If omitted or nil, that stands for the selected frame's display.
2386 On \"multi-monitor\" setups this refers to the pixel height for all
2387 physical monitors associated with TERMINAL.  To get information for
2388 each physical monitor, use `display-monitor-attributes-list'.  */)
2389   (Lisp_Object terminal)
2391   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2393   return make_number (x_display_pixel_height (dpyinfo));
2396 #ifdef NS_IMPL_COCOA
2398 /* Returns the name for the screen that OBJ represents, or NULL.
2399    Caller must free return value.
2402 static char *
2403 ns_get_name_from_ioreg (io_object_t obj)
2405   char *name = NULL;
2407   NSDictionary *info = (NSDictionary *)
2408     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2409   NSDictionary *names = [info objectForKey:
2410                                 [NSString stringWithUTF8String:
2411                                             kDisplayProductName]];
2413   if ([names count] > 0)
2414     {
2415       NSString *n = [names objectForKey: [[names allKeys]
2416                                                  objectAtIndex:0]];
2417       if (n != nil) name = xstrdup ([n UTF8String]);
2418     }
2420   [info release];
2422   return name;
2425 /* Returns the name for the screen that DID came from, or NULL.
2426    Caller must free return value.
2429 static char *
2430 ns_screen_name (CGDirectDisplayID did)
2432   char *name = NULL;
2434 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2435   mach_port_t masterPort;
2436   io_iterator_t it;
2437   io_object_t obj;
2439   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2441   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2442       || IOServiceGetMatchingServices (masterPort,
2443                                        IOServiceMatching ("IONDRVDevice"),
2444                                        &it) != kIOReturnSuccess)
2445     return name;
2447   /* Must loop until we find a name.  Many devices can have the same unit
2448      number (represents different GPU parts), but only one has a name.  */
2449   while (! name && (obj = IOIteratorNext (it)))
2450     {
2451       CFMutableDictionaryRef props;
2452       const void *val;
2454       if (IORegistryEntryCreateCFProperties (obj,
2455                                              &props,
2456                                              kCFAllocatorDefault,
2457                                              kNilOptions) == kIOReturnSuccess
2458           && props != nil
2459           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2460         {
2461           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2462           if (nr == CGDisplayUnitNumber (did))
2463             name = ns_get_name_from_ioreg (obj);
2464         }
2466       CFRelease (props);
2467       IOObjectRelease (obj);
2468     }
2470   IOObjectRelease (it);
2472 #else
2474   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2476 #endif
2477   return name;
2479 #endif
2481 static Lisp_Object
2482 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2483                                 int n_monitors,
2484                                 int primary_monitor,
2485                                 const char *source)
2487   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2488   Lisp_Object frame, rest;
2489   NSArray *screens = [NSScreen screens];
2490   int i;
2492   FOR_EACH_FRAME (rest, frame)
2493     {
2494       struct frame *f = XFRAME (frame);
2496       if (FRAME_NS_P (f))
2497         {
2498           NSView *view = FRAME_NS_VIEW (f);
2499           NSScreen *screen = [[view window] screen];
2500           NSUInteger k;
2502           i = -1;
2503           for (k = 0; i == -1 && k < [screens count]; ++k)
2504             {
2505               if ([screens objectAtIndex: k] == screen)
2506                 i = (int)k;
2507             }
2509           if (i > -1)
2510             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2511         }
2512     }
2514   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2515                                       monitor_frames, source);
2518 DEFUN ("ns-display-monitor-attributes-list",
2519        Fns_display_monitor_attributes_list,
2520        Sns_display_monitor_attributes_list,
2521        0, 1, 0,
2522        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2524 The optional argument TERMINAL specifies which display to ask about.
2525 TERMINAL should be a terminal object, a frame or a display name (a string).
2526 If omitted or nil, that stands for the selected frame's display.
2528 In addition to the standard attribute keys listed in
2529 `display-monitor-attributes-list', the following keys are contained in
2530 the attributes:
2532  source -- String describing the source from which multi-monitor
2533            information is obtained, \"NS\" is always the source."
2535 Internal use only, use `display-monitor-attributes-list' instead.  */)
2536   (Lisp_Object terminal)
2538   struct terminal *term = decode_live_terminal (terminal);
2539   NSArray *screens;
2540   NSUInteger i, n_monitors;
2541   struct MonitorInfo *monitors;
2542   Lisp_Object attributes_list = Qnil;
2543   CGFloat primary_display_height = 0;
2545   if (term->type != output_ns)
2546     return Qnil;
2548   screens = [NSScreen screens];
2549   n_monitors = [screens count];
2550   if (n_monitors == 0)
2551     return Qnil;
2553   monitors = xzalloc (n_monitors * sizeof *monitors);
2555   for (i = 0; i < [screens count]; ++i)
2556     {
2557       NSScreen *s = [screens objectAtIndex:i];
2558       struct MonitorInfo *m = &monitors[i];
2559       NSRect fr = [s frame];
2560       NSRect vfr = [s visibleFrame];
2561       short y, vy;
2563 #ifdef NS_IMPL_COCOA
2564       NSDictionary *dict = [s deviceDescription];
2565       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2566       CGDirectDisplayID did = [nid unsignedIntValue];
2567 #endif
2568       if (i == 0)
2569         {
2570           primary_display_height = fr.size.height;
2571           y = (short) fr.origin.y;
2572           vy = (short) vfr.origin.y;
2573         }
2574       else
2575         {
2576           // Flip y coordinate as NS has y starting from the bottom.
2577           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2578           vy = (short) (primary_display_height -
2579                         vfr.size.height - vfr.origin.y);
2580         }
2582       m->geom.x = (short) fr.origin.x;
2583       m->geom.y = y;
2584       m->geom.width = (unsigned short) fr.size.width;
2585       m->geom.height = (unsigned short) fr.size.height;
2587       m->work.x = (short) vfr.origin.x;
2588       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2589       // and fr.size.height - vfr.size.height are pixels missing in total.
2590       // Pixels missing at top are
2591       // fr.size.height - vfr.size.height - vy + y.
2592       // work.y is then pixels missing at top + y.
2593       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2594       m->work.width = (unsigned short) vfr.size.width;
2595       m->work.height = (unsigned short) vfr.size.height;
2597 #ifdef NS_IMPL_COCOA
2598       m->name = ns_screen_name (did);
2600       {
2601         CGSize mms = CGDisplayScreenSize (did);
2602         m->mm_width = (int) mms.width;
2603         m->mm_height = (int) mms.height;
2604       }
2606 #else
2607       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2608       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2609       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2610 #endif
2611     }
2613   // Primary monitor is always first for NS.
2614   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2615                                                     0, "NS");
2617   free_monitors (monitors, n_monitors);
2618   return attributes_list;
2622 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2623        0, 1, 0,
2624        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2625 The optional argument TERMINAL specifies which display to ask about.
2626 TERMINAL should be a terminal object, a frame or a display name (a string).
2627 If omitted or nil, that stands for the selected frame's display.  */)
2628   (Lisp_Object terminal)
2630   check_ns_display_info (terminal);
2631   return make_number
2632     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2636 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2637        0, 1, 0,
2638        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2639 The optional argument TERMINAL specifies which display to ask about.
2640 TERMINAL should be a terminal object, a frame or a display name (a string).
2641 If omitted or nil, that stands for the selected frame's display.  */)
2642   (Lisp_Object terminal)
2644   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2645   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2646   return make_number (1 << min (dpyinfo->n_planes, 24));
2650 /* Unused dummy def needed for compatibility. */
2651 Lisp_Object tip_frame;
2653 /* TODO: move to xdisp or similar */
2654 static void
2655 compute_tip_xy (struct frame *f,
2656                 Lisp_Object parms,
2657                 Lisp_Object dx,
2658                 Lisp_Object dy,
2659                 int width,
2660                 int height,
2661                 int *root_x,
2662                 int *root_y)
2664   Lisp_Object left, top, right, bottom;
2665   EmacsView *view = FRAME_NS_VIEW (f);
2666   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2667   NSPoint pt;
2669   /* Start with user-specified or mouse position.  */
2670   left = Fcdr (Fassq (Qleft, parms));
2671   top = Fcdr (Fassq (Qtop, parms));
2672   right = Fcdr (Fassq (Qright, parms));
2673   bottom = Fcdr (Fassq (Qbottom, parms));
2675   if ((!INTEGERP (left) && !INTEGERP (right))
2676       || (!INTEGERP (top) && !INTEGERP (bottom)))
2677     {
2678       pt.x = dpyinfo->last_mouse_motion_x;
2679       pt.y = dpyinfo->last_mouse_motion_y;
2680       /* Convert to screen coordinates */
2681       pt = [view convertPoint: pt toView: nil];
2682 #if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
2683       pt = [[view window] convertBaseToScreen: pt];
2684 #else
2685       {
2686         NSRect r = NSMakeRect (pt.x, pt.y, 0, 0);
2687         r = [[view window] convertRectToScreen: r];
2688         pt.x = r.origin.x;
2689         pt.y = r.origin.y;
2690       }
2691 #endif
2692     }
2693   else
2694     {
2695       /* Absolute coordinates.  */
2696       pt.x = INTEGERP (left) ? XINT (left) : XINT (right);
2697       pt.y = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
2698               - (INTEGERP (top) ? XINT (top) : XINT (bottom))
2699               - height);
2700     }
2702   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2703   if (INTEGERP (left) || INTEGERP (right))
2704     *root_x = pt.x;
2705   else if (pt.x + XINT (dx) <= 0)
2706     *root_x = 0; /* Can happen for negative dx */
2707   else if (pt.x + XINT (dx) + width
2708            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2709     /* It fits to the right of the pointer.  */
2710     *root_x = pt.x + XINT (dx);
2711   else if (width + XINT (dx) <= pt.x)
2712     /* It fits to the left of the pointer.  */
2713     *root_x = pt.x - width - XINT (dx);
2714   else
2715     /* Put it left justified on the screen -- it ought to fit that way.  */
2716     *root_x = 0;
2718   if (INTEGERP (top) || INTEGERP (bottom))
2719     *root_y = pt.y;
2720   else if (pt.y - XINT (dy) - height >= 0)
2721     /* It fits below the pointer.  */
2722     *root_y = pt.y - height - XINT (dy);
2723   else if (pt.y + XINT (dy) + height
2724            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2725     /* It fits above the pointer */
2726       *root_y = pt.y + XINT (dy);
2727   else
2728     /* Put it on the top.  */
2729     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2733 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2734        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2735 A tooltip window is a small window displaying a string.
2737 This is an internal function; Lisp code should call `tooltip-show'.
2739 FRAME nil or omitted means use the selected frame.
2741 PARMS is an optional list of frame parameters which can be used to
2742 change the tooltip's appearance.
2744 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2745 means use the default timeout of 5 seconds.
2747 If the list of frame parameters PARMS contains a `left' parameter,
2748 display the tooltip at that x-position.  If the list of frame parameters
2749 PARMS contains no `left' but a `right' parameter, display the tooltip
2750 right-adjusted at that x-position. Otherwise display it at the
2751 x-position of the mouse, with offset DX added (default is 5 if DX isn't
2752 specified).
2754 Likewise for the y-position: If a `top' frame parameter is specified, it
2755 determines the position of the upper edge of the tooltip window.  If a
2756 `bottom' parameter but no `top' frame parameter is specified, it
2757 determines the position of the lower edge of the tooltip window.
2758 Otherwise display the tooltip window at the y-position of the mouse,
2759 with offset DY added (default is -10).
2761 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2762 Text larger than the specified size is clipped.  */)
2763      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2765   int root_x, root_y;
2766   ptrdiff_t count = SPECPDL_INDEX ();
2767   struct frame *f;
2768   char *str;
2769   NSSize size;
2771   specbind (Qinhibit_redisplay, Qt);
2773   CHECK_STRING (string);
2774   str = SSDATA (string);
2775   f = decode_window_system_frame (frame);
2776   if (NILP (timeout))
2777     timeout = make_number (5);
2778   else
2779     CHECK_NATNUM (timeout);
2781   if (NILP (dx))
2782     dx = make_number (5);
2783   else
2784     CHECK_NUMBER (dx);
2786   if (NILP (dy))
2787     dy = make_number (-10);
2788   else
2789     CHECK_NUMBER (dy);
2791   block_input ();
2792   if (ns_tooltip == nil)
2793     ns_tooltip = [[EmacsTooltip alloc] init];
2794   else
2795     Fx_hide_tip ();
2797   [ns_tooltip setText: str];
2798   size = [ns_tooltip frame].size;
2800   /* Move the tooltip window where the mouse pointer is.  Resize and
2801      show it.  */
2802   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2803                   &root_x, &root_y);
2805   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2806   unblock_input ();
2808   return unbind_to (count, Qnil);
2812 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2813        doc: /* Hide the current tooltip window, if there is any.
2814 Value is t if tooltip was open, nil otherwise.  */)
2815      (void)
2817   if (ns_tooltip == nil || ![ns_tooltip isActive])
2818     return Qnil;
2819   [ns_tooltip hide];
2820   return Qt;
2823 /* Return geometric attributes of FRAME.  According to the value of
2824    ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner
2825    edges of FRAME, the root window edges of frame (Qroot_edges).  Any
2826    other value means to return the geometry as returned by
2827    Fx_frame_geometry.  */
2828 static Lisp_Object
2829 frame_geometry (Lisp_Object frame, Lisp_Object attribute)
2831   struct frame *f = decode_live_frame (frame);
2832   Lisp_Object fullscreen_symbol = Fframe_parameter (frame, Qfullscreen);
2833   bool fullscreen = (EQ (fullscreen_symbol, Qfullboth)
2834                      || EQ (fullscreen_symbol, Qfullscreen));
2835   int border = fullscreen ? 0 : f->border_width;
2836   int title_height = fullscreen ? 0 : FRAME_NS_TITLEBAR_HEIGHT (f);
2837   int native_width = FRAME_PIXEL_WIDTH (f);
2838   int native_height = FRAME_PIXEL_HEIGHT (f);
2839   int outer_width = native_width + 2 * border;
2840   int outer_height = native_height + 2 * border + title_height;
2841   int native_left = f->left_pos + border;
2842   int native_top = f->top_pos + border + title_height;
2843   int native_right = f->left_pos + outer_width - border;
2844   int native_bottom = f->top_pos + outer_height - border;
2845   int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f);
2846   int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f);
2847   int tool_bar_width = (tool_bar_height
2848                         ? outer_width - 2 * internal_border_width
2849                         : 0);
2851   /* Construct list.  */
2852   if (EQ (attribute, Qouter_edges))
2853     return list4 (make_number (f->left_pos), make_number (f->top_pos),
2854                   make_number (f->left_pos + outer_width),
2855                   make_number (f->top_pos + outer_height));
2856   else if (EQ (attribute, Qnative_edges))
2857     return list4 (make_number (native_left), make_number (native_top),
2858                   make_number (native_right), make_number (native_bottom));
2859   else if (EQ (attribute, Qinner_edges))
2860     return list4 (make_number (native_left + internal_border_width),
2861                   make_number (native_top
2862                                + tool_bar_height
2863                                + internal_border_width),
2864                   make_number (native_right - internal_border_width),
2865                   make_number (native_bottom - internal_border_width));
2866   else
2867     return
2868       listn (CONSTYPE_HEAP, 10,
2869              Fcons (Qouter_position,
2870                     Fcons (make_number (f->left_pos),
2871                            make_number (f->top_pos))),
2872              Fcons (Qouter_size,
2873                     Fcons (make_number (outer_width),
2874                            make_number (outer_height))),
2875              Fcons (Qexternal_border_size,
2876                     (fullscreen
2877                      ? Fcons (make_number (0), make_number (0))
2878                      : Fcons (make_number (border), make_number (border)))),
2879              Fcons (Qtitle_bar_size,
2880                     Fcons (make_number (0), make_number (title_height))),
2881              Fcons (Qmenu_bar_external, Qnil),
2882              Fcons (Qmenu_bar_size, Fcons (make_number (0), make_number (0))),
2883              Fcons (Qtool_bar_external,
2884                     FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil),
2885              Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)),
2886              Fcons (Qtool_bar_size,
2887                     Fcons (make_number (tool_bar_width),
2888                            make_number (tool_bar_height))),
2889              Fcons (Qinternal_border_width,
2890                     make_number (internal_border_width)));
2893 DEFUN ("ns-frame-geometry", Fns_frame_geometry, Sns_frame_geometry, 0, 1, 0,
2894        doc: /* Return geometric attributes of FRAME.
2895 FRAME must be a live frame and defaults to the selected one.  The return
2896 value is an association list of the attributes listed below.  All height
2897 and width values are in pixels.
2899 `outer-position' is a cons of the outer left and top edges of FRAME
2900   relative to the origin - the position (0, 0) - of FRAME's display.
2902 `outer-size' is a cons of the outer width and height of FRAME.  The
2903   outer size includes the title bar and the external borders as well as
2904   any menu and/or tool bar of frame.
2906 `external-border-size' is a cons of the horizontal and vertical width of
2907   FRAME's external borders as supplied by the window manager.
2909 `title-bar-size' is a cons of the width and height of the title bar of
2910   FRAME as supplied by the window manager.  If both of them are zero,
2911   FRAME has no title bar.  If only the width is zero, Emacs was not
2912   able to retrieve the width information.
2914 `menu-bar-external', if non-nil, means the menu bar is external (never
2915   included in the inner edges of FRAME).
2917 `menu-bar-size' is a cons of the width and height of the menu bar of
2918   FRAME.
2920 `tool-bar-external', if non-nil, means the tool bar is external (never
2921   included in the inner edges of FRAME).
2923 `tool-bar-position' tells on which side the tool bar on FRAME is and can
2924   be one of `left', `top', `right' or `bottom'.  If this is nil, FRAME
2925   has no tool bar.
2927 `tool-bar-size' is a cons of the width and height of the tool bar of
2928   FRAME.
2930 `internal-border-width' is the width of the internal border of
2931   FRAME.  */)
2932   (Lisp_Object frame)
2934   return frame_geometry (frame, Qnil);
2937 DEFUN ("ns-frame-edges", Fns_frame_edges, Sns_frame_edges, 0, 2, 0,
2938        doc: /* Return edge coordinates of FRAME.
2939 FRAME must be a live frame and defaults to the selected one.  The return
2940 value is a list of the form (LEFT, TOP, RIGHT, BOTTOM).  All values are
2941 in pixels relative to the origin - the position (0, 0) - of FRAME's
2942 display.
2944 If optional argument TYPE is the symbol `outer-edges', return the outer
2945 edges of FRAME.  The outer edges comprise the decorations of the window
2946 manager (like the title bar or external borders) as well as any external
2947 menu or tool bar of FRAME.  If optional argument TYPE is the symbol
2948 `native-edges' or nil, return the native edges of FRAME.  The native
2949 edges exclude the decorations of the window manager and any external
2950 menu or tool bar of FRAME.  If TYPE is the symbol `inner-edges', return
2951 the inner edges of FRAME.  These edges exclude title bar, any borders,
2952 menu bar or tool bar of FRAME.  */)
2953   (Lisp_Object frame, Lisp_Object type)
2955   return frame_geometry (frame, ((EQ (type, Qouter_edges)
2956                                   || EQ (type, Qinner_edges))
2957                                  ? type
2958                                  : Qnative_edges));
2961 /* ==========================================================================
2963     Class implementations
2965    ========================================================================== */
2968   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2969   Return YES if handled, NO if not.
2970  */
2971 static BOOL
2972 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2974   NSString *s;
2975   int i;
2976   BOOL ret = NO;
2978   if ([theEvent type] != NSKeyDown) return NO;
2979   s = [theEvent characters];
2981   for (i = 0; i < [s length]; ++i)
2982     {
2983       int ch = (int) [s characterAtIndex: i];
2984       switch (ch)
2985         {
2986         case NSHomeFunctionKey:
2987         case NSDownArrowFunctionKey:
2988         case NSUpArrowFunctionKey:
2989         case NSLeftArrowFunctionKey:
2990         case NSRightArrowFunctionKey:
2991         case NSPageUpFunctionKey:
2992         case NSPageDownFunctionKey:
2993         case NSEndFunctionKey:
2994           /* Don't send command modified keys, as those are handled in the
2995              performKeyEquivalent method of the super class.
2996           */
2997           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2998             {
2999               [panel sendEvent: theEvent];
3000               ret = YES;
3001             }
3002           break;
3003           /* As we don't have the standard key commands for
3004              copy/paste/cut/select-all in our edit menu, we must handle
3005              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
3006              here, paste works, because we have that in our Edit menu.
3007              I.e. refactor out code in nsterm.m, keyDown: to figure out the
3008              correct modifier.
3009           */
3010         case 'x': // Cut
3011         case 'c': // Copy
3012         case 'v': // Paste
3013         case 'a': // Select all
3014           if ([theEvent modifierFlags] & NSCommandKeyMask)
3015             {
3016               [NSApp sendAction:
3017                        (ch == 'x'
3018                         ? @selector(cut:)
3019                         : (ch == 'c'
3020                            ? @selector(copy:)
3021                            : (ch == 'v'
3022                               ? @selector(paste:)
3023                               : @selector(selectAll:))))
3024                              to:nil from:panel];
3025               ret = YES;
3026             }
3027         default:
3028           // Send all control keys, as the text field supports C-a, C-f, C-e
3029           // C-b and more.
3030           if ([theEvent modifierFlags] & NSControlKeyMask)
3031             {
3032               [panel sendEvent: theEvent];
3033               ret = YES;
3034             }
3035           break;
3036         }
3037     }
3040   return ret;
3043 @implementation EmacsSavePanel
3044 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3046   BOOL ret = handlePanelKeys (self, theEvent);
3047   if (! ret)
3048     ret = [super performKeyEquivalent:theEvent];
3049   return ret;
3051 @end
3054 @implementation EmacsOpenPanel
3055 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3057   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
3058   BOOL ret = handlePanelKeys (self, theEvent);
3059   if (! ret)
3060     ret = [super performKeyEquivalent:theEvent];
3061   return ret;
3063 @end
3066 @implementation EmacsFileDelegate
3067 /* --------------------------------------------------------------------------
3068    Delegate methods for Open/Save panels
3069    -------------------------------------------------------------------------- */
3070 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
3072   return YES;
3074 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
3076   return YES;
3078 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
3079           confirmed: (BOOL)okFlag
3081   return filename;
3083 @end
3085 #endif
3088 /* ==========================================================================
3090     Lisp interface declaration
3092    ========================================================================== */
3095 void
3096 syms_of_nsfns (void)
3098   DEFSYM (Qfontsize, "fontsize");
3100   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
3101                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
3102 If the title of a frame matches REGEXP, then IMAGE.tiff is
3103 selected as the image of the icon representing the frame when it's
3104 miniaturized.  If an element is t, then Emacs tries to select an icon
3105 based on the filetype of the visited file.
3107 The images have to be installed in a folder called English.lproj in the
3108 Emacs folder.  You have to restart Emacs after installing new icons.
3110 Example: Install an icon Gnus.tiff and execute the following code
3112   (setq ns-icon-type-alist
3113         (append ns-icon-type-alist
3114                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
3115                    . \"Gnus\"))))
3117 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
3118 be used as the image of the icon representing the frame.  */);
3119   Vns_icon_type_alist = list1 (Qt);
3121   DEFVAR_LISP ("ns-version-string", Vns_version_string,
3122                doc: /* Toolkit version for NS Windowing.  */);
3123   Vns_version_string = ns_appkit_version_str ();
3125   defsubr (&Sns_read_file_name);
3126   defsubr (&Sns_get_resource);
3127   defsubr (&Sns_set_resource);
3128   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
3129   defsubr (&Sx_display_grayscale_p);
3130   defsubr (&Sns_font_name);
3131   defsubr (&Sns_list_colors);
3132 #ifdef NS_IMPL_COCOA
3133   defsubr (&Sns_do_applescript);
3134 #endif
3135   defsubr (&Sxw_color_defined_p);
3136   defsubr (&Sxw_color_values);
3137   defsubr (&Sx_server_max_request_size);
3138   defsubr (&Sx_server_vendor);
3139   defsubr (&Sx_server_version);
3140   defsubr (&Sx_display_pixel_width);
3141   defsubr (&Sx_display_pixel_height);
3142   defsubr (&Sns_display_monitor_attributes_list);
3143   defsubr (&Sns_frame_geometry);
3144   defsubr (&Sns_frame_edges);
3145   defsubr (&Sx_display_mm_width);
3146   defsubr (&Sx_display_mm_height);
3147   defsubr (&Sx_display_screens);
3148   defsubr (&Sx_display_planes);
3149   defsubr (&Sx_display_color_cells);
3150   defsubr (&Sx_display_visual_class);
3151   defsubr (&Sx_display_backing_store);
3152   defsubr (&Sx_display_save_under);
3153   defsubr (&Sx_create_frame);
3154   defsubr (&Sx_open_connection);
3155   defsubr (&Sx_close_connection);
3156   defsubr (&Sx_display_list);
3158   defsubr (&Sns_hide_others);
3159   defsubr (&Sns_hide_emacs);
3160   defsubr (&Sns_emacs_info_panel);
3161   defsubr (&Sns_list_services);
3162   defsubr (&Sns_perform_service);
3163   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3164   defsubr (&Sns_popup_font_panel);
3165   defsubr (&Sns_popup_color_panel);
3167   defsubr (&Sx_show_tip);
3168   defsubr (&Sx_hide_tip);
3170   as_status = 0;
3171   as_script = Qnil;
3172   as_result = 0;