* nsfns.m (handlePanelKeys): New function.
[bpt/emacs.git] / src / nsfns.m
1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
2
3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2013 Free Software
4 Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
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.
12
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.
17
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/>. */
20
21 /*
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)
27 */
28
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>
32
33 #include <math.h>
34 #include <c-strcase.h>
35
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"
46
47 #if 0
48 int fns_trace_num = 1;
49 #define NSTRACE(x) fprintf (stderr, "%s:%d: [%d] " #x "\n", \
50 __FILE__, __LINE__, ++fns_trace_num)
51 #else
52 #define NSTRACE(x)
53 #endif
54
55 #ifdef HAVE_NS
56
57 extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
58
59 extern Lisp_Object Qforeground_color;
60 extern Lisp_Object Qbackground_color;
61 extern Lisp_Object Qcursor_color;
62 extern Lisp_Object Qinternal_border_width;
63 extern Lisp_Object Qvisibility;
64 extern Lisp_Object Qcursor_type;
65 extern Lisp_Object Qicon_type;
66 extern Lisp_Object Qicon_name;
67 extern Lisp_Object Qicon_left;
68 extern Lisp_Object Qicon_top;
69 extern Lisp_Object Qleft;
70 extern Lisp_Object Qright;
71 extern Lisp_Object Qtop;
72 extern Lisp_Object Qdisplay;
73 extern Lisp_Object Qvertical_scroll_bars;
74 extern Lisp_Object Qauto_raise;
75 extern Lisp_Object Qauto_lower;
76 extern Lisp_Object Qbox;
77 extern Lisp_Object Qscroll_bar_width;
78 extern Lisp_Object Qx_resource_name;
79 extern Lisp_Object Qface_set_after_frame_default;
80 extern Lisp_Object Qunderline, Qundefined;
81 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
82 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
83
84
85 Lisp_Object Qbuffered;
86 Lisp_Object Qfontsize;
87
88 /* hack for OS X file panels */
89 char panelOK = 0;
90
91 EmacsTooltip *ns_tooltip;
92
93 /* Need forward declaration here to preserve organizational integrity of file */
94 Lisp_Object Fx_open_connection (Lisp_Object, Lisp_Object, Lisp_Object);
95
96 /* Static variables to handle applescript execution. */
97 static Lisp_Object as_script, *as_result;
98 static int as_status;
99
100 #ifdef GLYPH_DEBUG
101 static ptrdiff_t image_cache_refcount;
102 #endif
103
104 /* ==========================================================================
105
106 Internal utility functions
107
108 ========================================================================== */
109
110 /* Let the user specify an Nextstep display with a frame.
111 nil stands for the selected frame--or, if that is not an Nextstep frame,
112 the first Nextstep display on the list. */
113 static struct ns_display_info *
114 check_ns_display_info (Lisp_Object frame)
115 {
116 if (NILP (frame))
117 {
118 struct frame *f = SELECTED_FRAME ();
119 if (FRAME_NS_P (f) && FRAME_LIVE_P (f) )
120 return FRAME_NS_DISPLAY_INFO (f);
121 else if (x_display_list != 0)
122 return x_display_list;
123 else
124 error ("Nextstep windows are not in use or not initialized");
125 }
126 else if (INTEGERP (frame))
127 {
128 struct terminal *t = get_terminal (frame, 1);
129
130 if (t->type != output_ns)
131 error ("Terminal %"pI"d is not a Nextstep display", XINT (frame));
132
133 return t->display_info.ns;
134 }
135 else if (STRINGP (frame))
136 return ns_display_info_for_name (frame);
137 else
138 {
139 FRAME_PTR f;
140
141 CHECK_LIVE_FRAME (frame);
142 f = XFRAME (frame);
143 if (! FRAME_NS_P (f))
144 error ("non-Nextstep frame used");
145 return FRAME_NS_DISPLAY_INFO (f);
146 }
147 return NULL; /* shut compiler up */
148 }
149
150
151 static id
152 ns_get_window (Lisp_Object maybeFrame)
153 {
154 id view =nil, window =nil;
155
156 if (!FRAMEP (maybeFrame) || !FRAME_NS_P (XFRAME (maybeFrame)))
157 maybeFrame = selected_frame;/*wrong_type_argument (Qframep, maybeFrame); */
158
159 if (!NILP (maybeFrame))
160 view = FRAME_NS_VIEW (XFRAME (maybeFrame));
161 if (view) window =[view window];
162
163 return window;
164 }
165
166
167 static NSScreen *
168 ns_get_screen (Lisp_Object screen)
169 {
170 struct frame *f;
171 struct terminal *terminal;
172
173 if (EQ (Qt, screen)) /* not documented */
174 return [NSScreen mainScreen];
175
176 terminal = get_terminal (screen, 1);
177 if (terminal->type != output_ns)
178 return NULL;
179
180 if (NILP (screen))
181 f = SELECTED_FRAME ();
182 else if (FRAMEP (screen))
183 f = XFRAME (screen);
184 else
185 {
186 struct ns_display_info *dpyinfo = terminal->display_info.ns;
187 f = dpyinfo->x_focus_frame
188 ? dpyinfo->x_focus_frame : dpyinfo->x_highlight_frame;
189 }
190
191 return ((f && FRAME_NS_P (f)) ? [[FRAME_NS_VIEW (f) window] screen]
192 : NULL);
193 }
194
195
196 /* Return the X display structure for the display named NAME.
197 Open a new connection if necessary. */
198 struct ns_display_info *
199 ns_display_info_for_name (Lisp_Object name)
200 {
201 Lisp_Object names;
202 struct ns_display_info *dpyinfo;
203
204 CHECK_STRING (name);
205
206 for (dpyinfo = x_display_list, names = ns_display_name_list;
207 dpyinfo;
208 dpyinfo = dpyinfo->next, names = XCDR (names))
209 {
210 Lisp_Object tem;
211 tem = Fstring_equal (XCAR (XCAR (names)), name);
212 if (!NILP (tem))
213 return dpyinfo;
214 }
215
216 error ("Emacs for OpenStep does not yet support multi-display.");
217
218 Fx_open_connection (name, Qnil, Qnil);
219 dpyinfo = x_display_list;
220
221 if (dpyinfo == 0)
222 error ("OpenStep on %s not responding.\n", SDATA (name));
223
224 return dpyinfo;
225 }
226
227 static NSString *
228 ns_filename_from_panel (NSSavePanel *panel)
229 {
230 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
231 NSURL *url = [panel URL];
232 NSString *str = [url path];
233 return str;
234 #else
235 return [panel filename];
236 #endif
237 }
238
239 static NSString *
240 ns_directory_from_panel (NSSavePanel *panel)
241 {
242 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
243 NSURL *url = [panel directoryURL];
244 NSString *str = [url path];
245 return str;
246 #else
247 return [panel directory];
248 #endif
249 }
250
251 static Lisp_Object
252 interpret_services_menu (NSMenu *menu, Lisp_Object prefix, Lisp_Object old)
253 /* --------------------------------------------------------------------------
254 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
255 -------------------------------------------------------------------------- */
256 {
257 int i, count;
258 NSMenuItem *item;
259 const char *name;
260 Lisp_Object nameStr;
261 unsigned short key;
262 NSString *keys;
263 Lisp_Object res;
264
265 count = [menu numberOfItems];
266 for (i = 0; i<count; i++)
267 {
268 item = [menu itemAtIndex: i];
269 name = [[item title] UTF8String];
270 if (!name) continue;
271
272 nameStr = build_string (name);
273
274 if ([item hasSubmenu])
275 {
276 old = interpret_services_menu ([item submenu],
277 Fcons (nameStr, prefix), old);
278 }
279 else
280 {
281 keys = [item keyEquivalent];
282 if (keys && [keys length] )
283 {
284 key = [keys characterAtIndex: 0];
285 res = make_number (key|super_modifier);
286 }
287 else
288 {
289 res = Qundefined;
290 }
291 old = Fcons (Fcons (res,
292 Freverse (Fcons (nameStr,
293 prefix))),
294 old);
295 }
296 }
297 return old;
298 }
299
300
301
302 /* ==========================================================================
303
304 Frame parameter setters
305
306 ========================================================================== */
307
308
309 static void
310 x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
311 {
312 NSColor *col;
313 CGFloat r, g, b, alpha;
314
315 if (ns_lisp_to_color (arg, &col))
316 {
317 store_frame_param (f, Qforeground_color, oldval);
318 error ("Unknown color");
319 }
320
321 [col retain];
322 [f->output_data.ns->foreground_color release];
323 f->output_data.ns->foreground_color = col;
324
325 [col getRed: &r green: &g blue: &b alpha: &alpha];
326 FRAME_FOREGROUND_PIXEL (f) =
327 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
328
329 if (FRAME_NS_VIEW (f))
330 {
331 update_face_from_frame_parameter (f, Qforeground_color, arg);
332 /*recompute_basic_faces (f); */
333 if (FRAME_VISIBLE_P (f))
334 redraw_frame (f);
335 }
336 }
337
338
339 static void
340 x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
341 {
342 struct face *face;
343 NSColor *col;
344 NSView *view = FRAME_NS_VIEW (f);
345 CGFloat r, g, b, alpha;
346
347 if (ns_lisp_to_color (arg, &col))
348 {
349 store_frame_param (f, Qbackground_color, oldval);
350 error ("Unknown color");
351 }
352
353 /* clear the frame; in some instances the NS-internal GC appears not to
354 update, or it does update and cannot clear old text properly */
355 if (FRAME_VISIBLE_P (f))
356 ns_clear_frame (f);
357
358 [col retain];
359 [f->output_data.ns->background_color release];
360 f->output_data.ns->background_color = col;
361
362 [col getRed: &r green: &g blue: &b alpha: &alpha];
363 FRAME_BACKGROUND_PIXEL (f) =
364 ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff));
365
366 if (view != nil)
367 {
368 [[view window] setBackgroundColor: col];
369
370 if (alpha != 1.0)
371 [[view window] setOpaque: NO];
372 else
373 [[view window] setOpaque: YES];
374
375 face = FRAME_DEFAULT_FACE (f);
376 if (face)
377 {
378 col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f);
379 face->background = ns_index_color
380 ([col colorWithAlphaComponent: alpha], f);
381
382 update_face_from_frame_parameter (f, Qbackground_color, arg);
383 }
384
385 if (FRAME_VISIBLE_P (f))
386 redraw_frame (f);
387 }
388 }
389
390
391 static void
392 x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
393 {
394 NSColor *col;
395
396 if (ns_lisp_to_color (arg, &col))
397 {
398 store_frame_param (f, Qcursor_color, oldval);
399 error ("Unknown color");
400 }
401
402 [FRAME_CURSOR_COLOR (f) release];
403 FRAME_CURSOR_COLOR (f) = [col retain];
404
405 if (FRAME_VISIBLE_P (f))
406 {
407 x_update_cursor (f, 0);
408 x_update_cursor (f, 1);
409 }
410 update_face_from_frame_parameter (f, Qcursor_color, arg);
411 }
412
413
414 static void
415 x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
416 {
417 NSView *view = FRAME_NS_VIEW (f);
418 NSTRACE (x_set_icon_name);
419
420 /* see if it's changed */
421 if (STRINGP (arg))
422 {
423 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
424 return;
425 }
426 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
427 return;
428
429 fset_icon_name (f, arg);
430
431 if (NILP (arg))
432 {
433 if (!NILP (f->title))
434 arg = f->title;
435 else
436 /* explicit name and no icon-name -> explicit_name */
437 if (f->explicit_name)
438 arg = f->name;
439 else
440 {
441 /* no explicit name and no icon-name ->
442 name has to be rebuild from icon_title_format */
443 windows_or_buffers_changed++;
444 return;
445 }
446 }
447
448 /* Don't change the name if it's already NAME. */
449 if ([[view window] miniwindowTitle] &&
450 ([[[view window] miniwindowTitle]
451 isEqualToString: [NSString stringWithUTF8String:
452 SSDATA (arg)]]))
453 return;
454
455 [[view window] setMiniwindowTitle:
456 [NSString stringWithUTF8String: SSDATA (arg)]];
457 }
458
459 static void
460 ns_set_name_internal (FRAME_PTR f, Lisp_Object name)
461 {
462 struct gcpro gcpro1;
463 Lisp_Object encoded_name, encoded_icon_name;
464 NSString *str;
465 NSView *view = FRAME_NS_VIEW (f);
466
467 GCPRO1 (name);
468 encoded_name = ENCODE_UTF_8 (name);
469 UNGCPRO;
470
471 str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
472
473 /* Don't change the name if it's already NAME. */
474 if (! [[[view window] title] isEqualToString: str])
475 [[view window] setTitle: str];
476
477 if (!STRINGP (f->icon_name))
478 encoded_icon_name = encoded_name;
479 else
480 encoded_icon_name = ENCODE_UTF_8 (f->icon_name);
481
482 str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)];
483
484 if ([[view window] miniwindowTitle] &&
485 ! [[[view window] miniwindowTitle] isEqualToString: str])
486 [[view window] setMiniwindowTitle: str];
487
488 }
489
490 static void
491 ns_set_name (struct frame *f, Lisp_Object name, int explicit)
492 {
493 NSTRACE (ns_set_name);
494
495 /* Make sure that requests from lisp code override requests from
496 Emacs redisplay code. */
497 if (explicit)
498 {
499 /* If we're switching from explicit to implicit, we had better
500 update the mode lines and thereby update the title. */
501 if (f->explicit_name && NILP (name))
502 update_mode_lines = 1;
503
504 f->explicit_name = ! NILP (name);
505 }
506 else if (f->explicit_name)
507 return;
508
509 if (NILP (name))
510 name = build_string([ns_app_name UTF8String]);
511 else
512 CHECK_STRING (name);
513
514 /* Don't change the name if it's already NAME. */
515 if (! NILP (Fstring_equal (name, f->name)))
516 return;
517
518 fset_name (f, name);
519
520 /* title overrides explicit name */
521 if (! NILP (f->title))
522 name = f->title;
523
524 ns_set_name_internal (f, name);
525 }
526
527
528 /* This function should be called when the user's lisp code has
529 specified a name for the frame; the name will override any set by the
530 redisplay code. */
531 static void
532 x_explicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
533 {
534 NSTRACE (x_explicitly_set_name);
535 ns_set_name (f, arg, 1);
536 }
537
538
539 /* This function should be called by Emacs redisplay code to set the
540 name; names set this way will never override names set by the user's
541 lisp code. */
542 void
543 x_implicitly_set_name (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
544 {
545 NSTRACE (x_implicitly_set_name);
546
547 /* Deal with NS specific format t. */
548 if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt))
549 || EQ (Vframe_title_format, Qt)))
550 ns_set_name_as_filename (f);
551 else
552 ns_set_name (f, arg, 0);
553 }
554
555
556 /* Change the title of frame F to NAME.
557 If NAME is nil, use the frame name as the title. */
558
559 static void
560 x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
561 {
562 NSTRACE (x_set_title);
563 /* Don't change the title if it's already NAME. */
564 if (EQ (name, f->title))
565 return;
566
567 update_mode_lines = 1;
568
569 fset_title (f, name);
570
571 if (NILP (name))
572 name = f->name;
573 else
574 CHECK_STRING (name);
575
576 ns_set_name_internal (f, name);
577 }
578
579
580 void
581 ns_set_name_as_filename (struct frame *f)
582 {
583 NSView *view;
584 Lisp_Object name, filename;
585 Lisp_Object buf = XWINDOW (f->selected_window)->contents;
586 const char *title;
587 NSAutoreleasePool *pool;
588 struct gcpro gcpro1;
589 Lisp_Object encoded_name, encoded_filename;
590 NSString *str;
591 NSTRACE (ns_set_name_as_filename);
592
593 if (f->explicit_name || ! NILP (f->title))
594 return;
595
596 block_input ();
597 pool = [[NSAutoreleasePool alloc] init];
598 filename = BVAR (XBUFFER (buf), filename);
599 name = BVAR (XBUFFER (buf), name);
600
601 if (NILP (name))
602 {
603 if (! NILP (filename))
604 name = Ffile_name_nondirectory (filename);
605 else
606 name = build_string ([ns_app_name UTF8String]);
607 }
608
609 GCPRO1 (name);
610 encoded_name = ENCODE_UTF_8 (name);
611 UNGCPRO;
612
613 view = FRAME_NS_VIEW (f);
614
615 title = FRAME_ICONIFIED_P (f) ? [[[view window] miniwindowTitle] UTF8String]
616 : [[[view window] title] UTF8String];
617
618 if (title && (! strcmp (title, SSDATA (encoded_name))))
619 {
620 [pool release];
621 unblock_input ();
622 return;
623 }
624
625 str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
626 if (str == nil) str = @"Bad coding";
627
628 if (FRAME_ICONIFIED_P (f))
629 [[view window] setMiniwindowTitle: str];
630 else
631 {
632 NSString *fstr;
633
634 if (! NILP (filename))
635 {
636 GCPRO1 (filename);
637 encoded_filename = ENCODE_UTF_8 (filename);
638 UNGCPRO;
639
640 fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
641 if (fstr == nil) fstr = @"";
642 #ifdef NS_IMPL_COCOA
643 /* work around a bug observed on 10.3 and later where
644 setTitleWithRepresentedFilename does not clear out previous state
645 if given filename does not exist */
646 if (! [[NSFileManager defaultManager] fileExistsAtPath: fstr])
647 [[view window] setRepresentedFilename: @""];
648 #endif
649 }
650 else
651 fstr = @"";
652
653 [[view window] setRepresentedFilename: fstr];
654 [[view window] setTitle: str];
655 fset_name (f, name);
656 }
657
658 [pool release];
659 unblock_input ();
660 }
661
662
663 void
664 ns_set_doc_edited (struct frame *f, Lisp_Object arg)
665 {
666 NSView *view = FRAME_NS_VIEW (f);
667 NSAutoreleasePool *pool;
668 if (!MINI_WINDOW_P (XWINDOW (f->selected_window)))
669 {
670 block_input ();
671 pool = [[NSAutoreleasePool alloc] init];
672 [[view window] setDocumentEdited: !NILP (arg)];
673 [pool release];
674 unblock_input ();
675 }
676 }
677
678
679 void
680 x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
681 {
682 int nlines;
683 if (FRAME_MINIBUF_ONLY_P (f))
684 return;
685
686 if (TYPE_RANGED_INTEGERP (int, value))
687 nlines = XINT (value);
688 else
689 nlines = 0;
690
691 FRAME_MENU_BAR_LINES (f) = 0;
692 if (nlines)
693 {
694 FRAME_EXTERNAL_MENU_BAR (f) = 1;
695 /* does for all frames, whereas we just want for one frame
696 [NSMenu setMenuBarVisible: YES]; */
697 }
698 else
699 {
700 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
701 free_frame_menubar (f);
702 /* [NSMenu setMenuBarVisible: NO]; */
703 FRAME_EXTERNAL_MENU_BAR (f) = 0;
704 }
705 }
706
707
708 /* toolbar support */
709 void
710 x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
711 {
712 int nlines;
713
714 if (FRAME_MINIBUF_ONLY_P (f))
715 return;
716
717 if (RANGED_INTEGERP (0, value, INT_MAX))
718 nlines = XFASTINT (value);
719 else
720 nlines = 0;
721
722 if (nlines)
723 {
724 FRAME_EXTERNAL_TOOL_BAR (f) = 1;
725 update_frame_tool_bar (f);
726 }
727 else
728 {
729 if (FRAME_EXTERNAL_TOOL_BAR (f))
730 {
731 free_frame_tool_bar (f);
732 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
733 }
734 }
735
736 x_set_window_size (f, 0, f->text_cols, f->text_lines);
737 }
738
739
740 void
741 ns_implicitly_set_icon_type (struct frame *f)
742 {
743 Lisp_Object tem;
744 EmacsView *view = FRAME_NS_VIEW (f);
745 id image = nil;
746 Lisp_Object chain, elt;
747 NSAutoreleasePool *pool;
748 BOOL setMini = YES;
749
750 NSTRACE (ns_implicitly_set_icon_type);
751
752 block_input ();
753 pool = [[NSAutoreleasePool alloc] init];
754 if (f->output_data.ns->miniimage
755 && [[NSString stringWithUTF8String: SSDATA (f->name)]
756 isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]])
757 {
758 [pool release];
759 unblock_input ();
760 return;
761 }
762
763 tem = assq_no_quit (Qicon_type, f->param_alist);
764 if (CONSP (tem) && ! NILP (XCDR (tem)))
765 {
766 [pool release];
767 unblock_input ();
768 return;
769 }
770
771 for (chain = Vns_icon_type_alist;
772 image == nil && CONSP (chain);
773 chain = XCDR (chain))
774 {
775 elt = XCAR (chain);
776 /* special case: 't' means go by file type */
777 if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/')
778 {
779 NSString *str
780 = [NSString stringWithUTF8String: SSDATA (f->name)];
781 if ([[NSFileManager defaultManager] fileExistsAtPath: str])
782 image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain];
783 }
784 else if (CONSP (elt) &&
785 STRINGP (XCAR (elt)) &&
786 STRINGP (XCDR (elt)) &&
787 fast_string_match (XCAR (elt), f->name) >= 0)
788 {
789 image = [EmacsImage allocInitFromFile: XCDR (elt)];
790 if (image == nil)
791 image = [[NSImage imageNamed:
792 [NSString stringWithUTF8String:
793 SSDATA (XCDR (elt))]] retain];
794 }
795 }
796
797 if (image == nil)
798 {
799 image = [[[NSWorkspace sharedWorkspace] iconForFileType: @"text"] retain];
800 setMini = NO;
801 }
802
803 [f->output_data.ns->miniimage release];
804 f->output_data.ns->miniimage = image;
805 [view setMiniwindowImage: setMini];
806 [pool release];
807 unblock_input ();
808 }
809
810
811 static void
812 x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
813 {
814 EmacsView *view = FRAME_NS_VIEW (f);
815 id image = nil;
816 BOOL setMini = YES;
817
818 NSTRACE (x_set_icon_type);
819
820 if (!NILP (arg) && SYMBOLP (arg))
821 {
822 arg =build_string (SSDATA (SYMBOL_NAME (arg)));
823 store_frame_param (f, Qicon_type, arg);
824 }
825
826 /* do it the implicit way */
827 if (NILP (arg))
828 {
829 ns_implicitly_set_icon_type (f);
830 return;
831 }
832
833 CHECK_STRING (arg);
834
835 image = [EmacsImage allocInitFromFile: arg];
836 if (image == nil)
837 image =[NSImage imageNamed: [NSString stringWithUTF8String:
838 SSDATA (arg)]];
839
840 if (image == nil)
841 {
842 image = [NSImage imageNamed: @"text"];
843 setMini = NO;
844 }
845
846 f->output_data.ns->miniimage = image;
847 [view setMiniwindowImage: setMini];
848 }
849
850
851 /* TODO: move to nsterm? */
852 int
853 ns_lisp_to_cursor_type (Lisp_Object arg)
854 {
855 char *str;
856 if (XTYPE (arg) == Lisp_String)
857 str = SSDATA (arg);
858 else if (XTYPE (arg) == Lisp_Symbol)
859 str = SSDATA (SYMBOL_NAME (arg));
860 else return -1;
861 if (!strcmp (str, "box")) return FILLED_BOX_CURSOR;
862 if (!strcmp (str, "hollow")) return HOLLOW_BOX_CURSOR;
863 if (!strcmp (str, "hbar")) return HBAR_CURSOR;
864 if (!strcmp (str, "bar")) return BAR_CURSOR;
865 if (!strcmp (str, "no")) return NO_CURSOR;
866 return -1;
867 }
868
869
870 Lisp_Object
871 ns_cursor_type_to_lisp (int arg)
872 {
873 switch (arg)
874 {
875 case FILLED_BOX_CURSOR: return Qbox;
876 case HOLLOW_BOX_CURSOR: return intern ("hollow");
877 case HBAR_CURSOR: return intern ("hbar");
878 case BAR_CURSOR: return intern ("bar");
879 case NO_CURSOR:
880 default: return intern ("no");
881 }
882 }
883
884 /* This is the same as the xfns.c definition. */
885 void
886 x_set_cursor_type (FRAME_PTR f, Lisp_Object arg, Lisp_Object oldval)
887 {
888 set_frame_cursor_types (f, arg);
889
890 /* Make sure the cursor gets redrawn. */
891 cursor_type_changed = 1;
892 }
893 \f
894
895 /* called to set mouse pointer color, but all other terms use it to
896 initialize pointer types (and don't set the color ;) */
897 static void
898 x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
899 {
900 /* don't think we can do this on Nextstep */
901 }
902
903
904 #define Str(x) #x
905 #define Xstr(x) Str(x)
906
907 static Lisp_Object
908 ns_appkit_version_str (void)
909 {
910 char tmp[80];
911
912 #ifdef NS_IMPL_GNUSTEP
913 sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION));
914 #elif defined(NS_IMPL_COCOA)
915 sprintf(tmp, "apple-appkit-%.2f", NSAppKitVersionNumber);
916 #else
917 tmp = "ns-unknown";
918 #endif
919 return build_string (tmp);
920 }
921
922
923 /* This is for use by x-server-version and collapses all version info we
924 have into a single int. For a better picture of the implementation
925 running, use ns_appkit_version_str.*/
926 static int
927 ns_appkit_version_int (void)
928 {
929 #ifdef NS_IMPL_GNUSTEP
930 return GNUSTEP_GUI_MAJOR_VERSION * 100 + GNUSTEP_GUI_MINOR_VERSION;
931 #elif defined(NS_IMPL_COCOA)
932 return (int)NSAppKitVersionNumber;
933 #endif
934 return 0;
935 }
936
937
938 static void
939 x_icon (struct frame *f, Lisp_Object parms)
940 /* --------------------------------------------------------------------------
941 Strangely-named function to set icon position parameters in frame.
942 This is irrelevant under OS X, but might be needed under GNUstep,
943 depending on the window manager used. Note, this is not a standard
944 frame parameter-setter; it is called directly from x-create-frame.
945 -------------------------------------------------------------------------- */
946 {
947 Lisp_Object icon_x, icon_y;
948 struct ns_display_info *dpyinfo = check_ns_display_info (Qnil);
949
950 f->output_data.ns->icon_top = Qnil;
951 f->output_data.ns->icon_left = Qnil;
952
953 /* Set the position of the icon. */
954 icon_x = x_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
955 icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
956 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
957 {
958 CHECK_NUMBER (icon_x);
959 CHECK_NUMBER (icon_y);
960 f->output_data.ns->icon_top = icon_y;
961 f->output_data.ns->icon_left = icon_x;
962 }
963 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
964 error ("Both left and top icon corners of icon must be specified");
965 }
966
967
968 /* Note: see frame.c for template, also where generic functions are impl */
969 frame_parm_handler ns_frame_parm_handlers[] =
970 {
971 x_set_autoraise, /* generic OK */
972 x_set_autolower, /* generic OK */
973 x_set_background_color,
974 0, /* x_set_border_color, may be impossible under Nextstep */
975 0, /* x_set_border_width, may be impossible under Nextstep */
976 x_set_cursor_color,
977 x_set_cursor_type,
978 x_set_font, /* generic OK */
979 x_set_foreground_color,
980 x_set_icon_name,
981 x_set_icon_type,
982 x_set_internal_border_width, /* generic OK */
983 x_set_menu_bar_lines,
984 x_set_mouse_color,
985 x_explicitly_set_name,
986 x_set_scroll_bar_width, /* generic OK */
987 x_set_title,
988 x_set_unsplittable, /* generic OK */
989 x_set_vertical_scroll_bars, /* generic OK */
990 x_set_visibility, /* generic OK */
991 x_set_tool_bar_lines,
992 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
993 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
994 x_set_screen_gamma, /* generic OK */
995 x_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */
996 x_set_fringe_width, /* generic OK */
997 x_set_fringe_width, /* generic OK */
998 0, /* x_set_wait_for_wm, will ignore */
999 x_set_fullscreen, /* generic OK */
1000 x_set_font_backend, /* generic OK */
1001 x_set_alpha,
1002 0, /* x_set_sticky */
1003 0, /* x_set_tool_bar_position */
1004 };
1005
1006
1007 /* Handler for signals raised during x_create_frame.
1008 FRAME is the frame which is partially constructed. */
1009
1010 static Lisp_Object
1011 unwind_create_frame (Lisp_Object frame)
1012 {
1013 struct frame *f = XFRAME (frame);
1014
1015 /* If frame is already dead, nothing to do. This can happen if the
1016 display is disconnected after the frame has become official, but
1017 before x_create_frame removes the unwind protect. */
1018 if (!FRAME_LIVE_P (f))
1019 return Qnil;
1020
1021 /* If frame is ``official'', nothing to do. */
1022 if (NILP (Fmemq (frame, Vframe_list)))
1023 {
1024 #if defined GLYPH_DEBUG && defined ENABLE_CHECKING
1025 struct ns_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1026 #endif
1027
1028 x_free_frame_resources (f);
1029 free_glyphs (f);
1030
1031 #ifdef GLYPH_DEBUG
1032 /* Check that reference counts are indeed correct. */
1033 eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
1034 #endif
1035 return Qt;
1036 }
1037
1038 return Qnil;
1039 }
1040
1041 /*
1042 * Read geometry related parameters from preferences if not in PARMS.
1043 * Returns the union of parms and any preferences read.
1044 */
1045
1046 static Lisp_Object
1047 get_geometry_from_preferences (struct ns_display_info *dpyinfo,
1048 Lisp_Object parms)
1049 {
1050 struct {
1051 const char *val;
1052 const char *cls;
1053 Lisp_Object tem;
1054 } r[] = {
1055 { "width", "Width", Qwidth },
1056 { "height", "Height", Qheight },
1057 { "left", "Left", Qleft },
1058 { "top", "Top", Qtop },
1059 };
1060
1061 int i;
1062 for (i = 0; i < sizeof (r)/sizeof (r[0]); ++i)
1063 {
1064 if (NILP (Fassq (r[i].tem, parms)))
1065 {
1066 Lisp_Object value
1067 = x_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls,
1068 RES_TYPE_NUMBER);
1069 if (! EQ (value, Qunbound))
1070 parms = Fcons (Fcons (r[i].tem, value), parms);
1071 }
1072 }
1073
1074 return parms;
1075 }
1076
1077 /* ==========================================================================
1078
1079 Lisp definitions
1080
1081 ========================================================================== */
1082
1083 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1084 1, 1, 0,
1085 doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1086 Return an Emacs frame object.
1087 PARMS is an alist of frame parameters.
1088 If the parameters specify that the frame should not have a minibuffer,
1089 and do not specify a specific minibuffer window to use,
1090 then `default-minibuffer-frame' must be a frame whose minibuffer can
1091 be shared by the new frame.
1092
1093 This function is an internal primitive--use `make-frame' instead. */)
1094 (Lisp_Object parms)
1095 {
1096 struct frame *f;
1097 Lisp_Object frame, tem;
1098 Lisp_Object name;
1099 int minibuffer_only = 0;
1100 int window_prompting = 0;
1101 int width, height;
1102 ptrdiff_t count = specpdl_ptr - specpdl;
1103 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1104 Lisp_Object display;
1105 struct ns_display_info *dpyinfo = NULL;
1106 Lisp_Object parent;
1107 struct kboard *kb;
1108 Lisp_Object tfont, tfontsize;
1109 static int desc_ctr = 1;
1110
1111 /* x_get_arg modifies parms. */
1112 parms = Fcopy_alist (parms);
1113
1114 /* Use this general default value to start with
1115 until we know if this frame has a specified name. */
1116 Vx_resource_name = Vinvocation_name;
1117
1118 display = x_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_STRING);
1119 if (EQ (display, Qunbound))
1120 display = Qnil;
1121 dpyinfo = check_ns_display_info (display);
1122 kb = dpyinfo->terminal->kboard;
1123
1124 if (!dpyinfo->terminal->name)
1125 error ("Terminal is not live, can't create new frames on it");
1126
1127 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1128 if (!STRINGP (name)
1129 && ! EQ (name, Qunbound)
1130 && ! NILP (name))
1131 error ("Invalid frame name--not a string or nil");
1132
1133 if (STRINGP (name))
1134 Vx_resource_name = name;
1135
1136 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1137 if (EQ (parent, Qunbound))
1138 parent = Qnil;
1139 if (! NILP (parent))
1140 CHECK_NUMBER (parent);
1141
1142 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
1143 /* No need to protect DISPLAY because that's not used after passing
1144 it to make_frame_without_minibuffer. */
1145 frame = Qnil;
1146 GCPRO4 (parms, parent, name, frame);
1147 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
1148 RES_TYPE_SYMBOL);
1149 if (EQ (tem, Qnone) || NILP (tem))
1150 f = make_frame_without_minibuffer (Qnil, kb, display);
1151 else if (EQ (tem, Qonly))
1152 {
1153 f = make_minibuffer_frame ();
1154 minibuffer_only = 1;
1155 }
1156 else if (WINDOWP (tem))
1157 f = make_frame_without_minibuffer (tem, kb, display);
1158 else
1159 f = make_frame (1);
1160
1161 XSETFRAME (frame, f);
1162
1163 f->terminal = dpyinfo->terminal;
1164
1165 f->output_method = output_ns;
1166 f->output_data.ns = xzalloc (sizeof *f->output_data.ns);
1167
1168 FRAME_FONTSET (f) = -1;
1169
1170 fset_icon_name (f, x_get_arg (dpyinfo, parms, Qicon_name,
1171 "iconName", "Title",
1172 RES_TYPE_STRING));
1173 if (! STRINGP (f->icon_name))
1174 fset_icon_name (f, Qnil);
1175
1176 FRAME_NS_DISPLAY_INFO (f) = dpyinfo;
1177
1178 /* With FRAME_NS_DISPLAY_INFO set up, this unwind-protect is safe. */
1179 record_unwind_protect (unwind_create_frame, frame);
1180
1181 f->output_data.ns->window_desc = desc_ctr++;
1182 if (TYPE_RANGED_INTEGERP (Window, parent))
1183 {
1184 f->output_data.ns->parent_desc = XFASTINT (parent);
1185 f->output_data.ns->explicit_parent = 1;
1186 }
1187 else
1188 {
1189 f->output_data.ns->parent_desc = FRAME_NS_DISPLAY_INFO (f)->root_window;
1190 f->output_data.ns->explicit_parent = 0;
1191 }
1192
1193 /* Set the name; the functions to which we pass f expect the name to
1194 be set. */
1195 if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name))
1196 {
1197 fset_name (f, build_string ([ns_app_name UTF8String]));
1198 f->explicit_name = 0;
1199 }
1200 else
1201 {
1202 fset_name (f, name);
1203 f->explicit_name = 1;
1204 specbind (Qx_resource_name, name);
1205 }
1206
1207 block_input ();
1208 register_font_driver (&nsfont_driver, f);
1209 x_default_parameter (f, parms, Qfont_backend, Qnil,
1210 "fontBackend", "FontBackend", RES_TYPE_STRING);
1211
1212 {
1213 /* use for default font name */
1214 id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */
1215 tfontsize = x_default_parameter (f, parms, Qfontsize,
1216 make_number (0 /*(int)[font pointSize]*/),
1217 "fontSize", "FontSize", RES_TYPE_NUMBER);
1218 tfont = x_default_parameter (f, parms, Qfont,
1219 build_string ([[font fontName] UTF8String]),
1220 "font", "Font", RES_TYPE_STRING);
1221 }
1222 unblock_input ();
1223
1224 x_default_parameter (f, parms, Qborder_width, make_number (0),
1225 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
1226 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1227 "internalBorderWidth", "InternalBorderWidth",
1228 RES_TYPE_NUMBER);
1229
1230 /* default scrollbars on right on Mac */
1231 {
1232 Lisp_Object spos
1233 #ifdef NS_IMPL_GNUSTEP
1234 = Qt;
1235 #else
1236 = Qright;
1237 #endif
1238 x_default_parameter (f, parms, Qvertical_scroll_bars, spos,
1239 "verticalScrollBars", "VerticalScrollBars",
1240 RES_TYPE_SYMBOL);
1241 }
1242 x_default_parameter (f, parms, Qforeground_color, build_string ("Black"),
1243 "foreground", "Foreground", RES_TYPE_STRING);
1244 x_default_parameter (f, parms, Qbackground_color, build_string ("White"),
1245 "background", "Background", RES_TYPE_STRING);
1246 /* FIXME: not supported yet in Nextstep */
1247 x_default_parameter (f, parms, Qline_spacing, Qnil,
1248 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
1249 x_default_parameter (f, parms, Qleft_fringe, Qnil,
1250 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
1251 x_default_parameter (f, parms, Qright_fringe, Qnil,
1252 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
1253
1254 #ifdef GLYPH_DEBUG
1255 image_cache_refcount =
1256 FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
1257 #endif
1258
1259 init_frame_faces (f);
1260
1261 /* The resources controlling the menu-bar and tool-bar are
1262 processed specially at startup, and reflected in the mode
1263 variables; ignore them here. */
1264 x_default_parameter (f, parms, Qmenu_bar_lines,
1265 NILP (Vmenu_bar_mode)
1266 ? make_number (0) : make_number (1),
1267 NULL, NULL, RES_TYPE_NUMBER);
1268 x_default_parameter (f, parms, Qtool_bar_lines,
1269 NILP (Vtool_bar_mode)
1270 ? make_number (0) : make_number (1),
1271 NULL, NULL, RES_TYPE_NUMBER);
1272
1273 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate",
1274 "BufferPredicate", RES_TYPE_SYMBOL);
1275 x_default_parameter (f, parms, Qtitle, Qnil, "title", "Title",
1276 RES_TYPE_STRING);
1277
1278 parms = get_geometry_from_preferences (dpyinfo, parms);
1279 window_prompting = x_figure_window_size (f, parms, 1);
1280
1281 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
1282 f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !EQ (tem, Qnil));
1283
1284 /* NOTE: on other terms, this is done in set_mouse_color, however this
1285 was not getting called under Nextstep */
1286 f->output_data.ns->text_cursor = [NSCursor IBeamCursor];
1287 f->output_data.ns->nontext_cursor = [NSCursor arrowCursor];
1288 f->output_data.ns->modeline_cursor = [NSCursor pointingHandCursor];
1289 f->output_data.ns->hand_cursor = [NSCursor pointingHandCursor];
1290 f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
1291 f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
1292 FRAME_NS_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
1293 = [NSCursor arrowCursor];
1294 f->output_data.ns->current_pointer = f->output_data.ns->text_cursor;
1295
1296 [[EmacsView alloc] initFrameFromEmacs: f];
1297
1298 x_icon (f, parms);
1299
1300 /* ns_display_info does not have a reference_count. */
1301 f->terminal->reference_count++;
1302
1303 /* It is now ok to make the frame official even if we get an error below.
1304 The frame needs to be on Vframe_list or making it visible won't work. */
1305 Vframe_list = Fcons (frame, Vframe_list);
1306
1307 x_default_parameter (f, parms, Qicon_type, Qnil,
1308 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
1309
1310 x_default_parameter (f, parms, Qauto_raise, Qnil,
1311 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
1312 x_default_parameter (f, parms, Qauto_lower, Qnil,
1313 "autoLower", "AutoLower", RES_TYPE_BOOLEAN);
1314 x_default_parameter (f, parms, Qcursor_type, Qbox,
1315 "cursorType", "CursorType", RES_TYPE_SYMBOL);
1316 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
1317 "scrollBarWidth", "ScrollBarWidth",
1318 RES_TYPE_NUMBER);
1319 x_default_parameter (f, parms, Qalpha, Qnil,
1320 "alpha", "Alpha", RES_TYPE_NUMBER);
1321 x_default_parameter (f, parms, Qfullscreen, Qnil,
1322 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
1323
1324 width = FRAME_COLS (f);
1325 height = FRAME_LINES (f);
1326
1327 SET_FRAME_COLS (f, 0);
1328 FRAME_LINES (f) = 0;
1329 change_frame_size (f, height, width, 1, 0, 0);
1330
1331 if (! f->output_data.ns->explicit_parent)
1332 {
1333 Lisp_Object visibility;
1334
1335 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
1336 RES_TYPE_SYMBOL);
1337 if (EQ (visibility, Qunbound))
1338 visibility = Qt;
1339
1340 if (EQ (visibility, Qicon))
1341 x_iconify_frame (f);
1342 else if (! NILP (visibility))
1343 {
1344 x_make_frame_visible (f);
1345 [[FRAME_NS_VIEW (f) window] makeKeyWindow];
1346 }
1347 else
1348 {
1349 /* Must have been Qnil. */
1350 }
1351 }
1352
1353 if (FRAME_HAS_MINIBUF_P (f)
1354 && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame))
1355 || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))))
1356 kset_default_minibuffer_frame (kb, frame);
1357
1358 /* All remaining specified parameters, which have not been "used"
1359 by x_get_arg and friends, now go in the misc. alist of the frame. */
1360 for (tem = parms; CONSP (tem); tem = XCDR (tem))
1361 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
1362 fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
1363
1364 UNGCPRO;
1365
1366 if (window_prompting & USPosition)
1367 x_set_offset (f, f->left_pos, f->top_pos, 1);
1368
1369 /* Make sure windows on this frame appear in calls to next-window
1370 and similar functions. */
1371 Vwindow_list = Qnil;
1372
1373 return unbind_to (count, frame);
1374 }
1375
1376
1377 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
1378 doc: /* Set the input focus to FRAME.
1379 FRAME nil means use the selected frame. */)
1380 (Lisp_Object frame)
1381 {
1382 struct frame *f = decode_window_system_frame (frame);
1383 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (f);
1384
1385 if (dpyinfo->x_focus_frame != f)
1386 {
1387 EmacsView *view = FRAME_NS_VIEW (f);
1388 block_input ();
1389 [NSApp activateIgnoringOtherApps: YES];
1390 [[view window] makeKeyAndOrderFront: view];
1391 unblock_input ();
1392 }
1393
1394 return Qnil;
1395 }
1396
1397
1398 DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel,
1399 0, 1, "",
1400 doc: /* Pop up the font panel. */)
1401 (Lisp_Object frame)
1402 {
1403 struct frame *f = decode_window_system_frame (frame);
1404 id fm = [NSFontManager sharedFontManager];
1405
1406 [fm setSelectedFont: ((struct nsfont_info *)f->output_data.ns->font)->nsfont
1407 isMultiple: NO];
1408 [fm orderFrontFontPanel: NSApp];
1409 return Qnil;
1410 }
1411
1412
1413 DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel,
1414 0, 1, "",
1415 doc: /* Pop up the color panel. */)
1416 (Lisp_Object frame)
1417 {
1418 check_window_system (NULL);
1419 [NSApp orderFrontColorPanel: NSApp];
1420 return Qnil;
1421 }
1422
1423
1424 DEFUN ("ns-read-file-name", Fns_read_file_name, Sns_read_file_name, 1, 5, 0,
1425 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1426 Optional arg DIR, if non-nil, supplies a default directory.
1427 Optional arg MUSTMATCH, if non-nil, means the returned file or
1428 directory must exist.
1429 Optional arg INIT, if non-nil, provides a default file name to use.
1430 Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
1431 (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch,
1432 Lisp_Object init, Lisp_Object dir_only_p)
1433 {
1434 static id fileDelegate = nil;
1435 BOOL ret;
1436 id panel;
1437 Lisp_Object fname;
1438
1439 NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil :
1440 [NSString stringWithUTF8String: SSDATA (prompt)];
1441 NSString *dirS = NILP (dir) || !STRINGP (dir) ?
1442 [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] :
1443 [NSString stringWithUTF8String: SSDATA (dir)];
1444 NSString *initS = NILP (init) || !STRINGP (init) ? nil :
1445 [NSString stringWithUTF8String: SSDATA (init)];
1446
1447 check_window_system (NULL);
1448
1449 if (fileDelegate == nil)
1450 fileDelegate = [EmacsFileDelegate new];
1451
1452 [NSCursor setHiddenUntilMouseMoves: NO];
1453
1454 if ([dirS characterAtIndex: 0] == '~')
1455 dirS = [dirS stringByExpandingTildeInPath];
1456
1457 panel = NILP (mustmatch) && NILP (dir_only_p) ?
1458 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel];
1459
1460 [panel setTitle: promptS];
1461
1462 [panel setAllowsOtherFileTypes: YES];
1463 [panel setTreatsFilePackagesAsDirectories: YES];
1464 [panel setDelegate: fileDelegate];
1465
1466 panelOK = 0;
1467 if (! NILP (dir_only_p))
1468 {
1469 [panel setCanChooseDirectories: YES];
1470 [panel setCanChooseFiles: NO];
1471 }
1472 else
1473 {
1474 /* This is not quite what the documentation says, but it is compatible
1475 with the Gtk+ code. Also, the menu entry says "Open File...". */
1476 [panel setCanChooseDirectories: NO];
1477 [panel setCanChooseFiles: YES];
1478 }
1479
1480 block_input ();
1481 #if defined (NS_IMPL_COCOA) && \
1482 MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1483 if (! NILP (mustmatch) || ! NILP (dir_only_p))
1484 [panel setAllowedFileTypes: nil];
1485 if (dirS) [panel setDirectoryURL: [NSURL fileURLWithPath: dirS]];
1486 if (initS && NILP (Ffile_directory_p (init)))
1487 [panel setNameFieldStringValue: [initS lastPathComponent]];
1488 else
1489 [panel setNameFieldStringValue: @""];
1490
1491 ret = [panel runModal];
1492 #else
1493 if (NILP (mustmatch) && NILP (dir_only_p))
1494 {
1495 ret = [panel runModalForDirectory: dirS file: initS];
1496 }
1497 else
1498 {
1499 ret = [panel runModalForDirectory: dirS file: initS types: nil];
1500 }
1501 #endif
1502
1503 ret = (ret == NSOKButton) || panelOK;
1504
1505 if (ret)
1506 {
1507 NSString *str = [panel getFilename];
1508 if (! str) str = [panel getDirectory];
1509 if (! str) ret = NO;
1510 else fname = build_string ([str UTF8String]);
1511 }
1512
1513 [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow];
1514 unblock_input ();
1515
1516 return ret ? fname : Qnil;
1517 }
1518
1519 const char *
1520 ns_get_defaults_value (const char *key)
1521 {
1522 NSObject *obj = [[NSUserDefaults standardUserDefaults]
1523 objectForKey: [NSString stringWithUTF8String: key]];
1524
1525 if (!obj) return NULL;
1526
1527 return [[NSString stringWithFormat: @"%@", obj] UTF8String];
1528 }
1529
1530
1531 DEFUN ("ns-get-resource", Fns_get_resource, Sns_get_resource, 2, 2, 0,
1532 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1533 If OWNER is nil, Emacs is assumed. */)
1534 (Lisp_Object owner, Lisp_Object name)
1535 {
1536 const char *value;
1537
1538 check_window_system (NULL);
1539 if (NILP (owner))
1540 owner = build_string([ns_app_name UTF8String]);
1541 CHECK_STRING (name);
1542
1543 value = ns_get_defaults_value (SSDATA (name));
1544
1545 if (value)
1546 return build_string (value);
1547 return Qnil;
1548 }
1549
1550
1551 DEFUN ("ns-set-resource", Fns_set_resource, Sns_set_resource, 3, 3, 0,
1552 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1553 If OWNER is nil, Emacs is assumed.
1554 If VALUE is nil, the default is removed. */)
1555 (Lisp_Object owner, Lisp_Object name, Lisp_Object value)
1556 {
1557 check_window_system (NULL);
1558 if (NILP (owner))
1559 owner = build_string ([ns_app_name UTF8String]);
1560 CHECK_STRING (name);
1561 if (NILP (value))
1562 {
1563 [[NSUserDefaults standardUserDefaults] removeObjectForKey:
1564 [NSString stringWithUTF8String: SSDATA (name)]];
1565 }
1566 else
1567 {
1568 CHECK_STRING (value);
1569 [[NSUserDefaults standardUserDefaults] setObject:
1570 [NSString stringWithUTF8String: SSDATA (value)]
1571 forKey: [NSString stringWithUTF8String:
1572 SSDATA (name)]];
1573 }
1574
1575 return Qnil;
1576 }
1577
1578
1579 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
1580 Sx_server_max_request_size,
1581 0, 1, 0,
1582 doc: /* This function is a no-op. It is only present for completeness. */)
1583 (Lisp_Object display)
1584 {
1585 check_ns_display_info (display);
1586 /* This function has no real equivalent under NeXTstep. Return nil to
1587 indicate this. */
1588 return Qnil;
1589 }
1590
1591
1592 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
1593 doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
1594 DISPLAY should be either a frame or a display name (a string).
1595 If omitted or nil, the selected frame's display is used. */)
1596 (Lisp_Object display)
1597 {
1598 #ifdef NS_IMPL_GNUSTEP
1599 return build_string ("GNU");
1600 #else
1601 return build_string ("Apple");
1602 #endif
1603 }
1604
1605
1606 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
1607 doc: /* Return the version numbers of the server of DISPLAY.
1608 The value is a list of three integers: the major and minor
1609 version numbers of the X Protocol in use, and the distributor-specific
1610 release number. See also the function `x-server-vendor'.
1611
1612 The optional argument DISPLAY specifies which display to ask about.
1613 DISPLAY should be either a frame or a display name (a string).
1614 If omitted or nil, that stands for the selected frame's display. */)
1615 (Lisp_Object display)
1616 {
1617 /*NOTE: it is unclear what would best correspond with "protocol";
1618 we return 10.3, meaning Panther, since this is roughly the
1619 level that GNUstep's APIs correspond to.
1620 The last number is where we distinguish between the Apple
1621 and GNUstep implementations ("distributor-specific release
1622 number") and give int'ized versions of major.minor. */
1623 return list3i (10, 3, ns_appkit_version_int ());
1624 }
1625
1626
1627 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
1628 doc: /* Return the number of screens on Nextstep display server DISPLAY.
1629 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1630 If omitted or nil, the selected frame's display is used. */)
1631 (Lisp_Object display)
1632 {
1633 int num;
1634
1635 check_ns_display_info (display);
1636 num = [[NSScreen screens] count];
1637
1638 return (num != 0) ? make_number (num) : Qnil;
1639 }
1640
1641
1642 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height,
1643 0, 1, 0,
1644 doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
1645 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1646 If omitted or nil, the selected frame's display is used. */)
1647 (Lisp_Object display)
1648 {
1649 check_ns_display_info (display);
1650 return make_number ((int)
1651 ([ns_get_screen (display) frame].size.height/(92.0/25.4)));
1652 }
1653
1654
1655 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width,
1656 0, 1, 0,
1657 doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
1658 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1659 If omitted or nil, the selected frame's display is used. */)
1660 (Lisp_Object display)
1661 {
1662 check_ns_display_info (display);
1663 return make_number ((int)
1664 ([ns_get_screen (display) frame].size.width/(92.0/25.4)));
1665 }
1666
1667
1668 DEFUN ("x-display-backing-store", Fx_display_backing_store,
1669 Sx_display_backing_store, 0, 1, 0,
1670 doc: /* Return whether the Nextstep display DISPLAY supports backing store.
1671 The value may be `buffered', `retained', or `non-retained'.
1672 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1673 If omitted or nil, the selected frame's display is used. */)
1674 (Lisp_Object display)
1675 {
1676 check_ns_display_info (display);
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 */
1689 }
1690
1691
1692 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1693 Sx_display_visual_class, 0, 1, 0,
1694 doc: /* Return the visual class of the Nextstep display server DISPLAY.
1695 The value is one of the symbols `static-gray', `gray-scale',
1696 `static-color', `pseudo-color', `true-color', or `direct-color'.
1697 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1698 If omitted or nil, the selected frame's display is used. */)
1699 (Lisp_Object display)
1700 {
1701 NSWindowDepth depth;
1702
1703 check_ns_display_info (display);
1704 depth = [ns_get_screen (display) depth];
1705
1706 if ( depth == NSBestDepth (NSCalibratedWhiteColorSpace, 2, 2, YES, NULL))
1707 return intern ("static-gray");
1708 else if (depth == NSBestDepth (NSCalibratedWhiteColorSpace, 8, 8, YES, NULL))
1709 return intern ("gray-scale");
1710 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 8, YES, NULL))
1711 return intern ("pseudo-color");
1712 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 4, 12, NO, NULL))
1713 return intern ("true-color");
1714 else if ( depth == NSBestDepth (NSCalibratedRGBColorSpace, 8, 24, NO, NULL))
1715 return intern ("direct-color");
1716 else
1717 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1718 return intern ("direct-color");
1719 }
1720
1721
1722 DEFUN ("x-display-save-under", Fx_display_save_under,
1723 Sx_display_save_under, 0, 1, 0,
1724 doc: /* Return t if DISPLAY supports the save-under feature.
1725 The optional argument DISPLAY specifies which display to ask about.
1726 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1727 If omitted or nil, the selected frame's display is used. */)
1728 (Lisp_Object display)
1729 {
1730 check_ns_display_info (display);
1731 switch ([ns_get_window (display) backingType])
1732 {
1733 case NSBackingStoreBuffered:
1734 return Qt;
1735
1736 case NSBackingStoreRetained:
1737 case NSBackingStoreNonretained:
1738 return Qnil;
1739
1740 default:
1741 error ("Strange value for backingType parameter of frame");
1742 }
1743 return Qnil; /* not reached, shut compiler up */
1744 }
1745
1746
1747 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
1748 1, 3, 0,
1749 doc: /* Open a connection to a display server.
1750 DISPLAY is the name of the display to connect to.
1751 Optional second arg XRM-STRING is a string of resources in xrdb format.
1752 If the optional third arg MUST-SUCCEED is non-nil,
1753 terminate Emacs if we can't open the connection.
1754 \(In the Nextstep version, the last two arguments are currently ignored.) */)
1755 (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed)
1756 {
1757 struct ns_display_info *dpyinfo;
1758
1759 CHECK_STRING (display);
1760
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 SSDATA (display));
1768 else
1769 error ("OpenStep on %s not responding.\n",
1770 SSDATA (display));
1771 }
1772
1773 return Qnil;
1774 }
1775
1776
1777 DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection,
1778 1, 1, 0,
1779 doc: /* Close the connection to the current Nextstep display server.
1780 DISPLAY should be a frame, the display name as a string, or a terminal ID. */)
1781 (Lisp_Object display)
1782 {
1783 check_ns_display_info (display);
1784 [NSApp terminate: NSApp];
1785 return Qnil;
1786 }
1787
1788
1789 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
1790 doc: /* Return the list of display names that Emacs has connections to. */)
1791 (void)
1792 {
1793 Lisp_Object tail, result;
1794
1795 result = Qnil;
1796 for (tail = ns_display_name_list; CONSP (tail); tail = XCDR (tail))
1797 result = Fcons (XCAR (XCAR (tail)), result);
1798
1799 return result;
1800 }
1801
1802
1803 DEFUN ("ns-hide-others", Fns_hide_others, Sns_hide_others,
1804 0, 0, 0,
1805 doc: /* Hides all applications other than Emacs. */)
1806 (void)
1807 {
1808 check_window_system (NULL);
1809 [NSApp hideOtherApplications: NSApp];
1810 return Qnil;
1811 }
1812
1813 DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
1814 1, 1, 0,
1815 doc: /* If ON is non-nil, the entire Emacs application is hidden.
1816 Otherwise if Emacs is hidden, it is unhidden.
1817 If ON is equal to `activate', Emacs is unhidden and becomes
1818 the active application. */)
1819 (Lisp_Object on)
1820 {
1821 check_window_system (NULL);
1822 if (EQ (on, intern ("activate")))
1823 {
1824 [NSApp unhide: NSApp];
1825 [NSApp activateIgnoringOtherApps: YES];
1826 }
1827 else if (NILP (on))
1828 [NSApp unhide: NSApp];
1829 else
1830 [NSApp hide: NSApp];
1831 return Qnil;
1832 }
1833
1834
1835 DEFUN ("ns-emacs-info-panel", Fns_emacs_info_panel, Sns_emacs_info_panel,
1836 0, 0, 0,
1837 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
1838 (void)
1839 {
1840 check_window_system (NULL);
1841 [NSApp orderFrontStandardAboutPanel: nil];
1842 return Qnil;
1843 }
1844
1845
1846 DEFUN ("ns-font-name", Fns_font_name, Sns_font_name, 1, 1, 0,
1847 doc: /* Determine font PostScript or family name for font NAME.
1848 NAME should be a string containing either the font name or an XLFD
1849 font descriptor. If string contains `fontset' and not
1850 `fontset-startup', it is left alone. */)
1851 (Lisp_Object name)
1852 {
1853 char *nm;
1854 CHECK_STRING (name);
1855 nm = SSDATA (name);
1856
1857 if (nm[0] != '-')
1858 return name;
1859 if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup"))
1860 return name;
1861
1862 return build_string (ns_xlfd_to_fontname (SSDATA (name)));
1863 }
1864
1865
1866 DEFUN ("ns-list-colors", Fns_list_colors, Sns_list_colors, 0, 1, 0,
1867 doc: /* Return a list of all available colors.
1868 The optional argument FRAME is currently ignored. */)
1869 (Lisp_Object frame)
1870 {
1871 Lisp_Object list = Qnil;
1872 NSEnumerator *colorlists;
1873 NSColorList *clist;
1874
1875 if (!NILP (frame))
1876 {
1877 CHECK_FRAME (frame);
1878 if (! FRAME_NS_P (XFRAME (frame)))
1879 error ("non-Nextstep frame used in `ns-list-colors'");
1880 }
1881
1882 block_input ();
1883
1884 colorlists = [[NSColorList availableColorLists] objectEnumerator];
1885 while ((clist = [colorlists nextObject]))
1886 {
1887 if ([[clist name] length] < 7 ||
1888 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1889 {
1890 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1891 NSString *cname;
1892 while ((cname = [cnames nextObject]))
1893 list = Fcons (build_string ([cname UTF8String]), list);
1894 /* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1895 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1896 UTF8String]), list); */
1897 }
1898 }
1899
1900 unblock_input ();
1901
1902 return list;
1903 }
1904
1905
1906 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1907 doc: /* List available Nextstep services by querying NSApp. */)
1908 (void)
1909 {
1910 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1911 /* You can't get services like this in 10.6+. */
1912 return Qnil;
1913 #else
1914 Lisp_Object ret = Qnil;
1915 NSMenu *svcs;
1916 id delegate;
1917
1918 check_window_system (NULL);
1919 svcs = [[NSMenu alloc] initWithTitle: @"Services"];
1920 [NSApp setServicesMenu: svcs];
1921 [NSApp registerServicesMenuSendTypes: ns_send_types
1922 returnTypes: ns_return_types];
1923
1924 /* On Tiger, services menu updating was made lazier (waits for user to
1925 actually click on the menu), so we have to force things along: */
1926 #ifdef NS_IMPL_COCOA
1927 delegate = [svcs delegate];
1928 if (delegate != nil)
1929 {
1930 if ([delegate respondsToSelector: @selector (menuNeedsUpdate:)])
1931 [delegate menuNeedsUpdate: svcs];
1932 if ([delegate respondsToSelector:
1933 @selector (menu:updateItem:atIndex:shouldCancel:)])
1934 {
1935 int i, len = [delegate numberOfItemsInMenu: svcs];
1936 for (i =0; i<len; i++)
1937 [svcs addItemWithTitle: @"" action: NULL keyEquivalent: @""];
1938 for (i =0; i<len; i++)
1939 if (![delegate menu: svcs
1940 updateItem: (NSMenuItem *)[svcs itemAtIndex: i]
1941 atIndex: i shouldCancel: NO])
1942 break;
1943 }
1944 }
1945 #endif
1946
1947 [svcs setAutoenablesItems: NO];
1948 #ifdef NS_IMPL_COCOA
1949 [svcs update]; /* on OS X, converts from '/' structure */
1950 #endif
1951
1952 ret = interpret_services_menu (svcs, Qnil, ret);
1953 return ret;
1954 #endif
1955 }
1956
1957
1958 DEFUN ("ns-perform-service", Fns_perform_service, Sns_perform_service,
1959 2, 2, 0,
1960 doc: /* Perform Nextstep SERVICE on SEND.
1961 SEND should be either a string or nil.
1962 The return value is the result of the service, as string, or nil if
1963 there was no result. */)
1964 (Lisp_Object service, Lisp_Object send)
1965 {
1966 id pb;
1967 NSString *svcName;
1968 char *utfStr;
1969
1970 CHECK_STRING (service);
1971 check_window_system (NULL);
1972
1973 utfStr = SSDATA (service);
1974 svcName = [NSString stringWithUTF8String: utfStr];
1975
1976 pb =[NSPasteboard pasteboardWithUniqueName];
1977 ns_string_to_pasteboard (pb, send);
1978
1979 if (NSPerformService (svcName, pb) == NO)
1980 Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
1981
1982 if ([[pb types] count] == 0)
1983 return build_string ("");
1984 return ns_string_from_pasteboard (pb);
1985 }
1986
1987
1988 DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
1989 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
1990 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
1991 (Lisp_Object str)
1992 {
1993 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
1994 remove this. */
1995 NSString *utfStr;
1996
1997 CHECK_STRING (str);
1998 utfStr = [NSString stringWithUTF8String: SSDATA (str)];
1999 if (![utfStr respondsToSelector:
2000 @selector (precomposedStringWithCanonicalMapping)])
2001 {
2002 message1
2003 ("Warning: ns-convert-utf8-nfd-to-nfc unsupported under GNUstep.\n");
2004 return Qnil;
2005 }
2006 else
2007 utfStr = [utfStr precomposedStringWithCanonicalMapping];
2008 return build_string ([utfStr UTF8String]);
2009 }
2010
2011
2012 #ifdef NS_IMPL_COCOA
2013
2014 /* Compile and execute the AppleScript SCRIPT and return the error
2015 status as function value. A zero is returned if compilation and
2016 execution is successful, in which case *RESULT is set to a Lisp
2017 string or a number containing the resulting script value. Otherwise,
2018 1 is returned. */
2019 static int
2020 ns_do_applescript (Lisp_Object script, Lisp_Object *result)
2021 {
2022 NSAppleEventDescriptor *desc;
2023 NSDictionary* errorDict;
2024 NSAppleEventDescriptor* returnDescriptor = NULL;
2025
2026 NSAppleScript* scriptObject =
2027 [[NSAppleScript alloc] initWithSource:
2028 [NSString stringWithUTF8String: SSDATA (script)]];
2029
2030 returnDescriptor = [scriptObject executeAndReturnError: &errorDict];
2031 [scriptObject release];
2032
2033 *result = Qnil;
2034
2035 if (returnDescriptor != NULL)
2036 {
2037 // successful execution
2038 if (kAENullEvent != [returnDescriptor descriptorType])
2039 {
2040 *result = Qt;
2041 // script returned an AppleScript result
2042 if ((typeUnicodeText == [returnDescriptor descriptorType]) ||
2043 #if defined (NS_IMPL_COCOA)
2044 (typeUTF16ExternalRepresentation
2045 == [returnDescriptor descriptorType]) ||
2046 #endif
2047 (typeUTF8Text == [returnDescriptor descriptorType]) ||
2048 (typeCString == [returnDescriptor descriptorType]))
2049 {
2050 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2051 if (desc)
2052 *result = build_string([[desc stringValue] UTF8String]);
2053 }
2054 else
2055 {
2056 /* use typeUTF16ExternalRepresentation? */
2057 // coerce the result to the appropriate ObjC type
2058 desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text];
2059 if (desc)
2060 *result = make_number([desc int32Value]);
2061 }
2062 }
2063 }
2064 else
2065 {
2066 // no script result, return error
2067 return 1;
2068 }
2069 return 0;
2070 }
2071
2072 /* Helper function called from sendEvent to run applescript
2073 from within the main event loop. */
2074
2075 void
2076 ns_run_ascript (void)
2077 {
2078 if (! NILP (as_script))
2079 as_status = ns_do_applescript (as_script, as_result);
2080 as_script = Qnil;
2081 }
2082
2083 DEFUN ("ns-do-applescript", Fns_do_applescript, Sns_do_applescript, 1, 1, 0,
2084 doc: /* Execute AppleScript SCRIPT and return the result.
2085 If compilation and execution are successful, the resulting script value
2086 is returned as a string, a number or, in the case of other constructs, t.
2087 In case the execution fails, an error is signaled. */)
2088 (Lisp_Object script)
2089 {
2090 Lisp_Object result;
2091 int status;
2092 NSEvent *nxev;
2093
2094 CHECK_STRING (script);
2095 check_window_system (NULL);
2096
2097 block_input ();
2098
2099 as_script = script;
2100 as_result = &result;
2101
2102 /* executing apple script requires the event loop to run, otherwise
2103 errors aren't returned and executeAndReturnError hangs forever.
2104 Post an event that runs applescript and then start the event loop.
2105 The event loop is exited when the script is done. */
2106 nxev = [NSEvent otherEventWithType: NSApplicationDefined
2107 location: NSMakePoint (0, 0)
2108 modifierFlags: 0
2109 timestamp: 0
2110 windowNumber: [[NSApp mainWindow] windowNumber]
2111 context: [NSApp context]
2112 subtype: 0
2113 data1: 0
2114 data2: NSAPP_DATA2_RUNASSCRIPT];
2115
2116 [NSApp postEvent: nxev atStart: NO];
2117
2118 // If there are other events, the event loop may exit. Keep running
2119 // until the script has been handled. */
2120 while (! NILP (as_script))
2121 [NSApp run];
2122
2123 status = as_status;
2124 as_status = 0;
2125 as_result = 0;
2126 unblock_input ();
2127 if (status == 0)
2128 return result;
2129 else if (!STRINGP (result))
2130 error ("AppleScript error %d", status);
2131 else
2132 error ("%s", SSDATA (result));
2133 }
2134 #endif
2135
2136
2137
2138 /* ==========================================================================
2139
2140 Miscellaneous functions not called through hooks
2141
2142 ========================================================================== */
2143
2144 /* called from frame.c */
2145 struct ns_display_info *
2146 check_x_display_info (Lisp_Object frame)
2147 {
2148 return check_ns_display_info (frame);
2149 }
2150
2151
2152 void
2153 x_set_scroll_bar_default_width (struct frame *f)
2154 {
2155 int wid = FRAME_COLUMN_WIDTH (f);
2156 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = NS_SCROLL_BAR_WIDTH_DEFAULT;
2157 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
2158 wid - 1) / wid;
2159 }
2160
2161
2162 /* terms impl this instead of x-get-resource directly */
2163 const char *
2164 x_get_string_resource (XrmDatabase rdb, char *name, char *class)
2165 {
2166 /* remove appname prefix; TODO: allow for !="Emacs" */
2167 char *toCheck = class + (!strncmp (class, "Emacs.", 6) ? 6 : 0);
2168 const char *res;
2169 check_window_system (NULL);
2170
2171 if (inhibit_x_resources)
2172 /* --quick was passed, so this is a no-op. */
2173 return NULL;
2174
2175 res = ns_get_defaults_value (toCheck);
2176 return !res ? NULL :
2177 (!c_strncasecmp (res, "YES", 3) ? "true" :
2178 (!c_strncasecmp (res, "NO", 2) ? "false" : res));
2179 }
2180
2181
2182 Lisp_Object
2183 x_get_focus_frame (struct frame *frame)
2184 {
2185 struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (frame);
2186 Lisp_Object nsfocus;
2187
2188 if (!dpyinfo->x_focus_frame)
2189 return Qnil;
2190
2191 XSETFRAME (nsfocus, dpyinfo->x_focus_frame);
2192 return nsfocus;
2193 }
2194
2195
2196 int
2197 x_pixel_width (struct frame *f)
2198 {
2199 return FRAME_PIXEL_WIDTH (f);
2200 }
2201
2202
2203 int
2204 x_pixel_height (struct frame *f)
2205 {
2206 return FRAME_PIXEL_HEIGHT (f);
2207 }
2208
2209
2210 int
2211 x_screen_planes (struct frame *f)
2212 {
2213 return FRAME_NS_DISPLAY_INFO (f)->n_planes;
2214 }
2215
2216
2217 void
2218 x_sync (struct frame *f)
2219 {
2220 /* XXX Not implemented XXX */
2221 return;
2222 }
2223
2224
2225
2226 /* ==========================================================================
2227
2228 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2229
2230 ========================================================================== */
2231
2232
2233 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
2234 doc: /* Internal function called by `color-defined-p', which see.
2235 \(Note that the Nextstep version of this function ignores FRAME.) */)
2236 (Lisp_Object color, Lisp_Object frame)
2237 {
2238 NSColor * col;
2239 check_window_system (NULL);
2240 return ns_lisp_to_color (color, &col) ? Qnil : Qt;
2241 }
2242
2243
2244 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
2245 doc: /* Internal function called by `color-values', which see. */)
2246 (Lisp_Object color, Lisp_Object frame)
2247 {
2248 NSColor * col;
2249 CGFloat red, green, blue, alpha;
2250
2251 check_window_system (NULL);
2252 CHECK_STRING (color);
2253
2254 if (ns_lisp_to_color (color, &col))
2255 return Qnil;
2256
2257 [[col colorUsingColorSpaceName: NSCalibratedRGBColorSpace]
2258 getRed: &red green: &green blue: &blue alpha: &alpha];
2259 return list3i (lrint (red * 65280), lrint (green * 65280),
2260 lrint (blue * 65280));
2261 }
2262
2263
2264 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
2265 doc: /* Internal function called by `display-color-p', which see. */)
2266 (Lisp_Object display)
2267 {
2268 NSWindowDepth depth;
2269 NSString *colorSpace;
2270
2271 check_ns_display_info (display);
2272 depth = [ns_get_screen (display) depth];
2273 colorSpace = NSColorSpaceFromDepth (depth);
2274
2275 return [colorSpace isEqualToString: NSDeviceWhiteColorSpace]
2276 || [colorSpace isEqualToString: NSCalibratedWhiteColorSpace]
2277 ? Qnil : Qt;
2278 }
2279
2280
2281 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
2282 Sx_display_grayscale_p, 0, 1, 0,
2283 doc: /* Return t if the Nextstep display supports shades of gray.
2284 Note that color displays do support shades of gray.
2285 The optional argument DISPLAY specifies which display to ask about.
2286 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2287 If omitted or nil, that stands for the selected frame's display. */)
2288 (Lisp_Object display)
2289 {
2290 NSWindowDepth depth;
2291
2292 check_ns_display_info (display);
2293 depth = [ns_get_screen (display) depth];
2294
2295 return NSBitsPerPixelFromDepth (depth) > 1 ? Qt : Qnil;
2296 }
2297
2298
2299 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2300 0, 1, 0,
2301 doc: /* Return the width in pixels of the Nextstep display DISPLAY.
2302 The optional argument DISPLAY specifies which display to ask about.
2303 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2304 If omitted or nil, that stands for the selected frame's display. */)
2305 (Lisp_Object display)
2306 {
2307 check_ns_display_info (display);
2308 return make_number ((int) [ns_get_screen (display) frame].size.width);
2309 }
2310
2311
2312 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2313 Sx_display_pixel_height, 0, 1, 0,
2314 doc: /* Return the height in pixels of the Nextstep display DISPLAY.
2315 The optional argument DISPLAY specifies which display to ask about.
2316 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2317 If omitted or nil, that stands for the selected frame's display. */)
2318 (Lisp_Object display)
2319 {
2320 check_ns_display_info (display);
2321 return make_number ((int) [ns_get_screen (display) frame].size.height);
2322 }
2323
2324
2325 DEFUN ("display-usable-bounds", Fns_display_usable_bounds,
2326 Sns_display_usable_bounds, 0, 1, 0,
2327 doc: /* Return the bounds of the usable part of the screen.
2328 The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
2329 are the boundaries of the usable part of the screen, excluding areas
2330 reserved for the Mac menu, dock, and so forth.
2331
2332 The screen queried corresponds to DISPLAY, which should be either a
2333 frame, a display name (a string), or terminal ID. If omitted or nil,
2334 that stands for the selected frame's display. */)
2335 (Lisp_Object display)
2336 {
2337 NSScreen *screen;
2338 NSRect vScreen;
2339
2340 check_ns_display_info (display);
2341 screen = ns_get_screen (display);
2342 if (!screen)
2343 return Qnil;
2344
2345 vScreen = [screen visibleFrame];
2346
2347 /* NS coordinate system is upside-down.
2348 Transform to screen-specific coordinates. */
2349 return list4i (vScreen.origin.x,
2350 [screen frame].size.height
2351 - vScreen.size.height - vScreen.origin.y,
2352 vScreen.size.width, vScreen.size.height);
2353 }
2354
2355
2356 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2357 0, 1, 0,
2358 doc: /* Return the number of bitplanes of the Nextstep display DISPLAY.
2359 The optional argument DISPLAY specifies which display to ask about.
2360 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2361 If omitted or nil, that stands for the selected frame's display. */)
2362 (Lisp_Object display)
2363 {
2364 check_ns_display_info (display);
2365 return make_number
2366 (NSBitsPerPixelFromDepth ([ns_get_screen (display) depth]));
2367 }
2368
2369
2370 DEFUN ("x-display-color-cells", Fx_display_color_cells,
2371 Sx_display_color_cells, 0, 1, 0,
2372 doc: /* Returns the number of color cells of the Nextstep display DISPLAY.
2373 The optional argument DISPLAY specifies which display to ask about.
2374 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2375 If omitted or nil, that stands for the selected frame's display. */)
2376 (Lisp_Object display)
2377 {
2378 struct ns_display_info *dpyinfo = check_ns_display_info (display);
2379 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2380 return make_number (1 << min (dpyinfo->n_planes, 24));
2381 }
2382
2383
2384 /* Unused dummy def needed for compatibility. */
2385 Lisp_Object tip_frame;
2386
2387 /* TODO: move to xdisp or similar */
2388 static void
2389 compute_tip_xy (struct frame *f,
2390 Lisp_Object parms,
2391 Lisp_Object dx,
2392 Lisp_Object dy,
2393 int width,
2394 int height,
2395 int *root_x,
2396 int *root_y)
2397 {
2398 Lisp_Object left, top;
2399 EmacsView *view = FRAME_NS_VIEW (f);
2400 NSPoint pt;
2401
2402 /* Start with user-specified or mouse position. */
2403 left = Fcdr (Fassq (Qleft, parms));
2404 top = Fcdr (Fassq (Qtop, parms));
2405
2406 if (!INTEGERP (left) || !INTEGERP (top))
2407 {
2408 pt = last_mouse_motion_position;
2409 /* Convert to screen coordinates */
2410 pt = [view convertPoint: pt toView: nil];
2411 pt = [[view window] convertBaseToScreen: pt];
2412 }
2413 else
2414 {
2415 /* Absolute coordinates. */
2416 pt.x = XINT (left);
2417 pt.y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - XINT (top)
2418 - height;
2419 }
2420
2421 /* Ensure in bounds. (Note, screen origin = lower left.) */
2422 if (INTEGERP (left))
2423 *root_x = pt.x;
2424 else if (pt.x + XINT (dx) <= 0)
2425 *root_x = 0; /* Can happen for negative dx */
2426 else if (pt.x + XINT (dx) + width
2427 <= x_display_pixel_width (FRAME_NS_DISPLAY_INFO (f)))
2428 /* It fits to the right of the pointer. */
2429 *root_x = pt.x + XINT (dx);
2430 else if (width + XINT (dx) <= pt.x)
2431 /* It fits to the left of the pointer. */
2432 *root_x = pt.x - width - XINT (dx);
2433 else
2434 /* Put it left justified on the screen -- it ought to fit that way. */
2435 *root_x = 0;
2436
2437 if (INTEGERP (top))
2438 *root_y = pt.y;
2439 else if (pt.y - XINT (dy) - height >= 0)
2440 /* It fits below the pointer. */
2441 *root_y = pt.y - height - XINT (dy);
2442 else if (pt.y + XINT (dy) + height
2443 <= x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)))
2444 /* It fits above the pointer */
2445 *root_y = pt.y + XINT (dy);
2446 else
2447 /* Put it on the top. */
2448 *root_y = x_display_pixel_height (FRAME_NS_DISPLAY_INFO (f)) - height;
2449 }
2450
2451
2452 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
2453 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2454 A tooltip window is a small window displaying a string.
2455
2456 This is an internal function; Lisp code should call `tooltip-show'.
2457
2458 FRAME nil or omitted means use the selected frame.
2459
2460 PARMS is an optional list of frame parameters which can be used to
2461 change the tooltip's appearance.
2462
2463 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2464 means use the default timeout of 5 seconds.
2465
2466 If the list of frame parameters PARMS contains a `left' parameter,
2467 the tooltip is displayed at that x-position. Otherwise it is
2468 displayed at the mouse position, with offset DX added (default is 5 if
2469 DX isn't specified). Likewise for the y-position; if a `top' frame
2470 parameter is specified, it determines the y-position of the tooltip
2471 window, otherwise it is displayed at the mouse position, with offset
2472 DY added (default is -10).
2473
2474 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2475 Text larger than the specified size is clipped. */)
2476 (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
2477 {
2478 int root_x, root_y;
2479 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2480 ptrdiff_t count = SPECPDL_INDEX ();
2481 struct frame *f;
2482 char *str;
2483 NSSize size;
2484
2485 specbind (Qinhibit_redisplay, Qt);
2486
2487 GCPRO4 (string, parms, frame, timeout);
2488
2489 CHECK_STRING (string);
2490 str = SSDATA (string);
2491 f = decode_window_system_frame (frame);
2492 if (NILP (timeout))
2493 timeout = make_number (5);
2494 else
2495 CHECK_NATNUM (timeout);
2496
2497 if (NILP (dx))
2498 dx = make_number (5);
2499 else
2500 CHECK_NUMBER (dx);
2501
2502 if (NILP (dy))
2503 dy = make_number (-10);
2504 else
2505 CHECK_NUMBER (dy);
2506
2507 block_input ();
2508 if (ns_tooltip == nil)
2509 ns_tooltip = [[EmacsTooltip alloc] init];
2510 else
2511 Fx_hide_tip ();
2512
2513 [ns_tooltip setText: str];
2514 size = [ns_tooltip frame].size;
2515
2516 /* Move the tooltip window where the mouse pointer is. Resize and
2517 show it. */
2518 compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height,
2519 &root_x, &root_y);
2520
2521 [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
2522 unblock_input ();
2523
2524 UNGCPRO;
2525 return unbind_to (count, Qnil);
2526 }
2527
2528
2529 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
2530 doc: /* Hide the current tooltip window, if there is any.
2531 Value is t if tooltip was open, nil otherwise. */)
2532 (void)
2533 {
2534 if (ns_tooltip == nil || ![ns_tooltip isActive])
2535 return Qnil;
2536 [ns_tooltip hide];
2537 return Qt;
2538 }
2539
2540
2541 /* ==========================================================================
2542
2543 Class implementations
2544
2545 ========================================================================== */
2546
2547 /*
2548 Handle arrow/function/control keys and copy/paste/cut in file dialogs.
2549 Return YES if handeled, NO if not.
2550 */
2551 static BOOL
2552 handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
2553 {
2554 NSString *s;
2555 int i;
2556 BOOL ret = NO;
2557
2558 if ([theEvent type] != NSKeyDown) return NO;
2559 s = [theEvent characters];
2560
2561 for (i = 0; i < [s length]; ++i)
2562 {
2563 int ch = (int) [s characterAtIndex: i];
2564 switch (ch)
2565 {
2566 case NSHomeFunctionKey:
2567 case NSDownArrowFunctionKey:
2568 case NSUpArrowFunctionKey:
2569 case NSLeftArrowFunctionKey:
2570 case NSRightArrowFunctionKey:
2571 case NSPageUpFunctionKey:
2572 case NSPageDownFunctionKey:
2573 case NSEndFunctionKey:
2574 [panel sendEvent: theEvent];
2575 ret = YES;
2576 break;
2577 /* As we don't have the standard key commands for
2578 copy/paste/cut/select-all in our edit menu, we must handle
2579 them here. TODO: handle Emacs key bindings for copy/cut/select-all
2580 here, paste works, because we have that in our Edit menu.
2581 I.e. refactor out code in nsterm.m, keyDown: to figure out the
2582 correct modifier.
2583 */
2584 case 'x': // Cut
2585 case 'c': // Copy
2586 case 'v': // Paste
2587 case 'a': // Select all
2588 if ([theEvent modifierFlags] & NSCommandKeyMask)
2589 {
2590 [NSApp sendAction:
2591 (ch == 'x'
2592 ? @selector(cut:)
2593 : (ch == 'c'
2594 ? @selector(copy:)
2595 : (ch == 'v'
2596 ? @selector(paste:)
2597 : @selector(selectAll:))))
2598 to:nil from:panel];
2599 ret = YES;
2600 }
2601 default:
2602 // Send all control keys, as the text field supports C-a, C-f, C-e
2603 // C-b and more.
2604 if ([theEvent modifierFlags] & NSControlKeyMask)
2605 {
2606 [panel sendEvent: theEvent];
2607 ret = YES;
2608 }
2609 break;
2610 }
2611 }
2612
2613
2614 return ret;
2615 }
2616
2617 @implementation EmacsSavePanel
2618 #ifdef NS_IMPL_COCOA
2619 /* --------------------------------------------------------------------------
2620 These are overridden to intercept on OS X: ending panel restarts NSApp
2621 event loop if it is stopped. Not sure if this is correct behavior,
2622 perhaps should check if running and if so send an appdefined.
2623 -------------------------------------------------------------------------- */
2624 - (void) ok: (id)sender
2625 {
2626 [super ok: sender];
2627 panelOK = 1;
2628 [NSApp stop: self];
2629 }
2630 - (void) cancel: (id)sender
2631 {
2632 [super cancel: sender];
2633 [NSApp stop: self];
2634 }
2635 #endif
2636 - (NSString *) getFilename
2637 {
2638 return ns_filename_from_panel (self);
2639 }
2640 - (NSString *) getDirectory
2641 {
2642 return ns_directory_from_panel (self);
2643 }
2644
2645 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2646 {
2647 BOOL ret = handlePanelKeys (self, theEvent);
2648 if (! ret)
2649 ret = [super performKeyEquivalent:theEvent];
2650 return ret;
2651 }
2652 @end
2653
2654
2655 @implementation EmacsOpenPanel
2656 #ifdef NS_IMPL_COCOA
2657 /* --------------------------------------------------------------------------
2658 These are overridden to intercept on OS X: ending panel restarts NSApp
2659 event loop if it is stopped. Not sure if this is correct behavior,
2660 perhaps should check if running and if so send an appdefined.
2661 -------------------------------------------------------------------------- */
2662 - (void) ok: (id)sender
2663 {
2664 [super ok: sender];
2665
2666 // If not choosing directories, and Open is pressed on a directory, return.
2667 if (! [self canChooseDirectories] && [self getDirectory] &&
2668 ! [self getFilename])
2669 return;
2670
2671 panelOK = 1;
2672 [NSApp stop: self];
2673 }
2674 - (void) cancel: (id)sender
2675 {
2676 [super cancel: sender];
2677 [NSApp stop: self];
2678 }
2679
2680 #endif
2681 - (NSString *) getFilename
2682 {
2683 return ns_filename_from_panel (self);
2684 }
2685 - (NSString *) getDirectory
2686 {
2687 return ns_directory_from_panel (self);
2688 }
2689 - (BOOL)performKeyEquivalent:(NSEvent *)theEvent
2690 {
2691 // NSOpenPanel inherits NSSavePanel, so passing self is OK.
2692 BOOL ret = handlePanelKeys (self, theEvent);
2693 if (! ret)
2694 ret = [super performKeyEquivalent:theEvent];
2695 return ret;
2696 }
2697 @end
2698
2699
2700 @implementation EmacsFileDelegate
2701 /* --------------------------------------------------------------------------
2702 Delegate methods for Open/Save panels
2703 -------------------------------------------------------------------------- */
2704 - (BOOL)panel: (id)sender isValidFilename: (NSString *)filename
2705 {
2706 return YES;
2707 }
2708 - (BOOL)panel: (id)sender shouldShowFilename: (NSString *)filename
2709 {
2710 return YES;
2711 }
2712 - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
2713 confirmed: (BOOL)okFlag
2714 {
2715 return filename;
2716 }
2717 @end
2718
2719 #endif
2720
2721
2722 /* ==========================================================================
2723
2724 Lisp interface declaration
2725
2726 ========================================================================== */
2727
2728
2729 void
2730 syms_of_nsfns (void)
2731 {
2732 Qfontsize = intern_c_string ("fontsize");
2733 staticpro (&Qfontsize);
2734
2735 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
2736 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2737 If the title of a frame matches REGEXP, then IMAGE.tiff is
2738 selected as the image of the icon representing the frame when it's
2739 miniaturized. If an element is t, then Emacs tries to select an icon
2740 based on the filetype of the visited file.
2741
2742 The images have to be installed in a folder called English.lproj in the
2743 Emacs folder. You have to restart Emacs after installing new icons.
2744
2745 Example: Install an icon Gnus.tiff and execute the following code
2746
2747 (setq ns-icon-type-alist
2748 (append ns-icon-type-alist
2749 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2750 . \"Gnus\"))))
2751
2752 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2753 be used as the image of the icon representing the frame. */);
2754 Vns_icon_type_alist = Fcons (Qt, Qnil);
2755
2756 DEFVAR_LISP ("ns-version-string", Vns_version_string,
2757 doc: /* Toolkit version for NS Windowing. */);
2758 Vns_version_string = ns_appkit_version_str ();
2759
2760 defsubr (&Sns_read_file_name);
2761 defsubr (&Sns_get_resource);
2762 defsubr (&Sns_set_resource);
2763 defsubr (&Sxw_display_color_p); /* this and next called directly by C code */
2764 defsubr (&Sx_display_grayscale_p);
2765 defsubr (&Sns_font_name);
2766 defsubr (&Sns_list_colors);
2767 #ifdef NS_IMPL_COCOA
2768 defsubr (&Sns_do_applescript);
2769 #endif
2770 defsubr (&Sxw_color_defined_p);
2771 defsubr (&Sxw_color_values);
2772 defsubr (&Sx_server_max_request_size);
2773 defsubr (&Sx_server_vendor);
2774 defsubr (&Sx_server_version);
2775 defsubr (&Sx_display_pixel_width);
2776 defsubr (&Sx_display_pixel_height);
2777 defsubr (&Sns_display_usable_bounds);
2778 defsubr (&Sx_display_mm_width);
2779 defsubr (&Sx_display_mm_height);
2780 defsubr (&Sx_display_screens);
2781 defsubr (&Sx_display_planes);
2782 defsubr (&Sx_display_color_cells);
2783 defsubr (&Sx_display_visual_class);
2784 defsubr (&Sx_display_backing_store);
2785 defsubr (&Sx_display_save_under);
2786 defsubr (&Sx_create_frame);
2787 defsubr (&Sx_open_connection);
2788 defsubr (&Sx_close_connection);
2789 defsubr (&Sx_display_list);
2790
2791 defsubr (&Sns_hide_others);
2792 defsubr (&Sns_hide_emacs);
2793 defsubr (&Sns_emacs_info_panel);
2794 defsubr (&Sns_list_services);
2795 defsubr (&Sns_perform_service);
2796 defsubr (&Sns_convert_utf8_nfd_to_nfc);
2797 defsubr (&Sx_focus_frame);
2798 defsubr (&Sns_popup_font_panel);
2799 defsubr (&Sns_popup_color_panel);
2800
2801 defsubr (&Sx_show_tip);
2802 defsubr (&Sx_hide_tip);
2803
2804 as_status = 0;
2805 as_script = Qnil;
2806 as_result = 0;
2807 }