* admin/authors.el (authors-renamed-files-alist): Add package-x-test.el
[emacs/old-mirror.git] / src / nsfns.m
blob052c428fae5cfc136b7ae445398a971ca4df9818
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, Qnil,
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   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1271                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1);
1273   /* The resources controlling the menu-bar and tool-bar are
1274      processed specially at startup, and reflected in the mode
1275      variables; ignore them here.  */
1276   x_default_parameter (f, parms, Qmenu_bar_lines,
1277                        NILP (Vmenu_bar_mode)
1278                        ? make_number (0) : make_number (1),
1279                        NULL, NULL, RES_TYPE_NUMBER);
1280   x_default_parameter (f, parms, Qtool_bar_lines,
1281                        NILP (Vtool_bar_mode)
1282                        ? make_number (0) : make_number (1),
1283                        NULL, NULL, RES_TYPE_NUMBER);
1285   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1286                        "BufferPredicate", RES_TYPE_SYMBOL);
1287   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1288                        RES_TYPE_STRING);
1290   parms = get_geometry_from_preferences (dpyinfo, parms);
1291   window_prompting = x_figure_window_size (f, parms, 1);
1293   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1294   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1296   /* NOTE: on other terms, this is done in set_mouse_color, however this
1297      was not getting called under Nextstep */
1298   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1299   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1300   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1301   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1302   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1303   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1304   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1305   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1306      = [NSCursor arrowCursor];
1307   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1308      = [NSCursor arrowCursor];
1309   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1311   [[EmacsView alloc] initFrameFromEmacs: f];
1313   x_icon (f, parms);
1315   /* ns_display_info does not have a reference_count.  */
1316   f->terminal->reference_count++;
1318   /* It is now ok to make the frame official even if we get an error below.
1319      The frame needs to be on Vframe_list or making it visible won't work. */
1320   Vframe_list = Fcons (frame, Vframe_list);
1322   x_default_parameter (f, parms, Qicon_type, Qnil,
1323                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1325   x_default_parameter (f, parms, Qauto_raise, Qnil,
1326                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1327   x_default_parameter (f, parms, Qauto_lower, Qnil,
1328                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1329   x_default_parameter (f, parms, Qcursor_type, Qbox,
1330                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1331   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1332                        "scrollBarWidth", "ScrollBarWidth",
1333                        RES_TYPE_NUMBER);
1334   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1335                        "scrollBarHeight", "ScrollBarHeight",
1336                        RES_TYPE_NUMBER);
1337   x_default_parameter (f, parms, Qalpha, Qnil,
1338                        "alpha", "Alpha", RES_TYPE_NUMBER);
1339   x_default_parameter (f, parms, Qfullscreen, Qnil,
1340                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1342   /* Consider frame official, now.  */
1343   f->official = true;
1345   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1);
1347   if (! f->output_data.ns->explicit_parent)
1348     {
1349       Lisp_Object visibility;
1351       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1352                               RES_TYPE_SYMBOL);
1353       if (EQ (visibility, Qunbound))
1354         visibility = Qt;
1356       if (EQ (visibility, Qicon))
1357         x_iconify_frame (f);
1358       else if (! NILP (visibility))
1359         {
1360           x_make_frame_visible (f);
1361           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1362         }
1363       else
1364         {
1365           /* Must have been Qnil.  */
1366         }
1367     }
1369   if (FRAME_HAS_MINIBUF_P (f)
1370       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1371           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1372     kset_default_minibuffer_frame (kb, frame);
1374   /* All remaining specified parameters, which have not been "used"
1375      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1376   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1377     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1378       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1380   UNGCPRO;
1382   if (window_prompting & USPosition)
1383     x_set_offset (f, f->left_pos, f->top_pos, 1);
1385   /* Make sure windows on this frame appear in calls to next-window
1386      and similar functions.  */
1387   Vwindow_list = Qnil;
1389   return unbind_to (count, frame);
1392 void
1393 x_focus_frame (struct frame *f)
1395   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1397   if (dpyinfo->x_focus_frame != f)
1398     {
1399       EmacsView *view = FRAME_NS_VIEW (f);
1400       block_input ();
1401       [NSApp activateIgnoringOtherApps: YES];
1402       [[view window] makeKeyAndOrderFront: view];
1403       unblock_input ();
1404     }
1408 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1409        0, 1, "",
1410        doc: /* Pop up the font panel. */)
1411      (Lisp_Object frame)
1413   struct frame *f = decode_window_system_frame (frame);
1414   id fm = [NSFontManager sharedFontManager];
1415   struct font *font = f->output_data.ns->font;
1416   NSFont *nsfont;
1417   if (EQ (font->driver->type, Qns))
1418     nsfont = ((struct nsfont_info *)font)->nsfont;
1419 #ifdef NS_IMPL_COCOA
1420 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5
1421   else
1422     nsfont = (NSFont *) macfont_get_nsctfont (font);
1423 #endif
1424 #endif
1425   [fm setSelectedFont: nsfont isMultiple: NO];
1426   [fm orderFrontFontPanel: NSApp];
1427   return Qnil;
1431 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1432        0, 1, "",
1433        doc: /* Pop up the color panel.  */)
1434      (Lisp_Object frame)
1436   check_window_system (NULL);
1437   [NSApp orderFrontColorPanel: NSApp];
1438   return Qnil;
1441 static struct
1443   id panel;
1444   BOOL ret;
1445 #if ! defined (NS_IMPL_COCOA) || \
1446   MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_6
1447   NSString *dirS, *initS;
1448   BOOL no_types;
1449 #endif
1450 } ns_fd_data;
1452 void
1453 ns_run_file_dialog (void)
1455   if (ns_fd_data.panel == nil) return;
1456 #if defined (NS_IMPL_COCOA) && \
1457   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1458   ns_fd_data.ret = [ns_fd_data.panel runModal];
1459 #else
1460   if (ns_fd_data.no_types)
1461     {
1462       ns_fd_data.ret = [ns_fd_data.panel
1463                            runModalForDirectory: ns_fd_data.dirS
1464                            file: ns_fd_data.initS];
1465     }
1466   else
1467     {
1468       ns_fd_data.ret = [ns_fd_data.panel
1469                            runModalForDirectory: ns_fd_data.dirS
1470                            file: ns_fd_data.initS
1471                            types: nil];
1472     }
1473 #endif
1474   ns_fd_data.panel = nil;
1477 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1478        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1479 Optional arg DIR, if non-nil, supplies a default directory.
1480 Optional arg MUSTMATCH, if non-nil, means the returned file or
1481 directory must exist.
1482 Optional arg INIT, if non-nil, provides a default file name to use.
1483 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1484   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1485    Lisp_Object init, Lisp_Object dir_only_p)
1487   static id fileDelegate = nil;
1488   BOOL ret;
1489   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1490   id panel;
1491   Lisp_Object fname;
1493   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1494     [NSString stringWithUTF8String: SSDATA (prompt)];
1495   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1496     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1497     [NSString stringWithUTF8String: SSDATA (dir)];
1498   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1499     [NSString stringWithUTF8String: SSDATA (init)];
1500   NSEvent *nxev;
1502   check_window_system (NULL);
1504   if (fileDelegate == nil)
1505     fileDelegate = [EmacsFileDelegate new];
1507   [NSCursor setHiddenUntilMouseMoves: NO];
1509   if ([dirS characterAtIndex: 0] == '~')
1510     dirS = [dirS stringByExpandingTildeInPath];
1512   panel = isSave ?
1513     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1515   [panel setTitle: promptS];
1517   [panel setAllowsOtherFileTypes: YES];
1518   [panel setTreatsFilePackagesAsDirectories: YES];
1519   [panel setDelegate: fileDelegate];
1521   if (! NILP (dir_only_p))
1522     {
1523       [panel setCanChooseDirectories: YES];
1524       [panel setCanChooseFiles: NO];
1525     }
1526   else if (! isSave)
1527     {
1528       /* This is not quite what the documentation says, but it is compatible
1529          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1530       [panel setCanChooseDirectories: NO];
1531       [panel setCanChooseFiles: YES];
1532     }
1534   block_input ();
1535   ns_fd_data.panel = panel;
1536   ns_fd_data.ret = NO;
1537 #if defined (NS_IMPL_COCOA) && \
1538   MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1539   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1540     [panel setAllowedFileTypes: nil];
1541   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1542   if (initS && NILP (Ffile_directory_p (init)))
1543     [panel setNameFieldStringValue: [initS lastPathComponent]];
1544   else
1545     [panel setNameFieldStringValue: @""];
1547 #else
1548   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1549   ns_fd_data.dirS = dirS;
1550   ns_fd_data.initS = initS;
1551 #endif
1553   /* runModalForDirectory/runModal restarts the main event loop when done,
1554      so we must start an event loop and then pop up the file dialog.
1555      The file dialog may pop up a confirm dialog after Ok has been pressed,
1556      so we can not simply pop down on the Ok/Cancel press.
1557    */
1558   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1559                             location: NSMakePoint (0, 0)
1560                        modifierFlags: 0
1561                            timestamp: 0
1562                         windowNumber: [[NSApp mainWindow] windowNumber]
1563                              context: [NSApp context]
1564                              subtype: 0
1565                                data1: 0
1566                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1568   [NSApp postEvent: nxev atStart: NO];
1569   while (ns_fd_data.panel != nil)
1570     [NSApp run];
1572   ret = (ns_fd_data.ret == NSOKButton);
1574   if (ret)
1575     {
1576       NSString *str = ns_filename_from_panel (panel);
1577       if (! str) str = ns_directory_from_panel (panel);
1578       if (! str) ret = NO;
1579       else fname = build_string ([str UTF8String]);
1580     }
1582   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1583   unblock_input ();
1585   return ret ? fname : Qnil;
1588 const char *
1589 ns_get_defaults_value (const char *key)
1591   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1592                     objectForKey: [NSString stringWithUTF8String: key]];
1594   if (!obj) return NULL;
1596   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1600 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1601        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1602 If OWNER is nil, Emacs is assumed.  */)
1603      (Lisp_Object owner, Lisp_Object name)
1605   const char *value;
1607   check_window_system (NULL);
1608   if (NILP (owner))
1609     owner = build_string([ns_app_name UTF8String]);
1610   CHECK_STRING (name);
1612   value = ns_get_defaults_value (SSDATA (name));
1614   if (value)
1615     return build_string (value);
1616   return Qnil;
1620 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1621        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1622 If OWNER is nil, Emacs is assumed.
1623 If VALUE is nil, the default is removed.  */)
1624      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1626   check_window_system (NULL);
1627   if (NILP (owner))
1628     owner = build_string ([ns_app_name UTF8String]);
1629   CHECK_STRING (name);
1630   if (NILP (value))
1631     {
1632       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1633                          [NSString stringWithUTF8String: SSDATA (name)]];
1634     }
1635   else
1636     {
1637       CHECK_STRING (value);
1638       [[NSUserDefaults standardUserDefaults] setObject:
1639                 [NSString stringWithUTF8String: SSDATA (value)]
1640                                         forKey: [NSString stringWithUTF8String:
1641                                                          SSDATA (name)]];
1642     }
1644   return Qnil;
1648 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1649        Sx_server_max_request_size,
1650        0, 1, 0,
1651        doc: /* This function is a no-op.  It is only present for completeness.  */)
1652      (Lisp_Object terminal)
1654   check_ns_display_info (terminal);
1655   /* This function has no real equivalent under NeXTstep.  Return nil to
1656      indicate this. */
1657   return Qnil;
1661 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1662        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1663 \(Labeling every distributor as a "vendor" embodies the false assumption
1664 that operating systems cannot be developed and distributed noncommercially.)
1665 The optional argument TERMINAL specifies which display to ask about.
1666 TERMINAL should be a terminal object, a frame or a display name (a string).
1667 If omitted or nil, that stands for the selected frame's display.  */)
1668   (Lisp_Object terminal)
1670   check_ns_display_info (terminal);
1671 #ifdef NS_IMPL_GNUSTEP
1672   return build_string ("GNU");
1673 #else
1674   return build_string ("Apple");
1675 #endif
1679 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1680        doc: /* Return the version numbers of the server of display TERMINAL.
1681 The value is a list of three integers: the major and minor
1682 version numbers of the X Protocol in use, and the distributor-specific release
1683 number.  See also the function `x-server-vendor'.
1685 The optional argument TERMINAL specifies which display to ask about.
1686 TERMINAL should be a terminal object, a frame or a display name (a string).
1687 If omitted or nil, that stands for the selected frame's display.  */)
1688   (Lisp_Object terminal)
1690   check_ns_display_info (terminal);
1691   /*NOTE: it is unclear what would best correspond with "protocol";
1692           we return 10.3, meaning Panther, since this is roughly the
1693           level that GNUstep's APIs correspond to.
1694           The last number is where we distinguish between the Apple
1695           and GNUstep implementations ("distributor-specific release
1696           number") and give int'ized versions of major.minor. */
1697   return list3i (10, 3, ns_appkit_version_int ());
1701 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1702        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1703 The optional argument TERMINAL specifies which display to ask about.
1704 TERMINAL should be a terminal object, a frame or a display name (a string).
1705 If omitted or nil, that stands for the selected frame's display.
1707 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1708 the number of physical monitors, use `(length
1709 (display-monitor-attributes-list TERMINAL))' instead.  */)
1710   (Lisp_Object terminal)
1712   check_ns_display_info (terminal);
1713   return make_number (1);
1717 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1718        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1719 The optional argument TERMINAL specifies which display to ask about.
1720 TERMINAL should be a terminal object, a frame or a display name (a string).
1721 If omitted or nil, that stands for the selected frame's display.
1723 On \"multi-monitor\" setups this refers to the height in millimeters for
1724 all physical monitors associated with TERMINAL.  To get information
1725 for each physical monitor, use `display-monitor-attributes-list'.  */)
1726   (Lisp_Object terminal)
1728   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1730   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1734 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1735        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1736 The optional argument TERMINAL specifies which display to ask about.
1737 TERMINAL should be a terminal object, a frame or a display name (a string).
1738 If omitted or nil, that stands for the selected frame's display.
1740 On \"multi-monitor\" setups this refers to the width in millimeters for
1741 all physical monitors associated with TERMINAL.  To get information
1742 for each physical monitor, use `display-monitor-attributes-list'.  */)
1743   (Lisp_Object terminal)
1745   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1747   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1751 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1752        Sx_display_backing_store, 0, 1, 0,
1753        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1754 The value may be `buffered', `retained', or `non-retained'.
1755 The optional argument TERMINAL specifies which display to ask about.
1756 TERMINAL should be a terminal object, a frame or a display name (a string).
1757 If omitted or nil, that stands for the selected frame's display.  */)
1758   (Lisp_Object terminal)
1760   check_ns_display_info (terminal);
1761   switch ([ns_get_window (terminal) backingType])
1762     {
1763     case NSBackingStoreBuffered:
1764       return intern ("buffered");
1765     case NSBackingStoreRetained:
1766       return intern ("retained");
1767     case NSBackingStoreNonretained:
1768       return intern ("non-retained");
1769     default:
1770       error ("Strange value for backingType parameter of frame");
1771     }
1772   return Qnil;  /* not reached, shut compiler up */
1776 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1777        Sx_display_visual_class, 0, 1, 0,
1778        doc: /* Return the visual class of the Nextstep display TERMINAL.
1779 The value is one of the symbols `static-gray', `gray-scale',
1780 `static-color', `pseudo-color', `true-color', or `direct-color'.
1782 The optional argument TERMINAL specifies which display to ask about.
1783 TERMINAL should a terminal object, a frame or a display name (a string).
1784 If omitted or nil, that stands for the selected frame's display.  */)
1785   (Lisp_Object terminal)
1787   NSWindowDepth depth;
1789   check_ns_display_info (terminal);
1790   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1792   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1793     return intern ("static-gray");
1794   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1795     return intern ("gray-scale");
1796   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1797     return intern ("pseudo-color");
1798   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1799     return intern ("true-color");
1800   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1801     return intern ("direct-color");
1802   else
1803     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1804     return intern ("direct-color");
1808 DEFUN ("x-display-save-under", Fx_display_save_under,
1809        Sx_display_save_under, 0, 1, 0,
1810        doc: /* Return t if TERMINAL supports the save-under feature.
1811 The optional argument TERMINAL specifies which display to ask about.
1812 TERMINAL should be a terminal object, a frame or a display name (a string).
1813 If omitted or nil, that stands for the selected frame's display.  */)
1814   (Lisp_Object terminal)
1816   check_ns_display_info (terminal);
1817   switch ([ns_get_window (terminal) backingType])
1818     {
1819     case NSBackingStoreBuffered:
1820       return Qt;
1822     case NSBackingStoreRetained:
1823     case NSBackingStoreNonretained:
1824       return Qnil;
1826     default:
1827       error ("Strange value for backingType parameter of frame");
1828     }
1829   return Qnil;  /* not reached, shut compiler up */
1833 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1834        1, 3, 0,
1835        doc: /* Open a connection to a display server.
1836 DISPLAY is the name of the display to connect to.
1837 Optional second arg XRM-STRING is a string of resources in xrdb format.
1838 If the optional third arg MUST-SUCCEED is non-nil,
1839 terminate Emacs if we can't open the connection.
1840 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1841      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1843   struct ns_display_info *dpyinfo;
1845   CHECK_STRING (display);
1847   nxatoms_of_nsselect ();
1848   dpyinfo = ns_term_init (display);
1849   if (dpyinfo == 0)
1850     {
1851       if (!NILP (must_succeed))
1852         fatal ("Display on %s not responding.\n",
1853                SSDATA (display));
1854       else
1855         error ("Display on %s not responding.\n",
1856                SSDATA (display));
1857     }
1859   return Qnil;
1863 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1864        1, 1, 0,
1865        doc: /* Close the connection to TERMINAL's Nextstep display server.
1866 For TERMINAL, specify a terminal object, a frame or a display name (a
1867 string).  If TERMINAL is nil, that stands for the selected frame's
1868 terminal.  */)
1869      (Lisp_Object terminal)
1871   check_ns_display_info (terminal);
1872   [NSApp terminate: NSApp];
1873   return Qnil;
1877 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1878        doc: /* Return the list of display names that Emacs has connections to.  */)
1879      (void)
1881   Lisp_Object result = Qnil;
1882   struct ns_display_info *ndi;
1884   for (ndi = x_display_list; ndi; ndi = ndi->next)
1885     result = Fcons (XCAR (ndi->name_list_element), result);
1887   return result;
1891 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1892        0, 0, 0,
1893        doc: /* Hides all applications other than Emacs.  */)
1894      (void)
1896   check_window_system (NULL);
1897   [NSApp hideOtherApplications: NSApp];
1898   return Qnil;
1901 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1902        1, 1, 0,
1903        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1904 Otherwise if Emacs is hidden, it is unhidden.
1905 If ON is equal to `activate', Emacs is unhidden and becomes
1906 the active application.  */)
1907      (Lisp_Object on)
1909   check_window_system (NULL);
1910   if (EQ (on, intern ("activate")))
1911     {
1912       [NSApp unhide: NSApp];
1913       [NSApp activateIgnoringOtherApps: YES];
1914     }
1915   else if (NILP (on))
1916     [NSApp unhide: NSApp];
1917   else
1918     [NSApp hide: NSApp];
1919   return Qnil;
1923 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1924        0, 0, 0,
1925        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1926      (void)
1928   check_window_system (NULL);
1929   [NSApp orderFrontStandardAboutPanel: nil];
1930   return Qnil;
1934 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1935        doc: /* Determine font PostScript or family name for font NAME.
1936 NAME should be a string containing either the font name or an XLFD
1937 font descriptor.  If string contains `fontset' and not
1938 `fontset-startup', it is left alone. */)
1939      (Lisp_Object name)
1941   char *nm;
1942   CHECK_STRING (name);
1943   nm = SSDATA (name);
1945   if (nm[0] != '-')
1946     return name;
1947   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1948     return name;
1950   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1954 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1955        doc: /* Return a list of all available colors.
1956 The optional argument FRAME is currently ignored.  */)
1957      (Lisp_Object frame)
1959   Lisp_Object list = Qnil;
1960   NSEnumerator *colorlists;
1961   NSColorList *clist;
1963   if (!NILP (frame))
1964     {
1965       CHECK_FRAME (frame);
1966       if (! FRAME_NS_P (XFRAME (frame)))
1967         error ("non-Nextstep frame used in `ns-list-colors'");
1968     }
1970   block_input ();
1972   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1973   while ((clist = [colorlists nextObject]))
1974     {
1975       if ([[clist name] length] < 7 ||
1976           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1977         {
1978           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1979           NSString *cname;
1980           while ((cname = [cnames nextObject]))
1981             list = Fcons (build_string ([cname UTF8String]), list);
1982 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1983                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1984                                              UTF8String]), list); */
1985         }
1986     }
1988   unblock_input ();
1990   return list;
1994 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1995        doc: /* List available Nextstep services by querying NSApp.  */)
1996      (void)
1998 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1999   /* You can't get services like this in 10.6+.  */
2000   return Qnil;
2001 #else
2002   Lisp_Object ret = Qnil;
2003   NSMenu *svcs;
2004 #ifdef NS_IMPL_COCOA
2005   id delegate;
2006 #endif
2008   check_window_system (NULL);
2009   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
2010   [NSApp setServicesMenu: svcs];
2011   [NSApp registerServicesMenuSendTypes: ns_send_types
2012                            returnTypes: ns_return_types];
2014 /* On Tiger, services menu updating was made lazier (waits for user to
2015    actually click on the menu), so we have to force things along: */
2016 #ifdef NS_IMPL_COCOA
2017   delegate = [svcs delegate];
2018   if (delegate != nil)
2019     {
2020       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2021         [delegate menuNeedsUpdate: svcs];
2022       if ([delegate respondsToSelector:
2023                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2024         {
2025           int i, len = [delegate numberOfItemsInMenu: svcs];
2026           for (i =0; i<len; i++)
2027             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2028           for (i =0; i<len; i++)
2029             if (![delegate menu: svcs
2030                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2031                         atIndex: i shouldCancel: NO])
2032               break;
2033         }
2034     }
2035 #endif
2037   [svcs setAutoenablesItems: NO];
2038 #ifdef NS_IMPL_COCOA
2039   [svcs update]; /* on OS X, converts from '/' structure */
2040 #endif
2042   ret = interpret_services_menu (svcs, Qnil, ret);
2043   return ret;
2044 #endif
2048 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2049        2, 2, 0,
2050        doc: /* Perform Nextstep SERVICE on SEND.
2051 SEND should be either a string or nil.
2052 The return value is the result of the service, as string, or nil if
2053 there was no result.  */)
2054      (Lisp_Object service, Lisp_Object send)
2056   id pb;
2057   NSString *svcName;
2058   char *utfStr;
2060   CHECK_STRING (service);
2061   check_window_system (NULL);
2063   utfStr = SSDATA (service);
2064   svcName = [NSString stringWithUTF8String: utfStr];
2066   pb =[NSPasteboard pasteboardWithUniqueName];
2067   ns_string_to_pasteboard (pb, send);
2069   if (NSPerformService (svcName, pb) == NO)
2070     Fsignal (Qquit, list1 (build_string ("service not available")));
2072   if ([[pb types] count] == 0)
2073     return build_string ("");
2074   return ns_string_from_pasteboard (pb);
2078 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2079        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2080        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2081      (Lisp_Object str)
2083 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2084          remove this. */
2085   NSString *utfStr;
2086   Lisp_Object ret = Qnil;
2087   NSAutoreleasePool *pool;
2089   CHECK_STRING (str);
2090   pool = [[NSAutoreleasePool alloc] init];
2091   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2092 #ifdef NS_IMPL_COCOA
2093   if (utfStr)
2094     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2095 #endif
2096   if (utfStr)
2097     {
2098       const char *cstr = [utfStr UTF8String];
2099       if (cstr)
2100         ret = build_string (cstr);
2101     }
2103   [pool release];
2104   if (NILP (ret))
2105     error ("Invalid UTF-8");
2107   return ret;
2111 #ifdef NS_IMPL_COCOA
2113 /* Compile and execute the AppleScript SCRIPT and return the error
2114    status as function value.  A zero is returned if compilation and
2115    execution is successful, in which case *RESULT is set to a Lisp
2116    string or a number containing the resulting script value.  Otherwise,
2117    1 is returned. */
2118 static int
2119 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2121   NSAppleEventDescriptor *desc;
2122   NSDictionary* errorDict;
2123   NSAppleEventDescriptor* returnDescriptor = NULL;
2125   NSAppleScript* scriptObject =
2126     [[NSAppleScript alloc] initWithSource:
2127                              [NSString stringWithUTF8String: SSDATA (script)]];
2129   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2130   [scriptObject release];
2131   *result = Qnil;
2133   if (returnDescriptor != NULL)
2134     {
2135       // successful execution
2136       if (kAENullEvent != [returnDescriptor descriptorType])
2137         {
2138           *result = Qt;
2139           // script returned an AppleScript result
2140           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2141 #if defined (NS_IMPL_COCOA)
2142               (typeUTF16ExternalRepresentation
2143                == [returnDescriptor descriptorType]) ||
2144 #endif
2145               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2146               (typeCString == [returnDescriptor descriptorType]))
2147             {
2148               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2149               if (desc)
2150                 *result = build_string([[desc stringValue] UTF8String]);
2151             }
2152           else
2153             {
2154               /* use typeUTF16ExternalRepresentation? */
2155               // coerce the result to the appropriate ObjC type
2156               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2157               if (desc)
2158                 *result = make_number([desc int32Value]);
2159             }
2160         }
2161     }
2162   else
2163     {
2164       // no script result, return error
2165       return 1;
2166     }
2167   return 0;
2170 /* Helper function called from sendEvent to run applescript
2171    from within the main event loop.  */
2173 void
2174 ns_run_ascript (void)
2176   if (! NILP (as_script))
2177     as_status = ns_do_applescript (as_script, as_result);
2178   as_script = Qnil;
2181 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2182        doc: /* Execute AppleScript SCRIPT and return the result.
2183 If compilation and execution are successful, the resulting script value
2184 is returned as a string, a number or, in the case of other constructs, t.
2185 In case the execution fails, an error is signaled. */)
2186      (Lisp_Object script)
2188   Lisp_Object result;
2189   int status;
2190   NSEvent *nxev;
2191   struct input_event ev;
2193   CHECK_STRING (script);
2194   check_window_system (NULL);
2196   block_input ();
2198   as_script = script;
2199   as_result = &result;
2201   /* executing apple script requires the event loop to run, otherwise
2202      errors aren't returned and executeAndReturnError hangs forever.
2203      Post an event that runs applescript and then start the event loop.
2204      The event loop is exited when the script is done.  */
2205   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2206                             location: NSMakePoint (0, 0)
2207                        modifierFlags: 0
2208                            timestamp: 0
2209                         windowNumber: [[NSApp mainWindow] windowNumber]
2210                              context: [NSApp context]
2211                              subtype: 0
2212                                data1: 0
2213                                data2: NSAPP_DATA2_RUNASSCRIPT];
2215   [NSApp postEvent: nxev atStart: NO];
2217   // If there are other events, the event loop may exit.  Keep running
2218   // until the script has been handled.  */
2219   ns_init_events (&ev);
2220   while (! NILP (as_script))
2221     [NSApp run];
2222   ns_finish_events ();
2224   status = as_status;
2225   as_status = 0;
2226   as_result = 0;
2227   unblock_input ();
2228   if (status == 0)
2229     return result;
2230   else if (!STRINGP (result))
2231     error ("AppleScript error %d", status);
2232   else
2233     error ("%s", SSDATA (result));
2235 #endif
2239 /* ==========================================================================
2241     Miscellaneous functions not called through hooks
2243    ========================================================================== */
2245 /* called from frame.c */
2246 struct ns_display_info *
2247 check_x_display_info (Lisp_Object frame)
2249   return check_ns_display_info (frame);
2253 void
2254 x_set_scroll_bar_default_width (struct frame *f)
2256   int wid = FRAME_COLUMN_WIDTH (f);
2257   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2258   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2259                                       wid - 1) / wid;
2262 void
2263 x_set_scroll_bar_default_height (struct frame *f)
2265   int height = FRAME_LINE_HEIGHT (f);
2266   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2267   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2268                                        height - 1) / height;
2271 /* terms impl this instead of x-get-resource directly */
2272 char *
2273 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2275   /* remove appname prefix; TODO: allow for !="Emacs" */
2276   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2278   check_window_system (NULL);
2280   if (inhibit_x_resources)
2281     /* --quick was passed, so this is a no-op.  */
2282     return NULL;
2284   res = ns_get_defaults_value (toCheck);
2285   return (!res ? NULL :
2286           (!c_strncasecmp (res, "YES", 3) ? "true" :
2287            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2291 Lisp_Object
2292 x_get_focus_frame (struct frame *frame)
2294   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2295   Lisp_Object nsfocus;
2297   if (!dpyinfo->x_focus_frame)
2298     return Qnil;
2300   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2301   return nsfocus;
2304 /* ==========================================================================
2306     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2308    ========================================================================== */
2311 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2312        doc: /* Internal function called by `color-defined-p', which see.
2313 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2314      (Lisp_Object color, Lisp_Object frame)
2316   NSColor * col;
2317   check_window_system (NULL);
2318   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2322 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2323        doc: /* Internal function called by `color-values', which see.  */)
2324      (Lisp_Object color, Lisp_Object frame)
2326   NSColor * col;
2327   EmacsCGFloat red, green, blue, alpha;
2329   check_window_system (NULL);
2330   CHECK_STRING (color);
2332   if (ns_lisp_to_color (color, &col))
2333     return Qnil;
2335   [[col colorUsingDefaultColorSpace]
2336         getRed: &red green: &green blue: &blue alpha: &alpha];
2337   return list3i (lrint (red * 65280), lrint (green * 65280),
2338                  lrint (blue * 65280));
2342 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2343        doc: /* Internal function called by `display-color-p', which see.  */)
2344      (Lisp_Object terminal)
2346   NSWindowDepth depth;
2347   NSString *colorSpace;
2349   check_ns_display_info (terminal);
2350   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2351   colorSpace = NSColorSpaceFromDepth (depth);
2353   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2354          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2355       ? Qnil : Qt;
2359 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2360        0, 1, 0,
2361        doc: /* Return t if the Nextstep display supports shades of gray.
2362 Note that color displays do support shades of gray.
2363 The optional argument TERMINAL specifies which display to ask about.
2364 TERMINAL should be a terminal object, a frame or a display name (a string).
2365 If omitted or nil, that stands for the selected frame's display.  */)
2366   (Lisp_Object terminal)
2368   NSWindowDepth depth;
2370   check_ns_display_info (terminal);
2371   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2373   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2377 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2378        0, 1, 0,
2379        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2380 The optional argument TERMINAL specifies which display to ask about.
2381 TERMINAL should be a terminal object, a frame or a display name (a string).
2382 If omitted or nil, that stands for the selected frame's display.
2384 On \"multi-monitor\" setups this refers to the pixel width for all
2385 physical monitors associated with TERMINAL.  To get information for
2386 each physical monitor, use `display-monitor-attributes-list'.  */)
2387   (Lisp_Object terminal)
2389   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2391   return make_number (x_display_pixel_width (dpyinfo));
2395 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2396        Sx_display_pixel_height, 0, 1, 0,
2397        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2398 The optional argument TERMINAL specifies which display to ask about.
2399 TERMINAL should be a terminal object, a frame or a display name (a string).
2400 If omitted or nil, that stands for the selected frame's display.
2402 On \"multi-monitor\" setups this refers to the pixel height for all
2403 physical monitors associated with TERMINAL.  To get information for
2404 each physical monitor, use `display-monitor-attributes-list'.  */)
2405   (Lisp_Object terminal)
2407   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2409   return make_number (x_display_pixel_height (dpyinfo));
2412 #ifdef NS_IMPL_COCOA
2414 /* Returns the name for the screen that OBJ represents, or NULL.
2415    Caller must free return value.
2418 static char *
2419 ns_get_name_from_ioreg (io_object_t obj)
2421   char *name = NULL;
2423   NSDictionary *info = (NSDictionary *)
2424     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2425   NSDictionary *names = [info objectForKey:
2426                                 [NSString stringWithUTF8String:
2427                                             kDisplayProductName]];
2429   if ([names count] > 0)
2430     {
2431       NSString *n = [names objectForKey: [[names allKeys]
2432                                                  objectAtIndex:0]];
2433       if (n != nil) name = xstrdup ([n UTF8String]);
2434     }
2436   [info release];
2438   return name;
2441 /* Returns the name for the screen that DID came from, or NULL.
2442    Caller must free return value.
2445 static char *
2446 ns_screen_name (CGDirectDisplayID did)
2448   char *name = NULL;
2450 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2451   mach_port_t masterPort;
2452   io_iterator_t it;
2453   io_object_t obj;
2455   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2457   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2458       || IOServiceGetMatchingServices (masterPort,
2459                                        IOServiceMatching ("IONDRVDevice"),
2460                                        &it) != kIOReturnSuccess)
2461     return name;
2463   /* Must loop until we find a name.  Many devices can have the same unit
2464      number (represents different GPU parts), but only one has a name.  */
2465   while (! name && (obj = IOIteratorNext (it)))
2466     {
2467       CFMutableDictionaryRef props;
2468       const void *val;
2470       if (IORegistryEntryCreateCFProperties (obj,
2471                                              &props,
2472                                              kCFAllocatorDefault,
2473                                              kNilOptions) == kIOReturnSuccess
2474           && props != nil
2475           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2476         {
2477           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2478           if (nr == CGDisplayUnitNumber (did))
2479             name = ns_get_name_from_ioreg (obj);
2480         }
2482       CFRelease (props);
2483       IOObjectRelease (obj);
2484     }
2486   IOObjectRelease (it);
2488 #else
2490   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2492 #endif
2493   return name;
2495 #endif
2497 static Lisp_Object
2498 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2499                                 int n_monitors,
2500                                 int primary_monitor,
2501                                 const char *source)
2503   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2504   Lisp_Object frame, rest;
2505   NSArray *screens = [NSScreen screens];
2506   int i;
2508   FOR_EACH_FRAME (rest, frame)
2509     {
2510       struct frame *f = XFRAME (frame);
2512       if (FRAME_NS_P (f))
2513         {
2514           NSView *view = FRAME_NS_VIEW (f);
2515           NSScreen *screen = [[view window] screen];
2516           NSUInteger k;
2518           i = -1;
2519           for (k = 0; i == -1 && k < [screens count]; ++k)
2520             {
2521               if ([screens objectAtIndex: k] == screen)
2522                 i = (int)k;
2523             }
2525           if (i > -1)
2526             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2527         }
2528     }
2530   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2531                                       monitor_frames, source);
2534 DEFUN ("ns-display-monitor-attributes-list",
2535        Fns_display_monitor_attributes_list,
2536        Sns_display_monitor_attributes_list,
2537        0, 1, 0,
2538        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2540 The optional argument TERMINAL specifies which display to ask about.
2541 TERMINAL should be a terminal object, a frame or a display name (a string).
2542 If omitted or nil, that stands for the selected frame's display.
2544 In addition to the standard attribute keys listed in
2545 `display-monitor-attributes-list', the following keys are contained in
2546 the attributes:
2548  source -- String describing the source from which multi-monitor
2549            information is obtained, \"NS\" is always the source."
2551 Internal use only, use `display-monitor-attributes-list' instead.  */)
2552   (Lisp_Object terminal)
2554   struct terminal *term = get_terminal (terminal, 1);
2555   NSArray *screens;
2556   NSUInteger i, n_monitors;
2557   struct MonitorInfo *monitors;
2558   Lisp_Object attributes_list = Qnil;
2559   CGFloat primary_display_height = 0;
2561   if (term->type != output_ns)
2562     return Qnil;
2564   screens = [NSScreen screens];
2565   n_monitors = [screens count];
2566   if (n_monitors == 0)
2567     return Qnil;
2569   monitors = xzalloc (n_monitors * sizeof *monitors);
2571   for (i = 0; i < [screens count]; ++i)
2572     {
2573       NSScreen *s = [screens objectAtIndex:i];
2574       struct MonitorInfo *m = &monitors[i];
2575       NSRect fr = [s frame];
2576       NSRect vfr = [s visibleFrame];
2577       short y, vy;
2579 #ifdef NS_IMPL_COCOA
2580       NSDictionary *dict = [s deviceDescription];
2581       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2582       CGDirectDisplayID did = [nid unsignedIntValue];
2583 #endif
2584       if (i == 0)
2585         {
2586           primary_display_height = fr.size.height;
2587           y = (short) fr.origin.y;
2588           vy = (short) vfr.origin.y;
2589         }
2590       else
2591         {
2592           // Flip y coordinate as NS has y starting from the bottom.
2593           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2594           vy = (short) (primary_display_height -
2595                         vfr.size.height - vfr.origin.y);
2596         }
2598       m->geom.x = (short) fr.origin.x;
2599       m->geom.y = y;
2600       m->geom.width = (unsigned short) fr.size.width;
2601       m->geom.height = (unsigned short) fr.size.height;
2603       m->work.x = (short) vfr.origin.x;
2604       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2605       // and fr.size.height - vfr.size.height are pixels missing in total.
2606       // Pixels missing at top are
2607       // fr.size.height - vfr.size.height - vy + y.
2608       // work.y is then pixels missing at top + y.
2609       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2610       m->work.width = (unsigned short) vfr.size.width;
2611       m->work.height = (unsigned short) vfr.size.height;
2613 #ifdef NS_IMPL_COCOA
2614       m->name = ns_screen_name (did);
2616       {
2617         CGSize mms = CGDisplayScreenSize (did);
2618         m->mm_width = (int) mms.width;
2619         m->mm_height = (int) mms.height;
2620       }
2622 #else
2623       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2624       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2625       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2626 #endif
2627     }
2629   // Primary monitor is always first for NS.
2630   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2631                                                     0, "NS");
2633   free_monitors (monitors, n_monitors);
2634   return attributes_list;
2638 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2639        0, 1, 0,
2640        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2641 The optional argument TERMINAL specifies which display to ask about.
2642 TERMINAL should be a terminal object, a frame or a display name (a string).
2643 If omitted or nil, that stands for the selected frame's display.  */)
2644   (Lisp_Object terminal)
2646   check_ns_display_info (terminal);
2647   return make_number
2648     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2652 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2653        0, 1, 0,
2654        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2655 The optional argument TERMINAL specifies which display to ask about.
2656 TERMINAL should be a terminal object, a frame or a display name (a string).
2657 If omitted or nil, that stands for the selected frame's display.  */)
2658   (Lisp_Object terminal)
2660   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2661   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2662   return make_number (1 << min (dpyinfo->n_planes, 24));
2666 /* Unused dummy def needed for compatibility. */
2667 Lisp_Object tip_frame;
2669 /* TODO: move to xdisp or similar */
2670 static void
2671 compute_tip_xy (struct frame *f,
2672                 Lisp_Object parms,
2673                 Lisp_Object dx,
2674                 Lisp_Object dy,
2675                 int width,
2676                 int height,
2677                 int *root_x,
2678                 int *root_y)
2680   Lisp_Object left, top;
2681   EmacsView *view = FRAME_NS_VIEW (f);
2682   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2683   NSPoint pt;
2685   /* Start with user-specified or mouse position.  */
2686   left = Fcdr (Fassq (Qleft, parms));
2687   top = Fcdr (Fassq (Qtop, parms));
2689   if (!INTEGERP (left) || !INTEGERP (top))
2690     {
2691       pt.x = dpyinfo->last_mouse_motion_x;
2692       pt.y = dpyinfo->last_mouse_motion_y;
2693       /* Convert to screen coordinates */
2694       pt = [view convertPoint: pt toView: nil];
2695       pt = [[view window] convertBaseToScreen: pt];
2696     }
2697   else
2698     {
2699       /* Absolute coordinates.  */
2700       pt.x = XINT (left);
2701       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2702         - height;
2703     }
2705   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2706   if (INTEGERP (left))
2707     *root_x = pt.x;
2708   else if (pt.x + XINT (dx) <= 0)
2709     *root_x = 0; /* Can happen for negative dx */
2710   else if (pt.x + XINT (dx) + width
2711            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2712     /* It fits to the right of the pointer.  */
2713     *root_x = pt.x + XINT (dx);
2714   else if (width + XINT (dx) <= pt.x)
2715     /* It fits to the left of the pointer.  */
2716     *root_x = pt.x - width - XINT (dx);
2717   else
2718     /* Put it left justified on the screen -- it ought to fit that way.  */
2719     *root_x = 0;
2721   if (INTEGERP (top))
2722     *root_y = pt.y;
2723   else if (pt.y - XINT (dy) - height >= 0)
2724     /* It fits below the pointer.  */
2725     *root_y = pt.y - height - XINT (dy);
2726   else if (pt.y + XINT (dy) + height
2727            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2728     /* It fits above the pointer */
2729       *root_y = pt.y + XINT (dy);
2730   else
2731     /* Put it on the top.  */
2732     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2736 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2737        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2738 A tooltip window is a small window displaying a string.
2740 This is an internal function; Lisp code should call `tooltip-show'.
2742 FRAME nil or omitted means use the selected frame.
2744 PARMS is an optional list of frame parameters which can be used to
2745 change the tooltip's appearance.
2747 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2748 means use the default timeout of 5 seconds.
2750 If the list of frame parameters PARMS contains a `left' parameter,
2751 the tooltip is displayed at that x-position.  Otherwise it is
2752 displayed at the mouse position, with offset DX added (default is 5 if
2753 DX isn't specified).  Likewise for the y-position; if a `top' frame
2754 parameter is specified, it determines the y-position of the tooltip
2755 window, otherwise it is displayed at the mouse position, with offset
2756 DY added (default is -10).
2758 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2759 Text larger than the specified size is clipped.  */)
2760      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2762   int root_x, root_y;
2763   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2764   ptrdiff_t count = SPECPDL_INDEX ();
2765   struct frame *f;
2766   char *str;
2767   NSSize size;
2769   specbind (Qinhibit_redisplay, Qt);
2771   GCPRO4 (string, parms, frame, timeout);
2773   CHECK_STRING (string);
2774   str = SSDATA (string);
2775   f = decode_window_system_frame (frame);
2776   if (NILP (timeout))
2777     timeout = make_number (5);
2778   else
2779     CHECK_NATNUM (timeout);
2781   if (NILP (dx))
2782     dx = make_number (5);
2783   else
2784     CHECK_NUMBER (dx);
2786   if (NILP (dy))
2787     dy = make_number (-10);
2788   else
2789     CHECK_NUMBER (dy);
2791   block_input ();
2792   if (ns_tooltip == nil)
2793     ns_tooltip = [[EmacsTooltip alloc] init];
2794   else
2795     Fx_hide_tip ();
2797   [ns_tooltip setText: str];
2798   size = [ns_tooltip frame].size;
2800   /* Move the tooltip window where the mouse pointer is.  Resize and
2801      show it.  */
2802   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2803                   &root_x, &root_y);
2805   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2806   unblock_input ();
2808   UNGCPRO;
2809   return unbind_to (count, Qnil);
2813 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2814        doc: /* Hide the current tooltip window, if there is any.
2815 Value is t if tooltip was open, nil otherwise.  */)
2816      (void)
2818   if (ns_tooltip == nil || ![ns_tooltip isActive])
2819     return Qnil;
2820   [ns_tooltip hide];
2821   return Qt;
2825 /* ==========================================================================
2827     Class implementations
2829    ========================================================================== */
2832   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2833   Return YES if handled, NO if not.
2834  */
2835 static BOOL
2836 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2838   NSString *s;
2839   int i;
2840   BOOL ret = NO;
2842   if ([theEvent type] != NSKeyDown) return NO;
2843   s = [theEvent characters];
2845   for (i = 0; i < [s length]; ++i)
2846     {
2847       int ch = (int) [s characterAtIndex: i];
2848       switch (ch)
2849         {
2850         case NSHomeFunctionKey:
2851         case NSDownArrowFunctionKey:
2852         case NSUpArrowFunctionKey:
2853         case NSLeftArrowFunctionKey:
2854         case NSRightArrowFunctionKey:
2855         case NSPageUpFunctionKey:
2856         case NSPageDownFunctionKey:
2857         case NSEndFunctionKey:
2858           /* Don't send command modified keys, as those are handled in the
2859              performKeyEquivalent method of the super class.
2860           */
2861           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2862             {
2863               [panel sendEvent: theEvent];
2864               ret = YES;
2865             }
2866           break;
2867           /* As we don't have the standard key commands for
2868              copy/paste/cut/select-all in our edit menu, we must handle
2869              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2870              here, paste works, because we have that in our Edit menu.
2871              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2872              correct modifier.
2873           */
2874         case 'x': // Cut
2875         case 'c': // Copy
2876         case 'v': // Paste
2877         case 'a': // Select all
2878           if ([theEvent modifierFlags] & NSCommandKeyMask)
2879             {
2880               [NSApp sendAction:
2881                        (ch == 'x'
2882                         ? @selector(cut:)
2883                         : (ch == 'c'
2884                            ? @selector(copy:)
2885                            : (ch == 'v'
2886                               ? @selector(paste:)
2887                               : @selector(selectAll:))))
2888                              to:nil from:panel];
2889               ret = YES;
2890             }
2891         default:
2892           // Send all control keys, as the text field supports C-a, C-f, C-e
2893           // C-b and more.
2894           if ([theEvent modifierFlags] & NSControlKeyMask)
2895             {
2896               [panel sendEvent: theEvent];
2897               ret = YES;
2898             }
2899           break;
2900         }
2901     }
2904   return ret;
2907 @implementation EmacsSavePanel
2908 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2910   BOOL ret = handlePanelKeys (self, theEvent);
2911   if (! ret)
2912     ret = [super performKeyEquivalent:theEvent];
2913   return ret;
2915 @end
2918 @implementation EmacsOpenPanel
2919 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2921   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2922   BOOL ret = handlePanelKeys (self, theEvent);
2923   if (! ret)
2924     ret = [super performKeyEquivalent:theEvent];
2925   return ret;
2927 @end
2930 @implementation EmacsFileDelegate
2931 /* --------------------------------------------------------------------------
2932    Delegate methods for Open/Save panels
2933    -------------------------------------------------------------------------- */
2934 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2936   return YES;
2938 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2940   return YES;
2942 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2943           confirmed: (BOOL)okFlag
2945   return filename;
2947 @end
2949 #endif
2952 /* ==========================================================================
2954     Lisp interface declaration
2956    ========================================================================== */
2959 void
2960 syms_of_nsfns (void)
2962   Qfontsize = intern_c_string ("fontsize");
2963   staticpro (&Qfontsize);
2965   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2966                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2967 If the title of a frame matches REGEXP, then IMAGE.tiff is
2968 selected as the image of the icon representing the frame when it's
2969 miniaturized.  If an element is t, then Emacs tries to select an icon
2970 based on the filetype of the visited file.
2972 The images have to be installed in a folder called English.lproj in the
2973 Emacs folder.  You have to restart Emacs after installing new icons.
2975 Example: Install an icon Gnus.tiff and execute the following code
2977   (setq ns-icon-type-alist
2978         (append ns-icon-type-alist
2979                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2980                    . \"Gnus\"))))
2982 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2983 be used as the image of the icon representing the frame.  */);
2984   Vns_icon_type_alist = list1 (Qt);
2986   DEFVAR_LISP ("ns-version-string", Vns_version_string,
2987                doc: /* Toolkit version for NS Windowing.  */);
2988   Vns_version_string = ns_appkit_version_str ();
2990   defsubr (&Sns_read_file_name);
2991   defsubr (&Sns_get_resource);
2992   defsubr (&Sns_set_resource);
2993   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2994   defsubr (&Sx_display_grayscale_p);
2995   defsubr (&Sns_font_name);
2996   defsubr (&Sns_list_colors);
2997 #ifdef NS_IMPL_COCOA
2998   defsubr (&Sns_do_applescript);
2999 #endif
3000   defsubr (&Sxw_color_defined_p);
3001   defsubr (&Sxw_color_values);
3002   defsubr (&Sx_server_max_request_size);
3003   defsubr (&Sx_server_vendor);
3004   defsubr (&Sx_server_version);
3005   defsubr (&Sx_display_pixel_width);
3006   defsubr (&Sx_display_pixel_height);
3007   defsubr (&Sns_display_monitor_attributes_list);
3008   defsubr (&Sx_display_mm_width);
3009   defsubr (&Sx_display_mm_height);
3010   defsubr (&Sx_display_screens);
3011   defsubr (&Sx_display_planes);
3012   defsubr (&Sx_display_color_cells);
3013   defsubr (&Sx_display_visual_class);
3014   defsubr (&Sx_display_backing_store);
3015   defsubr (&Sx_display_save_under);
3016   defsubr (&Sx_create_frame);
3017   defsubr (&Sx_open_connection);
3018   defsubr (&Sx_close_connection);
3019   defsubr (&Sx_display_list);
3021   defsubr (&Sns_hide_others);
3022   defsubr (&Sns_hide_emacs);
3023   defsubr (&Sns_emacs_info_panel);
3024   defsubr (&Sns_list_services);
3025   defsubr (&Sns_perform_service);
3026   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3027   defsubr (&Sns_popup_font_panel);
3028   defsubr (&Sns_popup_color_panel);
3030   defsubr (&Sx_show_tip);
3031   defsubr (&Sx_hide_tip);
3033   as_status = 0;
3034   as_script = Qnil;
3035   as_result = 0;