commit d812d20fbc3e1eff0f10443baed801adda9031cd (HEAD, refs/remotes/origin/master) Author: Alan Third Date: Thu Apr 20 15:25:56 2017 +0100 Add no-accept-focus and frame-list-z-order to NS port * lisp/frame.el (frame-list-z-order): Add NS. * src/nsfns.m: Add x_set_no_accept_focus to handler struct. (Fx_create_frame): Handle no-accept-focus parameter. (ns_window_is_ancestor): (Fns_frame_list_z_order): New functions. * src/nsterm.m (x_set_no_accept_focus): New function. (initFrameFromEmacs): Use EmacsWindow instead of EmacsFSWindow for non-fullscreen windows. (EmacsWindow:canBecomeKeyWindow): New function. diff --git a/lisp/frame.el b/lisp/frame.el index e632b5943f..cec262499d 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1500,6 +1500,7 @@ keys and their meanings." (declare-function x-frame-list-z-order "xfns.c" (&optional display)) (declare-function w32-frame-list-z-order "w32fns.c" (&optional display)) +(declare-function ns-frame-list-z-order "nsfns.m" (&optional display)) (defun frame-list-z-order (&optional display) "Return list of Emacs' frames, in Z (stacking) order. @@ -1517,10 +1518,13 @@ Return nil if DISPLAY contains no Emacs frame." ((eq frame-type 'x) (x-frame-list-z-order display)) ((eq frame-type 'w32) - (w32-frame-list-z-order display))))) + (w32-frame-list-z-order display)) + ((eq frame-type 'ns) + (ns-frame-list-z-order display))))) (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above)) (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above)) +(declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above)) (defun frame-restack (frame1 frame2 &optional above) "Restack FRAME1 below FRAME2. diff --git a/src/nsfns.m b/src/nsfns.m index f1a5df8f27..3a37df9575 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -973,14 +973,14 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side 0, /* x_set_tool_bar_position */ 0, /* x_set_inhibit_double_buffering */ #ifdef NS_IMPL_COCOA - x_set_undecorated, /* x_set_undecorated */ + x_set_undecorated, #else 0, /*x_set_undecorated */ #endif - x_set_parent_frame, /* x_set_parent_frame */ + x_set_parent_frame, 0, /* x_set_skip_taskbar */ 0, /* x_set_no_focus_on_map */ - 0, /* x_set_no_accept_focus */ + x_set_no_accept_focus, x_set_z_group, /* x_set_z_group */ 0, /* x_set_override_redirect */ }; @@ -1287,6 +1287,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side store_frame_param (f, Qparent_frame, parent_frame); x_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + x_default_parameter (f, parms, Qno_accept_focus, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); /* The resources controlling the menu-bar and tool-bar are processed specially at startup, and reflected in the mode @@ -1428,6 +1430,58 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side } } +static BOOL +ns_window_is_ancestor (NSWindow *win, NSWindow *candidate) +/* Test whether CANDIDATE is an ancestor window of WIN. */ +{ + if (candidate == NULL) + return NO; + else if (win == candidate) + return YES; + else + return ns_window_is_ancestor(win, [candidate parentWindow]); +} + +DEFUN ("ns-frame-list-z-order", Fns_frame_list_z_order, + Sns_frame_list_z_order, 0, 1, 0, + doc: /* Return list of Emacs' frames, in Z (stacking) order. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be either a frame or a display name (a string). If +omitted or nil, that stands for the selected frame's display. Return +nil if TERMINAL contains no Emacs frame. + +As a special case, if TERMINAL is non-nil and specifies a live frame, +return the child frames of that frame in Z (stacking) order. + +Frames are listed from topmost (first) to bottommost (last). */) + (Lisp_Object terminal) +{ + NSArray *list = [NSApp orderedWindows]; + Lisp_Object frames = Qnil; + + if (FRAMEP (terminal) && FRAME_LIVE_P (XFRAME (terminal))) + { + /* Filter LIST to just those that are ancestors of TERMINAL. */ + NSWindow *win = [FRAME_NS_VIEW (XFRAME (terminal)) window]; + + NSPredicate *ancestor_pred = + [NSPredicate predicateWithBlock:^BOOL(id candidate, NSDictionary *bind) { + return ns_window_is_ancestor (win, [(NSWindow *)candidate parentWindow]); + }]; + + list = [[NSApp orderedWindows] filteredArrayUsingPredicate: ancestor_pred]; + } + + for (NSWindow *win in [list reverseObjectEnumerator]) + { + Lisp_Object frame; + XSETFRAME (frame, ((EmacsView *)[win delegate])->emacsframe); + frames = Fcons(frame, frames); + } + + return frames; +} + DEFUN ("ns-frame-restack", Fns_frame_restack, Sns_frame_restack, 2, 3, 0, doc: /* Restack FRAME1 below FRAME2. This means that if both frames are visible and the display areas of @@ -3188,6 +3242,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename defsubr (&Sns_display_monitor_attributes_list); defsubr (&Sns_frame_geometry); defsubr (&Sns_frame_edges); + defsubr (&Sns_frame_list_z_order); defsubr (&Sns_frame_restack); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); diff --git a/src/nsterm.h b/src/nsterm.h index 2f8c4269b0..9285178d19 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1212,6 +1212,8 @@ extern void x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); extern void x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); +extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value); extern void x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, diff --git a/src/nsterm.m b/src/nsterm.m index c53957f933..4e88297bc0 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1913,6 +1913,21 @@ so some key presses (TAB) are swallowed by the system. */ } void +x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +/* Set frame F's `no-accept-focus' parameter which, if non-nil, hints + * that F's window-system window does not want to receive input focus + * via mouse clicks or by moving the mouse into it. + * + * If non-nil, this may have the unwanted side-effect that a user cannot + * scroll a non-selected frame with the mouse. + * + * Some window managers may not honor this parameter. */ +{ + if (!EQ (new_value, old_value)) + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); +} + +void x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) /* Set frame F's `z-group' parameter. If `above', F's window-system window is displayed above all windows that do not have the `above' @@ -6900,7 +6915,7 @@ This avoids an extra clear and redraw (flicker) at frame creation. */ maximizing_resize = NO; #endif - win = [[EmacsFSWindow alloc] + win = [[EmacsWindow alloc] initWithContentRect: r styleMask: (FRAME_UNDECORATED (f) ? NSWindowStyleMaskBorderless @@ -8130,6 +8145,11 @@ - (void)setFrameTopLeftPoint:(NSPoint)point [super setFrameTopLeftPoint:point]; } + +- (BOOL)canBecomeKeyWindow +{ + return !FRAME_NO_ACCEPT_FOCUS (((EmacsView *)[self delegate])->emacsframe); +} @end /* EmacsWindow */ commit a3b8618d79657af0d7fea9cb6fd914ccf0f67849 Author: Stefan Monnier Date: Fri Apr 21 12:14:59 2017 -0400 Improve prefix handling for dash.el * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Don't drop dash's "-" prefixes. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index ca46f31767..4d0554e610 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -598,7 +598,8 @@ Don't try to split prefixes that are already longer than that.") (lambda (x) (let ((prefix (car x))) (if (or (> (length prefix) 2) ;Long enough! - (string-match ".[[:punct:]]\\'" prefix)) + (and (eq (length prefix) 2) + (string-match "[[:punct:]]" prefix))) prefix ;; Some packages really don't follow the rules. ;; Drop the most egregious cases such as the commit 89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da Author: Stefan Monnier Date: Fri Apr 21 12:12:42 2017 -0400 * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet Revert 0d112c00ba0ec14bd3014efcd3430b9ddcfe1fc1 (to fix bug#26325) and use a different fix for bug#26068. (cl--symbol-macro-key): New function. (cl--sm-macroexpand, cl-symbol-macrolet): Use it instead of `symbol-name`. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet): Failure is not expected any more. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ecb89fd51d..db1518ce61 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2047,6 +2047,12 @@ This is like `cl-flet', but for macros instead of functions. cl--old-macroexpand (symbol-function 'macroexpand))) +(defun cl--symbol-macro-key (sym) + "Return the key used in `macroexpand-all-environment' for symbol macro SYM." + ;; In the past we've used `symbol-name' instead, but that doesn't + ;; preserve the `eq'uality between different symbols of the same name. + `(:cl-symbol-macro . ,sym)) + (defun cl--sm-macroexpand (exp &optional env) "Special macro expander used inside `cl-symbol-macrolet'. This function replaces `macroexpand' during macro expansion @@ -2059,8 +2065,10 @@ except that it additionally expands symbol macros." (pcase exp ((pred symbolp) ;; Perform symbol-macro expansion. - (when (cdr (assq exp env)) - (setq exp (cadr (assq exp env))))) + ;; FIXME: Calling `cl--symbol-macro-key' for every var reference + ;; is a bit more costly than I'd like. + (when (cdr (assoc (cl--symbol-macro-key exp) env)) + (setq exp (cadr (assoc (cl--symbol-macro-key exp) env))))) (`(setq . ,_) ;; Convert setq to setf if required by symbol-macro expansion. (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) @@ -2078,7 +2086,7 @@ except that it additionally expands symbol macros." (let ((letf nil) (found nil) (nbs ())) (dolist (binding bindings) (let* ((var (if (symbolp binding) binding (car binding))) - (sm (assq var env))) + (sm (assoc (cl--symbol-macro-key var) env))) (push (if (not (cdr sm)) binding (let ((nexp (cadr sm))) @@ -2149,7 +2157,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (let ((expansion ;; FIXME: For N bindings, this will traverse `body' N times! (macroexpand-all (macroexp-progn body) - (cons (list (caar bindings) + (cons (list (cl--symbol-macro-key + (caar bindings)) (cl-cadar bindings)) macroexpand-all-environment)))) (if (or (null (cdar bindings)) (cl-cddar bindings)) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 564ddab67d..65bd97f3b2 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -495,7 +495,6 @@ (ert-deftest cl-lib-symbol-macrolet () ;; bug#26325 - :expected-result :failed (should (equal (cl-flet ((f (x) (+ x 5))) (let ((x 5)) (f (+ x 6))))