* alloc.c (valgrind_p): Use bool for boolean.
[emacs.git] / src / nsfns.m
blob93b7d12becb519d509fb29ccb6cf04aa82ab8bbc
1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2013 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 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
50 #include "macfont.h"
51 #endif
52 #endif
54 #if 0
55 int fns_trace_num = 1;
56 #define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
57                                   __FILE__, __LINE__, ++fns_trace_num)
58 #else
59 #define NSTRACE(x)
60 #endif
62 #ifdef HAVE_NS
64 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
66 extern Lisp_Object Qforeground_color;
67 extern Lisp_Object Qbackground_color;
68 extern Lisp_Object Qcursor_color;
69 extern Lisp_Object Qinternal_border_width;
70 extern Lisp_Object Qvisibility;
71 extern Lisp_Object Qcursor_type;
72 extern Lisp_Object Qicon_type;
73 extern Lisp_Object Qicon_name;
74 extern Lisp_Object Qicon_left;
75 extern Lisp_Object Qicon_top;
76 extern Lisp_Object Qleft;
77 extern Lisp_Object Qright;
78 extern Lisp_Object Qtop;
79 extern Lisp_Object Qdisplay;
80 extern Lisp_Object Qvertical_scroll_bars;
81 extern Lisp_Object Qauto_raise;
82 extern Lisp_Object Qauto_lower;
83 extern Lisp_Object Qbox;
84 extern Lisp_Object Qscroll_bar_width;
85 extern Lisp_Object Qx_resource_name;
86 extern Lisp_Object Qface_set_after_frame_default;
87 extern Lisp_Object Qunderline, Qundefined;
88 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
89 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
92 Lisp_Object Qbuffered;
93 Lisp_Object Qfontsize;
95 EmacsTooltip *ns_tooltip = nil;
97 /* Need forward declaration here to preserve organizational integrity of file */
98 Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
100 /* Static variables to handle applescript execution.  */
101 static Lisp_Object as_script, *as_result;
102 static int as_status;
104 #ifdef GLYPH_DEBUG
105 static ptrdiff_t image_cache_refcount;
106 #endif
109 /* ==========================================================================
111     Internal utility functions
113    ========================================================================== */
115 /* Let the user specify a Nextstep display with a Lisp object.
116    OBJECT may be nil, a frame or a terminal object.
117    nil stands for the selected frame--or, if that is not a Nextstep frame,
118    the first Nextstep display on the list.  */
120 static struct ns_display_info *
121 check_ns_display_info (Lisp_Object object)
123   struct ns_display_info *dpyinfo = NULL;
125   if (NILP (object))
126     {
127       struct frame *sf = XFRAME (selected_frame);
129       if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
130         dpyinfo = FRAME_DISPLAY_INFO (sf);
131       else if (x_display_list != 0)
132         dpyinfo = x_display_list;
133       else
134         error ("Nextstep windows are not in use or not initialized");
135     }
136   else if (TERMINALP (object))
137     {
138       struct terminal *t = get_terminal (object, 1);
140       if (t->type != output_ns)
141         error ("Terminal %d is not a Nextstep display", t->id);
143       dpyinfo = t->display_info.ns;
144     }
145   else if (STRINGP (object))
146     dpyinfo = ns_display_info_for_name (object);
147   else
148     {
149       struct frame *f = decode_window_system_frame (object);
150       dpyinfo = FRAME_DISPLAY_INFO (f);
151     }
153   return dpyinfo;
157 static id
158 ns_get_window (Lisp_Object maybeFrame)
160   id view =nil, window =nil;
162   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
163     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
165   if (!NILP (maybeFrame))
166     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
167   if (view) window =[view window];
169   return window;
173 /* Return the X display structure for the display named NAME.
174    Open a new connection if necessary.  */
175 struct ns_display_info *
176 ns_display_info_for_name (Lisp_Object name)
178   Lisp_Object names;
179   struct ns_display_info *dpyinfo;
181   CHECK_STRING (name);
183   for (dpyinfo = x_display_list, names = ns_display_name_list;
184        dpyinfo;
185        dpyinfo = dpyinfo->next, names = XCDR (names))
186     {
187       Lisp_Object tem;
188       tem = Fstring_equal (XCAR (XCAR (names)), name);
189       if (!NILP (tem))
190         return dpyinfo;
191     }
193   error ("Emacs for OpenStep does not yet support multi-display.");
195   Fx_open_connection (name, Qnil, Qnil);
196   dpyinfo = x_display_list;
198   if (dpyinfo == 0)
199     error ("OpenStep on %s not responding.\n", SDATA (name));
201   return dpyinfo;
204 static NSString *
205 ns_filename_from_panel (NSSavePanel *panel)
207 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
208   NSURL *url = [panel URL];
209   NSString *str = [url path];
210   return str;
211 #else
212   return [panel filename];
213 #endif
216 static NSString *
217 ns_directory_from_panel (NSSavePanel *panel)
219 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
220   NSURL *url = [panel directoryURL];
221   NSString *str = [url path];
222   return str;
223 #else
224   return [panel directory];
225 #endif
228 static Lisp_Object
229 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
230 /* --------------------------------------------------------------------------
231    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
232    -------------------------------------------------------------------------- */
234   int i, count;
235   NSMenuItem *item;
236   const char *name;
237   Lisp_Object nameStr;
238   unsigned short key;
239   NSString *keys;
240   Lisp_Object res;
242   count = [menu numberOfItems];
243   for (i = 0; i<count; i++)
244     {
245       item = [menu itemAtIndex: i];
246       name = [[item title] UTF8String];
247       if (!name) continue;
249       nameStr = build_string (name);
251       if ([item hasSubmenu])
252         {
253           old = interpret_services_menu ([item submenu],
254                                         Fcons (nameStr, prefix), old);
255         }
256       else
257         {
258           keys = [item keyEquivalent];
259           if (keys && [keys length] )
260             {
261               key = [keys characterAtIndex: 0];
262               res = make_number (key|super_modifier);
263             }
264           else
265             {
266               res = Qundefined;
267             }
268           old = Fcons (Fcons (res,
269                             Freverse (Fcons (nameStr,
270                                            prefix))),
271                     old);
272         }
273     }
274   return old;
279 /* ==========================================================================
281     Frame parameter setters
283    ========================================================================== */
286 static void
287 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
289   NSColor *col;
290   EmacsCGFloat r, g, b, alpha;
292   if (ns_lisp_to_color (arg, &col))
293     {
294       store_frame_param (f, Qforeground_color, oldval);
295       error ("Unknown color");
296     }
298   [col retain];
299   [f->output_data.ns->foreground_color release];
300   f->output_data.ns->foreground_color = col;
302   [col getRed: &r green: &g blue: &b alpha: &alpha];
303   FRAME_FOREGROUND_PIXEL (f) =
304     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
306   if (FRAME_NS_VIEW (f))
307     {
308       update_face_from_frame_parameter (f, Qforeground_color, arg);
309       /*recompute_basic_faces (f); */
310       if (FRAME_VISIBLE_P (f))
311         redraw_frame (f);
312     }
316 static void
317 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
319   struct face *face;
320   NSColor *col;
321   NSView *view = FRAME_NS_VIEW (f);
322   EmacsCGFloat r, g, b, alpha;
324   if (ns_lisp_to_color (arg, &col))
325     {
326       store_frame_param (f, Qbackground_color, oldval);
327       error ("Unknown color");
328     }
330   /* clear the frame; in some instances the NS-internal GC appears not to
331      update, or it does update and cannot clear old text properly */
332   if (FRAME_VISIBLE_P (f))
333     ns_clear_frame (f);
335   [col retain];
336   [f->output_data.ns->background_color release];
337   f->output_data.ns->background_color = col;
339   [col getRed: &r green: &g blue: &b alpha: &alpha];
340   FRAME_BACKGROUND_PIXEL (f) =
341     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
343   if (view != nil)
344     {
345       [[view window] setBackgroundColor: col];
347       if (alpha != (EmacsCGFloat) 1.0)
348           [[view window] setOpaque: NO];
349       else
350           [[view window] setOpaque: YES];
352       face = FRAME_DEFAULT_FACE (f);
353       if (face)
354         {
355           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
356           face->background = ns_index_color
357             ([col colorWithAlphaComponent: alpha], f);
359           update_face_from_frame_parameter (f, Qbackground_color, arg);
360         }
362       if (FRAME_VISIBLE_P (f))
363         redraw_frame (f);
364     }
368 static void
369 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
371   NSColor *col;
373   if (ns_lisp_to_color (arg, &col))
374     {
375       store_frame_param (f, Qcursor_color, oldval);
376       error ("Unknown color");
377     }
379   [FRAME_CURSOR_COLOR (f) release];
380   FRAME_CURSOR_COLOR (f) = [col retain];
382   if (FRAME_VISIBLE_P (f))
383     {
384       x_update_cursor (f, 0);
385       x_update_cursor (f, 1);
386     }
387   update_face_from_frame_parameter (f, Qcursor_color, arg);
391 static void
392 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
394   NSView *view = FRAME_NS_VIEW (f);
395   NSTRACE (x_set_icon_name);
397   /* see if it's changed */
398   if (STRINGP (arg))
399     {
400       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
401         return;
402     }
403   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
404     return;
406   fset_icon_name (f, arg);
408   if (NILP (arg))
409     {
410       if (!NILP (f->title))
411         arg = f->title;
412       else
413         /* explicit name and no icon-name -> explicit_name */
414         if (f->explicit_name)
415           arg = f->name;
416         else
417           {
418             /* no explicit name and no icon-name ->
419                name has to be rebuild from icon_title_format */
420             windows_or_buffers_changed++;
421             return;
422           }
423     }
425   /* Don't change the name if it's already NAME.  */
426   if ([[view window] miniwindowTitle] &&
427       ([[[view window] miniwindowTitle]
428              isEqualToString: [NSString stringWithUTF8String:
429                                            SSDATA (arg)]]))
430     return;
432   [[view window] setMiniwindowTitle:
433         [NSString stringWithUTF8String: SSDATA (arg)]];
436 static void
437 ns_set_name_internal (struct frame *f, Lisp_Object name)
439   struct gcpro gcpro1;
440   Lisp_Object encoded_name, encoded_icon_name;
441   NSString *str;
442   NSView *view = FRAME_NS_VIEW (f);
444   GCPRO1 (name);
445   encoded_name = ENCODE_UTF_8 (name);
446   UNGCPRO;
448   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
450   /* Don't change the name if it's already NAME.  */
451   if (! [[[view window] title] isEqualToString: str])
452     [[view window] setTitle: str];
454   if (!STRINGP (f->icon_name))
455     encoded_icon_name = encoded_name;
456   else
457     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
459   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
461   if ([[view window] miniwindowTitle] &&
462       ! [[[view window] miniwindowTitle] isEqualToString: str])
463     [[view window] setMiniwindowTitle: str];
467 static void
468 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
470   NSTRACE (ns_set_name);
472   /* Make sure that requests from lisp code override requests from
473      Emacs redisplay code.  */
474   if (explicit)
475     {
476       /* If we're switching from explicit to implicit, we had better
477          update the mode lines and thereby update the title.  */
478       if (f->explicit_name && NILP (name))
479         update_mode_lines = 1;
481       f->explicit_name = ! NILP (name);
482     }
483   else if (f->explicit_name)
484     return;
486   if (NILP (name))
487     name = build_string([ns_app_name UTF8String]);
488   else
489     CHECK_STRING (name);
491   /* Don't change the name if it's already NAME.  */
492   if (! NILP (Fstring_equal (name, f->name)))
493     return;
495   fset_name (f, name);
497   /* title overrides explicit name */
498   if (! NILP (f->title))
499     name = f->title;
501   ns_set_name_internal (f, name);
505 /* This function should be called when the user's lisp code has
506    specified a name for the frame; the name will override any set by the
507    redisplay code.  */
508 static void
509 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
511   NSTRACE (x_explicitly_set_name);
512   ns_set_name (f, arg, 1);
516 /* This function should be called by Emacs redisplay code to set the
517    name; names set this way will never override names set by the user's
518    lisp code.  */
519 void
520 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
522   NSTRACE (x_implicitly_set_name);
524   /* Deal with NS specific format t.  */
525   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
526                          || EQ (Vframe_title_format, Qt)))
527     ns_set_name_as_filename (f);
528   else
529     ns_set_name (f, arg, 0);
533 /* Change the title of frame F to NAME.
534    If NAME is nil, use the frame name as the title.  */
536 static void
537 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
539   NSTRACE (x_set_title);
540   /* Don't change the title if it's already NAME.  */
541   if (EQ (name, f->title))
542     return;
544   update_mode_lines = 1;
546   fset_title (f, name);
548   if (NILP (name))
549     name = f->name;
550   else
551     CHECK_STRING (name);
553   ns_set_name_internal (f, name);
557 void
558 ns_set_name_as_filename (struct frame *f)
560   NSView *view;
561   Lisp_Object name, filename;
562   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
563   const char *title;
564   NSAutoreleasePool *pool;
565   struct gcpro gcpro1;
566   Lisp_Object encoded_name, encoded_filename;
567   NSString *str;
568   NSTRACE (ns_set_name_as_filename);
570   if (f->explicit_name || ! NILP (f->title))
571     return;
573   block_input ();
574   pool = [[NSAutoreleasePool alloc] init];
575   filename = BVAR (XBUFFER (buf), filename);
576   name = BVAR (XBUFFER (buf), name);
578   if (NILP (name))
579     {
580       if (! NILP (filename))
581         name = Ffile_name_nondirectory (filename);
582       else
583         name = build_string ([ns_app_name UTF8String]);
584     }
586   GCPRO1 (name);
587   encoded_name = ENCODE_UTF_8 (name);
588   UNGCPRO;
590   view = FRAME_NS_VIEW (f);
592   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
593                                 : [[[view window] title] UTF8String];
595   if (title && (! strcmp (title, SSDATA (encoded_name))))
596     {
597       [pool release];
598       unblock_input ();
599       return;
600     }
602   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
603   if (str == nil) str = @"Bad coding";
605   if (FRAME_ICONIFIED_P (f))
606     [[view window] setMiniwindowTitle: str];
607   else
608     {
609       NSString *fstr;
611       if (! NILP (filename))
612         {
613           GCPRO1 (filename);
614           encoded_filename = ENCODE_UTF_8 (filename);
615           UNGCPRO;
617           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
618           if (fstr == nil) fstr = @"";
619 #ifdef NS_IMPL_COCOA
620           /* work around a bug observed on 10.3 and later where
621              setTitleWithRepresentedFilename does not clear out previous state
622              if given filename does not exist */
623           if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
624             [[view window] setRepresentedFilename: @""];
625 #endif
626         }
627       else
628         fstr = @"";
630       [[view window] setRepresentedFilename: fstr];
631       [[view window] setTitle: str];
632       fset_name (f, name);
633     }
635   [pool release];
636   unblock_input ();
640 void
641 ns_set_doc_edited (struct frame *f, Lisp_Object arg)
643   NSView *view = FRAME_NS_VIEW (f);
644   NSAutoreleasePool *pool;
645   if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
646     {
647       block_input ();
648       pool = [[NSAutoreleasePool alloc] init];
649       [[view window] setDocumentEdited: !NILP (arg)];
650       [pool release];
651       unblock_input ();
652     }
656 void
657 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
659   int nlines;
660   if (FRAME_MINIBUF_ONLY_P (f))
661     return;
663   if (TYPE_RANGED_INTEGERP (int, value))
664     nlines = XINT (value);
665   else
666     nlines = 0;
668   FRAME_MENU_BAR_LINES (f) = 0;
669   if (nlines)
670     {
671       FRAME_EXTERNAL_MENU_BAR (f) = 1;
672       /* does for all frames, whereas we just want for one frame
673          [NSMenu setMenuBarVisible: YES]; */
674     }
675   else
676     {
677       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
678         free_frame_menubar (f);
679       /*      [NSMenu setMenuBarVisible: NO]; */
680       FRAME_EXTERNAL_MENU_BAR (f) = 0;
681     }
685 /* toolbar support */
686 void
687 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
689   int nlines;
691   if (FRAME_MINIBUF_ONLY_P (f))
692     return;
694   if (RANGED_INTEGERP (0, value, INT_MAX))
695     nlines = XFASTINT (value);
696   else
697     nlines = 0;
699   if (nlines)
700     {
701       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
702       update_frame_tool_bar (f);
703     }
704   else
705     {
706       if (FRAME_EXTERNAL_TOOL_BAR (f))
707         {
708           free_frame_tool_bar (f);
709           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
710         }
711     }
713   x_set_window_size (f, 0, f->text_cols, f->text_lines);
717 static void
718 ns_implicitly_set_icon_type (struct frame *f)
720   Lisp_Object tem;
721   EmacsView *view = FRAME_NS_VIEW (f);
722   id image = nil;
723   Lisp_Object chain, elt;
724   NSAutoreleasePool *pool;
725   BOOL setMini = YES;
727   NSTRACE (ns_implicitly_set_icon_type);
729   block_input ();
730   pool = [[NSAutoreleasePool alloc] init];
731   if (f->output_data.ns->miniimage
732       && [[NSString stringWithUTF8String: SSDATA (f->name)]
733                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
734     {
735       [pool release];
736       unblock_input ();
737       return;
738     }
740   tem = assq_no_quit (Qicon_type, f->param_alist);
741   if (CONSP (tem) && ! NILP (XCDR (tem)))
742     {
743       [pool release];
744       unblock_input ();
745       return;
746     }
748   for (chain = Vns_icon_type_alist;
749        image == nil && CONSP (chain);
750        chain = XCDR (chain))
751     {
752       elt = XCAR (chain);
753       /* special case: 't' means go by file type */
754       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
755         {
756           NSString *str
757              = [NSString stringWithUTF8String: SSDATA (f->name)];
758           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
759             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
760         }
761       else if (CONSP (elt) &&
762                STRINGP (XCAR (elt)) &&
763                STRINGP (XCDR (elt)) &&
764                fast_string_match (XCAR (elt), f->name) >= 0)
765         {
766           image = [EmacsImage allocInitFromFile: XCDR (elt)];
767           if (image == nil)
768             image = [[NSImage imageNamed:
769                                [NSString stringWithUTF8String:
770                                             SSDATA (XCDR (elt))]] retain];
771         }
772     }
774   if (image == nil)
775     {
776       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
777       setMini = NO;
778     }
780   [f->output_data.ns->miniimage release];
781   f->output_data.ns->miniimage = image;
782   [view setMiniwindowImage: setMini];
783   [pool release];
784   unblock_input ();
788 static void
789 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
791   EmacsView *view = FRAME_NS_VIEW (f);
792   id image = nil;
793   BOOL setMini = YES;
795   NSTRACE (x_set_icon_type);
797   if (!NILP (arg) && SYMBOLP (arg))
798     {
799       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
800       store_frame_param (f, Qicon_type, arg);
801     }
803   /* do it the implicit way */
804   if (NILP (arg))
805     {
806       ns_implicitly_set_icon_type (f);
807       return;
808     }
810   CHECK_STRING (arg);
812   image = [EmacsImage allocInitFromFile: arg];
813   if (image == nil)
814     image =[NSImage imageNamed: [NSString stringWithUTF8String:
815                                             SSDATA (arg)]];
817   if (image == nil)
818     {
819       image = [NSImage imageNamed: @"text"];
820       setMini = NO;
821     }
823   f->output_data.ns->miniimage = image;
824   [view setMiniwindowImage: setMini];
828 /* TODO: move to nsterm? */
830 ns_lisp_to_cursor_type (Lisp_Object arg)
832   char *str;
833   if (XTYPE (arg) == Lisp_String)
834     str = SSDATA (arg);
835   else if (XTYPE (arg) == Lisp_Symbol)
836     str = SSDATA (SYMBOL_NAME (arg));
837   else return -1;
838   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
839   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
840   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
841   if (!strcmp (str, "bar"))     return BAR_CURSOR;
842   if (!strcmp (str, "no"))      return NO_CURSOR;
843   return -1;
847 Lisp_Object
848 ns_cursor_type_to_lisp (int arg)
850   switch (arg)
851     {
852     case FILLED_BOX_CURSOR: return Qbox;
853     case HOLLOW_BOX_CURSOR: return intern ("hollow");
854     case HBAR_CURSOR:       return intern ("hbar");
855     case BAR_CURSOR:        return intern ("bar");
856     case NO_CURSOR:
857     default:                return intern ("no");
858     }
861 /* This is the same as the xfns.c definition.  */
862 static void
863 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
865   set_frame_cursor_types (f, arg);
868 /* called to set mouse pointer color, but all other terms use it to
869    initialize pointer types (and don't set the color ;) */
870 static void
871 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
873   /* don't think we can do this on Nextstep */
877 #define Str(x) #x
878 #define Xstr(x) Str(x)
880 static Lisp_Object
881 ns_appkit_version_str (void)
883   char tmp[80];
885 #ifdef NS_IMPL_GNUSTEP
886   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
887 #elif defined (NS_IMPL_COCOA)
888   sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
889 #else
890   tmp = "ns-unknown";
891 #endif
892   return build_string (tmp);
896 /* This is for use by x-server-version and collapses all version info we
897    have into a single int.  For a better picture of the implementation
898    running, use ns_appkit_version_str.*/
899 static int
900 ns_appkit_version_int (void)
902 #ifdef NS_IMPL_GNUSTEP
903   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
904 #elif defined (NS_IMPL_COCOA)
905   return (int)NSAppKitVersionNumber;
906 #endif
907   return 0;
911 static void
912 x_icon (struct frame *f, Lisp_Object parms)
913 /* --------------------------------------------------------------------------
914    Strangely-named function to set icon position parameters in frame.
915    This is irrelevant under OS X, but might be needed under GNUstep,
916    depending on the window manager used.  Note, this is not a standard
917    frame parameter-setter; it is called directly from x-create-frame.
918    -------------------------------------------------------------------------- */
920   Lisp_Object icon_x, icon_y;
921   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
923   f->output_data.ns->icon_top = Qnil;
924   f->output_data.ns->icon_left = Qnil;
926   /* Set the position of the icon.  */
927   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
928   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
929   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
930     {
931       CHECK_NUMBER (icon_x);
932       CHECK_NUMBER (icon_y);
933       f->output_data.ns->icon_top = icon_y;
934       f->output_data.ns->icon_left = icon_x;
935     }
936   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
937     error ("Both left and top icon corners of icon must be specified");
941 /* Note: see frame.c for template, also where generic functions are impl */
942 frame_parm_handler ns_frame_parm_handlers[] =
944   x_set_autoraise, /* generic OK */
945   x_set_autolower, /* generic OK */
946   x_set_background_color,
947   0, /* x_set_border_color,  may be impossible under Nextstep */
948   0, /* x_set_border_width,  may be impossible under Nextstep */
949   x_set_cursor_color,
950   x_set_cursor_type,
951   x_set_font, /* generic OK */
952   x_set_foreground_color,
953   x_set_icon_name,
954   x_set_icon_type,
955   x_set_internal_border_width, /* generic OK */
956   x_set_menu_bar_lines,
957   x_set_mouse_color,
958   x_explicitly_set_name,
959   x_set_scroll_bar_width, /* generic OK */
960   x_set_title,
961   x_set_unsplittable, /* generic OK */
962   x_set_vertical_scroll_bars, /* generic OK */
963   x_set_visibility, /* generic OK */
964   x_set_tool_bar_lines,
965   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
966   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
967   x_set_screen_gamma, /* generic OK */
968   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
969   x_set_fringe_width, /* generic OK */
970   x_set_fringe_width, /* generic OK */
971   0, /* x_set_wait_for_wm, will ignore */
972   x_set_fullscreen, /* generic OK */
973   x_set_font_backend, /* generic OK */
974   x_set_alpha,
975   0, /* x_set_sticky */
976   0, /* x_set_tool_bar_position */
980 /* Handler for signals raised during x_create_frame.
981    FRAME is the frame which is partially constructed.  */
983 static void
984 unwind_create_frame (Lisp_Object frame)
986   struct frame *f = XFRAME (frame);
988   /* If frame is already dead, nothing to do.  This can happen if the
989      display is disconnected after the frame has become official, but
990      before x_create_frame removes the unwind protect.  */
991   if (!FRAME_LIVE_P (f))
992     return;
994   /* If frame is ``official'', nothing to do.  */
995   if (NILP (Fmemq (frame, Vframe_list)))
996     {
997 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
998       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
999 #endif
1001       x_free_frame_resources (f);
1002       free_glyphs (f);
1004 #ifdef GLYPH_DEBUG
1005       /* Check that reference counts are indeed correct.  */
1006       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1007 #endif
1008     }
1012  * Read geometry related parameters from preferences if not in PARMS.
1013  * Returns the union of parms and any preferences read.
1014  */
1016 static Lisp_Object
1017 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1018                                Lisp_Object parms)
1020   struct {
1021     const char *val;
1022     const char *cls;
1023     Lisp_Object tem;
1024   } r[] = {
1025     { "width",  "Width", Qwidth },
1026     { "height", "Height", Qheight },
1027     { "left", "Left", Qleft },
1028     { "top", "Top", Qtop },
1029   };
1031   int i;
1032   for (i = 0; i < sizeof (r)/sizeof (r[0]); ++i)
1033     {
1034       if (NILP (Fassq (r[i].tem, parms)))
1035         {
1036           Lisp_Object value
1037             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1038                          RES_TYPE_NUMBER);
1039           if (! EQ (value, Qunbound))
1040             parms = Fcons (Fcons (r[i].tem, value), parms);
1041         }
1042     }
1044   return parms;
1047 /* ==========================================================================
1049     Lisp definitions
1051    ========================================================================== */
1053 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1054        1, 1, 0,
1055        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1056 Return an Emacs frame object.
1057 PARMS is an alist of frame parameters.
1058 If the parameters specify that the frame should not have a minibuffer,
1059 and do not specify a specific minibuffer window to use,
1060 then `default-minibuffer-frame' must be a frame whose minibuffer can
1061 be shared by the new frame.
1063 This function is an internal primitive--use `make-frame' instead.  */)
1064      (Lisp_Object parms)
1066   struct frame *f;
1067   Lisp_Object frame, tem;
1068   Lisp_Object name;
1069   int minibuffer_only = 0;
1070   long window_prompting = 0;
1071   int width, height;
1072   ptrdiff_t count = specpdl_ptr - specpdl;
1073   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1074   Lisp_Object display;
1075   struct ns_display_info *dpyinfo = NULL;
1076   Lisp_Object parent;
1077   struct kboard *kb;
1078   static int desc_ctr = 1;
1080   /* x_get_arg modifies parms.  */
1081   parms = Fcopy_alist (parms);
1083   /* Use this general default value to start with
1084      until we know if this frame has a specified name.  */
1085   Vx_resource_name = Vinvocation_name;
1087   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1088   if (EQ (display, Qunbound))
1089     display = Qnil;
1090   dpyinfo = check_ns_display_info (display);
1091   kb = dpyinfo->terminal->kboard;
1093   if (!dpyinfo->terminal->name)
1094     error ("Terminal is not live, can't create new frames on it");
1096   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1097   if (!STRINGP (name)
1098       && ! EQ (name, Qunbound)
1099       && ! NILP (name))
1100     error ("Invalid frame name--not a string or nil");
1102   if (STRINGP (name))
1103     Vx_resource_name = name;
1105   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1106   if (EQ (parent, Qunbound))
1107     parent = Qnil;
1108   if (! NILP (parent))
1109     CHECK_NUMBER (parent);
1111   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1112   /* No need to protect DISPLAY because that's not used after passing
1113      it to make_frame_without_minibuffer.  */
1114   frame = Qnil;
1115   GCPRO4 (parms, parent, name, frame);
1116   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1117                   RES_TYPE_SYMBOL);
1118   if (EQ (tem, Qnone) || NILP (tem))
1119       f = make_frame_without_minibuffer (Qnil, kb, display);
1120   else if (EQ (tem, Qonly))
1121     {
1122       f = make_minibuffer_frame ();
1123       minibuffer_only = 1;
1124     }
1125   else if (WINDOWP (tem))
1126       f = make_frame_without_minibuffer (tem, kb, display);
1127   else
1128       f = make_frame (1);
1130   XSETFRAME (frame, f);
1132   f->terminal = dpyinfo->terminal;
1134   f->output_method = output_ns;
1135   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1137   FRAME_FONTSET (f) = -1;
1139   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1140                                 "iconName", "Title",
1141                                 RES_TYPE_STRING));
1142   if (! STRINGP (f->icon_name))
1143     fset_icon_name (f, Qnil);
1145   FRAME_DISPLAY_INFO (f) = dpyinfo;
1147   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1148   record_unwind_protect (unwind_create_frame, frame);
1150   f->output_data.ns->window_desc = desc_ctr++;
1151   if (TYPE_RANGED_INTEGERP (Window, parent))
1152     {
1153       f->output_data.ns->parent_desc = XFASTINT (parent);
1154       f->output_data.ns->explicit_parent = 1;
1155     }
1156   else
1157     {
1158       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1159       f->output_data.ns->explicit_parent = 0;
1160     }
1162   /* Set the name; the functions to which we pass f expect the name to
1163      be set.  */
1164   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1165     {
1166       fset_name (f, build_string ([ns_app_name UTF8String]));
1167       f->explicit_name = 0;
1168     }
1169   else
1170     {
1171       fset_name (f, name);
1172       f->explicit_name = 1;
1173       specbind (Qx_resource_name, name);
1174     }
1176   block_input ();
1178 #ifdef NS_IMPL_COCOA
1179 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1180   if (CTGetCoreTextVersion != NULL
1181       && CTGetCoreTextVersion () >= kCTVersionNumber10_5)
1182     mac_register_font_driver (f);
1183 #endif
1184 #endif
1185   register_font_driver (&nsfont_driver, f);
1187   x_default_parameter (f, parms, Qfont_backend, Qnil,
1188                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1190   {
1191     /* use for default font name */
1192     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1193     x_default_parameter (f, parms, Qfontsize,
1194                                     make_number (0 /*(int)[font pointSize]*/),
1195                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1196     // Remove ' Regular', not handled by backends.
1197     char *fontname = xstrdup ([[font displayName] UTF8String]);
1198     int len = strlen (fontname);
1199     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1200       fontname[len-8] = '\0';
1201     x_default_parameter (f, parms, Qfont,
1202                                  build_string (fontname),
1203                                  "font", "Font", RES_TYPE_STRING);
1204   }
1205   unblock_input ();
1207   x_default_parameter (f, parms, Qborder_width, make_number (0),
1208                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1209   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1210                       "internalBorderWidth", "InternalBorderWidth",
1211                       RES_TYPE_NUMBER);
1213   /* default scrollbars on right on Mac */
1214   {
1215       Lisp_Object spos
1216 #ifdef NS_IMPL_GNUSTEP
1217           = Qt;
1218 #else
1219           = Qright;
1220 #endif
1221       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1222                            "verticalScrollBars", "VerticalScrollBars",
1223                            RES_TYPE_SYMBOL);
1224   }
1225   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1226                       "foreground", "Foreground", RES_TYPE_STRING);
1227   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1228                       "background", "Background", RES_TYPE_STRING);
1229   /* FIXME: not supported yet in Nextstep */
1230   x_default_parameter (f, parms, Qline_spacing, Qnil,
1231                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1232   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1233                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1234   x_default_parameter (f, parms, Qright_fringe, Qnil,
1235                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1237 #ifdef GLYPH_DEBUG
1238   image_cache_refcount =
1239     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1240 #endif
1242   init_frame_faces (f);
1244   /* The resources controlling the menu-bar and tool-bar are
1245      processed specially at startup, and reflected in the mode
1246      variables; ignore them here.  */
1247   x_default_parameter (f, parms, Qmenu_bar_lines,
1248                        NILP (Vmenu_bar_mode)
1249                        ? make_number (0) : make_number (1),
1250                        NULL, NULL, RES_TYPE_NUMBER);
1251   x_default_parameter (f, parms, Qtool_bar_lines,
1252                        NILP (Vtool_bar_mode)
1253                        ? make_number (0) : make_number (1),
1254                        NULL, NULL, RES_TYPE_NUMBER);
1256   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1257                        "BufferPredicate", RES_TYPE_SYMBOL);
1258   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1259                        RES_TYPE_STRING);
1261   parms = get_geometry_from_preferences (dpyinfo, parms);
1262   window_prompting = x_figure_window_size (f, parms, 1);
1264   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1265   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1267   /* NOTE: on other terms, this is done in set_mouse_color, however this
1268      was not getting called under Nextstep */
1269   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1270   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1271   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1272   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1273   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1274   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1275   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1276      = [NSCursor arrowCursor];
1277   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1279   [[EmacsView alloc] initFrameFromEmacs: f];
1281   x_icon (f, parms);
1283   /* ns_display_info does not have a reference_count.  */
1284   f->terminal->reference_count++;
1286   /* It is now ok to make the frame official even if we get an error below.
1287      The frame needs to be on Vframe_list or making it visible won't work. */
1288   Vframe_list = Fcons (frame, Vframe_list);
1290   x_default_parameter (f, parms, Qicon_type, Qnil,
1291                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1293   x_default_parameter (f, parms, Qauto_raise, Qnil,
1294                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1295   x_default_parameter (f, parms, Qauto_lower, Qnil,
1296                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1297   x_default_parameter (f, parms, Qcursor_type, Qbox,
1298                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1299   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1300                        "scrollBarWidth", "ScrollBarWidth",
1301                        RES_TYPE_NUMBER);
1302   x_default_parameter (f, parms, Qalpha, Qnil,
1303                        "alpha", "Alpha", RES_TYPE_NUMBER);
1304   x_default_parameter (f, parms, Qfullscreen, Qnil,
1305                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1307   width = FRAME_COLS (f);
1308   height = FRAME_LINES (f);
1310   SET_FRAME_COLS (f, 0);
1311   FRAME_LINES (f) = 0;
1312   change_frame_size (f, height, width, 1, 0, 0);
1314   if (! f->output_data.ns->explicit_parent)
1315     {
1316       Lisp_Object visibility;
1318       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1319                               RES_TYPE_SYMBOL);
1320       if (EQ (visibility, Qunbound))
1321         visibility = Qt;
1323       if (EQ (visibility, Qicon))
1324         x_iconify_frame (f);
1325       else if (! NILP (visibility))
1326         {
1327           x_make_frame_visible (f);
1328           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1329         }
1330       else
1331         {
1332           /* Must have been Qnil.  */
1333         }
1334     }
1336   if (FRAME_HAS_MINIBUF_P (f)
1337       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1338           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1339     kset_default_minibuffer_frame (kb, frame);
1341   /* All remaining specified parameters, which have not been "used"
1342      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1343   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1344     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1345       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1347   UNGCPRO;
1349   if (window_prompting & USPosition)
1350     x_set_offset (f, f->left_pos, f->top_pos, 1);
1352   /* Make sure windows on this frame appear in calls to next-window
1353      and similar functions.  */
1354   Vwindow_list = Qnil;
1356   return unbind_to (count, frame);
1359 void
1360 x_focus_frame (struct frame *f)
1362   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1364   if (dpyinfo->x_focus_frame != f)
1365     {
1366       EmacsView *view = FRAME_NS_VIEW (f);
1367       block_input ();
1368       [NSApp activateIgnoringOtherApps: YES];
1369       [[view window] makeKeyAndOrderFront: view];
1370       unblock_input ();
1371     }
1375 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1376        0, 1, "",
1377        doc: /* Pop up the font panel. */)
1378      (Lisp_Object frame)
1380   struct frame *f = decode_window_system_frame (frame);
1381   id fm = [NSFontManager sharedFontManager];
1382   struct font *font = f->output_data.ns->font;
1383   NSFont *nsfont;
1384   if (EQ (font->driver->type, Qns))
1385     nsfont = ((struct nsfont_info *)font)->nsfont;
1386 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1387   else
1388     nsfont = (NSFont *) macfont_get_nsctfont (font);
1389 #endif
1390   [fm setSelectedFont: nsfont isMultiple: NO];
1391   [fm orderFrontFontPanel: NSApp];
1392   return Qnil;
1396 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1397        0, 1, "",
1398        doc: /* Pop up the color panel.  */)
1399      (Lisp_Object frame)
1401   check_window_system (NULL);
1402   [NSApp orderFrontColorPanel: NSApp];
1403   return Qnil;
1406 static struct
1408   id panel;
1409   BOOL ret;
1410 #if ! defined (NS_IMPL_COCOA) || \
1411   MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
1412   NSString *dirS, *initS;
1413   BOOL no_types;
1414 #endif
1415 } ns_fd_data;
1417 void
1418 ns_run_file_dialog (void)
1420   if (ns_fd_data.panel == nil) return;
1421 #if defined (NS_IMPL_COCOA) && \
1422   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1423   ns_fd_data.ret = [ns_fd_data.panel runModal];
1424 #else
1425   if (ns_fd_data.no_types)
1426     {
1427       ns_fd_data.ret = [ns_fd_data.panel
1428                            runModalForDirectory: ns_fd_data.dirS
1429                            file: ns_fd_data.initS];
1430     }
1431   else
1432     {
1433       ns_fd_data.ret = [ns_fd_data.panel
1434                            runModalForDirectory: ns_fd_data.dirS
1435                            file: ns_fd_data.initS
1436                            types: nil];
1437     }
1438 #endif
1439   ns_fd_data.panel = nil;
1442 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1443        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1444 Optional arg DIR, if non-nil, supplies a default directory.
1445 Optional arg MUSTMATCH, if non-nil, means the returned file or
1446 directory must exist.
1447 Optional arg INIT, if non-nil, provides a default file name to use.
1448 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1449   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1450    Lisp_Object init, Lisp_Object dir_only_p)
1452   static id fileDelegate = nil;
1453   BOOL ret;
1454   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1455   id panel;
1456   Lisp_Object fname;
1458   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1459     [NSString stringWithUTF8String: SSDATA (prompt)];
1460   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1461     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1462     [NSString stringWithUTF8String: SSDATA (dir)];
1463   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1464     [NSString stringWithUTF8String: SSDATA (init)];
1465   NSEvent *nxev;
1467   check_window_system (NULL);
1469   if (fileDelegate == nil)
1470     fileDelegate = [EmacsFileDelegate new];
1472   [NSCursor setHiddenUntilMouseMoves: NO];
1474   if ([dirS characterAtIndex: 0] == '~')
1475     dirS = [dirS stringByExpandingTildeInPath];
1477   panel = isSave ?
1478     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1480   [panel setTitle: promptS];
1482   [panel setAllowsOtherFileTypes: YES];
1483   [panel setTreatsFilePackagesAsDirectories: YES];
1484   [panel setDelegate: fileDelegate];
1486   if (! NILP (dir_only_p))
1487     {
1488       [panel setCanChooseDirectories: YES];
1489       [panel setCanChooseFiles: NO];
1490     }
1491   else if (! isSave)
1492     {
1493       /* This is not quite what the documentation says, but it is compatible
1494          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1495       [panel setCanChooseDirectories: NO];
1496       [panel setCanChooseFiles: YES];
1497     }
1499   block_input ();
1500   ns_fd_data.panel = panel;
1501   ns_fd_data.ret = NO;
1502 #if defined (NS_IMPL_COCOA) && \
1503   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1504   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1505     [panel setAllowedFileTypes: nil];
1506   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1507   if (initS && NILP (Ffile_directory_p (init)))
1508     [panel setNameFieldStringValue: [initS lastPathComponent]];
1509   else
1510     [panel setNameFieldStringValue: @""];
1512 #else
1513   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1514   ns_fd_data.dirS = dirS;
1515   ns_fd_data.initS = initS;
1516 #endif
1518   /* runModalForDirectory/runModal restarts the main event loop when done,
1519      so we must start an event loop and then pop up the file dialog.
1520      The file dialog may pop up a confirm dialog after Ok has been pressed,
1521      so we can not simply pop down on the Ok/Cancel press.
1522    */
1523   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1524                             location: NSMakePoint (0, 0)
1525                        modifierFlags: 0
1526                            timestamp: 0
1527                         windowNumber: [[NSApp mainWindow] windowNumber]
1528                              context: [NSApp context]
1529                              subtype: 0
1530                                data1: 0
1531                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1533   [NSApp postEvent: nxev atStart: NO];
1534   while (ns_fd_data.panel != nil)
1535     [NSApp run];
1537   ret = (ns_fd_data.ret == NSOKButton);
1539   if (ret)
1540     {
1541       NSString *str = ns_filename_from_panel (panel);
1542       if (! str) str = ns_directory_from_panel (panel);
1543       if (! str) ret = NO;
1544       else fname = build_string ([str UTF8String]);
1545     }
1547   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1548   unblock_input ();
1550   return ret ? fname : Qnil;
1553 const char *
1554 ns_get_defaults_value (const char *key)
1556   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1557                     objectForKey: [NSString stringWithUTF8String: key]];
1559   if (!obj) return NULL;
1561   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1565 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1566        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1567 If OWNER is nil, Emacs is assumed.  */)
1568      (Lisp_Object owner, Lisp_Object name)
1570   const char *value;
1572   check_window_system (NULL);
1573   if (NILP (owner))
1574     owner = build_string([ns_app_name UTF8String]);
1575   CHECK_STRING (name);
1577   value = ns_get_defaults_value (SSDATA (name));
1579   if (value)
1580     return build_string (value);
1581   return Qnil;
1585 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1586        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1587 If OWNER is nil, Emacs is assumed.
1588 If VALUE is nil, the default is removed.  */)
1589      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1591   check_window_system (NULL);
1592   if (NILP (owner))
1593     owner = build_string ([ns_app_name UTF8String]);
1594   CHECK_STRING (name);
1595   if (NILP (value))
1596     {
1597       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1598                          [NSString stringWithUTF8String: SSDATA (name)]];
1599     }
1600   else
1601     {
1602       CHECK_STRING (value);
1603       [[NSUserDefaults standardUserDefaults] setObject:
1604                 [NSString stringWithUTF8String: SSDATA (value)]
1605                                         forKey: [NSString stringWithUTF8String:
1606                                                          SSDATA (name)]];
1607     }
1609   return Qnil;
1613 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1614        Sx_server_max_request_size,
1615        0, 1, 0,
1616        doc: /* This function is a no-op.  It is only present for completeness.  */)
1617      (Lisp_Object terminal)
1619   check_ns_display_info (terminal);
1620   /* This function has no real equivalent under NeXTstep.  Return nil to
1621      indicate this. */
1622   return Qnil;
1626 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1627        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1628 \(Labeling every distributor as a "vendor" embodies the false assumption
1629 that operating systems cannot be developed and distributed noncommercially.)
1630 The optional argument TERMINAL specifies which display to ask about.
1631 TERMINAL should be a terminal object, a frame or a display name (a string).
1632 If omitted or nil, that stands for the selected frame's display.  */)
1633   (Lisp_Object terminal)
1635   check_ns_display_info (terminal);
1636 #ifdef NS_IMPL_GNUSTEP
1637   return build_string ("GNU");
1638 #else
1639   return build_string ("Apple");
1640 #endif
1644 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1645        doc: /* Return the version numbers of the server of display TERMINAL.
1646 The value is a list of three integers: the major and minor
1647 version numbers of the X Protocol in use, and the distributor-specific release
1648 number.  See also the function `x-server-vendor'.
1650 The optional argument TERMINAL specifies which display to ask about.
1651 TERMINAL should be a terminal object, a frame or a display name (a string).
1652 If omitted or nil, that stands for the selected frame's display.  */)
1653   (Lisp_Object terminal)
1655   check_ns_display_info (terminal);
1656   /*NOTE: it is unclear what would best correspond with "protocol";
1657           we return 10.3, meaning Panther, since this is roughly the
1658           level that GNUstep's APIs correspond to.
1659           The last number is where we distinguish between the Apple
1660           and GNUstep implementations ("distributor-specific release
1661           number") and give int'ized versions of major.minor. */
1662   return list3i (10, 3, ns_appkit_version_int ());
1666 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1667        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1668 The optional argument TERMINAL specifies which display to ask about.
1669 TERMINAL should be a terminal object, a frame or a display name (a string).
1670 If omitted or nil, that stands for the selected frame's display.
1672 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1673 the number of physical monitors, use `(length
1674 (display-monitor-attributes-list TERMINAL))' instead.  */)
1675   (Lisp_Object terminal)
1677   check_ns_display_info (terminal);
1678   return make_number (1);
1682 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1683        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1684 The optional argument TERMINAL specifies which display to ask about.
1685 TERMINAL should be a terminal object, a frame or a display name (a string).
1686 If omitted or nil, that stands for the selected frame's display.
1688 On \"multi-monitor\" setups this refers to the height in millimeters for
1689 all physical monitors associated with TERMINAL.  To get information
1690 for each physical monitor, use `display-monitor-attributes-list'.  */)
1691   (Lisp_Object terminal)
1693   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1695   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1699 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1700        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1701 The optional argument TERMINAL specifies which display to ask about.
1702 TERMINAL should be a terminal object, a frame or a display name (a string).
1703 If omitted or nil, that stands for the selected frame's display.
1705 On \"multi-monitor\" setups this refers to the width in millimeters for
1706 all physical monitors associated with TERMINAL.  To get information
1707 for each physical monitor, use `display-monitor-attributes-list'.  */)
1708   (Lisp_Object terminal)
1710   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1712   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1716 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1717        Sx_display_backing_store, 0, 1, 0,
1718        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1719 The value may be `buffered', `retained', or `non-retained'.
1720 The optional argument TERMINAL specifies which display to ask about.
1721 TERMINAL should be a terminal object, a frame or a display name (a string).
1722 If omitted or nil, that stands for the selected frame's display.  */)
1723   (Lisp_Object terminal)
1725   check_ns_display_info (terminal);
1726   switch ([ns_get_window (terminal) backingType])
1727     {
1728     case NSBackingStoreBuffered:
1729       return intern ("buffered");
1730     case NSBackingStoreRetained:
1731       return intern ("retained");
1732     case NSBackingStoreNonretained:
1733       return intern ("non-retained");
1734     default:
1735       error ("Strange value for backingType parameter of frame");
1736     }
1737   return Qnil;  /* not reached, shut compiler up */
1741 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1742        Sx_display_visual_class, 0, 1, 0,
1743        doc: /* Return the visual class of the Nextstep display TERMINAL.
1744 The value is one of the symbols `static-gray', `gray-scale',
1745 `static-color', `pseudo-color', `true-color', or `direct-color'.
1747 The optional argument TERMINAL specifies which display to ask about.
1748 TERMINAL should a terminal object, a frame or a display name (a string).
1749 If omitted or nil, that stands for the selected frame's display.  */)
1750   (Lisp_Object terminal)
1752   NSWindowDepth depth;
1754   check_ns_display_info (terminal);
1755   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1757   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1758     return intern ("static-gray");
1759   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1760     return intern ("gray-scale");
1761   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1762     return intern ("pseudo-color");
1763   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1764     return intern ("true-color");
1765   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1766     return intern ("direct-color");
1767   else
1768     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1769     return intern ("direct-color");
1773 DEFUN ("x-display-save-under", Fx_display_save_under,
1774        Sx_display_save_under, 0, 1, 0,
1775        doc: /* Return t if TERMINAL supports the save-under feature.
1776 The optional argument TERMINAL specifies which display to ask about.
1777 TERMINAL should be a terminal object, a frame or a display name (a string).
1778 If omitted or nil, that stands for the selected frame's display.  */)
1779   (Lisp_Object terminal)
1781   check_ns_display_info (terminal);
1782   switch ([ns_get_window (terminal) backingType])
1783     {
1784     case NSBackingStoreBuffered:
1785       return Qt;
1787     case NSBackingStoreRetained:
1788     case NSBackingStoreNonretained:
1789       return Qnil;
1791     default:
1792       error ("Strange value for backingType parameter of frame");
1793     }
1794   return Qnil;  /* not reached, shut compiler up */
1798 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1799        1, 3, 0,
1800        doc: /* Open a connection to a display server.
1801 DISPLAY is the name of the display to connect to.
1802 Optional second arg XRM-STRING is a string of resources in xrdb format.
1803 If the optional third arg MUST-SUCCEED is non-nil,
1804 terminate Emacs if we can't open the connection.
1805 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1806      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1808   struct ns_display_info *dpyinfo;
1810   CHECK_STRING (display);
1812   nxatoms_of_nsselect ();
1813   dpyinfo = ns_term_init (display);
1814   if (dpyinfo == 0)
1815     {
1816       if (!NILP (must_succeed))
1817         fatal ("OpenStep on %s not responding.\n",
1818                SSDATA (display));
1819       else
1820         error ("OpenStep on %s not responding.\n",
1821                SSDATA (display));
1822     }
1824   return Qnil;
1828 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1829        1, 1, 0,
1830        doc: /* Close the connection to TERMINAL's Nextstep display server.
1831 For TERMINAL, specify a terminal object, a frame or a display name (a
1832 string).  If TERMINAL is nil, that stands for the selected frame's
1833 terminal.  */)
1834      (Lisp_Object terminal)
1836   check_ns_display_info (terminal);
1837   [NSApp terminate: NSApp];
1838   return Qnil;
1842 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1843        doc: /* Return the list of display names that Emacs has connections to.  */)
1844      (void)
1846   Lisp_Object tail, result;
1848   result = Qnil;
1849   for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1850     result = Fcons (XCAR (XCAR (tail)), result);
1852   return result;
1856 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1857        0, 0, 0,
1858        doc: /* Hides all applications other than Emacs.  */)
1859      (void)
1861   check_window_system (NULL);
1862   [NSApp hideOtherApplications: NSApp];
1863   return Qnil;
1866 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1867        1, 1, 0,
1868        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1869 Otherwise if Emacs is hidden, it is unhidden.
1870 If ON is equal to `activate', Emacs is unhidden and becomes
1871 the active application.  */)
1872      (Lisp_Object on)
1874   check_window_system (NULL);
1875   if (EQ (on, intern ("activate")))
1876     {
1877       [NSApp unhide: NSApp];
1878       [NSApp activateIgnoringOtherApps: YES];
1879     }
1880   else if (NILP (on))
1881     [NSApp unhide: NSApp];
1882   else
1883     [NSApp hide: NSApp];
1884   return Qnil;
1888 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1889        0, 0, 0,
1890        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1891      (void)
1893   check_window_system (NULL);
1894   [NSApp orderFrontStandardAboutPanel: nil];
1895   return Qnil;
1899 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1900        doc: /* Determine font PostScript or family name for font NAME.
1901 NAME should be a string containing either the font name or an XLFD
1902 font descriptor.  If string contains `fontset' and not
1903 `fontset-startup', it is left alone. */)
1904      (Lisp_Object name)
1906   char *nm;
1907   CHECK_STRING (name);
1908   nm = SSDATA (name);
1910   if (nm[0] != '-')
1911     return name;
1912   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1913     return name;
1915   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1919 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1920        doc: /* Return a list of all available colors.
1921 The optional argument FRAME is currently ignored.  */)
1922      (Lisp_Object frame)
1924   Lisp_Object list = Qnil;
1925   NSEnumerator *colorlists;
1926   NSColorList *clist;
1928   if (!NILP (frame))
1929     {
1930       CHECK_FRAME (frame);
1931       if (! FRAME_NS_P (XFRAME (frame)))
1932         error ("non-Nextstep frame used in `ns-list-colors'");
1933     }
1935   block_input ();
1937   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1938   while ((clist = [colorlists nextObject]))
1939     {
1940       if ([[clist name] length] < 7 ||
1941           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1942         {
1943           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1944           NSString *cname;
1945           while ((cname = [cnames nextObject]))
1946             list = Fcons (build_string ([cname UTF8String]), list);
1947 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1948                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1949                                              UTF8String]), list); */
1950         }
1951     }
1953   unblock_input ();
1955   return list;
1959 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1960        doc: /* List available Nextstep services by querying NSApp.  */)
1961      (void)
1963 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1964   /* You can't get services like this in 10.6+.  */
1965   return Qnil;
1966 #else
1967   Lisp_Object ret = Qnil;
1968   NSMenu *svcs;
1969 #ifdef NS_IMPL_COCOA
1970   id delegate;
1971 #endif
1973   check_window_system (NULL);
1974   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1975   [NSApp setServicesMenu: svcs];
1976   [NSApp registerServicesMenuSendTypes: ns_send_types
1977                            returnTypes: ns_return_types];
1979 /* On Tiger, services menu updating was made lazier (waits for user to
1980    actually click on the menu), so we have to force things along: */
1981 #ifdef NS_IMPL_COCOA
1982   delegate = [svcs delegate];
1983   if (delegate != nil)
1984     {
1985       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1986         [delegate menuNeedsUpdate: svcs];
1987       if ([delegate respondsToSelector:
1988                        @selector (menu:updateItem:atIndex:shouldCancel:)])
1989         {
1990           int i, len = [delegate numberOfItemsInMenu: svcs];
1991           for (i =0; i<len; i++)
1992             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
1993           for (i =0; i<len; i++)
1994             if (![delegate menu: svcs
1995                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
1996                         atIndex: i shouldCancel: NO])
1997               break;
1998         }
1999     }
2000 #endif
2002   [svcs setAutoenablesItems: NO];
2003 #ifdef NS_IMPL_COCOA
2004   [svcs update]; /* on OS X, converts from '/' structure */
2005 #endif
2007   ret = interpret_services_menu (svcs, Qnil, ret);
2008   return ret;
2009 #endif
2013 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2014        2, 2, 0,
2015        doc: /* Perform Nextstep SERVICE on SEND.
2016 SEND should be either a string or nil.
2017 The return value is the result of the service, as string, or nil if
2018 there was no result.  */)
2019      (Lisp_Object service, Lisp_Object send)
2021   id pb;
2022   NSString *svcName;
2023   char *utfStr;
2025   CHECK_STRING (service);
2026   check_window_system (NULL);
2028   utfStr = SSDATA (service);
2029   svcName = [NSString stringWithUTF8String: utfStr];
2031   pb =[NSPasteboard pasteboardWithUniqueName];
2032   ns_string_to_pasteboard (pb, send);
2034   if (NSPerformService (svcName, pb) == NO)
2035     Fsignal (Qquit, list1 (build_string ("service not available")));
2037   if ([[pb types] count] == 0)
2038     return build_string ("");
2039   return ns_string_from_pasteboard (pb);
2043 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2044        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2045        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2046      (Lisp_Object str)
2048 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2049          remove this. */
2050   NSString *utfStr;
2051   Lisp_Object ret;
2053   CHECK_STRING (str);
2054   NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
2055  utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2056 #ifdef NS_IMPL_COCOA
2057   utfStr = [utfStr precomposedStringWithCanonicalMapping];
2058 #endif
2059   ret = build_string ([utfStr UTF8String]);
2060   [pool release];
2061   return ret;
2065 #ifdef NS_IMPL_COCOA
2067 /* Compile and execute the AppleScript SCRIPT and return the error
2068    status as function value.  A zero is returned if compilation and
2069    execution is successful, in which case *RESULT is set to a Lisp
2070    string or a number containing the resulting script value.  Otherwise,
2071    1 is returned. */
2072 static int
2073 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2075   NSAppleEventDescriptor *desc;
2076   NSDictionary* errorDict;
2077   NSAppleEventDescriptor* returnDescriptor = NULL;
2079   NSAppleScript* scriptObject =
2080     [[NSAppleScript alloc] initWithSource:
2081                              [NSString stringWithUTF8String: SSDATA (script)]];
2083   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2084   [scriptObject release];
2086   *result = Qnil;
2088   if (returnDescriptor != NULL)
2089     {
2090       // successful execution
2091       if (kAENullEvent != [returnDescriptor descriptorType])
2092         {
2093           *result = Qt;
2094           // script returned an AppleScript result
2095           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2096 #if defined (NS_IMPL_COCOA)
2097               (typeUTF16ExternalRepresentation
2098                == [returnDescriptor descriptorType]) ||
2099 #endif
2100               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2101               (typeCString == [returnDescriptor descriptorType]))
2102             {
2103               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2104               if (desc)
2105                 *result = build_string([[desc stringValue] UTF8String]);
2106             }
2107           else
2108             {
2109               /* use typeUTF16ExternalRepresentation? */
2110               // coerce the result to the appropriate ObjC type
2111               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2112               if (desc)
2113                 *result = make_number([desc int32Value]);
2114             }
2115         }
2116     }
2117   else
2118     {
2119       // no script result, return error
2120       return 1;
2121     }
2122   return 0;
2125 /* Helper function called from sendEvent to run applescript
2126    from within the main event loop.  */
2128 void
2129 ns_run_ascript (void)
2131   if (! NILP (as_script))
2132     as_status = ns_do_applescript (as_script, as_result);
2133   as_script = Qnil;
2136 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2137        doc: /* Execute AppleScript SCRIPT and return the result.
2138 If compilation and execution are successful, the resulting script value
2139 is returned as a string, a number or, in the case of other constructs, t.
2140 In case the execution fails, an error is signaled. */)
2141      (Lisp_Object script)
2143   Lisp_Object result;
2144   int status;
2145   NSEvent *nxev;
2147   CHECK_STRING (script);
2148   check_window_system (NULL);
2150   block_input ();
2152   as_script = script;
2153   as_result = &result;
2155   /* executing apple script requires the event loop to run, otherwise
2156      errors aren't returned and executeAndReturnError hangs forever.
2157      Post an event that runs applescript and then start the event loop.
2158      The event loop is exited when the script is done.  */
2159   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2160                             location: NSMakePoint (0, 0)
2161                        modifierFlags: 0
2162                            timestamp: 0
2163                         windowNumber: [[NSApp mainWindow] windowNumber]
2164                              context: [NSApp context]
2165                              subtype: 0
2166                                data1: 0
2167                                data2: NSAPP_DATA2_RUNASSCRIPT];
2169   [NSApp postEvent: nxev atStart: NO];
2171   // If there are other events, the event loop may exit.  Keep running
2172   // until the script has been handled.  */
2173   while (! NILP (as_script))
2174     [NSApp run];
2176   status = as_status;
2177   as_status = 0;
2178   as_result = 0;
2179   unblock_input ();
2180   if (status == 0)
2181     return result;
2182   else if (!STRINGP (result))
2183     error ("AppleScript error %d", status);
2184   else
2185     error ("%s", SSDATA (result));
2187 #endif
2191 /* ==========================================================================
2193     Miscellaneous functions not called through hooks
2195    ========================================================================== */
2197 /* called from frame.c */
2198 struct ns_display_info *
2199 check_x_display_info (Lisp_Object frame)
2201   return check_ns_display_info (frame);
2205 void
2206 x_set_scroll_bar_default_width (struct frame *f)
2208   int wid = FRAME_COLUMN_WIDTH (f);
2209   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2210   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2211                                       wid - 1) / wid;
2214 /* terms impl this instead of x-get-resource directly */
2215 char *
2216 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2218   /* remove appname prefix; TODO: allow for !="Emacs" */
2219   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2221   check_window_system (NULL);
2223   if (inhibit_x_resources)
2224     /* --quick was passed, so this is a no-op.  */
2225     return NULL;
2227   res = ns_get_defaults_value (toCheck);
2228   return (!res ? NULL :
2229           (!c_strncasecmp (res, "YES", 3) ? "true" :
2230            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2234 Lisp_Object
2235 x_get_focus_frame (struct frame *frame)
2237   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2238   Lisp_Object nsfocus;
2240   if (!dpyinfo->x_focus_frame)
2241     return Qnil;
2243   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2244   return nsfocus;
2247 /* ==========================================================================
2249     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2251    ========================================================================== */
2254 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2255        doc: /* Internal function called by `color-defined-p', which see.
2256 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2257      (Lisp_Object color, Lisp_Object frame)
2259   NSColor * col;
2260   check_window_system (NULL);
2261   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2265 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2266        doc: /* Internal function called by `color-values', which see.  */)
2267      (Lisp_Object color, Lisp_Object frame)
2269   NSColor * col;
2270   EmacsCGFloat red, green, blue, alpha;
2272   check_window_system (NULL);
2273   CHECK_STRING (color);
2275   if (ns_lisp_to_color (color, &col))
2276     return Qnil;
2278   [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2279         getRed: &red green: &green blue: &blue alpha: &alpha];
2280   return list3i (lrint (red * 65280), lrint (green * 65280),
2281                  lrint (blue * 65280));
2285 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2286        doc: /* Internal function called by `display-color-p', which see.  */)
2287      (Lisp_Object terminal)
2289   NSWindowDepth depth;
2290   NSString *colorSpace;
2292   check_ns_display_info (terminal);
2293   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2294   colorSpace = NSColorSpaceFromDepth (depth);
2296   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2297          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2298       ? Qnil : Qt;
2302 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2303        0, 1, 0,
2304        doc: /* Return t if the Nextstep display supports shades of gray.
2305 Note that color displays do support shades of gray.
2306 The optional argument TERMINAL specifies which display to ask about.
2307 TERMINAL should be a terminal object, a frame or a display name (a string).
2308 If omitted or nil, that stands for the selected frame's display.  */)
2309   (Lisp_Object terminal)
2311   NSWindowDepth depth;
2313   check_ns_display_info (terminal);
2314   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2316   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2320 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2321        0, 1, 0,
2322        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2323 The optional argument TERMINAL specifies which display to ask about.
2324 TERMINAL should be a terminal object, a frame or a display name (a string).
2325 If omitted or nil, that stands for the selected frame's display.
2327 On \"multi-monitor\" setups this refers to the pixel width for all
2328 physical monitors associated with TERMINAL.  To get information for
2329 each physical monitor, use `display-monitor-attributes-list'.  */)
2330   (Lisp_Object terminal)
2332   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2334   return make_number (x_display_pixel_width (dpyinfo));
2338 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2339        Sx_display_pixel_height, 0, 1, 0,
2340        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2341 The optional argument TERMINAL specifies which display to ask about.
2342 TERMINAL should be a terminal object, a frame or a display name (a string).
2343 If omitted or nil, that stands for the selected frame's display.
2345 On \"multi-monitor\" setups this refers to the pixel height for all
2346 physical monitors associated with TERMINAL.  To get information for
2347 each physical monitor, use `display-monitor-attributes-list'.  */)
2348   (Lisp_Object terminal)
2350   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2352   return make_number (x_display_pixel_height (dpyinfo));
2355 #ifdef NS_IMPL_COCOA
2356 /* Returns the name for the screen that DICT came from, or NULL.
2357    Caller must free return value.
2360 static char *
2361 ns_screen_name (CGDirectDisplayID did)
2363   char *name = NULL;
2364   NSDictionary *info = (NSDictionary *)
2365     IODisplayCreateInfoDictionary (CGDisplayIOServicePort (did),
2366                                    kIODisplayOnlyPreferredName);
2367   NSDictionary *names
2368     = [info objectForKey:
2369               [NSString stringWithUTF8String:kDisplayProductName]];
2371   if ([names count] > 0) {
2372     NSString *n = [names objectForKey: [[names allKeys] objectAtIndex:0]];
2373     if (n != nil)
2374       name = xstrdup ([n UTF8String]);
2375   }
2377   [info release];
2378   return name;
2380 #endif
2382 static Lisp_Object
2383 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2384                                 int n_monitors,
2385                                 int primary_monitor,
2386                                 const char *source)
2388   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2389   Lisp_Object frame, rest;
2390   NSArray *screens = [NSScreen screens];
2391   int i;
2393   FOR_EACH_FRAME (rest, frame)
2394     {
2395       struct frame *f = XFRAME (frame);
2397       if (FRAME_NS_P (f))
2398         {
2399           NSView *view = FRAME_NS_VIEW (f);
2400           NSScreen *screen = [[view window] screen];
2401           NSUInteger k;
2403           i = -1;
2404           for (k = 0; i == -1 && k < [screens count]; ++k)
2405             {
2406               if ([screens objectAtIndex: k] == screen)
2407                 i = (int)k;
2408             }
2410           if (i > -1)
2411             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2412         }
2413     }
2415   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2416                                       monitor_frames, source);
2419 DEFUN ("ns-display-monitor-attributes-list",
2420        Fns_display_monitor_attributes_list,
2421        Sns_display_monitor_attributes_list,
2422        0, 1, 0,
2423        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2425 The optional argument TERMINAL specifies which display to ask about.
2426 TERMINAL should be a terminal object, a frame or a display name (a string).
2427 If omitted or nil, that stands for the selected frame's display.
2429 In addition to the standard attribute keys listed in
2430 `display-monitor-attributes-list', the following keys are contained in
2431 the attributes:
2433  source -- String describing the source from which multi-monitor
2434            information is obtained, \"NS\" is always the source."
2436 Internal use only, use `display-monitor-attributes-list' instead.  */)
2437   (Lisp_Object terminal)
2439   struct terminal *term = get_terminal (terminal, 1);
2440   NSArray *screens;
2441   NSUInteger i, n_monitors;
2442   struct MonitorInfo *monitors;
2443   Lisp_Object attributes_list = Qnil;
2444   CGFloat primary_display_height = 0;
2446   if (term->type != output_ns)
2447     return Qnil;
2449   screens = [NSScreen screens];
2450   n_monitors = [screens count];
2451   if (n_monitors == 0)
2452     return Qnil;
2454   monitors = xzalloc (n_monitors * sizeof *monitors);
2456   for (i = 0; i < [screens count]; ++i)
2457     {
2458       NSScreen *s = [screens objectAtIndex:i];
2459       struct MonitorInfo *m = &monitors[i];
2460       NSRect fr = [s frame];
2461       NSRect vfr = [s visibleFrame];
2462       short y, vy;
2464 #ifdef NS_IMPL_COCOA
2465       NSDictionary *dict = [s deviceDescription];
2466       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2467       CGDirectDisplayID did = [nid unsignedIntValue];
2468 #endif
2469       if (i == 0)
2470         {
2471           primary_display_height = fr.size.height;
2472           y = (short) fr.origin.y;
2473           vy = (short) vfr.origin.y;
2474         }
2475       else
2476         {
2477           // Flip y coordinate as NS has y starting from the bottom.
2478           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2479           vy = (short) (primary_display_height -
2480                         vfr.size.height - vfr.origin.y);
2481         }
2483       m->geom.x = (short) fr.origin.x;
2484       m->geom.y = y;
2485       m->geom.width = (unsigned short) fr.size.width;
2486       m->geom.height = (unsigned short) fr.size.height;
2488       m->work.x = (short) vfr.origin.x;
2489       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2490       // and fr.size.height - vfr.size.height are pixels missing in total.
2491       // Pixels missing at top are
2492       // fr.size.height - vfr.size.height - vy + y.
2493       // work.y is then pixels missing at top + y.
2494       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2495       m->work.width = (unsigned short) vfr.size.width;
2496       m->work.height = (unsigned short) vfr.size.height;
2498 #ifdef NS_IMPL_COCOA
2499       m->name = ns_screen_name (did);
2501       {
2502         CGSize mms = CGDisplayScreenSize (did);
2503         m->mm_width = (int) mms.width;
2504         m->mm_height = (int) mms.height;
2505       }
2507 #else
2508       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2509       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2510       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2511 #endif
2512     }
2514   // Primary monitor is always first for NS.
2515   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2516                                                     0, "NS");
2518   free_monitors (monitors, n_monitors);
2519   return attributes_list;
2523 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2524        0, 1, 0,
2525        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2526 The optional argument TERMINAL specifies which display to ask about.
2527 TERMINAL should be a terminal object, a frame or a display name (a string).
2528 If omitted or nil, that stands for the selected frame's display.  */)
2529   (Lisp_Object terminal)
2531   check_ns_display_info (terminal);
2532   return make_number
2533     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2537 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2538        0, 1, 0,
2539        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2540 The optional argument TERMINAL specifies which display to ask about.
2541 TERMINAL should be a terminal object, a frame or a display name (a string).
2542 If omitted or nil, that stands for the selected frame's display.  */)
2543   (Lisp_Object terminal)
2545   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2546   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2547   return make_number (1 << min (dpyinfo->n_planes, 24));
2551 /* Unused dummy def needed for compatibility. */
2552 Lisp_Object tip_frame;
2554 /* TODO: move to xdisp or similar */
2555 static void
2556 compute_tip_xy (struct frame *f,
2557                 Lisp_Object parms,
2558                 Lisp_Object dx,
2559                 Lisp_Object dy,
2560                 int width,
2561                 int height,
2562                 int *root_x,
2563                 int *root_y)
2565   Lisp_Object left, top;
2566   EmacsView *view = FRAME_NS_VIEW (f);
2567   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2568   NSPoint pt;
2570   /* Start with user-specified or mouse position.  */
2571   left = Fcdr (Fassq (Qleft, parms));
2572   top = Fcdr (Fassq (Qtop, parms));
2574   if (!INTEGERP (left) || !INTEGERP (top))
2575     {
2576       pt.x = dpyinfo->last_mouse_motion_x;
2577       pt.y = dpyinfo->last_mouse_motion_y;
2578       /* Convert to screen coordinates */
2579       pt = [view convertPoint: pt toView: nil];
2580       pt = [[view window] convertBaseToScreen: pt];
2581     }
2582   else
2583     {
2584       /* Absolute coordinates.  */
2585       pt.x = XINT (left);
2586       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2587         - height;
2588     }
2590   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2591   if (INTEGERP (left))
2592     *root_x = pt.x;
2593   else if (pt.x + XINT (dx) <= 0)
2594     *root_x = 0; /* Can happen for negative dx */
2595   else if (pt.x + XINT (dx) + width
2596            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2597     /* It fits to the right of the pointer.  */
2598     *root_x = pt.x + XINT (dx);
2599   else if (width + XINT (dx) <= pt.x)
2600     /* It fits to the left of the pointer.  */
2601     *root_x = pt.x - width - XINT (dx);
2602   else
2603     /* Put it left justified on the screen -- it ought to fit that way.  */
2604     *root_x = 0;
2606   if (INTEGERP (top))
2607     *root_y = pt.y;
2608   else if (pt.y - XINT (dy) - height >= 0)
2609     /* It fits below the pointer.  */
2610     *root_y = pt.y - height - XINT (dy);
2611   else if (pt.y + XINT (dy) + height
2612            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2613     /* It fits above the pointer */
2614       *root_y = pt.y + XINT (dy);
2615   else
2616     /* Put it on the top.  */
2617     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2621 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2622        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2623 A tooltip window is a small window displaying a string.
2625 This is an internal function; Lisp code should call `tooltip-show'.
2627 FRAME nil or omitted means use the selected frame.
2629 PARMS is an optional list of frame parameters which can be used to
2630 change the tooltip's appearance.
2632 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2633 means use the default timeout of 5 seconds.
2635 If the list of frame parameters PARMS contains a `left' parameter,
2636 the tooltip is displayed at that x-position.  Otherwise it is
2637 displayed at the mouse position, with offset DX added (default is 5 if
2638 DX isn't specified).  Likewise for the y-position; if a `top' frame
2639 parameter is specified, it determines the y-position of the tooltip
2640 window, otherwise it is displayed at the mouse position, with offset
2641 DY added (default is -10).
2643 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2644 Text larger than the specified size is clipped.  */)
2645      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2647   int root_x, root_y;
2648   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2649   ptrdiff_t count = SPECPDL_INDEX ();
2650   struct frame *f;
2651   char *str;
2652   NSSize size;
2654   specbind (Qinhibit_redisplay, Qt);
2656   GCPRO4 (string, parms, frame, timeout);
2658   CHECK_STRING (string);
2659   str = SSDATA (string);
2660   f = decode_window_system_frame (frame);
2661   if (NILP (timeout))
2662     timeout = make_number (5);
2663   else
2664     CHECK_NATNUM (timeout);
2666   if (NILP (dx))
2667     dx = make_number (5);
2668   else
2669     CHECK_NUMBER (dx);
2671   if (NILP (dy))
2672     dy = make_number (-10);
2673   else
2674     CHECK_NUMBER (dy);
2676   block_input ();
2677   if (ns_tooltip == nil)
2678     ns_tooltip = [[EmacsTooltip alloc] init];
2679   else
2680     Fx_hide_tip ();
2682   [ns_tooltip setText: str];
2683   size = [ns_tooltip frame].size;
2685   /* Move the tooltip window where the mouse pointer is.  Resize and
2686      show it.  */
2687   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2688                   &root_x, &root_y);
2690   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2691   unblock_input ();
2693   UNGCPRO;
2694   return unbind_to (count, Qnil);
2698 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2699        doc: /* Hide the current tooltip window, if there is any.
2700 Value is t if tooltip was open, nil otherwise.  */)
2701      (void)
2703   if (ns_tooltip == nil || ![ns_tooltip isActive])
2704     return Qnil;
2705   [ns_tooltip hide];
2706   return Qt;
2710 /* ==========================================================================
2712     Class implementations
2714    ========================================================================== */
2717   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2718   Return YES if handled, NO if not.
2719  */
2720 static BOOL
2721 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2723   NSString *s;
2724   int i;
2725   BOOL ret = NO;
2727   if ([theEvent type] != NSKeyDown) return NO;
2728   s = [theEvent characters];
2730   for (i = 0; i < [s length]; ++i)
2731     {
2732       int ch = (int) [s characterAtIndex: i];
2733       switch (ch)
2734         {
2735         case NSHomeFunctionKey:
2736         case NSDownArrowFunctionKey:
2737         case NSUpArrowFunctionKey:
2738         case NSLeftArrowFunctionKey:
2739         case NSRightArrowFunctionKey:
2740         case NSPageUpFunctionKey:
2741         case NSPageDownFunctionKey:
2742         case NSEndFunctionKey:
2743           /* Don't send command modified keys, as those are handled in the
2744              performKeyEquivalent method of the super class.
2745           */
2746           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2747             {
2748               [panel sendEvent: theEvent];
2749               ret = YES;
2750             }
2751           break;
2752           /* As we don't have the standard key commands for
2753              copy/paste/cut/select-all in our edit menu, we must handle
2754              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2755              here, paste works, because we have that in our Edit menu.
2756              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2757              correct modifier.
2758           */
2759         case 'x': // Cut
2760         case 'c': // Copy
2761         case 'v': // Paste
2762         case 'a': // Select all
2763           if ([theEvent modifierFlags] & NSCommandKeyMask)
2764             {
2765               [NSApp sendAction:
2766                        (ch == 'x'
2767                         ? @selector(cut:)
2768                         : (ch == 'c'
2769                            ? @selector(copy:)
2770                            : (ch == 'v'
2771                               ? @selector(paste:)
2772                               : @selector(selectAll:))))
2773                              to:nil from:panel];
2774               ret = YES;
2775             }
2776         default:
2777           // Send all control keys, as the text field supports C-a, C-f, C-e
2778           // C-b and more.
2779           if ([theEvent modifierFlags] & NSControlKeyMask)
2780             {
2781               [panel sendEvent: theEvent];
2782               ret = YES;
2783             }
2784           break;
2785         }
2786     }
2789   return ret;
2792 @implementation EmacsSavePanel
2793 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2795   BOOL ret = handlePanelKeys (self, theEvent);
2796   if (! ret)
2797     ret = [super performKeyEquivalent:theEvent];
2798   return ret;
2800 @end
2803 @implementation EmacsOpenPanel
2804 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2806   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2807   BOOL ret = handlePanelKeys (self, theEvent);
2808   if (! ret)
2809     ret = [super performKeyEquivalent:theEvent];
2810   return ret;
2812 @end
2815 @implementation EmacsFileDelegate
2816 /* --------------------------------------------------------------------------
2817    Delegate methods for Open/Save panels
2818    -------------------------------------------------------------------------- */
2819 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2821   return YES;
2823 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2825   return YES;
2827 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2828           confirmed: (BOOL)okFlag
2830   return filename;
2832 @end
2834 #endif
2837 /* ==========================================================================
2839     Lisp interface declaration
2841    ========================================================================== */
2844 void
2845 syms_of_nsfns (void)
2847   Qfontsize = intern_c_string ("fontsize");
2848   staticpro (&Qfontsize);
2850   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2851                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2852 If the title of a frame matches REGEXP, then IMAGE.tiff is
2853 selected as the image of the icon representing the frame when it's
2854 miniaturized.  If an element is t, then Emacs tries to select an icon
2855 based on the filetype of the visited file.
2857 The images have to be installed in a folder called English.lproj in the
2858 Emacs folder.  You have to restart Emacs after installing new icons.
2860 Example: Install an icon Gnus.tiff and execute the following code
2862   (setq ns-icon-type-alist
2863         (append ns-icon-type-alist
2864                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2865                    . \"Gnus\"))))
2867 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2868 be used as the image of the icon representing the frame.  */);
2869   Vns_icon_type_alist = list1 (Qt);
2871   DEFVAR_LISP ("ns-version-string", Vns_version_string,
2872                doc: /* Toolkit version for NS Windowing.  */);
2873   Vns_version_string = ns_appkit_version_str ();
2875   defsubr (&Sns_read_file_name);
2876   defsubr (&Sns_get_resource);
2877   defsubr (&Sns_set_resource);
2878   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2879   defsubr (&Sx_display_grayscale_p);
2880   defsubr (&Sns_font_name);
2881   defsubr (&Sns_list_colors);
2882 #ifdef NS_IMPL_COCOA
2883   defsubr (&Sns_do_applescript);
2884 #endif
2885   defsubr (&Sxw_color_defined_p);
2886   defsubr (&Sxw_color_values);
2887   defsubr (&Sx_server_max_request_size);
2888   defsubr (&Sx_server_vendor);
2889   defsubr (&Sx_server_version);
2890   defsubr (&Sx_display_pixel_width);
2891   defsubr (&Sx_display_pixel_height);
2892   defsubr (&Sns_display_monitor_attributes_list);
2893   defsubr (&Sx_display_mm_width);
2894   defsubr (&Sx_display_mm_height);
2895   defsubr (&Sx_display_screens);
2896   defsubr (&Sx_display_planes);
2897   defsubr (&Sx_display_color_cells);
2898   defsubr (&Sx_display_visual_class);
2899   defsubr (&Sx_display_backing_store);
2900   defsubr (&Sx_display_save_under);
2901   defsubr (&Sx_create_frame);
2902   defsubr (&Sx_open_connection);
2903   defsubr (&Sx_close_connection);
2904   defsubr (&Sx_display_list);
2906   defsubr (&Sns_hide_others);
2907   defsubr (&Sns_hide_emacs);
2908   defsubr (&Sns_emacs_info_panel);
2909   defsubr (&Sns_list_services);
2910   defsubr (&Sns_perform_service);
2911   defsubr (&Sns_convert_utf8_nfd_to_nfc);
2912   defsubr (&Sns_popup_font_panel);
2913   defsubr (&Sns_popup_color_panel);
2915   defsubr (&Sx_show_tip);
2916   defsubr (&Sx_hide_tip);
2918   as_status = 0;
2919   as_script = Qnil;
2920   as_result = 0;