Make [:print:] support non-ASCII characters correctly
[emacs.git] / src / nsfns.m
blobf8863e6d40015eb28ff2d72b8a33cdd739990ed4
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 #ifdef GLYPH_DEBUG
74 static ptrdiff_t image_cache_refcount;
75 #endif
78 /* ==========================================================================
80     Internal utility functions
82    ========================================================================== */
84 /* Let the user specify a Nextstep display with a Lisp object.
85    OBJECT may be nil, a frame or a terminal object.
86    nil stands for the selected frame--or, if that is not a Nextstep frame,
87    the first Nextstep display on the list.  */
89 static struct ns_display_info *
90 check_ns_display_info (Lisp_Object object)
92   struct ns_display_info *dpyinfo = NULL;
94   if (NILP (object))
95     {
96       struct frame *sf = XFRAME (selected_frame);
98       if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
99         dpyinfo = FRAME_DISPLAY_INFO (sf);
100       else if (x_display_list != 0)
101         dpyinfo = x_display_list;
102       else
103         error ("Nextstep windows are not in use or not initialized");
104     }
105   else if (TERMINALP (object))
106     {
107       struct terminal *t = decode_live_terminal (object);
109       if (t->type != output_ns)
110         error ("Terminal %d is not a Nextstep display", t->id);
112       dpyinfo = t->display_info.ns;
113     }
114   else if (STRINGP (object))
115     dpyinfo = ns_display_info_for_name (object);
116   else
117     {
118       struct frame *f = decode_window_system_frame (object);
119       dpyinfo = FRAME_DISPLAY_INFO (f);
120     }
122   return dpyinfo;
126 static id
127 ns_get_window (Lisp_Object maybeFrame)
129   id view =nil, window =nil;
131   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
132     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
134   if (!NILP (maybeFrame))
135     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
136   if (view) window =[view window];
138   return window;
142 /* Return the X display structure for the display named NAME.
143    Open a new connection if necessary.  */
144 struct ns_display_info *
145 ns_display_info_for_name (Lisp_Object name)
147   struct ns_display_info *dpyinfo;
149   CHECK_STRING (name);
151   for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
152     if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
153       return dpyinfo;
155   error ("Emacs for Nextstep does not yet support multi-display");
157   Fx_open_connection (name, Qnil, Qnil);
158   dpyinfo = x_display_list;
160   if (dpyinfo == 0)
161     error ("Display on %s not responding.\n", SDATA (name));
163   return dpyinfo;
166 static NSString *
167 ns_filename_from_panel (NSSavePanel *panel)
169 #ifdef NS_IMPL_COCOA
170   NSURL *url = [panel URL];
171   NSString *str = [url path];
172   return str;
173 #else
174   return [panel filename];
175 #endif
178 static NSString *
179 ns_directory_from_panel (NSSavePanel *panel)
181 #ifdef NS_IMPL_COCOA
182   NSURL *url = [panel directoryURL];
183   NSString *str = [url path];
184   return str;
185 #else
186   return [panel directory];
187 #endif
190 static Lisp_Object
191 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
192 /* --------------------------------------------------------------------------
193    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
194    -------------------------------------------------------------------------- */
196   int i, count;
197   NSMenuItem *item;
198   const char *name;
199   Lisp_Object nameStr;
200   unsigned short key;
201   NSString *keys;
202   Lisp_Object res;
204   count = [menu numberOfItems];
205   for (i = 0; i<count; i++)
206     {
207       item = [menu itemAtIndex: i];
208       name = [[item title] UTF8String];
209       if (!name) continue;
211       nameStr = build_string (name);
213       if ([item hasSubmenu])
214         {
215           old = interpret_services_menu ([item submenu],
216                                         Fcons (nameStr, prefix), old);
217         }
218       else
219         {
220           keys = [item keyEquivalent];
221           if (keys && [keys length] )
222             {
223               key = [keys characterAtIndex: 0];
224               res = make_number (key|super_modifier);
225             }
226           else
227             {
228               res = Qundefined;
229             }
230           old = Fcons (Fcons (res,
231                             Freverse (Fcons (nameStr,
232                                            prefix))),
233                     old);
234         }
235     }
236   return old;
241 /* ==========================================================================
243     Frame parameter setters
245    ========================================================================== */
248 static void
249 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
251   NSColor *col;
252   EmacsCGFloat r, g, b, alpha;
254   /* Must block_input, because ns_lisp_to_color does block/unblock_input
255      which means that col may be deallocated in its unblock_input if there
256      is user input, unless we also block_input.  */
257   block_input ();
258   if (ns_lisp_to_color (arg, &col))
259     {
260       store_frame_param (f, Qforeground_color, oldval);
261       unblock_input ();
262       error ("Unknown color");
263     }
265   [col retain];
266   [f->output_data.ns->foreground_color release];
267   f->output_data.ns->foreground_color = col;
269   [col getRed: &r green: &g blue: &b alpha: &alpha];
270   FRAME_FOREGROUND_PIXEL (f) =
271     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
273   if (FRAME_NS_VIEW (f))
274     {
275       update_face_from_frame_parameter (f, Qforeground_color, arg);
276       /*recompute_basic_faces (f); */
277       if (FRAME_VISIBLE_P (f))
278         SET_FRAME_GARBAGED (f);
279     }
280   unblock_input ();
284 static void
285 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
287   struct face *face;
288   NSColor *col;
289   NSView *view = FRAME_NS_VIEW (f);
290   EmacsCGFloat r, g, b, alpha;
292   block_input ();
293   if (ns_lisp_to_color (arg, &col))
294     {
295       store_frame_param (f, Qbackground_color, oldval);
296       unblock_input ();
297       error ("Unknown color");
298     }
300   /* clear the frame; in some instances the NS-internal GC appears not to
301      update, or it does update and cannot clear old text properly */
302   if (FRAME_VISIBLE_P (f))
303     ns_clear_frame (f);
305   [col retain];
306   [f->output_data.ns->background_color release];
307   f->output_data.ns->background_color = col;
309   [col getRed: &r green: &g blue: &b alpha: &alpha];
310   FRAME_BACKGROUND_PIXEL (f) =
311     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
313   if (view != nil)
314     {
315       [[view window] setBackgroundColor: col];
317       if (alpha != (EmacsCGFloat) 1.0)
318           [[view window] setOpaque: NO];
319       else
320           [[view window] setOpaque: YES];
322       face = FRAME_DEFAULT_FACE (f);
323       if (face)
324         {
325           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
326           face->background = ns_index_color
327             ([col colorWithAlphaComponent: alpha], f);
329           update_face_from_frame_parameter (f, Qbackground_color, arg);
330         }
332       if (FRAME_VISIBLE_P (f))
333         SET_FRAME_GARBAGED (f);
334     }
335   unblock_input ();
339 static void
340 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
342   NSColor *col;
344   block_input ();
345   if (ns_lisp_to_color (arg, &col))
346     {
347       store_frame_param (f, Qcursor_color, oldval);
348       unblock_input ();
349       error ("Unknown color");
350     }
352   [FRAME_CURSOR_COLOR (f) release];
353   FRAME_CURSOR_COLOR (f) = [col retain];
355   if (FRAME_VISIBLE_P (f))
356     {
357       x_update_cursor (f, 0);
358       x_update_cursor (f, 1);
359     }
360   update_face_from_frame_parameter (f, Qcursor_color, arg);
361   unblock_input ();
365 static void
366 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
368   NSView *view = FRAME_NS_VIEW (f);
369   NSTRACE (x_set_icon_name);
371   /* see if it's changed */
372   if (STRINGP (arg))
373     {
374       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
375         return;
376     }
377   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
378     return;
380   fset_icon_name (f, arg);
382   if (NILP (arg))
383     {
384       if (!NILP (f->title))
385         arg = f->title;
386       else
387         /* Explicit name and no icon-name -> explicit_name.  */
388         if (f->explicit_name)
389           arg = f->name;
390         else
391           {
392             /* No explicit name and no icon-name ->
393                name has to be rebuild from icon_title_format.  */
394             windows_or_buffers_changed = 62;
395             return;
396           }
397     }
399   /* Don't change the name if it's already NAME.  */
400   if ([[view window] miniwindowTitle]
401       && ([[[view window] miniwindowTitle]
402              isEqualToString: [NSString stringWithUTF8String:
403                                           SSDATA (arg)]]))
404     return;
406   [[view window] setMiniwindowTitle:
407         [NSString stringWithUTF8String: SSDATA (arg)]];
410 static void
411 ns_set_name_internal (struct frame *f, Lisp_Object name)
413   struct gcpro gcpro1;
414   Lisp_Object encoded_name, encoded_icon_name;
415   NSString *str;
416   NSView *view = FRAME_NS_VIEW (f);
418   GCPRO1 (name);
419   encoded_name = ENCODE_UTF_8 (name);
420   UNGCPRO;
422   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
424   /* Don't change the name if it's already NAME.  */
425   if (! [[[view window] title] isEqualToString: str])
426     [[view window] setTitle: str];
428   if (!STRINGP (f->icon_name))
429     encoded_icon_name = encoded_name;
430   else
431     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
433   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
435   if ([[view window] miniwindowTitle]
436       && ! [[[view window] miniwindowTitle] isEqualToString: str])
437     [[view window] setMiniwindowTitle: str];
441 static void
442 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
444   NSTRACE (ns_set_name);
446   /* Make sure that requests from lisp code override requests from
447      Emacs redisplay code.  */
448   if (explicit)
449     {
450       /* If we're switching from explicit to implicit, we had better
451          update the mode lines and thereby update the title.  */
452       if (f->explicit_name && NILP (name))
453         update_mode_lines = 21;
455       f->explicit_name = ! NILP (name);
456     }
457   else if (f->explicit_name)
458     return;
460   if (NILP (name))
461     name = build_string ([ns_app_name UTF8String]);
462   else
463     CHECK_STRING (name);
465   /* Don't change the name if it's already NAME.  */
466   if (! NILP (Fstring_equal (name, f->name)))
467     return;
469   fset_name (f, name);
471   /* Title overrides explicit name.  */
472   if (! NILP (f->title))
473     name = f->title;
475   ns_set_name_internal (f, name);
479 /* This function should be called when the user's lisp code has
480    specified a name for the frame; the name will override any set by the
481    redisplay code.  */
482 static void
483 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
485   NSTRACE (x_explicitly_set_name);
486   ns_set_name (f, arg, 1);
490 /* This function should be called by Emacs redisplay code to set the
491    name; names set this way will never override names set by the user's
492    lisp code.  */
493 void
494 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
496   NSTRACE (x_implicitly_set_name);
498   /* Deal with NS specific format t.  */
499   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
500                          || EQ (Vframe_title_format, Qt)))
501     ns_set_name_as_filename (f);
502   else
503     ns_set_name (f, arg, 0);
507 /* Change the title of frame F to NAME.
508    If NAME is nil, use the frame name as the title.  */
510 static void
511 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
513   NSTRACE (x_set_title);
514   /* Don't change the title if it's already NAME.  */
515   if (EQ (name, f->title))
516     return;
518   update_mode_lines = 22;
520   fset_title (f, name);
522   if (NILP (name))
523     name = f->name;
524   else
525     CHECK_STRING (name);
527   ns_set_name_internal (f, name);
531 void
532 ns_set_name_as_filename (struct frame *f)
534   NSView *view;
535   Lisp_Object name, filename;
536   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
537   const char *title;
538   NSAutoreleasePool *pool;
539   struct gcpro gcpro1;
540   Lisp_Object encoded_name, encoded_filename;
541   NSString *str;
542   NSTRACE (ns_set_name_as_filename);
544   if (f->explicit_name || ! NILP (f->title))
545     return;
547   block_input ();
548   pool = [[NSAutoreleasePool alloc] init];
549   filename = BVAR (XBUFFER (buf), filename);
550   name = BVAR (XBUFFER (buf), name);
552   if (NILP (name))
553     {
554       if (! NILP (filename))
555         name = Ffile_name_nondirectory (filename);
556       else
557         name = build_string ([ns_app_name UTF8String]);
558     }
560   GCPRO1 (name);
561   encoded_name = ENCODE_UTF_8 (name);
562   UNGCPRO;
564   view = FRAME_NS_VIEW (f);
566   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
567                                 : [[[view window] title] UTF8String];
569   if (title && (! strcmp (title, SSDATA (encoded_name))))
570     {
571       [pool release];
572       unblock_input ();
573       return;
574     }
576   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
577   if (str == nil) str = @"Bad coding";
579   if (FRAME_ICONIFIED_P (f))
580     [[view window] setMiniwindowTitle: str];
581   else
582     {
583       NSString *fstr;
585       if (! NILP (filename))
586         {
587           GCPRO1 (filename);
588           encoded_filename = ENCODE_UTF_8 (filename);
589           UNGCPRO;
591           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
592           if (fstr == nil) fstr = @"";
593         }
594       else
595         fstr = @"";
597       ns_set_represented_filename (fstr, f);
598       [[view window] setTitle: str];
599       fset_name (f, name);
600     }
602   [pool release];
603   unblock_input ();
607 void
608 ns_set_doc_edited (void)
610   NSAutoreleasePool *pool;
611   Lisp_Object tail, frame;
612   block_input ();
613   pool = [[NSAutoreleasePool alloc] init];
614   FOR_EACH_FRAME (tail, frame)
615     {
616       BOOL edited = NO;
617       struct frame *f = XFRAME (frame);
618       struct window *w;
619       NSView *view;
621       if (! FRAME_NS_P (f)) continue;
622       w = XWINDOW (FRAME_SELECTED_WINDOW (f));
623       view = FRAME_NS_VIEW (f);
624       if (!MINI_WINDOW_P (w))
625         edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
626           ! NILP (Fbuffer_file_name (w->contents));
627       [[view window] setDocumentEdited: edited];
628     }
630   [pool release];
631   unblock_input ();
635 void
636 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
638   int nlines;
639   if (FRAME_MINIBUF_ONLY_P (f))
640     return;
642   if (TYPE_RANGED_INTEGERP (int, value))
643     nlines = XINT (value);
644   else
645     nlines = 0;
647   FRAME_MENU_BAR_LINES (f) = 0;
648   if (nlines)
649     {
650       FRAME_EXTERNAL_MENU_BAR (f) = 1;
651       /* does for all frames, whereas we just want for one frame
652          [NSMenu setMenuBarVisible: YES]; */
653     }
654   else
655     {
656       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
657         free_frame_menubar (f);
658       /*      [NSMenu setMenuBarVisible: NO]; */
659       FRAME_EXTERNAL_MENU_BAR (f) = 0;
660     }
664 /* toolbar support */
665 void
666 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
668   int nlines;
670   if (FRAME_MINIBUF_ONLY_P (f))
671     return;
673   if (RANGED_INTEGERP (0, value, INT_MAX))
674     nlines = XFASTINT (value);
675   else
676     nlines = 0;
678   if (nlines)
679     {
680       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
681       update_frame_tool_bar (f);
682     }
683   else
684     {
685       if (FRAME_EXTERNAL_TOOL_BAR (f))
686         {
687           free_frame_tool_bar (f);
688           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
689         }
690     }
692   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
696 void
697 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
699   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
701   CHECK_TYPE_RANGED_INTEGER (int, arg);
702   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
703   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
704     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
706   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
707     return;
709   if (FRAME_X_WINDOW (f) != 0)
710     adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
712   SET_FRAME_GARBAGED (f);
716 static void
717 ns_implicitly_set_icon_type (struct frame *f)
719   Lisp_Object tem;
720   EmacsView *view = FRAME_NS_VIEW (f);
721   id image = nil;
722   Lisp_Object chain, elt;
723   NSAutoreleasePool *pool;
724   BOOL setMini = YES;
726   NSTRACE (ns_implicitly_set_icon_type);
728   block_input ();
729   pool = [[NSAutoreleasePool alloc] init];
730   if (f->output_data.ns->miniimage
731       && [[NSString stringWithUTF8String: SSDATA (f->name)]
732                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
733     {
734       [pool release];
735       unblock_input ();
736       return;
737     }
739   tem = assq_no_quit (Qicon_type, f->param_alist);
740   if (CONSP (tem) && ! NILP (XCDR (tem)))
741     {
742       [pool release];
743       unblock_input ();
744       return;
745     }
747   for (chain = Vns_icon_type_alist;
748        image == nil && CONSP (chain);
749        chain = XCDR (chain))
750     {
751       elt = XCAR (chain);
752       /* special case: 't' means go by file type */
753       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
754         {
755           NSString *str
756              = [NSString stringWithUTF8String: SSDATA (f->name)];
757           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
758             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
759         }
760       else if (CONSP (elt) &&
761                STRINGP (XCAR (elt)) &&
762                STRINGP (XCDR (elt)) &&
763                fast_string_match (XCAR (elt), f->name) >= 0)
764         {
765           image = [EmacsImage allocInitFromFile: XCDR (elt)];
766           if (image == nil)
767             image = [[NSImage imageNamed:
768                                [NSString stringWithUTF8String:
769                                             SSDATA (XCDR (elt))]] retain];
770         }
771     }
773   if (image == nil)
774     {
775       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
776       setMini = NO;
777     }
779   [f->output_data.ns->miniimage release];
780   f->output_data.ns->miniimage = image;
781   [view setMiniwindowImage: setMini];
782   [pool release];
783   unblock_input ();
787 static void
788 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
790   EmacsView *view = FRAME_NS_VIEW (f);
791   id image = nil;
792   BOOL setMini = YES;
794   NSTRACE (x_set_icon_type);
796   if (!NILP (arg) && SYMBOLP (arg))
797     {
798       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
799       store_frame_param (f, Qicon_type, arg);
800     }
802   /* do it the implicit way */
803   if (NILP (arg))
804     {
805       ns_implicitly_set_icon_type (f);
806       return;
807     }
809   CHECK_STRING (arg);
811   image = [EmacsImage allocInitFromFile: arg];
812   if (image == nil)
813     image =[NSImage imageNamed: [NSString stringWithUTF8String:
814                                             SSDATA (arg)]];
816   if (image == nil)
817     {
818       image = [NSImage imageNamed: @"text"];
819       setMini = NO;
820     }
822   f->output_data.ns->miniimage = image;
823   [view setMiniwindowImage: setMini];
827 /* TODO: move to nsterm? */
829 ns_lisp_to_cursor_type (Lisp_Object arg)
831   char *str;
832   if (XTYPE (arg) == Lisp_String)
833     str = SSDATA (arg);
834   else if (XTYPE (arg) == Lisp_Symbol)
835     str = SSDATA (SYMBOL_NAME (arg));
836   else return -1;
837   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
838   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
839   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
840   if (!strcmp (str, "bar"))     return BAR_CURSOR;
841   if (!strcmp (str, "no"))      return NO_CURSOR;
842   return -1;
846 Lisp_Object
847 ns_cursor_type_to_lisp (int arg)
849   switch (arg)
850     {
851     case FILLED_BOX_CURSOR: return Qbox;
852     case HOLLOW_BOX_CURSOR: return Qhollow;
853     case HBAR_CURSOR:       return Qhbar;
854     case BAR_CURSOR:        return Qbar;
855     case NO_CURSOR:
856     default:                return intern ("no");
857     }
860 /* This is the same as the xfns.c definition.  */
861 static void
862 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
864   set_frame_cursor_types (f, arg);
867 /* called to set mouse pointer color, but all other terms use it to
868    initialize pointer types (and don't set the color ;) */
869 static void
870 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
872   /* don't think we can do this on Nextstep */
876 #define Str(x) #x
877 #define Xstr(x) Str(x)
879 static Lisp_Object
880 ns_appkit_version_str (void)
882   char tmp[256];
884 #ifdef NS_IMPL_GNUSTEP
885   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
886 #elif defined (NS_IMPL_COCOA)
887   NSString *osversion
888     = [[NSProcessInfo processInfo] operatingSystemVersionString];
889   sprintf(tmp, "appkit-%.2f %s",
890           NSAppKitVersionNumber,
891           [osversion UTF8String]);
892 #else
893   tmp = "ns-unknown";
894 #endif
895   return build_string (tmp);
899 /* This is for use by x-server-version and collapses all version info we
900    have into a single int.  For a better picture of the implementation
901    running, use ns_appkit_version_str.*/
902 static int
903 ns_appkit_version_int (void)
905 #ifdef NS_IMPL_GNUSTEP
906   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
907 #elif defined (NS_IMPL_COCOA)
908   return (int)NSAppKitVersionNumber;
909 #endif
910   return 0;
914 static void
915 x_icon (struct frame *f, Lisp_Object parms)
916 /* --------------------------------------------------------------------------
917    Strangely-named function to set icon position parameters in frame.
918    This is irrelevant under OS X, but might be needed under GNUstep,
919    depending on the window manager used.  Note, this is not a standard
920    frame parameter-setter; it is called directly from x-create-frame.
921    -------------------------------------------------------------------------- */
923   Lisp_Object icon_x, icon_y;
924   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
926   f->output_data.ns->icon_top = -1;
927   f->output_data.ns->icon_left = -1;
929   /* Set the position of the icon.  */
930   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
931   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
932   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
933     {
934       CHECK_NUMBER (icon_x);
935       CHECK_NUMBER (icon_y);
936       f->output_data.ns->icon_top = XINT (icon_y);
937       f->output_data.ns->icon_left = XINT (icon_x);
938     }
939   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
940     error ("Both left and top icon corners of icon must be specified");
944 /* Note: see frame.c for template, also where generic functions are impl */
945 frame_parm_handler ns_frame_parm_handlers[] =
947   x_set_autoraise, /* generic OK */
948   x_set_autolower, /* generic OK */
949   x_set_background_color,
950   0, /* x_set_border_color,  may be impossible under Nextstep */
951   0, /* x_set_border_width,  may be impossible under Nextstep */
952   x_set_cursor_color,
953   x_set_cursor_type,
954   x_set_font, /* generic OK */
955   x_set_foreground_color,
956   x_set_icon_name,
957   x_set_icon_type,
958   x_set_internal_border_width, /* generic OK */
959   0, /* x_set_right_divider_width */
960   0, /* x_set_bottom_divider_width */
961   x_set_menu_bar_lines,
962   x_set_mouse_color,
963   x_explicitly_set_name,
964   x_set_scroll_bar_width, /* generic OK */
965   x_set_scroll_bar_height, /* generic OK */
966   x_set_title,
967   x_set_unsplittable, /* generic OK */
968   x_set_vertical_scroll_bars, /* generic OK */
969   x_set_horizontal_scroll_bars, /* generic OK */
970   x_set_visibility, /* generic OK */
971   x_set_tool_bar_lines,
972   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
973   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
974   x_set_screen_gamma, /* generic OK */
975   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
976   x_set_left_fringe, /* generic OK */
977   x_set_right_fringe, /* generic OK */
978   0, /* x_set_wait_for_wm, will ignore */
979   x_set_fullscreen, /* generic OK */
980   x_set_font_backend, /* generic OK */
981   x_set_alpha,
982   0, /* x_set_sticky */
983   0, /* x_set_tool_bar_position */
987 /* Handler for signals raised during x_create_frame.
988    FRAME is the frame which is partially constructed.  */
990 static void
991 unwind_create_frame (Lisp_Object frame)
993   struct frame *f = XFRAME (frame);
995   /* If frame is already dead, nothing to do.  This can happen if the
996      display is disconnected after the frame has become official, but
997      before x_create_frame removes the unwind protect.  */
998   if (!FRAME_LIVE_P (f))
999     return;
1001   /* If frame is ``official'', nothing to do.  */
1002   if (NILP (Fmemq (frame, Vframe_list)))
1003     {
1004 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1005       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1006 #endif
1008       x_free_frame_resources (f);
1009       free_glyphs (f);
1011 #ifdef GLYPH_DEBUG
1012       /* Check that reference counts are indeed correct.  */
1013       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1014 #endif
1015     }
1019  * Read geometry related parameters from preferences if not in PARMS.
1020  * Returns the union of parms and any preferences read.
1021  */
1023 static Lisp_Object
1024 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1025                                Lisp_Object parms)
1027   struct {
1028     const char *val;
1029     const char *cls;
1030     Lisp_Object tem;
1031   } r[] = {
1032     { "width",  "Width", Qwidth },
1033     { "height", "Height", Qheight },
1034     { "left", "Left", Qleft },
1035     { "top", "Top", Qtop },
1036   };
1038   int i;
1039   for (i = 0; i < ARRAYELTS (r); ++i)
1040     {
1041       if (NILP (Fassq (r[i].tem, parms)))
1042         {
1043           Lisp_Object value
1044             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1045                          RES_TYPE_NUMBER);
1046           if (! EQ (value, Qunbound))
1047             parms = Fcons (Fcons (r[i].tem, value), parms);
1048         }
1049     }
1051   return parms;
1054 /* ==========================================================================
1056     Lisp definitions
1058    ========================================================================== */
1060 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1061        1, 1, 0,
1062        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1063 Return an Emacs frame object.
1064 PARMS is an alist of frame parameters.
1065 If the parameters specify that the frame should not have a minibuffer,
1066 and do not specify a specific minibuffer window to use,
1067 then `default-minibuffer-frame' must be a frame whose minibuffer can
1068 be shared by the new frame.
1070 This function is an internal primitive--use `make-frame' instead.  */)
1071      (Lisp_Object parms)
1073   struct frame *f;
1074   Lisp_Object frame, tem;
1075   Lisp_Object name;
1076   int minibuffer_only = 0;
1077   long window_prompting = 0;
1078   int width, height;
1079   ptrdiff_t count = specpdl_ptr - specpdl;
1080   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1081   Lisp_Object display;
1082   struct ns_display_info *dpyinfo = NULL;
1083   Lisp_Object parent;
1084   struct kboard *kb;
1085   static int desc_ctr = 1;
1087   /* x_get_arg modifies parms.  */
1088   parms = Fcopy_alist (parms);
1090   /* Use this general default value to start with
1091      until we know if this frame has a specified name.  */
1092   Vx_resource_name = Vinvocation_name;
1094   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1095   if (EQ (display, Qunbound))
1096     display = Qnil;
1097   dpyinfo = check_ns_display_info (display);
1098   kb = dpyinfo->terminal->kboard;
1100   if (!dpyinfo->terminal->name)
1101     error ("Terminal is not live, can't create new frames on it");
1103   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1104   if (!STRINGP (name)
1105       && ! EQ (name, Qunbound)
1106       && ! NILP (name))
1107     error ("Invalid frame name--not a string or nil");
1109   if (STRINGP (name))
1110     Vx_resource_name = name;
1112   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1113   if (EQ (parent, Qunbound))
1114     parent = Qnil;
1115   if (! NILP (parent))
1116     CHECK_NUMBER (parent);
1118   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1119   /* No need to protect DISPLAY because that's not used after passing
1120      it to make_frame_without_minibuffer.  */
1121   frame = Qnil;
1122   GCPRO4 (parms, parent, name, frame);
1123   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1124                   RES_TYPE_SYMBOL);
1125   if (EQ (tem, Qnone) || NILP (tem))
1126       f = make_frame_without_minibuffer (Qnil, kb, display);
1127   else if (EQ (tem, Qonly))
1128     {
1129       f = make_minibuffer_frame ();
1130       minibuffer_only = 1;
1131     }
1132   else if (WINDOWP (tem))
1133       f = make_frame_without_minibuffer (tem, kb, display);
1134   else
1135       f = make_frame (1);
1137   XSETFRAME (frame, f);
1139   f->terminal = dpyinfo->terminal;
1141   f->output_method = output_ns;
1142   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1144   FRAME_FONTSET (f) = -1;
1146   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1147                                 "iconName", "Title",
1148                                 RES_TYPE_STRING));
1149   if (! STRINGP (f->icon_name))
1150     fset_icon_name (f, Qnil);
1152   FRAME_DISPLAY_INFO (f) = dpyinfo;
1154   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1155   record_unwind_protect (unwind_create_frame, frame);
1157   f->output_data.ns->window_desc = desc_ctr++;
1158   if (TYPE_RANGED_INTEGERP (Window, parent))
1159     {
1160       f->output_data.ns->parent_desc = XFASTINT (parent);
1161       f->output_data.ns->explicit_parent = 1;
1162     }
1163   else
1164     {
1165       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1166       f->output_data.ns->explicit_parent = 0;
1167     }
1169   /* Set the name; the functions to which we pass f expect the name to
1170      be set.  */
1171   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1172     {
1173       fset_name (f, build_string ([ns_app_name UTF8String]));
1174       f->explicit_name = 0;
1175     }
1176   else
1177     {
1178       fset_name (f, name);
1179       f->explicit_name = 1;
1180       specbind (Qx_resource_name, name);
1181     }
1183   block_input ();
1185 #ifdef NS_IMPL_COCOA
1186     mac_register_font_driver (f);
1187 #else
1188     register_font_driver (&nsfont_driver, f);
1189 #endif
1191   x_default_parameter (f, parms, Qfont_backend, Qnil,
1192                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1194   {
1195     /* use for default font name */
1196     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1197     x_default_parameter (f, parms, Qfontsize,
1198                                     make_number (0 /*(int)[font pointSize]*/),
1199                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1200     // Remove ' Regular', not handled by backends.
1201     char *fontname = xstrdup ([[font displayName] UTF8String]);
1202     int len = strlen (fontname);
1203     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1204       fontname[len-8] = '\0';
1205     x_default_parameter (f, parms, Qfont,
1206                                  build_string (fontname),
1207                                  "font", "Font", RES_TYPE_STRING);
1208     xfree (fontname);
1209   }
1210   unblock_input ();
1212   x_default_parameter (f, parms, Qborder_width, make_number (0),
1213                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1214   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1215                       "internalBorderWidth", "InternalBorderWidth",
1216                       RES_TYPE_NUMBER);
1218   /* default vertical scrollbars on right on Mac */
1219   {
1220       Lisp_Object spos
1221 #ifdef NS_IMPL_GNUSTEP
1222           = Qt;
1223 #else
1224           = Qright;
1225 #endif
1226       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1227                            "verticalScrollBars", "VerticalScrollBars",
1228                            RES_TYPE_SYMBOL);
1229   }
1230   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil,
1231                        "horizontalScrollBars", "HorizontalScrollBars",
1232                        RES_TYPE_SYMBOL);
1233   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1234                       "foreground", "Foreground", RES_TYPE_STRING);
1235   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1236                       "background", "Background", RES_TYPE_STRING);
1237   /* FIXME: not supported yet in Nextstep */
1238   x_default_parameter (f, parms, Qline_spacing, Qnil,
1239                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1240   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1241                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1242   x_default_parameter (f, parms, Qright_fringe, Qnil,
1243                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1245 #ifdef GLYPH_DEBUG
1246   image_cache_refcount =
1247     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1248 #endif
1250   init_frame_faces (f);
1252   /* Read comment about this code in corresponding place in xfns.c.  */
1253   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1254                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
1255                      Qx_create_frame_1);
1257   /* The resources controlling the menu-bar and tool-bar are
1258      processed specially at startup, and reflected in the mode
1259      variables; ignore them here.  */
1260   x_default_parameter (f, parms, Qmenu_bar_lines,
1261                        NILP (Vmenu_bar_mode)
1262                        ? make_number (0) : make_number (1),
1263                        NULL, NULL, RES_TYPE_NUMBER);
1264   x_default_parameter (f, parms, Qtool_bar_lines,
1265                        NILP (Vtool_bar_mode)
1266                        ? make_number (0) : make_number (1),
1267                        NULL, NULL, RES_TYPE_NUMBER);
1269   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1270                        "BufferPredicate", RES_TYPE_SYMBOL);
1271   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1272                        RES_TYPE_STRING);
1274   parms = get_geometry_from_preferences (dpyinfo, parms);
1275   window_prompting = x_figure_window_size (f, parms, 1);
1277   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1278   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1280   /* NOTE: on other terms, this is done in set_mouse_color, however this
1281      was not getting called under Nextstep */
1282   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1283   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1284   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1285   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1286   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1287   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1288   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1289   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1290      = [NSCursor arrowCursor];
1291   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1292      = [NSCursor arrowCursor];
1293   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1295   [[EmacsView alloc] initFrameFromEmacs: f];
1297   x_icon (f, parms);
1299   /* ns_display_info does not have a reference_count.  */
1300   f->terminal->reference_count++;
1302   /* It is now ok to make the frame official even if we get an error below.
1303      The frame needs to be on Vframe_list or making it visible won't work. */
1304   Vframe_list = Fcons (frame, Vframe_list);
1306   x_default_parameter (f, parms, Qicon_type, Qnil,
1307                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1309   x_default_parameter (f, parms, Qauto_raise, Qnil,
1310                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1311   x_default_parameter (f, parms, Qauto_lower, Qnil,
1312                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1313   x_default_parameter (f, parms, Qcursor_type, Qbox,
1314                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1315   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1316                        "scrollBarWidth", "ScrollBarWidth",
1317                        RES_TYPE_NUMBER);
1318   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1319                        "scrollBarHeight", "ScrollBarHeight",
1320                        RES_TYPE_NUMBER);
1321   x_default_parameter (f, parms, Qalpha, Qnil,
1322                        "alpha", "Alpha", RES_TYPE_NUMBER);
1323   x_default_parameter (f, parms, Qfullscreen, Qnil,
1324                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1326   /* Allow x_set_window_size, now.  */
1327   f->can_x_set_window_size = true;
1329   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
1330                      Qx_create_frame_2);
1332   if (! f->output_data.ns->explicit_parent)
1333     {
1334       Lisp_Object visibility;
1336       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1337                               RES_TYPE_SYMBOL);
1338       if (EQ (visibility, Qunbound))
1339         visibility = Qt;
1341       if (EQ (visibility, Qicon))
1342         x_iconify_frame (f);
1343       else if (! NILP (visibility))
1344         {
1345           x_make_frame_visible (f);
1346           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1347         }
1348       else
1349         {
1350           /* Must have been Qnil.  */
1351         }
1352     }
1354   if (FRAME_HAS_MINIBUF_P (f)
1355       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1356           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1357     kset_default_minibuffer_frame (kb, frame);
1359   /* All remaining specified parameters, which have not been "used"
1360      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1361   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1362     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1363       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1365   UNGCPRO;
1367   if (window_prompting & USPosition)
1368     x_set_offset (f, f->left_pos, f->top_pos, 1);
1370   /* Make sure windows on this frame appear in calls to next-window
1371      and similar functions.  */
1372   Vwindow_list = Qnil;
1374   return unbind_to (count, frame);
1377 void
1378 x_focus_frame (struct frame *f)
1380   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1382   if (dpyinfo->x_focus_frame != f)
1383     {
1384       EmacsView *view = FRAME_NS_VIEW (f);
1385       block_input ();
1386       [NSApp activateIgnoringOtherApps: YES];
1387       [[view window] makeKeyAndOrderFront: view];
1388       unblock_input ();
1389     }
1393 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1394        0, 1, "",
1395        doc: /* Pop up the font panel. */)
1396      (Lisp_Object frame)
1398   struct frame *f = decode_window_system_frame (frame);
1399   id fm = [NSFontManager sharedFontManager];
1400   struct font *font = f->output_data.ns->font;
1401   NSFont *nsfont;
1402 #ifdef NS_IMPL_GNUSTEP
1403   nsfont = ((struct nsfont_info *)font)->nsfont;
1404 #endif
1405 #ifdef NS_IMPL_COCOA
1406   nsfont = (NSFont *) macfont_get_nsctfont (font);
1407 #endif
1408   [fm setSelectedFont: nsfont isMultiple: NO];
1409   [fm orderFrontFontPanel: NSApp];
1410   return Qnil;
1414 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1415        0, 1, "",
1416        doc: /* Pop up the color panel.  */)
1417      (Lisp_Object frame)
1419   check_window_system (NULL);
1420   [NSApp orderFrontColorPanel: NSApp];
1421   return Qnil;
1424 static struct
1426   id panel;
1427   BOOL ret;
1428 #ifdef NS_IMPL_GNUSTEP
1429   NSString *dirS, *initS;
1430   BOOL no_types;
1431 #endif
1432 } ns_fd_data;
1434 void
1435 ns_run_file_dialog (void)
1437   if (ns_fd_data.panel == nil) return;
1438 #ifdef NS_IMPL_COCOA
1439   ns_fd_data.ret = [ns_fd_data.panel runModal];
1440 #else
1441   if (ns_fd_data.no_types)
1442     {
1443       ns_fd_data.ret = [ns_fd_data.panel
1444                            runModalForDirectory: ns_fd_data.dirS
1445                            file: ns_fd_data.initS];
1446     }
1447   else
1448     {
1449       ns_fd_data.ret = [ns_fd_data.panel
1450                            runModalForDirectory: ns_fd_data.dirS
1451                            file: ns_fd_data.initS
1452                            types: nil];
1453     }
1454 #endif
1455   ns_fd_data.panel = nil;
1458 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1459        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1460 Optional arg DIR, if non-nil, supplies a default directory.
1461 Optional arg MUSTMATCH, if non-nil, means the returned file or
1462 directory must exist.
1463 Optional arg INIT, if non-nil, provides a default file name to use.
1464 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1465   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1466    Lisp_Object init, Lisp_Object dir_only_p)
1468   static id fileDelegate = nil;
1469   BOOL ret;
1470   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1471   id panel;
1472   Lisp_Object fname;
1474   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1475     [NSString stringWithUTF8String: SSDATA (prompt)];
1476   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1477     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1478     [NSString stringWithUTF8String: SSDATA (dir)];
1479   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1480     [NSString stringWithUTF8String: SSDATA (init)];
1481   NSEvent *nxev;
1483   check_window_system (NULL);
1485   if (fileDelegate == nil)
1486     fileDelegate = [EmacsFileDelegate new];
1488   [NSCursor setHiddenUntilMouseMoves: NO];
1490   if ([dirS characterAtIndex: 0] == '~')
1491     dirS = [dirS stringByExpandingTildeInPath];
1493   panel = isSave ?
1494     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1496   [panel setTitle: promptS];
1498   [panel setAllowsOtherFileTypes: YES];
1499   [panel setTreatsFilePackagesAsDirectories: YES];
1500   [panel setDelegate: fileDelegate];
1502   if (! NILP (dir_only_p))
1503     {
1504       [panel setCanChooseDirectories: YES];
1505       [panel setCanChooseFiles: NO];
1506     }
1507   else if (! isSave)
1508     {
1509       /* This is not quite what the documentation says, but it is compatible
1510          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1511       [panel setCanChooseDirectories: NO];
1512       [panel setCanChooseFiles: YES];
1513     }
1515   block_input ();
1516   ns_fd_data.panel = panel;
1517   ns_fd_data.ret = NO;
1518 #ifdef NS_IMPL_COCOA
1519   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1520     [panel setAllowedFileTypes: nil];
1521   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1522   if (initS && NILP (Ffile_directory_p (init)))
1523     [panel setNameFieldStringValue: [initS lastPathComponent]];
1524   else
1525     [panel setNameFieldStringValue: @""];
1527 #else
1528   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1529   ns_fd_data.dirS = dirS;
1530   ns_fd_data.initS = initS;
1531 #endif
1533   /* runModalForDirectory/runModal restarts the main event loop when done,
1534      so we must start an event loop and then pop up the file dialog.
1535      The file dialog may pop up a confirm dialog after Ok has been pressed,
1536      so we can not simply pop down on the Ok/Cancel press.
1537    */
1538   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1539                             location: NSMakePoint (0, 0)
1540                        modifierFlags: 0
1541                            timestamp: 0
1542                         windowNumber: [[NSApp mainWindow] windowNumber]
1543                              context: [NSApp context]
1544                              subtype: 0
1545                                data1: 0
1546                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1548   [NSApp postEvent: nxev atStart: NO];
1549   while (ns_fd_data.panel != nil)
1550     [NSApp run];
1552   ret = (ns_fd_data.ret == NSOKButton);
1554   if (ret)
1555     {
1556       NSString *str = ns_filename_from_panel (panel);
1557       if (! str) str = ns_directory_from_panel (panel);
1558       if (! str) ret = NO;
1559       else fname = build_string ([str UTF8String]);
1560     }
1562   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1563   unblock_input ();
1565   return ret ? fname : Qnil;
1568 const char *
1569 ns_get_defaults_value (const char *key)
1571   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1572                     objectForKey: [NSString stringWithUTF8String: key]];
1574   if (!obj) return NULL;
1576   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1580 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1581        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1582 If OWNER is nil, Emacs is assumed.  */)
1583      (Lisp_Object owner, Lisp_Object name)
1585   const char *value;
1587   check_window_system (NULL);
1588   if (NILP (owner))
1589     owner = build_string([ns_app_name UTF8String]);
1590   CHECK_STRING (name);
1592   value = ns_get_defaults_value (SSDATA (name));
1594   if (value)
1595     return build_string (value);
1596   return Qnil;
1600 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1601        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1602 If OWNER is nil, Emacs is assumed.
1603 If VALUE is nil, the default is removed.  */)
1604      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1606   check_window_system (NULL);
1607   if (NILP (owner))
1608     owner = build_string ([ns_app_name UTF8String]);
1609   CHECK_STRING (name);
1610   if (NILP (value))
1611     {
1612       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1613                          [NSString stringWithUTF8String: SSDATA (name)]];
1614     }
1615   else
1616     {
1617       CHECK_STRING (value);
1618       [[NSUserDefaults standardUserDefaults] setObject:
1619                 [NSString stringWithUTF8String: SSDATA (value)]
1620                                         forKey: [NSString stringWithUTF8String:
1621                                                          SSDATA (name)]];
1622     }
1624   return Qnil;
1628 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1629        Sx_server_max_request_size,
1630        0, 1, 0,
1631        doc: /* This function is a no-op.  It is only present for completeness.  */)
1632      (Lisp_Object terminal)
1634   check_ns_display_info (terminal);
1635   /* This function has no real equivalent under NeXTstep.  Return nil to
1636      indicate this. */
1637   return Qnil;
1641 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1642        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1643 \(Labeling every distributor as a "vendor" embodies the false assumption
1644 that operating systems cannot be developed and distributed noncommercially.)
1645 The optional argument TERMINAL specifies which display to ask about.
1646 TERMINAL should be a terminal object, a frame or a display name (a string).
1647 If omitted or nil, that stands for the selected frame's display.  */)
1648   (Lisp_Object terminal)
1650   check_ns_display_info (terminal);
1651 #ifdef NS_IMPL_GNUSTEP
1652   return build_string ("GNU");
1653 #else
1654   return build_string ("Apple");
1655 #endif
1659 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1660        doc: /* Return the version numbers of the server of display TERMINAL.
1661 The value is a list of three integers: the major and minor
1662 version numbers of the X Protocol in use, and the distributor-specific release
1663 number.  See also the function `x-server-vendor'.
1665 The optional argument TERMINAL specifies which display to ask about.
1666 TERMINAL should be a terminal object, a frame or a display name (a string).
1667 If omitted or nil, that stands for the selected frame's display.  */)
1668   (Lisp_Object terminal)
1670   check_ns_display_info (terminal);
1671   /*NOTE: it is unclear what would best correspond with "protocol";
1672           we return 10.3, meaning Panther, since this is roughly the
1673           level that GNUstep's APIs correspond to.
1674           The last number is where we distinguish between the Apple
1675           and GNUstep implementations ("distributor-specific release
1676           number") and give int'ized versions of major.minor. */
1677   return list3i (10, 3, ns_appkit_version_int ());
1681 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1682        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1683 The optional argument TERMINAL specifies which display to ask about.
1684 TERMINAL should be a terminal object, a frame or a display name (a string).
1685 If omitted or nil, that stands for the selected frame's display.
1687 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1688 the number of physical monitors, use `(length
1689 (display-monitor-attributes-list TERMINAL))' instead.  */)
1690   (Lisp_Object terminal)
1692   check_ns_display_info (terminal);
1693   return make_number (1);
1697 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1698        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1699 The optional argument TERMINAL specifies which display to ask about.
1700 TERMINAL should be a terminal object, a frame or a display name (a string).
1701 If omitted or nil, that stands for the selected frame's display.
1703 On \"multi-monitor\" setups this refers to the height in millimeters for
1704 all physical monitors associated with TERMINAL.  To get information
1705 for each physical monitor, use `display-monitor-attributes-list'.  */)
1706   (Lisp_Object terminal)
1708   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1710   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1714 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1715        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1716 The optional argument TERMINAL specifies which display to ask about.
1717 TERMINAL should be a terminal object, a frame or a display name (a string).
1718 If omitted or nil, that stands for the selected frame's display.
1720 On \"multi-monitor\" setups this refers to the width in millimeters for
1721 all physical monitors associated with TERMINAL.  To get information
1722 for each physical monitor, use `display-monitor-attributes-list'.  */)
1723   (Lisp_Object terminal)
1725   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1727   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1731 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1732        Sx_display_backing_store, 0, 1, 0,
1733        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1734 The value may be `buffered', `retained', or `non-retained'.
1735 The optional argument TERMINAL specifies which display to ask about.
1736 TERMINAL should be a terminal object, a frame or a display name (a string).
1737 If omitted or nil, that stands for the selected frame's display.  */)
1738   (Lisp_Object terminal)
1740   check_ns_display_info (terminal);
1741   switch ([ns_get_window (terminal) backingType])
1742     {
1743     case NSBackingStoreBuffered:
1744       return intern ("buffered");
1745     case NSBackingStoreRetained:
1746       return intern ("retained");
1747     case NSBackingStoreNonretained:
1748       return intern ("non-retained");
1749     default:
1750       error ("Strange value for backingType parameter of frame");
1751     }
1752   return Qnil;  /* not reached, shut compiler up */
1756 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1757        Sx_display_visual_class, 0, 1, 0,
1758        doc: /* Return the visual class of the Nextstep display TERMINAL.
1759 The value is one of the symbols `static-gray', `gray-scale',
1760 `static-color', `pseudo-color', `true-color', or `direct-color'.
1762 The optional argument TERMINAL specifies which display to ask about.
1763 TERMINAL should a terminal object, a frame or a display name (a string).
1764 If omitted or nil, that stands for the selected frame's display.  */)
1765   (Lisp_Object terminal)
1767   NSWindowDepth depth;
1769   check_ns_display_info (terminal);
1770   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1772   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1773     return intern ("static-gray");
1774   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1775     return intern ("gray-scale");
1776   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1777     return intern ("pseudo-color");
1778   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1779     return intern ("true-color");
1780   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1781     return intern ("direct-color");
1782   else
1783     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1784     return intern ("direct-color");
1788 DEFUN ("x-display-save-under", Fx_display_save_under,
1789        Sx_display_save_under, 0, 1, 0,
1790        doc: /* Return t if TERMINAL supports the save-under feature.
1791 The optional argument TERMINAL specifies which display to ask about.
1792 TERMINAL should be a terminal object, a frame or a display name (a string).
1793 If omitted or nil, that stands for the selected frame's display.  */)
1794   (Lisp_Object terminal)
1796   check_ns_display_info (terminal);
1797   switch ([ns_get_window (terminal) backingType])
1798     {
1799     case NSBackingStoreBuffered:
1800       return Qt;
1802     case NSBackingStoreRetained:
1803     case NSBackingStoreNonretained:
1804       return Qnil;
1806     default:
1807       error ("Strange value for backingType parameter of frame");
1808     }
1809   return Qnil;  /* not reached, shut compiler up */
1813 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1814        1, 3, 0,
1815        doc: /* Open a connection to a display server.
1816 DISPLAY is the name of the display to connect to.
1817 Optional second arg XRM-STRING is a string of resources in xrdb format.
1818 If the optional third arg MUST-SUCCEED is non-nil,
1819 terminate Emacs if we can't open the connection.
1820 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1821      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1823   struct ns_display_info *dpyinfo;
1825   CHECK_STRING (display);
1827   nxatoms_of_nsselect ();
1828   dpyinfo = ns_term_init (display);
1829   if (dpyinfo == 0)
1830     {
1831       if (!NILP (must_succeed))
1832         fatal ("Display on %s not responding.\n",
1833                SSDATA (display));
1834       else
1835         error ("Display on %s not responding.\n",
1836                SSDATA (display));
1837     }
1839   return Qnil;
1843 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1844        1, 1, 0,
1845        doc: /* Close the connection to TERMINAL's Nextstep display server.
1846 For TERMINAL, specify a terminal object, a frame or a display name (a
1847 string).  If TERMINAL is nil, that stands for the selected frame's
1848 terminal.  */)
1849      (Lisp_Object terminal)
1851   check_ns_display_info (terminal);
1852   [NSApp terminate: NSApp];
1853   return Qnil;
1857 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1858        doc: /* Return the list of display names that Emacs has connections to.  */)
1859      (void)
1861   Lisp_Object result = Qnil;
1862   struct ns_display_info *ndi;
1864   for (ndi = x_display_list; ndi; ndi = ndi->next)
1865     result = Fcons (XCAR (ndi->name_list_element), result);
1867   return result;
1871 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1872        0, 0, 0,
1873        doc: /* Hides all applications other than Emacs.  */)
1874      (void)
1876   check_window_system (NULL);
1877   [NSApp hideOtherApplications: NSApp];
1878   return Qnil;
1881 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1882        1, 1, 0,
1883        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1884 Otherwise if Emacs is hidden, it is unhidden.
1885 If ON is equal to `activate', Emacs is unhidden and becomes
1886 the active application.  */)
1887      (Lisp_Object on)
1889   check_window_system (NULL);
1890   if (EQ (on, intern ("activate")))
1891     {
1892       [NSApp unhide: NSApp];
1893       [NSApp activateIgnoringOtherApps: YES];
1894     }
1895   else if (NILP (on))
1896     [NSApp unhide: NSApp];
1897   else
1898     [NSApp hide: NSApp];
1899   return Qnil;
1903 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1904        0, 0, 0,
1905        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1906      (void)
1908   check_window_system (NULL);
1909   [NSApp orderFrontStandardAboutPanel: nil];
1910   return Qnil;
1914 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1915        doc: /* Determine font PostScript or family name for font NAME.
1916 NAME should be a string containing either the font name or an XLFD
1917 font descriptor.  If string contains `fontset' and not
1918 `fontset-startup', it is left alone. */)
1919      (Lisp_Object name)
1921   char *nm;
1922   CHECK_STRING (name);
1923   nm = SSDATA (name);
1925   if (nm[0] != '-')
1926     return name;
1927   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1928     return name;
1930   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1934 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1935        doc: /* Return a list of all available colors.
1936 The optional argument FRAME is currently ignored.  */)
1937      (Lisp_Object frame)
1939   Lisp_Object list = Qnil;
1940   NSEnumerator *colorlists;
1941   NSColorList *clist;
1943   if (!NILP (frame))
1944     {
1945       CHECK_FRAME (frame);
1946       if (! FRAME_NS_P (XFRAME (frame)))
1947         error ("non-Nextstep frame used in `ns-list-colors'");
1948     }
1950   block_input ();
1952   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1953   while ((clist = [colorlists nextObject]))
1954     {
1955       if ([[clist name] length] < 7 ||
1956           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1957         {
1958           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1959           NSString *cname;
1960           while ((cname = [cnames nextObject]))
1961             list = Fcons (build_string ([cname UTF8String]), list);
1962 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1963                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1964                                              UTF8String]), list); */
1965         }
1966     }
1968   unblock_input ();
1970   return list;
1974 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1975        doc: /* List available Nextstep services by querying NSApp.  */)
1976      (void)
1978 #ifdef NS_IMPL_COCOA
1979   /* You can't get services like this in 10.6+.  */
1980   return Qnil;
1981 #else
1982   Lisp_Object ret = Qnil;
1983   NSMenu *svcs;
1984 #ifdef NS_IMPL_COCOA
1985   id delegate;
1986 #endif
1988   check_window_system (NULL);
1989   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1990   [NSApp setServicesMenu: svcs];
1991   [NSApp registerServicesMenuSendTypes: ns_send_types
1992                            returnTypes: ns_return_types];
1994 /* On Tiger, services menu updating was made lazier (waits for user to
1995    actually click on the menu), so we have to force things along: */
1996 #ifdef NS_IMPL_COCOA
1997   delegate = [svcs delegate];
1998   if (delegate != nil)
1999     {
2000       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2001         [delegate menuNeedsUpdate: svcs];
2002       if ([delegate respondsToSelector:
2003                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2004         {
2005           int i, len = [delegate numberOfItemsInMenu: svcs];
2006           for (i =0; i<len; i++)
2007             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2008           for (i =0; i<len; i++)
2009             if (![delegate menu: svcs
2010                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2011                         atIndex: i shouldCancel: NO])
2012               break;
2013         }
2014     }
2015 #endif
2017   [svcs setAutoenablesItems: NO];
2018 #ifdef NS_IMPL_COCOA
2019   [svcs update]; /* on OS X, converts from '/' structure */
2020 #endif
2022   ret = interpret_services_menu (svcs, Qnil, ret);
2023   return ret;
2024 #endif
2028 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2029        2, 2, 0,
2030        doc: /* Perform Nextstep SERVICE on SEND.
2031 SEND should be either a string or nil.
2032 The return value is the result of the service, as string, or nil if
2033 there was no result.  */)
2034      (Lisp_Object service, Lisp_Object send)
2036   id pb;
2037   NSString *svcName;
2038   char *utfStr;
2040   CHECK_STRING (service);
2041   check_window_system (NULL);
2043   utfStr = SSDATA (service);
2044   svcName = [NSString stringWithUTF8String: utfStr];
2046   pb =[NSPasteboard pasteboardWithUniqueName];
2047   ns_string_to_pasteboard (pb, send);
2049   if (NSPerformService (svcName, pb) == NO)
2050     Fsignal (Qquit, list1 (build_string ("service not available")));
2052   if ([[pb types] count] == 0)
2053     return build_string ("");
2054   return ns_string_from_pasteboard (pb);
2058 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2059        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2060        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2061      (Lisp_Object str)
2063 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2064          remove this. */
2065   NSString *utfStr;
2066   Lisp_Object ret = Qnil;
2067   NSAutoreleasePool *pool;
2069   CHECK_STRING (str);
2070   pool = [[NSAutoreleasePool alloc] init];
2071   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2072 #ifdef NS_IMPL_COCOA
2073   if (utfStr)
2074     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2075 #endif
2076   if (utfStr)
2077     {
2078       const char *cstr = [utfStr UTF8String];
2079       if (cstr)
2080         ret = build_string (cstr);
2081     }
2083   [pool release];
2084   if (NILP (ret))
2085     error ("Invalid UTF-8");
2087   return ret;
2091 #ifdef NS_IMPL_COCOA
2093 /* Compile and execute the AppleScript SCRIPT and return the error
2094    status as function value.  A zero is returned if compilation and
2095    execution is successful, in which case *RESULT is set to a Lisp
2096    string or a number containing the resulting script value.  Otherwise,
2097    1 is returned. */
2098 static int
2099 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2101   NSAppleEventDescriptor *desc;
2102   NSDictionary* errorDict;
2103   NSAppleEventDescriptor* returnDescriptor = NULL;
2105   NSAppleScript* scriptObject =
2106     [[NSAppleScript alloc] initWithSource:
2107                              [NSString stringWithUTF8String: SSDATA (script)]];
2109   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2110   [scriptObject release];
2111   *result = Qnil;
2113   if (returnDescriptor != NULL)
2114     {
2115       // successful execution
2116       if (kAENullEvent != [returnDescriptor descriptorType])
2117         {
2118           *result = Qt;
2119           // script returned an AppleScript result
2120           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2121 #if defined (NS_IMPL_COCOA)
2122               (typeUTF16ExternalRepresentation
2123                == [returnDescriptor descriptorType]) ||
2124 #endif
2125               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2126               (typeCString == [returnDescriptor descriptorType]))
2127             {
2128               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2129               if (desc)
2130                 *result = build_string([[desc stringValue] UTF8String]);
2131             }
2132           else
2133             {
2134               /* use typeUTF16ExternalRepresentation? */
2135               // coerce the result to the appropriate ObjC type
2136               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2137               if (desc)
2138                 *result = make_number([desc int32Value]);
2139             }
2140         }
2141     }
2142   else
2143     {
2144       // no script result, return error
2145       return 1;
2146     }
2147   return 0;
2150 /* Helper function called from sendEvent to run applescript
2151    from within the main event loop.  */
2153 void
2154 ns_run_ascript (void)
2156   if (! NILP (as_script))
2157     as_status = ns_do_applescript (as_script, as_result);
2158   as_script = Qnil;
2161 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2162        doc: /* Execute AppleScript SCRIPT and return the result.
2163 If compilation and execution are successful, the resulting script value
2164 is returned as a string, a number or, in the case of other constructs, t.
2165 In case the execution fails, an error is signaled. */)
2166      (Lisp_Object script)
2168   Lisp_Object result;
2169   int status;
2170   NSEvent *nxev;
2171   struct input_event ev;
2173   CHECK_STRING (script);
2174   check_window_system (NULL);
2176   block_input ();
2178   as_script = script;
2179   as_result = &result;
2181   /* executing apple script requires the event loop to run, otherwise
2182      errors aren't returned and executeAndReturnError hangs forever.
2183      Post an event that runs applescript and then start the event loop.
2184      The event loop is exited when the script is done.  */
2185   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2186                             location: NSMakePoint (0, 0)
2187                        modifierFlags: 0
2188                            timestamp: 0
2189                         windowNumber: [[NSApp mainWindow] windowNumber]
2190                              context: [NSApp context]
2191                              subtype: 0
2192                                data1: 0
2193                                data2: NSAPP_DATA2_RUNASSCRIPT];
2195   [NSApp postEvent: nxev atStart: NO];
2197   // If there are other events, the event loop may exit.  Keep running
2198   // until the script has been handled.  */
2199   ns_init_events (&ev);
2200   while (! NILP (as_script))
2201     [NSApp run];
2202   ns_finish_events ();
2204   status = as_status;
2205   as_status = 0;
2206   as_result = 0;
2207   unblock_input ();
2208   if (status == 0)
2209     return result;
2210   else if (!STRINGP (result))
2211     error ("AppleScript error %d", status);
2212   else
2213     error ("%s", SSDATA (result));
2215 #endif
2219 /* ==========================================================================
2221     Miscellaneous functions not called through hooks
2223    ========================================================================== */
2225 /* called from frame.c */
2226 struct ns_display_info *
2227 check_x_display_info (Lisp_Object frame)
2229   return check_ns_display_info (frame);
2233 void
2234 x_set_scroll_bar_default_width (struct frame *f)
2236   int wid = FRAME_COLUMN_WIDTH (f);
2237   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2238   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2239                                       wid - 1) / wid;
2242 void
2243 x_set_scroll_bar_default_height (struct frame *f)
2245   int height = FRAME_LINE_HEIGHT (f);
2246   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2247   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2248                                        height - 1) / height;
2251 /* terms impl this instead of x-get-resource directly */
2252 char *
2253 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2255   /* remove appname prefix; TODO: allow for !="Emacs" */
2256   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2258   check_window_system (NULL);
2260   if (inhibit_x_resources)
2261     /* --quick was passed, so this is a no-op.  */
2262     return NULL;
2264   res = ns_get_defaults_value (toCheck);
2265   return (!res ? NULL :
2266           (!c_strncasecmp (res, "YES", 3) ? "true" :
2267            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2271 Lisp_Object
2272 x_get_focus_frame (struct frame *frame)
2274   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2275   Lisp_Object nsfocus;
2277   if (!dpyinfo->x_focus_frame)
2278     return Qnil;
2280   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2281   return nsfocus;
2284 /* ==========================================================================
2286     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2288    ========================================================================== */
2291 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2292        doc: /* Internal function called by `color-defined-p', which see.
2293 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2294      (Lisp_Object color, Lisp_Object frame)
2296   NSColor * col;
2297   check_window_system (NULL);
2298   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2302 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2303        doc: /* Internal function called by `color-values', which see.  */)
2304      (Lisp_Object color, Lisp_Object frame)
2306   NSColor * col;
2307   EmacsCGFloat red, green, blue, alpha;
2309   check_window_system (NULL);
2310   CHECK_STRING (color);
2312   block_input ();
2313   if (ns_lisp_to_color (color, &col))
2314     {
2315       unblock_input ();
2316       return Qnil;
2317     }
2319   [[col colorUsingDefaultColorSpace]
2320         getRed: &red green: &green blue: &blue alpha: &alpha];
2321   unblock_input ();
2322   return list3i (lrint (red * 65280), lrint (green * 65280),
2323                  lrint (blue * 65280));
2327 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2328        doc: /* Internal function called by `display-color-p', which see.  */)
2329      (Lisp_Object terminal)
2331   NSWindowDepth depth;
2332   NSString *colorSpace;
2334   check_ns_display_info (terminal);
2335   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2336   colorSpace = NSColorSpaceFromDepth (depth);
2338   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2339          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2340       ? Qnil : Qt;
2344 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2345        0, 1, 0,
2346        doc: /* Return t if the Nextstep display supports shades of gray.
2347 Note that color displays do support shades of gray.
2348 The optional argument TERMINAL specifies which display to ask about.
2349 TERMINAL should be a terminal object, a frame or a display name (a string).
2350 If omitted or nil, that stands for the selected frame's display.  */)
2351   (Lisp_Object terminal)
2353   NSWindowDepth depth;
2355   check_ns_display_info (terminal);
2356   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2358   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2362 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2363        0, 1, 0,
2364        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2365 The optional argument TERMINAL specifies which display to ask about.
2366 TERMINAL should be a terminal object, a frame or a display name (a string).
2367 If omitted or nil, that stands for the selected frame's display.
2369 On \"multi-monitor\" setups this refers to the pixel width for all
2370 physical monitors associated with TERMINAL.  To get information for
2371 each physical monitor, use `display-monitor-attributes-list'.  */)
2372   (Lisp_Object terminal)
2374   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2376   return make_number (x_display_pixel_width (dpyinfo));
2380 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2381        Sx_display_pixel_height, 0, 1, 0,
2382        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2383 The optional argument TERMINAL specifies which display to ask about.
2384 TERMINAL should be a terminal object, a frame or a display name (a string).
2385 If omitted or nil, that stands for the selected frame's display.
2387 On \"multi-monitor\" setups this refers to the pixel height for all
2388 physical monitors associated with TERMINAL.  To get information for
2389 each physical monitor, use `display-monitor-attributes-list'.  */)
2390   (Lisp_Object terminal)
2392   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2394   return make_number (x_display_pixel_height (dpyinfo));
2397 #ifdef NS_IMPL_COCOA
2399 /* Returns the name for the screen that OBJ represents, or NULL.
2400    Caller must free return value.
2403 static char *
2404 ns_get_name_from_ioreg (io_object_t obj)
2406   char *name = NULL;
2408   NSDictionary *info = (NSDictionary *)
2409     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2410   NSDictionary *names = [info objectForKey:
2411                                 [NSString stringWithUTF8String:
2412                                             kDisplayProductName]];
2414   if ([names count] > 0)
2415     {
2416       NSString *n = [names objectForKey: [[names allKeys]
2417                                                  objectAtIndex:0]];
2418       if (n != nil) name = xstrdup ([n UTF8String]);
2419     }
2421   [info release];
2423   return name;
2426 /* Returns the name for the screen that DID came from, or NULL.
2427    Caller must free return value.
2430 static char *
2431 ns_screen_name (CGDirectDisplayID did)
2433   char *name = NULL;
2435 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2436   mach_port_t masterPort;
2437   io_iterator_t it;
2438   io_object_t obj;
2440   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2442   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2443       || IOServiceGetMatchingServices (masterPort,
2444                                        IOServiceMatching ("IONDRVDevice"),
2445                                        &it) != kIOReturnSuccess)
2446     return name;
2448   /* Must loop until we find a name.  Many devices can have the same unit
2449      number (represents different GPU parts), but only one has a name.  */
2450   while (! name && (obj = IOIteratorNext (it)))
2451     {
2452       CFMutableDictionaryRef props;
2453       const void *val;
2455       if (IORegistryEntryCreateCFProperties (obj,
2456                                              &props,
2457                                              kCFAllocatorDefault,
2458                                              kNilOptions) == kIOReturnSuccess
2459           && props != nil
2460           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2461         {
2462           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2463           if (nr == CGDisplayUnitNumber (did))
2464             name = ns_get_name_from_ioreg (obj);
2465         }
2467       CFRelease (props);
2468       IOObjectRelease (obj);
2469     }
2471   IOObjectRelease (it);
2473 #else
2475   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2477 #endif
2478   return name;
2480 #endif
2482 static Lisp_Object
2483 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2484                                 int n_monitors,
2485                                 int primary_monitor,
2486                                 const char *source)
2488   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2489   Lisp_Object frame, rest;
2490   NSArray *screens = [NSScreen screens];
2491   int i;
2493   FOR_EACH_FRAME (rest, frame)
2494     {
2495       struct frame *f = XFRAME (frame);
2497       if (FRAME_NS_P (f))
2498         {
2499           NSView *view = FRAME_NS_VIEW (f);
2500           NSScreen *screen = [[view window] screen];
2501           NSUInteger k;
2503           i = -1;
2504           for (k = 0; i == -1 && k < [screens count]; ++k)
2505             {
2506               if ([screens objectAtIndex: k] == screen)
2507                 i = (int)k;
2508             }
2510           if (i > -1)
2511             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2512         }
2513     }
2515   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2516                                       monitor_frames, source);
2519 DEFUN ("ns-display-monitor-attributes-list",
2520        Fns_display_monitor_attributes_list,
2521        Sns_display_monitor_attributes_list,
2522        0, 1, 0,
2523        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2525 The optional argument TERMINAL specifies which display to ask about.
2526 TERMINAL should be a terminal object, a frame or a display name (a string).
2527 If omitted or nil, that stands for the selected frame's display.
2529 In addition to the standard attribute keys listed in
2530 `display-monitor-attributes-list', the following keys are contained in
2531 the attributes:
2533  source -- String describing the source from which multi-monitor
2534            information is obtained, \"NS\" is always the source."
2536 Internal use only, use `display-monitor-attributes-list' instead.  */)
2537   (Lisp_Object terminal)
2539   struct terminal *term = decode_live_terminal (terminal);
2540   NSArray *screens;
2541   NSUInteger i, n_monitors;
2542   struct MonitorInfo *monitors;
2543   Lisp_Object attributes_list = Qnil;
2544   CGFloat primary_display_height = 0;
2546   if (term->type != output_ns)
2547     return Qnil;
2549   screens = [NSScreen screens];
2550   n_monitors = [screens count];
2551   if (n_monitors == 0)
2552     return Qnil;
2554   monitors = xzalloc (n_monitors * sizeof *monitors);
2556   for (i = 0; i < [screens count]; ++i)
2557     {
2558       NSScreen *s = [screens objectAtIndex:i];
2559       struct MonitorInfo *m = &monitors[i];
2560       NSRect fr = [s frame];
2561       NSRect vfr = [s visibleFrame];
2562       short y, vy;
2564 #ifdef NS_IMPL_COCOA
2565       NSDictionary *dict = [s deviceDescription];
2566       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2567       CGDirectDisplayID did = [nid unsignedIntValue];
2568 #endif
2569       if (i == 0)
2570         {
2571           primary_display_height = fr.size.height;
2572           y = (short) fr.origin.y;
2573           vy = (short) vfr.origin.y;
2574         }
2575       else
2576         {
2577           // Flip y coordinate as NS has y starting from the bottom.
2578           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2579           vy = (short) (primary_display_height -
2580                         vfr.size.height - vfr.origin.y);
2581         }
2583       m->geom.x = (short) fr.origin.x;
2584       m->geom.y = y;
2585       m->geom.width = (unsigned short) fr.size.width;
2586       m->geom.height = (unsigned short) fr.size.height;
2588       m->work.x = (short) vfr.origin.x;
2589       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2590       // and fr.size.height - vfr.size.height are pixels missing in total.
2591       // Pixels missing at top are
2592       // fr.size.height - vfr.size.height - vy + y.
2593       // work.y is then pixels missing at top + y.
2594       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2595       m->work.width = (unsigned short) vfr.size.width;
2596       m->work.height = (unsigned short) vfr.size.height;
2598 #ifdef NS_IMPL_COCOA
2599       m->name = ns_screen_name (did);
2601       {
2602         CGSize mms = CGDisplayScreenSize (did);
2603         m->mm_width = (int) mms.width;
2604         m->mm_height = (int) mms.height;
2605       }
2607 #else
2608       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2609       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2610       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2611 #endif
2612     }
2614   // Primary monitor is always first for NS.
2615   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2616                                                     0, "NS");
2618   free_monitors (monitors, n_monitors);
2619   return attributes_list;
2623 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2624        0, 1, 0,
2625        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2626 The optional argument TERMINAL specifies which display to ask about.
2627 TERMINAL should be a terminal object, a frame or a display name (a string).
2628 If omitted or nil, that stands for the selected frame's display.  */)
2629   (Lisp_Object terminal)
2631   check_ns_display_info (terminal);
2632   return make_number
2633     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2637 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2638        0, 1, 0,
2639        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2640 The optional argument TERMINAL specifies which display to ask about.
2641 TERMINAL should be a terminal object, a frame or a display name (a string).
2642 If omitted or nil, that stands for the selected frame's display.  */)
2643   (Lisp_Object terminal)
2645   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2646   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2647   return make_number (1 << min (dpyinfo->n_planes, 24));
2651 /* Unused dummy def needed for compatibility. */
2652 Lisp_Object tip_frame;
2654 /* TODO: move to xdisp or similar */
2655 static void
2656 compute_tip_xy (struct frame *f,
2657                 Lisp_Object parms,
2658                 Lisp_Object dx,
2659                 Lisp_Object dy,
2660                 int width,
2661                 int height,
2662                 int *root_x,
2663                 int *root_y)
2665   Lisp_Object left, top;
2666   EmacsView *view = FRAME_NS_VIEW (f);
2667   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2668   NSPoint pt;
2670   /* Start with user-specified or mouse position.  */
2671   left = Fcdr (Fassq (Qleft, parms));
2672   top = Fcdr (Fassq (Qtop, parms));
2674   if (!INTEGERP (left) || !INTEGERP (top))
2675     {
2676       pt.x = dpyinfo->last_mouse_motion_x;
2677       pt.y = dpyinfo->last_mouse_motion_y;
2678       /* Convert to screen coordinates */
2679       pt = [view convertPoint: pt toView: nil];
2680       pt = [[view window] convertBaseToScreen: pt];
2681     }
2682   else
2683     {
2684       /* Absolute coordinates.  */
2685       pt.x = XINT (left);
2686       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2687         - height;
2688     }
2690   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2691   if (INTEGERP (left))
2692     *root_x = pt.x;
2693   else if (pt.x + XINT (dx) <= 0)
2694     *root_x = 0; /* Can happen for negative dx */
2695   else if (pt.x + XINT (dx) + width
2696            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2697     /* It fits to the right of the pointer.  */
2698     *root_x = pt.x + XINT (dx);
2699   else if (width + XINT (dx) <= pt.x)
2700     /* It fits to the left of the pointer.  */
2701     *root_x = pt.x - width - XINT (dx);
2702   else
2703     /* Put it left justified on the screen -- it ought to fit that way.  */
2704     *root_x = 0;
2706   if (INTEGERP (top))
2707     *root_y = pt.y;
2708   else if (pt.y - XINT (dy) - height >= 0)
2709     /* It fits below the pointer.  */
2710     *root_y = pt.y - height - XINT (dy);
2711   else if (pt.y + XINT (dy) + height
2712            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2713     /* It fits above the pointer */
2714       *root_y = pt.y + XINT (dy);
2715   else
2716     /* Put it on the top.  */
2717     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2721 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2722        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2723 A tooltip window is a small window displaying a string.
2725 This is an internal function; Lisp code should call `tooltip-show'.
2727 FRAME nil or omitted means use the selected frame.
2729 PARMS is an optional list of frame parameters which can be used to
2730 change the tooltip's appearance.
2732 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2733 means use the default timeout of 5 seconds.
2735 If the list of frame parameters PARMS contains a `left' parameter,
2736 the tooltip is displayed at that x-position.  Otherwise it is
2737 displayed at the mouse position, with offset DX added (default is 5 if
2738 DX isn't specified).  Likewise for the y-position; if a `top' frame
2739 parameter is specified, it determines the y-position of the tooltip
2740 window, otherwise it is displayed at the mouse position, with offset
2741 DY added (default is -10).
2743 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2744 Text larger than the specified size is clipped.  */)
2745      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2747   int root_x, root_y;
2748   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2749   ptrdiff_t count = SPECPDL_INDEX ();
2750   struct frame *f;
2751   char *str;
2752   NSSize size;
2754   specbind (Qinhibit_redisplay, Qt);
2756   GCPRO4 (string, parms, frame, timeout);
2758   CHECK_STRING (string);
2759   str = SSDATA (string);
2760   f = decode_window_system_frame (frame);
2761   if (NILP (timeout))
2762     timeout = make_number (5);
2763   else
2764     CHECK_NATNUM (timeout);
2766   if (NILP (dx))
2767     dx = make_number (5);
2768   else
2769     CHECK_NUMBER (dx);
2771   if (NILP (dy))
2772     dy = make_number (-10);
2773   else
2774     CHECK_NUMBER (dy);
2776   block_input ();
2777   if (ns_tooltip == nil)
2778     ns_tooltip = [[EmacsTooltip alloc] init];
2779   else
2780     Fx_hide_tip ();
2782   [ns_tooltip setText: str];
2783   size = [ns_tooltip frame].size;
2785   /* Move the tooltip window where the mouse pointer is.  Resize and
2786      show it.  */
2787   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2788                   &root_x, &root_y);
2790   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2791   unblock_input ();
2793   UNGCPRO;
2794   return unbind_to (count, Qnil);
2798 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2799        doc: /* Hide the current tooltip window, if there is any.
2800 Value is t if tooltip was open, nil otherwise.  */)
2801      (void)
2803   if (ns_tooltip == nil || ![ns_tooltip isActive])
2804     return Qnil;
2805   [ns_tooltip hide];
2806   return Qt;
2809 DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0,
2810        doc: /* Return geometric attributes of frame FRAME.
2812 FRAME must be a live frame and defaults to the selected one.
2814 The return value is an association list containing the following
2815 elements (all size values are in pixels).
2817 - `frame-outer-size' is a cons of the outer width and height of FRAME.
2818   The outer size include the title bar and the external borders as well
2819   as any menu and/or tool bar of frame.
2821 - `border' is a cons of the horizontal and vertical width of FRAME's
2822   external borders.
2824 - `title-bar-height' is the height of the title bar of FRAME.
2826 - `menu-bar-external' if `t' means the menu bar is external (not
2827   included in the inner edges of FRAME).
2829 - `menu-bar-size' is a cons of the width and height of the menu bar of
2830   FRAME.
2832 - `tool-bar-external' if `t' means the tool bar is external (not
2833   included in the inner edges of FRAME).
2835 - `tool-bar-side' tells tells on which side the tool bar on FRAME is and
2836   can be one of `left', `top', `right' or `bottom'.
2838 - `tool-bar-size' is a cons of the width and height of the tool bar of
2839   FRAME.
2841 - `frame-inner-size' is a cons of the inner width and height of FRAME.
2842   This excludes FRAME's title bar and external border as well as any
2843   external menu and/or tool bar.  */)
2844   (Lisp_Object frame)
2846   struct frame *f = decode_live_frame (frame);
2847   int inner_width = FRAME_PIXEL_WIDTH (f);
2848   int inner_height = FRAME_PIXEL_HEIGHT (f);
2849   Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen);
2850   int border = f->border_width;
2851   int title = FRAME_NS_TITLEBAR_HEIGHT (f);
2852   int outer_width = FRAME_PIXEL_WIDTH (f) + 2 * border;
2853   int outer_height = FRAME_PIXEL_HEIGHT (f) + 2 * border;
2854   int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f);
2855   int tool_bar_width = tool_bar_height > 0
2856     ? outer_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)
2857     : 0;
2858   // Always 0 on NS.
2859   int menu_bar_height = 0;
2860   int menu_bar_width = 0;
2862   return
2863     listn (CONSTYPE_HEAP, 10,
2864            Fcons (Qframe_position,
2865                   Fcons (make_number (f->left_pos), make_number (f->top_pos))),
2866            Fcons (Qframe_outer_size,
2867                   Fcons (make_number (outer_width), make_number (outer_height))),
2868            Fcons (Qexternal_border_size,
2869                   ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen))
2870                    ? Fcons (make_number (0), make_number (0))
2871                    : Fcons (make_number (border), make_number (border)))),
2872            Fcons (Qtitle_height,
2873                   ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen))
2874                    ? make_number (0)
2875                    : make_number (title))),
2876            Fcons (Qmenu_bar_external, FRAME_EXTERNAL_MENU_BAR (f) ? Qt : Qnil),
2877            Fcons (Qmenu_bar_size,
2878                   Fcons (make_number (menu_bar_width),
2879                          make_number (menu_bar_height))),
2880            Fcons (Qtool_bar_external, FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil),
2881            Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)),
2882            Fcons (Qtool_bar_size,
2883                   Fcons (make_number (tool_bar_width),
2884                          make_number (tool_bar_height))),
2885            Fcons (Qframe_inner_size,
2886                   Fcons (make_number (inner_width),
2887                          make_number (inner_height))));
2891 /* ==========================================================================
2893     Class implementations
2895    ========================================================================== */
2898   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2899   Return YES if handled, NO if not.
2900  */
2901 static BOOL
2902 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2904   NSString *s;
2905   int i;
2906   BOOL ret = NO;
2908   if ([theEvent type] != NSKeyDown) return NO;
2909   s = [theEvent characters];
2911   for (i = 0; i < [s length]; ++i)
2912     {
2913       int ch = (int) [s characterAtIndex: i];
2914       switch (ch)
2915         {
2916         case NSHomeFunctionKey:
2917         case NSDownArrowFunctionKey:
2918         case NSUpArrowFunctionKey:
2919         case NSLeftArrowFunctionKey:
2920         case NSRightArrowFunctionKey:
2921         case NSPageUpFunctionKey:
2922         case NSPageDownFunctionKey:
2923         case NSEndFunctionKey:
2924           /* Don't send command modified keys, as those are handled in the
2925              performKeyEquivalent method of the super class.
2926           */
2927           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2928             {
2929               [panel sendEvent: theEvent];
2930               ret = YES;
2931             }
2932           break;
2933           /* As we don't have the standard key commands for
2934              copy/paste/cut/select-all in our edit menu, we must handle
2935              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2936              here, paste works, because we have that in our Edit menu.
2937              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2938              correct modifier.
2939           */
2940         case 'x': // Cut
2941         case 'c': // Copy
2942         case 'v': // Paste
2943         case 'a': // Select all
2944           if ([theEvent modifierFlags] & NSCommandKeyMask)
2945             {
2946               [NSApp sendAction:
2947                        (ch == 'x'
2948                         ? @selector(cut:)
2949                         : (ch == 'c'
2950                            ? @selector(copy:)
2951                            : (ch == 'v'
2952                               ? @selector(paste:)
2953                               : @selector(selectAll:))))
2954                              to:nil from:panel];
2955               ret = YES;
2956             }
2957         default:
2958           // Send all control keys, as the text field supports C-a, C-f, C-e
2959           // C-b and more.
2960           if ([theEvent modifierFlags] & NSControlKeyMask)
2961             {
2962               [panel sendEvent: theEvent];
2963               ret = YES;
2964             }
2965           break;
2966         }
2967     }
2970   return ret;
2973 @implementation EmacsSavePanel
2974 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2976   BOOL ret = handlePanelKeys (self, theEvent);
2977   if (! ret)
2978     ret = [super performKeyEquivalent:theEvent];
2979   return ret;
2981 @end
2984 @implementation EmacsOpenPanel
2985 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2987   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2988   BOOL ret = handlePanelKeys (self, theEvent);
2989   if (! ret)
2990     ret = [super performKeyEquivalent:theEvent];
2991   return ret;
2993 @end
2996 @implementation EmacsFileDelegate
2997 /* --------------------------------------------------------------------------
2998    Delegate methods for Open/Save panels
2999    -------------------------------------------------------------------------- */
3000 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
3002   return YES;
3004 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
3006   return YES;
3008 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
3009           confirmed: (BOOL)okFlag
3011   return filename;
3013 @end
3015 #endif
3018 /* ==========================================================================
3020     Lisp interface declaration
3022    ========================================================================== */
3025 void
3026 syms_of_nsfns (void)
3028   DEFSYM (Qfontsize, "fontsize");
3030   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
3031                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
3032 If the title of a frame matches REGEXP, then IMAGE.tiff is
3033 selected as the image of the icon representing the frame when it's
3034 miniaturized.  If an element is t, then Emacs tries to select an icon
3035 based on the filetype of the visited file.
3037 The images have to be installed in a folder called English.lproj in the
3038 Emacs folder.  You have to restart Emacs after installing new icons.
3040 Example: Install an icon Gnus.tiff and execute the following code
3042   (setq ns-icon-type-alist
3043         (append ns-icon-type-alist
3044                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
3045                    . \"Gnus\"))))
3047 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
3048 be used as the image of the icon representing the frame.  */);
3049   Vns_icon_type_alist = list1 (Qt);
3051   DEFVAR_LISP ("ns-version-string", Vns_version_string,
3052                doc: /* Toolkit version for NS Windowing.  */);
3053   Vns_version_string = ns_appkit_version_str ();
3055   defsubr (&Sns_read_file_name);
3056   defsubr (&Sns_get_resource);
3057   defsubr (&Sns_set_resource);
3058   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
3059   defsubr (&Sx_display_grayscale_p);
3060   defsubr (&Sns_font_name);
3061   defsubr (&Sns_list_colors);
3062 #ifdef NS_IMPL_COCOA
3063   defsubr (&Sns_do_applescript);
3064 #endif
3065   defsubr (&Sxw_color_defined_p);
3066   defsubr (&Sxw_color_values);
3067   defsubr (&Sx_server_max_request_size);
3068   defsubr (&Sx_server_vendor);
3069   defsubr (&Sx_server_version);
3070   defsubr (&Sx_display_pixel_width);
3071   defsubr (&Sx_display_pixel_height);
3072   defsubr (&Sns_display_monitor_attributes_list);
3073   defsubr (&Sx_frame_geometry);
3074   defsubr (&Sx_display_mm_width);
3075   defsubr (&Sx_display_mm_height);
3076   defsubr (&Sx_display_screens);
3077   defsubr (&Sx_display_planes);
3078   defsubr (&Sx_display_color_cells);
3079   defsubr (&Sx_display_visual_class);
3080   defsubr (&Sx_display_backing_store);
3081   defsubr (&Sx_display_save_under);
3082   defsubr (&Sx_create_frame);
3083   defsubr (&Sx_open_connection);
3084   defsubr (&Sx_close_connection);
3085   defsubr (&Sx_display_list);
3087   defsubr (&Sns_hide_others);
3088   defsubr (&Sns_hide_emacs);
3089   defsubr (&Sns_emacs_info_panel);
3090   defsubr (&Sns_list_services);
3091   defsubr (&Sns_perform_service);
3092   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3093   defsubr (&Sns_popup_font_panel);
3094   defsubr (&Sns_popup_color_panel);
3096   defsubr (&Sx_show_tip);
3097   defsubr (&Sx_hide_tip);
3099   as_status = 0;
3100   as_script = Qnil;
3101   as_result = 0;