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