lisp/ChangeLog: Fix last entry.
[emacs.git] / src / nsfns.m
blob8bce1da2e5dcc1e791e652445f0f672c74e82f94
1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2014 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 Qtop;
77 extern Lisp_Object Qdisplay;
78 extern Lisp_Object Qvertical_scroll_bars;
79 extern Lisp_Object Qhorizontal_scroll_bars;
80 extern Lisp_Object Qauto_raise;
81 extern Lisp_Object Qauto_lower;
82 extern Lisp_Object Qbox;
83 extern Lisp_Object Qscroll_bar_width;
84 extern Lisp_Object Qscroll_bar_height;
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   struct ns_display_info *dpyinfo;
180   CHECK_STRING (name);
182   for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
183     if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
184       return dpyinfo;
186   error ("Emacs for Nextstep does not yet support multi-display");
188   Fx_open_connection (name, Qnil, Qnil);
189   dpyinfo = x_display_list;
191   if (dpyinfo == 0)
192     error ("Display on %s not responding.\n", SDATA (name));
194   return dpyinfo;
197 static NSString *
198 ns_filename_from_panel (NSSavePanel *panel)
200 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
201   NSURL *url = [panel URL];
202   NSString *str = [url path];
203   return str;
204 #else
205   return [panel filename];
206 #endif
209 static NSString *
210 ns_directory_from_panel (NSSavePanel *panel)
212 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
213   NSURL *url = [panel directoryURL];
214   NSString *str = [url path];
215   return str;
216 #else
217   return [panel directory];
218 #endif
221 static Lisp_Object
222 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
223 /* --------------------------------------------------------------------------
224    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
225    -------------------------------------------------------------------------- */
227   int i, count;
228   NSMenuItem *item;
229   const char *name;
230   Lisp_Object nameStr;
231   unsigned short key;
232   NSString *keys;
233   Lisp_Object res;
235   count = [menu numberOfItems];
236   for (i = 0; i<count; i++)
237     {
238       item = [menu itemAtIndex: i];
239       name = [[item title] UTF8String];
240       if (!name) continue;
242       nameStr = build_string (name);
244       if ([item hasSubmenu])
245         {
246           old = interpret_services_menu ([item submenu],
247                                         Fcons (nameStr, prefix), old);
248         }
249       else
250         {
251           keys = [item keyEquivalent];
252           if (keys && [keys length] )
253             {
254               key = [keys characterAtIndex: 0];
255               res = make_number (key|super_modifier);
256             }
257           else
258             {
259               res = Qundefined;
260             }
261           old = Fcons (Fcons (res,
262                             Freverse (Fcons (nameStr,
263                                            prefix))),
264                     old);
265         }
266     }
267   return old;
272 /* ==========================================================================
274     Frame parameter setters
276    ========================================================================== */
279 static void
280 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
282   NSColor *col;
283   EmacsCGFloat r, g, b, alpha;
285   if (ns_lisp_to_color (arg, &col))
286     {
287       store_frame_param (f, Qforeground_color, oldval);
288       error ("Unknown color");
289     }
291   [col retain];
292   [f->output_data.ns->foreground_color release];
293   f->output_data.ns->foreground_color = col;
295   [col getRed: &r green: &g blue: &b alpha: &alpha];
296   FRAME_FOREGROUND_PIXEL (f) =
297     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
299   if (FRAME_NS_VIEW (f))
300     {
301       update_face_from_frame_parameter (f, Qforeground_color, arg);
302       /*recompute_basic_faces (f); */
303       if (FRAME_VISIBLE_P (f))
304         redraw_frame (f);
305     }
309 static void
310 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
312   struct face *face;
313   NSColor *col;
314   NSView *view = FRAME_NS_VIEW (f);
315   EmacsCGFloat r, g, b, alpha;
317   if (ns_lisp_to_color (arg, &col))
318     {
319       store_frame_param (f, Qbackground_color, oldval);
320       error ("Unknown color");
321     }
323   /* clear the frame; in some instances the NS-internal GC appears not to
324      update, or it does update and cannot clear old text properly */
325   if (FRAME_VISIBLE_P (f))
326     ns_clear_frame (f);
328   [col retain];
329   [f->output_data.ns->background_color release];
330   f->output_data.ns->background_color = col;
332   [col getRed: &r green: &g blue: &b alpha: &alpha];
333   FRAME_BACKGROUND_PIXEL (f) =
334     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
336   if (view != nil)
337     {
338       [[view window] setBackgroundColor: col];
340       if (alpha != (EmacsCGFloat) 1.0)
341           [[view window] setOpaque: NO];
342       else
343           [[view window] setOpaque: YES];
345       face = FRAME_DEFAULT_FACE (f);
346       if (face)
347         {
348           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
349           face->background = ns_index_color
350             ([col colorWithAlphaComponent: alpha], f);
352           update_face_from_frame_parameter (f, Qbackground_color, arg);
353         }
355       if (FRAME_VISIBLE_P (f))
356         redraw_frame (f);
357     }
361 static void
362 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
364   NSColor *col;
366   if (ns_lisp_to_color (arg, &col))
367     {
368       store_frame_param (f, Qcursor_color, oldval);
369       error ("Unknown color");
370     }
372   [FRAME_CURSOR_COLOR (f) release];
373   FRAME_CURSOR_COLOR (f) = [col retain];
375   if (FRAME_VISIBLE_P (f))
376     {
377       x_update_cursor (f, 0);
378       x_update_cursor (f, 1);
379     }
380   update_face_from_frame_parameter (f, Qcursor_color, arg);
384 static void
385 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
387   NSView *view = FRAME_NS_VIEW (f);
388   NSTRACE (x_set_icon_name);
390   /* see if it's changed */
391   if (STRINGP (arg))
392     {
393       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
394         return;
395     }
396   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
397     return;
399   fset_icon_name (f, arg);
401   if (NILP (arg))
402     {
403       if (!NILP (f->title))
404         arg = f->title;
405       else
406         /* Explicit name and no icon-name -> explicit_name.  */
407         if (f->explicit_name)
408           arg = f->name;
409         else
410           {
411             /* No explicit name and no icon-name ->
412                name has to be rebuild from icon_title_format.  */
413             windows_or_buffers_changed = 62;
414             return;
415           }
416     }
418   /* Don't change the name if it's already NAME.  */
419   if ([[view window] miniwindowTitle]
420       && ([[[view window] miniwindowTitle]
421              isEqualToString: [NSString stringWithUTF8String:
422                                           SSDATA (arg)]]))
423     return;
425   [[view window] setMiniwindowTitle:
426         [NSString stringWithUTF8String: SSDATA (arg)]];
429 static void
430 ns_set_name_internal (struct frame *f, Lisp_Object name)
432   struct gcpro gcpro1;
433   Lisp_Object encoded_name, encoded_icon_name;
434   NSString *str;
435   NSView *view = FRAME_NS_VIEW (f);
437   GCPRO1 (name);
438   encoded_name = ENCODE_UTF_8 (name);
439   UNGCPRO;
441   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
443   /* Don't change the name if it's already NAME.  */
444   if (! [[[view window] title] isEqualToString: str])
445     [[view window] setTitle: str];
447   if (!STRINGP (f->icon_name))
448     encoded_icon_name = encoded_name;
449   else
450     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
452   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
454   if ([[view window] miniwindowTitle]
455       && ! [[[view window] miniwindowTitle] isEqualToString: str])
456     [[view window] setMiniwindowTitle: str];
460 static void
461 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
463   NSTRACE (ns_set_name);
465   /* Make sure that requests from lisp code override requests from
466      Emacs redisplay code.  */
467   if (explicit)
468     {
469       /* If we're switching from explicit to implicit, we had better
470          update the mode lines and thereby update the title.  */
471       if (f->explicit_name && NILP (name))
472         update_mode_lines = 21;
474       f->explicit_name = ! NILP (name);
475     }
476   else if (f->explicit_name)
477     return;
479   if (NILP (name))
480     name = build_string ([ns_app_name UTF8String]);
481   else
482     CHECK_STRING (name);
484   /* Don't change the name if it's already NAME.  */
485   if (! NILP (Fstring_equal (name, f->name)))
486     return;
488   fset_name (f, name);
490   /* Title overrides explicit name.  */
491   if (! NILP (f->title))
492     name = f->title;
494   ns_set_name_internal (f, name);
498 /* This function should be called when the user's lisp code has
499    specified a name for the frame; the name will override any set by the
500    redisplay code.  */
501 static void
502 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
504   NSTRACE (x_explicitly_set_name);
505   ns_set_name (f, arg, 1);
509 /* This function should be called by Emacs redisplay code to set the
510    name; names set this way will never override names set by the user's
511    lisp code.  */
512 void
513 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
515   NSTRACE (x_implicitly_set_name);
517   /* Deal with NS specific format t.  */
518   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
519                          || EQ (Vframe_title_format, Qt)))
520     ns_set_name_as_filename (f);
521   else
522     ns_set_name (f, arg, 0);
526 /* Change the title of frame F to NAME.
527    If NAME is nil, use the frame name as the title.  */
529 static void
530 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
532   NSTRACE (x_set_title);
533   /* Don't change the title if it's already NAME.  */
534   if (EQ (name, f->title))
535     return;
537   update_mode_lines = 22;
539   fset_title (f, name);
541   if (NILP (name))
542     name = f->name;
543   else
544     CHECK_STRING (name);
546   ns_set_name_internal (f, name);
550 void
551 ns_set_name_as_filename (struct frame *f)
553   NSView *view;
554   Lisp_Object name, filename;
555   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
556   const char *title;
557   NSAutoreleasePool *pool;
558   struct gcpro gcpro1;
559   Lisp_Object encoded_name, encoded_filename;
560   NSString *str;
561   NSTRACE (ns_set_name_as_filename);
563   if (f->explicit_name || ! NILP (f->title))
564     return;
566   block_input ();
567   pool = [[NSAutoreleasePool alloc] init];
568   filename = BVAR (XBUFFER (buf), filename);
569   name = BVAR (XBUFFER (buf), name);
571   if (NILP (name))
572     {
573       if (! NILP (filename))
574         name = Ffile_name_nondirectory (filename);
575       else
576         name = build_string ([ns_app_name UTF8String]);
577     }
579   GCPRO1 (name);
580   encoded_name = ENCODE_UTF_8 (name);
581   UNGCPRO;
583   view = FRAME_NS_VIEW (f);
585   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
586                                 : [[[view window] title] UTF8String];
588   if (title && (! strcmp (title, SSDATA (encoded_name))))
589     {
590       [pool release];
591       unblock_input ();
592       return;
593     }
595   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
596   if (str == nil) str = @"Bad coding";
598   if (FRAME_ICONIFIED_P (f))
599     [[view window] setMiniwindowTitle: str];
600   else
601     {
602       NSString *fstr;
604       if (! NILP (filename))
605         {
606           GCPRO1 (filename);
607           encoded_filename = ENCODE_UTF_8 (filename);
608           UNGCPRO;
610           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
611           if (fstr == nil) fstr = @"";
612 #ifdef NS_IMPL_COCOA
613           /* work around a bug observed on 10.3 and later where
614              setTitleWithRepresentedFilename does not clear out previous state
615              if given filename does not exist */
616           if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
617             [[view window] setRepresentedFilename: @""];
618 #endif
619         }
620       else
621         fstr = @"";
623       [[view window] setRepresentedFilename: fstr];
624       [[view window] setTitle: str];
625       fset_name (f, name);
626     }
628   [pool release];
629   unblock_input ();
633 void
634 ns_set_doc_edited (struct frame *f, Lisp_Object arg)
636   NSView *view = FRAME_NS_VIEW (f);
637   NSAutoreleasePool *pool;
638   if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
639     {
640       block_input ();
641       pool = [[NSAutoreleasePool alloc] init];
642       [[view window] setDocumentEdited: !NILP (arg)];
643       [pool release];
644       unblock_input ();
645     }
649 void
650 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
652   int nlines;
653   if (FRAME_MINIBUF_ONLY_P (f))
654     return;
656   if (TYPE_RANGED_INTEGERP (int, value))
657     nlines = XINT (value);
658   else
659     nlines = 0;
661   FRAME_MENU_BAR_LINES (f) = 0;
662   if (nlines)
663     {
664       FRAME_EXTERNAL_MENU_BAR (f) = 1;
665       /* does for all frames, whereas we just want for one frame
666          [NSMenu setMenuBarVisible: YES]; */
667     }
668   else
669     {
670       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
671         free_frame_menubar (f);
672       /*      [NSMenu setMenuBarVisible: NO]; */
673       FRAME_EXTERNAL_MENU_BAR (f) = 0;
674     }
678 /* toolbar support */
679 void
680 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
682   int nlines;
684   if (FRAME_MINIBUF_ONLY_P (f))
685     return;
687   if (RANGED_INTEGERP (0, value, INT_MAX))
688     nlines = XFASTINT (value);
689   else
690     nlines = 0;
692   if (nlines)
693     {
694       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
695       update_frame_tool_bar (f);
696     }
697   else
698     {
699       if (FRAME_EXTERNAL_TOOL_BAR (f))
700         {
701           free_frame_tool_bar (f);
702           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
703         }
704     }
706   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
710 void
711 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
713   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
715   CHECK_TYPE_RANGED_INTEGER (int, arg);
716   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
717   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
718     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
720   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
721     return;
723   if (FRAME_X_WINDOW (f) != 0)
724     adjust_frame_size (f, -1, -1, 3, 0);
726   SET_FRAME_GARBAGED (f);
730 static void
731 ns_implicitly_set_icon_type (struct frame *f)
733   Lisp_Object tem;
734   EmacsView *view = FRAME_NS_VIEW (f);
735   id image = nil;
736   Lisp_Object chain, elt;
737   NSAutoreleasePool *pool;
738   BOOL setMini = YES;
740   NSTRACE (ns_implicitly_set_icon_type);
742   block_input ();
743   pool = [[NSAutoreleasePool alloc] init];
744   if (f->output_data.ns->miniimage
745       && [[NSString stringWithUTF8String: SSDATA (f->name)]
746                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
747     {
748       [pool release];
749       unblock_input ();
750       return;
751     }
753   tem = assq_no_quit (Qicon_type, f->param_alist);
754   if (CONSP (tem) && ! NILP (XCDR (tem)))
755     {
756       [pool release];
757       unblock_input ();
758       return;
759     }
761   for (chain = Vns_icon_type_alist;
762        image == nil && CONSP (chain);
763        chain = XCDR (chain))
764     {
765       elt = XCAR (chain);
766       /* special case: 't' means go by file type */
767       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
768         {
769           NSString *str
770              = [NSString stringWithUTF8String: SSDATA (f->name)];
771           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
772             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
773         }
774       else if (CONSP (elt) &&
775                STRINGP (XCAR (elt)) &&
776                STRINGP (XCDR (elt)) &&
777                fast_string_match (XCAR (elt), f->name) >= 0)
778         {
779           image = [EmacsImage allocInitFromFile: XCDR (elt)];
780           if (image == nil)
781             image = [[NSImage imageNamed:
782                                [NSString stringWithUTF8String:
783                                             SSDATA (XCDR (elt))]] retain];
784         }
785     }
787   if (image == nil)
788     {
789       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
790       setMini = NO;
791     }
793   [f->output_data.ns->miniimage release];
794   f->output_data.ns->miniimage = image;
795   [view setMiniwindowImage: setMini];
796   [pool release];
797   unblock_input ();
801 static void
802 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
804   EmacsView *view = FRAME_NS_VIEW (f);
805   id image = nil;
806   BOOL setMini = YES;
808   NSTRACE (x_set_icon_type);
810   if (!NILP (arg) && SYMBOLP (arg))
811     {
812       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
813       store_frame_param (f, Qicon_type, arg);
814     }
816   /* do it the implicit way */
817   if (NILP (arg))
818     {
819       ns_implicitly_set_icon_type (f);
820       return;
821     }
823   CHECK_STRING (arg);
825   image = [EmacsImage allocInitFromFile: arg];
826   if (image == nil)
827     image =[NSImage imageNamed: [NSString stringWithUTF8String:
828                                             SSDATA (arg)]];
830   if (image == nil)
831     {
832       image = [NSImage imageNamed: @"text"];
833       setMini = NO;
834     }
836   f->output_data.ns->miniimage = image;
837   [view setMiniwindowImage: setMini];
841 /* TODO: move to nsterm? */
843 ns_lisp_to_cursor_type (Lisp_Object arg)
845   char *str;
846   if (XTYPE (arg) == Lisp_String)
847     str = SSDATA (arg);
848   else if (XTYPE (arg) == Lisp_Symbol)
849     str = SSDATA (SYMBOL_NAME (arg));
850   else return -1;
851   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
852   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
853   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
854   if (!strcmp (str, "bar"))     return BAR_CURSOR;
855   if (!strcmp (str, "no"))      return NO_CURSOR;
856   return -1;
860 Lisp_Object
861 ns_cursor_type_to_lisp (int arg)
863   switch (arg)
864     {
865     case FILLED_BOX_CURSOR: return Qbox;
866     case HOLLOW_BOX_CURSOR: return intern ("hollow");
867     case HBAR_CURSOR:       return intern ("hbar");
868     case BAR_CURSOR:        return intern ("bar");
869     case NO_CURSOR:
870     default:                return intern ("no");
871     }
874 /* This is the same as the xfns.c definition.  */
875 static void
876 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
878   set_frame_cursor_types (f, arg);
881 /* called to set mouse pointer color, but all other terms use it to
882    initialize pointer types (and don't set the color ;) */
883 static void
884 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
886   /* don't think we can do this on Nextstep */
890 #define Str(x) #x
891 #define Xstr(x) Str(x)
893 static Lisp_Object
894 ns_appkit_version_str (void)
896   char tmp[256];
898 #ifdef NS_IMPL_GNUSTEP
899   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
900 #elif defined (NS_IMPL_COCOA)
901   NSString *osversion
902     = [[NSProcessInfo processInfo] operatingSystemVersionString];
903   sprintf(tmp, "appkit-%.2f %s",
904           NSAppKitVersionNumber,
905           [osversion UTF8String]);
906 #else
907   tmp = "ns-unknown";
908 #endif
909   return build_string (tmp);
913 /* This is for use by x-server-version and collapses all version info we
914    have into a single int.  For a better picture of the implementation
915    running, use ns_appkit_version_str.*/
916 static int
917 ns_appkit_version_int (void)
919 #ifdef NS_IMPL_GNUSTEP
920   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
921 #elif defined (NS_IMPL_COCOA)
922   return (int)NSAppKitVersionNumber;
923 #endif
924   return 0;
928 static void
929 x_icon (struct frame *f, Lisp_Object parms)
930 /* --------------------------------------------------------------------------
931    Strangely-named function to set icon position parameters in frame.
932    This is irrelevant under OS X, but might be needed under GNUstep,
933    depending on the window manager used.  Note, this is not a standard
934    frame parameter-setter; it is called directly from x-create-frame.
935    -------------------------------------------------------------------------- */
937   Lisp_Object icon_x, icon_y;
938   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
940   f->output_data.ns->icon_top = Qnil;
941   f->output_data.ns->icon_left = Qnil;
943   /* Set the position of the icon.  */
944   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
945   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
946   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
947     {
948       CHECK_NUMBER (icon_x);
949       CHECK_NUMBER (icon_y);
950       f->output_data.ns->icon_top = icon_y;
951       f->output_data.ns->icon_left = icon_x;
952     }
953   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
954     error ("Both left and top icon corners of icon must be specified");
958 /* Note: see frame.c for template, also where generic functions are impl */
959 frame_parm_handler ns_frame_parm_handlers[] =
961   x_set_autoraise, /* generic OK */
962   x_set_autolower, /* generic OK */
963   x_set_background_color,
964   0, /* x_set_border_color,  may be impossible under Nextstep */
965   0, /* x_set_border_width,  may be impossible under Nextstep */
966   x_set_cursor_color,
967   x_set_cursor_type,
968   x_set_font, /* generic OK */
969   x_set_foreground_color,
970   x_set_icon_name,
971   x_set_icon_type,
972   x_set_internal_border_width, /* generic OK */
973   0, /* x_set_right_divider_width */
974   0, /* x_set_bottom_divider_width */
975   x_set_menu_bar_lines,
976   x_set_mouse_color,
977   x_explicitly_set_name,
978   x_set_scroll_bar_width, /* generic OK */
979   x_set_scroll_bar_height, /* generic OK */
980   x_set_title,
981   x_set_unsplittable, /* generic OK */
982   x_set_vertical_scroll_bars, /* generic OK */
983   x_set_horizontal_scroll_bars, /* generic OK */
984   x_set_visibility, /* generic OK */
985   x_set_tool_bar_lines,
986   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
987   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
988   x_set_screen_gamma, /* generic OK */
989   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
990   x_set_left_fringe, /* generic OK */
991   x_set_right_fringe, /* generic OK */
992   0, /* x_set_wait_for_wm, will ignore */
993   x_set_fullscreen, /* generic OK */
994   x_set_font_backend, /* generic OK */
995   x_set_alpha,
996   0, /* x_set_sticky */
997   0, /* x_set_tool_bar_position */
1001 /* Handler for signals raised during x_create_frame.
1002    FRAME is the frame which is partially constructed.  */
1004 static void
1005 unwind_create_frame (Lisp_Object frame)
1007   struct frame *f = XFRAME (frame);
1009   /* If frame is already dead, nothing to do.  This can happen if the
1010      display is disconnected after the frame has become official, but
1011      before x_create_frame removes the unwind protect.  */
1012   if (!FRAME_LIVE_P (f))
1013     return;
1015   /* If frame is ``official'', nothing to do.  */
1016   if (NILP (Fmemq (frame, Vframe_list)))
1017     {
1018 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1019       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1020 #endif
1022       x_free_frame_resources (f);
1023       free_glyphs (f);
1025 #ifdef GLYPH_DEBUG
1026       /* Check that reference counts are indeed correct.  */
1027       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1028 #endif
1029     }
1033  * Read geometry related parameters from preferences if not in PARMS.
1034  * Returns the union of parms and any preferences read.
1035  */
1037 static Lisp_Object
1038 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1039                                Lisp_Object parms)
1041   struct {
1042     const char *val;
1043     const char *cls;
1044     Lisp_Object tem;
1045   } r[] = {
1046     { "width",  "Width", Qwidth },
1047     { "height", "Height", Qheight },
1048     { "left", "Left", Qleft },
1049     { "top", "Top", Qtop },
1050   };
1052   int i;
1053   for (i = 0; i < ARRAYELTS (r); ++i)
1054     {
1055       if (NILP (Fassq (r[i].tem, parms)))
1056         {
1057           Lisp_Object value
1058             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1059                          RES_TYPE_NUMBER);
1060           if (! EQ (value, Qunbound))
1061             parms = Fcons (Fcons (r[i].tem, value), parms);
1062         }
1063     }
1065   return parms;
1068 /* ==========================================================================
1070     Lisp definitions
1072    ========================================================================== */
1074 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1075        1, 1, 0,
1076        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1077 Return an Emacs frame object.
1078 PARMS is an alist of frame parameters.
1079 If the parameters specify that the frame should not have a minibuffer,
1080 and do not specify a specific minibuffer window to use,
1081 then `default-minibuffer-frame' must be a frame whose minibuffer can
1082 be shared by the new frame.
1084 This function is an internal primitive--use `make-frame' instead.  */)
1085      (Lisp_Object parms)
1087   struct frame *f;
1088   Lisp_Object frame, tem;
1089   Lisp_Object name;
1090   int minibuffer_only = 0;
1091   long window_prompting = 0;
1092   int width, height;
1093   ptrdiff_t count = specpdl_ptr - specpdl;
1094   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1095   Lisp_Object display;
1096   struct ns_display_info *dpyinfo = NULL;
1097   Lisp_Object parent;
1098   struct kboard *kb;
1099   static int desc_ctr = 1;
1101   /* x_get_arg modifies parms.  */
1102   parms = Fcopy_alist (parms);
1104   /* Use this general default value to start with
1105      until we know if this frame has a specified name.  */
1106   Vx_resource_name = Vinvocation_name;
1108   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1109   if (EQ (display, Qunbound))
1110     display = Qnil;
1111   dpyinfo = check_ns_display_info (display);
1112   kb = dpyinfo->terminal->kboard;
1114   if (!dpyinfo->terminal->name)
1115     error ("Terminal is not live, can't create new frames on it");
1117   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1118   if (!STRINGP (name)
1119       && ! EQ (name, Qunbound)
1120       && ! NILP (name))
1121     error ("Invalid frame name--not a string or nil");
1123   if (STRINGP (name))
1124     Vx_resource_name = name;
1126   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1127   if (EQ (parent, Qunbound))
1128     parent = Qnil;
1129   if (! NILP (parent))
1130     CHECK_NUMBER (parent);
1132   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1133   /* No need to protect DISPLAY because that's not used after passing
1134      it to make_frame_without_minibuffer.  */
1135   frame = Qnil;
1136   GCPRO4 (parms, parent, name, frame);
1137   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1138                   RES_TYPE_SYMBOL);
1139   if (EQ (tem, Qnone) || NILP (tem))
1140       f = make_frame_without_minibuffer (Qnil, kb, display);
1141   else if (EQ (tem, Qonly))
1142     {
1143       f = make_minibuffer_frame ();
1144       minibuffer_only = 1;
1145     }
1146   else if (WINDOWP (tem))
1147       f = make_frame_without_minibuffer (tem, kb, display);
1148   else
1149       f = make_frame (1);
1151   XSETFRAME (frame, f);
1153   f->terminal = dpyinfo->terminal;
1155   f->output_method = output_ns;
1156   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1158   FRAME_FONTSET (f) = -1;
1160   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1161                                 "iconName", "Title",
1162                                 RES_TYPE_STRING));
1163   if (! STRINGP (f->icon_name))
1164     fset_icon_name (f, Qnil);
1166   FRAME_DISPLAY_INFO (f) = dpyinfo;
1168   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1169   record_unwind_protect (unwind_create_frame, frame);
1171   f->output_data.ns->window_desc = desc_ctr++;
1172   if (TYPE_RANGED_INTEGERP (Window, parent))
1173     {
1174       f->output_data.ns->parent_desc = XFASTINT (parent);
1175       f->output_data.ns->explicit_parent = 1;
1176     }
1177   else
1178     {
1179       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1180       f->output_data.ns->explicit_parent = 0;
1181     }
1183   /* Set the name; the functions to which we pass f expect the name to
1184      be set.  */
1185   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1186     {
1187       fset_name (f, build_string ([ns_app_name UTF8String]));
1188       f->explicit_name = 0;
1189     }
1190   else
1191     {
1192       fset_name (f, name);
1193       f->explicit_name = 1;
1194       specbind (Qx_resource_name, name);
1195     }
1197   block_input ();
1199 #ifdef NS_IMPL_COCOA
1200 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1201   if (CTGetCoreTextVersion != NULL
1202       && CTGetCoreTextVersion () >= kCTVersionNumber10_5)
1203     mac_register_font_driver (f);
1204 #endif
1205 #endif
1206   register_font_driver (&nsfont_driver, f);
1208   x_default_parameter (f, parms, Qfont_backend, Qnil,
1209                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1211   {
1212     /* use for default font name */
1213     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1214     x_default_parameter (f, parms, Qfontsize,
1215                                     make_number (0 /*(int)[font pointSize]*/),
1216                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1217     // Remove ' Regular', not handled by backends.
1218     char *fontname = xstrdup ([[font displayName] UTF8String]);
1219     int len = strlen (fontname);
1220     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1221       fontname[len-8] = '\0';
1222     x_default_parameter (f, parms, Qfont,
1223                                  build_string (fontname),
1224                                  "font", "Font", RES_TYPE_STRING);
1225     xfree (fontname);
1226   }
1227   unblock_input ();
1229   x_default_parameter (f, parms, Qborder_width, make_number (0),
1230                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1231   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1232                       "internalBorderWidth", "InternalBorderWidth",
1233                       RES_TYPE_NUMBER);
1235   /* default vertical scrollbars on right on Mac */
1236   {
1237       Lisp_Object spos
1238 #ifdef NS_IMPL_GNUSTEP
1239           = Qt;
1240 #else
1241           = Qright;
1242 #endif
1243       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1244                            "verticalScrollBars", "VerticalScrollBars",
1245                            RES_TYPE_SYMBOL);
1246   }
1247   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qt,
1248                        "horizontalScrollBars", "HorizontalScrollBars",
1249                        RES_TYPE_SYMBOL);
1250   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1251                       "foreground", "Foreground", RES_TYPE_STRING);
1252   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1253                       "background", "Background", RES_TYPE_STRING);
1254   /* FIXME: not supported yet in Nextstep */
1255   x_default_parameter (f, parms, Qline_spacing, Qnil,
1256                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1257   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1258                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1259   x_default_parameter (f, parms, Qright_fringe, Qnil,
1260                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1262 #ifdef GLYPH_DEBUG
1263   image_cache_refcount =
1264     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1265 #endif
1267   init_frame_faces (f);
1269   /* Read comment about this code in corresponding place in xfns.c.  */
1270   width = FRAME_TEXT_WIDTH (f);
1271   height = FRAME_TEXT_HEIGHT (f);
1272   FRAME_TEXT_HEIGHT (f) = 0;
1273   SET_FRAME_WIDTH (f, 0);
1274   change_frame_size (f, width, height, 1, 0, 0, 1);
1276   /* The resources controlling the menu-bar and tool-bar are
1277      processed specially at startup, and reflected in the mode
1278      variables; ignore them here.  */
1279   x_default_parameter (f, parms, Qmenu_bar_lines,
1280                        NILP (Vmenu_bar_mode)
1281                        ? make_number (0) : make_number (1),
1282                        NULL, NULL, RES_TYPE_NUMBER);
1283   x_default_parameter (f, parms, Qtool_bar_lines,
1284                        NILP (Vtool_bar_mode)
1285                        ? make_number (0) : make_number (1),
1286                        NULL, NULL, RES_TYPE_NUMBER);
1288   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1289                        "BufferPredicate", RES_TYPE_SYMBOL);
1290   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1291                        RES_TYPE_STRING);
1293   parms = get_geometry_from_preferences (dpyinfo, parms);
1294   window_prompting = x_figure_window_size (f, parms, 1);
1296   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1297   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1299   /* NOTE: on other terms, this is done in set_mouse_color, however this
1300      was not getting called under Nextstep */
1301   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1302   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1303   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1304   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1305   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1306   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1307   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1308   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1309      = [NSCursor arrowCursor];
1310   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1311      = [NSCursor arrowCursor];
1312   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1314   [[EmacsView alloc] initFrameFromEmacs: f];
1316   x_icon (f, parms);
1318   /* ns_display_info does not have a reference_count.  */
1319   f->terminal->reference_count++;
1321   /* It is now ok to make the frame official even if we get an error below.
1322      The frame needs to be on Vframe_list or making it visible won't work. */
1323   Vframe_list = Fcons (frame, Vframe_list);
1325   x_default_parameter (f, parms, Qicon_type, Qnil,
1326                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1328   x_default_parameter (f, parms, Qauto_raise, Qnil,
1329                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1330   x_default_parameter (f, parms, Qauto_lower, Qnil,
1331                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1332   x_default_parameter (f, parms, Qcursor_type, Qbox,
1333                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1334   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1335                        "scrollBarWidth", "ScrollBarWidth",
1336                        RES_TYPE_NUMBER);
1337   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1338                        "scrollBarHeight", "ScrollBarHeight",
1339                        RES_TYPE_NUMBER);
1340   x_default_parameter (f, parms, Qalpha, Qnil,
1341                        "alpha", "Alpha", RES_TYPE_NUMBER);
1342   x_default_parameter (f, parms, Qfullscreen, Qnil,
1343                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1345   width = FRAME_TEXT_WIDTH (f);
1346   height = FRAME_TEXT_HEIGHT (f);
1347   FRAME_TEXT_HEIGHT (f) = 0;
1348   SET_FRAME_WIDTH (f, 0);
1349   change_frame_size (f, width, height, 1, 0, 0, 1);
1351   if (! f->output_data.ns->explicit_parent)
1352     {
1353       Lisp_Object visibility;
1355       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1356                               RES_TYPE_SYMBOL);
1357       if (EQ (visibility, Qunbound))
1358         visibility = Qt;
1360       if (EQ (visibility, Qicon))
1361         x_iconify_frame (f);
1362       else if (! NILP (visibility))
1363         {
1364           x_make_frame_visible (f);
1365           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1366         }
1367       else
1368         {
1369           /* Must have been Qnil.  */
1370         }
1371     }
1373   if (FRAME_HAS_MINIBUF_P (f)
1374       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1375           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1376     kset_default_minibuffer_frame (kb, frame);
1378   /* All remaining specified parameters, which have not been "used"
1379      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1380   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1381     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1382       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1384   UNGCPRO;
1386   if (window_prompting & USPosition)
1387     x_set_offset (f, f->left_pos, f->top_pos, 1);
1389   /* Make sure windows on this frame appear in calls to next-window
1390      and similar functions.  */
1391   Vwindow_list = Qnil;
1393   return unbind_to (count, frame);
1396 void
1397 x_focus_frame (struct frame *f)
1399   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1401   if (dpyinfo->x_focus_frame != f)
1402     {
1403       EmacsView *view = FRAME_NS_VIEW (f);
1404       block_input ();
1405       [NSApp activateIgnoringOtherApps: YES];
1406       [[view window] makeKeyAndOrderFront: view];
1407       unblock_input ();
1408     }
1412 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1413        0, 1, "",
1414        doc: /* Pop up the font panel. */)
1415      (Lisp_Object frame)
1417   struct frame *f = decode_window_system_frame (frame);
1418   id fm = [NSFontManager sharedFontManager];
1419   struct font *font = f->output_data.ns->font;
1420   NSFont *nsfont;
1421   if (EQ (font->driver->type, Qns))
1422     nsfont = ((struct nsfont_info *)font)->nsfont;
1423 #ifdef NS_IMPL_COCOA
1424 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1425   else
1426     nsfont = (NSFont *) macfont_get_nsctfont (font);
1427 #endif
1428 #endif
1429   [fm setSelectedFont: nsfont isMultiple: NO];
1430   [fm orderFrontFontPanel: NSApp];
1431   return Qnil;
1435 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1436        0, 1, "",
1437        doc: /* Pop up the color panel.  */)
1438      (Lisp_Object frame)
1440   check_window_system (NULL);
1441   [NSApp orderFrontColorPanel: NSApp];
1442   return Qnil;
1445 static struct
1447   id panel;
1448   BOOL ret;
1449 #if ! defined (NS_IMPL_COCOA) || \
1450   MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
1451   NSString *dirS, *initS;
1452   BOOL no_types;
1453 #endif
1454 } ns_fd_data;
1456 void
1457 ns_run_file_dialog (void)
1459   if (ns_fd_data.panel == nil) return;
1460 #if defined (NS_IMPL_COCOA) && \
1461   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1462   ns_fd_data.ret = [ns_fd_data.panel runModal];
1463 #else
1464   if (ns_fd_data.no_types)
1465     {
1466       ns_fd_data.ret = [ns_fd_data.panel
1467                            runModalForDirectory: ns_fd_data.dirS
1468                            file: ns_fd_data.initS];
1469     }
1470   else
1471     {
1472       ns_fd_data.ret = [ns_fd_data.panel
1473                            runModalForDirectory: ns_fd_data.dirS
1474                            file: ns_fd_data.initS
1475                            types: nil];
1476     }
1477 #endif
1478   ns_fd_data.panel = nil;
1481 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1482        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1483 Optional arg DIR, if non-nil, supplies a default directory.
1484 Optional arg MUSTMATCH, if non-nil, means the returned file or
1485 directory must exist.
1486 Optional arg INIT, if non-nil, provides a default file name to use.
1487 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1488   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1489    Lisp_Object init, Lisp_Object dir_only_p)
1491   static id fileDelegate = nil;
1492   BOOL ret;
1493   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1494   id panel;
1495   Lisp_Object fname;
1497   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1498     [NSString stringWithUTF8String: SSDATA (prompt)];
1499   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1500     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1501     [NSString stringWithUTF8String: SSDATA (dir)];
1502   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1503     [NSString stringWithUTF8String: SSDATA (init)];
1504   NSEvent *nxev;
1506   check_window_system (NULL);
1508   if (fileDelegate == nil)
1509     fileDelegate = [EmacsFileDelegate new];
1511   [NSCursor setHiddenUntilMouseMoves: NO];
1513   if ([dirS characterAtIndex: 0] == '~')
1514     dirS = [dirS stringByExpandingTildeInPath];
1516   panel = isSave ?
1517     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1519   [panel setTitle: promptS];
1521   [panel setAllowsOtherFileTypes: YES];
1522   [panel setTreatsFilePackagesAsDirectories: YES];
1523   [panel setDelegate: fileDelegate];
1525   if (! NILP (dir_only_p))
1526     {
1527       [panel setCanChooseDirectories: YES];
1528       [panel setCanChooseFiles: NO];
1529     }
1530   else if (! isSave)
1531     {
1532       /* This is not quite what the documentation says, but it is compatible
1533          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1534       [panel setCanChooseDirectories: NO];
1535       [panel setCanChooseFiles: YES];
1536     }
1538   block_input ();
1539   ns_fd_data.panel = panel;
1540   ns_fd_data.ret = NO;
1541 #if defined (NS_IMPL_COCOA) && \
1542   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1543   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1544     [panel setAllowedFileTypes: nil];
1545   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1546   if (initS && NILP (Ffile_directory_p (init)))
1547     [panel setNameFieldStringValue: [initS lastPathComponent]];
1548   else
1549     [panel setNameFieldStringValue: @""];
1551 #else
1552   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1553   ns_fd_data.dirS = dirS;
1554   ns_fd_data.initS = initS;
1555 #endif
1557   /* runModalForDirectory/runModal restarts the main event loop when done,
1558      so we must start an event loop and then pop up the file dialog.
1559      The file dialog may pop up a confirm dialog after Ok has been pressed,
1560      so we can not simply pop down on the Ok/Cancel press.
1561    */
1562   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1563                             location: NSMakePoint (0, 0)
1564                        modifierFlags: 0
1565                            timestamp: 0
1566                         windowNumber: [[NSApp mainWindow] windowNumber]
1567                              context: [NSApp context]
1568                              subtype: 0
1569                                data1: 0
1570                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1572   [NSApp postEvent: nxev atStart: NO];
1573   while (ns_fd_data.panel != nil)
1574     [NSApp run];
1576   ret = (ns_fd_data.ret == NSOKButton);
1578   if (ret)
1579     {
1580       NSString *str = ns_filename_from_panel (panel);
1581       if (! str) str = ns_directory_from_panel (panel);
1582       if (! str) ret = NO;
1583       else fname = build_string ([str UTF8String]);
1584     }
1586   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1587   unblock_input ();
1589   return ret ? fname : Qnil;
1592 const char *
1593 ns_get_defaults_value (const char *key)
1595   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1596                     objectForKey: [NSString stringWithUTF8String: key]];
1598   if (!obj) return NULL;
1600   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1604 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1605        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1606 If OWNER is nil, Emacs is assumed.  */)
1607      (Lisp_Object owner, Lisp_Object name)
1609   const char *value;
1611   check_window_system (NULL);
1612   if (NILP (owner))
1613     owner = build_string([ns_app_name UTF8String]);
1614   CHECK_STRING (name);
1616   value = ns_get_defaults_value (SSDATA (name));
1618   if (value)
1619     return build_string (value);
1620   return Qnil;
1624 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1625        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1626 If OWNER is nil, Emacs is assumed.
1627 If VALUE is nil, the default is removed.  */)
1628      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1630   check_window_system (NULL);
1631   if (NILP (owner))
1632     owner = build_string ([ns_app_name UTF8String]);
1633   CHECK_STRING (name);
1634   if (NILP (value))
1635     {
1636       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1637                          [NSString stringWithUTF8String: SSDATA (name)]];
1638     }
1639   else
1640     {
1641       CHECK_STRING (value);
1642       [[NSUserDefaults standardUserDefaults] setObject:
1643                 [NSString stringWithUTF8String: SSDATA (value)]
1644                                         forKey: [NSString stringWithUTF8String:
1645                                                          SSDATA (name)]];
1646     }
1648   return Qnil;
1652 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1653        Sx_server_max_request_size,
1654        0, 1, 0,
1655        doc: /* This function is a no-op.  It is only present for completeness.  */)
1656      (Lisp_Object terminal)
1658   check_ns_display_info (terminal);
1659   /* This function has no real equivalent under NeXTstep.  Return nil to
1660      indicate this. */
1661   return Qnil;
1665 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1666        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1667 \(Labeling every distributor as a "vendor" embodies the false assumption
1668 that operating systems cannot be developed and distributed noncommercially.)
1669 The optional argument TERMINAL specifies which display to ask about.
1670 TERMINAL should be a terminal object, a frame or a display name (a string).
1671 If omitted or nil, that stands for the selected frame's display.  */)
1672   (Lisp_Object terminal)
1674   check_ns_display_info (terminal);
1675 #ifdef NS_IMPL_GNUSTEP
1676   return build_string ("GNU");
1677 #else
1678   return build_string ("Apple");
1679 #endif
1683 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1684        doc: /* Return the version numbers of the server of display TERMINAL.
1685 The value is a list of three integers: the major and minor
1686 version numbers of the X Protocol in use, and the distributor-specific release
1687 number.  See also the function `x-server-vendor'.
1689 The optional argument TERMINAL specifies which display to ask about.
1690 TERMINAL should be a terminal object, a frame or a display name (a string).
1691 If omitted or nil, that stands for the selected frame's display.  */)
1692   (Lisp_Object terminal)
1694   check_ns_display_info (terminal);
1695   /*NOTE: it is unclear what would best correspond with "protocol";
1696           we return 10.3, meaning Panther, since this is roughly the
1697           level that GNUstep's APIs correspond to.
1698           The last number is where we distinguish between the Apple
1699           and GNUstep implementations ("distributor-specific release
1700           number") and give int'ized versions of major.minor. */
1701   return list3i (10, 3, ns_appkit_version_int ());
1705 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1706        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1707 The optional argument TERMINAL specifies which display to ask about.
1708 TERMINAL should be a terminal object, a frame or a display name (a string).
1709 If omitted or nil, that stands for the selected frame's display.
1711 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1712 the number of physical monitors, use `(length
1713 (display-monitor-attributes-list TERMINAL))' instead.  */)
1714   (Lisp_Object terminal)
1716   check_ns_display_info (terminal);
1717   return make_number (1);
1721 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1722        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1723 The optional argument TERMINAL specifies which display to ask about.
1724 TERMINAL should be a terminal object, a frame or a display name (a string).
1725 If omitted or nil, that stands for the selected frame's display.
1727 On \"multi-monitor\" setups this refers to the height in millimeters for
1728 all physical monitors associated with TERMINAL.  To get information
1729 for each physical monitor, use `display-monitor-attributes-list'.  */)
1730   (Lisp_Object terminal)
1732   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1734   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1738 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1739        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1740 The optional argument TERMINAL specifies which display to ask about.
1741 TERMINAL should be a terminal object, a frame or a display name (a string).
1742 If omitted or nil, that stands for the selected frame's display.
1744 On \"multi-monitor\" setups this refers to the width in millimeters for
1745 all physical monitors associated with TERMINAL.  To get information
1746 for each physical monitor, use `display-monitor-attributes-list'.  */)
1747   (Lisp_Object terminal)
1749   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1751   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1755 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1756        Sx_display_backing_store, 0, 1, 0,
1757        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1758 The value may be `buffered', `retained', or `non-retained'.
1759 The optional argument TERMINAL specifies which display to ask about.
1760 TERMINAL should be a terminal object, a frame or a display name (a string).
1761 If omitted or nil, that stands for the selected frame's display.  */)
1762   (Lisp_Object terminal)
1764   check_ns_display_info (terminal);
1765   switch ([ns_get_window (terminal) backingType])
1766     {
1767     case NSBackingStoreBuffered:
1768       return intern ("buffered");
1769     case NSBackingStoreRetained:
1770       return intern ("retained");
1771     case NSBackingStoreNonretained:
1772       return intern ("non-retained");
1773     default:
1774       error ("Strange value for backingType parameter of frame");
1775     }
1776   return Qnil;  /* not reached, shut compiler up */
1780 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1781        Sx_display_visual_class, 0, 1, 0,
1782        doc: /* Return the visual class of the Nextstep display TERMINAL.
1783 The value is one of the symbols `static-gray', `gray-scale',
1784 `static-color', `pseudo-color', `true-color', or `direct-color'.
1786 The optional argument TERMINAL specifies which display to ask about.
1787 TERMINAL should a terminal object, a frame or a display name (a string).
1788 If omitted or nil, that stands for the selected frame's display.  */)
1789   (Lisp_Object terminal)
1791   NSWindowDepth depth;
1793   check_ns_display_info (terminal);
1794   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1796   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1797     return intern ("static-gray");
1798   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1799     return intern ("gray-scale");
1800   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1801     return intern ("pseudo-color");
1802   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1803     return intern ("true-color");
1804   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1805     return intern ("direct-color");
1806   else
1807     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1808     return intern ("direct-color");
1812 DEFUN ("x-display-save-under", Fx_display_save_under,
1813        Sx_display_save_under, 0, 1, 0,
1814        doc: /* Return t if TERMINAL supports the save-under feature.
1815 The optional argument TERMINAL specifies which display to ask about.
1816 TERMINAL should be a terminal object, a frame or a display name (a string).
1817 If omitted or nil, that stands for the selected frame's display.  */)
1818   (Lisp_Object terminal)
1820   check_ns_display_info (terminal);
1821   switch ([ns_get_window (terminal) backingType])
1822     {
1823     case NSBackingStoreBuffered:
1824       return Qt;
1826     case NSBackingStoreRetained:
1827     case NSBackingStoreNonretained:
1828       return Qnil;
1830     default:
1831       error ("Strange value for backingType parameter of frame");
1832     }
1833   return Qnil;  /* not reached, shut compiler up */
1837 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1838        1, 3, 0,
1839        doc: /* Open a connection to a display server.
1840 DISPLAY is the name of the display to connect to.
1841 Optional second arg XRM-STRING is a string of resources in xrdb format.
1842 If the optional third arg MUST-SUCCEED is non-nil,
1843 terminate Emacs if we can't open the connection.
1844 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1845      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1847   struct ns_display_info *dpyinfo;
1849   CHECK_STRING (display);
1851   nxatoms_of_nsselect ();
1852   dpyinfo = ns_term_init (display);
1853   if (dpyinfo == 0)
1854     {
1855       if (!NILP (must_succeed))
1856         fatal ("Display on %s not responding.\n",
1857                SSDATA (display));
1858       else
1859         error ("Display on %s not responding.\n",
1860                SSDATA (display));
1861     }
1863   return Qnil;
1867 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1868        1, 1, 0,
1869        doc: /* Close the connection to TERMINAL's Nextstep display server.
1870 For TERMINAL, specify a terminal object, a frame or a display name (a
1871 string).  If TERMINAL is nil, that stands for the selected frame's
1872 terminal.  */)
1873      (Lisp_Object terminal)
1875   check_ns_display_info (terminal);
1876   [NSApp terminate: NSApp];
1877   return Qnil;
1881 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1882        doc: /* Return the list of display names that Emacs has connections to.  */)
1883      (void)
1885   Lisp_Object result = Qnil;
1886   struct ns_display_info *ndi;
1888   for (ndi = x_display_list; ndi; ndi = ndi->next)
1889     result = Fcons (XCAR (ndi->name_list_element), result);
1891   return result;
1895 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1896        0, 0, 0,
1897        doc: /* Hides all applications other than Emacs.  */)
1898      (void)
1900   check_window_system (NULL);
1901   [NSApp hideOtherApplications: NSApp];
1902   return Qnil;
1905 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1906        1, 1, 0,
1907        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1908 Otherwise if Emacs is hidden, it is unhidden.
1909 If ON is equal to `activate', Emacs is unhidden and becomes
1910 the active application.  */)
1911      (Lisp_Object on)
1913   check_window_system (NULL);
1914   if (EQ (on, intern ("activate")))
1915     {
1916       [NSApp unhide: NSApp];
1917       [NSApp activateIgnoringOtherApps: YES];
1918     }
1919   else if (NILP (on))
1920     [NSApp unhide: NSApp];
1921   else
1922     [NSApp hide: NSApp];
1923   return Qnil;
1927 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1928        0, 0, 0,
1929        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1930      (void)
1932   check_window_system (NULL);
1933   [NSApp orderFrontStandardAboutPanel: nil];
1934   return Qnil;
1938 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1939        doc: /* Determine font PostScript or family name for font NAME.
1940 NAME should be a string containing either the font name or an XLFD
1941 font descriptor.  If string contains `fontset' and not
1942 `fontset-startup', it is left alone. */)
1943      (Lisp_Object name)
1945   char *nm;
1946   CHECK_STRING (name);
1947   nm = SSDATA (name);
1949   if (nm[0] != '-')
1950     return name;
1951   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1952     return name;
1954   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1958 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1959        doc: /* Return a list of all available colors.
1960 The optional argument FRAME is currently ignored.  */)
1961      (Lisp_Object frame)
1963   Lisp_Object list = Qnil;
1964   NSEnumerator *colorlists;
1965   NSColorList *clist;
1967   if (!NILP (frame))
1968     {
1969       CHECK_FRAME (frame);
1970       if (! FRAME_NS_P (XFRAME (frame)))
1971         error ("non-Nextstep frame used in `ns-list-colors'");
1972     }
1974   block_input ();
1976   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1977   while ((clist = [colorlists nextObject]))
1978     {
1979       if ([[clist name] length] < 7 ||
1980           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1981         {
1982           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1983           NSString *cname;
1984           while ((cname = [cnames nextObject]))
1985             list = Fcons (build_string ([cname UTF8String]), list);
1986 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1987                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1988                                              UTF8String]), list); */
1989         }
1990     }
1992   unblock_input ();
1994   return list;
1998 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1999        doc: /* List available Nextstep services by querying NSApp.  */)
2000      (void)
2002 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
2003   /* You can't get services like this in 10.6+.  */
2004   return Qnil;
2005 #else
2006   Lisp_Object ret = Qnil;
2007   NSMenu *svcs;
2008 #ifdef NS_IMPL_COCOA
2009   id delegate;
2010 #endif
2012   check_window_system (NULL);
2013   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
2014   [NSApp setServicesMenu: svcs];
2015   [NSApp registerServicesMenuSendTypes: ns_send_types
2016                            returnTypes: ns_return_types];
2018 /* On Tiger, services menu updating was made lazier (waits for user to
2019    actually click on the menu), so we have to force things along: */
2020 #ifdef NS_IMPL_COCOA
2021   delegate = [svcs delegate];
2022   if (delegate != nil)
2023     {
2024       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2025         [delegate menuNeedsUpdate: svcs];
2026       if ([delegate respondsToSelector:
2027                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2028         {
2029           int i, len = [delegate numberOfItemsInMenu: svcs];
2030           for (i =0; i<len; i++)
2031             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2032           for (i =0; i<len; i++)
2033             if (![delegate menu: svcs
2034                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2035                         atIndex: i shouldCancel: NO])
2036               break;
2037         }
2038     }
2039 #endif
2041   [svcs setAutoenablesItems: NO];
2042 #ifdef NS_IMPL_COCOA
2043   [svcs update]; /* on OS X, converts from '/' structure */
2044 #endif
2046   ret = interpret_services_menu (svcs, Qnil, ret);
2047   return ret;
2048 #endif
2052 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2053        2, 2, 0,
2054        doc: /* Perform Nextstep SERVICE on SEND.
2055 SEND should be either a string or nil.
2056 The return value is the result of the service, as string, or nil if
2057 there was no result.  */)
2058      (Lisp_Object service, Lisp_Object send)
2060   id pb;
2061   NSString *svcName;
2062   char *utfStr;
2064   CHECK_STRING (service);
2065   check_window_system (NULL);
2067   utfStr = SSDATA (service);
2068   svcName = [NSString stringWithUTF8String: utfStr];
2070   pb =[NSPasteboard pasteboardWithUniqueName];
2071   ns_string_to_pasteboard (pb, send);
2073   if (NSPerformService (svcName, pb) == NO)
2074     Fsignal (Qquit, list1 (build_string ("service not available")));
2076   if ([[pb types] count] == 0)
2077     return build_string ("");
2078   return ns_string_from_pasteboard (pb);
2082 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2083        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2084        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2085      (Lisp_Object str)
2087 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2088          remove this. */
2089   NSString *utfStr;
2090   Lisp_Object ret = Qnil;
2091   NSAutoreleasePool *pool;
2093   CHECK_STRING (str);
2094   pool = [[NSAutoreleasePool alloc] init];
2095   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2096 #ifdef NS_IMPL_COCOA
2097   if (utfStr)
2098     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2099 #endif
2100   if (utfStr)
2101     {
2102       const char *cstr = [utfStr UTF8String];
2103       if (cstr)
2104         ret = build_string (cstr);
2105     }
2107   [pool release];
2108   if (NILP (ret))
2109     error ("Invalid UTF-8");
2111   return ret;
2115 #ifdef NS_IMPL_COCOA
2117 /* Compile and execute the AppleScript SCRIPT and return the error
2118    status as function value.  A zero is returned if compilation and
2119    execution is successful, in which case *RESULT is set to a Lisp
2120    string or a number containing the resulting script value.  Otherwise,
2121    1 is returned. */
2122 static int
2123 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2125   NSAppleEventDescriptor *desc;
2126   NSDictionary* errorDict;
2127   NSAppleEventDescriptor* returnDescriptor = NULL;
2129   NSAppleScript* scriptObject =
2130     [[NSAppleScript alloc] initWithSource:
2131                              [NSString stringWithUTF8String: SSDATA (script)]];
2133   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2134   [scriptObject release];
2135   *result = Qnil;
2137   if (returnDescriptor != NULL)
2138     {
2139       // successful execution
2140       if (kAENullEvent != [returnDescriptor descriptorType])
2141         {
2142           *result = Qt;
2143           // script returned an AppleScript result
2144           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2145 #if defined (NS_IMPL_COCOA)
2146               (typeUTF16ExternalRepresentation
2147                == [returnDescriptor descriptorType]) ||
2148 #endif
2149               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2150               (typeCString == [returnDescriptor descriptorType]))
2151             {
2152               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2153               if (desc)
2154                 *result = build_string([[desc stringValue] UTF8String]);
2155             }
2156           else
2157             {
2158               /* use typeUTF16ExternalRepresentation? */
2159               // coerce the result to the appropriate ObjC type
2160               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2161               if (desc)
2162                 *result = make_number([desc int32Value]);
2163             }
2164         }
2165     }
2166   else
2167     {
2168       // no script result, return error
2169       return 1;
2170     }
2171   return 0;
2174 /* Helper function called from sendEvent to run applescript
2175    from within the main event loop.  */
2177 void
2178 ns_run_ascript (void)
2180   if (! NILP (as_script))
2181     as_status = ns_do_applescript (as_script, as_result);
2182   as_script = Qnil;
2185 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2186        doc: /* Execute AppleScript SCRIPT and return the result.
2187 If compilation and execution are successful, the resulting script value
2188 is returned as a string, a number or, in the case of other constructs, t.
2189 In case the execution fails, an error is signaled. */)
2190      (Lisp_Object script)
2192   Lisp_Object result;
2193   int status;
2194   NSEvent *nxev;
2195   struct input_event ev;
2197   CHECK_STRING (script);
2198   check_window_system (NULL);
2200   block_input ();
2202   as_script = script;
2203   as_result = &result;
2205   /* executing apple script requires the event loop to run, otherwise
2206      errors aren't returned and executeAndReturnError hangs forever.
2207      Post an event that runs applescript and then start the event loop.
2208      The event loop is exited when the script is done.  */
2209   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2210                             location: NSMakePoint (0, 0)
2211                        modifierFlags: 0
2212                            timestamp: 0
2213                         windowNumber: [[NSApp mainWindow] windowNumber]
2214                              context: [NSApp context]
2215                              subtype: 0
2216                                data1: 0
2217                                data2: NSAPP_DATA2_RUNASSCRIPT];
2219   [NSApp postEvent: nxev atStart: NO];
2221   // If there are other events, the event loop may exit.  Keep running
2222   // until the script has been handled.  */
2223   ns_init_events (&ev);
2224   while (! NILP (as_script))
2225     [NSApp run];
2226   ns_finish_events ();
2228   status = as_status;
2229   as_status = 0;
2230   as_result = 0;
2231   unblock_input ();
2232   if (status == 0)
2233     return result;
2234   else if (!STRINGP (result))
2235     error ("AppleScript error %d", status);
2236   else
2237     error ("%s", SSDATA (result));
2239 #endif
2243 /* ==========================================================================
2245     Miscellaneous functions not called through hooks
2247    ========================================================================== */
2249 /* called from frame.c */
2250 struct ns_display_info *
2251 check_x_display_info (Lisp_Object frame)
2253   return check_ns_display_info (frame);
2257 void
2258 x_set_scroll_bar_default_width (struct frame *f)
2260   int wid = FRAME_COLUMN_WIDTH (f);
2261   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2262   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2263                                       wid - 1) / wid;
2266 void
2267 x_set_scroll_bar_default_height (struct frame *f)
2269   int height = FRAME_LINE_HEIGHT (f);
2270   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2271   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2272                                        height - 1) / height;
2275 /* terms impl this instead of x-get-resource directly */
2276 char *
2277 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2279   /* remove appname prefix; TODO: allow for !="Emacs" */
2280   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2282   check_window_system (NULL);
2284   if (inhibit_x_resources)
2285     /* --quick was passed, so this is a no-op.  */
2286     return NULL;
2288   res = ns_get_defaults_value (toCheck);
2289   return (!res ? NULL :
2290           (!c_strncasecmp (res, "YES", 3) ? "true" :
2291            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2295 Lisp_Object
2296 x_get_focus_frame (struct frame *frame)
2298   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2299   Lisp_Object nsfocus;
2301   if (!dpyinfo->x_focus_frame)
2302     return Qnil;
2304   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2305   return nsfocus;
2308 /* ==========================================================================
2310     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2312    ========================================================================== */
2315 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2316        doc: /* Internal function called by `color-defined-p', which see.
2317 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2318      (Lisp_Object color, Lisp_Object frame)
2320   NSColor * col;
2321   check_window_system (NULL);
2322   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2326 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2327        doc: /* Internal function called by `color-values', which see.  */)
2328      (Lisp_Object color, Lisp_Object frame)
2330   NSColor * col;
2331   EmacsCGFloat red, green, blue, alpha;
2333   check_window_system (NULL);
2334   CHECK_STRING (color);
2336   if (ns_lisp_to_color (color, &col))
2337     return Qnil;
2339   [[col colorUsingDefaultColorSpace]
2340         getRed: &red green: &green blue: &blue alpha: &alpha];
2341   return list3i (lrint (red * 65280), lrint (green * 65280),
2342                  lrint (blue * 65280));
2346 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2347        doc: /* Internal function called by `display-color-p', which see.  */)
2348      (Lisp_Object terminal)
2350   NSWindowDepth depth;
2351   NSString *colorSpace;
2353   check_ns_display_info (terminal);
2354   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2355   colorSpace = NSColorSpaceFromDepth (depth);
2357   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2358          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2359       ? Qnil : Qt;
2363 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2364        0, 1, 0,
2365        doc: /* Return t if the Nextstep display supports shades of gray.
2366 Note that color displays do support shades of gray.
2367 The optional argument TERMINAL specifies which display to ask about.
2368 TERMINAL should be a terminal object, a frame or a display name (a string).
2369 If omitted or nil, that stands for the selected frame's display.  */)
2370   (Lisp_Object terminal)
2372   NSWindowDepth depth;
2374   check_ns_display_info (terminal);
2375   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2377   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2381 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2382        0, 1, 0,
2383        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2384 The optional argument TERMINAL specifies which display to ask about.
2385 TERMINAL should be a terminal object, a frame or a display name (a string).
2386 If omitted or nil, that stands for the selected frame's display.
2388 On \"multi-monitor\" setups this refers to the pixel width for all
2389 physical monitors associated with TERMINAL.  To get information for
2390 each physical monitor, use `display-monitor-attributes-list'.  */)
2391   (Lisp_Object terminal)
2393   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2395   return make_number (x_display_pixel_width (dpyinfo));
2399 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2400        Sx_display_pixel_height, 0, 1, 0,
2401        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2402 The optional argument TERMINAL specifies which display to ask about.
2403 TERMINAL should be a terminal object, a frame or a display name (a string).
2404 If omitted or nil, that stands for the selected frame's display.
2406 On \"multi-monitor\" setups this refers to the pixel height for all
2407 physical monitors associated with TERMINAL.  To get information for
2408 each physical monitor, use `display-monitor-attributes-list'.  */)
2409   (Lisp_Object terminal)
2411   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2413   return make_number (x_display_pixel_height (dpyinfo));
2416 #ifdef NS_IMPL_COCOA
2418 /* Returns the name for the screen that OBJ represents, or NULL.
2419    Caller must free return value.
2422 static char *
2423 ns_get_name_from_ioreg (io_object_t obj)
2425   char *name = NULL;
2427   NSDictionary *info = (NSDictionary *)
2428     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2429   NSDictionary *names = [info objectForKey:
2430                                 [NSString stringWithUTF8String:
2431                                             kDisplayProductName]];
2433   if ([names count] > 0)
2434     {
2435       NSString *n = [names objectForKey: [[names allKeys]
2436                                                  objectAtIndex:0]];
2437       if (n != nil) name = xstrdup ([n UTF8String]);
2438     }
2440   [info release];
2442   return name;
2445 /* Returns the name for the screen that DID came from, or NULL.
2446    Caller must free return value.
2449 static char *
2450 ns_screen_name (CGDirectDisplayID did)
2452   char *name = NULL;
2454 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2455   mach_port_t masterPort;
2456   io_iterator_t it;
2457   io_object_t obj;
2459   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2461   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2462       || IOServiceGetMatchingServices (masterPort,
2463                                        IOServiceMatching ("IONDRVDevice"),
2464                                        &it) != kIOReturnSuccess)
2465     return name;
2467   /* Must loop until we find a name.  Many devices can have the same unit
2468      number (represents different GPU parts), but only one has a name.  */
2469   while (! name && (obj = IOIteratorNext (it)))
2470     {
2471       CFMutableDictionaryRef props;
2472       const void *val;
2474       if (IORegistryEntryCreateCFProperties (obj,
2475                                              &props,
2476                                              kCFAllocatorDefault,
2477                                              kNilOptions) == kIOReturnSuccess
2478           && props != nil
2479           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2480         {
2481           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2482           if (nr == CGDisplayUnitNumber (did))
2483             name = ns_get_name_from_ioreg (obj);
2484         }
2486       CFRelease (props);
2487       IOObjectRelease (obj);
2488     }
2490   IOObjectRelease (it);
2492 #else
2494   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2496 #endif
2497   return name;
2499 #endif
2501 static Lisp_Object
2502 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2503                                 int n_monitors,
2504                                 int primary_monitor,
2505                                 const char *source)
2507   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2508   Lisp_Object frame, rest;
2509   NSArray *screens = [NSScreen screens];
2510   int i;
2512   FOR_EACH_FRAME (rest, frame)
2513     {
2514       struct frame *f = XFRAME (frame);
2516       if (FRAME_NS_P (f))
2517         {
2518           NSView *view = FRAME_NS_VIEW (f);
2519           NSScreen *screen = [[view window] screen];
2520           NSUInteger k;
2522           i = -1;
2523           for (k = 0; i == -1 && k < [screens count]; ++k)
2524             {
2525               if ([screens objectAtIndex: k] == screen)
2526                 i = (int)k;
2527             }
2529           if (i > -1)
2530             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2531         }
2532     }
2534   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2535                                       monitor_frames, source);
2538 DEFUN ("ns-display-monitor-attributes-list",
2539        Fns_display_monitor_attributes_list,
2540        Sns_display_monitor_attributes_list,
2541        0, 1, 0,
2542        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2544 The optional argument TERMINAL specifies which display to ask about.
2545 TERMINAL should be a terminal object, a frame or a display name (a string).
2546 If omitted or nil, that stands for the selected frame's display.
2548 In addition to the standard attribute keys listed in
2549 `display-monitor-attributes-list', the following keys are contained in
2550 the attributes:
2552  source -- String describing the source from which multi-monitor
2553            information is obtained, \"NS\" is always the source."
2555 Internal use only, use `display-monitor-attributes-list' instead.  */)
2556   (Lisp_Object terminal)
2558   struct terminal *term = get_terminal (terminal, 1);
2559   NSArray *screens;
2560   NSUInteger i, n_monitors;
2561   struct MonitorInfo *monitors;
2562   Lisp_Object attributes_list = Qnil;
2563   CGFloat primary_display_height = 0;
2565   if (term->type != output_ns)
2566     return Qnil;
2568   screens = [NSScreen screens];
2569   n_monitors = [screens count];
2570   if (n_monitors == 0)
2571     return Qnil;
2573   monitors = xzalloc (n_monitors * sizeof *monitors);
2575   for (i = 0; i < [screens count]; ++i)
2576     {
2577       NSScreen *s = [screens objectAtIndex:i];
2578       struct MonitorInfo *m = &monitors[i];
2579       NSRect fr = [s frame];
2580       NSRect vfr = [s visibleFrame];
2581       short y, vy;
2583 #ifdef NS_IMPL_COCOA
2584       NSDictionary *dict = [s deviceDescription];
2585       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2586       CGDirectDisplayID did = [nid unsignedIntValue];
2587 #endif
2588       if (i == 0)
2589         {
2590           primary_display_height = fr.size.height;
2591           y = (short) fr.origin.y;
2592           vy = (short) vfr.origin.y;
2593         }
2594       else
2595         {
2596           // Flip y coordinate as NS has y starting from the bottom.
2597           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2598           vy = (short) (primary_display_height -
2599                         vfr.size.height - vfr.origin.y);
2600         }
2602       m->geom.x = (short) fr.origin.x;
2603       m->geom.y = y;
2604       m->geom.width = (unsigned short) fr.size.width;
2605       m->geom.height = (unsigned short) fr.size.height;
2607       m->work.x = (short) vfr.origin.x;
2608       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2609       // and fr.size.height - vfr.size.height are pixels missing in total.
2610       // Pixels missing at top are
2611       // fr.size.height - vfr.size.height - vy + y.
2612       // work.y is then pixels missing at top + y.
2613       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2614       m->work.width = (unsigned short) vfr.size.width;
2615       m->work.height = (unsigned short) vfr.size.height;
2617 #ifdef NS_IMPL_COCOA
2618       m->name = ns_screen_name (did);
2620       {
2621         CGSize mms = CGDisplayScreenSize (did);
2622         m->mm_width = (int) mms.width;
2623         m->mm_height = (int) mms.height;
2624       }
2626 #else
2627       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2628       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2629       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2630 #endif
2631     }
2633   // Primary monitor is always first for NS.
2634   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2635                                                     0, "NS");
2637   free_monitors (monitors, n_monitors);
2638   return attributes_list;
2642 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2643        0, 1, 0,
2644        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2645 The optional argument TERMINAL specifies which display to ask about.
2646 TERMINAL should be a terminal object, a frame or a display name (a string).
2647 If omitted or nil, that stands for the selected frame's display.  */)
2648   (Lisp_Object terminal)
2650   check_ns_display_info (terminal);
2651   return make_number
2652     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2656 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2657        0, 1, 0,
2658        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2659 The optional argument TERMINAL specifies which display to ask about.
2660 TERMINAL should be a terminal object, a frame or a display name (a string).
2661 If omitted or nil, that stands for the selected frame's display.  */)
2662   (Lisp_Object terminal)
2664   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2665   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2666   return make_number (1 << min (dpyinfo->n_planes, 24));
2670 /* Unused dummy def needed for compatibility. */
2671 Lisp_Object tip_frame;
2673 /* TODO: move to xdisp or similar */
2674 static void
2675 compute_tip_xy (struct frame *f,
2676                 Lisp_Object parms,
2677                 Lisp_Object dx,
2678                 Lisp_Object dy,
2679                 int width,
2680                 int height,
2681                 int *root_x,
2682                 int *root_y)
2684   Lisp_Object left, top;
2685   EmacsView *view = FRAME_NS_VIEW (f);
2686   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2687   NSPoint pt;
2689   /* Start with user-specified or mouse position.  */
2690   left = Fcdr (Fassq (Qleft, parms));
2691   top = Fcdr (Fassq (Qtop, parms));
2693   if (!INTEGERP (left) || !INTEGERP (top))
2694     {
2695       pt.x = dpyinfo->last_mouse_motion_x;
2696       pt.y = dpyinfo->last_mouse_motion_y;
2697       /* Convert to screen coordinates */
2698       pt = [view convertPoint: pt toView: nil];
2699       pt = [[view window] convertBaseToScreen: pt];
2700     }
2701   else
2702     {
2703       /* Absolute coordinates.  */
2704       pt.x = XINT (left);
2705       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2706         - height;
2707     }
2709   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2710   if (INTEGERP (left))
2711     *root_x = pt.x;
2712   else if (pt.x + XINT (dx) <= 0)
2713     *root_x = 0; /* Can happen for negative dx */
2714   else if (pt.x + XINT (dx) + width
2715            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2716     /* It fits to the right of the pointer.  */
2717     *root_x = pt.x + XINT (dx);
2718   else if (width + XINT (dx) <= pt.x)
2719     /* It fits to the left of the pointer.  */
2720     *root_x = pt.x - width - XINT (dx);
2721   else
2722     /* Put it left justified on the screen -- it ought to fit that way.  */
2723     *root_x = 0;
2725   if (INTEGERP (top))
2726     *root_y = pt.y;
2727   else if (pt.y - XINT (dy) - height >= 0)
2728     /* It fits below the pointer.  */
2729     *root_y = pt.y - height - XINT (dy);
2730   else if (pt.y + XINT (dy) + height
2731            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2732     /* It fits above the pointer */
2733       *root_y = pt.y + XINT (dy);
2734   else
2735     /* Put it on the top.  */
2736     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2740 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2741        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2742 A tooltip window is a small window displaying a string.
2744 This is an internal function; Lisp code should call `tooltip-show'.
2746 FRAME nil or omitted means use the selected frame.
2748 PARMS is an optional list of frame parameters which can be used to
2749 change the tooltip's appearance.
2751 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2752 means use the default timeout of 5 seconds.
2754 If the list of frame parameters PARMS contains a `left' parameter,
2755 the tooltip is displayed at that x-position.  Otherwise it is
2756 displayed at the mouse position, with offset DX added (default is 5 if
2757 DX isn't specified).  Likewise for the y-position; if a `top' frame
2758 parameter is specified, it determines the y-position of the tooltip
2759 window, otherwise it is displayed at the mouse position, with offset
2760 DY added (default is -10).
2762 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2763 Text larger than the specified size is clipped.  */)
2764      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2766   int root_x, root_y;
2767   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2768   ptrdiff_t count = SPECPDL_INDEX ();
2769   struct frame *f;
2770   char *str;
2771   NSSize size;
2773   specbind (Qinhibit_redisplay, Qt);
2775   GCPRO4 (string, parms, frame, timeout);
2777   CHECK_STRING (string);
2778   str = SSDATA (string);
2779   f = decode_window_system_frame (frame);
2780   if (NILP (timeout))
2781     timeout = make_number (5);
2782   else
2783     CHECK_NATNUM (timeout);
2785   if (NILP (dx))
2786     dx = make_number (5);
2787   else
2788     CHECK_NUMBER (dx);
2790   if (NILP (dy))
2791     dy = make_number (-10);
2792   else
2793     CHECK_NUMBER (dy);
2795   block_input ();
2796   if (ns_tooltip == nil)
2797     ns_tooltip = [[EmacsTooltip alloc] init];
2798   else
2799     Fx_hide_tip ();
2801   [ns_tooltip setText: str];
2802   size = [ns_tooltip frame].size;
2804   /* Move the tooltip window where the mouse pointer is.  Resize and
2805      show it.  */
2806   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2807                   &root_x, &root_y);
2809   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2810   unblock_input ();
2812   UNGCPRO;
2813   return unbind_to (count, Qnil);
2817 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2818        doc: /* Hide the current tooltip window, if there is any.
2819 Value is t if tooltip was open, nil otherwise.  */)
2820      (void)
2822   if (ns_tooltip == nil || ![ns_tooltip isActive])
2823     return Qnil;
2824   [ns_tooltip hide];
2825   return Qt;
2829 /* ==========================================================================
2831     Class implementations
2833    ========================================================================== */
2836   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2837   Return YES if handled, NO if not.
2838  */
2839 static BOOL
2840 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2842   NSString *s;
2843   int i;
2844   BOOL ret = NO;
2846   if ([theEvent type] != NSKeyDown) return NO;
2847   s = [theEvent characters];
2849   for (i = 0; i < [s length]; ++i)
2850     {
2851       int ch = (int) [s characterAtIndex: i];
2852       switch (ch)
2853         {
2854         case NSHomeFunctionKey:
2855         case NSDownArrowFunctionKey:
2856         case NSUpArrowFunctionKey:
2857         case NSLeftArrowFunctionKey:
2858         case NSRightArrowFunctionKey:
2859         case NSPageUpFunctionKey:
2860         case NSPageDownFunctionKey:
2861         case NSEndFunctionKey:
2862           /* Don't send command modified keys, as those are handled in the
2863              performKeyEquivalent method of the super class.
2864           */
2865           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2866             {
2867               [panel sendEvent: theEvent];
2868               ret = YES;
2869             }
2870           break;
2871           /* As we don't have the standard key commands for
2872              copy/paste/cut/select-all in our edit menu, we must handle
2873              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2874              here, paste works, because we have that in our Edit menu.
2875              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2876              correct modifier.
2877           */
2878         case 'x': // Cut
2879         case 'c': // Copy
2880         case 'v': // Paste
2881         case 'a': // Select all
2882           if ([theEvent modifierFlags] & NSCommandKeyMask)
2883             {
2884               [NSApp sendAction:
2885                        (ch == 'x'
2886                         ? @selector(cut:)
2887                         : (ch == 'c'
2888                            ? @selector(copy:)
2889                            : (ch == 'v'
2890                               ? @selector(paste:)
2891                               : @selector(selectAll:))))
2892                              to:nil from:panel];
2893               ret = YES;
2894             }
2895         default:
2896           // Send all control keys, as the text field supports C-a, C-f, C-e
2897           // C-b and more.
2898           if ([theEvent modifierFlags] & NSControlKeyMask)
2899             {
2900               [panel sendEvent: theEvent];
2901               ret = YES;
2902             }
2903           break;
2904         }
2905     }
2908   return ret;
2911 @implementation EmacsSavePanel
2912 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2914   BOOL ret = handlePanelKeys (self, theEvent);
2915   if (! ret)
2916     ret = [super performKeyEquivalent:theEvent];
2917   return ret;
2919 @end
2922 @implementation EmacsOpenPanel
2923 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2925   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2926   BOOL ret = handlePanelKeys (self, theEvent);
2927   if (! ret)
2928     ret = [super performKeyEquivalent:theEvent];
2929   return ret;
2931 @end
2934 @implementation EmacsFileDelegate
2935 /* --------------------------------------------------------------------------
2936    Delegate methods for Open/Save panels
2937    -------------------------------------------------------------------------- */
2938 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2940   return YES;
2942 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2944   return YES;
2946 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2947           confirmed: (BOOL)okFlag
2949   return filename;
2951 @end
2953 #endif
2956 /* ==========================================================================
2958     Lisp interface declaration
2960    ========================================================================== */
2963 void
2964 syms_of_nsfns (void)
2966   Qfontsize = intern_c_string ("fontsize");
2967   staticpro (&Qfontsize);
2969   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2970                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2971 If the title of a frame matches REGEXP, then IMAGE.tiff is
2972 selected as the image of the icon representing the frame when it's
2973 miniaturized.  If an element is t, then Emacs tries to select an icon
2974 based on the filetype of the visited file.
2976 The images have to be installed in a folder called English.lproj in the
2977 Emacs folder.  You have to restart Emacs after installing new icons.
2979 Example: Install an icon Gnus.tiff and execute the following code
2981   (setq ns-icon-type-alist
2982         (append ns-icon-type-alist
2983                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2984                    . \"Gnus\"))))
2986 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2987 be used as the image of the icon representing the frame.  */);
2988   Vns_icon_type_alist = list1 (Qt);
2990   DEFVAR_LISP ("ns-version-string", Vns_version_string,
2991                doc: /* Toolkit version for NS Windowing.  */);
2992   Vns_version_string = ns_appkit_version_str ();
2994   defsubr (&Sns_read_file_name);
2995   defsubr (&Sns_get_resource);
2996   defsubr (&Sns_set_resource);
2997   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2998   defsubr (&Sx_display_grayscale_p);
2999   defsubr (&Sns_font_name);
3000   defsubr (&Sns_list_colors);
3001 #ifdef NS_IMPL_COCOA
3002   defsubr (&Sns_do_applescript);
3003 #endif
3004   defsubr (&Sxw_color_defined_p);
3005   defsubr (&Sxw_color_values);
3006   defsubr (&Sx_server_max_request_size);
3007   defsubr (&Sx_server_vendor);
3008   defsubr (&Sx_server_version);
3009   defsubr (&Sx_display_pixel_width);
3010   defsubr (&Sx_display_pixel_height);
3011   defsubr (&Sns_display_monitor_attributes_list);
3012   defsubr (&Sx_display_mm_width);
3013   defsubr (&Sx_display_mm_height);
3014   defsubr (&Sx_display_screens);
3015   defsubr (&Sx_display_planes);
3016   defsubr (&Sx_display_color_cells);
3017   defsubr (&Sx_display_visual_class);
3018   defsubr (&Sx_display_backing_store);
3019   defsubr (&Sx_display_save_under);
3020   defsubr (&Sx_create_frame);
3021   defsubr (&Sx_open_connection);
3022   defsubr (&Sx_close_connection);
3023   defsubr (&Sx_display_list);
3025   defsubr (&Sns_hide_others);
3026   defsubr (&Sns_hide_emacs);
3027   defsubr (&Sns_emacs_info_panel);
3028   defsubr (&Sns_list_services);
3029   defsubr (&Sns_perform_service);
3030   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3031   defsubr (&Sns_popup_font_panel);
3032   defsubr (&Sns_popup_color_panel);
3034   defsubr (&Sx_show_tip);
3035   defsubr (&Sx_hide_tip);
3037   as_status = 0;
3038   as_script = Qnil;
3039   as_result = 0;