1 /* Functions for the NeXT/Open/GNUstep and MacOSX window system.
3 Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2012
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 Originally by Carl Edman
23 Updated by Christian Limpach (chris@nice.ch)
24 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
25 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
26 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
29 /* This should be the first include, as it may set up #defines affecting
30 interpretation of even the system includes. */
36 #include
<c
-strcase.h
>
39 #include "blockinput.h"
42 #include "character.h"
45 #include "termhooks.h"
50 int fns_trace_num
= 1;
51 #define NSTRACE
(x
) fprintf (stderr
, "
%s:%d: [%d] " #x "\n", \
52 __FILE__
, __LINE__
, ++fns_trace_num
)
59 extern NSArray
*ns_send_types
, *ns_return_types
, *ns_drag_types
;
61 extern Lisp_Object Qforeground_color
;
62 extern Lisp_Object Qbackground_color
;
63 extern Lisp_Object Qcursor_color
;
64 extern Lisp_Object Qinternal_border_width
;
65 extern Lisp_Object Qvisibility
;
66 extern Lisp_Object Qcursor_type
;
67 extern Lisp_Object Qicon_type
;
68 extern Lisp_Object Qicon_name
;
69 extern Lisp_Object Qicon_left
;
70 extern Lisp_Object Qicon_top
;
71 extern Lisp_Object Qleft
;
72 extern Lisp_Object Qright
;
73 extern Lisp_Object Qtop
;
74 extern Lisp_Object Qdisplay
;
75 extern Lisp_Object Qvertical_scroll_bars
;
76 extern Lisp_Object Qauto_raise
;
77 extern Lisp_Object Qauto_lower
;
78 extern Lisp_Object Qbox
;
79 extern Lisp_Object Qscroll_bar_width
;
80 extern Lisp_Object Qx_resource_name
;
81 extern Lisp_Object Qface_set_after_frame_default
;
82 extern Lisp_Object Qunderline
, Qundefined
;
83 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
84 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
85 extern Lisp_Object Qnone
;
88 Lisp_Object Qbuffered
;
89 Lisp_Object Qfontsize
;
91 /* hack for OS X file panels */
94 EmacsTooltip
*ns_tooltip
;
96 /* Need forward declaration here to preserve organizational integrity of file */
97 Lisp_Object Fx_open_connection
(Lisp_Object
, Lisp_Object
, Lisp_Object
);
99 extern BOOL ns_in_resize
;
101 /* Static variables to handle applescript execution. */
102 static Lisp_Object as_script
, *as_result
;
103 static int as_status
;
106 static ptrdiff_t image_cache_refcount
;
109 /* ==========================================================================
111 Internal utility functions
113 ========================================================================== */
120 error ("OpenStep is not in use or not initialized"
);
124 /* Nonzero if we can use mouse menus. */
132 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
133 and checking validity for NS. */
135 check_ns_frame
(Lisp_Object frame
)
140 f
= SELECTED_FRAME
();
143 CHECK_LIVE_FRAME
(frame
);
146 if (! FRAME_NS_P
(f
))
147 error ("non
-Nextstep frame used"
);
152 /* Let the user specify an Nextstep display with a frame.
153 nil stands for the selected frame--or, if that is not an Nextstep frame,
154 the first Nextstep display on the list. */
155 static
struct ns_display_info
*
156 check_ns_display_info
(Lisp_Object frame
)
160 struct frame
*f
= SELECTED_FRAME
();
161 if (FRAME_NS_P
(f
) && FRAME_LIVE_P
(f
) )
162 return FRAME_NS_DISPLAY_INFO
(f
);
163 else if (x_display_list
!= 0)
164 return x_display_list
;
166 error ("Nextstep windows are not in use or not initialized"
);
168 else if (INTEGERP
(frame
))
170 struct terminal *t
= get_terminal
(frame
, 1);
172 if (t
->type != output_ns
)
173 error ("
Terminal %"pI"d is not a Nextstep display", XINT (frame));
175 return t
->display_info.ns
;
177 else if (STRINGP
(frame
))
178 return ns_display_info_for_name
(frame
);
183 CHECK_LIVE_FRAME
(frame
);
185 if (! FRAME_NS_P
(f
))
186 error ("non
-Nextstep frame used"
);
187 return FRAME_NS_DISPLAY_INFO
(f
);
189 return NULL; /* shut compiler up */
194 ns_get_window
(Lisp_Object maybeFrame
)
196 id
view =nil
, window
=nil
;
198 if (!FRAMEP
(maybeFrame
) ||
!FRAME_NS_P
(XFRAME
(maybeFrame
)))
199 maybeFrame
= selected_frame
;/*wrong_type_argument (Qframep, maybeFrame); */
201 if (!NILP
(maybeFrame
))
202 view = FRAME_NS_VIEW
(XFRAME
(maybeFrame
));
203 if (view) window
=[view window
];
210 ns_get_screen
(Lisp_Object screen
)
213 struct terminal *terminal;
215 if (EQ
(Qt
, screen
)) /* not documented */
216 return [NSScreen mainScreen
];
218 terminal = get_terminal
(screen
, 1);
219 if (terminal->type != output_ns
)
223 f
= SELECTED_FRAME
();
224 else if (FRAMEP
(screen
))
228 struct ns_display_info
*dpyinfo
= terminal->display_info.ns
;
229 f
= dpyinfo
->x_focus_frame
230 ? dpyinfo
->x_focus_frame
: dpyinfo
->x_highlight_frame
;
233 return ((f
&& FRAME_NS_P
(f
)) ?
[[FRAME_NS_VIEW
(f
) window
] screen
]
238 /* Return the X display structure for the display named NAME.
239 Open a new connection if necessary. */
240 struct ns_display_info
*
241 ns_display_info_for_name
(Lisp_Object name
)
244 struct ns_display_info
*dpyinfo
;
248 for (dpyinfo
= x_display_list
, names
= ns_display_name_list
;
250 dpyinfo
= dpyinfo
->next
, names
= XCDR
(names
))
253 tem
= Fstring_equal
(XCAR
(XCAR
(names
)), name
);
258 error ("Emacs
for OpenStep does not yet support multi
-display."
);
260 Fx_open_connection
(name
, Qnil
, Qnil
);
261 dpyinfo
= x_display_list
;
264 error ("OpenStep on
%s not responding.\n", SDATA (name));
271 interpret_services_menu
(NSMenu
*menu, Lisp_Object prefix
, Lisp_Object old
)
272 /* --------------------------------------------------------------------------
273 Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
274 -------------------------------------------------------------------------- */
284 count
= [menu numberOfItems
];
285 for (i
= 0; i
<count
; i
++)
287 item
= [menu itemAtIndex
: i
];
288 name
= [[item
title] UTF8String
];
291 nameStr
= build_string
(name
);
293 if ([item hasSubmenu
])
295 old
= interpret_services_menu
([item submenu
],
296 Fcons
(nameStr
, prefix
), old
);
300 keys
= [item keyEquivalent
];
301 if (keys
&& [keys
length] )
303 key
= [keys characterAtIndex
: 0];
304 res
= make_number
(key|super_modifier
);
310 old
= Fcons
(Fcons
(res
,
311 Freverse
(Fcons
(nameStr
,
321 /* ==========================================================================
323 Frame parameter setters
325 ========================================================================== */
329 x_set_foreground_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
332 CGFloat r
, g
, b
, alpha
;
334 if (ns_lisp_to_color
(arg
, &col
))
336 store_frame_param
(f
, Qforeground_color
, oldval
);
337 error ("Unknown color"
);
341 [f
->output_data.ns
->foreground_color release
];
342 f
->output_data.ns
->foreground_color
= col
;
344 [col getRed
: &r green
: &g blue
: &b alpha
: &alpha
];
345 FRAME_FOREGROUND_PIXEL
(f
) =
346 ARGB_TO_ULONG
((int
)(alpha
*0xff), (int
)(r
*0xff), (int
)(g
*0xff), (int
)(b
*0xff));
348 if (FRAME_NS_VIEW
(f
))
350 update_face_from_frame_parameter
(f
, Qforeground_color
, arg
);
351 /*recompute_basic_faces (f); */
352 if (FRAME_VISIBLE_P
(f
))
359 x_set_background_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
363 NSView
*view = FRAME_NS_VIEW
(f
);
364 CGFloat r
, g
, b
, alpha
;
366 if (ns_lisp_to_color
(arg
, &col
))
368 store_frame_param
(f
, Qbackground_color
, oldval
);
369 error ("Unknown color"
);
372 /* clear the frame; in some instances the NS-internal GC appears not to
373 update, or it does update and cannot clear old text properly */
374 if (FRAME_VISIBLE_P
(f
))
378 [f
->output_data.ns
->background_color release
];
379 f
->output_data.ns
->background_color
= col
;
381 [col getRed
: &r green
: &g blue
: &b alpha
: &alpha
];
382 FRAME_BACKGROUND_PIXEL
(f
) =
383 ARGB_TO_ULONG
((int
)(alpha
*0xff), (int
)(r
*0xff), (int
)(g
*0xff), (int
)(b
*0xff));
387 [[view window
] setBackgroundColor
: col
];
390 [[view window
] setOpaque
: NO
];
392 [[view window
] setOpaque
: YES
];
394 face
= FRAME_DEFAULT_FACE
(f
);
397 col
= ns_lookup_indexed_color
(NS_FACE_BACKGROUND
(face
), f
);
398 face
->background
= ns_index_color
399 ([col colorWithAlphaComponent
: alpha
], f
);
401 update_face_from_frame_parameter
(f
, Qbackground_color
, arg
);
404 if (FRAME_VISIBLE_P
(f
))
411 x_set_cursor_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
415 if (ns_lisp_to_color
(arg
, &col
))
417 store_frame_param
(f
, Qcursor_color
, oldval
);
418 error ("Unknown color"
);
421 [FRAME_CURSOR_COLOR
(f
) release
];
422 FRAME_CURSOR_COLOR
(f
) = [col retain
];
424 if (FRAME_VISIBLE_P
(f
))
426 x_update_cursor
(f
, 0);
427 x_update_cursor
(f
, 1);
429 update_face_from_frame_parameter
(f
, Qcursor_color
, arg
);
434 x_set_icon_name
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
436 NSView
*view = FRAME_NS_VIEW
(f
);
437 NSTRACE
(x_set_icon_name
);
442 /* see if it's changed */
445 if (STRINGP
(oldval
) && EQ
(Fstring_equal
(oldval
, arg
), Qt
))
448 else if (!STRINGP
(oldval
) && EQ
(oldval
, Qnil
) == EQ
(arg
, Qnil
))
451 FSET
(f
, icon_name
, arg
);
455 if (!NILP
(FGET
(f
, title)))
456 arg
= FGET
(f
, title);
458 /* explicit name and no icon-name -> explicit_name */
459 if (f
->explicit_name
)
460 arg
= FGET
(f
, name
);
463 /* no explicit name and no icon-name ->
464 name has to be rebuild from icon_title_format */
465 windows_or_buffers_changed
++;
470 /* Don't change the name if it's already NAME. */
471 if ([[view window
] miniwindowTitle
] &&
472 ([[[view window
] miniwindowTitle
]
473 isEqualToString
: [NSString stringWithUTF8String
:
477 [[view window
] setMiniwindowTitle
:
478 [NSString stringWithUTF8String
: SSDATA
(arg
)]];
482 ns_set_name_internal
(FRAME_PTR f
, Lisp_Object name
)
485 Lisp_Object encoded_name
, encoded_icon_name
;
487 NSView
*view = FRAME_NS_VIEW
(f
);
490 encoded_name
= ENCODE_UTF_8
(name
);
493 str
= [NSString stringWithUTF8String
: SSDATA
(encoded_name
)];
495 /* Don't change the name if it's already NAME. */
496 if (! [[[view window
] title] isEqualToString
: str
])
497 [[view window
] setTitle
: str
];
499 if (!STRINGP
(FGET
(f
, icon_name
)))
500 encoded_icon_name
= encoded_name
;
502 encoded_icon_name
= ENCODE_UTF_8
(FGET
(f
, icon_name
));
504 str
= [NSString stringWithUTF8String
: SSDATA
(encoded_icon_name
)];
506 if ([[view window
] miniwindowTitle
] &&
507 ! [[[view window
] miniwindowTitle
] isEqualToString
: str
])
508 [[view window
] setMiniwindowTitle
: str
];
513 ns_set_name
(struct frame
*f
, Lisp_Object name
, int explicit
)
515 NSTRACE
(ns_set_name
);
520 /* Make sure that requests from lisp code override requests from
521 Emacs redisplay code. */
524 /* If we're switching from explicit to implicit, we had better
525 update the mode lines and thereby update the title. */
526 if (f
->explicit_name
&& NILP
(name
))
527 update_mode_lines
= 1;
529 f
->explicit_name
= ! NILP
(name
);
531 else if (f
->explicit_name
)
535 name
= build_string
([ns_app_name UTF8String
]);
539 /* Don't change the name if it's already NAME. */
540 if (! NILP
(Fstring_equal
(name
, FGET
(f
, name
))))
543 FSET
(f
, name
, name
);
545 /* title overrides explicit name */
546 if (! NILP
(FGET
(f
, title)))
547 name
= FGET
(f
, title);
549 ns_set_name_internal
(f
, name
);
553 /* This function should be called when the user's lisp code has
554 specified a name for the frame; the name will override any set by the
557 x_explicitly_set_name
(FRAME_PTR f
, Lisp_Object arg
, Lisp_Object oldval
)
559 NSTRACE
(x_explicitly_set_name
);
560 ns_set_name
(f
, arg
, 1);
564 /* This function should be called by Emacs redisplay code to set the
565 name; names set this way will never override names set by the user's
568 x_implicitly_set_name
(FRAME_PTR f
, Lisp_Object arg
, Lisp_Object oldval
)
570 NSTRACE
(x_implicitly_set_name
);
572 /* Deal with NS specific format t. */
573 if (FRAME_NS_P
(f
) && ((FRAME_ICONIFIED_P
(f
) && EQ
(Vicon_title_format
, Qt
))
574 || EQ
(Vframe_title_format
, Qt
)))
575 ns_set_name_as_filename
(f
);
577 ns_set_name
(f
, arg
, 0);
581 /* Change the title of frame F to NAME.
582 If NAME is nil, use the frame name as the title. */
585 x_set_title
(struct frame
*f
, Lisp_Object name
, Lisp_Object old_name
)
587 NSTRACE
(x_set_title
);
588 /* Don't change the title if it's already NAME. */
589 if (EQ
(name
, FGET
(f
, title)))
592 update_mode_lines
= 1;
594 FSET
(f
, title, name
);
597 name
= FGET
(f
, name
);
601 ns_set_name_internal
(f
, name
);
606 ns_set_name_as_filename
(struct frame
*f
)
609 Lisp_Object name
, filename
;
610 Lisp_Object buf
= WGET
(XWINDOW
(FGET
(f
, selected_window
)), buffer
);
612 NSAutoreleasePool
*pool
;
614 Lisp_Object encoded_name
, encoded_filename
;
616 NSTRACE
(ns_set_name_as_filename
);
618 if (f
->explicit_name ||
! NILP
(FGET
(f
, title)) || ns_in_resize
)
622 pool
= [[NSAutoreleasePool alloc
] init
];
623 filename
= BVAR
(XBUFFER
(buf
), filename
);
624 name
= BVAR
(XBUFFER
(buf
), name
);
628 if (! NILP
(filename
))
629 name
= Ffile_name_nondirectory
(filename
);
631 name
= build_string
([ns_app_name UTF8String
]);
635 encoded_name
= ENCODE_UTF_8
(name
);
638 view = FRAME_NS_VIEW
(f
);
640 title = FRAME_ICONIFIED_P
(f
) ?
[[[view window
] miniwindowTitle
] UTF8String
]
641 : [[[view window
] title] UTF8String
];
643 if (title && (! strcmp (title, SSDATA
(encoded_name
))))
650 str
= [NSString stringWithUTF8String
: SSDATA
(encoded_name
)];
651 if (str
== nil
) str
= @"Bad coding"
;
653 if (FRAME_ICONIFIED_P
(f
))
654 [[view window
] setMiniwindowTitle
: str
];
659 if (! NILP
(filename
))
662 encoded_filename
= ENCODE_UTF_8
(filename
);
665 fstr
= [NSString stringWithUTF8String
: SSDATA
(encoded_filename
)];
666 if (fstr
== nil
) fstr
= @""
;
668 /* work around a bug observed on 10.3 and later where
669 setTitleWithRepresentedFilename does not clear out previous state
670 if given filename does not exist */
671 if (! [[NSFileManager defaultManager
] fileExistsAtPath
: fstr
])
672 [[view window
] setRepresentedFilename
: @""
];
678 [[view window
] setRepresentedFilename
: fstr
];
679 [[view window
] setTitle
: str
];
680 FSET
(f
, name
, name
);
689 ns_set_doc_edited
(struct frame
*f
, Lisp_Object arg
)
691 NSView
*view = FRAME_NS_VIEW
(f
);
692 NSAutoreleasePool
*pool
;
693 if (!MINI_WINDOW_P
(XWINDOW
(FGET
(f
, selected_window
))))
696 pool
= [[NSAutoreleasePool alloc
] init
];
697 [[view window
] setDocumentEdited
: !NILP
(arg
)];
705 x_set_menu_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
708 if (FRAME_MINIBUF_ONLY_P
(f
))
711 if (TYPE_RANGED_INTEGERP
(int
, value
))
712 nlines
= XINT
(value
);
716 FRAME_MENU_BAR_LINES
(f
) = 0;
719 FRAME_EXTERNAL_MENU_BAR
(f
) = 1;
720 /* does for all frames, whereas we just want for one frame
721 [NSMenu setMenuBarVisible: YES]; */
725 if (FRAME_EXTERNAL_MENU_BAR
(f
) == 1)
726 free_frame_menubar
(f
);
727 /* [NSMenu setMenuBarVisible: NO]; */
728 FRAME_EXTERNAL_MENU_BAR
(f
) = 0;
733 /* toolbar support */
735 x_set_tool_bar_lines
(struct frame
*f
, Lisp_Object value
, Lisp_Object oldval
)
739 if (FRAME_MINIBUF_ONLY_P
(f
))
742 if (RANGED_INTEGERP
(0, value
, INT_MAX
))
743 nlines
= XFASTINT
(value
);
749 FRAME_EXTERNAL_TOOL_BAR
(f
) = 1;
750 update_frame_tool_bar
(f
);
754 if (FRAME_EXTERNAL_TOOL_BAR
(f
))
756 free_frame_tool_bar
(f
);
757 FRAME_EXTERNAL_TOOL_BAR
(f
) = 0;
761 x_set_window_size
(f
, 0, f
->text_cols
, f
->text_lines
);
766 ns_implicitly_set_icon_type
(struct frame
*f
)
769 EmacsView
*view = FRAME_NS_VIEW
(f
);
771 Lisp_Object chain
, elt
;
772 NSAutoreleasePool
*pool
;
775 NSTRACE
(ns_implicitly_set_icon_type
);
778 pool
= [[NSAutoreleasePool alloc
] init
];
779 if (f
->output_data.ns
->miniimage
780 && [[NSString stringWithUTF8String
: SSDATA
(FGET
(f
, name
))]
781 isEqualToString
: [(NSImage
*)f
->output_data.ns
->miniimage name
]])
788 tem
= assq_no_quit
(Qicon_type
, FGET
(f
, param_alist
));
789 if (CONSP
(tem
) && ! NILP
(XCDR
(tem
)))
796 for (chain
= Vns_icon_type_alist
;
797 image == nil
&& CONSP
(chain
);
798 chain
= XCDR
(chain
))
801 /* special case: 't' means go by file type */
802 if (SYMBOLP
(elt
) && EQ
(elt
, Qt
) && SSDATA
(FGET
(f
, name
))[0] == '/')
805 = [NSString stringWithUTF8String
: SSDATA
(FGET
(f
, name
))];
806 if ([[NSFileManager defaultManager
] fileExistsAtPath
: str
])
807 image = [[[NSWorkspace sharedWorkspace
] iconForFile
: str
] retain
];
809 else if (CONSP
(elt
) &&
810 STRINGP
(XCAR
(elt
)) &&
811 STRINGP
(XCDR
(elt
)) &&
812 fast_string_match
(XCAR
(elt
), FGET
(f
, name
)) >= 0)
814 image = [EmacsImage allocInitFromFile
: XCDR
(elt
)];
816 image = [[NSImage imageNamed
:
817 [NSString stringWithUTF8String
:
818 SSDATA
(XCDR
(elt
))]] retain
];
824 image = [[[NSWorkspace sharedWorkspace
] iconForFileType
: @"
text"
] retain
];
828 [f
->output_data.ns
->miniimage release
];
829 f
->output_data.ns
->miniimage
= image;
830 [view setMiniwindowImage
: setMini
];
837 x_set_icon_type
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
839 EmacsView
*view = FRAME_NS_VIEW
(f
);
843 NSTRACE
(x_set_icon_type
);
845 if (!NILP
(arg
) && SYMBOLP
(arg
))
847 arg
=build_string
(SSDATA
(SYMBOL_NAME
(arg
)));
848 store_frame_param
(f
, Qicon_type
, arg
);
851 /* do it the implicit way */
854 ns_implicitly_set_icon_type
(f
);
860 image = [EmacsImage allocInitFromFile
: arg
];
862 image =[NSImage imageNamed
: [NSString stringWithUTF8String
:
867 image = [NSImage imageNamed
: @"
text"
];
871 f
->output_data.ns
->miniimage
= image;
872 [view setMiniwindowImage
: setMini
];
876 /* Xism; we stub out (we do implement this in ns-win.el) */
878 XParseGeometry
(char *string
, int
*x
, int
*y
,
879 unsigned int
*width
, unsigned int
*height
)
881 message1
("Warning
: XParseGeometry not supported under NS.
\n"
);
886 /* TODO: move to nsterm? */
888 ns_lisp_to_cursor_type
(Lisp_Object arg
)
891 if (XTYPE
(arg
) == Lisp_String
)
893 else if (XTYPE
(arg
) == Lisp_Symbol
)
894 str
= SSDATA
(SYMBOL_NAME
(arg
));
896 if (!strcmp (str
, "box"
)) return FILLED_BOX_CURSOR
;
897 if (!strcmp (str
, "hollow"
)) return HOLLOW_BOX_CURSOR
;
898 if (!strcmp (str
, "hbar"
)) return HBAR_CURSOR
;
899 if (!strcmp (str
, "
bar"
)) return BAR_CURSOR
;
900 if (!strcmp (str
, "no"
)) return NO_CURSOR
;
906 ns_cursor_type_to_lisp
(int arg
)
910 case FILLED_BOX_CURSOR
: return Qbox
;
911 case HOLLOW_BOX_CURSOR
: return intern
("hollow"
);
912 case HBAR_CURSOR
: return intern
("hbar"
);
913 case BAR_CURSOR
: return intern
("
bar"
);
915 default
: return intern
("no"
);
919 /* This is the same as the xfns.c definition. */
921 x_set_cursor_type
(FRAME_PTR f
, Lisp_Object arg
, Lisp_Object oldval
)
923 set_frame_cursor_types
(f
, arg
);
925 /* Make sure the cursor gets redrawn. */
926 cursor_type_changed
= 1;
930 /* called to set mouse pointer color, but all other terms use it to
931 initialize pointer types (and don't set the color ;) */
933 x_set_mouse_color
(struct frame
*f
, Lisp_Object arg
, Lisp_Object oldval
)
935 /* don't think we can do this on Nextstep */
940 #define Xstr
(x
) Str
(x
)
943 ns_appkit_version_str
(void
)
947 #ifdef NS_IMPL_GNUSTEP
948 sprintf(tmp
, "gnustep
-gui
-%s", Xstr(GNUSTEP_GUI_VERSION));
949 #elif defined
(NS_IMPL_COCOA
)
950 sprintf(tmp
, "apple
-appkit
-%.2f", NSAppKitVersionNumber);
954 return build_string
(tmp
);
958 /* This is for use by x-server-version and collapses all version info we
959 have into a single int. For a better picture of the implementation
960 running, use ns_appkit_version_str.*/
962 ns_appkit_version_int
(void
)
964 #ifdef NS_IMPL_GNUSTEP
965 return GNUSTEP_GUI_MAJOR_VERSION
* 100 + GNUSTEP_GUI_MINOR_VERSION
;
966 #elif defined
(NS_IMPL_COCOA
)
967 return (int
)NSAppKitVersionNumber
;
974 x_icon
(struct frame
*f
, Lisp_Object parms
)
975 /* --------------------------------------------------------------------------
976 Strangely-named function to set icon position parameters in frame.
977 This is irrelevant under OS X, but might be needed under GNUstep,
978 depending on the window manager used. Note, this is not a standard
979 frame parameter-setter; it is called directly from x-create-frame.
980 -------------------------------------------------------------------------- */
982 Lisp_Object icon_x
, icon_y
;
983 struct ns_display_info
*dpyinfo
= check_ns_display_info
(Qnil
);
985 f
->output_data.ns
->icon_top
= Qnil
;
986 f
->output_data.ns
->icon_left
= Qnil
;
988 /* Set the position of the icon. */
989 icon_x
= x_get_arg
(dpyinfo
, parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
990 icon_y
= x_get_arg
(dpyinfo
, parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
991 if (!EQ
(icon_x
, Qunbound
) && !EQ
(icon_y
, Qunbound
))
993 CHECK_NUMBER
(icon_x
);
994 CHECK_NUMBER
(icon_y
);
995 f
->output_data.ns
->icon_top
= icon_y
;
996 f
->output_data.ns
->icon_left
= icon_x
;
998 else if (!EQ
(icon_x
, Qunbound
) ||
!EQ
(icon_y
, Qunbound
))
999 error ("Both left and top icon corners of icon must be specified"
);
1003 /* Note: see frame.c for template, also where generic functions are impl */
1004 frame_parm_handler ns_frame_parm_handlers
[] =
1006 x_set_autoraise
, /* generic OK */
1007 x_set_autolower
, /* generic OK */
1008 x_set_background_color
,
1009 0, /* x_set_border_color, may be impossible under Nextstep */
1010 0, /* x_set_border_width, may be impossible under Nextstep */
1013 x_set_font
, /* generic OK */
1014 x_set_foreground_color
,
1017 x_set_internal_border_width
, /* generic OK */
1018 x_set_menu_bar_lines
,
1020 x_explicitly_set_name
,
1021 x_set_scroll_bar_width
, /* generic OK */
1023 x_set_unsplittable
, /* generic OK */
1024 x_set_vertical_scroll_bars
, /* generic OK */
1025 x_set_visibility
, /* generic OK */
1026 x_set_tool_bar_lines
,
1027 0, /* x_set_scroll_bar_foreground, will ignore (not possible on NS) */
1028 0, /* x_set_scroll_bar_background, will ignore (not possible on NS) */
1029 x_set_screen_gamma
, /* generic OK */
1030 x_set_line_spacing
, /* generic OK, sets f->extra_line_spacing to int */
1031 x_set_fringe_width
, /* generic OK */
1032 x_set_fringe_width
, /* generic OK */
1033 0, /* x_set_wait_for_wm, will ignore */
1034 0, /* x_set_fullscreen will ignore */
1035 x_set_font_backend
, /* generic OK */
1037 0, /* x_set_sticky */
1038 0, /* x_set_tool_bar_position */
1042 /* Handler for signals raised during x_create_frame.
1043 FRAME is the frame which is partially constructed. */
1046 unwind_create_frame
(Lisp_Object frame
)
1048 struct frame
*f
= XFRAME
(frame
);
1050 /* If frame is already dead, nothing to do. This can happen if the
1051 display is disconnected after the frame has become official, but
1052 before x_create_frame removes the unwind protect. */
1053 if (!FRAME_LIVE_P
(f
))
1056 /* If frame is ``official'', nothing to do. */
1057 if (NILP
(Fmemq
(frame
, Vframe_list
)))
1059 #
if defined GLYPH_DEBUG
&& defined ENABLE_CHECKING
1060 struct ns_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO
(f
);
1063 x_free_frame_resources
(f
);
1067 /* Check that reference counts are indeed correct. */
1068 eassert
(dpyinfo
->terminal->image_cache
->refcount
== image_cache_refcount
);
1077 * Read geometry related parameters from preferences if not in PARMS.
1078 * Returns the union of parms and any preferences read.
1082 get_geometry_from_preferences
(struct ns_display_info
*dpyinfo
,
1090 { "width"
, "Width"
, Qwidth
},
1091 { "height"
, "Height"
, Qheight
},
1092 { "left"
, "Left"
, Qleft
},
1093 { "top"
, "Top"
, Qtop
},
1097 for (i
= 0; i
< sizeof
(r
)/sizeof
(r
[0]); ++i
)
1099 if (NILP
(Fassq
(r
[i
].tem
, parms
)))
1102 = x_get_arg
(dpyinfo
, parms
, r
[i
].tem
, r
[i
].val
, r
[i
].cls
,
1104 if (! EQ
(value
, Qunbound
))
1105 parms
= Fcons
(Fcons
(r
[i
].tem
, value
), parms
);
1112 /* ==========================================================================
1116 ========================================================================== */
1118 DEFUN
("x
-create
-frame"
, Fx_create_frame
, Sx_create_frame
,
1120 doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
1121 Return an Emacs frame object.
1122 PARMS is an alist of frame parameters.
1123 If the parameters specify that the frame should not have a minibuffer,
1124 and do not specify a specific minibuffer window to use,
1125 then `default-minibuffer-frame' must be a frame whose minibuffer can
1126 be shared by the new frame.
1128 This function is an internal primitive--use `make-frame' instead. */)
1132 Lisp_Object frame
, tem
;
1134 int minibuffer_only
= 0;
1135 int window_prompting
= 0;
1137 ptrdiff_t count
= specpdl_ptr
- specpdl
;
1138 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1139 Lisp_Object display
;
1140 struct ns_display_info
*dpyinfo
= NULL;
1143 Lisp_Object tfont
, tfontsize
;
1144 static int desc_ctr
= 1;
1148 /* x_get_arg modifies parms. */
1149 parms
= Fcopy_alist
(parms
);
1151 /* Use this general default value to start with
1152 until we know if this frame has a specified name. */
1153 Vx_resource_name
= Vinvocation_name
;
1155 display
= x_get_arg
(dpyinfo
, parms
, Qterminal
, 0, 0, RES_TYPE_STRING
);
1156 if (EQ
(display
, Qunbound
))
1158 dpyinfo
= check_ns_display_info
(display
);
1159 kb
= dpyinfo
->terminal->kboard
;
1161 if (!dpyinfo
->terminal->name
)
1162 error ("
Terminal is not live
, can
't create new frames on it");
1164 name = x_get_arg (dpyinfo, parms, Qname, 0, 0, RES_TYPE_STRING);
1166 && ! EQ (name, Qunbound)
1168 error ("Invalid frame name--not a string or nil");
1171 Vx_resource_name = name;
1173 parent = x_get_arg (dpyinfo, parms, Qparent_id, 0, 0, RES_TYPE_NUMBER);
1174 if (EQ (parent, Qunbound))
1176 if (! NILP (parent))
1177 CHECK_NUMBER (parent);
1179 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
1180 /* No need to protect DISPLAY because that's not used after passing
1181 it to make_frame_without_minibuffer. */
1183 GCPRO4
(parms
, parent
, name
, frame
);
1184 tem
= x_get_arg
(dpyinfo
, parms
, Qminibuffer
, "minibuffer"
, "Minibuffer"
,
1186 if (EQ
(tem
, Qnone
) || NILP
(tem
))
1187 f
= make_frame_without_minibuffer
(Qnil
, kb
, display
);
1188 else if (EQ
(tem
, Qonly
))
1190 f
= make_minibuffer_frame
();
1191 minibuffer_only
= 1;
1193 else if (WINDOWP
(tem
))
1194 f
= make_frame_without_minibuffer
(tem
, kb
, display
);
1198 XSETFRAME
(frame
, f
);
1199 FRAME_CAN_HAVE_SCROLL_BARS
(f
) = 1;
1201 f
->terminal = dpyinfo
->terminal;
1203 f
->output_method
= output_ns
;
1204 f
->output_data.ns
= xzalloc
(sizeof
*f
->output_data.ns
);
1206 FRAME_FONTSET
(f
) = -1;
1208 FSET
(f
, icon_name
, x_get_arg
(dpyinfo
, parms
, Qicon_name
,
1209 "iconName"
, "
Title"
,
1211 if (! STRINGP
(FGET
(f
, icon_name
)))
1212 FSET
(f
, icon_name
, Qnil
);
1214 FRAME_NS_DISPLAY_INFO
(f
) = dpyinfo
;
1216 /* With FRAME_NS_DISPLAY_INFO set up, this unwind-protect is safe. */
1217 record_unwind_protect
(unwind_create_frame
, frame
);
1219 f
->output_data.ns
->window_desc
= desc_ctr
++;
1220 if (TYPE_RANGED_INTEGERP
(Window
, parent
))
1222 f
->output_data.ns
->parent_desc
= XFASTINT
(parent
);
1223 f
->output_data.ns
->explicit_parent
= 1;
1227 f
->output_data.ns
->parent_desc
= FRAME_NS_DISPLAY_INFO
(f
)->root_window
;
1228 f
->output_data.ns
->explicit_parent
= 0;
1231 /* Set the name; the functions to which we pass f expect the name to
1233 if (EQ
(name
, Qunbound
) || NILP
(name
) ||
! STRINGP
(name
))
1235 FSET
(f
, name
, build_string
([ns_app_name UTF8String
]));
1236 f
->explicit_name
= 0;
1240 FSET
(f
, name
, name
);
1241 f
->explicit_name
= 1;
1242 specbind
(Qx_resource_name
, name
);
1245 f
->resx
= dpyinfo
->resx
;
1246 f
->resy
= dpyinfo
->resy
;
1249 register_font_driver
(&nsfont_driver
, f
);
1250 x_default_parameter
(f
, parms
, Qfont_backend
, Qnil
,
1251 "fontBackend"
, "FontBackend"
, RES_TYPE_STRING
);
1254 /* use for default font name */
1255 id font
= [NSFont userFixedPitchFontOfSize
: -1.0]; /* default */
1256 tfontsize
= x_default_parameter
(f
, parms
, Qfontsize
,
1257 make_number
(0 /*(int)[font pointSize]*/),
1258 "fontSize"
, "FontSize"
, RES_TYPE_NUMBER
);
1259 tfont
= x_default_parameter
(f
, parms
, Qfont
,
1260 build_string
([[font fontName
] UTF8String
]),
1261 "font"
, "Font"
, RES_TYPE_STRING
);
1265 x_default_parameter
(f
, parms
, Qborder_width
, make_number
(0),
1266 "borderwidth"
, "BorderWidth"
, RES_TYPE_NUMBER
);
1267 x_default_parameter
(f
, parms
, Qinternal_border_width
, make_number
(2),
1268 "internalBorderWidth"
, "InternalBorderWidth"
,
1271 /* default scrollbars on right on Mac */
1274 #ifdef NS_IMPL_GNUSTEP
1279 x_default_parameter
(f
, parms
, Qvertical_scroll_bars
, spos
,
1280 "verticalScrollBars"
, "VerticalScrollBars"
,
1283 x_default_parameter
(f
, parms
, Qforeground_color
, build_string
("Black"
),
1284 "foreground"
, "Foreground"
, RES_TYPE_STRING
);
1285 x_default_parameter
(f
, parms
, Qbackground_color
, build_string
("
White"
),
1286 "background"
, "Background"
, RES_TYPE_STRING
);
1287 /* FIXME: not supported yet in Nextstep */
1288 x_default_parameter
(f
, parms
, Qline_spacing
, Qnil
,
1289 "lineSpacing"
, "LineSpacing"
, RES_TYPE_NUMBER
);
1290 x_default_parameter
(f
, parms
, Qleft_fringe
, Qnil
,
1291 "leftFringe"
, "LeftFringe"
, RES_TYPE_NUMBER
);
1292 x_default_parameter
(f
, parms
, Qright_fringe
, Qnil
,
1293 "rightFringe"
, "RightFringe"
, RES_TYPE_NUMBER
);
1296 image_cache_refcount
=
1297 FRAME_IMAGE_CACHE
(f
) ? FRAME_IMAGE_CACHE
(f
)->refcount
: 0;
1300 init_frame_faces
(f
);
1302 /* The resources controlling the menu-bar and tool-bar are
1303 processed specially at startup, and reflected in the mode
1304 variables; ignore them here. */
1305 x_default_parameter
(f
, parms
, Qmenu_bar_lines
,
1306 NILP
(Vmenu_bar_mode
)
1307 ? make_number
(0) : make_number
(1),
1308 NULL, NULL, RES_TYPE_NUMBER
);
1309 x_default_parameter
(f
, parms
, Qtool_bar_lines
,
1310 NILP
(Vtool_bar_mode
)
1311 ? make_number
(0) : make_number
(1),
1312 NULL, NULL, RES_TYPE_NUMBER
);
1314 x_default_parameter
(f
, parms
, Qbuffer_predicate
, Qnil
, "bufferPredicate"
,
1315 "BufferPredicate"
, RES_TYPE_SYMBOL
);
1316 x_default_parameter
(f
, parms
, Qtitle
, Qnil
, "
title"
, "
Title"
,
1319 parms
= get_geometry_from_preferences
(dpyinfo
, parms
);
1320 window_prompting
= x_figure_window_size
(f
, parms
, 1);
1322 tem
= x_get_arg
(dpyinfo
, parms
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
1323 f
->no_split
= minibuffer_only ||
(!EQ
(tem
, Qunbound
) && !EQ
(tem
, Qnil
));
1325 /* NOTE: on other terms, this is done in set_mouse_color, however this
1326 was not getting called under Nextstep */
1327 f
->output_data.ns
->text_cursor
= [NSCursor IBeamCursor
];
1328 f
->output_data.ns
->nontext_cursor
= [NSCursor arrowCursor
];
1329 f
->output_data.ns
->modeline_cursor
= [NSCursor pointingHandCursor
];
1330 f
->output_data.ns
->hand_cursor
= [NSCursor pointingHandCursor
];
1331 f
->output_data.ns
->hourglass_cursor
= [NSCursor disappearingItemCursor
];
1332 f
->output_data.ns
->horizontal_drag_cursor
= [NSCursor resizeLeftRightCursor
];
1333 FRAME_NS_DISPLAY_INFO
(f
)->vertical_scroll_bar_cursor
1334 = [NSCursor arrowCursor
];
1335 f
->output_data.ns
->current_pointer
= f
->output_data.ns
->text_cursor
;
1337 [[EmacsView alloc
] initFrameFromEmacs
: f
];
1341 /* ns_display_info does not have a reference_count. */
1342 f
->terminal->reference_count
++;
1344 /* It is now ok to make the frame official even if we get an error below.
1345 The frame needs to be on Vframe_list or making it visible won't work. */
1346 Vframe_list
= Fcons
(frame
, Vframe_list
);
1348 x_default_parameter
(f
, parms
, Qicon_type
, Qnil
,
1349 "bitmapIcon"
, "BitmapIcon"
, RES_TYPE_SYMBOL
);
1351 x_default_parameter
(f
, parms
, Qauto_raise
, Qnil
,
1352 "autoRaise"
, "AutoRaiseLower"
, RES_TYPE_BOOLEAN
);
1353 x_default_parameter
(f
, parms
, Qauto_lower
, Qnil
,
1354 "autoLower"
, "AutoLower"
, RES_TYPE_BOOLEAN
);
1355 x_default_parameter
(f
, parms
, Qcursor_type
, Qbox
,
1356 "cursorType"
, "CursorType"
, RES_TYPE_SYMBOL
);
1357 x_default_parameter
(f
, parms
, Qscroll_bar_width
, Qnil
,
1358 "scrollBarWidth"
, "ScrollBarWidth"
,
1360 x_default_parameter
(f
, parms
, Qalpha
, Qnil
,
1361 "alpha"
, "Alpha"
, RES_TYPE_NUMBER
);
1363 width
= FRAME_COLS
(f
);
1364 height
= FRAME_LINES
(f
);
1366 SET_FRAME_COLS
(f
, 0);
1367 FRAME_LINES
(f
) = 0;
1368 change_frame_size
(f
, height
, width
, 1, 0, 0);
1370 if (! f
->output_data.ns
->explicit_parent
)
1372 Lisp_Object visibility
;
1374 visibility
= x_get_arg
(dpyinfo
, parms
, Qvisibility
, 0, 0,
1376 if (EQ
(visibility
, Qunbound
))
1379 if (EQ
(visibility
, Qicon
))
1380 x_iconify_frame
(f
);
1381 else if (! NILP
(visibility
))
1383 x_make_frame_visible
(f
);
1384 [[FRAME_NS_VIEW
(f
) window
] makeKeyWindow
];
1388 /* Must have been Qnil. */
1392 if (FRAME_HAS_MINIBUF_P
(f
)
1393 && (!FRAMEP
(KVAR
(kb
, Vdefault_minibuffer_frame
))
1394 ||
!FRAME_LIVE_P
(XFRAME
(KVAR
(kb
, Vdefault_minibuffer_frame
)))))
1395 KVAR
(kb
, Vdefault_minibuffer_frame
) = frame
;
1397 /* All remaining specified parameters, which have not been "used"
1398 by x_get_arg and friends, now go in the misc. alist of the frame. */
1399 for (tem
= parms
; CONSP
(tem
); tem
= XCDR
(tem
))
1400 if (CONSP
(XCAR
(tem
)) && !NILP
(XCAR
(XCAR
(tem
))))
1401 FSET
(f
, param_alist
, Fcons
(XCAR
(tem
), FGET
(f
, param_alist
)));
1405 /* Make sure windows on this frame appear in calls to next-window
1406 and similar functions. */
1407 Vwindow_list
= Qnil
;
1409 return unbind_to
(count
, frame
);
1413 DEFUN
("x
-focus
-frame"
, Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
1414 doc: /* Set the input focus to FRAME.
1415 FRAME nil means use the selected frame. */)
1418 struct frame
*f
= check_ns_frame
(frame
);
1419 struct ns_display_info
*dpyinfo
= FRAME_NS_DISPLAY_INFO
(f
);
1421 if (dpyinfo
->x_focus_frame
!= f
)
1423 EmacsView
*view = FRAME_NS_VIEW
(f
);
1425 [NSApp activateIgnoringOtherApps
: YES
];
1426 [[view window
] makeKeyAndOrderFront
: view];
1434 DEFUN
("ns
-popup
-font
-panel"
, Fns_popup_font_panel
, Sns_popup_font_panel
,
1436 doc: /* Pop up the font panel. */)
1443 fm
= [NSFontManager sharedFontManager
];
1445 f
= SELECTED_FRAME
();
1448 CHECK_FRAME
(frame
);
1452 [fm setSelectedFont
: ((struct nsfont_info
*)f
->output_data.ns
->font
)->nsfont
1454 [fm orderFrontFontPanel
: NSApp
];
1459 DEFUN
("ns
-popup
-color
-panel"
, Fns_popup_color_panel
, Sns_popup_color_panel
,
1461 doc: /* Pop up the color panel. */)
1468 f
= SELECTED_FRAME
();
1471 CHECK_FRAME
(frame
);
1475 [NSApp orderFrontColorPanel
: NSApp
];
1480 DEFUN
("ns
-read
-file
-name"
, Fns_read_file_name
, Sns_read_file_name
, 1, 4, 0,
1481 doc: /* Use a graphical panel to read a file name, using prompt PROMPT.
1482 Optional arg DIR, if non-nil, supplies a default directory.
1483 Optional arg MUSTMATCH, if non-nil, means the returned file or
1484 directory must exist.
1485 Optional arg INIT, if non-nil, provides a default file name to use. */)
1486 (Lisp_Object prompt
, Lisp_Object
dir, Lisp_Object mustmatch
, Lisp_Object init
)
1488 static id fileDelegate
= nil
;
1493 NSString
*promptS
= NILP
(prompt
) ||
!STRINGP
(prompt
) ? nil
:
1494 [NSString stringWithUTF8String
: SSDATA
(prompt
)];
1495 NSString
*dirS
= NILP
(dir) ||
!STRINGP
(dir) ?
1496 [NSString stringWithUTF8String
: SSDATA
(BVAR
(current_buffer
, directory
))] :
1497 [NSString stringWithUTF8String
: SSDATA
(dir)];
1498 NSString
*initS
= NILP
(init
) ||
!STRINGP
(init
) ? nil
:
1499 [NSString stringWithUTF8String
: SSDATA
(init
)];
1503 if (fileDelegate
== nil
)
1504 fileDelegate
= [EmacsFileDelegate new
];
1506 [NSCursor setHiddenUntilMouseMoves
: NO
];
1508 if ([dirS characterAtIndex
: 0] == '~')
1509 dirS
= [dirS stringByExpandingTildeInPath
];
1511 panel
= NILP
(mustmatch
) ?
1512 (id
)[EmacsSavePanel savePanel
] : (id
)[EmacsOpenPanel openPanel
];
1514 [panel setTitle
: promptS
];
1516 /* Puma (10.1) does not have */
1517 if ([panel respondsToSelector
: @selector
(setAllowsOtherFileTypes
:)])
1518 [panel setAllowsOtherFileTypes
: YES
];
1520 [panel setTreatsFilePackagesAsDirectories
: YES
];
1521 [panel setDelegate
: fileDelegate
];
1525 if (NILP
(mustmatch
))
1527 ret
= [panel runModalForDirectory
: dirS file
: initS
];
1531 [panel setCanChooseDirectories
: YES
];
1532 ret
= [panel runModalForDirectory
: dirS file
: initS types
: nil
];
1535 ret
= (ret
== NSOKButton
) || panelOK
;
1538 fname
= build_string
([[panel filename
] UTF8String
]);
1540 [[FRAME_NS_VIEW
(SELECTED_FRAME
()) window
] makeKeyWindow
];
1543 return ret ? fname
: Qnil
;
1547 ns_get_defaults_value
(const
char *key
)
1549 NSObject
*obj
= [[NSUserDefaults standardUserDefaults
]
1550 objectForKey
: [NSString stringWithUTF8String
: key
]];
1552 if (!obj
) return NULL;
1554 return [[NSString stringWithFormat
: @"
%@", obj] UTF8String];
1558 DEFUN
("ns
-get-resource"
, Fns_get_resource
, Sns_get_resource
, 2, 2, 0,
1559 doc: /* Return the value of the property NAME of OWNER from the defaults database.
1560 If OWNER is nil, Emacs is assumed. */)
1561 (Lisp_Object owner
, Lisp_Object name
)
1567 owner
= build_string
([ns_app_name UTF8String
]);
1568 CHECK_STRING
(name
);
1569 /*fprintf (stderr, "ns-get-resource checking resource '%s'\n", SSDATA (name)); */
1571 value
= ns_get_defaults_value
(SSDATA
(name
));
1574 return build_string
(value
);
1579 DEFUN
("ns
-set-resource"
, Fns_set_resource
, Sns_set_resource
, 3, 3, 0,
1580 doc: /* Set property NAME of OWNER to VALUE, from the defaults database.
1581 If OWNER is nil, Emacs is assumed.
1582 If VALUE is nil, the default is removed. */)
1583 (Lisp_Object owner
, Lisp_Object name
, Lisp_Object value
)
1587 owner
= build_string
([ns_app_name UTF8String
]);
1588 CHECK_STRING
(name
);
1591 [[NSUserDefaults standardUserDefaults
] removeObjectForKey
:
1592 [NSString stringWithUTF8String
: SSDATA
(name
)]];
1596 CHECK_STRING
(value
);
1597 [[NSUserDefaults standardUserDefaults
] setObject
:
1598 [NSString stringWithUTF8String
: SSDATA
(value
)]
1599 forKey
: [NSString stringWithUTF8String
:
1607 DEFUN
("x
-server
-max-request
-size"
, Fx_server_max_request_size
,
1608 Sx_server_max_request_size
,
1610 doc: /* This function is a no-op. It is only present for completeness. */)
1611 (Lisp_Object display
)
1614 /* This function has no real equivalent under NeXTstep. Return nil to
1620 DEFUN
("x
-server
-vendor"
, Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
1621 doc: /* Return the vendor ID string of Nextstep display server DISPLAY.
1622 DISPLAY should be either a frame or a display name (a string).
1623 If omitted or nil, the selected frame's display is used. */)
1624 (Lisp_Object display
)
1626 #ifdef NS_IMPL_GNUSTEP
1627 return build_string
("GNU"
);
1629 return build_string
("Apple"
);
1634 DEFUN
("x
-server
-version"
, Fx_server_version
, Sx_server_version
, 0, 1, 0,
1635 doc: /* Return the version numbers of the server of DISPLAY.
1636 The value is a list of three integers: the major and minor
1637 version numbers of the X Protocol in use, and the distributor-specific
1638 release number. See also the function `x-server-vendor'.
1640 The optional argument DISPLAY specifies which display to ask about.
1641 DISPLAY should be either a frame or a display name (a string).
1642 If omitted or nil, that stands for the selected frame's display. */)
1643 (Lisp_Object display
)
1645 /*NOTE: it is unclear what would best correspond with "protocol";
1646 we return 10.3, meaning Panther, since this is roughly the
1647 level that GNUstep's APIs correspond to.
1648 The last number is where we distinguish between the Apple
1649 and GNUstep implementations ("distributor-specific release
1650 number") and give int'ized versions of major.minor. */
1651 return Fcons
(make_number
(10),
1652 Fcons
(make_number
(3),
1653 Fcons
(make_number
(ns_appkit_version_int
()), Qnil
)));
1657 DEFUN
("x
-display
-screens"
, Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
1658 doc: /* Return the number of screens on Nextstep display server DISPLAY.
1659 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1660 If omitted or nil, the selected frame's display is used. */)
1661 (Lisp_Object display
)
1666 num
= [[NSScreen screens
] count
];
1668 return (num
!= 0) ? make_number
(num
) : Qnil
;
1672 DEFUN
("x
-display
-mm
-height"
, Fx_display_mm_height
, Sx_display_mm_height
,
1674 doc: /* Return the height of Nextstep display server DISPLAY, in millimeters.
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 (Lisp_Object display
)
1680 return make_number
((int
)
1681 ([ns_get_screen
(display
) frame
].
size.height
/(92.0/25.4)));
1685 DEFUN
("x
-display
-mm
-width"
, Fx_display_mm_width
, Sx_display_mm_width
,
1687 doc: /* Return the width of Nextstep display server DISPLAY, in millimeters.
1688 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1689 If omitted or nil, the selected frame's display is used. */)
1690 (Lisp_Object display
)
1693 return make_number
((int
)
1694 ([ns_get_screen
(display
) frame
].
size.width
/(92.0/25.4)));
1698 DEFUN
("x
-display
-backing
-store"
, Fx_display_backing_store
,
1699 Sx_display_backing_store
, 0, 1, 0,
1700 doc: /* Return whether the Nextstep display DISPLAY supports backing store.
1701 The value may be `buffered', `retained', or `non-retained'.
1702 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1703 If omitted or nil, the selected frame's display is used. */)
1704 (Lisp_Object display
)
1707 switch ([ns_get_window
(display
) backingType
])
1709 case NSBackingStoreBuffered
:
1710 return intern
("buffered"
);
1711 case NSBackingStoreRetained
:
1712 return intern
("retained"
);
1713 case NSBackingStoreNonretained
:
1714 return intern
("non
-retained"
);
1716 error ("Strange value
for backingType parameter of frame"
);
1718 return Qnil
; /* not reached, shut compiler up */
1722 DEFUN
("x
-display
-visual
-class"
, Fx_display_visual_class
,
1723 Sx_display_visual_class
, 0, 1, 0,
1724 doc: /* Return the visual class of the Nextstep display server DISPLAY.
1725 The value is one of the symbols `static-gray', `gray-scale',
1726 `static-color', `pseudo-color', `true-color', or `direct-color'.
1727 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1728 If omitted or nil, the selected frame's display is used. */)
1729 (Lisp_Object display
)
1731 NSWindowDepth depth
;
1733 depth
= [ns_get_screen
(display
) depth
];
1735 if ( depth
== NSBestDepth
(NSCalibratedWhiteColorSpace
, 2, 2, YES
, NULL))
1736 return intern
("static
-gray"
);
1737 else if (depth
== NSBestDepth
(NSCalibratedWhiteColorSpace
, 8, 8, YES
, NULL))
1738 return intern
("
gray-scale"
);
1739 else if ( depth
== NSBestDepth
(NSCalibratedRGBColorSpace
, 8, 8, YES
, NULL))
1740 return intern
("pseudo
-color"
);
1741 else if ( depth
== NSBestDepth
(NSCalibratedRGBColorSpace
, 4, 12, NO
, NULL))
1742 return intern
("true
-color"
);
1743 else if ( depth
== NSBestDepth
(NSCalibratedRGBColorSpace
, 8, 24, NO
, NULL))
1744 return intern
("direct
-color"
);
1746 /* color mgmt as far as we do it is really handled by Nextstep itself anyway */
1747 return intern
("direct
-color"
);
1751 DEFUN
("x
-display
-save-under"
, Fx_display_save_under
,
1752 Sx_display_save_under
, 0, 1, 0,
1753 doc: /* Return t if DISPLAY supports the save-under feature.
1754 The optional argument DISPLAY specifies which display to ask about.
1755 DISPLAY should be a frame, the display name as a string, or a terminal ID.
1756 If omitted or nil, the selected frame's display is used. */)
1757 (Lisp_Object display
)
1760 switch ([ns_get_window
(display
) backingType
])
1762 case NSBackingStoreBuffered
:
1765 case NSBackingStoreRetained
:
1766 case NSBackingStoreNonretained
:
1770 error ("Strange value
for backingType parameter of frame"
);
1772 return Qnil
; /* not reached, shut compiler up */
1776 DEFUN
("x
-open
-connection"
, Fx_open_connection
, Sx_open_connection
,
1778 doc: /* Open a connection to a display server.
1779 DISPLAY is the name of the display to connect to.
1780 Optional second arg XRM-STRING is a string of resources in xrdb format.
1781 If the optional third arg MUST-SUCCEED is non-nil,
1782 terminate Emacs if we can't open the connection.
1783 \(In the Nextstep version, the last two arguments are currently ignored.) */)
1784 (Lisp_Object display
, Lisp_Object resource_string
, Lisp_Object must_succeed
)
1786 struct ns_display_info
*dpyinfo
;
1788 CHECK_STRING
(display
);
1790 nxatoms_of_nsselect
();
1791 dpyinfo
= ns_term_init
(display
);
1794 if (!NILP
(must_succeed
))
1795 fatal
("OpenStep on
%s not responding.\n",
1798 error ("OpenStep on
%s not responding.\n",
1802 /* Register our external input/output types, used for determining
1803 applicable services and also drag/drop eligibility. */
1804 ns_send_types
= [[NSArray arrayWithObjects
: NSStringPboardType
, nil
] retain
];
1805 ns_return_types
= [[NSArray arrayWithObjects
: NSStringPboardType
, nil
]
1807 ns_drag_types
= [[NSArray arrayWithObjects
:
1809 NSTabularTextPboardType
,
1810 NSFilenamesPboardType
,
1813 NSFontPboardType
, nil
] retain
];
1819 DEFUN
("x
-close-connection"
, Fx_close_connection
, Sx_close_connection
,
1821 doc: /* Close the connection to the current Nextstep display server.
1822 The argument DISPLAY is currently ignored. */)
1823 (Lisp_Object display
)
1826 /*ns_delete_terminal (dpyinfo->terminal); */
1827 [NSApp terminate
: NSApp
];
1832 DEFUN
("x
-display
-list"
, Fx_display_list
, Sx_display_list
, 0, 0, 0,
1833 doc: /* Return the list of display names that Emacs has connections to. */)
1836 Lisp_Object tail
, result
;
1839 for (tail
= ns_display_name_list
; CONSP
(tail
); tail
= XCDR
(tail
))
1840 result
= Fcons
(XCAR
(XCAR
(tail
)), result
);
1846 DEFUN
("ns
-hide
-others"
, Fns_hide_others
, Sns_hide_others
,
1848 doc: /* Hides all applications other than Emacs. */)
1852 [NSApp hideOtherApplications
: NSApp
];
1856 DEFUN
("ns
-hide
-emacs"
, Fns_hide_emacs
, Sns_hide_emacs
,
1858 doc: /* If ON is non-nil, the entire Emacs application is hidden.
1859 Otherwise if Emacs is hidden, it is unhidden.
1860 If ON is equal to `activate', Emacs is unhidden and becomes
1861 the active application. */)
1865 if (EQ
(on
, intern
("activate"
)))
1867 [NSApp unhide
: NSApp
];
1868 [NSApp activateIgnoringOtherApps
: YES
];
1871 [NSApp unhide
: NSApp
];
1873 [NSApp hide
: NSApp
];
1878 DEFUN
("ns
-emacs
-info-panel"
, Fns_emacs_info_panel
, Sns_emacs_info_panel
,
1880 doc: /* Shows the 'Info' or 'About' panel for Emacs. */)
1884 [NSApp orderFrontStandardAboutPanel
: nil
];
1889 DEFUN
("ns
-font
-name"
, Fns_font_name
, Sns_font_name
, 1, 1, 0,
1890 doc: /* Determine font PostScript or family name for font NAME.
1891 NAME should be a string containing either the font name or an XLFD
1892 font descriptor. If string contains `fontset' and not
1893 `fontset-startup', it is left alone. */)
1897 CHECK_STRING
(name
);
1902 if (strstr
(nm
, "fontset"
) && !strstr
(nm
, "fontset
-startup"
))
1905 return build_string
(ns_xlfd_to_fontname
(SSDATA
(name
)));
1909 DEFUN
("ns
-list
-colors"
, Fns_list_colors
, Sns_list_colors
, 0, 1, 0,
1910 doc: /* Return a list of all available colors.
1911 The optional argument FRAME is currently ignored. */)
1914 Lisp_Object list
= Qnil
;
1915 NSEnumerator
*colorlists
;
1920 CHECK_FRAME
(frame
);
1921 if (! FRAME_NS_P
(XFRAME
(frame
)))
1922 error ("non
-Nextstep frame used in `ns
-list
-colors
'");
1927 colorlists = [[NSColorList availableColorLists] objectEnumerator];
1928 while ((clist = [colorlists nextObject]))
1930 if ([[clist name] length] < 7 ||
1931 [[clist name] rangeOfString: @"PANTONE"].location == 0)
1933 NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator];
1935 while ((cname = [cnames nextObject]))
1936 list = Fcons (build_string ([cname UTF8String]), list);
1937 /* for (i = [[clist allKeys] count] - 1; i >= 0; i--)
1938 list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i]
1939 UTF8String]), list); */
1949 DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0,
1950 doc: /* List available Nextstep services by querying NSApp. */)
1953 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6
1954 /* You can't
get services like this in
10.6+. */
1957 Lisp_Object ret
= Qnil
;
1962 svcs
= [[NSMenu alloc
] initWithTitle
: @"Services"
];
1963 [NSApp setServicesMenu
: svcs
]; /* this and next rebuild on <10.4 */
1964 [NSApp registerServicesMenuSendTypes
: ns_send_types
1965 returnTypes
: ns_return_types
];
1967 /* On Tiger, services menu updating was made lazier (waits for user to
1968 actually click on the menu), so we have to force things along: */
1969 #ifdef NS_IMPL_COCOA
1970 if (NSAppKitVersionNumber
>= 744.0)
1972 delegate
= [svcs delegate
];
1973 if (delegate
!= nil
)
1975 if ([delegate respondsToSelector
: @selector
(menuNeedsUpdate
:)])
1976 [delegate menuNeedsUpdate
: svcs
];
1977 if ([delegate respondsToSelector
:
1978 @selector
(menu:updateItem
:atIndex
:shouldCancel
:)])
1980 int i
, len
= [delegate numberOfItemsInMenu
: svcs
];
1981 for (i
=0; i
<len
; i
++)
1982 [svcs addItemWithTitle
: @"" action
: NULL keyEquivalent
: @""
];
1983 for (i
=0; i
<len
; i
++)
1984 if (![delegate
menu: svcs
1985 updateItem
: (NSMenuItem
*)[svcs itemAtIndex
: i
]
1986 atIndex
: i shouldCancel
: NO
])
1993 [svcs setAutoenablesItems
: NO
];
1994 #ifdef NS_IMPL_COCOA
1995 [svcs update
]; /* on OS X, converts from '/' structure */
1998 ret
= interpret_services_menu
(svcs
, Qnil
, ret
);
2004 DEFUN
("ns
-perform
-service"
, Fns_perform_service
, Sns_perform_service
,
2006 doc: /* Perform Nextstep SERVICE on SEND.
2007 SEND should be either a string or nil.
2008 The return value is the result of the service, as string, or nil if
2009 there was no result. */)
2010 (Lisp_Object service
, Lisp_Object send
)
2016 CHECK_STRING
(service
);
2019 utfStr
= SSDATA
(service
);
2020 svcName
= [NSString stringWithUTF8String
: utfStr
];
2022 pb
=[NSPasteboard pasteboardWithUniqueName
];
2023 ns_string_to_pasteboard
(pb
, send
);
2025 if (NSPerformService
(svcName
, pb
) == NO
)
2026 Fsignal
(Qquit
, Fcons
(build_string
("service not available"
), Qnil
));
2028 if ([[pb types
] count
] == 0)
2029 return build_string
(""
);
2030 return ns_string_from_pasteboard
(pb
);
2034 DEFUN
("ns
-convert
-utf8
-nfd
-to
-nfc"
, Fns_convert_utf8_nfd_to_nfc
,
2035 Sns_convert_utf8_nfd_to_nfc
, 1, 1, 0,
2036 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
2039 /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2044 utfStr
= [NSString stringWithUTF8String
: SSDATA
(str
)];
2045 if (![utfStr respondsToSelector
:
2046 @selector
(precomposedStringWithCanonicalMapping
)])
2049 ("Warning
: ns
-convert
-utf8
-nfd
-to
-nfc unsupported under GNUstep.
\n"
);
2053 utfStr
= [utfStr precomposedStringWithCanonicalMapping
];
2054 return build_string
([utfStr UTF8String
]);
2058 #ifdef NS_IMPL_COCOA
2060 /* Compile and execute the AppleScript SCRIPT and return the error
2061 status as function value. A zero is returned if compilation and
2062 execution is successful, in which case *RESULT is set to a Lisp
2063 string or a number containing the resulting script value. Otherwise,
2066 ns_do_applescript
(Lisp_Object
script, Lisp_Object
*result
)
2068 NSAppleEventDescriptor
*desc
;
2069 NSDictionary
* errorDict
;
2070 NSAppleEventDescriptor
* returnDescriptor
= NULL;
2072 NSAppleScript
* scriptObject
=
2073 [[NSAppleScript alloc
] initWithSource
:
2074 [NSString stringWithUTF8String
: SSDATA
(script)]];
2076 returnDescriptor
= [scriptObject executeAndReturnError
: &errorDict
];
2077 [scriptObject release
];
2081 if (returnDescriptor
!= NULL)
2083 // successful execution
2084 if (kAENullEvent
!= [returnDescriptor descriptorType
])
2087 // script returned an AppleScript result
2088 if ((typeUnicodeText
== [returnDescriptor descriptorType
]) ||
2089 #
if defined
(NS_IMPL_COCOA
) && MAC_OS_X_VERSION_MAX_ALLOWED
>= MAC_OS_X_VERSION_10_4
2090 (typeUTF16ExternalRepresentation
2091 == [returnDescriptor descriptorType
]) ||
2093 (typeUTF8Text
== [returnDescriptor descriptorType
]) ||
2094 (typeCString
== [returnDescriptor descriptorType
]))
2096 desc
= [returnDescriptor coerceToDescriptorType
: typeUTF8Text
];
2098 *result
= build_string
([[desc stringValue
] UTF8String
]);
2102 /* use typeUTF16ExternalRepresentation? */
2103 // coerce the result to the appropriate ObjC
type
2104 desc
= [returnDescriptor coerceToDescriptorType
: typeUTF8Text
];
2106 *result
= make_number
([desc int32Value
]);
2112 // no
script result
, return error
2118 /* Helper function called from sendEvent to run applescript
2119 from within the main event loop. */
2122 ns_run_ascript
(void
)
2124 as_status
= ns_do_applescript
(as_script
, as_result
);
2127 DEFUN
("ns
-do
-applescript"
, Fns_do_applescript
, Sns_do_applescript
, 1, 1, 0,
2128 doc: /* Execute AppleScript SCRIPT and return the result.
2129 If compilation and execution are successful, the resulting script value
2130 is returned as a string, a number or, in the case of other constructs, t.
2131 In case the execution fails, an error is signaled. */)
2132 (Lisp_Object
script)
2138 CHECK_STRING
(script);
2144 as_result
= &result
;
2146 /* executing apple script requires the event loop to run, otherwise
2147 errors aren't returned and executeAndReturnError hangs forever.
2148 Post an event that runs applescript and then start the event loop.
2149 The event loop is exited when the script is done. */
2150 nxev
= [NSEvent otherEventWithType
: NSApplicationDefined
2151 location
: NSMakePoint
(0, 0)
2154 windowNumber
: [[NSApp mainWindow
] windowNumber
]
2155 context
: [NSApp context
]
2158 data2
: NSAPP_DATA2_RUNASSCRIPT
];
2160 [NSApp postEvent
: nxev atStart
: NO
];
2170 else if (!STRINGP
(result
))
2171 error ("AppleScript
error %d", status);
2173 error ("
%s", SSDATA (result));
2179 /* ==========================================================================
2181 Miscellaneous functions not called through hooks
2183 ========================================================================== */
2186 /* called from image.c */
2188 check_x_frame
(Lisp_Object frame
)
2190 return check_ns_frame
(frame
);
2194 /* called from frame.c */
2195 struct ns_display_info
*
2196 check_x_display_info
(Lisp_Object frame
)
2198 return check_ns_display_info
(frame
);
2203 x_set_scroll_bar_default_width
(struct frame
*f
)
2205 int wid
= FRAME_COLUMN_WIDTH
(f
);
2206 FRAME_CONFIG_SCROLL_BAR_WIDTH
(f
) = NS_SCROLL_BAR_WIDTH_DEFAULT
;
2207 FRAME_CONFIG_SCROLL_BAR_COLS
(f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH
(f
) +
2212 /* terms impl this instead of x-get-resource directly */
2214 x_get_string_resource
(XrmDatabase rdb
, char *name
, char *class)
2216 /* remove appname prefix; TODO: allow for !="Emacs" */
2217 char *toCheck
= class + (!strncmp
(class, "Emacs."
, 6) ?
6 : 0);
2221 if (inhibit_x_resources
)
2222 /* --quick was passed, so this is a no-op. */
2225 res
= ns_get_defaults_value
(toCheck
);
2226 return !res ?
NULL :
2227 (!c_strncasecmp
(res
, "YES"
, 3) ? "true"
:
2228 (!c_strncasecmp
(res
, "NO"
, 2) ? "false"
: res
));
2233 x_get_focus_frame
(struct frame
*frame
)
2235 struct ns_display_info
*dpyinfo
= FRAME_NS_DISPLAY_INFO
(frame
);
2236 Lisp_Object nsfocus
;
2238 if (!dpyinfo
->x_focus_frame
)
2241 XSETFRAME
(nsfocus
, dpyinfo
->x_focus_frame
);
2247 x_pixel_width
(struct frame
*f
)
2249 return FRAME_PIXEL_WIDTH
(f
);
2254 x_pixel_height
(struct frame
*f
)
2256 return FRAME_PIXEL_HEIGHT
(f
);
2261 x_char_width
(struct frame
*f
)
2263 return FRAME_COLUMN_WIDTH
(f
);
2268 x_char_height
(struct frame
*f
)
2270 return FRAME_LINE_HEIGHT
(f
);
2275 x_screen_planes
(struct frame
*f
)
2277 return FRAME_NS_DISPLAY_INFO
(f
)->n_planes
;
2282 x_sync
(struct frame
*f
)
2284 /* XXX Not implemented XXX */
2290 /* ==========================================================================
2292 Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'.
2294 ========================================================================== */
2297 DEFUN
("xw
-color
-defined
-p"
, Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
2298 doc: /* Internal function called by `color-defined-p', which see.
2299 \(Note that the Nextstep version of this function ignores FRAME.) */)
2300 (Lisp_Object color
, Lisp_Object frame
)
2304 return ns_lisp_to_color
(color
, &col
) ? Qnil
: Qt
;
2308 DEFUN
("xw
-color
-values"
, Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
2309 doc: /* Internal function called by `color-values', which see. */)
2310 (Lisp_Object color
, Lisp_Object frame
)
2313 CGFloat red
, green
, blue
, alpha
;
2316 CHECK_STRING
(color
);
2318 if (ns_lisp_to_color
(color
, &col
))
2321 [[col colorUsingColorSpaceName
: NSCalibratedRGBColorSpace
]
2322 getRed
: &red green
: &green blue
: &blue alpha
: &alpha
];
2323 return list3
(make_number
(lrint
(red
*65280)),
2324 make_number
(lrint
(green
*65280)),
2325 make_number
(lrint
(blue
*65280)));
2329 DEFUN
("xw
-display
-color
-p"
, Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
2330 doc: /* Internal function called by `display-color-p', which see. */)
2331 (Lisp_Object display
)
2333 NSWindowDepth depth
;
2334 NSString
*colorSpace
;
2336 depth
= [ns_get_screen
(display
) depth
];
2337 colorSpace
= NSColorSpaceFromDepth
(depth
);
2339 return [colorSpace isEqualToString
: NSDeviceWhiteColorSpace
]
2340 ||
[colorSpace isEqualToString
: NSCalibratedWhiteColorSpace
]
2345 DEFUN
("x
-display
-grayscale
-p"
, Fx_display_grayscale_p
,
2346 Sx_display_grayscale_p
, 0, 1, 0,
2347 doc: /* Return t if the Nextstep display supports shades of gray.
2348 Note that color displays do support shades of gray.
2349 The optional argument DISPLAY specifies which display to ask about.
2350 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2351 If omitted or nil, that stands for the selected frame's display. */)
2352 (Lisp_Object display
)
2354 NSWindowDepth depth
;
2356 depth
= [ns_get_screen
(display
) depth
];
2358 return NSBitsPerPixelFromDepth
(depth
) > 1 ? Qt
: Qnil
;
2362 DEFUN
("x
-display
-pixel
-width"
, Fx_display_pixel_width
, Sx_display_pixel_width
,
2364 doc: /* Return the width in pixels of the Nextstep display DISPLAY.
2365 The optional argument DISPLAY specifies which display to ask about.
2366 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2367 If omitted or nil, that stands for the selected frame's display. */)
2368 (Lisp_Object display
)
2371 return make_number
((int
) [ns_get_screen
(display
) frame
].
size.width
);
2375 DEFUN
("x
-display
-pixel
-height"
, Fx_display_pixel_height
,
2376 Sx_display_pixel_height
, 0, 1, 0,
2377 doc: /* Return the height in pixels of the Nextstep display DISPLAY.
2378 The optional argument DISPLAY specifies which display to ask about.
2379 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2380 If omitted or nil, that stands for the selected frame's display. */)
2381 (Lisp_Object display
)
2384 return make_number
((int
) [ns_get_screen
(display
) frame
].
size.height
);
2388 DEFUN
("display
-usable
-bounds"
, Fns_display_usable_bounds
,
2389 Sns_display_usable_bounds
, 0, 1, 0,
2390 doc: /* Return the bounds of the usable part of the screen.
2391 The return value is a list of integers (LEFT TOP WIDTH HEIGHT), which
2392 are the boundaries of the usable part of the screen, excluding areas
2393 reserved for the Mac menu, dock, and so forth.
2395 The screen queried corresponds to DISPLAY, which should be either a
2396 frame, a display name (a string), or terminal ID. If omitted or nil,
2397 that stands for the selected frame's display. */)
2398 (Lisp_Object display
)
2404 screen
= ns_get_screen
(display
);
2408 vScreen
= [screen visibleFrame
];
2410 /* NS coordinate system is upside-down.
2411 Transform to screen-specific coordinates. */
2412 return list4
(make_number
((int
) vScreen.origin.x
),
2413 make_number
((int
) [screen frame
].
size.height
2414 - vScreen.
size.height
- vScreen.origin.y
),
2415 make_number
((int
) vScreen.
size.width
),
2416 make_number
((int
) vScreen.
size.height
));
2420 DEFUN
("x
-display
-planes"
, Fx_display_planes
, Sx_display_planes
,
2422 doc: /* Return the number of bitplanes of the Nextstep display DISPLAY.
2423 The optional argument DISPLAY specifies which display to ask about.
2424 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2425 If omitted or nil, that stands for the selected frame's display. */)
2426 (Lisp_Object display
)
2430 (NSBitsPerPixelFromDepth
([ns_get_screen
(display
) depth
]));
2434 DEFUN
("x
-display
-color
-cells"
, Fx_display_color_cells
,
2435 Sx_display_color_cells
, 0, 1, 0,
2436 doc: /* Returns the number of color cells of the Nextstep display DISPLAY.
2437 The optional argument DISPLAY specifies which display to ask about.
2438 DISPLAY should be either a frame, a display name (a string), or terminal ID.
2439 If omitted or nil, that stands for the selected frame's display. */)
2440 (Lisp_Object display
)
2442 struct ns_display_info
*dpyinfo
;
2445 dpyinfo
= check_ns_display_info
(display
);
2446 /* We force 24+ bit depths to 24-bit to prevent an overflow. */
2447 return make_number
(1 << min (dpyinfo
->n_planes
, 24));
2451 /* Unused dummy def needed for compatibility. */
2452 Lisp_Object tip_frame
;
2454 /* TODO: move to xdisp or similar */
2456 compute_tip_xy
(struct frame
*f
,
2465 Lisp_Object left
, top
;
2466 EmacsView
*view = FRAME_NS_VIEW
(f
);
2469 /* Start with user-specified or mouse position. */
2470 left
= Fcdr
(Fassq
(Qleft
, parms
));
2471 top
= Fcdr
(Fassq
(Qtop
, parms
));
2473 if (!INTEGERP
(left
) ||
!INTEGERP
(top
))
2475 pt
= last_mouse_motion_position
;
2476 /* Convert to screen coordinates */
2477 pt
= [view convertPoint
: pt toView
: nil
];
2478 pt
= [[view window
] convertBaseToScreen
: pt
];
2482 /* Absolute coordinates. */
2484 pt.y
= x_display_pixel_height
(FRAME_NS_DISPLAY_INFO
(f
)) - XINT
(top
)
2488 /* Ensure in bounds. (Note, screen origin = lower left.) */
2489 if (INTEGERP
(left
))
2491 else if (pt.x
+ XINT
(dx
) <= 0)
2492 *root_x
= 0; /* Can happen for negative dx */
2493 else if (pt.x
+ XINT
(dx
) + width
2494 <= x_display_pixel_width
(FRAME_NS_DISPLAY_INFO
(f
)))
2495 /* It fits to the right of the pointer. */
2496 *root_x
= pt.x
+ XINT
(dx
);
2497 else if (width
+ XINT
(dx
) <= pt.x
)
2498 /* It fits to the left of the pointer. */
2499 *root_x
= pt.x
- width
- XINT
(dx
);
2501 /* Put it left justified on the screen -- it ought to fit that way. */
2506 else if (pt.y
- XINT
(dy
) - height
>= 0)
2507 /* It fits below the pointer. */
2508 *root_y
= pt.y
- height
- XINT
(dy
);
2509 else if (pt.y
+ XINT
(dy
) + height
2510 <= x_display_pixel_height
(FRAME_NS_DISPLAY_INFO
(f
)))
2511 /* It fits above the pointer */
2512 *root_y
= pt.y
+ XINT
(dy
);
2514 /* Put it on the top. */
2515 *root_y
= x_display_pixel_height
(FRAME_NS_DISPLAY_INFO
(f
)) - height
;
2519 DEFUN
("x
-show
-tip"
, Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
2520 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
2521 A tooltip window is a small window displaying a string.
2523 This is an internal function; Lisp code should call `tooltip-show'.
2525 FRAME nil or omitted means use the selected frame.
2527 PARMS is an optional list of frame parameters which can be used to
2528 change the tooltip's appearance.
2530 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
2531 means use the default timeout of 5 seconds.
2533 If the list of frame parameters PARMS contains a `left' parameter,
2534 the tooltip is displayed at that x-position. Otherwise it is
2535 displayed at the mouse position, with offset DX added (default is 5 if
2536 DX isn't specified). Likewise for the y-position; if a `top' frame
2537 parameter is specified, it determines the y-position of the tooltip
2538 window, otherwise it is displayed at the mouse position, with offset
2539 DY added (default is -10).
2541 A tooltip's maximum size is specified by `x-max-tooltip-size'.
2542 Text larger than the specified size is clipped. */)
2543 (Lisp_Object string
, Lisp_Object frame
, Lisp_Object parms
, Lisp_Object timeout
, Lisp_Object dx
, Lisp_Object dy
)
2546 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2547 ptrdiff_t count
= SPECPDL_INDEX
();
2552 specbind
(Qinhibit_redisplay
, Qt
);
2554 GCPRO4
(string
, parms
, frame
, timeout
);
2556 CHECK_STRING
(string
);
2557 str
= SSDATA
(string
);
2558 f
= check_x_frame
(frame
);
2560 timeout
= make_number
(5);
2562 CHECK_NATNUM
(timeout
);
2565 dx
= make_number
(5);
2570 dy
= make_number
(-10);
2575 if (ns_tooltip
== nil
)
2576 ns_tooltip
= [[EmacsTooltip alloc
] init
];
2580 [ns_tooltip setText
: str
];
2581 size = [ns_tooltip frame
].
size;
2583 /* Move the tooltip window where the mouse pointer is. Resize and
2585 compute_tip_xy
(f
, parms
, dx
, dy
, (int
)size.width
, (int
)size.height
,
2588 [ns_tooltip showAtX
: root_x Y
: root_y
for: XINT
(timeout
)];
2592 return unbind_to
(count
, Qnil
);
2596 DEFUN
("x
-hide
-tip"
, Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
2597 doc: /* Hide the current tooltip window, if there is any.
2598 Value is t if tooltip was open, nil otherwise. */)
2601 if (ns_tooltip
== nil ||
![ns_tooltip isActive
])
2608 /* ==========================================================================
2610 Class implementations
2612 ========================================================================== */
2615 @implementation EmacsSavePanel
2616 #ifdef NS_IMPL_COCOA
2617 /* --------------------------------------------------------------------------
2618 These are overridden to intercept on OS X: ending panel restarts NSApp
2619 event loop if it is stopped. Not sure if this is correct behavior,
2620 perhaps should check if running and if so send an appdefined.
2621 -------------------------------------------------------------------------- */
2622 - (void
) ok
: (id
)sender
2628 - (void
) cancel
: (id
)sender
2630 [super cancel
: sender
];
2637 @implementation EmacsOpenPanel
2638 #ifdef NS_IMPL_COCOA
2639 /* --------------------------------------------------------------------------
2640 These are overridden to intercept on OS X: ending panel restarts NSApp
2641 event loop if it is stopped. Not sure if this is correct behavior,
2642 perhaps should check if running and if so send an appdefined.
2643 -------------------------------------------------------------------------- */
2644 - (void
) ok
: (id
)sender
2650 - (void
) cancel
: (id
)sender
2652 [super cancel
: sender
];
2659 @implementation EmacsFileDelegate
2660 /* --------------------------------------------------------------------------
2661 Delegate methods for Open/Save panels
2662 -------------------------------------------------------------------------- */
2663 - (BOOL
)panel
: (id
)sender isValidFilename
: (NSString
*)filename
2667 - (BOOL
)panel
: (id
)sender shouldShowFilename
: (NSString
*)filename
2671 - (NSString
*)panel
: (id
)sender userEnteredFilename
: (NSString
*)filename
2672 confirmed
: (BOOL
)okFlag
2681 /* ==========================================================================
2683 Lisp interface declaration
2685 ========================================================================== */
2689 syms_of_nsfns
(void
)
2691 Qfontsize
= intern_c_string
("fontsize"
);
2692 staticpro
(&Qfontsize
);
2694 DEFVAR_LISP
("ns
-icon
-type-alist"
, Vns_icon_type_alist
,
2695 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
2696 If the title of a frame matches REGEXP, then IMAGE.tiff is
2697 selected as the image of the icon representing the frame when it's
2698 miniaturized. If an element is t, then Emacs tries to select an icon
2699 based on the filetype of the visited file.
2701 The images have to be installed in a folder called English.lproj in the
2702 Emacs folder. You have to restart Emacs after installing new icons.
2704 Example: Install an icon Gnus.tiff and execute the following code
2706 (setq ns-icon-type-alist
2707 (append ns-icon-type-alist
2708 '((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\"
2711 When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
2712 be used as the image of the icon representing the frame. */);
2713 Vns_icon_type_alist
= Fcons
(Qt
, Qnil
);
2715 DEFVAR_LISP
("ns
-version-string"
, Vns_version_string
,
2716 doc: /* Toolkit version for NS Windowing. */);
2717 Vns_version_string
= ns_appkit_version_str
();
2719 defsubr
(&Sns_read_file_name
);
2720 defsubr
(&Sns_get_resource
);
2721 defsubr
(&Sns_set_resource
);
2722 defsubr
(&Sxw_display_color_p
); /* this and next called directly by C code */
2723 defsubr
(&Sx_display_grayscale_p
);
2724 defsubr
(&Sns_font_name
);
2725 defsubr
(&Sns_list_colors
);
2726 #ifdef NS_IMPL_COCOA
2727 defsubr
(&Sns_do_applescript
);
2729 defsubr
(&Sxw_color_defined_p
);
2730 defsubr
(&Sxw_color_values
);
2731 defsubr
(&Sx_server_max_request_size
);
2732 defsubr
(&Sx_server_vendor
);
2733 defsubr
(&Sx_server_version
);
2734 defsubr
(&Sx_display_pixel_width
);
2735 defsubr
(&Sx_display_pixel_height
);
2736 defsubr
(&Sns_display_usable_bounds
);
2737 defsubr
(&Sx_display_mm_width
);
2738 defsubr
(&Sx_display_mm_height
);
2739 defsubr
(&Sx_display_screens
);
2740 defsubr
(&Sx_display_planes
);
2741 defsubr
(&Sx_display_color_cells
);
2742 defsubr
(&Sx_display_visual_class
);
2743 defsubr
(&Sx_display_backing_store
);
2744 defsubr
(&Sx_display_save_under
);
2745 defsubr
(&Sx_create_frame
);
2746 defsubr
(&Sx_open_connection
);
2747 defsubr
(&Sx_close_connection
);
2748 defsubr
(&Sx_display_list
);
2750 defsubr
(&Sns_hide_others
);
2751 defsubr
(&Sns_hide_emacs
);
2752 defsubr
(&Sns_emacs_info_panel
);
2753 defsubr
(&Sns_list_services
);
2754 defsubr
(&Sns_perform_service
);
2755 defsubr
(&Sns_convert_utf8_nfd_to_nfc
);
2756 defsubr
(&Sx_focus_frame
);
2757 defsubr
(&Sns_popup_font_panel
);
2758 defsubr
(&Sns_popup_color_panel
);
2760 defsubr
(&Sx_show_tip
);
2761 defsubr
(&Sx_hide_tip
);
2763 /* used only in fontset.c */
2764 check_window_system_func
= check_ns
;