Fix problem with images referenced within svg files. (bug#19373)
[emacs.git] / src / nsfns.m
bloba5ff6346d74988cc345edae697e5bb3c11bfada4
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   /* Must block_input, because ns_lisp_to_color does block/unblock_input
284      which means that col may be deallocated in its unblock_input if there
285      is user input, unless we also block_input.  */
286   block_input ();
287   if (ns_lisp_to_color (arg, &col))
288     {
289       store_frame_param (f, Qforeground_color, oldval);
290       unblock_input ();
291       error ("Unknown color");
292     }
294   [col retain];
295   [f->output_data.ns->foreground_color release];
296   f->output_data.ns->foreground_color = col;
298   [col getRed: &r green: &g blue: &b alpha: &alpha];
299   FRAME_FOREGROUND_PIXEL (f) =
300     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
302   if (FRAME_NS_VIEW (f))
303     {
304       update_face_from_frame_parameter (f, Qforeground_color, arg);
305       /*recompute_basic_faces (f); */
306       if (FRAME_VISIBLE_P (f))
307         SET_FRAME_GARBAGED (f);
308     }
309   unblock_input ();
313 static void
314 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
316   struct face *face;
317   NSColor *col;
318   NSView *view = FRAME_NS_VIEW (f);
319   EmacsCGFloat r, g, b, alpha;
321   block_input ();
322   if (ns_lisp_to_color (arg, &col))
323     {
324       store_frame_param (f, Qbackground_color, oldval);
325       unblock_input ();
326       error ("Unknown color");
327     }
329   /* clear the frame; in some instances the NS-internal GC appears not to
330      update, or it does update and cannot clear old text properly */
331   if (FRAME_VISIBLE_P (f))
332     ns_clear_frame (f);
334   [col retain];
335   [f->output_data.ns->background_color release];
336   f->output_data.ns->background_color = col;
338   [col getRed: &r green: &g blue: &b alpha: &alpha];
339   FRAME_BACKGROUND_PIXEL (f) =
340     ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
342   if (view != nil)
343     {
344       [[view window] setBackgroundColor: col];
346       if (alpha != (EmacsCGFloat) 1.0)
347           [[view window] setOpaque: NO];
348       else
349           [[view window] setOpaque: YES];
351       face = FRAME_DEFAULT_FACE (f);
352       if (face)
353         {
354           col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
355           face->background = ns_index_color
356             ([col colorWithAlphaComponent: alpha], f);
358           update_face_from_frame_parameter (f, Qbackground_color, arg);
359         }
361       if (FRAME_VISIBLE_P (f))
362         SET_FRAME_GARBAGED (f);
363     }
364   unblock_input ();
368 static void
369 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
371   NSColor *col;
373   block_input ();
374   if (ns_lisp_to_color (arg, &col))
375     {
376       store_frame_param (f, Qcursor_color, oldval);
377       unblock_input ();
378       error ("Unknown color");
379     }
381   [FRAME_CURSOR_COLOR (f) release];
382   FRAME_CURSOR_COLOR (f) = [col retain];
384   if (FRAME_VISIBLE_P (f))
385     {
386       x_update_cursor (f, 0);
387       x_update_cursor (f, 1);
388     }
389   update_face_from_frame_parameter (f, Qcursor_color, arg);
390   unblock_input ();
394 static void
395 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
397   NSView *view = FRAME_NS_VIEW (f);
398   NSTRACE (x_set_icon_name);
400   /* see if it's changed */
401   if (STRINGP (arg))
402     {
403       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
404         return;
405     }
406   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
407     return;
409   fset_icon_name (f, arg);
411   if (NILP (arg))
412     {
413       if (!NILP (f->title))
414         arg = f->title;
415       else
416         /* Explicit name and no icon-name -> explicit_name.  */
417         if (f->explicit_name)
418           arg = f->name;
419         else
420           {
421             /* No explicit name and no icon-name ->
422                name has to be rebuild from icon_title_format.  */
423             windows_or_buffers_changed = 62;
424             return;
425           }
426     }
428   /* Don't change the name if it's already NAME.  */
429   if ([[view window] miniwindowTitle]
430       && ([[[view window] miniwindowTitle]
431              isEqualToString: [NSString stringWithUTF8String:
432                                           SSDATA (arg)]]))
433     return;
435   [[view window] setMiniwindowTitle:
436         [NSString stringWithUTF8String: SSDATA (arg)]];
439 static void
440 ns_set_name_internal (struct frame *f, Lisp_Object name)
442   struct gcpro gcpro1;
443   Lisp_Object encoded_name, encoded_icon_name;
444   NSString *str;
445   NSView *view = FRAME_NS_VIEW (f);
447   GCPRO1 (name);
448   encoded_name = ENCODE_UTF_8 (name);
449   UNGCPRO;
451   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
453   /* Don't change the name if it's already NAME.  */
454   if (! [[[view window] title] isEqualToString: str])
455     [[view window] setTitle: str];
457   if (!STRINGP (f->icon_name))
458     encoded_icon_name = encoded_name;
459   else
460     encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
462   str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
464   if ([[view window] miniwindowTitle]
465       && ! [[[view window] miniwindowTitle] isEqualToString: str])
466     [[view window] setMiniwindowTitle: str];
470 static void
471 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
473   NSTRACE (ns_set_name);
475   /* Make sure that requests from lisp code override requests from
476      Emacs redisplay code.  */
477   if (explicit)
478     {
479       /* If we're switching from explicit to implicit, we had better
480          update the mode lines and thereby update the title.  */
481       if (f->explicit_name && NILP (name))
482         update_mode_lines = 21;
484       f->explicit_name = ! NILP (name);
485     }
486   else if (f->explicit_name)
487     return;
489   if (NILP (name))
490     name = build_string ([ns_app_name UTF8String]);
491   else
492     CHECK_STRING (name);
494   /* Don't change the name if it's already NAME.  */
495   if (! NILP (Fstring_equal (name, f->name)))
496     return;
498   fset_name (f, name);
500   /* Title overrides explicit name.  */
501   if (! NILP (f->title))
502     name = f->title;
504   ns_set_name_internal (f, name);
508 /* This function should be called when the user's lisp code has
509    specified a name for the frame; the name will override any set by the
510    redisplay code.  */
511 static void
512 x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
514   NSTRACE (x_explicitly_set_name);
515   ns_set_name (f, arg, 1);
519 /* This function should be called by Emacs redisplay code to set the
520    name; names set this way will never override names set by the user's
521    lisp code.  */
522 void
523 x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
525   NSTRACE (x_implicitly_set_name);
527   /* Deal with NS specific format t.  */
528   if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
529                          || EQ (Vframe_title_format, Qt)))
530     ns_set_name_as_filename (f);
531   else
532     ns_set_name (f, arg, 0);
536 /* Change the title of frame F to NAME.
537    If NAME is nil, use the frame name as the title.  */
539 static void
540 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
542   NSTRACE (x_set_title);
543   /* Don't change the title if it's already NAME.  */
544   if (EQ (name, f->title))
545     return;
547   update_mode_lines = 22;
549   fset_title (f, name);
551   if (NILP (name))
552     name = f->name;
553   else
554     CHECK_STRING (name);
556   ns_set_name_internal (f, name);
560 void
561 ns_set_name_as_filename (struct frame *f)
563   NSView *view;
564   Lisp_Object name, filename;
565   Lisp_Object buf = XWINDOW (f->selected_window)->contents;
566   const char *title;
567   NSAutoreleasePool *pool;
568   struct gcpro gcpro1;
569   Lisp_Object encoded_name, encoded_filename;
570   NSString *str;
571   NSTRACE (ns_set_name_as_filename);
573   if (f->explicit_name || ! NILP (f->title))
574     return;
576   block_input ();
577   pool = [[NSAutoreleasePool alloc] init];
578   filename = BVAR (XBUFFER (buf), filename);
579   name = BVAR (XBUFFER (buf), name);
581   if (NILP (name))
582     {
583       if (! NILP (filename))
584         name = Ffile_name_nondirectory (filename);
585       else
586         name = build_string ([ns_app_name UTF8String]);
587     }
589   GCPRO1 (name);
590   encoded_name = ENCODE_UTF_8 (name);
591   UNGCPRO;
593   view = FRAME_NS_VIEW (f);
595   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
596                                 : [[[view window] title] UTF8String];
598   if (title && (! strcmp (title, SSDATA (encoded_name))))
599     {
600       [pool release];
601       unblock_input ();
602       return;
603     }
605   str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
606   if (str == nil) str = @"Bad coding";
608   if (FRAME_ICONIFIED_P (f))
609     [[view window] setMiniwindowTitle: str];
610   else
611     {
612       NSString *fstr;
614       if (! NILP (filename))
615         {
616           GCPRO1 (filename);
617           encoded_filename = ENCODE_UTF_8 (filename);
618           UNGCPRO;
620           fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
621           if (fstr == nil) fstr = @"";
622         }
623       else
624         fstr = @"";
626       ns_set_represented_filename (fstr, f);
627       [[view window] setTitle: str];
628       fset_name (f, name);
629     }
631   [pool release];
632   unblock_input ();
636 void
637 ns_set_doc_edited (void)
639   NSAutoreleasePool *pool;
640   Lisp_Object tail, frame;
641   block_input ();
642   pool = [[NSAutoreleasePool alloc] init];
643   FOR_EACH_FRAME (tail, frame)
644     {
645       BOOL edited = NO;
646       struct frame *f = XFRAME (frame);
647       struct window *w;
648       NSView *view;
650       if (! FRAME_NS_P (f)) continue;
651       w = XWINDOW (FRAME_SELECTED_WINDOW (f));
652       view = FRAME_NS_VIEW (f);
653       if (!MINI_WINDOW_P (w))
654         edited = ! NILP (Fbuffer_modified_p (w->contents)) &&
655           ! NILP (Fbuffer_file_name (w->contents));
656       [[view window] setDocumentEdited: edited];
657     }
659   [pool release];
660   unblock_input ();
664 void
665 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
667   int nlines;
668   if (FRAME_MINIBUF_ONLY_P (f))
669     return;
671   if (TYPE_RANGED_INTEGERP (int, value))
672     nlines = XINT (value);
673   else
674     nlines = 0;
676   FRAME_MENU_BAR_LINES (f) = 0;
677   if (nlines)
678     {
679       FRAME_EXTERNAL_MENU_BAR (f) = 1;
680       /* does for all frames, whereas we just want for one frame
681          [NSMenu setMenuBarVisible: YES]; */
682     }
683   else
684     {
685       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
686         free_frame_menubar (f);
687       /*      [NSMenu setMenuBarVisible: NO]; */
688       FRAME_EXTERNAL_MENU_BAR (f) = 0;
689     }
693 /* toolbar support */
694 void
695 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
697   int nlines;
699   if (FRAME_MINIBUF_ONLY_P (f))
700     return;
702   if (RANGED_INTEGERP (0, value, INT_MAX))
703     nlines = XFASTINT (value);
704   else
705     nlines = 0;
707   if (nlines)
708     {
709       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
710       update_frame_tool_bar (f);
711     }
712   else
713     {
714       if (FRAME_EXTERNAL_TOOL_BAR (f))
715         {
716           free_frame_tool_bar (f);
717           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
718         }
719     }
721   x_set_window_size (f, 0, f->text_cols, f->text_lines, 0);
725 void
726 x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
728   int old_width = FRAME_INTERNAL_BORDER_WIDTH (f);
730   CHECK_TYPE_RANGED_INTEGER (int, arg);
731   FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
732   if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
733     FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
735   if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width)
736     return;
738   if (FRAME_X_WINDOW (f) != 0)
739     adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width);
741   SET_FRAME_GARBAGED (f);
745 static void
746 ns_implicitly_set_icon_type (struct frame *f)
748   Lisp_Object tem;
749   EmacsView *view = FRAME_NS_VIEW (f);
750   id image = nil;
751   Lisp_Object chain, elt;
752   NSAutoreleasePool *pool;
753   BOOL setMini = YES;
755   NSTRACE (ns_implicitly_set_icon_type);
757   block_input ();
758   pool = [[NSAutoreleasePool alloc] init];
759   if (f->output_data.ns->miniimage
760       && [[NSString stringWithUTF8String: SSDATA (f->name)]
761                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
762     {
763       [pool release];
764       unblock_input ();
765       return;
766     }
768   tem = assq_no_quit (Qicon_type, f->param_alist);
769   if (CONSP (tem) && ! NILP (XCDR (tem)))
770     {
771       [pool release];
772       unblock_input ();
773       return;
774     }
776   for (chain = Vns_icon_type_alist;
777        image == nil && CONSP (chain);
778        chain = XCDR (chain))
779     {
780       elt = XCAR (chain);
781       /* special case: 't' means go by file type */
782       if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
783         {
784           NSString *str
785              = [NSString stringWithUTF8String: SSDATA (f->name)];
786           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
787             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
788         }
789       else if (CONSP (elt) &&
790                STRINGP (XCAR (elt)) &&
791                STRINGP (XCDR (elt)) &&
792                fast_string_match (XCAR (elt), f->name) >= 0)
793         {
794           image = [EmacsImage allocInitFromFile: XCDR (elt)];
795           if (image == nil)
796             image = [[NSImage imageNamed:
797                                [NSString stringWithUTF8String:
798                                             SSDATA (XCDR (elt))]] retain];
799         }
800     }
802   if (image == nil)
803     {
804       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
805       setMini = NO;
806     }
808   [f->output_data.ns->miniimage release];
809   f->output_data.ns->miniimage = image;
810   [view setMiniwindowImage: setMini];
811   [pool release];
812   unblock_input ();
816 static void
817 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
819   EmacsView *view = FRAME_NS_VIEW (f);
820   id image = nil;
821   BOOL setMini = YES;
823   NSTRACE (x_set_icon_type);
825   if (!NILP (arg) && SYMBOLP (arg))
826     {
827       arg =build_string (SSDATA (SYMBOL_NAME (arg)));
828       store_frame_param (f, Qicon_type, arg);
829     }
831   /* do it the implicit way */
832   if (NILP (arg))
833     {
834       ns_implicitly_set_icon_type (f);
835       return;
836     }
838   CHECK_STRING (arg);
840   image = [EmacsImage allocInitFromFile: arg];
841   if (image == nil)
842     image =[NSImage imageNamed: [NSString stringWithUTF8String:
843                                             SSDATA (arg)]];
845   if (image == nil)
846     {
847       image = [NSImage imageNamed: @"text"];
848       setMini = NO;
849     }
851   f->output_data.ns->miniimage = image;
852   [view setMiniwindowImage: setMini];
856 /* TODO: move to nsterm? */
858 ns_lisp_to_cursor_type (Lisp_Object arg)
860   char *str;
861   if (XTYPE (arg) == Lisp_String)
862     str = SSDATA (arg);
863   else if (XTYPE (arg) == Lisp_Symbol)
864     str = SSDATA (SYMBOL_NAME (arg));
865   else return -1;
866   if (!strcmp (str, "box"))     return FILLED_BOX_CURSOR;
867   if (!strcmp (str, "hollow"))  return HOLLOW_BOX_CURSOR;
868   if (!strcmp (str, "hbar"))    return HBAR_CURSOR;
869   if (!strcmp (str, "bar"))     return BAR_CURSOR;
870   if (!strcmp (str, "no"))      return NO_CURSOR;
871   return -1;
875 Lisp_Object
876 ns_cursor_type_to_lisp (int arg)
878   switch (arg)
879     {
880     case FILLED_BOX_CURSOR: return Qbox;
881     case HOLLOW_BOX_CURSOR: return intern ("hollow");
882     case HBAR_CURSOR:       return intern ("hbar");
883     case BAR_CURSOR:        return intern ("bar");
884     case NO_CURSOR:
885     default:                return intern ("no");
886     }
889 /* This is the same as the xfns.c definition.  */
890 static void
891 x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
893   set_frame_cursor_types (f, arg);
896 /* called to set mouse pointer color, but all other terms use it to
897    initialize pointer types (and don't set the color ;) */
898 static void
899 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
901   /* don't think we can do this on Nextstep */
905 #define Str(x) #x
906 #define Xstr(x) Str(x)
908 static Lisp_Object
909 ns_appkit_version_str (void)
911   char tmp[256];
913 #ifdef NS_IMPL_GNUSTEP
914   sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
915 #elif defined (NS_IMPL_COCOA)
916   NSString *osversion
917     = [[NSProcessInfo processInfo] operatingSystemVersionString];
918   sprintf(tmp, "appkit-%.2f %s",
919           NSAppKitVersionNumber,
920           [osversion UTF8String]);
921 #else
922   tmp = "ns-unknown";
923 #endif
924   return build_string (tmp);
928 /* This is for use by x-server-version and collapses all version info we
929    have into a single int.  For a better picture of the implementation
930    running, use ns_appkit_version_str.*/
931 static int
932 ns_appkit_version_int (void)
934 #ifdef NS_IMPL_GNUSTEP
935   return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
936 #elif defined (NS_IMPL_COCOA)
937   return (int)NSAppKitVersionNumber;
938 #endif
939   return 0;
943 static void
944 x_icon (struct frame *f, Lisp_Object parms)
945 /* --------------------------------------------------------------------------
946    Strangely-named function to set icon position parameters in frame.
947    This is irrelevant under OS X, but might be needed under GNUstep,
948    depending on the window manager used.  Note, this is not a standard
949    frame parameter-setter; it is called directly from x-create-frame.
950    -------------------------------------------------------------------------- */
952   Lisp_Object icon_x, icon_y;
953   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
955   f->output_data.ns->icon_top = -1;
956   f->output_data.ns->icon_left = -1;
958   /* Set the position of the icon.  */
959   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
960   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
961   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
962     {
963       CHECK_NUMBER (icon_x);
964       CHECK_NUMBER (icon_y);
965       f->output_data.ns->icon_top = XINT (icon_y);
966       f->output_data.ns->icon_left = XINT (icon_x);
967     }
968   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
969     error ("Both left and top icon corners of icon must be specified");
973 /* Note: see frame.c for template, also where generic functions are impl */
974 frame_parm_handler ns_frame_parm_handlers[] =
976   x_set_autoraise, /* generic OK */
977   x_set_autolower, /* generic OK */
978   x_set_background_color,
979   0, /* x_set_border_color,  may be impossible under Nextstep */
980   0, /* x_set_border_width,  may be impossible under Nextstep */
981   x_set_cursor_color,
982   x_set_cursor_type,
983   x_set_font, /* generic OK */
984   x_set_foreground_color,
985   x_set_icon_name,
986   x_set_icon_type,
987   x_set_internal_border_width, /* generic OK */
988   0, /* x_set_right_divider_width */
989   0, /* x_set_bottom_divider_width */
990   x_set_menu_bar_lines,
991   x_set_mouse_color,
992   x_explicitly_set_name,
993   x_set_scroll_bar_width, /* generic OK */
994   x_set_scroll_bar_height, /* generic OK */
995   x_set_title,
996   x_set_unsplittable, /* generic OK */
997   x_set_vertical_scroll_bars, /* generic OK */
998   x_set_horizontal_scroll_bars, /* generic OK */
999   x_set_visibility, /* generic OK */
1000   x_set_tool_bar_lines,
1001   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1002   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
1003   x_set_screen_gamma, /* generic OK */
1004   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1005   x_set_left_fringe, /* generic OK */
1006   x_set_right_fringe, /* generic OK */
1007   0, /* x_set_wait_for_wm, will ignore */
1008   x_set_fullscreen, /* generic OK */
1009   x_set_font_backend, /* generic OK */
1010   x_set_alpha,
1011   0, /* x_set_sticky */
1012   0, /* x_set_tool_bar_position */
1016 /* Handler for signals raised during x_create_frame.
1017    FRAME is the frame which is partially constructed.  */
1019 static void
1020 unwind_create_frame (Lisp_Object frame)
1022   struct frame *f = XFRAME (frame);
1024   /* If frame is already dead, nothing to do.  This can happen if the
1025      display is disconnected after the frame has become official, but
1026      before x_create_frame removes the unwind protect.  */
1027   if (!FRAME_LIVE_P (f))
1028     return;
1030   /* If frame is ``official'', nothing to do.  */
1031   if (NILP (Fmemq (frame, Vframe_list)))
1032     {
1033 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1034       struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1035 #endif
1037       x_free_frame_resources (f);
1038       free_glyphs (f);
1040 #ifdef GLYPH_DEBUG
1041       /* Check that reference counts are indeed correct.  */
1042       eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1043 #endif
1044     }
1048  * Read geometry related parameters from preferences if not in PARMS.
1049  * Returns the union of parms and any preferences read.
1050  */
1052 static Lisp_Object
1053 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1054                                Lisp_Object parms)
1056   struct {
1057     const char *val;
1058     const char *cls;
1059     Lisp_Object tem;
1060   } r[] = {
1061     { "width",  "Width", Qwidth },
1062     { "height", "Height", Qheight },
1063     { "left", "Left", Qleft },
1064     { "top", "Top", Qtop },
1065   };
1067   int i;
1068   for (i = 0; i < ARRAYELTS (r); ++i)
1069     {
1070       if (NILP (Fassq (r[i].tem, parms)))
1071         {
1072           Lisp_Object value
1073             = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1074                          RES_TYPE_NUMBER);
1075           if (! EQ (value, Qunbound))
1076             parms = Fcons (Fcons (r[i].tem, value), parms);
1077         }
1078     }
1080   return parms;
1083 /* ==========================================================================
1085     Lisp definitions
1087    ========================================================================== */
1089 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1090        1, 1, 0,
1091        doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1092 Return an Emacs frame object.
1093 PARMS is an alist of frame parameters.
1094 If the parameters specify that the frame should not have a minibuffer,
1095 and do not specify a specific minibuffer window to use,
1096 then `default-minibuffer-frame' must be a frame whose minibuffer can
1097 be shared by the new frame.
1099 This function is an internal primitive--use `make-frame' instead.  */)
1100      (Lisp_Object parms)
1102   struct frame *f;
1103   Lisp_Object frame, tem;
1104   Lisp_Object name;
1105   int minibuffer_only = 0;
1106   long window_prompting = 0;
1107   int width, height;
1108   ptrdiff_t count = specpdl_ptr - specpdl;
1109   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1110   Lisp_Object display;
1111   struct ns_display_info *dpyinfo = NULL;
1112   Lisp_Object parent;
1113   struct kboard *kb;
1114   static int desc_ctr = 1;
1116   /* x_get_arg modifies parms.  */
1117   parms = Fcopy_alist (parms);
1119   /* Use this general default value to start with
1120      until we know if this frame has a specified name.  */
1121   Vx_resource_name = Vinvocation_name;
1123   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1124   if (EQ (display, Qunbound))
1125     display = Qnil;
1126   dpyinfo = check_ns_display_info (display);
1127   kb = dpyinfo->terminal->kboard;
1129   if (!dpyinfo->terminal->name)
1130     error ("Terminal is not live, can't create new frames on it");
1132   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1133   if (!STRINGP (name)
1134       && ! EQ (name, Qunbound)
1135       && ! NILP (name))
1136     error ("Invalid frame name--not a string or nil");
1138   if (STRINGP (name))
1139     Vx_resource_name = name;
1141   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1142   if (EQ (parent, Qunbound))
1143     parent = Qnil;
1144   if (! NILP (parent))
1145     CHECK_NUMBER (parent);
1147   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
1148   /* No need to protect DISPLAY because that's not used after passing
1149      it to make_frame_without_minibuffer.  */
1150   frame = Qnil;
1151   GCPRO4 (parms, parent, name, frame);
1152   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1153                   RES_TYPE_SYMBOL);
1154   if (EQ (tem, Qnone) || NILP (tem))
1155       f = make_frame_without_minibuffer (Qnil, kb, display);
1156   else if (EQ (tem, Qonly))
1157     {
1158       f = make_minibuffer_frame ();
1159       minibuffer_only = 1;
1160     }
1161   else if (WINDOWP (tem))
1162       f = make_frame_without_minibuffer (tem, kb, display);
1163   else
1164       f = make_frame (1);
1166   XSETFRAME (frame, f);
1168   f->terminal = dpyinfo->terminal;
1170   f->output_method = output_ns;
1171   f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1173   FRAME_FONTSET (f) = -1;
1175   fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1176                                 "iconName", "Title",
1177                                 RES_TYPE_STRING));
1178   if (! STRINGP (f->icon_name))
1179     fset_icon_name (f, Qnil);
1181   FRAME_DISPLAY_INFO (f) = dpyinfo;
1183   /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe.  */
1184   record_unwind_protect (unwind_create_frame, frame);
1186   f->output_data.ns->window_desc = desc_ctr++;
1187   if (TYPE_RANGED_INTEGERP (Window, parent))
1188     {
1189       f->output_data.ns->parent_desc = XFASTINT (parent);
1190       f->output_data.ns->explicit_parent = 1;
1191     }
1192   else
1193     {
1194       f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
1195       f->output_data.ns->explicit_parent = 0;
1196     }
1198   /* Set the name; the functions to which we pass f expect the name to
1199      be set.  */
1200   if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1201     {
1202       fset_name (f, build_string ([ns_app_name UTF8String]));
1203       f->explicit_name = 0;
1204     }
1205   else
1206     {
1207       fset_name (f, name);
1208       f->explicit_name = 1;
1209       specbind (Qx_resource_name, name);
1210     }
1212   block_input ();
1214 #ifdef NS_IMPL_COCOA
1215     mac_register_font_driver (f);
1216 #else
1217     register_font_driver (&nsfont_driver, f);
1218 #endif
1220   x_default_parameter (f, parms, Qfont_backend, Qnil,
1221                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1223   {
1224     /* use for default font name */
1225     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1226     x_default_parameter (f, parms, Qfontsize,
1227                                     make_number (0 /*(int)[font pointSize]*/),
1228                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1229     // Remove ' Regular', not handled by backends.
1230     char *fontname = xstrdup ([[font displayName] UTF8String]);
1231     int len = strlen (fontname);
1232     if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0)
1233       fontname[len-8] = '\0';
1234     x_default_parameter (f, parms, Qfont,
1235                                  build_string (fontname),
1236                                  "font", "Font", RES_TYPE_STRING);
1237     xfree (fontname);
1238   }
1239   unblock_input ();
1241   x_default_parameter (f, parms, Qborder_width, make_number (0),
1242                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1243   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1244                       "internalBorderWidth", "InternalBorderWidth",
1245                       RES_TYPE_NUMBER);
1247   /* default vertical scrollbars on right on Mac */
1248   {
1249       Lisp_Object spos
1250 #ifdef NS_IMPL_GNUSTEP
1251           = Qt;
1252 #else
1253           = Qright;
1254 #endif
1255       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1256                            "verticalScrollBars", "VerticalScrollBars",
1257                            RES_TYPE_SYMBOL);
1258   }
1259   x_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil,
1260                        "horizontalScrollBars", "HorizontalScrollBars",
1261                        RES_TYPE_SYMBOL);
1262   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1263                       "foreground", "Foreground", RES_TYPE_STRING);
1264   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1265                       "background", "Background", RES_TYPE_STRING);
1266   /* FIXME: not supported yet in Nextstep */
1267   x_default_parameter (f, parms, Qline_spacing, Qnil,
1268                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1269   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1270                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1271   x_default_parameter (f, parms, Qright_fringe, Qnil,
1272                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1274 #ifdef GLYPH_DEBUG
1275   image_cache_refcount =
1276     FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1277 #endif
1279   init_frame_faces (f);
1281   /* Read comment about this code in corresponding place in xfns.c.  */
1282   adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
1283                      FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qnil);
1285   /* The resources controlling the menu-bar and tool-bar are
1286      processed specially at startup, and reflected in the mode
1287      variables; ignore them here.  */
1288   x_default_parameter (f, parms, Qmenu_bar_lines,
1289                        NILP (Vmenu_bar_mode)
1290                        ? make_number (0) : make_number (1),
1291                        NULL, NULL, RES_TYPE_NUMBER);
1292   x_default_parameter (f, parms, Qtool_bar_lines,
1293                        NILP (Vtool_bar_mode)
1294                        ? make_number (0) : make_number (1),
1295                        NULL, NULL, RES_TYPE_NUMBER);
1297   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1298                        "BufferPredicate", RES_TYPE_SYMBOL);
1299   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1300                        RES_TYPE_STRING);
1302   parms = get_geometry_from_preferences (dpyinfo, parms);
1303   window_prompting = x_figure_window_size (f, parms, 1);
1305   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1306   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1308   /* NOTE: on other terms, this is done in set_mouse_color, however this
1309      was not getting called under Nextstep */
1310   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1311   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1312   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1313   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1314   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1315   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1316   f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
1317   FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1318      = [NSCursor arrowCursor];
1319   FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
1320      = [NSCursor arrowCursor];
1321   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1323   [[EmacsView alloc] initFrameFromEmacs: f];
1325   x_icon (f, parms);
1327   /* ns_display_info does not have a reference_count.  */
1328   f->terminal->reference_count++;
1330   /* It is now ok to make the frame official even if we get an error below.
1331      The frame needs to be on Vframe_list or making it visible won't work. */
1332   Vframe_list = Fcons (frame, Vframe_list);
1334   x_default_parameter (f, parms, Qicon_type, Qnil,
1335                        "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1337   x_default_parameter (f, parms, Qauto_raise, Qnil,
1338                        "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1339   x_default_parameter (f, parms, Qauto_lower, Qnil,
1340                        "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1341   x_default_parameter (f, parms, Qcursor_type, Qbox,
1342                        "cursorType", "CursorType", RES_TYPE_SYMBOL);
1343   x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1344                        "scrollBarWidth", "ScrollBarWidth",
1345                        RES_TYPE_NUMBER);
1346   x_default_parameter (f, parms, Qscroll_bar_height, Qnil,
1347                        "scrollBarHeight", "ScrollBarHeight",
1348                        RES_TYPE_NUMBER);
1349   x_default_parameter (f, parms, Qalpha, Qnil,
1350                        "alpha", "Alpha", RES_TYPE_NUMBER);
1351   x_default_parameter (f, parms, Qfullscreen, Qnil,
1352                        "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1354   /* Allow x_set_window_size, now.  */
1355   f->can_x_set_window_size = true;
1357   adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, Qnil);
1359   if (! f->output_data.ns->explicit_parent)
1360     {
1361       Lisp_Object visibility;
1363       visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1364                               RES_TYPE_SYMBOL);
1365       if (EQ (visibility, Qunbound))
1366         visibility = Qt;
1368       if (EQ (visibility, Qicon))
1369         x_iconify_frame (f);
1370       else if (! NILP (visibility))
1371         {
1372           x_make_frame_visible (f);
1373           [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1374         }
1375       else
1376         {
1377           /* Must have been Qnil.  */
1378         }
1379     }
1381   if (FRAME_HAS_MINIBUF_P (f)
1382       && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1383           || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1384     kset_default_minibuffer_frame (kb, frame);
1386   /* All remaining specified parameters, which have not been "used"
1387      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1388   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1389     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1390       fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1392   UNGCPRO;
1394   if (window_prompting & USPosition)
1395     x_set_offset (f, f->left_pos, f->top_pos, 1);
1397   /* Make sure windows on this frame appear in calls to next-window
1398      and similar functions.  */
1399   Vwindow_list = Qnil;
1401   return unbind_to (count, frame);
1404 void
1405 x_focus_frame (struct frame *f)
1407   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1409   if (dpyinfo->x_focus_frame != f)
1410     {
1411       EmacsView *view = FRAME_NS_VIEW (f);
1412       block_input ();
1413       [NSApp activateIgnoringOtherApps: YES];
1414       [[view window] makeKeyAndOrderFront: view];
1415       unblock_input ();
1416     }
1420 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1421        0, 1, "",
1422        doc: /* Pop up the font panel. */)
1423      (Lisp_Object frame)
1425   struct frame *f = decode_window_system_frame (frame);
1426   id fm = [NSFontManager sharedFontManager];
1427   struct font *font = f->output_data.ns->font;
1428   NSFont *nsfont;
1429 #ifdef NS_IMPL_GNUSTEP
1430   nsfont = ((struct nsfont_info *)font)->nsfont;
1431 #endif
1432 #ifdef NS_IMPL_COCOA
1433   nsfont = (NSFont *) macfont_get_nsctfont (font);
1434 #endif
1435   [fm setSelectedFont: nsfont isMultiple: NO];
1436   [fm orderFrontFontPanel: NSApp];
1437   return Qnil;
1441 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1442        0, 1, "",
1443        doc: /* Pop up the color panel.  */)
1444      (Lisp_Object frame)
1446   check_window_system (NULL);
1447   [NSApp orderFrontColorPanel: NSApp];
1448   return Qnil;
1451 static struct
1453   id panel;
1454   BOOL ret;
1455 #ifdef NS_IMPL_GNUSTEP
1456   NSString *dirS, *initS;
1457   BOOL no_types;
1458 #endif
1459 } ns_fd_data;
1461 void
1462 ns_run_file_dialog (void)
1464   if (ns_fd_data.panel == nil) return;
1465 #ifdef NS_IMPL_COCOA
1466   ns_fd_data.ret = [ns_fd_data.panel runModal];
1467 #else
1468   if (ns_fd_data.no_types)
1469     {
1470       ns_fd_data.ret = [ns_fd_data.panel
1471                            runModalForDirectory: ns_fd_data.dirS
1472                            file: ns_fd_data.initS];
1473     }
1474   else
1475     {
1476       ns_fd_data.ret = [ns_fd_data.panel
1477                            runModalForDirectory: ns_fd_data.dirS
1478                            file: ns_fd_data.initS
1479                            types: nil];
1480     }
1481 #endif
1482   ns_fd_data.panel = nil;
1485 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1486        doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1487 Optional arg DIR, if non-nil, supplies a default directory.
1488 Optional arg MUSTMATCH, if non-nil, means the returned file or
1489 directory must exist.
1490 Optional arg INIT, if non-nil, provides a default file name to use.
1491 Optional arg DIR_ONLY_P, if non-nil, means choose only directories.  */)
1492   (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1493    Lisp_Object init, Lisp_Object dir_only_p)
1495   static id fileDelegate = nil;
1496   BOOL ret;
1497   BOOL isSave = NILP (mustmatch) && NILP (dir_only_p);
1498   id panel;
1499   Lisp_Object fname;
1501   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1502     [NSString stringWithUTF8String: SSDATA (prompt)];
1503   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1504     [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1505     [NSString stringWithUTF8String: SSDATA (dir)];
1506   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1507     [NSString stringWithUTF8String: SSDATA (init)];
1508   NSEvent *nxev;
1510   check_window_system (NULL);
1512   if (fileDelegate == nil)
1513     fileDelegate = [EmacsFileDelegate new];
1515   [NSCursor setHiddenUntilMouseMoves: NO];
1517   if ([dirS characterAtIndex: 0] == '~')
1518     dirS = [dirS stringByExpandingTildeInPath];
1520   panel = isSave ?
1521     (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1523   [panel setTitle: promptS];
1525   [panel setAllowsOtherFileTypes: YES];
1526   [panel setTreatsFilePackagesAsDirectories: YES];
1527   [panel setDelegate: fileDelegate];
1529   if (! NILP (dir_only_p))
1530     {
1531       [panel setCanChooseDirectories: YES];
1532       [panel setCanChooseFiles: NO];
1533     }
1534   else if (! isSave)
1535     {
1536       /* This is not quite what the documentation says, but it is compatible
1537          with the Gtk+ code.  Also, the menu entry says "Open File...".  */
1538       [panel setCanChooseDirectories: NO];
1539       [panel setCanChooseFiles: YES];
1540     }
1542   block_input ();
1543   ns_fd_data.panel = panel;
1544   ns_fd_data.ret = NO;
1545 #ifdef NS_IMPL_COCOA
1546   if (! NILP (mustmatch) || ! NILP (dir_only_p))
1547     [panel setAllowedFileTypes: nil];
1548   if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1549   if (initS && NILP (Ffile_directory_p (init)))
1550     [panel setNameFieldStringValue: [initS lastPathComponent]];
1551   else
1552     [panel setNameFieldStringValue: @""];
1554 #else
1555   ns_fd_data.no_types = NILP (mustmatch) && NILP (dir_only_p);
1556   ns_fd_data.dirS = dirS;
1557   ns_fd_data.initS = initS;
1558 #endif
1560   /* runModalForDirectory/runModal restarts the main event loop when done,
1561      so we must start an event loop and then pop up the file dialog.
1562      The file dialog may pop up a confirm dialog after Ok has been pressed,
1563      so we can not simply pop down on the Ok/Cancel press.
1564    */
1565   nxev = [NSEvent otherEventWithType: NSApplicationDefined
1566                             location: NSMakePoint (0, 0)
1567                        modifierFlags: 0
1568                            timestamp: 0
1569                         windowNumber: [[NSApp mainWindow] windowNumber]
1570                              context: [NSApp context]
1571                              subtype: 0
1572                                data1: 0
1573                                data2: NSAPP_DATA2_RUNFILEDIALOG];
1575   [NSApp postEvent: nxev atStart: NO];
1576   while (ns_fd_data.panel != nil)
1577     [NSApp run];
1579   ret = (ns_fd_data.ret == NSOKButton);
1581   if (ret)
1582     {
1583       NSString *str = ns_filename_from_panel (panel);
1584       if (! str) str = ns_directory_from_panel (panel);
1585       if (! str) ret = NO;
1586       else fname = build_string ([str UTF8String]);
1587     }
1589   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1590   unblock_input ();
1592   return ret ? fname : Qnil;
1595 const char *
1596 ns_get_defaults_value (const char *key)
1598   NSObject *obj = [[NSUserDefaults standardUserDefaults]
1599                     objectForKey: [NSString stringWithUTF8String: key]];
1601   if (!obj) return NULL;
1603   return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1607 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1608        doc: /* Return the value of the property NAME of OWNER from the defaults database.
1609 If OWNER is nil, Emacs is assumed.  */)
1610      (Lisp_Object owner, Lisp_Object name)
1612   const char *value;
1614   check_window_system (NULL);
1615   if (NILP (owner))
1616     owner = build_string([ns_app_name UTF8String]);
1617   CHECK_STRING (name);
1619   value = ns_get_defaults_value (SSDATA (name));
1621   if (value)
1622     return build_string (value);
1623   return Qnil;
1627 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1628        doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1629 If OWNER is nil, Emacs is assumed.
1630 If VALUE is nil, the default is removed.  */)
1631      (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1633   check_window_system (NULL);
1634   if (NILP (owner))
1635     owner = build_string ([ns_app_name UTF8String]);
1636   CHECK_STRING (name);
1637   if (NILP (value))
1638     {
1639       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1640                          [NSString stringWithUTF8String: SSDATA (name)]];
1641     }
1642   else
1643     {
1644       CHECK_STRING (value);
1645       [[NSUserDefaults standardUserDefaults] setObject:
1646                 [NSString stringWithUTF8String: SSDATA (value)]
1647                                         forKey: [NSString stringWithUTF8String:
1648                                                          SSDATA (name)]];
1649     }
1651   return Qnil;
1655 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1656        Sx_server_max_request_size,
1657        0, 1, 0,
1658        doc: /* This function is a no-op.  It is only present for completeness.  */)
1659      (Lisp_Object terminal)
1661   check_ns_display_info (terminal);
1662   /* This function has no real equivalent under NeXTstep.  Return nil to
1663      indicate this. */
1664   return Qnil;
1668 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1669        doc: /* Return the "vendor ID" string of Nextstep display server TERMINAL.
1670 \(Labeling every distributor as a "vendor" embodies the false assumption
1671 that operating systems cannot be developed and distributed noncommercially.)
1672 The optional argument TERMINAL specifies which display to ask about.
1673 TERMINAL should be a terminal object, a frame or a display name (a string).
1674 If omitted or nil, that stands for the selected frame's display.  */)
1675   (Lisp_Object terminal)
1677   check_ns_display_info (terminal);
1678 #ifdef NS_IMPL_GNUSTEP
1679   return build_string ("GNU");
1680 #else
1681   return build_string ("Apple");
1682 #endif
1686 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1687        doc: /* Return the version numbers of the server of display TERMINAL.
1688 The value is a list of three integers: the major and minor
1689 version numbers of the X Protocol in use, and the distributor-specific release
1690 number.  See also the function `x-server-vendor'.
1692 The optional argument TERMINAL specifies which display to ask about.
1693 TERMINAL should be a terminal object, a frame or a display name (a string).
1694 If omitted or nil, that stands for the selected frame's display.  */)
1695   (Lisp_Object terminal)
1697   check_ns_display_info (terminal);
1698   /*NOTE: it is unclear what would best correspond with "protocol";
1699           we return 10.3, meaning Panther, since this is roughly the
1700           level that GNUstep's APIs correspond to.
1701           The last number is where we distinguish between the Apple
1702           and GNUstep implementations ("distributor-specific release
1703           number") and give int'ized versions of major.minor. */
1704   return list3i (10, 3, ns_appkit_version_int ());
1708 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1709        doc: /* Return the number of screens on Nextstep display server TERMINAL.
1710 The optional argument TERMINAL specifies which display to ask about.
1711 TERMINAL should be a terminal object, a frame or a display name (a string).
1712 If omitted or nil, that stands for the selected frame's display.
1714 Note: "screen" here is not in Nextstep terminology but in X11's.  For
1715 the number of physical monitors, use `(length
1716 (display-monitor-attributes-list TERMINAL))' instead.  */)
1717   (Lisp_Object terminal)
1719   check_ns_display_info (terminal);
1720   return make_number (1);
1724 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
1725        doc: /* Return the height in millimeters of the Nextstep display TERMINAL.
1726 The optional argument TERMINAL specifies which display to ask about.
1727 TERMINAL should be a terminal object, a frame or a display name (a string).
1728 If omitted or nil, that stands for the selected frame's display.
1730 On \"multi-monitor\" setups this refers to the height in millimeters for
1731 all physical monitors associated with TERMINAL.  To get information
1732 for each physical monitor, use `display-monitor-attributes-list'.  */)
1733   (Lisp_Object terminal)
1735   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1737   return make_number (x_display_pixel_height (dpyinfo) / (92.0/25.4));
1741 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
1742        doc: /* Return the width in millimeters of the Nextstep display TERMINAL.
1743 The optional argument TERMINAL specifies which display to ask about.
1744 TERMINAL should be a terminal object, a frame or a display name (a string).
1745 If omitted or nil, that stands for the selected frame's display.
1747 On \"multi-monitor\" setups this refers to the width in millimeters for
1748 all physical monitors associated with TERMINAL.  To get information
1749 for each physical monitor, use `display-monitor-attributes-list'.  */)
1750   (Lisp_Object terminal)
1752   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
1754   return make_number (x_display_pixel_width (dpyinfo) / (92.0/25.4));
1758 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1759        Sx_display_backing_store, 0, 1, 0,
1760        doc: /* Return an indication of whether the Nextstep display TERMINAL does backing store.
1761 The value may be `buffered', `retained', or `non-retained'.
1762 The optional argument TERMINAL specifies which display to ask about.
1763 TERMINAL should be a terminal object, a frame or a display name (a string).
1764 If omitted or nil, that stands for the selected frame's display.  */)
1765   (Lisp_Object terminal)
1767   check_ns_display_info (terminal);
1768   switch ([ns_get_window (terminal) backingType])
1769     {
1770     case NSBackingStoreBuffered:
1771       return intern ("buffered");
1772     case NSBackingStoreRetained:
1773       return intern ("retained");
1774     case NSBackingStoreNonretained:
1775       return intern ("non-retained");
1776     default:
1777       error ("Strange value for backingType parameter of frame");
1778     }
1779   return Qnil;  /* not reached, shut compiler up */
1783 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1784        Sx_display_visual_class, 0, 1, 0,
1785        doc: /* Return the visual class of the Nextstep display TERMINAL.
1786 The value is one of the symbols `static-gray', `gray-scale',
1787 `static-color', `pseudo-color', `true-color', or `direct-color'.
1789 The optional argument TERMINAL specifies which display to ask about.
1790 TERMINAL should a terminal object, a frame or a display name (a string).
1791 If omitted or nil, that stands for the selected frame's display.  */)
1792   (Lisp_Object terminal)
1794   NSWindowDepth depth;
1796   check_ns_display_info (terminal);
1797   depth = [[[NSScreen screens] objectAtIndex:0] depth];
1799   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1800     return intern ("static-gray");
1801   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1802     return intern ("gray-scale");
1803   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1804     return intern ("pseudo-color");
1805   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1806     return intern ("true-color");
1807   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1808     return intern ("direct-color");
1809   else
1810     /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1811     return intern ("direct-color");
1815 DEFUN ("x-display-save-under", Fx_display_save_under,
1816        Sx_display_save_under, 0, 1, 0,
1817        doc: /* Return t if TERMINAL supports the save-under feature.
1818 The optional argument TERMINAL specifies which display to ask about.
1819 TERMINAL should be a terminal object, a frame or a display name (a string).
1820 If omitted or nil, that stands for the selected frame's display.  */)
1821   (Lisp_Object terminal)
1823   check_ns_display_info (terminal);
1824   switch ([ns_get_window (terminal) backingType])
1825     {
1826     case NSBackingStoreBuffered:
1827       return Qt;
1829     case NSBackingStoreRetained:
1830     case NSBackingStoreNonretained:
1831       return Qnil;
1833     default:
1834       error ("Strange value for backingType parameter of frame");
1835     }
1836   return Qnil;  /* not reached, shut compiler up */
1840 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1841        1, 3, 0,
1842        doc: /* Open a connection to a display server.
1843 DISPLAY is the name of the display to connect to.
1844 Optional second arg XRM-STRING is a string of resources in xrdb format.
1845 If the optional third arg MUST-SUCCEED is non-nil,
1846 terminate Emacs if we can't open the connection.
1847 \(In the Nextstep version, the last two arguments are currently ignored.)  */)
1848      (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1850   struct ns_display_info *dpyinfo;
1852   CHECK_STRING (display);
1854   nxatoms_of_nsselect ();
1855   dpyinfo = ns_term_init (display);
1856   if (dpyinfo == 0)
1857     {
1858       if (!NILP (must_succeed))
1859         fatal ("Display on %s not responding.\n",
1860                SSDATA (display));
1861       else
1862         error ("Display on %s not responding.\n",
1863                SSDATA (display));
1864     }
1866   return Qnil;
1870 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1871        1, 1, 0,
1872        doc: /* Close the connection to TERMINAL's Nextstep display server.
1873 For TERMINAL, specify a terminal object, a frame or a display name (a
1874 string).  If TERMINAL is nil, that stands for the selected frame's
1875 terminal.  */)
1876      (Lisp_Object terminal)
1878   check_ns_display_info (terminal);
1879   [NSApp terminate: NSApp];
1880   return Qnil;
1884 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1885        doc: /* Return the list of display names that Emacs has connections to.  */)
1886      (void)
1888   Lisp_Object result = Qnil;
1889   struct ns_display_info *ndi;
1891   for (ndi = x_display_list; ndi; ndi = ndi->next)
1892     result = Fcons (XCAR (ndi->name_list_element), result);
1894   return result;
1898 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1899        0, 0, 0,
1900        doc: /* Hides all applications other than Emacs.  */)
1901      (void)
1903   check_window_system (NULL);
1904   [NSApp hideOtherApplications: NSApp];
1905   return Qnil;
1908 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1909        1, 1, 0,
1910        doc: /* If ON is non-nil, the entire Emacs application is hidden.
1911 Otherwise if Emacs is hidden, it is unhidden.
1912 If ON is equal to `activate', Emacs is unhidden and becomes
1913 the active application.  */)
1914      (Lisp_Object on)
1916   check_window_system (NULL);
1917   if (EQ (on, intern ("activate")))
1918     {
1919       [NSApp unhide: NSApp];
1920       [NSApp activateIgnoringOtherApps: YES];
1921     }
1922   else if (NILP (on))
1923     [NSApp unhide: NSApp];
1924   else
1925     [NSApp hide: NSApp];
1926   return Qnil;
1930 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1931        0, 0, 0,
1932        doc: /* Shows the 'Info' or 'About' panel for Emacs.  */)
1933      (void)
1935   check_window_system (NULL);
1936   [NSApp orderFrontStandardAboutPanel: nil];
1937   return Qnil;
1941 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1942        doc: /* Determine font PostScript or family name for font NAME.
1943 NAME should be a string containing either the font name or an XLFD
1944 font descriptor.  If string contains `fontset' and not
1945 `fontset-startup', it is left alone. */)
1946      (Lisp_Object name)
1948   char *nm;
1949   CHECK_STRING (name);
1950   nm = SSDATA (name);
1952   if (nm[0] != '-')
1953     return name;
1954   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1955     return name;
1957   return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1961 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1962        doc: /* Return a list of all available colors.
1963 The optional argument FRAME is currently ignored.  */)
1964      (Lisp_Object frame)
1966   Lisp_Object list = Qnil;
1967   NSEnumerator *colorlists;
1968   NSColorList *clist;
1970   if (!NILP (frame))
1971     {
1972       CHECK_FRAME (frame);
1973       if (! FRAME_NS_P (XFRAME (frame)))
1974         error ("non-Nextstep frame used in `ns-list-colors'");
1975     }
1977   block_input ();
1979   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1980   while ((clist = [colorlists nextObject]))
1981     {
1982       if ([[clist name] length] < 7 ||
1983           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1984         {
1985           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1986           NSString *cname;
1987           while ((cname = [cnames nextObject]))
1988             list = Fcons (build_string ([cname UTF8String]), list);
1989 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1990                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1991                                              UTF8String]), list); */
1992         }
1993     }
1995   unblock_input ();
1997   return list;
2001 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
2002        doc: /* List available Nextstep services by querying NSApp.  */)
2003      (void)
2005 #ifdef NS_IMPL_COCOA
2006   /* You can't get services like this in 10.6+.  */
2007   return Qnil;
2008 #else
2009   Lisp_Object ret = Qnil;
2010   NSMenu *svcs;
2011 #ifdef NS_IMPL_COCOA
2012   id delegate;
2013 #endif
2015   check_window_system (NULL);
2016   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
2017   [NSApp setServicesMenu: svcs];
2018   [NSApp registerServicesMenuSendTypes: ns_send_types
2019                            returnTypes: ns_return_types];
2021 /* On Tiger, services menu updating was made lazier (waits for user to
2022    actually click on the menu), so we have to force things along: */
2023 #ifdef NS_IMPL_COCOA
2024   delegate = [svcs delegate];
2025   if (delegate != nil)
2026     {
2027       if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2028         [delegate menuNeedsUpdate: svcs];
2029       if ([delegate respondsToSelector:
2030                        @selector (menu:updateItem:atIndex:shouldCancel:)])
2031         {
2032           int i, len = [delegate numberOfItemsInMenu: svcs];
2033           for (i =0; i<len; i++)
2034             [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2035           for (i =0; i<len; i++)
2036             if (![delegate menu: svcs
2037                      updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2038                         atIndex: i shouldCancel: NO])
2039               break;
2040         }
2041     }
2042 #endif
2044   [svcs setAutoenablesItems: NO];
2045 #ifdef NS_IMPL_COCOA
2046   [svcs update]; /* on OS X, converts from '/' structure */
2047 #endif
2049   ret = interpret_services_menu (svcs, Qnil, ret);
2050   return ret;
2051 #endif
2055 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2056        2, 2, 0,
2057        doc: /* Perform Nextstep SERVICE on SEND.
2058 SEND should be either a string or nil.
2059 The return value is the result of the service, as string, or nil if
2060 there was no result.  */)
2061      (Lisp_Object service, Lisp_Object send)
2063   id pb;
2064   NSString *svcName;
2065   char *utfStr;
2067   CHECK_STRING (service);
2068   check_window_system (NULL);
2070   utfStr = SSDATA (service);
2071   svcName = [NSString stringWithUTF8String: utfStr];
2073   pb =[NSPasteboard pasteboardWithUniqueName];
2074   ns_string_to_pasteboard (pb, send);
2076   if (NSPerformService (svcName, pb) == NO)
2077     Fsignal (Qquit, list1 (build_string ("service not available")));
2079   if ([[pb types] count] == 0)
2080     return build_string ("");
2081   return ns_string_from_pasteboard (pb);
2085 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2086        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2087        doc: /* Return an NFC string that matches the UTF-8 NFD string STR.  */)
2088      (Lisp_Object str)
2090 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2091          remove this. */
2092   NSString *utfStr;
2093   Lisp_Object ret = Qnil;
2094   NSAutoreleasePool *pool;
2096   CHECK_STRING (str);
2097   pool = [[NSAutoreleasePool alloc] init];
2098   utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2099 #ifdef NS_IMPL_COCOA
2100   if (utfStr)
2101     utfStr = [utfStr precomposedStringWithCanonicalMapping];
2102 #endif
2103   if (utfStr)
2104     {
2105       const char *cstr = [utfStr UTF8String];
2106       if (cstr)
2107         ret = build_string (cstr);
2108     }
2110   [pool release];
2111   if (NILP (ret))
2112     error ("Invalid UTF-8");
2114   return ret;
2118 #ifdef NS_IMPL_COCOA
2120 /* Compile and execute the AppleScript SCRIPT and return the error
2121    status as function value.  A zero is returned if compilation and
2122    execution is successful, in which case *RESULT is set to a Lisp
2123    string or a number containing the resulting script value.  Otherwise,
2124    1 is returned. */
2125 static int
2126 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2128   NSAppleEventDescriptor *desc;
2129   NSDictionary* errorDict;
2130   NSAppleEventDescriptor* returnDescriptor = NULL;
2132   NSAppleScript* scriptObject =
2133     [[NSAppleScript alloc] initWithSource:
2134                              [NSString stringWithUTF8String: SSDATA (script)]];
2136   returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2137   [scriptObject release];
2138   *result = Qnil;
2140   if (returnDescriptor != NULL)
2141     {
2142       // successful execution
2143       if (kAENullEvent != [returnDescriptor descriptorType])
2144         {
2145           *result = Qt;
2146           // script returned an AppleScript result
2147           if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2148 #if defined (NS_IMPL_COCOA)
2149               (typeUTF16ExternalRepresentation
2150                == [returnDescriptor descriptorType]) ||
2151 #endif
2152               (typeUTF8Text == [returnDescriptor descriptorType]) ||
2153               (typeCString == [returnDescriptor descriptorType]))
2154             {
2155               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2156               if (desc)
2157                 *result = build_string([[desc stringValue] UTF8String]);
2158             }
2159           else
2160             {
2161               /* use typeUTF16ExternalRepresentation? */
2162               // coerce the result to the appropriate ObjC type
2163               desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2164               if (desc)
2165                 *result = make_number([desc int32Value]);
2166             }
2167         }
2168     }
2169   else
2170     {
2171       // no script result, return error
2172       return 1;
2173     }
2174   return 0;
2177 /* Helper function called from sendEvent to run applescript
2178    from within the main event loop.  */
2180 void
2181 ns_run_ascript (void)
2183   if (! NILP (as_script))
2184     as_status = ns_do_applescript (as_script, as_result);
2185   as_script = Qnil;
2188 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2189        doc: /* Execute AppleScript SCRIPT and return the result.
2190 If compilation and execution are successful, the resulting script value
2191 is returned as a string, a number or, in the case of other constructs, t.
2192 In case the execution fails, an error is signaled. */)
2193      (Lisp_Object script)
2195   Lisp_Object result;
2196   int status;
2197   NSEvent *nxev;
2198   struct input_event ev;
2200   CHECK_STRING (script);
2201   check_window_system (NULL);
2203   block_input ();
2205   as_script = script;
2206   as_result = &result;
2208   /* executing apple script requires the event loop to run, otherwise
2209      errors aren't returned and executeAndReturnError hangs forever.
2210      Post an event that runs applescript and then start the event loop.
2211      The event loop is exited when the script is done.  */
2212   nxev = [NSEvent otherEventWithType: NSApplicationDefined
2213                             location: NSMakePoint (0, 0)
2214                        modifierFlags: 0
2215                            timestamp: 0
2216                         windowNumber: [[NSApp mainWindow] windowNumber]
2217                              context: [NSApp context]
2218                              subtype: 0
2219                                data1: 0
2220                                data2: NSAPP_DATA2_RUNASSCRIPT];
2222   [NSApp postEvent: nxev atStart: NO];
2224   // If there are other events, the event loop may exit.  Keep running
2225   // until the script has been handled.  */
2226   ns_init_events (&ev);
2227   while (! NILP (as_script))
2228     [NSApp run];
2229   ns_finish_events ();
2231   status = as_status;
2232   as_status = 0;
2233   as_result = 0;
2234   unblock_input ();
2235   if (status == 0)
2236     return result;
2237   else if (!STRINGP (result))
2238     error ("AppleScript error %d", status);
2239   else
2240     error ("%s", SSDATA (result));
2242 #endif
2246 /* ==========================================================================
2248     Miscellaneous functions not called through hooks
2250    ========================================================================== */
2252 /* called from frame.c */
2253 struct ns_display_info *
2254 check_x_display_info (Lisp_Object frame)
2256   return check_ns_display_info (frame);
2260 void
2261 x_set_scroll_bar_default_width (struct frame *f)
2263   int wid = FRAME_COLUMN_WIDTH (f);
2264   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2265   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2266                                       wid - 1) / wid;
2269 void
2270 x_set_scroll_bar_default_height (struct frame *f)
2272   int height = FRAME_LINE_HEIGHT (f);
2273   FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2274   FRAME_CONFIG_SCROLL_BAR_LINES (f) = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) +
2275                                        height - 1) / height;
2278 /* terms impl this instead of x-get-resource directly */
2279 char *
2280 x_get_string_resource (XrmDatabase rdb, const char *name, const char *class)
2282   /* remove appname prefix; TODO: allow for !="Emacs" */
2283   const char *res, *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2285   check_window_system (NULL);
2287   if (inhibit_x_resources)
2288     /* --quick was passed, so this is a no-op.  */
2289     return NULL;
2291   res = ns_get_defaults_value (toCheck);
2292   return (!res ? NULL :
2293           (!c_strncasecmp (res, "YES", 3) ? "true" :
2294            (!c_strncasecmp (res, "NO", 2) ? "false" : (char *) res)));
2298 Lisp_Object
2299 x_get_focus_frame (struct frame *frame)
2301   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame);
2302   Lisp_Object nsfocus;
2304   if (!dpyinfo->x_focus_frame)
2305     return Qnil;
2307   XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2308   return nsfocus;
2311 /* ==========================================================================
2313     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2315    ========================================================================== */
2318 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2319        doc: /* Internal function called by `color-defined-p', which see.
2320 \(Note that the Nextstep version of this function ignores FRAME.)  */)
2321      (Lisp_Object color, Lisp_Object frame)
2323   NSColor * col;
2324   check_window_system (NULL);
2325   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2329 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2330        doc: /* Internal function called by `color-values', which see.  */)
2331      (Lisp_Object color, Lisp_Object frame)
2333   NSColor * col;
2334   EmacsCGFloat red, green, blue, alpha;
2336   check_window_system (NULL);
2337   CHECK_STRING (color);
2339   block_input ();
2340   if (ns_lisp_to_color (color, &col))
2341     {
2342       unblock_input ();
2343       return Qnil;
2344     }
2346   [[col colorUsingDefaultColorSpace]
2347         getRed: &red green: &green blue: &blue alpha: &alpha];
2348   unblock_input ();
2349   return list3i (lrint (red * 65280), lrint (green * 65280),
2350                  lrint (blue * 65280));
2354 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2355        doc: /* Internal function called by `display-color-p', which see.  */)
2356      (Lisp_Object terminal)
2358   NSWindowDepth depth;
2359   NSString *colorSpace;
2361   check_ns_display_info (terminal);
2362   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2363   colorSpace = NSColorSpaceFromDepth (depth);
2365   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2366          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2367       ? Qnil : Qt;
2371 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2372        0, 1, 0,
2373        doc: /* Return t if the Nextstep display supports shades of gray.
2374 Note that color displays do support shades of gray.
2375 The optional argument TERMINAL specifies which display to ask about.
2376 TERMINAL should be a terminal object, a frame or a display name (a string).
2377 If omitted or nil, that stands for the selected frame's display.  */)
2378   (Lisp_Object terminal)
2380   NSWindowDepth depth;
2382   check_ns_display_info (terminal);
2383   depth = [[[NSScreen screens] objectAtIndex:0] depth];
2385   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2389 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2390        0, 1, 0,
2391        doc: /* Return the width in pixels of the Nextstep display TERMINAL.
2392 The optional argument TERMINAL specifies which display to ask about.
2393 TERMINAL should be a terminal object, a frame or a display name (a string).
2394 If omitted or nil, that stands for the selected frame's display.
2396 On \"multi-monitor\" setups this refers to the pixel width for all
2397 physical monitors associated with TERMINAL.  To get information for
2398 each physical monitor, use `display-monitor-attributes-list'.  */)
2399   (Lisp_Object terminal)
2401   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2403   return make_number (x_display_pixel_width (dpyinfo));
2407 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2408        Sx_display_pixel_height, 0, 1, 0,
2409        doc: /* Return the height in pixels of the Nextstep display TERMINAL.
2410 The optional argument TERMINAL specifies which display to ask about.
2411 TERMINAL should be a terminal object, a frame or a display name (a string).
2412 If omitted or nil, that stands for the selected frame's display.
2414 On \"multi-monitor\" setups this refers to the pixel height for all
2415 physical monitors associated with TERMINAL.  To get information for
2416 each physical monitor, use `display-monitor-attributes-list'.  */)
2417   (Lisp_Object terminal)
2419   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2421   return make_number (x_display_pixel_height (dpyinfo));
2424 #ifdef NS_IMPL_COCOA
2426 /* Returns the name for the screen that OBJ represents, or NULL.
2427    Caller must free return value.
2430 static char *
2431 ns_get_name_from_ioreg (io_object_t obj)
2433   char *name = NULL;
2435   NSDictionary *info = (NSDictionary *)
2436     IODisplayCreateInfoDictionary (obj, kIODisplayOnlyPreferredName);
2437   NSDictionary *names = [info objectForKey:
2438                                 [NSString stringWithUTF8String:
2439                                             kDisplayProductName]];
2441   if ([names count] > 0)
2442     {
2443       NSString *n = [names objectForKey: [[names allKeys]
2444                                                  objectAtIndex:0]];
2445       if (n != nil) name = xstrdup ([n UTF8String]);
2446     }
2448   [info release];
2450   return name;
2453 /* Returns the name for the screen that DID came from, or NULL.
2454    Caller must free return value.
2457 static char *
2458 ns_screen_name (CGDirectDisplayID did)
2460   char *name = NULL;
2462 #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
2463   mach_port_t masterPort;
2464   io_iterator_t it;
2465   io_object_t obj;
2467   // CGDisplayIOServicePort is deprecated.  Do it another (harder) way.
2469   if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
2470       || IOServiceGetMatchingServices (masterPort,
2471                                        IOServiceMatching ("IONDRVDevice"),
2472                                        &it) != kIOReturnSuccess)
2473     return name;
2475   /* Must loop until we find a name.  Many devices can have the same unit
2476      number (represents different GPU parts), but only one has a name.  */
2477   while (! name && (obj = IOIteratorNext (it)))
2478     {
2479       CFMutableDictionaryRef props;
2480       const void *val;
2482       if (IORegistryEntryCreateCFProperties (obj,
2483                                              &props,
2484                                              kCFAllocatorDefault,
2485                                              kNilOptions) == kIOReturnSuccess
2486           && props != nil
2487           && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
2488         {
2489           unsigned nr = [(NSNumber *)val unsignedIntegerValue];
2490           if (nr == CGDisplayUnitNumber (did))
2491             name = ns_get_name_from_ioreg (obj);
2492         }
2494       CFRelease (props);
2495       IOObjectRelease (obj);
2496     }
2498   IOObjectRelease (it);
2500 #else
2502   name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
2504 #endif
2505   return name;
2507 #endif
2509 static Lisp_Object
2510 ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
2511                                 int n_monitors,
2512                                 int primary_monitor,
2513                                 const char *source)
2515   Lisp_Object monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
2516   Lisp_Object frame, rest;
2517   NSArray *screens = [NSScreen screens];
2518   int i;
2520   FOR_EACH_FRAME (rest, frame)
2521     {
2522       struct frame *f = XFRAME (frame);
2524       if (FRAME_NS_P (f))
2525         {
2526           NSView *view = FRAME_NS_VIEW (f);
2527           NSScreen *screen = [[view window] screen];
2528           NSUInteger k;
2530           i = -1;
2531           for (k = 0; i == -1 && k < [screens count]; ++k)
2532             {
2533               if ([screens objectAtIndex: k] == screen)
2534                 i = (int)k;
2535             }
2537           if (i > -1)
2538             ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
2539         }
2540     }
2542   return make_monitor_attribute_list (monitors, n_monitors, primary_monitor,
2543                                       monitor_frames, source);
2546 DEFUN ("ns-display-monitor-attributes-list",
2547        Fns_display_monitor_attributes_list,
2548        Sns_display_monitor_attributes_list,
2549        0, 1, 0,
2550        doc: /* Return a list of physical monitor attributes on the X display TERMINAL.
2552 The optional argument TERMINAL specifies which display to ask about.
2553 TERMINAL should be a terminal object, a frame or a display name (a string).
2554 If omitted or nil, that stands for the selected frame's display.
2556 In addition to the standard attribute keys listed in
2557 `display-monitor-attributes-list', the following keys are contained in
2558 the attributes:
2560  source -- String describing the source from which multi-monitor
2561            information is obtained, \"NS\" is always the source."
2563 Internal use only, use `display-monitor-attributes-list' instead.  */)
2564   (Lisp_Object terminal)
2566   struct terminal *term = decode_live_terminal (terminal);
2567   NSArray *screens;
2568   NSUInteger i, n_monitors;
2569   struct MonitorInfo *monitors;
2570   Lisp_Object attributes_list = Qnil;
2571   CGFloat primary_display_height = 0;
2573   if (term->type != output_ns)
2574     return Qnil;
2576   screens = [NSScreen screens];
2577   n_monitors = [screens count];
2578   if (n_monitors == 0)
2579     return Qnil;
2581   monitors = xzalloc (n_monitors * sizeof *monitors);
2583   for (i = 0; i < [screens count]; ++i)
2584     {
2585       NSScreen *s = [screens objectAtIndex:i];
2586       struct MonitorInfo *m = &monitors[i];
2587       NSRect fr = [s frame];
2588       NSRect vfr = [s visibleFrame];
2589       short y, vy;
2591 #ifdef NS_IMPL_COCOA
2592       NSDictionary *dict = [s deviceDescription];
2593       NSNumber *nid = [dict objectForKey:@"NSScreenNumber"];
2594       CGDirectDisplayID did = [nid unsignedIntValue];
2595 #endif
2596       if (i == 0)
2597         {
2598           primary_display_height = fr.size.height;
2599           y = (short) fr.origin.y;
2600           vy = (short) vfr.origin.y;
2601         }
2602       else
2603         {
2604           // Flip y coordinate as NS has y starting from the bottom.
2605           y = (short) (primary_display_height - fr.size.height - fr.origin.y);
2606           vy = (short) (primary_display_height -
2607                         vfr.size.height - vfr.origin.y);
2608         }
2610       m->geom.x = (short) fr.origin.x;
2611       m->geom.y = y;
2612       m->geom.width = (unsigned short) fr.size.width;
2613       m->geom.height = (unsigned short) fr.size.height;
2615       m->work.x = (short) vfr.origin.x;
2616       // y is flipped on NS, so vy - y are pixels missing at the bottom,
2617       // and fr.size.height - vfr.size.height are pixels missing in total.
2618       // Pixels missing at top are
2619       // fr.size.height - vfr.size.height - vy + y.
2620       // work.y is then pixels missing at top + y.
2621       m->work.y = (short) (fr.size.height - vfr.size.height) - vy + y + y;
2622       m->work.width = (unsigned short) vfr.size.width;
2623       m->work.height = (unsigned short) vfr.size.height;
2625 #ifdef NS_IMPL_COCOA
2626       m->name = ns_screen_name (did);
2628       {
2629         CGSize mms = CGDisplayScreenSize (did);
2630         m->mm_width = (int) mms.width;
2631         m->mm_height = (int) mms.height;
2632       }
2634 #else
2635       // Assume 92 dpi as x-display-mm-height/x-display-mm-width does.
2636       m->mm_width = (int) (25.4 * fr.size.width / 92.0);
2637       m->mm_height = (int) (25.4 * fr.size.height / 92.0);
2638 #endif
2639     }
2641   // Primary monitor is always first for NS.
2642   attributes_list = ns_make_monitor_attribute_list (monitors, n_monitors,
2643                                                     0, "NS");
2645   free_monitors (monitors, n_monitors);
2646   return attributes_list;
2650 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2651        0, 1, 0,
2652        doc: /* Return the number of bitplanes of the Nextstep display TERMINAL.
2653 The optional argument TERMINAL specifies which display to ask about.
2654 TERMINAL should be a terminal object, a frame or a display name (a string).
2655 If omitted or nil, that stands for the selected frame's display.  */)
2656   (Lisp_Object terminal)
2658   check_ns_display_info (terminal);
2659   return make_number
2660     (NSBitsPerPixelFromDepth ([[[NSScreen screens] objectAtIndex:0] depth]));
2664 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2665        0, 1, 0,
2666        doc: /* Returns the number of color cells of the Nextstep display TERMINAL.
2667 The optional argument TERMINAL specifies which display to ask about.
2668 TERMINAL should be a terminal object, a frame or a display name (a string).
2669 If omitted or nil, that stands for the selected frame's display.  */)
2670   (Lisp_Object terminal)
2672   struct ns_display_info *dpyinfo = check_ns_display_info (terminal);
2673   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2674   return make_number (1 << min (dpyinfo->n_planes, 24));
2678 /* Unused dummy def needed for compatibility. */
2679 Lisp_Object tip_frame;
2681 /* TODO: move to xdisp or similar */
2682 static void
2683 compute_tip_xy (struct frame *f,
2684                 Lisp_Object parms,
2685                 Lisp_Object dx,
2686                 Lisp_Object dy,
2687                 int width,
2688                 int height,
2689                 int *root_x,
2690                 int *root_y)
2692   Lisp_Object left, top;
2693   EmacsView *view = FRAME_NS_VIEW (f);
2694   struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
2695   NSPoint pt;
2697   /* Start with user-specified or mouse position.  */
2698   left = Fcdr (Fassq (Qleft, parms));
2699   top = Fcdr (Fassq (Qtop, parms));
2701   if (!INTEGERP (left) || !INTEGERP (top))
2702     {
2703       pt.x = dpyinfo->last_mouse_motion_x;
2704       pt.y = dpyinfo->last_mouse_motion_y;
2705       /* Convert to screen coordinates */
2706       pt = [view convertPoint: pt toView: nil];
2707       pt = [[view window] convertBaseToScreen: pt];
2708     }
2709   else
2710     {
2711       /* Absolute coordinates.  */
2712       pt.x = XINT (left);
2713       pt.y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - XINT (top)
2714         - height;
2715     }
2717   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2718   if (INTEGERP (left))
2719     *root_x = pt.x;
2720   else if (pt.x + XINT (dx) <= 0)
2721     *root_x = 0; /* Can happen for negative dx */
2722   else if (pt.x + XINT (dx) + width
2723            <= x_display_pixel_width (FRAME_DISPLAY_INFO (f)))
2724     /* It fits to the right of the pointer.  */
2725     *root_x = pt.x + XINT (dx);
2726   else if (width + XINT (dx) <= pt.x)
2727     /* It fits to the left of the pointer.  */
2728     *root_x = pt.x - width - XINT (dx);
2729   else
2730     /* Put it left justified on the screen -- it ought to fit that way.  */
2731     *root_x = 0;
2733   if (INTEGERP (top))
2734     *root_y = pt.y;
2735   else if (pt.y - XINT (dy) - height >= 0)
2736     /* It fits below the pointer.  */
2737     *root_y = pt.y - height - XINT (dy);
2738   else if (pt.y + XINT (dy) + height
2739            <= x_display_pixel_height (FRAME_DISPLAY_INFO (f)))
2740     /* It fits above the pointer */
2741       *root_y = pt.y + XINT (dy);
2742   else
2743     /* Put it on the top.  */
2744     *root_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height;
2748 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2749        doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2750 A tooltip window is a small window displaying a string.
2752 This is an internal function; Lisp code should call `tooltip-show'.
2754 FRAME nil or omitted means use the selected frame.
2756 PARMS is an optional list of frame parameters which can be used to
2757 change the tooltip's appearance.
2759 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2760 means use the default timeout of 5 seconds.
2762 If the list of frame parameters PARMS contains a `left' parameter,
2763 the tooltip is displayed at that x-position.  Otherwise it is
2764 displayed at the mouse position, with offset DX added (default is 5 if
2765 DX isn't specified).  Likewise for the y-position; if a `top' frame
2766 parameter is specified, it determines the y-position of the tooltip
2767 window, otherwise it is displayed at the mouse position, with offset
2768 DY added (default is -10).
2770 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2771 Text larger than the specified size is clipped.  */)
2772      (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2774   int root_x, root_y;
2775   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2776   ptrdiff_t count = SPECPDL_INDEX ();
2777   struct frame *f;
2778   char *str;
2779   NSSize size;
2781   specbind (Qinhibit_redisplay, Qt);
2783   GCPRO4 (string, parms, frame, timeout);
2785   CHECK_STRING (string);
2786   str = SSDATA (string);
2787   f = decode_window_system_frame (frame);
2788   if (NILP (timeout))
2789     timeout = make_number (5);
2790   else
2791     CHECK_NATNUM (timeout);
2793   if (NILP (dx))
2794     dx = make_number (5);
2795   else
2796     CHECK_NUMBER (dx);
2798   if (NILP (dy))
2799     dy = make_number (-10);
2800   else
2801     CHECK_NUMBER (dy);
2803   block_input ();
2804   if (ns_tooltip == nil)
2805     ns_tooltip = [[EmacsTooltip alloc] init];
2806   else
2807     Fx_hide_tip ();
2809   [ns_tooltip setText: str];
2810   size = [ns_tooltip frame].size;
2812   /* Move the tooltip window where the mouse pointer is.  Resize and
2813      show it.  */
2814   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2815                   &root_x, &root_y);
2817   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2818   unblock_input ();
2820   UNGCPRO;
2821   return unbind_to (count, Qnil);
2825 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2826        doc: /* Hide the current tooltip window, if there is any.
2827 Value is t if tooltip was open, nil otherwise.  */)
2828      (void)
2830   if (ns_tooltip == nil || ![ns_tooltip isActive])
2831     return Qnil;
2832   [ns_tooltip hide];
2833   return Qt;
2837 /* ==========================================================================
2839     Class implementations
2841    ========================================================================== */
2844   Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2845   Return YES if handled, NO if not.
2846  */
2847 static BOOL
2848 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2850   NSString *s;
2851   int i;
2852   BOOL ret = NO;
2854   if ([theEvent type] != NSKeyDown) return NO;
2855   s = [theEvent characters];
2857   for (i = 0; i < [s length]; ++i)
2858     {
2859       int ch = (int) [s characterAtIndex: i];
2860       switch (ch)
2861         {
2862         case NSHomeFunctionKey:
2863         case NSDownArrowFunctionKey:
2864         case NSUpArrowFunctionKey:
2865         case NSLeftArrowFunctionKey:
2866         case NSRightArrowFunctionKey:
2867         case NSPageUpFunctionKey:
2868         case NSPageDownFunctionKey:
2869         case NSEndFunctionKey:
2870           /* Don't send command modified keys, as those are handled in the
2871              performKeyEquivalent method of the super class.
2872           */
2873           if (! ([theEvent modifierFlags] & NSCommandKeyMask))
2874             {
2875               [panel sendEvent: theEvent];
2876               ret = YES;
2877             }
2878           break;
2879           /* As we don't have the standard key commands for
2880              copy/paste/cut/select-all in our edit menu, we must handle
2881              them here.  TODO: handle Emacs key bindings for copy/cut/select-all
2882              here, paste works, because we have that in our Edit menu.
2883              I.e. refactor out code in nsterm.m, keyDown: to figure out the
2884              correct modifier.
2885           */
2886         case 'x': // Cut
2887         case 'c': // Copy
2888         case 'v': // Paste
2889         case 'a': // Select all
2890           if ([theEvent modifierFlags] & NSCommandKeyMask)
2891             {
2892               [NSApp sendAction:
2893                        (ch == 'x'
2894                         ? @selector(cut:)
2895                         : (ch == 'c'
2896                            ? @selector(copy:)
2897                            : (ch == 'v'
2898                               ? @selector(paste:)
2899                               : @selector(selectAll:))))
2900                              to:nil from:panel];
2901               ret = YES;
2902             }
2903         default:
2904           // Send all control keys, as the text field supports C-a, C-f, C-e
2905           // C-b and more.
2906           if ([theEvent modifierFlags] & NSControlKeyMask)
2907             {
2908               [panel sendEvent: theEvent];
2909               ret = YES;
2910             }
2911           break;
2912         }
2913     }
2916   return ret;
2919 @implementation EmacsSavePanel
2920 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2922   BOOL ret = handlePanelKeys (self, theEvent);
2923   if (! ret)
2924     ret = [super performKeyEquivalent:theEvent];
2925   return ret;
2927 @end
2930 @implementation EmacsOpenPanel
2931 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2933   // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2934   BOOL ret = handlePanelKeys (self, theEvent);
2935   if (! ret)
2936     ret = [super performKeyEquivalent:theEvent];
2937   return ret;
2939 @end
2942 @implementation EmacsFileDelegate
2943 /* --------------------------------------------------------------------------
2944    Delegate methods for Open/Save panels
2945    -------------------------------------------------------------------------- */
2946 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2948   return YES;
2950 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2952   return YES;
2954 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2955           confirmed: (BOOL)okFlag
2957   return filename;
2959 @end
2961 #endif
2964 /* ==========================================================================
2966     Lisp interface declaration
2968    ========================================================================== */
2971 void
2972 syms_of_nsfns (void)
2974   Qfontsize = intern_c_string ("fontsize");
2975   staticpro (&Qfontsize);
2977   DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2978                doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2979 If the title of a frame matches REGEXP, then IMAGE.tiff is
2980 selected as the image of the icon representing the frame when it's
2981 miniaturized.  If an element is t, then Emacs tries to select an icon
2982 based on the filetype of the visited file.
2984 The images have to be installed in a folder called English.lproj in the
2985 Emacs folder.  You have to restart Emacs after installing new icons.
2987 Example: Install an icon Gnus.tiff and execute the following code
2989   (setq ns-icon-type-alist
2990         (append ns-icon-type-alist
2991                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2992                    . \"Gnus\"))))
2994 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2995 be used as the image of the icon representing the frame.  */);
2996   Vns_icon_type_alist = list1 (Qt);
2998   DEFVAR_LISP ("ns-version-string", Vns_version_string,
2999                doc: /* Toolkit version for NS Windowing.  */);
3000   Vns_version_string = ns_appkit_version_str ();
3002   defsubr (&Sns_read_file_name);
3003   defsubr (&Sns_get_resource);
3004   defsubr (&Sns_set_resource);
3005   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
3006   defsubr (&Sx_display_grayscale_p);
3007   defsubr (&Sns_font_name);
3008   defsubr (&Sns_list_colors);
3009 #ifdef NS_IMPL_COCOA
3010   defsubr (&Sns_do_applescript);
3011 #endif
3012   defsubr (&Sxw_color_defined_p);
3013   defsubr (&Sxw_color_values);
3014   defsubr (&Sx_server_max_request_size);
3015   defsubr (&Sx_server_vendor);
3016   defsubr (&Sx_server_version);
3017   defsubr (&Sx_display_pixel_width);
3018   defsubr (&Sx_display_pixel_height);
3019   defsubr (&Sns_display_monitor_attributes_list);
3020   defsubr (&Sx_display_mm_width);
3021   defsubr (&Sx_display_mm_height);
3022   defsubr (&Sx_display_screens);
3023   defsubr (&Sx_display_planes);
3024   defsubr (&Sx_display_color_cells);
3025   defsubr (&Sx_display_visual_class);
3026   defsubr (&Sx_display_backing_store);
3027   defsubr (&Sx_display_save_under);
3028   defsubr (&Sx_create_frame);
3029   defsubr (&Sx_open_connection);
3030   defsubr (&Sx_close_connection);
3031   defsubr (&Sx_display_list);
3033   defsubr (&Sns_hide_others);
3034   defsubr (&Sns_hide_emacs);
3035   defsubr (&Sns_emacs_info_panel);
3036   defsubr (&Sns_list_services);
3037   defsubr (&Sns_perform_service);
3038   defsubr (&Sns_convert_utf8_nfd_to_nfc);
3039   defsubr (&Sns_popup_font_panel);
3040   defsubr (&Sns_popup_color_panel);
3042   defsubr (&Sx_show_tip);
3043   defsubr (&Sx_hide_tip);
3045   as_status = 0;
3046   as_script = Qnil;
3047   as_result = 0;