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