* Makefile.in: Undef LIB_STANDARD before defining it to silence warning
[emacs.git] / src / nsfns.m
blob8ec6518aead7c1eb2c6be6c80d9c4c2a92a4040b
1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
2    Copyright (C) 1989, 1992, 1993, 1994, 2005, 2006, 2008
3      Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
21 Originally by Carl Edman
22 Updated by Christian Limpach (chris@nice.ch)
23 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
24 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
25 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
28 #include <signal.h>
29 #include <math.h>
30 #include "config.h"
31 #include "lisp.h"
32 #include "blockinput.h"
33 #include "nsterm.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "keyboard.h"
37 #include "termhooks.h"
38 #include "fontset.h"
40 #include "character.h"
41 #include "font.h"
43 #if 0
44 int fns_trace_num = 1;
45 #define NSTRACE(x)        fprintf (stderr, "%s:%d: [%d] " #x "\n",        \
46                                   __FILE__, __LINE__, ++fns_trace_num)
47 #else
48 #define NSTRACE(x)
49 #endif
51 #ifdef HAVE_NS
53 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
55 extern Lisp_Object Qforeground_color;
56 extern Lisp_Object Qbackground_color;
57 extern Lisp_Object Qcursor_color;
58 extern Lisp_Object Qinternal_border_width;
59 extern Lisp_Object Qvisibility;
60 extern Lisp_Object Qcursor_type;
61 extern Lisp_Object Qicon_type;
62 extern Lisp_Object Qicon_name;
63 extern Lisp_Object Qicon_left;
64 extern Lisp_Object Qicon_top;
65 extern Lisp_Object Qleft;
66 extern Lisp_Object Qright;
67 extern Lisp_Object Qtop;
68 extern Lisp_Object Qdisplay;
69 extern Lisp_Object Qvertical_scroll_bars;
70 extern Lisp_Object Qauto_raise;
71 extern Lisp_Object Qauto_lower;
72 extern Lisp_Object Qbox;
73 extern Lisp_Object Qscroll_bar_width;
74 extern Lisp_Object Qx_resource_name;
75 extern Lisp_Object Qface_set_after_frame_default;
76 extern Lisp_Object Qunderline, Qundefined;
77 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
78 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
80 Lisp_Object Qnone;
81 Lisp_Object Qns_frame_parameter;
82 Lisp_Object Qbuffered;
83 Lisp_Object Qfontsize;
85 /* hack for OS X file panels */
86 char panelOK = 0;
88 /* Alist of elements (REGEXP . IMAGE) for images of icons associated
89    to frames.*/
90 Lisp_Object Vns_icon_type_alist;
92 EmacsTooltip *ns_tooltip;
94 /* Need forward declaration here to preserve organizational integrity of file */
95 Lisp_Object Fns_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
97 extern BOOL ns_in_resize;
100 /* ==========================================================================
102     Internal utility functions
104    ========================================================================== */
107 void
108 check_ns (void)
110  if (NSApp == nil)
111    error ("OpenStep is not in use or not initialized");
115 /* Nonzero if we can use mouse menus. */
117 have_menus_p ()
119   return NSApp != nil;
123 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
124    and checking validity for NS.  */
125 static FRAME_PTR
126 check_ns_frame (Lisp_Object frame)
128   FRAME_PTR f;
130   if (NILP (frame))
131       f = SELECTED_FRAME ();
132   else
133     {
134       CHECK_LIVE_FRAME (frame);
135       f = XFRAME (frame);
136     }
137   if (! FRAME_NS_P (f))
138     error ("non-NS frame used");
139   return f;
143 /* Let the user specify an NS display with a frame.
144    nil stands for the selected frame--or, if that is not an NS frame,
145    the first NS display on the list.  */
146 static struct ns_display_info *
147 check_ns_display_info (Lisp_Object frame)
149   if (NILP (frame))
150     {
151       struct frame *f = SELECTED_FRAME ();
152       if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
153         return FRAME_NS_DISPLAY_INFO (f);
154       else if (ns_display_list != 0)
155         return ns_display_list;
156       else
157         error ("NS windows are not in use or not initialized");
158     }
159   else if (INTEGERP (frame))
160     {
161       struct terminal *t = get_terminal (frame, 1);
163       if (t->type != output_ns)
164         error ("Terminal %d is not an NS display", XINT (frame));
166       return t->display_info.ns;
167     }
168   else if (STRINGP (frame))
169     return ns_display_info_for_name (frame);
170   else
171     {
172       FRAME_PTR f;
174       CHECK_LIVE_FRAME (frame);
175       f = XFRAME (frame);
176       if (! FRAME_NS_P (f))
177         error ("non-NS frame used");
178       return FRAME_NS_DISPLAY_INFO (f);
179     }
180   return NULL;  /* shut compiler up */
184 static id
185 ns_get_window (Lisp_Object maybeFrame)
187   id view =nil, window =nil;
189   if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
190     maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
192   if (!NILP (maybeFrame))
193     view = FRAME_NS_VIEW (XFRAME (maybeFrame));
194   if (view) window =[view window];
196   return window;
200 static NSScreen *
201 ns_get_screen (Lisp_Object anythingUnderTheSun)
203   id window =nil;
204   NSScreen *screen = 0;
206   struct terminal *terminal;
207   struct ns_display_info *dpyinfo;
208   struct frame *f = NULL;
209   Lisp_Object frame;
211   if (INTEGERP (anythingUnderTheSun)) {
212     /* we got a terminal */
213     terminal = get_terminal (anythingUnderTheSun, 1);
214     dpyinfo = terminal->display_info.ns;
215     f = dpyinfo->ns_focus_frame;
216     if (!f)
217       f = dpyinfo->ns_highlight_frame;
219   } else if (FRAMEP (anythingUnderTheSun) &&
220              FRAME_NS_P (XFRAME (anythingUnderTheSun))) {
221     /* we got a frame */
222     f = XFRAME (anythingUnderTheSun);
224   } else if (STRINGP (anythingUnderTheSun)) { /* FIXME/cl for multi-display */
225   }
227   if (!f)
228     f = SELECTED_FRAME ();
229   if (f)
230     {
231       XSETFRAME (frame, f);
232       window = ns_get_window (frame);
233     }
235   if (window)
236     screen = [window screen];
237   if (!screen)
238     screen = [NSScreen mainScreen];
240   return screen;
244 /* Return the X display structure for the display named NAME.
245    Open a new connection if necessary.  */
246 struct ns_display_info *
247 ns_display_info_for_name (name)
248      Lisp_Object name;
250   Lisp_Object names;
251   struct ns_display_info *dpyinfo;
253   CHECK_STRING (name);
255   for (dpyinfo = ns_display_list, names = ns_display_name_list;
256        dpyinfo;
257        dpyinfo = dpyinfo->next, names = XCDR (names))
258     {
259       Lisp_Object tem;
260       tem = Fstring_equal (XCAR (XCAR (names)), name);
261       if (!NILP (tem))
262         return dpyinfo;
263     }
265   error ("Emacs for OpenStep does not yet support multi-display.");
267   Fns_open_connection (name, Qnil, Qnil);
268   dpyinfo = ns_display_list;
270   if (dpyinfo == 0)
271     error ("OpenStep on %s not responding.\n", SDATA (name));
273   return dpyinfo;
277 static Lisp_Object
278 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
279 /* --------------------------------------------------------------------------
280    Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
281    -------------------------------------------------------------------------- */
283   int i, count;
284   id<NSMenuItem> item;
285   const char *name;
286   Lisp_Object nameStr;
287   unsigned short key;
288   NSString *keys;
289   Lisp_Object res;
291   count = [menu numberOfItems];
292   for (i = 0; i<count; i++)
293     {
294       item = [menu itemAtIndex: i];
295       name = [[item title] UTF8String];
296       if (!name) continue;
298       nameStr = build_string (name);
300       if ([item hasSubmenu])
301         {
302           old = interpret_services_menu ([item submenu],
303                                         Fcons (nameStr, prefix), old);
304         }
305       else
306         {
307           keys = [item keyEquivalent];
308           if (keys && [keys length] )
309             {
310               key = [keys characterAtIndex: 0];
311               res = make_number (key|super_modifier);
312             }
313           else
314             {
315               res = Qundefined;
316             }
317           old = Fcons (Fcons (res,
318                             Freverse (Fcons (nameStr,
319                                            prefix))),
320                     old);
321         }
322     }
323   return old;
328 /* ==========================================================================
330     Frame parameter setters
332    ========================================================================== */
335 static void
336 ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
338   NSColor *col;
340   if (ns_lisp_to_color (arg, &col))
341     {
342       store_frame_param (f, Qforeground_color, oldval);
343       error ("Unknown color");
344     }
346   [col retain];
347   [f->output_data.ns->foreground_color release];
348   f->output_data.ns->foreground_color = col;
350   if (FRAME_NS_VIEW (f))
351     {
352       update_face_from_frame_parameter (f, Qforeground_color, arg);
353       /*recompute_basic_faces (f); */
354       if (FRAME_VISIBLE_P (f))
355         redraw_frame (f);
356     }
360 static void
361 ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
363   struct face *face;
364   NSColor *col;
365   NSView *view = FRAME_NS_VIEW (f);
366   float alpha;
368   if (ns_lisp_to_color (arg, &col))
369     {
370       store_frame_param (f, Qbackground_color, oldval);
371       error ("Unknown color");
372     }
374   /* clear the frame; in some instances the NS-internal GC appears not to
375      update, or it does update and cannot clear old text properly */
376   if (FRAME_VISIBLE_P (f))
377     ns_clear_frame (f);
379   [col retain];
380   [f->output_data.ns->background_color release];
381   f->output_data.ns->background_color = col;
382   if (view != nil)
383     {
384       [[view window] setBackgroundColor: col];
385       alpha = [col alphaComponent];
387 #ifdef NS_IMPL_COCOA
388       /* the alpha code below only works on 10.4, so we need to do something
389          else (albeit less good) otherwise.
390          Check NSApplication.h for useful NSAppKitVersionNumber values. */
391       if (NSAppKitVersionNumber < 744.0)
392           [[view window] setAlphaValue: alpha];
393 #endif
395       if (alpha != 1.0)
396           [[view window] setOpaque: NO];
397       else
398           [[view window] setOpaque: YES];
400       face = FRAME_DEFAULT_FACE (f);
401       if (face)
402         {
403           col = NS_FACE_BACKGROUND (face);
404           face->background
405              = (EMACS_UINT) [[col colorWithAlphaComponent: alpha] retain];
406           [col release];
408           update_face_from_frame_parameter (f, Qbackground_color, arg);
409         }
411       if (FRAME_VISIBLE_P (f))
412         redraw_frame (f);
413     }
417 static void
418 ns_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
420   NSColor *col;
422   if (ns_lisp_to_color (arg, &col))
423     {
424       store_frame_param (f, Qcursor_color, oldval);
425       error ("Unknown color");
426     }
428   [f->output_data.ns->desired_cursor_color release];
429   f->output_data.ns->desired_cursor_color = [col retain];
431   if (FRAME_VISIBLE_P (f))
432     {
433       x_update_cursor (f, 0);
434       x_update_cursor (f, 1);
435     }
436   update_face_from_frame_parameter (f, Qcursor_color, arg);
440 static void
441 ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
443   NSView *view = FRAME_NS_VIEW (f);
444   NSTRACE (ns_set_icon_name);
446   if (ns_in_resize)
447     return;
449   /* see if it's changed */
450   if (STRINGP (arg))
451     {
452       if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
453         return;
454     }
455   else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
456     return;
458   f->icon_name = arg;
460   if (NILP (arg))
461     {
462       if (!NILP (f->title))
463         arg = f->title;
464       else
465         /* explicit name and no icon-name -> explicit_name */
466         if (f->explicit_name)
467           arg = f->name;
468         else
469           {
470             /* no explicit name and no icon-name ->
471                name has to be rebuild from icon_title_format */
472             windows_or_buffers_changed++;
473             return;
474           }
475     }
477   /* Don't change the name if it's already NAME.  */
478   if ([[view window] miniwindowTitle] &&
479       ([[[view window] miniwindowTitle]
480              isEqualToString: [NSString stringWithUTF8String:
481                                            SDATA (arg)]]))
482     return;
484   [[view window] setMiniwindowTitle:
485         [NSString stringWithUTF8String: SDATA (arg)]];
489 static void
490 ns_set_name_iconic (struct frame *f, Lisp_Object name, int explicit)
492   NSView *view = FRAME_NS_VIEW (f);
493   NSTRACE (ns_set_name_iconic);
495   if (ns_in_resize)
496     return;
498   /* Make sure that requests from lisp code override requests from
499      Emacs redisplay code.  */
500   if (explicit)
501     {
502       /* If we're switching from explicit to implicit, we had better
503          update the mode lines and thereby update the title.  */
504       if (f->explicit_name && NILP (name))
505         update_mode_lines = 1;
507       f->explicit_name = ! NILP (name);
508     }
509   else if (f->explicit_name)
510     name = f->name;
512   /* title overrides explicit name */
513   if (! NILP (f->title))
514     name = f->title;
516   /* icon_name overrides title and explicit name */
517   if (! NILP (f->icon_name))
518     name = f->icon_name;
520   if (NILP (name))
521     name = build_string
522         ([[[NSProcessInfo processInfo] processName] UTF8String]);
523   else
524     CHECK_STRING (name);
526   /* Don't change the name if it's already NAME.  */
527   if ([[view window] miniwindowTitle] &&
528       ([[[view window] miniwindowTitle]
529              isEqualToString: [NSString stringWithUTF8String:
530                                            SDATA (name)]]))
531     return;
533   [[view window] setMiniwindowTitle:
534         [NSString stringWithUTF8String: SDATA (name)]];
538 static void
539 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
541   NSView *view = FRAME_NS_VIEW (f);
542   NSTRACE (ns_set_name);
544   if (ns_in_resize)
545     return;
547   /* Make sure that requests from lisp code override requests from
548      Emacs redisplay code.  */
549   if (explicit)
550     {
551       /* If we're switching from explicit to implicit, we had better
552          update the mode lines and thereby update the title.  */
553       if (f->explicit_name && NILP (name))
554         update_mode_lines = 1;
556       f->explicit_name = ! NILP (name);
557     }
558   else if (f->explicit_name)
559     return;
561   if (NILP (name))
562     name = build_string
563         ([[[NSProcessInfo processInfo] processName] UTF8String]);
565   f->name = name;
567   /* title overrides explicit name */
568   if (! NILP (f->title))
569     name = f->title;
571   CHECK_STRING (name);
573   /* Don't change the name if it's already NAME.  */
574   if ([[[view window] title]
575             isEqualToString: [NSString stringWithUTF8String:
576                                           SDATA (name)]])
577     return;
578   [[view window] setTitle: [NSString stringWithUTF8String:
579                                         SDATA (name)]];
583 /* This function should be called when the user's lisp code has
584    specified a name for the frame; the name will override any set by the
585    redisplay code.  */
586 static void
587 ns_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
589   NSTRACE (ns_explicitly_set_name);
590   ns_set_name_iconic (f, arg, 1);
591   ns_set_name (f, arg, 1);
595 /* This function should be called by Emacs redisplay code to set the
596    name; names set this way will never override names set by the user's
597    lisp code.  */
598 void
599 x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
601   NSTRACE (x_implicitly_set_name);
602   if (FRAME_ICONIFIED_P (f))
603     ns_set_name_iconic (f, arg, 0);
604   else
605     ns_set_name (f, arg, 0);
609 /* Change the title of frame F to NAME.
610    If NAME is nil, use the frame name as the title.
612    If EXPLICIT is non-zero, that indicates that lisp code is setting the
613    name; if NAME is a string, set F's name to NAME and set
614    F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
616    If EXPLICIT is zero, that indicates that Emacs redisplay code is
617    suggesting a new name, which lisp code should override; if
618    F->explicit_name is set, ignore the new name; otherwise, set it.  */
619 static void
620 ns_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
622   NSTRACE (ns_set_title);
623   /* Don't change the title if it's already NAME.  */
624   if (EQ (name, f->title))
625     return;
627   update_mode_lines = 1;
629   f->title = name;
633 void
634 ns_set_name_as_filename (struct frame *f)
636   NSView *view = FRAME_NS_VIEW (f);
637   Lisp_Object name;
638   Lisp_Object buf = XWINDOW (f->selected_window)->buffer;
639   const char *title;
640   NSAutoreleasePool *pool;
641   NSTRACE (ns_set_name_as_filename);
643   if (f->explicit_name || ! NILP (f->title) || ns_in_resize)
644     return;
646   BLOCK_INPUT;
647   pool = [[NSAutoreleasePool alloc] init];
648   name =XBUFFER (buf)->filename;
649   if (NILP (name) || FRAME_ICONIFIED_P (f)) name =XBUFFER (buf)->name;
651   if (FRAME_ICONIFIED_P (f) && !NILP (f->icon_name))
652     name = f->icon_name;
654   if (NILP (name))
655     name = build_string
656         ([[[NSProcessInfo processInfo] processName] UTF8String]);
657   else
658     CHECK_STRING (name);
660   title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
661                                 : [[[view window] title] UTF8String];
663   if (title && (! strcmp (title, SDATA (name))))
664     {
665       [pool release];
666       UNBLOCK_INPUT;
667       return;
668     }
670   if (! FRAME_ICONIFIED_P (f))
671     {
672 #ifdef NS_IMPL_COCOA
673       /* work around a bug observed on 10.3 where
674          setTitleWithRepresentedFilename does not clear out previous state
675          if given filename does not exist */
676       NSString *str = [NSString stringWithUTF8String: SDATA (name)];
677       if (![[NSFileManager defaultManager] fileExistsAtPath: str])
678         {
679           [[view window] setTitleWithRepresentedFilename: @""];
680           [[view window] setTitle: str];
681         }
682       else
683         {
684           [[view window] setTitleWithRepresentedFilename: str];
685         }
686 #else
687       [[view window] setTitleWithRepresentedFilename:
688                          [NSString stringWithUTF8String: SDATA (name)]];
689 #endif
690       f->name = name;
691     }
692   else
693     {
694       [[view window] setMiniwindowTitle:
695             [NSString stringWithUTF8String: SDATA (name)]];
696     }
697   [pool release];
698   UNBLOCK_INPUT;
702 void
703 ns_set_doc_edited (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
705   NSView *view = FRAME_NS_VIEW (f);
706   NSAutoreleasePool *pool;
707   BLOCK_INPUT;
708   pool = [[NSAutoreleasePool alloc] init];
709   [[view window] setDocumentEdited: !NILP (arg)];
710   [pool release];
711   UNBLOCK_INPUT;
715 static void
716 ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
718   int nlines;
719   int olines = FRAME_MENU_BAR_LINES (f);
720   if (FRAME_MINIBUF_ONLY_P (f))
721     return;
723   if (INTEGERP (value))
724     nlines = XINT (value);
725   else
726     nlines = 0;
728   FRAME_MENU_BAR_LINES (f) = 0;
729   if (nlines)
730     {
731       FRAME_EXTERNAL_MENU_BAR (f) = 1;
732 /* does for all frames, whereas we just want for one frame
733         [NSMenu setMenuBarVisible: YES]; */
734     }
735   else
736     {
737       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
738         free_frame_menubar (f);
739 /*      [NSMenu setMenuBarVisible: NO]; */
740       FRAME_EXTERNAL_MENU_BAR (f) = 0;
741     }
745 /* 23: PENDING: there is an erroneous direct call in window.c to this fn */
746 void
747 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
749   ns_set_menu_bar_lines (f, value, oldval);
753 /* 23: toolbar support */
754 static void
755 ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
757   int nlines;
758   Lisp_Object root_window;
760   if (FRAME_MINIBUF_ONLY_P (f))
761     return;
763   if (INTEGERP (value) && XINT (value) >= 0)
764     nlines = XFASTINT (value);
765   else
766     nlines = 0;
768   if (nlines)
769     {
770       FRAME_EXTERNAL_TOOL_BAR (f) = 1;
771       update_frame_tool_bar (f);
772     }
773   else
774     {
775       if (FRAME_EXTERNAL_TOOL_BAR (f))
776         {
777           free_frame_tool_bar (f);
778           FRAME_EXTERNAL_TOOL_BAR (f) = 0;
779         }
780     }
782   x_set_window_size (f, 0, f->text_cols, f->text_lines);
786 /* 23: PENDING: there is an erroneous direct call in window.c to this fn */
787 void
788 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
790   ns_set_tool_bar_lines (f, value, oldval);
794 void
795 ns_implicitly_set_icon_type (struct frame *f)
797   Lisp_Object tem;
798   EmacsView *view = FRAME_NS_VIEW (f);
799   id image =nil;
800   Lisp_Object chain, elt;
801   NSAutoreleasePool *pool;
802   BOOL setMini = YES;
804   NSTRACE (ns_implicitly_set_icon_type);
806   BLOCK_INPUT;
807   pool = [[NSAutoreleasePool alloc] init];
808   if (f->output_data.ns->miniimage
809       && [[NSString stringWithUTF8String: SDATA (f->name)]
810                isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
811     {
812       [pool release];
813       UNBLOCK_INPUT;
814       return;
815     }
817   tem = assq_no_quit (Qicon_type, f->param_alist);
818   if (CONSP (tem) && ! NILP (XCDR (tem)))
819     {
820       [pool release];
821       UNBLOCK_INPUT;
822       return;
823     }
825   for (chain = Vns_icon_type_alist;
826        (image = nil) && CONSP (chain);
827        chain = XCDR (chain))
828     {
829       elt = XCAR (chain);
830       /* special case: 't' means go by file type */
831       if (SYMBOLP (elt) && EQ (elt, Qt) && SDATA (f->name)[0] == '/')
832         {
833           NSString *str
834              = [NSString stringWithUTF8String: SDATA (f->name)];
835           if ([[NSFileManager defaultManager] fileExistsAtPath: str])
836             image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
837         }
838       else if (CONSP (elt) &&
839                STRINGP (XCAR (elt)) &&
840                STRINGP (XCDR (elt)) &&
841                fast_string_match (XCAR (elt), f->name) >= 0)
842         {
843           image = [EmacsImage allocInitFromFile: XCDR (elt)];
844           if (image == nil)
845             image = [[NSImage imageNamed:
846                                [NSString stringWithUTF8String:
847                                             SDATA (XCDR (elt))]] retain];
848         }
849     }
851   if (image == nil)
852     {
853       image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
854       setMini = NO;
855     }
857   [f->output_data.ns->miniimage release];
858   f->output_data.ns->miniimage = image;
859   [view setMiniwindowImage: setMini];
860   [pool release];
861   UNBLOCK_INPUT;
865 static void
866 ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
868   EmacsView *view = FRAME_NS_VIEW (f);
869   id image = nil;
870   BOOL setMini = YES;
872   NSTRACE (ns_set_icon_type);
874   if (!NILP (arg) && SYMBOLP (arg))
875     {
876       arg =build_string (SDATA (SYMBOL_NAME (arg)));
877       store_frame_param (f, Qicon_type, arg);
878     }
880   /* do it the implicit way */
881   if (NILP (arg))
882     {
883       ns_implicitly_set_icon_type (f);
884       return;
885     }
887   CHECK_STRING (arg);
889   image = [EmacsImage allocInitFromFile: arg];
890   if (image == nil)
891     image =[NSImage imageNamed: [NSString stringWithUTF8String:
892                                             SDATA (arg)]];
894   if (image == nil)
895     {
896       image = [NSImage imageNamed: @"text"];
897       setMini = NO;
898     }
900   f->output_data.ns->miniimage = image;
901   [view setMiniwindowImage: setMini];
905 /* 23: added Xism; we stub out (we do implement this in ns-win.el) */
907 XParseGeometry (char *string, int *x, int *y,
908                 unsigned int *width, unsigned int *height)
910   message1 ("Warning: XParseGeometry not supported under NS.\n");
911   return 0;
915 /*PENDING: move to nsterm? */
917 ns_lisp_to_cursor_type (Lisp_Object arg)
919   char *str;
920   if (XTYPE (arg) == Lisp_String)
921     str = SDATA (arg);
922   else if (XTYPE (arg) == Lisp_Symbol)
923     str = SDATA (SYMBOL_NAME (arg));
924   else return -1;
925   if (!strcmp (str, "box"))      return filled_box;
926   if (!strcmp (str, "hollow"))   return hollow_box;
927   if (!strcmp (str, "underscore")) return underscore;
928   if (!strcmp (str, "bar"))      return bar;
929   if (!strcmp (str, "no"))       return no_highlight;
930   return -1;
934 Lisp_Object
935 ns_cursor_type_to_lisp (int arg)
937   switch (arg)
938     {
939     case filled_box: return Qbox;
940     case hollow_box: return intern ("hollow");
941     case underscore: return intern ("underscore");
942     case bar:        return intern ("bar");
943     case no_highlight:
944     default:         return intern ("no");
945     }
949 static void
950 ns_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
952   int val;
954   val = ns_lisp_to_cursor_type (arg);
955   if (val >= 0)
956     {
957       f->output_data.ns->desired_cursor =val;
958     }
959   else
960     {
961       store_frame_param (f, Qcursor_type, oldval);
962       error ("the `cursor-type' frame parameter should be either `no', `box', \
963 `hollow', `underscore' or `bar'.");
964     }
966   update_mode_lines++;
970 /* 23: called to set mouse pointer color, but all other terms use it to
971        initialize pointer types (and don't set the color ;) */
972 static void
973 ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
975   /* don't think we can do this on NS */
979 static void
980 ns_icon (struct frame *f, Lisp_Object parms)
981 /* --------------------------------------------------------------------------
982    Strangely-named function to set icon position parameters in frame.
983    This is irrelevant under OS X, but might be needed under GNUstep,
984    depending on the window manager used.  Note, this is not a standard
985    frame parameter-setter; it is called directly from x-create-frame.
986    -------------------------------------------------------------------------- */
988   Lisp_Object icon_x, icon_y;
989   struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
991   f->output_data.ns->icon_top = Qnil;
992   f->output_data.ns->icon_left = Qnil;
994   /* Set the position of the icon.  */
995   icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
996   icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0,  RES_TYPE_NUMBER);
997   if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
998     {
999       CHECK_NUMBER (icon_x);
1000       CHECK_NUMBER (icon_y);
1001       f->output_data.ns->icon_top = icon_y;
1002       f->output_data.ns->icon_left = icon_x;
1003     }
1004   else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1005     error ("Both left and top icon corners of icon must be specified");
1009 /* 23 Note: commented out ns_... entries are no longer used in 23.
1010             commented out x_... entries have not been implemented yet.
1011    see frame.c for template, also where all generic OK functions are impl */
1012 frame_parm_handler ns_frame_parm_handlers[] =
1014   x_set_autoraise, /* generic OK */
1015   x_set_autolower, /* generic OK */
1016   ns_set_background_color,
1017   0, /* x_set_border_color,  may be impossible under NS */
1018   0, /* x_set_border_width,  may be impossible under NS */
1019   ns_set_cursor_color,
1020   ns_set_cursor_type,
1021   x_set_font, /* generic OK */
1022   ns_set_foreground_color,
1023   ns_set_icon_name,
1024   ns_set_icon_type,
1025   x_set_internal_border_width, /* generic OK */
1026   ns_set_menu_bar_lines,
1027   ns_set_mouse_color,
1028   ns_explicitly_set_name,
1029   x_set_scroll_bar_width, /* generic OK */
1030   ns_set_title,
1031   x_set_unsplittable, /* generic OK */
1032   x_set_vertical_scroll_bars, /* generic OK */
1033   x_set_visibility, /* generic OK */
1034   ns_set_tool_bar_lines,
1035   0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1036   0, /* x_set_scroll_bar_background,  will ignore (not possible on NS) */
1037   x_set_screen_gamma, /* generic OK */
1038   x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
1039   x_set_fringe_width, /* generic OK */
1040   x_set_fringe_width, /* generic OK */
1041   0, /* x_set_wait_for_wm, will ignore */
1042   0,  /* x_set_fullscreen will ignore */
1043   x_set_font_backend /* generic OK */
1047 DEFUN ("x-create-frame", Fns_create_frame, Sns_create_frame,
1048        1, 1, 0,
1049        "Make a new NS window, which is called a \"frame\" in Emacs terms.\n\
1050 Return an Emacs frame object representing the X window.\n\
1051 ALIST is an alist of frame parameters.\n\
1052 If the parameters specify that the frame should not have a minibuffer,\n\
1053 and do not specify a specific minibuffer window to use,\n\
1054 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1055 be shared by the new frame.")
1056      (parms)
1057      Lisp_Object parms;
1059   static int desc_ctr = 1;
1060   struct frame *f;
1061   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1062   Lisp_Object frame, tem;
1063   Lisp_Object name;
1064   int minibuffer_only = 0;
1065   int count = specpdl_ptr - specpdl;
1066   Lisp_Object display;
1067   struct ns_display_info *dpyinfo = NULL;
1068   Lisp_Object parent;
1069   struct kboard *kb;
1070   Lisp_Object tfont, tfontsize;
1071   int window_prompting = 0;
1072   int width, height;
1074   check_ns ();
1076   display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1077   if (EQ (display, Qunbound))
1078     display = Qnil;
1079   dpyinfo = check_ns_display_info (display);
1081   if (!dpyinfo->terminal->name)
1082     error ("Terminal is not live, can't create new frames on it");
1084   kb = dpyinfo->terminal->kboard;
1086   name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1087   if (!STRINGP (name)
1088       && ! EQ (name, Qunbound)
1089       && ! NILP (name))
1090     error ("Invalid frame name--not a string or nil");
1092   if (STRINGP (name))
1093     Vx_resource_name = name;
1095   parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1096   if (EQ (parent, Qunbound))
1097     parent = Qnil;
1098   if (! NILP (parent))
1099     CHECK_NUMBER (parent);
1101   frame = Qnil;
1102   GCPRO4 (parms, parent, name, frame);
1104   tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1105                   RES_TYPE_SYMBOL);
1106   if (EQ (tem, Qnone) || NILP (tem))
1107     {
1108       f = make_frame_without_minibuffer (Qnil, kb, display);
1109     }
1110   else if (EQ (tem, Qonly))
1111     {
1112       f = make_minibuffer_frame ();
1113       minibuffer_only = 1;
1114     }
1115   else if (WINDOWP (tem))
1116     {
1117       f = make_frame_without_minibuffer (tem, kb, display);
1118     }
1119   else
1120     {
1121       f = make_frame (1);
1122     }
1124   /* Set the name; the functions to which we pass f expect the name to
1125      be set.  */
1126   if (EQ (name, Qunbound) || NILP (name) || (XTYPE (name) != Lisp_String))
1127     {
1128       f->name
1129          = build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
1130       f->explicit_name =0;
1131     }
1132   else
1133     {
1134       f->name = name;
1135       f->explicit_name = 1;
1136       specbind (Qx_resource_name, name);
1137     }
1139   XSETFRAME (frame, f);
1140   FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1142   f->terminal = dpyinfo->terminal;
1143   f->terminal->reference_count++;
1145   f->output_method = output_ns;
1146   f->output_data.ns = (struct ns_output *)xmalloc (sizeof *(f->output_data.ns));
1147   bzero (f->output_data.ns, sizeof (*(f->output_data.ns)));
1149   FRAME_FONTSET (f) = -1;
1151   /* record_unwind_protect (unwind_create_frame, frame); safety; maybe later? */
1153   f->icon_name = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
1154                             RES_TYPE_STRING);
1155   if (EQ (f->icon_name, Qunbound) || (XTYPE (f->icon_name) != Lisp_String))
1156     f->icon_name = Qnil;
1158   FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
1160   f->output_data.ns->window_desc = desc_ctr++;
1161   if (!NILP (parent))
1162     {
1163       f->output_data.ns->parent_desc = (Window) XFASTINT (parent);
1164       f->output_data.ns->explicit_parent = 1;
1165     }
1166   else
1167     {
1168       f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window;
1169       f->output_data.ns->explicit_parent = 0;
1170     }
1172   f->resx = dpyinfo->resx;
1173   f->resy = dpyinfo->resy;
1175   BLOCK_INPUT;
1176   register_font_driver (&nsfont_driver, f);
1177   x_default_parameter (f, parms, Qfont_backend, Qnil,
1178                         "fontBackend", "FontBackend", RES_TYPE_STRING);
1180   {
1181     /* use for default font name */
1182     id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1183     tfontsize = x_default_parameter (f, parms, Qfontsize,
1184                                     make_number (0 /*(int)[font pointSize]*/),
1185                                     "fontSize", "FontSize", RES_TYPE_NUMBER);
1186     tfont = x_default_parameter (f, parms, Qfont,
1187                                  build_string ([[font fontName] UTF8String]),
1188                                  "font", "Font", RES_TYPE_STRING);
1189   }
1190   UNBLOCK_INPUT;
1192   x_default_parameter (f, parms, Qborder_width, make_number (0),
1193                        "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1194   x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1195                       "internalBorderWidth", "InternalBorderWidth",
1196                       RES_TYPE_NUMBER);
1198   /* default scrollbars on right on Mac */
1199   {
1200       Lisp_Object spos
1201 #ifdef NS_IMPL_GNUSTEP
1202           = Qt;
1203 #else
1204           = Qright;
1205 #endif
1206       x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1207                            "verticalScrollBars", "VerticalScrollBars",
1208                            RES_TYPE_SYMBOL);
1209   }
1210   x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1211                       "foreground", "Foreground", RES_TYPE_STRING);
1212   x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1213                       "background", "Background", RES_TYPE_STRING);
1214   x_default_parameter (f, parms, Qcursor_color, build_string ("grey"),
1215                       "cursorColor", "CursorColor", RES_TYPE_STRING);
1216   /*PENDING: not suppported yet in NS */
1217   x_default_parameter (f, parms, Qline_spacing, Qnil,
1218                        "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1219   x_default_parameter (f, parms, Qleft_fringe, Qnil,
1220                        "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1221   x_default_parameter (f, parms, Qright_fringe, Qnil,
1222                        "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1223   /* end PENDING */
1225   init_frame_faces (f);
1227   x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0), "menuBar",
1228                       "menuBar", RES_TYPE_NUMBER);
1229   x_default_parameter (f, parms, Qtool_bar_lines, make_number (0), "toolBar",
1230                       "toolBar", RES_TYPE_NUMBER);
1231   x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1232                        "BufferPredicate", RES_TYPE_SYMBOL);
1233   x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1234                        RES_TYPE_STRING);
1236 /*PENDING: other terms seem to get away w/o this complexity.. */
1237   if (NILP (Fassq (Qwidth, parms)))
1238     {
1239       Lisp_Object value
1240          = x_get_arg (dpyinfo, parms, Qwidth, "width", "Width",
1241                       RES_TYPE_NUMBER);
1242       if (! EQ (value, Qunbound))
1243         parms = Fcons (Fcons (Qwidth, value), parms);
1244     }
1245   if (NILP (Fassq (Qheight, parms)))
1246     {
1247       Lisp_Object value
1248          = x_get_arg (dpyinfo, parms, Qheight, "height", "Height",
1249                       RES_TYPE_NUMBER);
1250       if (! EQ (value, Qunbound))
1251         parms = Fcons (Fcons (Qheight, value), parms);
1252     }
1253   if (NILP (Fassq (Qleft, parms)))
1254     {
1255       Lisp_Object value
1256          = x_get_arg (dpyinfo, parms, Qleft, "left", "Left", RES_TYPE_NUMBER);
1257       if (! EQ (value, Qunbound))
1258         parms = Fcons (Fcons (Qleft, value), parms);
1259     }
1260   if (NILP (Fassq (Qtop, parms)))
1261     {
1262       Lisp_Object value
1263          = x_get_arg (dpyinfo, parms, Qtop, "top", "Top", RES_TYPE_NUMBER);
1264       if (! EQ (value, Qunbound))
1265         parms = Fcons (Fcons (Qtop, value), parms);
1266     }
1268   window_prompting = x_figure_window_size (f, parms, 1);
1270   tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1271   f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1273   /* NOTE: on other terms, this is done in set_mouse_color, however this
1274      was not getting called under NS */
1275   f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1276   f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1277   f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1278   f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1279   f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1280   f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1281   FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1282      = [NSCursor arrowCursor];
1283   f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1285   [[EmacsView alloc] initFrameFromEmacs: f];
1287   ns_icon (f, parms);
1289   /* It is now ok to make the frame official even if we get an error below.
1290      The frame needs to be on Vframe_list or making it visible won't work. */
1291   Vframe_list = Fcons (frame, Vframe_list);
1292   /*FRAME_NS_DISPLAY_INFO (f)->reference_count++; */
1294   x_default_parameter (f, parms, Qcursor_type, Qbox, "cursorType", "CursorType",
1295                       RES_TYPE_SYMBOL);
1296   x_default_parameter (f, parms, Qscroll_bar_width, Qnil, "scrollBarWidth",
1297                       "ScrollBarWidth", RES_TYPE_NUMBER);
1298   x_default_parameter (f, parms, Qicon_type, Qnil, "bitmapIcon", "BitmapIcon",
1299                       RES_TYPE_SYMBOL);
1300   x_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaise",
1301                       RES_TYPE_BOOLEAN);
1302   x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoLower",
1303                       RES_TYPE_BOOLEAN);
1304   x_default_parameter (f, parms, Qbuffered, Qt, "buffered", "Buffered",
1305                       RES_TYPE_BOOLEAN);
1307   width = FRAME_COLS (f);
1308   height = FRAME_LINES (f);
1310   SET_FRAME_COLS (f, 0);
1311   FRAME_LINES (f) = 0;
1312   change_frame_size (f, height, width, 1, 0, 0);
1314   if (! f->output_data.ns->explicit_parent)
1315     {
1316         tem = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_BOOLEAN);
1317         if (EQ (tem, Qunbound))
1318             tem = Qnil;
1320         x_set_visibility (f, tem, Qnil);
1321         if (EQ (tem, Qt))
1322             [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1323     }
1325   if (FRAME_HAS_MINIBUF_P (f)
1326       && (!FRAMEP (kb->Vdefault_minibuffer_frame)
1327           || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
1328     kb->Vdefault_minibuffer_frame = frame;
1330   /* All remaining specified parameters, which have not been "used"
1331      by x_get_arg and friends, now go in the misc. alist of the frame.  */
1332   for (tem = parms; CONSP (tem); tem = XCDR (tem))
1333     if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1334       f->param_alist = Fcons (XCAR (tem), f->param_alist);
1336   UNGCPRO;
1337   Vwindow_list = Qnil;
1339   return unbind_to (count, frame);
1343 /* ==========================================================================
1345     Lisp definitions
1347    ========================================================================== */
1349 DEFUN ("ns-focus-frame", Fns_focus_frame, Sns_focus_frame, 1, 1, 0,
1350        doc: /* Set the input focus to FRAME.
1351 FRAME nil means use the selected frame.  */)
1352      (frame)
1353      Lisp_Object frame;
1355   struct frame *f = check_ns_frame (frame);
1356   struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1358   if (dpyinfo->ns_focus_frame != f)
1359     {
1360       EmacsView *view = FRAME_NS_VIEW (f);
1361       BLOCK_INPUT;
1362       [[view window] makeKeyAndOrderFront: view];
1363       UNBLOCK_INPUT;
1364     }
1366   return Qnil;
1370 DEFUN ("ns-popup-prefs-panel", Fns_popup_prefs_panel, Sns_popup_prefs_panel,
1371        0, 0, "", "Pop up the preferences panel.")
1372      ()
1374   check_ns ();
1375   [(EmacsApp *)NSApp showPreferencesWindow: NSApp];
1376   return Qnil;
1380 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1381        0, 1, "", "Pop up the font panel.")
1382      (frame)
1383      Lisp_Object frame;
1385   id fm;
1386   struct frame *f;
1388   check_ns ();
1389   fm = [NSFontManager new];
1390   if (NILP (frame))
1391     f = SELECTED_FRAME ();
1392   else
1393     {
1394       CHECK_FRAME (frame);
1395       f = XFRAME (frame);
1396     }
1398   [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1399            isMultiple: NO];
1400   [fm orderFrontFontPanel: NSApp];
1401   return Qnil;
1405 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, 
1406        0, 1, "", "Pop up the color panel.")
1407      (frame)
1408      Lisp_Object frame;
1410   struct frame *f;
1412   check_ns ();
1413   if (NILP (frame))
1414     f = SELECTED_FRAME ();
1415   else
1416     {
1417       CHECK_FRAME (frame);
1418       f = XFRAME (frame);
1419     }
1421   [NSApp orderFrontColorPanel: NSApp];
1422   return Qnil;
1426 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 4, 0,
1427        "As read-file-name except that NS panels are used for querying, and\n\
1428 args are slightly different.  Nil returned if no selection made.\n\
1429 Set ISLOAD non-nil if file being read for a save.")
1430      (prompt, dir, isLoad, init)
1431      Lisp_Object prompt, dir, isLoad, init;
1433   static id fileDelegate = nil;
1434   int ret;
1435   id panel;
1436   NSString *fname;
1438   NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1439     [NSString stringWithUTF8String: SDATA (prompt)];
1440   NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1441     [NSString stringWithUTF8String: SDATA (current_buffer->directory)] :
1442     [NSString stringWithUTF8String: SDATA (dir)];
1443   NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1444     [NSString stringWithUTF8String: SDATA (init)];
1446   check_ns ();
1448   if (fileDelegate == nil)
1449     fileDelegate = [EmacsFileDelegate new];
1451   [NSCursor setHiddenUntilMouseMoves: NO];
1453   if ([dirS characterAtIndex: 0] == '~')
1454     dirS = [dirS stringByExpandingTildeInPath];
1456   panel = NILP (isLoad) ?
1457     [EmacsSavePanel savePanel] : [EmacsOpenPanel openPanel];
1459   [panel setTitle: promptS];
1461   /* Puma (10.1) does not have */
1462   if ([panel respondsToSelector: @selector (setAllowsOtherFileTypes:)])
1463     [panel setAllowsOtherFileTypes: YES];
1465   [panel setTreatsFilePackagesAsDirectories: YES];
1466   [panel setDelegate: fileDelegate];
1468   panelOK = 0;
1469   if (NILP (isLoad))
1470     {
1471       ret = [panel runModalForDirectory: dirS file: initS];
1472     }
1473   else
1474     {
1475       [panel setCanChooseDirectories: YES];
1476       ret = [panel runModalForDirectory: dirS file: initS types: nil];
1477     }
1479   ret = (ret = NSOKButton) || panelOK;
1481   fname = [panel filename];
1483   [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1485   return ret ? build_string ([fname UTF8String]) : Qnil;
1489 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1490        "Return the value of the property NAME of OWNER from the defaults database.\n\
1491 If OWNER is nil, Emacs is assumed.")
1492      (owner, name)
1493      Lisp_Object owner, name;
1495   const char *value;
1497   check_ns ();
1498   if (NILP (owner))
1499     owner = build_string
1500         ([[[NSProcessInfo processInfo] processName] UTF8String]);
1501   /* CHECK_STRING (owner);  this should be just "Emacs" */
1502   CHECK_STRING (name);
1503 /*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SDATA (name)); */
1505   value =[[[NSUserDefaults standardUserDefaults]
1506             objectForKey: [NSString stringWithUTF8String: SDATA (name)]]
1507            UTF8String];
1509   if (value)
1510     return build_string (value);
1511 /*fprintf (stderr, "Nothing found for NS resource '%s'.\n", SDATA (name)); */
1512   return Qnil;
1516 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1517        "Set property NAME of OWNER to VALUE, from the defaults database.\n\
1518 If OWNER is nil, Emacs is assumed.\n\
1519 If VALUE is nil, the default is removed.")
1520      (owner, name, value)
1521      Lisp_Object owner, name, value;
1523   check_ns ();
1524   if (NILP (owner))
1525     owner
1526        = build_string ([[[NSProcessInfo processInfo] processName] UTF8String]);
1527   CHECK_STRING (owner);
1528   CHECK_STRING (name);
1529   if (NILP (value))
1530     {
1531       [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1532                          [NSString stringWithUTF8String: SDATA (name)]];
1533     }
1534   else
1535     {
1536       CHECK_STRING (value);
1537       [[NSUserDefaults standardUserDefaults] setObject:
1538                 [NSString stringWithUTF8String: SDATA (value)]
1539                                         forKey: [NSString stringWithUTF8String:
1540                                                          SDATA (name)]];
1541     }
1543   return Qnil;
1547 DEFUN ("ns-set-alpha", Fns_set_alpha, Sns_set_alpha, 2, 2, 0,
1548        "Return a color same as given with alpha set to given value\n\
1549 from 0 to 1, where 1 is fully opaque.")
1550      (color, alpha)
1551      Lisp_Object color;
1552      Lisp_Object alpha;
1554   NSColor *col;
1555   float a;
1557   CHECK_STRING (color);
1558   CHECK_NUMBER_OR_FLOAT (alpha);
1560   if (ns_lisp_to_color (color, &col))
1561     error ("Unknown color.");
1563   a = XFLOATINT (alpha);
1564   if (a < 0.0 || a > 1.0)
1565     error ("Alpha value should be between 0 and 1 inclusive.");
1567   col = [col colorWithAlphaComponent: a];
1568   return ns_color_to_lisp (col);
1572 DEFUN ("ns-server-max-request-size", Fns_server_max_request_size,
1573        Sns_server_max_request_size,
1574        0, 1, 0,
1575        "This function is only present for completeness.  It does not return\n\
1576 a usable result for NS windows.")
1577      (display)
1578      Lisp_Object display;
1580   check_ns ();
1581   /* This function has no real equivalent under NeXTstep.  Return nil to
1582      indicate this. */
1583   return Qnil;
1587 DEFUN ("ns-server-vendor", Fns_server_vendor, Sns_server_vendor, 0, 1, 0,
1588        "Returns the vendor ID string of the NS server of display DISPLAY.\n\
1589 The optional argument DISPLAY specifies which display to ask about.\n\
1590 DISPLAY should be either a frame or a display name (a string).\n\
1591 If omitted or nil, that stands for the selected frame's display.")
1592      (display)
1593      Lisp_Object display;
1595   check_ns ();
1596 #ifdef NS_IMPL_GNUSTEP
1597   return build_string ("GNU");
1598 #else
1599   return build_string ("Apple");
1600 #endif
1604 DEFUN ("ns-server-version", Fns_server_version, Sns_server_version, 0, 1, 0,
1605        "Returns the version number of the NS release of display DISPLAY.\n\
1606 See also the function `ns-server-vendor'.\n\n\
1607 The optional argument DISPLAY specifies which display to ask about.\n\
1608 DISPLAY should be either a frame or a display name (a string).\n\
1609 If omitted or nil, that stands for the selected frame's display.")
1610      (display)
1611      Lisp_Object display;
1613   /*PENDING: return GUI version on GNUSTEP, ?? on OS X */
1614   return build_string ("1.0");
1618 DEFUN ("ns-display-screens", Fns_display_screens, Sns_display_screens, 0, 1, 0,
1619        "Returns the number of screens on the NS server of display DISPLAY.\n\
1620 The optional argument DISPLAY specifies which display to ask about.\n\
1621 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1622 If omitted or nil, that stands for the selected frame's display.")
1623      (display)
1624      Lisp_Object display;
1626   int num;
1628   check_ns ();
1629   num = [[NSScreen screens] count];
1631   return (num != 0) ? make_number (num) : Qnil;
1635 DEFUN ("ns-display-mm-height", Fns_display_mm_height, Sns_display_mm_height,
1636        0, 1, 0,
1637        "Returns the height in millimeters of the NS display DISPLAY.\n\
1638 The optional argument DISPLAY specifies which display to ask about.\n\
1639 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1640 If omitted or nil, that stands for the selected frame's display.")
1641      (display)
1642      Lisp_Object display;
1644   check_ns ();
1645   return make_number ((int)
1646                      ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1650 DEFUN ("ns-display-mm-width", Fns_display_mm_width, Sns_display_mm_width,
1651        0, 1, 0,
1652        "Returns the width in millimeters of the NS display DISPLAY.\n\
1653 The optional argument DISPLAY specifies which display to ask about.\n\
1654 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1655 If omitted or nil, that stands for the selected frame's display.")
1656      (display)
1657      Lisp_Object display;
1659   check_ns ();
1660   return make_number ((int)
1661                      ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1665 DEFUN ("ns-display-backing-store", Fns_display_backing_store,
1666        Sns_display_backing_store, 0, 1, 0,
1667        "Returns an indication of whether NS display DISPLAY does backing store.\n\
1668 The value may be `buffered', `retained', or `non-retained'.\n\
1669 The optional argument DISPLAY specifies which display to ask about.\n\
1670 DISPLAY should be either a frame, display name (a string), or terminal ID.\n\
1671 If omitted or nil, that stands for the selected frame's display.\n\
1672 Under NS, this may differ for each frame.")
1673      (display)
1674      Lisp_Object display;
1676   check_ns ();
1677   switch ([ns_get_window (display) backingType])
1678     {
1679     case NSBackingStoreBuffered:
1680       return intern ("buffered");
1681     case NSBackingStoreRetained:
1682       return intern ("retained");
1683     case NSBackingStoreNonretained:
1684       return intern ("non-retained");
1685     default:
1686       error ("Strange value for backingType parameter of frame");
1687     }
1688   return Qnil;  /* not reached, shut compiler up */
1692 DEFUN ("ns-display-visual-class", Fns_display_visual_class,
1693        Sns_display_visual_class, 0, 1, 0,
1694        "Returns the visual class of the NS display DISPLAY.\n\
1695 The value is one of the symbols `static-gray', `gray-scale',\n\
1696 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
1697 The optional argument DISPLAY specifies which display to ask about.\n\
1698 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1699 If omitted or nil, that stands for the selected frame's display.")
1700      (display)
1701      Lisp_Object display;
1703   NSWindowDepth depth;
1704   check_ns ();
1705   depth = [ns_get_screen (display) depth];
1707   if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1708     return intern ("static-gray");
1709   else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1710     return intern ("gray-scale");
1711   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1712     return intern ("pseudo-color");
1713   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1714     return intern ("true-color");
1715   else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1716     return intern ("direct-color");
1717   else
1718     /* color mgmt as far as we do it is really handled by NS itself anyway */
1719     return intern ("direct-color");
1723 DEFUN ("ns-display-save-under", Fns_display_save_under,
1724        Sns_display_save_under, 0, 1, 0,
1725        "Returns t if the NS display DISPLAY supports the save-under feature.\n\
1726 The optional argument DISPLAY specifies which display to ask about.\n\
1727 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
1728 If omitted or nil, that stands for the selected frame's display.\n\
1729 Under NS, this may differ for each frame.")
1730      (display)
1731      Lisp_Object display;
1733   check_ns ();
1734   switch ([ns_get_window (display) backingType])
1735     {
1736     case NSBackingStoreBuffered:
1737       return Qt;
1739     case NSBackingStoreRetained:
1740     case NSBackingStoreNonretained:
1741       return Qnil;
1743     default:
1744       error ("Strange value for backingType parameter of frame");
1745     }
1746   return Qnil;  /* not reached, shut compiler up */
1750 DEFUN ("ns-open-connection", Fns_open_connection, Sns_open_connection,
1751        1, 3, 0, "Open a connection to a NS server.\n\
1752 DISPLAY is the name of the display to connect to.\n\
1753 Optional arguments XRM-STRING and MUST-SUCCEED are currently ignored.")
1754      (display, resource_string, must_succeed)
1755      Lisp_Object display, resource_string, must_succeed;
1757   struct ns_display_info *dpyinfo;
1759   CHECK_STRING (display);
1761   nxatoms_of_nsselect ();
1762   dpyinfo = ns_term_init (display);
1763   if (dpyinfo == 0)
1764     {
1765       if (!NILP (must_succeed))
1766         fatal ("OpenStep on %s not responding.\n",
1767                SDATA (display));
1768       else
1769         error ("OpenStep on %s not responding.\n",
1770                SDATA (display));
1771     }
1773   /* Register our external input/output types, used for determining
1774      applicable services and also drag/drop eligibility. */
1775   ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1776   ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain];
1777   ns_drag_types = [[NSArray arrayWithObjects:
1778                             NSStringPboardType,
1779                             NSTabularTextPboardType,
1780                             NSFilenamesPboardType,
1781                             NSURLPboardType,
1782                             NSColorPboardType,
1783                             NSFontPboardType, nil] retain];
1785   return Qnil;
1789 DEFUN ("ns-close-connection", Fns_close_connection, Sns_close_connection,
1790        1, 1, 0, "Close the connection to the current NS server.\n\
1791 The second argument DISPLAY is currently ignored, but nil would stand for\n\
1792 the selected frame's display.")
1793      (display)
1794      Lisp_Object display;
1796   check_ns ();
1797 #ifdef NS_IMPL_COCOA
1798   PSFlush ();
1799 #endif
1800   /*ns_delete_terminal (dpyinfo->terminal); */
1801   [NSApp terminate: NSApp];
1802   return Qnil;
1806 DEFUN ("ns-display-list", Fns_display_list, Sns_display_list, 0, 0, 0,
1807        "Return the list of display names that Emacs has connections to.")
1808      ()
1810   Lisp_Object tail, result;
1812   result = Qnil;
1813   for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1814     result = Fcons (XCAR (XCAR (tail)), result);
1816   return result;
1820 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1821        0, 0, 0, "Hides all applications other than emacs.")
1822      ()
1824   check_ns ();
1825   [NSApp hideOtherApplications: NSApp];
1826   return Qnil;
1829 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1830        1, 1, 0, "If ON is non-nil, the entire emacs application is hidden.\n\
1831 Otherwise if emacs is hidden, it is unhidden.\n\
1832 If ON is equal to 'activate, emacs is unhidden and becomes\n\
1833 the active application.")
1834      (on)
1835      Lisp_Object on;
1837   check_ns ();
1838   if (EQ (on, intern ("activate")))
1839     {
1840       [NSApp unhide: NSApp];
1841       [NSApp activateIgnoringOtherApps: YES];
1842     }
1843   else if (NILP (on))
1844     [NSApp unhide: NSApp];
1845   else
1846     [NSApp hide: NSApp];
1847   return Qnil;
1851 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1852        0, 0, 0, "Shows the 'Info' or 'About' panel for Emacs.")
1853      ()
1855   check_ns ();
1856   [NSApp orderFrontStandardAboutPanel: nil];
1857   return Qnil;
1861 DEFUN ("x-list-fonts", Fns_list_fonts, Sns_list_fonts, 1, 4, 0,
1862        doc: /* Return a list of the names of available fonts matching PATTERN.
1863 If optional arguments FACE and FRAME are specified, return only fonts
1864 the same size as FACE on FRAME.
1865 If optional argument MAX is specified, return at most MAX matches.
1867 PATTERN is a regular expression; FACE is a face name - a symbol.
1869 The return value is a list of strings, suitable as arguments to
1870 set-face-font.
1872 The font names are _NOT_ X names.  */)
1873      (pattern, face, frame, max)
1874      Lisp_Object pattern, face, frame, max;
1876   Lisp_Object flist, olist = Qnil, tem;
1877   struct frame *f;
1878   int maxnames;
1880   /* We can't simply call check_x_frame because this function may be
1881      called before any frame is created.  */
1882   if (NILP (frame))
1883     f = SELECTED_FRAME ();
1884   else
1885     {
1886       CHECK_LIVE_FRAME (frame);
1887       f = XFRAME (frame);
1888     }
1889   if (! FRAME_WINDOW_P (f))
1890     {
1891       /* Perhaps we have not yet created any frame.  */
1892       f = NULL;
1893     }
1895   if (NILP (max))
1896     maxnames = 4;
1897   else
1898     {
1899       CHECK_NATNUM (max);
1900       maxnames = XFASTINT (max);
1901     }
1903   /* get XLFD names */
1904   flist = ns_list_fonts (f, pattern, 0, maxnames);
1906   /* convert list into regular names */
1907   for (tem = flist; CONSP (tem); tem = XCDR (tem))
1908     {
1909       Lisp_Object fname = XCAR (tem);
1910       olist = Fcons (build_string (ns_xlfd_to_fontname (SDATA (fname))),
1911                     olist);
1912     }
1914   return olist;
1918 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1919        "Determine font postscript or family name from a font name string or\n\
1920 XLFD string.  If string contains fontset' and not 'fontset-startup' it is\n\
1921 left alone.")
1922      (name)
1923      Lisp_Object name;
1925   char *nm;
1926   CHECK_STRING (name);
1927   nm = SDATA (name);
1929   if (nm[0] != '-')
1930     return name;
1931   if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1932     return name;
1934   return build_string (ns_xlfd_to_fontname (SDATA (name)));
1938 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1939        "Return a list of all available colors.\n\
1940 The optional argument FRAME is currently ignored.")
1941      (frame)
1942      Lisp_Object frame;
1944   Lisp_Object list = Qnil;
1945   NSEnumerator *colorlists;
1946   NSColorList *clist;
1948   if (!NILP (frame))
1949     {
1950       CHECK_FRAME (frame);
1951       if (! FRAME_NS_P (XFRAME (frame)))
1952         error ("non-NS frame used in `ns-list-colors'");
1953     }
1955   BLOCK_INPUT;
1957   colorlists = [[NSColorList availableColorLists] objectEnumerator];
1958   while (clist = [colorlists nextObject])
1959     {
1960       if ([[clist name] length] < 7 ||
1961           [[clist name] rangeOfString: @"PANTONE"].location == 0)
1962         {
1963           NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1964           NSString *cname;
1965           while (cname = [cnames nextObject])
1966             list = Fcons (build_string ([cname UTF8String]), list);
1967 /*           for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1968                list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1969                                              UTF8String]), list); */
1970         }
1971     }
1973   UNBLOCK_INPUT;
1975   return list;
1979 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1980        "List NS services by querying NSApp.")
1981      ()
1983   Lisp_Object ret = Qnil;
1984   NSMenu *svcs;
1985   id delegate;
1987   check_ns ();
1988   svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1989   [NSApp setServicesMenu: svcs];  /* this and next rebuild on <10.4 */
1990   [NSApp registerServicesMenuSendTypes: ns_send_types
1991                            returnTypes: ns_return_types];
1993 /* On Tiger, services menu updating was made lazier (waits for user to
1994    actually click on the menu), so we have to force things along: */
1995 #ifdef NS_IMPL_COCOA
1996   if (NSAppKitVersionNumber >= 744.0)
1997     {
1998       delegate = [svcs delegate];
1999       if (delegate != nil)
2000         {
2001           if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
2002               [delegate menuNeedsUpdate: svcs];
2003           if ([delegate respondsToSelector:
2004                             @selector (menu:updateItem:atIndex:shouldCancel:)])
2005             {
2006               int i, len = [delegate numberOfItemsInMenu: svcs];
2007               for (i =0; i<len; i++)
2008                   [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
2009               for (i =0; i<len; i++)
2010                   if (![delegate menu: svcs
2011                            updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
2012                               atIndex: i shouldCancel: NO])
2013                     break;
2014             }
2015         }
2016     }
2017 #endif
2019   [svcs setAutoenablesItems: NO];
2020 #ifdef NS_IMPL_COCOA
2021   [svcs update]; /* on OS X, converts from '/' structure */
2022 #endif
2024   ret = interpret_services_menu (svcs, Qnil, ret);
2025   return ret;
2029 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
2030        2, 2, 0, "Perform NS SERVICE on SEND which is either a string or nil.\n\
2031 Returns result of service as string or nil if no result.")
2032      (service, send)
2033      Lisp_Object service, send;
2035   id pb;
2036   NSString *svcName;
2037   char *utfStr;
2038   int len;
2040   CHECK_STRING (service);
2041   check_ns ();
2043   utfStr = SDATA (service);
2044   svcName = [NSString stringWithUTF8String: utfStr];
2046   pb =[NSPasteboard pasteboardWithUniqueName];
2047   ns_string_to_pasteboard (pb, send);
2049   if (NSPerformService (svcName, pb) == NO)
2050     Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
2052   if ([[pb types] count] == 0)
2053     return build_string ("");
2054   return ns_string_from_pasteboard (pb);
2058 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2059        Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2060        "Composes character sequences in UTF-8 normal form NFD string STR to produce a normal (composed normal form NFC) string.")
2061     (str)
2062     Lisp_Object str;
2064   NSString *utfStr;
2066   CHECK_STRING (str);
2067   utfStr = [[NSString stringWithUTF8String: SDATA (str)]
2068              precomposedStringWithCanonicalMapping];
2069   return build_string ([utfStr UTF8String]);
2073 /* ==========================================================================
2075     Miscellaneous functions not called through hooks
2077    ========================================================================== */
2080 /* 23: call in image.c */
2081 FRAME_PTR
2082 check_x_frame (Lisp_Object frame)
2084   return check_ns_frame (frame);
2087 /* 23: added, due to call in frame.c */
2088 struct ns_display_info *
2089 check_x_display_info (Lisp_Object frame)
2091   return check_ns_display_info (frame);
2095 /* 23: new function; we don't have much in the way of flexibility though */
2096 void
2097 x_set_scroll_bar_default_width (f)
2098      struct frame *f;
2100   int wid = FRAME_COLUMN_WIDTH (f);
2101   FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2102   FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2103                                       wid - 1) / wid;
2107 /* 23: terms now impl this instead of x-get-resource directly */
2108 const char *
2109 x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2111   /* remove appname prefix; PENDING: allow for !="Emacs" */
2112   char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2113   const char *res;
2114   check_ns ();
2116   /* Support emacs-20-style face resources for backwards compatibility */
2117   if (!strncmp (toCheck, "Face", 4))
2118     toCheck = name + (!strncmp (name, "emacs.", 6) ? 6 : 0);
2120 /*fprintf (stderr, "Checking '%s'\n", toCheck); */
2121   
2122   res = [[[NSUserDefaults standardUserDefaults] objectForKey:
2123                    [NSString stringWithUTF8String: toCheck]] UTF8String];
2124   return !res ? NULL :
2125       (!strncasecmp (res, "YES", 3) ? "true" :
2126           (!strncasecmp (res, "NO", 2) ? "false" : res));
2130 Lisp_Object
2131 x_get_focus_frame (struct frame *frame)
2133   struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2134   Lisp_Object nsfocus;
2136   if (!dpyinfo->ns_focus_frame)
2137     return Qnil;
2139   XSETFRAME (nsfocus, dpyinfo->ns_focus_frame);
2140   return nsfocus;
2145 x_pixel_width (struct frame *f)
2147   return FRAME_PIXEL_WIDTH (f);
2152 x_pixel_height (struct frame *f)
2154   return FRAME_PIXEL_HEIGHT (f);
2159 x_char_width (struct frame *f)
2161   return FRAME_COLUMN_WIDTH (f);
2166 x_char_height (struct frame *f)
2168   return FRAME_LINE_HEIGHT (f);
2173 x_screen_planes (struct frame *f)
2175   return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2179 void
2180 x_sync (Lisp_Object frame)
2182   /* XXX Not implemented XXX */
2183   return;
2188 /* ==========================================================================
2190     Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2192    ========================================================================== */
2195 DEFUN ("xw-color-defined-p", Fns_color_defined_p, Sns_color_defined_p, 1, 2, 0,
2196        "Return t if the current NS display supports the color named COLOR.\n\
2197 The optional argument FRAME is currently ignored.")
2198      (color, frame)
2199      Lisp_Object color, frame;
2201   NSColor * col;
2202   check_ns ();
2203   return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2207 DEFUN ("xw-color-values", Fns_color_values, Sns_color_values, 1, 2, 0,
2208        "Return a description of the color named COLOR.\n\
2209 The value is a list of integer RGBA values--(RED GREEN BLUE ALPHA).\n\
2210 These values appear to range from 0 to 65280; white is (65280 65280 65280 0).\n\
2211 The optional argument FRAME is currently ignored.")
2212      (color, frame)
2213      Lisp_Object color, frame;
2215   NSColor * col;
2216   float red, green, blue, alpha;
2217   Lisp_Object rgba[4];
2219   check_ns ();
2220   CHECK_STRING (color);
2222   if (ns_lisp_to_color (color, &col))
2223     return Qnil;
2225   [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2226         getRed: &red green: &green blue: &blue alpha: &alpha];
2227   rgba[0] = make_number (lrint (red*65280));
2228   rgba[1] = make_number (lrint (green*65280));
2229   rgba[2] = make_number (lrint (blue*65280));
2230   rgba[3] = make_number (lrint (alpha*65280));
2232   return Flist (4, rgba);
2236 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2237        "Return t if the NS display supports color.\n\
2238 The optional argument DISPLAY specifies which display to ask about.\n\
2239 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2240 If omitted or nil, that stands for the selected frame's display.")
2241      (display)
2242      Lisp_Object display;
2244   NSWindowDepth depth;
2245   NSString *colorSpace;
2246   check_ns ();
2247   depth = [ns_get_screen (display) depth];
2248   colorSpace = NSColorSpaceFromDepth (depth);
2250   return    [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2251          || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2252       ? Qnil : Qt;
2256 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2257        Sx_display_grayscale_p, 0, 1, 0,
2258        "Return t if the NS display supports shades of gray.\n\
2259 Note that color displays do support shades of gray.\n\
2260 The optional argument DISPLAY specifies which display to ask about.\n\
2261 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2262 If omitted or nil, that stands for the selected frame's display.")
2263      (display)
2264      Lisp_Object display;
2266   NSWindowDepth depth;
2267   check_ns ();
2268   depth = [ns_get_screen (display) depth];
2270   return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2274 DEFUN ("x-display-pixel-width", Fns_display_pixel_width, Sns_display_pixel_width,
2275        0, 1, 0,
2276        "Returns the width in pixels of the NS display DISPLAY.\n\
2277 The optional argument DISPLAY specifies which display to ask about.\n\
2278 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2279 If omitted or nil, that stands for the selected frame's display.")
2280      (display)
2281      Lisp_Object display;
2283   check_ns ();
2284   return make_number ((int) [ns_get_screen (display) frame].size.width);
2288 DEFUN ("x-display-pixel-height", Fns_display_pixel_height,
2289        Sns_display_pixel_height, 0, 1, 0,
2290        "Returns the height in pixels of the NS display DISPLAY.\n\
2291 The optional argument DISPLAY specifies which display to ask about.\n\
2292 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2293 If omitted or nil, that stands for the selected frame's display.")
2294      (display)
2295      Lisp_Object display;
2297   check_ns ();
2298   return make_number ((int) [ns_get_screen (display) frame].size.height);
2301 DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2302        Sns_display_usable_bounds, 0, 1, 0,
2303        "Returns a list of integers in form (left top width height) describing the \
2304 usable screen area excluding reserved areas such as the Mac menu and doc, or \
2305 the Windows task bar.\n                        \
2306 The optional argument DISPLAY specifies which display to ask about.\n\
2307 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2308 If omitted or nil, that stands for the selected frame's display.")
2309      (display)
2310      Lisp_Object display;
2312   int top;
2313   NSRect vScreen;
2315   check_ns ();
2316   vScreen = [ns_get_screen (display) visibleFrame];
2317   top = vScreen.origin.y == 0.0 ?
2318     (int) [ns_get_screen (display) frame].size.height - vScreen.size.height : 0;
2320   return list4 (make_number ((int) vScreen.origin.x),
2321                 make_number (top),
2322                 make_number ((int) vScreen.size.width),
2323                 make_number ((int) vScreen.size.height));
2327 DEFUN ("x-display-planes", Fx_display_planes, Sns_display_planes,
2328        0, 1, 0,
2329        "Returns the number of bitplanes of the NS display DISPLAY.\n\
2330 The optional argument DISPLAY specifies which display to ask about.\n\
2331 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2332 If omitted or nil, that stands for the selected frame's display.")
2333      (display)
2334      Lisp_Object display;
2336   check_ns ();
2337   return make_number
2338     (NSBitsPerSampleFromDepth ([ns_get_screen (display) depth]));
2342 DEFUN ("x-display-color-cells", Fns_display_color_cells,
2343        Sns_display_color_cells, 0, 1, 0,
2344        "Returns the number of color cells of the NS display DISPLAY.\n\
2345 The optional argument DISPLAY specifies which display to ask about.\n\
2346 DISPLAY should be either a frame, a display name (a string), or terminal ID.\n\
2347 If omitted or nil, that stands for the selected frame's display.")
2348      (display)
2349      Lisp_Object display;
2351   check_ns ();
2352   struct ns_display_info *dpyinfo = check_ns_display_info (display);
2354   /* We force 24+ bit depths to 24-bit to prevent an overflow.  */
2355   return make_number (1 << min (dpyinfo->n_planes, 24));
2359 /* Unused dummy def needed for compatibility. */
2360 Lisp_Object tip_frame;
2362 /*PENDING: move to xdisp or similar */
2363 static void
2364 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
2365      struct frame *f;
2366      Lisp_Object parms, dx, dy;
2367      int width, height;
2368      int *root_x, *root_y;
2370   Lisp_Object left, top;
2371   EmacsView *view = FRAME_NS_VIEW (f);
2372   NSPoint pt;
2373   
2374   /* Start with user-specified or mouse position.  */
2375   left = Fcdr (Fassq (Qleft, parms));
2376   if (INTEGERP (left))
2377     pt.x = XINT (left);
2378   else
2379     pt.x = last_mouse_motion_position.x;
2380   top = Fcdr (Fassq (Qtop, parms));
2381   if (INTEGERP (top))
2382     pt.y = XINT (top);
2383   else
2384     pt.y = last_mouse_motion_position.y;
2386   /* Convert to screen coordinates */
2387   pt = [view convertPoint: pt toView: nil];
2388   pt = [[view window] convertBaseToScreen: pt];
2390   /* Ensure in bounds.  (Note, screen origin = lower left.) */
2391   if (pt.x + XINT (dx) <= 0)
2392     *root_x = 0; /* Can happen for negative dx */
2393   else if (pt.x + XINT (dx) + width <= FRAME_NS_DISPLAY_INFO (f)->width)
2394     /* It fits to the right of the pointer.  */
2395     *root_x = pt.x + XINT (dx);
2396   else if (width + XINT (dx) <= pt.x)
2397     /* It fits to the left of the pointer.  */
2398     *root_x = pt.x - width - XINT (dx);
2399   else
2400     /* Put it left justified on the screen -- it ought to fit that way.  */
2401     *root_x = 0;
2403   if (pt.y - XINT (dy) - height >= 0)
2404     /* It fits below the pointer.  */
2405     *root_y = pt.y - height - XINT (dy);
2406   else if (pt.y + XINT (dy) + height <= FRAME_NS_DISPLAY_INFO (f)->height)
2407     /* It fits above the pointer */
2408       *root_y = pt.y + XINT (dy);
2409   else
2410     /* Put it on the top.  */
2411     *root_y = FRAME_NS_DISPLAY_INFO (f)->height - height;
2415 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2416        doc: /* Show STRING in a "tooltip" window on frame FRAME.
2417 A tooltip window is a small window displaying a string.
2419 FRAME nil or omitted means use the selected frame.
2421 PARMS is an optional list of frame parameters which can be used to
2422 change the tooltip's appearance.
2424 Automatically hide the tooltip after TIMEOUT seconds.  TIMEOUT nil
2425 means use the default timeout of 5 seconds.
2427 If the list of frame parameters PARMS contains a `left' parameter,
2428 the tooltip is displayed at that x-position.  Otherwise it is
2429 displayed at the mouse position, with offset DX added (default is 5 if
2430 DX isn't specified).  Likewise for the y-position; if a `top' frame
2431 parameter is specified, it determines the y-position of the tooltip
2432 window, otherwise it is displayed at the mouse position, with offset
2433 DY added (default is -10).
2435 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2436 Text larger than the specified size is clipped.  */)
2437      (string, frame, parms, timeout, dx, dy)
2438      Lisp_Object string, frame, parms, timeout, dx, dy;
2440   int root_x, root_y;
2441   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2442   int count = SPECPDL_INDEX ();
2443   struct frame *f;
2444   char *str;
2445   NSSize size;
2447   specbind (Qinhibit_redisplay, Qt);
2449   GCPRO4 (string, parms, frame, timeout);
2451   CHECK_STRING (string);
2452   str = SDATA (string);
2453   f = check_x_frame (frame);
2454   if (NILP (timeout))
2455     timeout = make_number (5);
2456   else
2457     CHECK_NATNUM (timeout);
2459   if (NILP (dx))
2460     dx = make_number (5);
2461   else
2462     CHECK_NUMBER (dx);
2464   if (NILP (dy))
2465     dy = make_number (-10);
2466   else
2467     CHECK_NUMBER (dy);
2469   BLOCK_INPUT;
2470   if (ns_tooltip == nil)
2471     ns_tooltip = [[EmacsTooltip alloc] init];
2472   else
2473     Fx_hide_tip ();
2475   [ns_tooltip setText: str];
2476   size = [ns_tooltip frame].size;
2478   /* Move the tooltip window where the mouse pointer is.  Resize and
2479      show it.  */
2480   compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2481                   &root_x, &root_y);
2483   [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2484   UNBLOCK_INPUT;
2486   UNGCPRO;
2487   return unbind_to (count, Qnil);
2491 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2492        doc: /* Hide the current tooltip window, if there is any.
2493 Value is t if tooltip was open, nil otherwise.  */)
2494      ()
2496   if (ns_tooltip == nil || ![ns_tooltip isActive])
2497     return Qnil;
2498   [ns_tooltip hide];
2499   return Qt;
2503 /* ==========================================================================
2505     Lisp interface declaration
2507    ========================================================================== */
2510 void
2511 syms_of_nsfns ()
2513   int i;
2515   Qns_frame_parameter = intern ("ns-frame-parameter");
2516   staticpro (&Qns_frame_parameter);
2517   Qnone = intern ("none");
2518   staticpro (&Qnone);
2519   Qbuffered = intern ("bufferd");
2520   staticpro (&Qbuffered);
2521   Qfontsize = intern ("fontsize");
2522   staticpro (&Qfontsize);
2524   DEFVAR_LISP ("ns-icon-type-alist", &Vns_icon_type_alist,
2525                "Alist of elements (REGEXP . IMAGE) for images of icons associated to\n\
2526 frames.  If the title of a frame matches REGEXP, then IMAGE.tiff is\n\
2527 selected as the image of the icon representing the frame when it's\n\
2528 miniaturized.  If an element is t, then Emacs tries to select an icon\n\
2529 based on the filetype of the visited file.\n\
2531 The images have to be installed in a folder called English.lproj in the\n\
2532 Emacs.app folder.  You have to restart Emacs after installing new icons.\n\
2534 Example: Install an icon Gnus.tiff and execute the following code\n\
2536   (setq ns-icon-type-alist\n\
2537         (append ns-icon-type-alist\n\
2538                 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"\n\
2539                    . \"Gnus\"))))\n\
2541 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will\n\
2542 be used as the image of the icon representing the frame.");
2543   Vns_icon_type_alist = Fcons (Qt, Qnil);
2545   defsubr (&Sns_read_file_name);
2546   defsubr (&Sns_get_resource);
2547   defsubr (&Sns_set_resource);
2548   defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2549   defsubr (&Sx_display_grayscale_p);
2550   defsubr (&Sns_list_fonts);
2551   defsubr (&Sns_font_name);
2552   defsubr (&Sns_list_colors);
2553   defsubr (&Sns_color_defined_p);
2554   defsubr (&Sns_color_values);
2555   defsubr (&Sns_server_max_request_size);
2556   defsubr (&Sns_server_vendor);
2557   defsubr (&Sns_server_version);
2558   defsubr (&Sns_display_pixel_width);
2559   defsubr (&Sns_display_pixel_height);
2560   defsubr (&Sns_display_usable_bounds);
2561   defsubr (&Sns_display_mm_width);
2562   defsubr (&Sns_display_mm_height);
2563   defsubr (&Sns_display_screens);
2564   defsubr (&Sns_display_planes);
2565   defsubr (&Sns_display_color_cells);
2566   defsubr (&Sns_display_visual_class);
2567   defsubr (&Sns_display_backing_store);
2568   defsubr (&Sns_display_save_under);
2569   defsubr (&Sns_create_frame);
2570   defsubr (&Sns_set_alpha);
2571   defsubr (&Sns_open_connection);
2572   defsubr (&Sns_close_connection);
2573   defsubr (&Sns_display_list);
2575   defsubr (&Sns_hide_others);
2576   defsubr (&Sns_hide_emacs);
2577   defsubr (&Sns_emacs_info_panel);
2578   defsubr (&Sns_list_services);
2579   defsubr (&Sns_perform_service);
2580   defsubr (&Sns_convert_utf8_nfd_to_nfc);
2581   defsubr (&Sns_focus_frame);
2582   defsubr (&Sns_popup_prefs_panel);
2583   defsubr (&Sns_popup_font_panel);
2584   defsubr (&Sns_popup_color_panel);
2586   defsubr (&Sx_show_tip);
2587   defsubr (&Sx_hide_tip);
2589   /* used only in fontset.c */
2590   check_window_system_func = check_ns;
2596 /* ==========================================================================
2598     Class implementations
2600    ========================================================================== */
2603 @implementation EmacsSavePanel
2604 #ifdef NS_IMPL_COCOA
2605 /* --------------------------------------------------------------------------
2606    These are overridden to intercept on OS X: ending panel restarts NSApp
2607    event loop if it is stopped.  Not sure if this is correct behavior,
2608    perhaps should check if running and if so send an appdefined.
2609    -------------------------------------------------------------------------- */
2610 - (void) ok: (id)sender
2612   [super ok: sender];
2613   panelOK = 1;
2614   [NSApp stop: self];
2616 - (void) cancel: (id)sender
2618   [super cancel: sender];
2619   [NSApp stop: self];
2621 #endif
2622 @end
2625 @implementation EmacsOpenPanel
2626 #ifdef NS_IMPL_COCOA
2627 /* --------------------------------------------------------------------------
2628    These are overridden to intercept on OS X: ending panel restarts NSApp
2629    event loop if it is stopped.  Not sure if this is correct behavior,
2630    perhaps should check if running and if so send an appdefined.
2631    -------------------------------------------------------------------------- */
2632 - (void) ok: (id)sender
2634   [super ok: sender];
2635   panelOK = 1;
2636   [NSApp stop: self];
2638 - (void) cancel: (id)sender
2640   [super cancel: sender];
2641   [NSApp stop: self];
2643 #endif
2644 @end
2647 @implementation EmacsFileDelegate
2648 /* --------------------------------------------------------------------------
2649    Delegate methods for Open/Save panels
2650    -------------------------------------------------------------------------- */
2651 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2653   return YES;
2655 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2657   return YES;
2659 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2660           confirmed: (BOOL)okFlag
2662   return filename;
2664 @end
2666 #endif
2668 // arch-tag: dc2a3f74-1123-4daa-8eed-fb78db6a5642