eww point positioning tweak
[emacs.git] / src / nsfns.m
blob1537adbc56d6cef914d9730842060f7660576824
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 #include "macfont.h"
50 #endif
52 #if 0
53 int fns_trace_num = 1;
54 #define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
55                                   __FILE__, __LINE__, ++fns_trace_num)
56 #else
57 #define NSTRACE(x)
58 #endif
60 #ifdef HAVE_NS
62 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
64 extern Lisp_Object Qforeground_color;
65 extern Lisp_Object Qbackground_color;
66 extern Lisp_Object Qcursor_color;
67 extern Lisp_Object Qinternal_border_width;
68 extern Lisp_Object Qvisibility;
69 extern Lisp_Object Qcursor_type;
70 extern Lisp_Object Qicon_type;
71 extern Lisp_Object Qicon_name;
72 extern Lisp_Object Qicon_left;
73 extern Lisp_Object Qicon_top;
74 extern Lisp_Object Qtop;
75 extern Lisp_Object Qdisplay;
76 extern Lisp_Object Qvertical_scroll_bars;
77 extern Lisp_Object Qhorizontal_scroll_bars;
78 extern Lisp_Object Qauto_raise;
79 extern Lisp_Object Qauto_lower;
80 extern Lisp_Object Qbox;
81 extern Lisp_Object Qscroll_bar_width;
82 extern Lisp_Object Qscroll_bar_height;
83 extern Lisp_Object Qx_resource_name;
84 extern Lisp_Object Qface_set_after_frame_default;
85 extern Lisp_Object Qunderline, Qundefined;
86 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
87 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
90 Lisp_Object Qbuffered;
91 Lisp_Object Qfontsize;
93 EmacsTooltip *ns_tooltip = nil;
95 /* Need forward declaration here to preserve organizational integrity of file */
96 Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
98 /* Static variables to handle applescript execution.  */
99 static Lisp_Object as_script, *as_result;
100 static int as_status;
102 #ifdef GLYPH_DEBUG
103 static ptrdiff_t image_cache_refcount;
104 #endif
107 /* ==========================================================================
109     Internal utility functions
111    ========================================================================== */
113 /* Let the user specify a Nextstep display with a Lisp object.
114    OBJECT may be nil, a frame or a terminal object.
115    nil stands for the selected frame--or, if that is not a Nextstep frame,
116    the first Nextstep display on the list.  */
118 static struct ns_display_info *
119 check_ns_display_info (Lisp_Object object)
121   struct ns_display_info *dpyinfo = NULL;
123   if (NILP (object))
124     {
125       struct frame *sf = XFRAME (selected_frame);
127       if (FRAME_NS_P (sf) && FRAME_LIVE_P (sf))
128         dpyinfo = FRAME_DISPLAY_INFO (sf);
129       else if (x_display_list != 0)
130         dpyinfo = x_display_list;
131       else
132         error ("Nextstep windows are not in use or not initialized");
133     }
134   else if (TERMINALP (object))
135     {
136       struct terminal *t = decode_live_terminal (object);
138       if (t->type != output_ns)
139         error ("Terminal %d is not a Nextstep display", t->id);
141       dpyinfo = t->display_info.ns;
142     }
143   else if (STRINGP (object))
144     dpyinfo = ns_display_info_for_name (object);
145   else
146     {
147       struct frame *f = decode_window_system_frame (object);
148       dpyinfo = FRAME_DISPLAY_INFO (f);
149     }
151   return dpyinfo;
155 static id
156 ns_get_window (Lisp_Object maybeFrame)
158   id view =nil, window =nil;
160   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
161     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
163   if (!NILP (maybeFrame))
164     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
165   if (view) window =[view window];
167   return window;
171 /* Return the X display structure for the display named NAME.
172    Open a new connection if necessary.  */
173 struct ns_display_info *
174 ns_display_info_for_name (Lisp_Object name)
176   struct ns_display_info *dpyinfo;
178   CHECK_STRING (name);
180   for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
181     if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name)))
182       return dpyinfo;
184   error ("Emacs for Nextstep does not yet support multi-display");
186   Fx_open_connection (name, Qnil, Qnil);
187   dpyinfo = x_display_list;
189   if (dpyinfo == 0)
190     error ("Display on %s not responding.\n", SDATA (name));
192   return dpyinfo;
195 static NSString *
196 ns_filename_from_panel (NSSavePanel *panel)
198 #ifdef NS_IMPL_COCOA
199   NSURL *url = [panel URL];
200   NSString *str = [url path];
201   return str;
202 #else
203   return [panel filename];
204 #endif
207 static NSString *
208 ns_directory_from_panel (NSSavePanel *panel)
210 #ifdef NS_IMPL_COCOA
211   NSURL *url = [panel directoryURL];
212   NSString *str = [url path];
213   return str;
214 #else
215   return [panel directory];
216 #endif
219 static Lisp_Object
220 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
221 /* --------------------------------------------------------------------------
222    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
223    -------------------------------------------------------------------------- */
225   int i, count;
226   NSMenuItem *item;
227   const char *name;
228   Lisp_Object nameStr;
229   unsigned short key;
230   NSString *keys;
231   Lisp_Object res;
233   count = [menu numberOfItems];
234   for (i = 0; i<count; i++)
235     {
236       item = [menu itemAtIndex: i];
237       name = [[item title] UTF8String];
238       if (!name) continue;
240       nameStr = build_string (name);
242       if ([item hasSubmenu])
243         {
244           old = interpret_services_menu ([item submenu],
245                                         Fcons (nameStr, prefix), old);
246         }
247       else
248         {
249           keys = [item keyEquivalent];
250           if (keys && [keys length] )
251             {
252               key = [keys characterAtIndex: 0];
253               res = make_number (key|super_modifier);
254             }
255           else
256             {
257               res = Qundefined;
258             }
259           old = Fcons (Fcons (res,
260                             Freverse (Fcons (nameStr,
261                                            prefix))),
262                     old);
263         }
264     }
265   return old;
270 /* ==========================================================================
272     Frame parameter setters
274    ========================================================================== */
277 static void
278 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
280   NSColor *col;
281   EmacsCGFloat r, g, b, alpha;
283   if (ns_lisp_to_color (arg, &col))
284     {
285       store_frame_param (f, Qforeground_color, oldval);
286       error ("Unknown color");
287     }
289   [col retain];
290   [f->output_data.ns->foreground_color release];
291   f->output_data.ns->foreground_color = col;
293   [col getRed: &r green: &g blue: &b alpha: &alpha];
294   FRAME_FOREGROUND_PIXEL (f) =
295     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
297   if (FRAME_NS_VIEW (f))
298     {
299       update_face_from_frame_parameter (f, Qforeground_color, arg);
300       /*recompute_basic_faces (f); */
301       if (FRAME_VISIBLE_P (f))
302         redraw_frame (f);
303     }
307 static void
308 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
310   struct face *face;
311   NSColor *col;
312   NSView *view = FRAME_NS_VIEW (f);
313   EmacsCGFloat r, g, b, alpha;
315   if (ns_lisp_to_color (arg, &col))
316     {
317       store_frame_param (f, Qbackground_color, oldval);
318       error ("Unknown color");
319     }
321   /* clear the frame; in some instances the NS-internal GC appears not to
322      update, or it does update and cannot clear old text properly */
323   if (FRAME_VISIBLE_P (f))
324     ns_clear_frame (f);
326   [col retain];
327   [f->output_data.ns->background_color release];
328   f->output_data.ns->background_color = col;
330   [col getRed: &r green: &g blue: &b alpha: &alpha];
331   FRAME_BACKGROUND_PIXEL (f) =
332     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
334   if (view != nil)
335     {
336       [[view window] setBackgroundColor: col];
338       if (alpha != (EmacsCGFloat) 1.0)
339           [[view window] setOpaque: NO];
340       else
341           [[view window] setOpaque: YES];
343       face = FRAME_DEFAULT_FACE (f);
344       if (face)
345         {
346           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
347           face->background = ns_index_color
348             ([col colorWithAlphaComponent: alpha], f);
350           update_face_from_frame_parameter (f, Qbackground_color, arg);
351         }
353       if (FRAME_VISIBLE_P (f))
354         redraw_frame (f);
355     }
359 static void
360 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
362   NSColor *col;
364   if (ns_lisp_to_color (arg, &col))
365     {
366       store_frame_param (f, Qcursor_color, oldval);
367       error ("Unknown color");
368     }
370   [FRAME_CURSOR_COLOR (f) release];
371   FRAME_CURSOR_COLOR (f) = [col retain];
373   if (FRAME_VISIBLE_P (f))
374     {
375       x_update_cursor (f, 0);
376       x_update_cursor (f, 1);
377     }
378   update_face_from_frame_parameter (f, Qcursor_color, arg);
382 static void
383 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
385   NSView *view = FRAME_NS_VIEW (f);
386   NSTRACE (x_set_icon_name);
388   /* see if it's changed */
389   if (STRINGP (arg))
390     {
391       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
392         return;
393     }
394   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
395     return;
397   fset_icon_name (f, arg);
399   if (NILP (arg))
400     {
401       if (!NILP (f->title))
402         arg = f->title;
403       else
404         /* Explicit name and no icon-name -> explicit_name.  */
405         if (f->explicit_name)
406           arg = f->name;
407         else
408           {
409             /* No explicit name and no icon-name ->
410                name has to be rebuild from icon_title_format.  */
411             windows_or_buffers_changed = 62;
412             return;
413           }
414     }
416   /* Don't change the name if it's already NAME.  */
417   if ([[view window] miniwindowTitle]
418       && ([[[view window] miniwindowTitle]
419              isEqualToString: [NSString stringWithUTF8String:
420                                           SSDATA (arg)]]))
421     return;
423   [[view window] setMiniwindowTitle:
424         [NSString stringWithUTF8String: SSDATA (arg)]];
427 static void
428 ns_set_name_internal (struct frame *f, Lisp_Object name)
430   struct gcpro gcpro1;
431   Lisp_Object encoded_name, encoded_icon_name;
432   NSString *str;
433   NSView *view = FRAME_NS_VIEW (f);
435   GCPRO1 (name);
436   encoded_name = ENCODE_UTF_8 (name);
437   UNGCPRO;
439   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
441   /* Don't change the name if it's already NAME.  */
442   if (! [[[view window] title] isEqualToString: str])
443     [[view window] setTitle: str];
445   if (!STRINGP (f->icon_name))
446     encoded_icon_name = encoded_name;
447   else
448     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
450   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
452   if ([[view window] miniwindowTitle]
453       && ! [[[view window] miniwindowTitle] isEqualToString: str])
454     [[view window] setMiniwindowTitle: str];
458 static void
459 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
461   NSTRACE (ns_set_name);
463   /* Make sure that requests from lisp code override requests from
464      Emacs redisplay code.  */
465   if (explicit)
466     {
467       /* If we're switching from explicit to implicit, we had better
468          update the mode lines and thereby update the title.  */
469       if (f->explicit_name && NILP (name))
470         update_mode_lines = 21;
472       f->explicit_name = ! NILP (name);
473     }
474   else if (f->explicit_name)
475     return;
477   if (NILP (name))
478     name = build_string ([ns_app_name UTF8String]);
479   else
480     CHECK_STRING (name);
482   /* Don't change the name if it's already NAME.  */
483   if (! NILP (Fstring_equal (name, f->name)))
484     return;
486   fset_name (f, name);
488   /* Title overrides explicit name.  */
489   if (! NILP (f->title))
490     name = f->title;
492   ns_set_name_internal (f, name);
496 /* This function should be called when the user's lisp code has
497    specified a name for the frame; the name will override any set by the
498    redisplay code.  */
499 static void
500 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
502   NSTRACE (x_explicitly_set_name);
503   ns_set_name (f, arg, 1);
507 /* This function should be called by Emacs redisplay code to set the
508    name; names set this way will never override names set by the user's
509    lisp code.  */
510 void
511 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
513   NSTRACE (x_implicitly_set_name);
515   /* Deal with NS specific format t.  */
516   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
517                          || EQ (Vframe_title_format, Qt)))
518     ns_set_name_as_filename (f);
519   else
520     ns_set_name (f, arg, 0);
524 /* Change the title of frame F to NAME.
525    If NAME is nil, use the frame name as the title.  */
527 static void
528 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
530   NSTRACE (x_set_title);
531   /* Don't change the title if it's already NAME.  */
532   if (EQ (name, f->title))
533     return;
535   update_mode_lines = 22;
537   fset_title (f, name);
539   if (NILP (name))
540     name = f->name;
541   else
542     CHECK_STRING (name);
544   ns_set_name_internal (f, name);
548 void
549 ns_set_name_as_filename (struct frame *f)
551   NSView *view;
552   Lisp_Object name, filename;
553   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
554   const char *title;
555   NSAutoreleasePool *pool;
556   struct gcpro gcpro1;
557   Lisp_Object encoded_name, encoded_filename;
558   NSString *str;
559   NSTRACE (ns_set_name_as_filename);
561   if (f->explicit_name || ! NILP (f->title))
562     return;
564   block_input ();
565   pool = [[NSAutoreleasePool alloc] init];
566   filename = BVAR (XBUFFER (buf), filename);
567   name = BVAR (XBUFFER (buf), name);
569   if (NILP (name))
570     {
571       if (! NILP (filename))
572         name = Ffile_name_nondirectory (filename);
573       else
574         name = build_string ([ns_app_name UTF8String]);
575     }
577   GCPRO1 (name);
578   encoded_name = ENCODE_UTF_8 (name);
579   UNGCPRO;
581   view = FRAME_NS_VIEW (f);
583   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
584                                 : [[[view window] title] UTF8String];
586   if (title && (! strcmp (title, SSDATA (encoded_name))))
587     {
588       [pool release];
589       unblock_input ();
590       return;
591     }
593   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
594   if (str == nil) str = @"Bad coding";
596   if (FRAME_ICONIFIED_P (f))
597     [[view window] setMiniwindowTitle: str];
598   else
599     {
600       NSString *fstr;
602       if (! NILP (filename))
603         {
604           GCPRO1 (filename);
605           encoded_filename = ENCODE_UTF_8 (filename);
606           UNGCPRO;
608           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
609           if (fstr == nil) fstr = @"";
610 #ifdef NS_IMPL_COCOA
611           /* work around a bug observed on 10.3 and later where
612              setTitleWithRepresentedFilename does not clear out previous state
613              if given filename does not exist */
614           if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
615             [[view window] setRepresentedFilename: @""];
616 #endif
617         }
618       else
619         fstr = @"";
621       [[view window] setRepresentedFilename: fstr];
622       [[view window] setTitle: str];
623       fset_name (f, name);
624     }
626   [pool release];
627   unblock_input ();
631 void
632 ns_set_doc_edited (void)
634   NSAutoreleasePool *pool;
635   Lisp_Object tail, frame;
636   block_input ();
637   pool = [[NSAutoreleasePool alloc] init];
638   FOR_EACH_FRAME (tail, frame)
639     {
640       BOOL edited = NO;
641       struct frame *f = XFRAME (frame);
642       struct window *w;
643       NSView *view;
645       if (! FRAME_NS_P (f)) continue;
646       w = XWINDOW (FRAME_SELECTED_WINDOW (f));
647       view = FRAME_NS_VIEW (f);
648       if (!MINI_WINDOW_P (w))
649         edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
650           ! NILP (Fbuffer_file_name (w->contents));
651       [[view window] setDocumentEdited: edited];
652     }
654   [pool release];
655   unblock_input ();
659 void
660 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
662   int nlines;
663   if (FRAME_MINIBUF_ONLY_P (f))
664     return;
666   if (TYPE_RANGED_INTEGERP (int, value))
667     nlines = XINT (value);
668   else
669     nlines = 0;
671   FRAME_MENU_BAR_LINES (f) = 0;
672   if (nlines)
673     {
674       FRAME_EXTERNAL_MENU_BAR (f) = 1;
675       /* does for all frames, whereas we just want for one frame
676          [NSMenu setMenuBarVisible: YES]; */
677     }
678   else
679     {
680       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
681         free_frame_menubar (f);
682       /*      [NSMenu setMenuBarVisible: NO]; */
683       FRAME_EXTERNAL_MENU_BAR (f) = 0;
684     }
688 /* toolbar support */
689 void
690 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
692   int nlines;
694   if (FRAME_MINIBUF_ONLY_P (f))
695     return;
697   if (RANGED_INTEGERP (0, value, INT_MAX))
698     nlines = XFASTINT (value);
699   else
700     nlines = 0;
702   if (nlines)
703     {
704       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
705       update_frame_tool_bar (f);
706     }
707   else
708     {
709       if (FRAME_EXTERNAL_TOOL_BAR (f))
710         {
711           free_frame_tool_bar (f);
712           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
713         }
714     }
716   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
720 void
721 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
723   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
725   CHECK_TYPE_RANGED_INTEGER (int, arg);
726   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
727   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
728     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
730   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
731     return;
733   if (FRAME_X_WINDOW (f) != 0)
734     adjust_frame_size (f, -1, -1, 3, 0);
736   SET_FRAME_GARBAGED (f);
740 static void
741 ns_implicitly_set_icon_type (struct frame *f)
743   Lisp_Object tem;
744   EmacsView *view = FRAME_NS_VIEW (f);
745   id image = nil;
746   Lisp_Object chain, elt;
747   NSAutoreleasePool *pool;
748   BOOL setMini = YES;
750   NSTRACE (ns_implicitly_set_icon_type);
752   block_input ();
753   pool = [[NSAutoreleasePool alloc] init];
754   if (f->output_data.ns->miniimage
755       && [[NSString stringWithUTF8String: SSDATA (f->name)]
756                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
757     {
758       [pool release];
759       unblock_input ();
760       return;
761     }
763   tem = assq_no_quit (Qicon_type, f->param_alist);
764   if (CONSP (tem) && ! NILP (XCDR (tem)))
765     {
766       [pool release];
767       unblock_input ();
768       return;
769     }
771   for (chain = Vns_icon_type_alist;
772        image == nil && CONSP (chain);
773        chain = XCDR (chain))
774     {
775       elt = XCAR (chain);
776       /* special case: 't' means go by file type */
777       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
778         {
779           NSString *str
780              = [NSString stringWithUTF8String: SSDATA (f->name)];
781           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
782             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
783         }
784       else if (CONSP (elt) &&
785                STRINGP (XCAR (elt)) &&
786                STRINGP (XCDR (elt)) &&
787                fast_string_match (XCAR (elt), f->name) >= 0)
788         {
789           image = [EmacsImage allocInitFromFile: XCDR (elt)];
790           if (image == nil)
791             image = [[NSImage imageNamed:
792                                [NSString stringWithUTF8String:
793                                             SSDATA (XCDR (elt))]] retain];
794         }
795     }
797   if (image == nil)
798     {
799       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
800       setMini = NO;
801     }
803   [f->output_data.ns->miniimage release];
804   f->output_data.ns->miniimage = image;
805   [view setMiniwindowImage: setMini];
806   [pool release];
807   unblock_input ();
811 static void
812 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
814   EmacsView *view = FRAME_NS_VIEW (f);
815   id image = nil;
816   BOOL setMini = YES;
818   NSTRACE (x_set_icon_type);
820   if (!NILP (arg) && SYMBOLP (arg))
821     {
822       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
823       store_frame_param (f, Qicon_type, arg);
824     }
826   /* do it the implicit way */
827   if (NILP (arg))
828     {
829       ns_implicitly_set_icon_type (f);
830       return;
831     }
833   CHECK_STRING (arg);
835   image = [EmacsImage allocInitFromFile: arg];
836   if (image == nil)
837     image =[NSImage imageNamed: [NSString stringWithUTF8String:
838                                             SSDATA (arg)]];
840   if (image == nil)
841     {
842       image = [NSImage imageNamed: @"text"];
843       setMini = NO;
844     }
846   f->output_data.ns->miniimage = image;
847   [view setMiniwindowImage: setMini];
851 /* TODO: move to nsterm? */
853 ns_lisp_to_cursor_type (Lisp_Object arg)
855   char *str;
856   if (XTYPE (arg) == Lisp_String)
857     str = SSDATA (arg);
858   else if (XTYPE (arg) == Lisp_Symbol)
859     str = SSDATA (SYMBOL_NAME (arg));
860   else return -1;
861   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
862   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
863   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
864   if (!strcmp (str, "bar"))     return BAR_CURSOR;
865   if (!strcmp (str, "no"))      return NO_CURSOR;
866   return -1;
870 Lisp_Object
871 ns_cursor_type_to_lisp (int arg)
873   switch (arg)
874     {
875     case FILLED_BOX_CURSOR: return Qbox;
876     case HOLLOW_BOX_CURSOR: return intern ("hollow");
877     case HBAR_CURSOR:       return intern ("hbar");
878     case BAR_CURSOR:        return intern ("bar");
879     case NO_CURSOR:
880     default:                return intern ("no");
881     }
884 /* This is the same as the xfns.c definition.  */
885 static void
886 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
888   set_frame_cursor_types (f, arg);
891 /* called to set mouse pointer color, but all other terms use it to
892    initialize pointer types (and don't set the color ;) */
893 static void
894 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
896   /* don't think we can do this on Nextstep */
900 #define Str(x) #x
901 #define Xstr(x) Str(x)
903 static Lisp_Object
904 ns_appkit_version_str (void)
906   char tmp[256];
908 #ifdef NS_IMPL_GNUSTEP
909   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
910 #elif defined (NS_IMPL_COCOA)
911   NSString *osversion
912     = [[NSProcessInfo processInfo] operatingSystemVersionString];
913   sprintf(tmp, "appkit-%.2f %s",
914           NSAppKitVersionNumber,
915           [osversion UTF8String]);
916 #else
917   tmp = "ns-unknown";
918 #endif
919   return build_string (tmp);
923 /* This is for use by x-server-version and collapses all version info we
924    have into a single int.  For a better picture of the implementation
925    running, use ns_appkit_version_str.*/
926 static int
927 ns_appkit_version_int (void)
929 #ifdef NS_IMPL_GNUSTEP
930   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
931 #elif defined (NS_IMPL_COCOA)
932   return (int)NSAppKitVersionNumber;
933 #endif
934   return 0;
938 static void
939 x_icon (struct frame *f, Lisp_Object parms)
940 /* --------------------------------------------------------------------------
941    Strangely-named function to set icon position parameters in frame.
942    This is irrelevant under OS X, but might be needed under GNUstep,
943    depending on the window manager used.  Note, this is not a standard
944    frame parameter-setter; it is called directly from x-create-frame.
945    -------------------------------------------------------------------------- */
947   Lisp_Object icon_x, icon_y;
948   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
950   f->output_data.ns->icon_top = -1;
951   f->output_data.ns->icon_left = -1;
953   /* Set the position of the icon.  */
954   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
955   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
956   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
957     {
958       CHECK_NUMBER (icon_x);
959       CHECK_NUMBER (icon_y);
960       f->output_data.ns->icon_top = XINT (icon_y);
961       f->output_data.ns->icon_left = XINT (icon_x);
962     }
963   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
964     error ("Both left and top icon corners of icon must be specified");
968 /* Note: see frame.c for template, also where generic functions are impl */
969 frame_parm_handler ns_frame_parm_handlers[] =
971   x_set_autoraise, /* generic OK */
972   x_set_autolower, /* generic OK */
973   x_set_background_color,
974   0, /* x_set_border_color,  may be impossible under Nextstep */
975   0, /* x_set_border_width,  may be impossible under Nextstep */
976   x_set_cursor_color,
977   x_set_cursor_type,
978   x_set_font, /* generic OK */
979   x_set_foreground_color,
980   x_set_icon_name,
981   x_set_icon_type,
982   x_set_internal_border_width, /* generic OK */
983   0, /* x_set_right_divider_width */
984   0, /* x_set_bottom_divider_width */
985   x_set_menu_bar_lines,
986   x_set_mouse_color,
987   x_explicitly_set_name,
988   x_set_scroll_bar_width, /* generic OK */
989   x_set_scroll_bar_height, /* generic OK */
990   x_set_title,
991   x_set_unsplittable, /* generic OK */
992   x_set_vertical_scroll_bars, /* generic OK */
993   x_set_horizontal_scroll_bars, /* generic OK */
994   x_set_visibility, /* generic OK */
995   x_set_tool_bar_lines,
996   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
997   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
998   x_set_screen_gamma, /* generic OK */
999   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1000   x_set_left_fringe, /* generic OK */
1001   x_set_right_fringe, /* generic OK */
1002   0, /* x_set_wait_for_wm, will ignore */
1003   x_set_fullscreen, /* generic OK */
1004   x_set_font_backend, /* generic OK */
1005   x_set_alpha,
1006   0, /* x_set_sticky */
1007   0, /* x_set_tool_bar_position */
1011 /* Handler for signals raised during x_create_frame.
1012    FRAME is the frame which is partially constructed.  */
1014 static void
1015 unwind_create_frame (Lisp_Object frame)
1017   struct frame *f = XFRAME (frame);
1019   /* If frame is already dead, nothing to do.  This can happen if the
1020      display is disconnected after the frame has become official, but
1021      before x_create_frame removes the unwind protect.  */
1022   if (!FRAME_LIVE_P (f))
1023     return;
1025   /* If frame is ``official'', nothing to do.  */
1026   if (NILP (Fmemq (frame, Vframe_list)))
1027     {
1028 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1029       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1030 #endif
1032       x_free_frame_resources (f);
1033       free_glyphs (f);
1035 #ifdef GLYPH_DEBUG
1036       /* Check that reference counts are indeed correct.  */
1037       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1038 #endif
1039     }
1043  * Read geometry related parameters from preferences if not in PARMS.
1044  * Returns the union of parms and any preferences read.
1045  */
1047 static Lisp_Object
1048 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1049                                Lisp_Object parms)
1051   struct {
1052     const char *val;
1053     const char *cls;
1054     Lisp_Object tem;
1055   } r[] = {
1056     { "width",  "Width", Qwidth },
1057     { "height", "Height", Qheight },
1058     { "left", "Left", Qleft },
1059     { "top", "Top", Qtop },
1060   };
1062   int i;
1063   for (i = 0; i < ARRAYELTS (r); ++i)
1064     {
1065       if (NILP (Fassq (r[i].tem, parms)))
1066         {
1067           Lisp_Object value
1068             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1069                          RES_TYPE_NUMBER);
1070           if (! EQ (value, Qunbound))
1071             parms = Fcons (Fcons (r[i].tem, value), parms);
1072         }
1073     }
1075   return parms;
1078 /* ==========================================================================
1080     Lisp definitions
1082    ========================================================================== */
1084 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1085        1, 1, 0,
1086        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1087 Return an Emacs frame object.
1088 PARMS is an alist of frame parameters.
1089 If the parameters specify that the frame should not have a minibuffer,
1090 and do not specify a specific minibuffer window to use,
1091 then `default-minibuffer-frame' must be a frame whose minibuffer can
1092 be shared by the new frame.
1094 This function is an internal primitive--use `make-frame' instead.  */)
1095      (Lisp_Object parms)
1097   struct frame *f;
1098   Lisp_Object frame, tem;
1099   Lisp_Object name;
1100   int minibuffer_only = 0;
1101   long window_prompting = 0;
1102   int width, height;
1103   ptrdiff_t count = specpdl_ptr - specpdl;
1104   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1105   Lisp_Object display;
1106   struct ns_display_info *dpyinfo = NULL;
1107   Lisp_Object parent;
1108   struct kboard *kb;
1109   static int desc_ctr = 1;
1111   /* x_get_arg modifies parms.  */
1112   parms = Fcopy_alist (parms);
1114   /* Use this general default value to start with
1115      until we know if this frame has a specified name.  */
1116   Vx_resource_name = Vinvocation_name;
1118   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1119   if (EQ (display, Qunbound))
1120     display = Qnil;
1121   dpyinfo = check_ns_display_info (display);
1122   kb = dpyinfo->terminal->kboard;
1124   if (!dpyinfo->terminal->name)
1125     error ("Terminal is not live, can't create new frames on it");
1127   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1128   if (!STRINGP (name)
1129       && ! EQ (name, Qunbound)
1130       && ! NILP (name))
1131     error ("Invalid frame name--not a string or nil");
1133   if (STRINGP (name))
1134     Vx_resource_name = name;
1136   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1137   if (EQ (parent, Qunbound))
1138     parent = Qnil;
1139   if (! NILP (parent))
1140     CHECK_NUMBER (parent);
1142   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1143   /* No need to protect DISPLAY because that's not used after passing
1144      it to make_frame_without_minibuffer.  */
1145   frame = Qnil;
1146   GCPRO4 (parms, parent, name, frame);
1147   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1148                   RES_TYPE_SYMBOL);
1149   if (EQ (tem, Qnone) || NILP (tem))
1150       f = make_frame_without_minibuffer (Qnil, kb, display);
1151   else if (EQ (tem, Qonly))
1152     {
1153       f = make_minibuffer_frame ();
1154       minibuffer_only = 1;
1155     }
1156   else if (WINDOWP (tem))
1157       f = make_frame_without_minibuffer (tem, kb, display);
1158   else
1159       f = make_frame (1);
1161   XSETFRAME (frame, f);
1163   f->terminal = dpyinfo->terminal;
1165   f->output_method = output_ns;
1166   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1168   FRAME_FONTSET (f) = -1;
1170   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1171                                 "iconName", "Title",
1172                                 RES_TYPE_STRING));
1173   if (! STRINGP (f->icon_name))
1174     fset_icon_name (f, Qnil);
1176   FRAME_DISPLAY_INFO (f) = dpyinfo;
1178   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1179   record_unwind_protect (unwind_create_frame, frame);
1181   f->output_data.ns->window_desc = desc_ctr++;
1182   if (TYPE_RANGED_INTEGERP (Window, parent))
1183     {
1184       f->output_data.ns->parent_desc = XFASTINT (parent);
1185       f->output_data.ns->explicit_parent = 1;
1186     }
1187   else
1188     {
1189       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1190       f->output_data.ns->explicit_parent = 0;
1191     }
1193   /* Set the name; the functions to which we pass f expect the name to
1194      be set.  */
1195   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1196     {
1197       fset_name (f, build_string ([ns_app_name UTF8String]));
1198       f->explicit_name = 0;
1199     }
1200   else
1201     {
1202       fset_name (f, name);
1203       f->explicit_name = 1;
1204       specbind (Qx_resource_name, name);
1205     }
1207   block_input ();
1209 #ifdef NS_IMPL_COCOA
1210     mac_register_font_driver (f);
1211 #else
1212     register_font_driver (&nsfont_driver, f);
1213 #endif
1215   x_default_parameter (f, parms, Qfont_backend, Qnil,
1216                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1218   {
1219     /* use for default font name */
1220     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1221     x_default_parameter (f, parms, Qfontsize,
1222                                     make_number (0 /*(int)[font pointSize]*/),
1223                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1224     // Remove ' Regular', not handled by backends.
1225     char *fontname = xstrdup ([[font displayName] UTF8String]);
1226     int len = strlen (fontname);
1227     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1228       fontname[len-8] = '\0';
1229     x_default_parameter (f, parms, Qfont,
1230                                  build_string (fontname),
1231                                  "font", "Font", RES_TYPE_STRING);
1232     xfree (fontname);
1233   }
1234   unblock_input ();
1236   x_default_parameter (f, parms, Qborder_width, make_number (0),
1237                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1238   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1239                       "internalBorderWidth", "InternalBorderWidth",
1240                       RES_TYPE_NUMBER);
1242   /* default vertical scrollbars on right on Mac */
1243   {
1244       Lisp_Object spos
1245 #ifdef NS_IMPL_GNUSTEP
1246           = Qt;
1247 #else
1248           = Qright;
1249 #endif
1250       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1251                            "verticalScrollBars", "VerticalScrollBars",
1252                            RES_TYPE_SYMBOL);
1253   }
1254   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil,
1255                        "horizontalScrollBars", "HorizontalScrollBars",
1256                        RES_TYPE_SYMBOL);
1257   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1258                       "foreground", "Foreground", RES_TYPE_STRING);
1259   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1260                       "background", "Background", RES_TYPE_STRING);
1261   /* FIXME: not supported yet in Nextstep */
1262   x_default_parameter (f, parms, Qline_spacing, Qnil,
1263                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1264   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1265                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1266   x_default_parameter (f, parms, Qright_fringe, Qnil,
1267                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1269 #ifdef GLYPH_DEBUG
1270   image_cache_refcount =
1271     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1272 #endif
1274   init_frame_faces (f);
1276   /* Read comment about this code in corresponding place in xfns.c.  */
1277   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1278                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1);
1280   /* The resources controlling the menu-bar and tool-bar are
1281      processed specially at startup, and reflected in the mode
1282      variables; ignore them here.  */
1283   x_default_parameter (f, parms, Qmenu_bar_lines,
1284                        NILP (Vmenu_bar_mode)
1285                        ? make_number (0) : make_number (1),
1286                        NULL, NULL, RES_TYPE_NUMBER);
1287   x_default_parameter (f, parms, Qtool_bar_lines,
1288                        NILP (Vtool_bar_mode)
1289                        ? make_number (0) : make_number (1),
1290                        NULL, NULL, RES_TYPE_NUMBER);
1292   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1293                        "BufferPredicate", RES_TYPE_SYMBOL);
1294   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1295                        RES_TYPE_STRING);
1297   parms = get_geometry_from_preferences (dpyinfo, parms);
1298   window_prompting = x_figure_window_size (f, parms, 1);
1300   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1301   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1303   /* NOTE: on other terms, this is done in set_mouse_color, however this
1304      was not getting called under Nextstep */
1305   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1306   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1307   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1308   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1309   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1310   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1311   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1312   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1313      = [NSCursor arrowCursor];
1314   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1315      = [NSCursor arrowCursor];
1316   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1318   [[EmacsView alloc] initFrameFromEmacs: f];
1320   x_icon (f, parms);
1322   /* ns_display_info does not have a reference_count.  */
1323   f->terminal->reference_count++;
1325   /* It is now ok to make the frame official even if we get an error below.
1326      The frame needs to be on Vframe_list or making it visible won't work. */
1327   Vframe_list = Fcons (frame, Vframe_list);
1329   x_default_parameter (f, parms, Qicon_type, Qnil,
1330                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1332   x_default_parameter (f, parms, Qauto_raise, Qnil,
1333                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1334   x_default_parameter (f, parms, Qauto_lower, Qnil,
1335                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1336   x_default_parameter (f, parms, Qcursor_type, Qbox,
1337                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1338   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1339                        "scrollBarWidth", "ScrollBarWidth",
1340                        RES_TYPE_NUMBER);
1341   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1342                        "scrollBarHeight", "ScrollBarHeight",
1343                        RES_TYPE_NUMBER);
1344   x_default_parameter (f, parms, Qalpha, Qnil,
1345                        "alpha", "Alpha", RES_TYPE_NUMBER);
1346   x_default_parameter (f, parms, Qfullscreen, Qnil,
1347                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1349   /* Consider frame official, now.  */
1350   f->official = true;
1352   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1);
1354   if (! f->output_data.ns->explicit_parent)
1355     {
1356       Lisp_Object visibility;
1358       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1359                               RES_TYPE_SYMBOL);
1360       if (EQ (visibility, Qunbound))
1361         visibility = Qt;
1363       if (EQ (visibility, Qicon))
1364         x_iconify_frame (f);
1365       else if (! NILP (visibility))
1366         {
1367           x_make_frame_visible (f);
1368           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1369         }
1370       else
1371         {
1372           /* Must have been Qnil.  */
1373         }
1374     }
1376   if (FRAME_HAS_MINIBUF_P (f)
1377       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1378           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1379     kset_default_minibuffer_frame (kb, frame);
1381   /* All remaining specified parameters, which have not been "used"
1382      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1383   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1384     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1385       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1387   UNGCPRO;
1389   if (window_prompting & USPosition)
1390     x_set_offset (f, f->left_pos, f->top_pos, 1);
1392   /* Make sure windows on this frame appear in calls to next-window
1393      and similar functions.  */
1394   Vwindow_list = Qnil;
1396   return unbind_to (count, frame);
1399 void
1400 x_focus_frame (struct frame *f)
1402   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1404   if (dpyinfo->x_focus_frame != f)
1405     {
1406       EmacsView *view = FRAME_NS_VIEW (f);
1407       block_input ();
1408       [NSApp activateIgnoringOtherApps: YES];
1409       [[view window] makeKeyAndOrderFront: view];
1410       unblock_input ();
1411     }
1415 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1416        0, 1, "",
1417        doc: /* Pop up the font panel. */)
1418      (Lisp_Object frame)
1420   struct frame *f = decode_window_system_frame (frame);
1421   id fm = [NSFontManager sharedFontManager];
1422   struct font *font = f->output_data.ns->font;
1423   NSFont *nsfont;
1424 #ifdef NS_IMPL_GNUSTEP
1425   nsfont = ((struct nsfont_info *)font)->nsfont;
1426 #endif
1427 #ifdef NS_IMPL_COCOA
1428   nsfont = (NSFont *) macfont_get_nsctfont (font);
1429 #endif
1430   [fm setSelectedFont: nsfont isMultiple: NO];
1431   [fm orderFrontFontPanel: NSApp];
1432   return Qnil;
1436 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1437        0, 1, "",
1438        doc: /* Pop up the color panel.  */)
1439      (Lisp_Object frame)
1441   check_window_system (NULL);
1442   [NSApp orderFrontColorPanel: NSApp];
1443   return Qnil;
1446 static struct
1448   id panel;
1449   BOOL ret;
1450 #ifdef NS_IMPL_GNUSTEP
1451   NSString *dirS, *initS;
1452   BOOL no_types;
1453 #endif
1454 } ns_fd_data;
1456 void
1457 ns_run_file_dialog (void)
1459   if (ns_fd_data.panel == nil) return;
1460 #ifdef NS_IMPL_COCOA
1461   ns_fd_data.ret = [ns_fd_data.panel runModal];
1462 #else
1463   if (ns_fd_data.no_types)
1464     {
1465       ns_fd_data.ret = [ns_fd_data.panel
1466                            runModalForDirectory: ns_fd_data.dirS
1467                            file: ns_fd_data.initS];
1468     }
1469   else
1470     {
1471       ns_fd_data.ret = [ns_fd_data.panel
1472                            runModalForDirectory: ns_fd_data.dirS
1473                            file: ns_fd_data.initS
1474                            types: nil];
1475     }
1476 #endif
1477   ns_fd_data.panel = nil;
1480 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1481        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1482 Optional arg DIR, if non-nil, supplies a default directory.
1483 Optional arg MUSTMATCH, if non-nil, means the returned file or
1484 directory must exist.
1485 Optional arg INIT, if non-nil, provides a default file name to use.
1486 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1487   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1488    Lisp_Object init, Lisp_Object dir_only_p)
1490   static id fileDelegate = nil;
1491   BOOL ret;
1492   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1493   id panel;
1494   Lisp_Object fname;
1496   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1497     [NSString stringWithUTF8String: SSDATA (prompt)];
1498   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1499     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1500     [NSString stringWithUTF8String: SSDATA (dir)];
1501   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1502     [NSString stringWithUTF8String: SSDATA (init)];
1503   NSEvent *nxev;
1505   check_window_system (NULL);
1507   if (fileDelegate == nil)
1508     fileDelegate = [EmacsFileDelegate new];
1510   [NSCursor setHiddenUntilMouseMoves: NO];
1512   if ([dirS characterAtIndex: 0] == '~')
1513     dirS = [dirS stringByExpandingTildeInPath];
1515   panel = isSave ?
1516     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1518   [panel setTitle: promptS];
1520   [panel setAllowsOtherFileTypes: YES];
1521   [panel setTreatsFilePackagesAsDirectories: YES];
1522   [panel setDelegate: fileDelegate];
1524   if (! NILP (dir_only_p))
1525     {
1526       [panel setCanChooseDirectories: YES];
1527       [panel setCanChooseFiles: NO];
1528     }
1529   else if (! isSave)
1530     {
1531       /* This is not quite what the documentation says, but it is compatible
1532          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1533       [panel setCanChooseDirectories: NO];
1534       [panel setCanChooseFiles: YES];
1535     }
1537   block_input ();
1538   ns_fd_data.panel = panel;
1539   ns_fd_data.ret = NO;
1540 #ifdef NS_IMPL_COCOA
1541   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1542     [panel setAllowedFileTypes: nil];
1543   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1544   if (initS && NILP (Ffile_directory_p (init)))
1545     [panel setNameFieldStringValue: [initS lastPathComponent]];
1546   else
1547     [panel setNameFieldStringValue: @""];
1549 #else
1550   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1551   ns_fd_data.dirS = dirS;
1552   ns_fd_data.initS = initS;
1553 #endif
1555   /* runModalForDirectory/runModal restarts the main event loop when done,
1556      so we must start an event loop and then pop up the file dialog.
1557      The file dialog may pop up a confirm dialog after Ok has been pressed,
1558      so we can not simply pop down on the Ok/Cancel press.
1559    */
1560   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1561                             location: NSMakePoint (0, 0)
1562                        modifierFlags: 0
1563                            timestamp: 0
1564                         windowNumber: [[NSApp mainWindow] windowNumber]
1565                              context: [NSApp context]
1566                              subtype: 0
1567                                data1: 0
1568                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1570   [NSApp postEvent: nxev atStart: NO];
1571   while (ns_fd_data.panel != nil)
1572     [NSApp run];
1574   ret = (ns_fd_data.ret == NSOKButton);
1576   if (ret)
1577     {
1578       NSString *str = ns_filename_from_panel (panel);
1579       if (! str) str = ns_directory_from_panel (panel);
1580       if (! str) ret = NO;
1581       else fname = build_string ([str UTF8String]);
1582     }
1584   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1585   unblock_input ();
1587   return ret ? fname : Qnil;
1590 const char *
1591 ns_get_defaults_value (const char *key)
1593   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1594                     objectForKey: [NSString stringWithUTF8String: key]];
1596   if (!obj) return NULL;
1598   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1602 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1603        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1604 If OWNER is nil, Emacs is assumed.  */)
1605      (Lisp_Object owner, Lisp_Object name)
1607   const char *value;
1609   check_window_system (NULL);
1610   if (NILP (owner))
1611     owner = build_string([ns_app_name UTF8String]);
1612   CHECK_STRING (name);
1614   value = ns_get_defaults_value (SSDATA (name));
1616   if (value)
1617     return build_string (value);
1618   return Qnil;
1622 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1623        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1624 If OWNER is nil, Emacs is assumed.
1625 If VALUE is nil, the default is removed.  */)
1626      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1628   check_window_system (NULL);
1629   if (NILP (owner))
1630     owner = build_string ([ns_app_name UTF8String]);
1631   CHECK_STRING (name);
1632   if (NILP (value))
1633     {
1634       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1635                          [NSString stringWithUTF8String: SSDATA (name)]];
1636     }
1637   else
1638     {
1639       CHECK_STRING (value);
1640       [[NSUserDefaults standardUserDefaults] setObject:
1641                 [NSString stringWithUTF8String: SSDATA (value)]
1642                                         forKey: [NSString stringWithUTF8String:
1643                                                          SSDATA (name)]];
1644     }
1646   return Qnil;
1650 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1651        Sx_server_max_request_size,
1652        0, 1, 0,
1653        doc: /* This function is a no-op.  It is only present for completeness.  */)
1654      (Lisp_Object terminal)
1656   check_ns_display_info (terminal);
1657   /* This function has no real equivalent under NeXTstep.  Return nil to
1658      indicate this. */
1659   return Qnil;
1663 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1664        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1665 \(Labeling every distributor as a "vendor" embodies the false assumption
1666 that operating systems cannot be developed and distributed noncommercially.)
1667 The optional argument TERMINAL specifies which display to ask about.
1668 TERMINAL should be a terminal object, a frame or a display name (a string).
1669 If omitted or nil, that stands for the selected frame's display.  */)
1670   (Lisp_Object terminal)
1672   check_ns_display_info (terminal);
1673 #ifdef NS_IMPL_GNUSTEP
1674   return build_string ("GNU");
1675 #else
1676   return build_string ("Apple");
1677 #endif
1681 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1682        doc: /* Return the version numbers of the server of display TERMINAL.
1683 The value is a list of three integers: the major and minor
1684 version numbers of the X Protocol in use, and the distributor-specific release
1685 number.  See also the function `x-server-vendor'.
1687 The optional argument TERMINAL specifies which display to ask about.
1688 TERMINAL should be a terminal object, a frame or a display name (a string).
1689 If omitted or nil, that stands for the selected frame's display.  */)
1690   (Lisp_Object terminal)
1692   check_ns_display_info (terminal);
1693   /*NOTE: it is unclear what would best correspond with "protocol";
1694           we return 10.3, meaning Panther, since this is roughly the
1695           level that GNUstep's APIs correspond to.
1696           The last number is where we distinguish between the Apple
1697           and GNUstep implementations ("distributor-specific release
1698           number") and give int'ized versions of major.minor. */
1699   return list3i (10, 3, ns_appkit_version_int ());
1703 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1704        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1705 The optional argument TERMINAL specifies which display to ask about.
1706 TERMINAL should be a terminal object, a frame or a display name (a string).
1707 If omitted or nil, that stands for the selected frame's display.
1709 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1710 the number of physical monitors, use `(length
1711 (display-monitor-attributes-list TERMINAL))' instead.  */)
1712   (Lisp_Object terminal)
1714   check_ns_display_info (terminal);
1715   return make_number (1);
1719 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1720        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1721 The optional argument TERMINAL specifies which display to ask about.
1722 TERMINAL should be a terminal object, a frame or a display name (a string).
1723 If omitted or nil, that stands for the selected frame's display.
1725 On \"multi-monitor\" setups this refers to the height in millimeters for
1726 all physical monitors associated with TERMINAL.  To get information
1727 for each physical monitor, use `display-monitor-attributes-list'.  */)
1728   (Lisp_Object terminal)
1730   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1732   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1736 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1737        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1738 The optional argument TERMINAL specifies which display to ask about.
1739 TERMINAL should be a terminal object, a frame or a display name (a string).
1740 If omitted or nil, that stands for the selected frame's display.
1742 On \"multi-monitor\" setups this refers to the width in millimeters for
1743 all physical monitors associated with TERMINAL.  To get information
1744 for each physical monitor, use `display-monitor-attributes-list'.  */)
1745   (Lisp_Object terminal)
1747   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1749   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1753 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1754        Sx_display_backing_store, 0, 1, 0,
1755        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1756 The value may be `buffered', `retained', or `non-retained'.
1757 The optional argument TERMINAL specifies which display to ask about.
1758 TERMINAL should be a terminal object, a frame or a display name (a string).
1759 If omitted or nil, that stands for the selected frame's display.  */)
1760   (Lisp_Object terminal)
1762   check_ns_display_info (terminal);
1763   switch ([ns_get_window (terminal) backingType])
1764     {
1765     case NSBackingStoreBuffered:
1766       return intern ("buffered");
1767     case NSBackingStoreRetained:
1768       return intern ("retained");
1769     case NSBackingStoreNonretained:
1770       return intern ("non-retained");
1771     default:
1772       error ("Strange value for backingType parameter of frame");
1773     }
1774   return Qnil;  /* not reached, shut compiler up */
1778 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1779        Sx_display_visual_class, 0, 1, 0,
1780        doc: /* Return the visual class of the Nextstep display TERMINAL.
1781 The value is one of the symbols `static-gray', `gray-scale',
1782 `static-color', `pseudo-color', `true-color', or `direct-color'.
1784 The optional argument TERMINAL specifies which display to ask about.
1785 TERMINAL should a terminal object, a frame or a display name (a string).
1786 If omitted or nil, that stands for the selected frame's display.  */)
1787   (Lisp_Object terminal)
1789   NSWindowDepth depth;
1791   check_ns_display_info (terminal);
1792   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1794   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1795     return intern ("static-gray");
1796   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1797     return intern ("gray-scale");
1798   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1799     return intern ("pseudo-color");
1800   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1801     return intern ("true-color");
1802   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1803     return intern ("direct-color");
1804   else
1805     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1806     return intern ("direct-color");
1810 DEFUN ("x-display-save-under", Fx_display_save_under,
1811        Sx_display_save_under, 0, 1, 0,
1812        doc: /* Return t if TERMINAL supports the save-under feature.
1813 The optional argument TERMINAL specifies which display to ask about.
1814 TERMINAL should be a terminal object, a frame or a display name (a string).
1815 If omitted or nil, that stands for the selected frame's display.  */)
1816   (Lisp_Object terminal)
1818   check_ns_display_info (terminal);
1819   switch ([ns_get_window (terminal) backingType])
1820     {
1821     case NSBackingStoreBuffered:
1822       return Qt;
1824     case NSBackingStoreRetained:
1825     case NSBackingStoreNonretained:
1826       return Qnil;
1828     default:
1829       error ("Strange value for backingType parameter of frame");
1830     }
1831   return Qnil;  /* not reached, shut compiler up */
1835 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1836        1, 3, 0,
1837        doc: /* Open a connection to a display server.
1838 DISPLAY is the name of the display to connect to.
1839 Optional second arg XRM-STRING is a string of resources in xrdb format.
1840 If the optional third arg MUST-SUCCEED is non-nil,
1841 terminate Emacs if we can't open the connection.
1842 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1843      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1845   struct ns_display_info *dpyinfo;
1847   CHECK_STRING (display);
1849   nxatoms_of_nsselect ();
1850   dpyinfo = ns_term_init (display);
1851   if (dpyinfo == 0)
1852     {
1853       if (!NILP (must_succeed))
1854         fatal ("Display on %s not responding.\n",
1855                SSDATA (display));
1856       else
1857         error ("Display on %s not responding.\n",
1858                SSDATA (display));
1859     }
1861   return Qnil;
1865 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1866        1, 1, 0,
1867        doc: /* Close the connection to TERMINAL's Nextstep display server.
1868 For TERMINAL, specify a terminal object, a frame or a display name (a
1869 string).  If TERMINAL is nil, that stands for the selected frame's
1870 terminal.  */)
1871      (Lisp_Object terminal)
1873   check_ns_display_info (terminal);
1874   [NSApp terminate: NSApp];
1875   return Qnil;
1879 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1880        doc: /* Return the list of display names that Emacs has connections to.  */)
1881      (void)
1883   Lisp_Object result = Qnil;
1884   struct ns_display_info *ndi;
1886   for (ndi = x_display_list; ndi; ndi = ndi->next)
1887     result = Fcons (XCAR (ndi->name_list_element), result);
1889   return result;
1893 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1894        0, 0, 0,
1895        doc: /* Hides all applications other than Emacs.  */)
1896      (void)
1898   check_window_system (NULL);
1899   [NSApp hideOtherApplications: NSApp];
1900   return Qnil;
1903 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1904        1, 1, 0,
1905        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1906 Otherwise if Emacs is hidden, it is unhidden.
1907 If ON is equal to `activate', Emacs is unhidden and becomes
1908 the active application.  */)
1909      (Lisp_Object on)
1911   check_window_system (NULL);
1912   if (EQ (on, intern ("activate")))
1913     {
1914       [NSApp unhide: NSApp];
1915       [NSApp activateIgnoringOtherApps: YES];
1916     }
1917   else if (NILP (on))
1918     [NSApp unhide: NSApp];
1919   else
1920     [NSApp hide: NSApp];
1921   return Qnil;
1925 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1926        0, 0, 0,
1927        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1928      (void)
1930   check_window_system (NULL);
1931   [NSApp orderFrontStandardAboutPanel: nil];
1932   return Qnil;
1936 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1937        doc: /* Determine font PostScript or family name for font NAME.
1938 NAME should be a string containing either the font name or an XLFD
1939 font descriptor.  If string contains `fontset' and not
1940 `fontset-startup', it is left alone. */)
1941      (Lisp_Object name)
1943   char *nm;
1944   CHECK_STRING (name);
1945   nm = SSDATA (name);
1947   if (nm[0] != '-')
1948     return name;
1949   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1950     return name;
1952   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1956 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1957        doc: /* Return a list of all available colors.
1958 The optional argument FRAME is currently ignored.  */)
1959      (Lisp_Object frame)
1961   Lisp_Object list = Qnil;
1962   NSEnumerator *colorlists;
1963   NSColorList *clist;
1965   if (!NILP (frame))
1966     {
1967       CHECK_FRAME (frame);
1968       if (! FRAME_NS_P (XFRAME (frame)))
1969         error ("non-Nextstep frame used in `ns-list-colors'");
1970     }
1972   block_input ();
1974   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1975   while ((clist = [colorlists nextObject]))
1976     {
1977       if ([[clist name] length] < 7 ||
1978           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1979         {
1980           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1981           NSString *cname;
1982           while ((cname = [cnames nextObject]))
1983             list = Fcons (build_string ([cname UTF8String]), list);
1984 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1985                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1986                                              UTF8String]), list); */
1987         }
1988     }
1990   unblock_input ();
1992   return list;
1996 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1997        doc: /* List available Nextstep services by querying NSApp.  */)
1998      (void)
2000 #ifdef NS_IMPL_COCOA
2001   /* You can't get services like this in 10.6+.  */
2002   return Qnil;
2003 #else
2004   Lisp_Object ret = Qnil;
2005   NSMenu *svcs;
2006 #ifdef NS_IMPL_COCOA
2007   id delegate;
2008 #endif
2010   check_window_system (NULL);
2011   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
2012   [NSApp setServicesMenu: svcs];
2013   [NSApp registerServicesMenuSendTypes: ns_send_types
2014                            returnTypes: ns_return_types];
2016 /* On Tiger, services menu updating was made lazier (waits for user to
2017    actually click on the menu), so we have to force things along: */
2018 #ifdef NS_IMPL_COCOA
2019   delegate = [svcs delegate];
2020   if (delegate != nil)
2021     {
2022       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2023         [delegate menuNeedsUpdate: svcs];
2024       if ([delegate respondsToSelector:
2025                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2026         {
2027           int i, len = [delegate numberOfItemsInMenu: svcs];
2028           for (i =0; i<len; i++)
2029             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2030           for (i =0; i<len; i++)
2031             if (![delegate menu: svcs
2032                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2033                         atIndex: i shouldCancel: NO])
2034               break;
2035         }
2036     }
2037 #endif
2039   [svcs setAutoenablesItems: NO];
2040 #ifdef NS_IMPL_COCOA
2041   [svcs update]; /* on OS X, converts from '/' structure */
2042 #endif
2044   ret = interpret_services_menu (svcs, Qnil, ret);
2045   return ret;
2046 #endif
2050 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2051        2, 2, 0,
2052        doc: /* Perform Nextstep SERVICE on SEND.
2053 SEND should be either a string or nil.
2054 The return value is the result of the service, as string, or nil if
2055 there was no result.  */)
2056      (Lisp_Object service, Lisp_Object send)
2058   id pb;
2059   NSString *svcName;
2060   char *utfStr;
2062   CHECK_STRING (service);
2063   check_window_system (NULL);
2065   utfStr = SSDATA (service);
2066   svcName = [NSString stringWithUTF8String: utfStr];
2068   pb =[NSPasteboard pasteboardWithUniqueName];
2069   ns_string_to_pasteboard (pb, send);
2071   if (NSPerformService (svcName, pb) == NO)
2072     Fsignal (Qquit, list1 (build_string ("service not available")));
2074   if ([[pb types] count] == 0)
2075     return build_string ("");
2076   return ns_string_from_pasteboard (pb);
2080 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2081        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2082        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2083      (Lisp_Object str)
2085 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2086          remove this. */
2087   NSString *utfStr;
2088   Lisp_Object ret = Qnil;
2089   NSAutoreleasePool *pool;
2091   CHECK_STRING (str);
2092   pool = [[NSAutoreleasePool alloc] init];
2093   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2094 #ifdef NS_IMPL_COCOA
2095   if (utfStr)
2096     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2097 #endif
2098   if (utfStr)
2099     {
2100       const char *cstr = [utfStr UTF8String];
2101       if (cstr)
2102         ret = build_string (cstr);
2103     }
2105   [pool release];
2106   if (NILP (ret))
2107     error ("Invalid UTF-8");
2109   return ret;
2113 #ifdef NS_IMPL_COCOA
2115 /* Compile and execute the AppleScript SCRIPT and return the error
2116    status as function value.  A zero is returned if compilation and
2117    execution is successful, in which case *RESULT is set to a Lisp
2118    string or a number containing the resulting script value.  Otherwise,
2119    1 is returned. */
2120 static int
2121 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2123   NSAppleEventDescriptor *desc;
2124   NSDictionary* errorDict;
2125   NSAppleEventDescriptor* returnDescriptor = NULL;
2127   NSAppleScript* scriptObject =
2128     [[NSAppleScript alloc] initWithSource:
2129                              [NSString stringWithUTF8String: SSDATA (script)]];
2131   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2132   [scriptObject release];
2133   *result = Qnil;
2135   if (returnDescriptor != NULL)
2136     {
2137       // successful execution
2138       if (kAENullEvent != [returnDescriptor descriptorType])
2139         {
2140           *result = Qt;
2141           // script returned an AppleScript result
2142           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2143 #if defined (NS_IMPL_COCOA)
2144               (typeUTF16ExternalRepresentation
2145                == [returnDescriptor descriptorType]) ||
2146 #endif
2147               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2148               (typeCString == [returnDescriptor descriptorType]))
2149             {
2150               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2151               if (desc)
2152                 *result = build_string([[desc stringValue] UTF8String]);
2153             }
2154           else
2155             {
2156               /* use typeUTF16ExternalRepresentation? */
2157               // coerce the result to the appropriate ObjC type
2158               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2159               if (desc)
2160                 *result = make_number([desc int32Value]);
2161             }
2162         }
2163     }
2164   else
2165     {
2166       // no script result, return error
2167       return 1;
2168     }
2169   return 0;
2172 /* Helper function called from sendEvent to run applescript
2173    from within the main event loop.  */
2175 void
2176 ns_run_ascript (void)
2178   if (! NILP (as_script))
2179     as_status = ns_do_applescript (as_script, as_result);
2180   as_script = Qnil;
2183 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2184        doc: /* Execute AppleScript SCRIPT and return the result.
2185 If compilation and execution are successful, the resulting script value
2186 is returned as a string, a number or, in the case of other constructs, t.
2187 In case the execution fails, an error is signaled. */)
2188      (Lisp_Object script)
2190   Lisp_Object result;
2191   int status;
2192   NSEvent *nxev;
2193   struct input_event ev;
2195   CHECK_STRING (script);
2196   check_window_system (NULL);
2198   block_input ();
2200   as_script = script;
2201   as_result = &result;
2203   /* executing apple script requires the event loop to run, otherwise
2204      errors aren't returned and executeAndReturnError hangs forever.
2205      Post an event that runs applescript and then start the event loop.
2206      The event loop is exited when the script is done.  */
2207   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2208                             location: NSMakePoint (0, 0)
2209                        modifierFlags: 0
2210                            timestamp: 0
2211                         windowNumber: [[NSApp mainWindow] windowNumber]
2212                              context: [NSApp context]
2213                              subtype: 0
2214                                data1: 0
2215                                data2: NSAPP_DATA2_RUNASSCRIPT];
2217   [NSApp postEvent: nxev atStart: NO];
2219   // If there are other events, the event loop may exit.  Keep running
2220   // until the script has been handled.  */
2221   ns_init_events (&ev);
2222   while (! NILP (as_script))
2223     [NSApp run];
2224   ns_finish_events ();
2226   status = as_status;
2227   as_status = 0;
2228   as_result = 0;
2229   unblock_input ();
2230   if (status == 0)
2231     return result;
2232   else if (!STRINGP (result))
2233     error ("AppleScript error %d", status);
2234   else
2235     error ("%s", SSDATA (result));
2237 #endif
2241 /* ==========================================================================
2243     Miscellaneous functions not called through hooks
2245    ========================================================================== */
2247 /* called from frame.c */
2248 struct ns_display_info *
2249 check_x_display_info (Lisp_Object frame)
2251   return check_ns_display_info (frame);
2255 void
2256 x_set_scroll_bar_default_width (struct frame *f)
2258   int wid = FRAME_COLUMN_WIDTH (f);
2259   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2260   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2261                                       wid - 1) / wid;
2264 void
2265 x_set_scroll_bar_default_height (struct frame *f)
2267   int height = FRAME_LINE_HEIGHT (f);
2268   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2269   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2270                                        height - 1) / height;
2273 /* terms impl this instead of x-get-resource directly */
2274 char *
2275 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2277   /* remove appname prefix; TODO: allow for !="Emacs" */
2278   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2280   check_window_system (NULL);
2282   if (inhibit_x_resources)
2283     /* --quick was passed, so this is a no-op.  */
2284     return NULL;
2286   res = ns_get_defaults_value (toCheck);
2287   return (!res ? NULL :
2288           (!c_strncasecmp (res, "YES", 3) ? "true" :
2289            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2293 Lisp_Object
2294 x_get_focus_frame (struct frame *frame)
2296   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2297   Lisp_Object nsfocus;
2299   if (!dpyinfo->x_focus_frame)
2300     return Qnil;
2302   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2303   return nsfocus;
2306 /* ==========================================================================
2308     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2310    ========================================================================== */
2313 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2314        doc: /* Internal function called by `color-defined-p', which see.
2315 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2316      (Lisp_Object color, Lisp_Object frame)
2318   NSColor * col;
2319   check_window_system (NULL);
2320   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2324 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2325        doc: /* Internal function called by `color-values', which see.  */)
2326      (Lisp_Object color, Lisp_Object frame)
2328   NSColor * col;
2329   EmacsCGFloat red, green, blue, alpha;
2331   check_window_system (NULL);
2332   CHECK_STRING (color);
2334   if (ns_lisp_to_color (color, &col))
2335     return Qnil;
2337   [[col colorUsingDefaultColorSpace]
2338         getRed: &red green: &green blue: &blue alpha: &alpha];
2339   return list3i (lrint (red * 65280), lrint (green * 65280),
2340                  lrint (blue * 65280));
2344 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2345        doc: /* Internal function called by `display-color-p', which see.  */)
2346      (Lisp_Object terminal)
2348   NSWindowDepth depth;
2349   NSString *colorSpace;
2351   check_ns_display_info (terminal);
2352   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2353   colorSpace = NSColorSpaceFromDepth (depth);
2355   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2356          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2357       ? Qnil : Qt;
2361 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2362        0, 1, 0,
2363        doc: /* Return t if the Nextstep display supports shades of gray.
2364 Note that color displays do support shades of gray.
2365 The optional argument TERMINAL specifies which display to ask about.
2366 TERMINAL should be a terminal object, a frame or a display name (a string).
2367 If omitted or nil, that stands for the selected frame's display.  */)
2368   (Lisp_Object terminal)
2370   NSWindowDepth depth;
2372   check_ns_display_info (terminal);
2373   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2375   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2379 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2380        0, 1, 0,
2381        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2382 The optional argument TERMINAL specifies which display to ask about.
2383 TERMINAL should be a terminal object, a frame or a display name (a string).
2384 If omitted or nil, that stands for the selected frame's display.
2386 On \"multi-monitor\" setups this refers to the pixel width for all
2387 physical monitors associated with TERMINAL.  To get information for
2388 each physical monitor, use `display-monitor-attributes-list'.  */)
2389   (Lisp_Object terminal)
2391   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2393   return make_number (x_display_pixel_width (dpyinfo));
2397 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2398        Sx_display_pixel_height, 0, 1, 0,
2399        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2400 The optional argument TERMINAL specifies which display to ask about.
2401 TERMINAL should be a terminal object, a frame or a display name (a string).
2402 If omitted or nil, that stands for the selected frame's display.
2404 On \"multi-monitor\" setups this refers to the pixel height for all
2405 physical monitors associated with TERMINAL.  To get information for
2406 each physical monitor, use `display-monitor-attributes-list'.  */)
2407   (Lisp_Object terminal)
2409   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2411   return make_number (x_display_pixel_height (dpyinfo));
2414 #ifdef NS_IMPL_COCOA
2416 /* Returns the name for the screen that OBJ represents, or NULL.
2417    Caller must free return value.
2420 static char *
2421 ns_get_name_from_ioreg (io_object_t obj)
2423   char *name = NULL;
2425   NSDictionary *info = (NSDictionary *)
2426     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2427   NSDictionary *names = [info objectForKey:
2428                                 [NSString stringWithUTF8String:
2429                                             kDisplayProductName]];
2431   if ([names count] > 0)
2432     {
2433       NSString *n = [names objectForKey: [[names allKeys]
2434                                                  objectAtIndex:0]];
2435       if (n != nil) name = xstrdup ([n UTF8String]);
2436     }
2438   [info release];
2440   return name;
2443 /* Returns the name for the screen that DID came from, or NULL.
2444    Caller must free return value.
2447 static char *
2448 ns_screen_name (CGDirectDisplayID did)
2450   char *name = NULL;
2452 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2453   mach_port_t masterPort;
2454   io_iterator_t it;
2455   io_object_t obj;
2457   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2459   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2460       || IOServiceGetMatchingServices (masterPort,
2461                                        IOServiceMatching ("IONDRVDevice"),
2462                                        &it) != kIOReturnSuccess)
2463     return name;
2465   /* Must loop until we find a name.  Many devices can have the same unit
2466      number (represents different GPU parts), but only one has a name.  */
2467   while (! name && (obj = IOIteratorNext (it)))
2468     {
2469       CFMutableDictionaryRef props;
2470       const void *val;
2472       if (IORegistryEntryCreateCFProperties (obj,
2473                                              &props,
2474                                              kCFAllocatorDefault,
2475                                              kNilOptions) == kIOReturnSuccess
2476           && props != nil
2477           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2478         {
2479           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2480           if (nr == CGDisplayUnitNumber (did))
2481             name = ns_get_name_from_ioreg (obj);
2482         }
2484       CFRelease (props);
2485       IOObjectRelease (obj);
2486     }
2488   IOObjectRelease (it);
2490 #else
2492   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2494 #endif
2495   return name;
2497 #endif
2499 static Lisp_Object
2500 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2501                                 int n_monitors,
2502                                 int primary_monitor,
2503                                 const char *source)
2505   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2506   Lisp_Object frame, rest;
2507   NSArray *screens = [NSScreen screens];
2508   int i;
2510   FOR_EACH_FRAME (rest, frame)
2511     {
2512       struct frame *f = XFRAME (frame);
2514       if (FRAME_NS_P (f))
2515         {
2516           NSView *view = FRAME_NS_VIEW (f);
2517           NSScreen *screen = [[view window] screen];
2518           NSUInteger k;
2520           i = -1;
2521           for (k = 0; i == -1 && k < [screens count]; ++k)
2522             {
2523               if ([screens objectAtIndex: k] == screen)
2524                 i = (int)k;
2525             }
2527           if (i > -1)
2528             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2529         }
2530     }
2532   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2533                                       monitor_frames, source);
2536 DEFUN ("ns-display-monitor-attributes-list",
2537        Fns_display_monitor_attributes_list,
2538        Sns_display_monitor_attributes_list,
2539        0, 1, 0,
2540        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2542 The optional argument TERMINAL specifies which display to ask about.
2543 TERMINAL should be a terminal object, a frame or a display name (a string).
2544 If omitted or nil, that stands for the selected frame's display.
2546 In addition to the standard attribute keys listed in
2547 `display-monitor-attributes-list', the following keys are contained in
2548 the attributes:
2550  source -- String describing the source from which multi-monitor
2551            information is obtained, \"NS\" is always the source."
2553 Internal use only, use `display-monitor-attributes-list' instead.  */)
2554   (Lisp_Object terminal)
2556   struct terminal *term = decode_live_terminal (terminal);
2557   NSArray *screens;
2558   NSUInteger i, n_monitors;
2559   struct MonitorInfo *monitors;
2560   Lisp_Object attributes_list = Qnil;
2561   CGFloat primary_display_height = 0;
2563   if (term->type != output_ns)
2564     return Qnil;
2566   screens = [NSScreen screens];
2567   n_monitors = [screens count];
2568   if (n_monitors == 0)
2569     return Qnil;
2571   monitors = xzalloc (n_monitors * sizeof *monitors);
2573   for (i = 0; i < [screens count]; ++i)
2574     {
2575       NSScreen *s = [screens objectAtIndex:i];
2576       struct MonitorInfo *m = &monitors[i];
2577       NSRect fr = [s frame];
2578       NSRect vfr = [s visibleFrame];
2579       short y, vy;
2581 #ifdef NS_IMPL_COCOA
2582       NSDictionary *dict = [s deviceDescription];
2583       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2584       CGDirectDisplayID did = [nid unsignedIntValue];
2585 #endif
2586       if (i == 0)
2587         {
2588           primary_display_height = fr.size.height;
2589           y = (short) fr.origin.y;
2590           vy = (short) vfr.origin.y;
2591         }
2592       else
2593         {
2594           // Flip y coordinate as NS has y starting from the bottom.
2595           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2596           vy = (short) (primary_display_height -
2597                         vfr.size.height - vfr.origin.y);
2598         }
2600       m->geom.x = (short) fr.origin.x;
2601       m->geom.y = y;
2602       m->geom.width = (unsigned short) fr.size.width;
2603       m->geom.height = (unsigned short) fr.size.height;
2605       m->work.x = (short) vfr.origin.x;
2606       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2607       // and fr.size.height - vfr.size.height are pixels missing in total.
2608       // Pixels missing at top are
2609       // fr.size.height - vfr.size.height - vy + y.
2610       // work.y is then pixels missing at top + y.
2611       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2612       m->work.width = (unsigned short) vfr.size.width;
2613       m->work.height = (unsigned short) vfr.size.height;
2615 #ifdef NS_IMPL_COCOA
2616       m->name = ns_screen_name (did);
2618       {
2619         CGSize mms = CGDisplayScreenSize (did);
2620         m->mm_width = (int) mms.width;
2621         m->mm_height = (int) mms.height;
2622       }
2624 #else
2625       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2626       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2627       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2628 #endif
2629     }
2631   // Primary monitor is always first for NS.
2632   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2633                                                     0, "NS");
2635   free_monitors (monitors, n_monitors);
2636   return attributes_list;
2640 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2641        0, 1, 0,
2642        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2643 The optional argument TERMINAL specifies which display to ask about.
2644 TERMINAL should be a terminal object, a frame or a display name (a string).
2645 If omitted or nil, that stands for the selected frame's display.  */)
2646   (Lisp_Object terminal)
2648   check_ns_display_info (terminal);
2649   return make_number
2650     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2654 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2655        0, 1, 0,
2656        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2657 The optional argument TERMINAL specifies which display to ask about.
2658 TERMINAL should be a terminal object, a frame or a display name (a string).
2659 If omitted or nil, that stands for the selected frame's display.  */)
2660   (Lisp_Object terminal)
2662   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2663   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2664   return make_number (1 << min (dpyinfo->n_planes, 24));
2668 /* Unused dummy def needed for compatibility. */
2669 Lisp_Object tip_frame;
2671 /* TODO: move to xdisp or similar */
2672 static void
2673 compute_tip_xy (struct frame *f,
2674                 Lisp_Object parms,
2675                 Lisp_Object dx,
2676                 Lisp_Object dy,
2677                 int width,
2678                 int height,
2679                 int *root_x,
2680                 int *root_y)
2682   Lisp_Object left, top;
2683   EmacsView *view = FRAME_NS_VIEW (f);
2684   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2685   NSPoint pt;
2687   /* Start with user-specified or mouse position.  */
2688   left = Fcdr (Fassq (Qleft, parms));
2689   top = Fcdr (Fassq (Qtop, parms));
2691   if (!INTEGERP (left) || !INTEGERP (top))
2692     {
2693       pt.x = dpyinfo->last_mouse_motion_x;
2694       pt.y = dpyinfo->last_mouse_motion_y;
2695       /* Convert to screen coordinates */
2696       pt = [view convertPoint: pt toView: nil];
2697       pt = [[view window] convertBaseToScreen: pt];
2698     }
2699   else
2700     {
2701       /* Absolute coordinates.  */
2702       pt.x = XINT (left);
2703       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2704         - height;
2705     }
2707   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2708   if (INTEGERP (left))
2709     *root_x = pt.x;
2710   else if (pt.x + XINT (dx) <= 0)
2711     *root_x = 0; /* Can happen for negative dx */
2712   else if (pt.x + XINT (dx) + width
2713            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2714     /* It fits to the right of the pointer.  */
2715     *root_x = pt.x + XINT (dx);
2716   else if (width + XINT (dx) <= pt.x)
2717     /* It fits to the left of the pointer.  */
2718     *root_x = pt.x - width - XINT (dx);
2719   else
2720     /* Put it left justified on the screen -- it ought to fit that way.  */
2721     *root_x = 0;
2723   if (INTEGERP (top))
2724     *root_y = pt.y;
2725   else if (pt.y - XINT (dy) - height >= 0)
2726     /* It fits below the pointer.  */
2727     *root_y = pt.y - height - XINT (dy);
2728   else if (pt.y + XINT (dy) + height
2729            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2730     /* It fits above the pointer */
2731       *root_y = pt.y + XINT (dy);
2732   else
2733     /* Put it on the top.  */
2734     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2738 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2739        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2740 A tooltip window is a small window displaying a string.
2742 This is an internal function; Lisp code should call `tooltip-show'.
2744 FRAME nil or omitted means use the selected frame.
2746 PARMS is an optional list of frame parameters which can be used to
2747 change the tooltip's appearance.
2749 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2750 means use the default timeout of 5 seconds.
2752 If the list of frame parameters PARMS contains a `left' parameter,
2753 the tooltip is displayed at that x-position.  Otherwise it is
2754 displayed at the mouse position, with offset DX added (default is 5 if
2755 DX isn't specified).  Likewise for the y-position; if a `top' frame
2756 parameter is specified, it determines the y-position of the tooltip
2757 window, otherwise it is displayed at the mouse position, with offset
2758 DY added (default is -10).
2760 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2761 Text larger than the specified size is clipped.  */)
2762      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2764   int root_x, root_y;
2765   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2766   ptrdiff_t count = SPECPDL_INDEX ();
2767   struct frame *f;
2768   char *str;
2769   NSSize size;
2771   specbind (Qinhibit_redisplay, Qt);
2773   GCPRO4 (string, parms, frame, timeout);
2775   CHECK_STRING (string);
2776   str = SSDATA (string);
2777   f = decode_window_system_frame (frame);
2778   if (NILP (timeout))
2779     timeout = make_number (5);
2780   else
2781     CHECK_NATNUM (timeout);
2783   if (NILP (dx))
2784     dx = make_number (5);
2785   else
2786     CHECK_NUMBER (dx);
2788   if (NILP (dy))
2789     dy = make_number (-10);
2790   else
2791     CHECK_NUMBER (dy);
2793   block_input ();
2794   if (ns_tooltip == nil)
2795     ns_tooltip = [[EmacsTooltip alloc] init];
2796   else
2797     Fx_hide_tip ();
2799   [ns_tooltip setText: str];
2800   size = [ns_tooltip frame].size;
2802   /* Move the tooltip window where the mouse pointer is.  Resize and
2803      show it.  */
2804   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2805                   &root_x, &root_y);
2807   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2808   unblock_input ();
2810   UNGCPRO;
2811   return unbind_to (count, Qnil);
2815 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2816        doc: /* Hide the current tooltip window, if there is any.
2817 Value is t if tooltip was open, nil otherwise.  */)
2818      (void)
2820   if (ns_tooltip == nil || ![ns_tooltip isActive])
2821     return Qnil;
2822   [ns_tooltip hide];
2823   return Qt;
2827 /* ==========================================================================
2829     Class implementations
2831    ========================================================================== */
2834   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2835   Return YES if handled, NO if not.
2836  */
2837 static BOOL
2838 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2840   NSString *s;
2841   int i;
2842   BOOL ret = NO;
2844   if ([theEvent type] != NSKeyDown) return NO;
2845   s = [theEvent characters];
2847   for (i = 0; i < [s length]; ++i)
2848     {
2849       int ch = (int) [s characterAtIndex: i];
2850       switch (ch)
2851         {
2852         case NSHomeFunctionKey:
2853         case NSDownArrowFunctionKey:
2854         case NSUpArrowFunctionKey:
2855         case NSLeftArrowFunctionKey:
2856         case NSRightArrowFunctionKey:
2857         case NSPageUpFunctionKey:
2858         case NSPageDownFunctionKey:
2859         case NSEndFunctionKey:
2860           /* Don't send command modified keys, as those are handled in the
2861              performKeyEquivalent method of the super class.
2862           */
2863           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2864             {
2865               [panel sendEvent: theEvent];
2866               ret = YES;
2867             }
2868           break;
2869           /* As we don't have the standard key commands for
2870              copy/paste/cut/select-all in our edit menu, we must handle
2871              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2872              here, paste works, because we have that in our Edit menu.
2873              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2874              correct modifier.
2875           */
2876         case 'x': // Cut
2877         case 'c': // Copy
2878         case 'v': // Paste
2879         case 'a': // Select all
2880           if ([theEvent modifierFlags] & NSCommandKeyMask)
2881             {
2882               [NSApp sendAction:
2883                        (ch == 'x'
2884                         ? @selector(cut:)
2885                         : (ch == 'c'
2886                            ? @selector(copy:)
2887                            : (ch == 'v'
2888                               ? @selector(paste:)
2889                               : @selector(selectAll:))))
2890                              to:nil from:panel];
2891               ret = YES;
2892             }
2893         default:
2894           // Send all control keys, as the text field supports C-a, C-f, C-e
2895           // C-b and more.
2896           if ([theEvent modifierFlags] & NSControlKeyMask)
2897             {
2898               [panel sendEvent: theEvent];
2899               ret = YES;
2900             }
2901           break;
2902         }
2903     }
2906   return ret;
2909 @implementation EmacsSavePanel
2910 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2912   BOOL ret = handlePanelKeys (self, theEvent);
2913   if (! ret)
2914     ret = [super performKeyEquivalent:theEvent];
2915   return ret;
2917 @end
2920 @implementation EmacsOpenPanel
2921 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2923   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2924   BOOL ret = handlePanelKeys (self, theEvent);
2925   if (! ret)
2926     ret = [super performKeyEquivalent:theEvent];
2927   return ret;
2929 @end
2932 @implementation EmacsFileDelegate
2933 /* --------------------------------------------------------------------------
2934    Delegate methods for Open/Save panels
2935    -------------------------------------------------------------------------- */
2936 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2938   return YES;
2940 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2942   return YES;
2944 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2945           confirmed: (BOOL)okFlag
2947   return filename;
2949 @end
2951 #endif
2954 /* ==========================================================================
2956     Lisp interface declaration
2958    ========================================================================== */
2961 void
2962 syms_of_nsfns (void)
2964   Qfontsize = intern_c_string ("fontsize");
2965   staticpro (&Qfontsize);
2967   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2968                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2969 If the title of a frame matches REGEXP, then IMAGE.tiff is
2970 selected as the image of the icon representing the frame when it's
2971 miniaturized.  If an element is t, then Emacs tries to select an icon
2972 based on the filetype of the visited file.
2974 The images have to be installed in a folder called English.lproj in the
2975 Emacs folder.  You have to restart Emacs after installing new icons.
2977 Example: Install an icon Gnus.tiff and execute the following code
2979   (setq ns-icon-type-alist
2980         (append ns-icon-type-alist
2981                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2982                    . \"Gnus\"))))
2984 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2985 be used as the image of the icon representing the frame.  */);
2986   Vns_icon_type_alist = list1 (Qt);
2988   DEFVAR_LISP ("ns-version-string", Vns_version_string,
2989                doc: /* Toolkit version for NS Windowing.  */);
2990   Vns_version_string = ns_appkit_version_str ();
2992   defsubr (&Sns_read_file_name);
2993   defsubr (&Sns_get_resource);
2994   defsubr (&Sns_set_resource);
2995   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2996   defsubr (&Sx_display_grayscale_p);
2997   defsubr (&Sns_font_name);
2998   defsubr (&Sns_list_colors);
2999 #ifdef NS_IMPL_COCOA
3000   defsubr (&Sns_do_applescript);
3001 #endif
3002   defsubr (&Sxw_color_defined_p);
3003   defsubr (&Sxw_color_values);
3004   defsubr (&Sx_server_max_request_size);
3005   defsubr (&Sx_server_vendor);
3006   defsubr (&Sx_server_version);
3007   defsubr (&Sx_display_pixel_width);
3008   defsubr (&Sx_display_pixel_height);
3009   defsubr (&Sns_display_monitor_attributes_list);
3010   defsubr (&Sx_display_mm_width);
3011   defsubr (&Sx_display_mm_height);
3012   defsubr (&Sx_display_screens);
3013   defsubr (&Sx_display_planes);
3014   defsubr (&Sx_display_color_cells);
3015   defsubr (&Sx_display_visual_class);
3016   defsubr (&Sx_display_backing_store);
3017   defsubr (&Sx_display_save_under);
3018   defsubr (&Sx_create_frame);
3019   defsubr (&Sx_open_connection);
3020   defsubr (&Sx_close_connection);
3021   defsubr (&Sx_display_list);
3023   defsubr (&Sns_hide_others);
3024   defsubr (&Sns_hide_emacs);
3025   defsubr (&Sns_emacs_info_panel);
3026   defsubr (&Sns_list_services);
3027   defsubr (&Sns_perform_service);
3028   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3029   defsubr (&Sns_popup_font_panel);
3030   defsubr (&Sns_popup_color_panel);
3032   defsubr (&Sx_show_tip);
3033   defsubr (&Sx_hide_tip);
3035   as_status = 0;
3036   as_script = Qnil;
3037   as_result = 0;