diff options
author | Martin Rudalics <rudalics@gmx.at> | 2017-04-12 10:38:25 +0200 |
---|---|---|
committer | Martin Rudalics <rudalics@gmx.at> | 2017-04-12 10:38:25 +0200 |
commit | 3fdd3bb56c006a2a24761b8fcea0cbd9b0cba422 (patch) | |
tree | a0b8f5e431ba812b4fe69261a8515e973a3e7ed3 /lisp | |
parent | 449bc49c768a4733411c7e05186be7efc163cd7c (diff) | |
download | emacs-3fdd3bb56c006a2a24761b8fcea0cbd9b0cba422.tar.gz |
Add new frame parameters and associated functions
Add new frame parameters `undecorated', `override-redirect',
`parent-frame', `skip-taskbar', `no-focus-on-map',
`no-accept-focus', `z-group', `delete-before', `no-other-frame',
`mouse-wheel-frame', `min-width', `min-height'. Add new
functions `frame-restack' and `frame-list-z-order'.
* lisp/cus-start.el (focus-follows-mouse): Adapt customization
type.
* lisp/frame.el (handle-delete-frame): Handle child and
`delete-before' frames.
(other-frame): Stop looking for other frame after one round.
(frame-list-z-order, frame-restack): New functions.
(delete-other-frames): Handle child frames.
* lisp/frameset.el (frameset-persistent-filter-alist)
(frameset--record-relationships): Handle `delete-before',
`parent-frame' and `mouse-wheel-frame' parameters. Rename
latter from `frameset--record-minibuffer-relationships'.
(frameset--restore-frame): Handle ‘parent-frame’ parameter
specially.
(frameset-restore): Handle `delete-before', `parent-frame' and
`mouse-wheel-frame' parameters.
* lisp/mwheel.el (mwheel-scroll): Handle `mouse-wheel-frame'
parameter.
* lisp/window.el (window--min-size-ignore-p): Fix doc-string.
(mouse-autoselect-window-select, handle-select-window): Major
rewrite. Try to not ignore errors. Handle auto-selection of
child frames and different values of `focus-follows-mouse'.
* src/frame.c (frame_windows_min_size): Handle new `min-width'
and `min-height' frame parameters.
(make_frame): Initialize new frame structure members.
(do_switch_frame): Don't reset internal_last_event_frame for
descendant frames.
(Fframe_parent, frame_ancestor_p, Fframe_ancestor_p): New
functions.
(candidate_frame): Don't return `no-other-frame' frame.
(other_frames): New function replacing other_visible_frames.
(delete_frame): Rewrite. Handle child and `delete-before' frames.
(Fmake_frame_invisible): Call other_frames.
(store_frame_param): Check `delete-before' and `parent-frame'
parameters for circular dependencies.
(frame_parms, syms_of_frame): Add entries for and define new
frame parameters.
(focus_follows_mouse): New meaningful value `auto-raise'.
* src/frame.h (z_group): New enumeration type.
(frame): New slots parent_frame, undecorated, override_redirect,
skip_taskbar, no_focus_on_map, no_accept_focus, z_group.
(fset_parent_frame): New inlined function.
(FRAME_UNDECORATED, FRAME_OVERRIDE_REDIRECT)
(FRAME_PARENT_FRAME, FRAME_SKIP_TASKBAR, FRAME_NO_FOCUS_ON_MAP)
(FRAME_NO_ACCEPT_FOCUS, FRAME_Z_GROUP, FRAME_Z_GROUP_NONE)
(FRAME_Z_GROUP_ABOVE, FRAME_Z_GROUP_ABOVE_SUSPENDED)
(FRAME_Z_GROUP_BELOW): New macros.
(frame_ancestor_p): Add declaration.
* src/gtkutil.c (xg_create_frame_widgets): Handle
`undecorated' and `override-redirect' frame parameters.
(x_wm_set_size_hint): None for child frames.
(xg_set_undecorated, xg_frame_restack, xg_set_skip_taskbar)
(xg_set_no_focus_on_map, xg_set_no_accept_focus)
(xg_set_override_redirect): New functions.
(xg_update_scrollbar_pos, xg_update_horizontal_scrollbar_pos):
Don't let scrollbars obscure child frames.
* src/gtkutil.h: (xg_set_undecorated, xg_frame_restack)
(xg_set_skip_taskbar, xg_set_no_focus_on_map)
(xg_set_no_accept_focus, xg_set_override_redirect): Add extern
declarations.
* src/nsfns.m (ns_frame_parm_handlers): Add entries for new
frame parameters.
(Fx_create_frame): Install `min-width' and `min-height' frame
parameters.
* src/nsterm.m (mouseMoved:): Handle focus_follows_mouse change.
* src/w32fns.c (WS_EX_NOACTIVATE): Define if necessary.
(x_real_positions): Handle child frames.
(x_set_menu_bar_lines): Don't for child frames.
(x_set_undecorated, x_set_parent_frame, x_set_skip_taskbar)
(x_set_no_focus_on_map, x_set_no_accept_focus)
(x_set_z_group): New functions.
(w32_createvscrollbar, w32_createhscrollbar): Don't draw
scroll bars over child frames.
(w32_createwindow): Handle new frame parameters and child frames.
(w32_wnd_proc): Let mouse clicks into a child frame activate
the frame. Try to handle the `no-accept-focus' parameter. Do
SetFocus when our window is brought to top or becomes the
foreground window.
(w32_window): Don't initialize menu bar for child frames.
(Fx_create_frame): Handle new frame parameters.
(x_create_tip_frame): Set explicit_parent slot.
(w32_dialog_in_progress): New function.
(Fx_file_dialog): Handle `z-group-above' frames.
(w32_frame_list_z_order, Fw32_frame_list_z_order)
(w32_frame_restack, Fw32_frame_restack): New functions.
(w32_frame_parm_handlers): Add entries for new frame
parameters.
* src/w32font.c (Fx_select_font): Handle `z-group-above'
frames during font selection dialogue.
* src/w32term.c (construct_mouse_wheel): Construct mouse wheel
event from F's w32 window.
(w32_mouse_position): Handle child frames.
(w32_set_vertical_scroll_bar, w32_set_horizontal_scroll_bar):
Don't draw scroll bars over child frames.
(w32_read_socket): Always erase background of child frames.
When generating SELECT_WINDOW_EVENTs handle new value of
`focus-follows-mouse' and handle `no-accept-focus' parameter.
Handle `mouse-wheel-frame' parameter.
(x_calc_absolute_position, x_set_offset, x_set_window_size):
Handle child frames.
(x_make_frame_visible): Handle child frames specially. Handle
`no-focus-on-map' parameter.
* src/w32term.h (w32_dialog_in_progress): Add external
declaration.
* src/xdisp.c (x_consider_frame_title, prepare_menu_bars): Not
for child frames.
* src/xfns.c (Xm/MwmUtil.h): Include for WM hints.
(PropMotifWmHints, PROP_MOTIF_WM_HINTS_ELEMENTS): Define for
non-Motif, non-GTK case.
(x_real_pos_and_offsets): Handle child frames.
(x_set_undecorated, x_set_parent_frame)
(x_set_no_focus_on_map, x_set_no_accept_focus)
(x_set_override_redirect): New functions.
(x_set_menu_bar_lines): Not for child frames.
(x_window): Handle `undecorated' and `override_redirect' cases.
(Fx_create_frame): Handle new frame parameters.
(frame_geometry): Handle child frames and outer border.
(x_frame_list_z_order, Fx_frame_list_z_order)
(x_frame_restack, Fx_frame_restack): New functions.
(Fx_file_dialog, Fx_select_font): Set x_menu_set_in_use.
(x_frame_parm_handlers): Add entries for new frame parameters.
* src/xmenu.c (x_menu_set_in_use): Handle `z-group-above'
frames.
* src/xterm.c (x_set_frame_alpha): Don't set alpha of parent
for child frames.
(XTmouse_position): Handle child frames.
(x_scroll_bar_create, x_scroll_bar_expose): Don't let scroll
bars obscure child frames.
(handle_one_xevent): Handle child frame positions. If necessary
set `skip-taskbar' and reassign proper `z-group' when we are
mapped. When generating SELECT_WINDOW_EVENTs handle new value
of `focus-follows-mouse'. Handle `mouse-wheel-frame' parameter.
Let mouse clicks into a child frame activate the frame.
(x_calc_absolute_position, x_set_offset): Handle child frames
specially.
(x_set_skip_taskbar, x_set_z_group): New functions.
(x_make_frame_visible): Handle child frames.
(ATOM_REFS_INIT): Add entries for
Xatom_net_wm_state_skip_taskbar, Xatom_net_wm_state_above,
Xatom_net_wm_state_below.
* src/xterm.h (top-level): Declare Xatom_net_wm_state_above,
Xatom_net_wm_state_below and Xatom_net_wm_state_skip_taskbar.
(x_set_skip_taskbar, x_set_z_group): Add extern declarations.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/cus-start.el | 6 | ||||
-rw-r--r-- | lisp/frame.el | 117 | ||||
-rw-r--r-- | lisp/frameset.el | 100 | ||||
-rw-r--r-- | lisp/mwheel.el | 59 | ||||
-rw-r--r-- | lisp/window.el | 169 |
5 files changed, 313 insertions, 138 deletions
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 51c43c7d21a..a507e30ca9c 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -286,7 +286,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "22.1") - (focus-follows-mouse frames boolean "20.3") + (focus-follows-mouse + frames (choice + (const :tag "Off (nil)" :value nil) + (const :tag "On (t)" :value t) + (const :tag "Auto-raise" :value auto-raise)) "26.1") ;; fontset.c ;; FIXME nil is the initial value, fontset.el setqs it. (vertical-centering-font-regexp display diff --git a/lisp/frame.el b/lisp/frame.el index 4768b5be002..86a0e26e393 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -115,15 +115,19 @@ appended when the minibuffer frame is created." (defun handle-delete-frame (event) "Handle delete-frame events from the X server." (interactive "e") - (let ((frame (posn-window (event-start event))) - (i 0) - (tail (frame-list))) - (while tail - (and (frame-visible-p (car tail)) - (not (eq (car tail) frame)) - (setq i (1+ i))) - (setq tail (cdr tail))) - (if (> i 0) + (let* ((frame (posn-window (event-start event)))) + (if (catch 'other-frame + (dolist (frame-1 (frame-list)) + ;; A valid "other" frame is visible, owns its minibuffer + ;; window, has its `delete-before' parameter unset and is + ;; not a child frame. + (when (and (not (eq frame-1 frame)) + (frame-visible-p frame-1) + (window-live-p (minibuffer-window frame-1)) + (eq (window-frame (minibuffer-window frame-1)) frame-1) + (not (frame-parent frame-1)) + (not (frame-parameter frame-1 'delete-before))) + (throw 'other-frame t)))) (delete-frame frame t) ;; Gildea@x.org says it is ok to ask questions before terminating. (save-buffers-kill-emacs)))) @@ -834,21 +838,24 @@ All frames are arranged in a cyclic order. This command selects the frame ARG steps away in that order. A negative ARG moves in the opposite order. -To make this command work properly, you must tell Emacs -how the system (or the window manager) generally handles -focus-switching between windows. If moving the mouse onto a window -selects it (gives it focus), set `focus-follows-mouse' to t. -Otherwise, that variable should be nil." +To make this command work properly, you must tell Emacs how the +system (or the window manager) generally handles focus-switching +between windows. If moving the mouse onto a window selects +it (gives it focus), set `focus-follows-mouse' to t. Otherwise, +that variable should be nil." (interactive "p") - (let ((frame (selected-frame))) + (let ((sframe (selected-frame)) + (frame (selected-frame))) (while (> arg 0) (setq frame (next-frame frame)) - (while (not (eq (frame-visible-p frame) t)) + (while (and (not (eq frame sframe)) + (not (eq (frame-visible-p frame) t))) (setq frame (next-frame frame))) (setq arg (1- arg))) (while (< arg 0) (setq frame (previous-frame frame)) - (while (not (eq (frame-visible-p frame) t)) + (while (and (not (eq frame sframe)) + (not (eq (frame-visible-p frame) t))) (setq frame (previous-frame frame))) (setq arg (1+ arg))) (select-frame-set-input-focus frame))) @@ -1380,6 +1387,7 @@ and width values are in pixels. '(outer-position 0 . 0) (cons 'outer-size (cons (frame-width frame) (frame-height frame))) '(external-border-size 0 . 0) + '(outer-border-width . 0) '(title-bar-size 0 . 0) '(menu-bar-external . nil) (let ((menu-bar-lines (frame-parameter frame 'menu-bar-lines))) @@ -1490,6 +1498,59 @@ keys and their meanings." for frames = (cdr (assq 'frames attributes)) if (memq frame frames) return attributes)) +(declare-function x-frame-list-z-order "xfns.c" (&optional display)) +(declare-function w32-frame-list-z-order "w32fns.c" (&optional display)) + +(defun frame-list-z-order (&optional display) + "Return list of Emacs' frames, in Z (stacking) order. +The optional argument DISPLAY specifies which display to poll. +DISPLAY should be either a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +Frames are listed from topmost (first) to bottommost (last). As +a special case, if DISPLAY is non-nil and specifies a live frame, +return the child frames of that frame in Z (stacking) order. + +Return nil if DISPLAY contains no Emacs frame." + (let ((frame-type (framep-on-display display))) + (cond + ((eq frame-type 'x) + (x-frame-list-z-order display)) + ((eq frame-type 'w32) + (w32-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)) + +(defun frame-restack (frame1 frame2 &optional above) + "Restack FRAME1 below FRAME2. +This implies that if both frames are visible and the display +areas of these frames overlap, FRAME2 will (partially) obscure +FRAME1. If the optional third argument ABOVE is non-nil, restack +FRAME1 above FRAME2. This means that if both frames are visible +and the display areas of these frames overlap, FRAME1 will +\(partially) obscure FRAME2. + +This may be thought of as an atomic action performed in two +steps: The first step removes FRAME1's window-system window from +the display. The second step reinserts FRAME1's window +below (above if ABOVE is true) that of FRAME2. Hence the +position of FRAME2 in its display's Z (stacking) order relative +to all other frames excluding FRAME1 remains unaltered. + +Some window managers may refuse to restack windows. " + (if (and (frame-live-p frame1) + (frame-live-p frame2) + (equal (frame-parameter frame1 'display) + (frame-parameter frame2 'display))) + (let ((frame-type (framep-on-display frame1))) + (cond + ((eq frame-type 'x) + (x-frame-restack frame1 frame2 above)) + ((eq frame-type 'w32) + (w32-frame-restack frame1 frame2 above)))) + (error "Cannot restack frames"))) + (defun frame-size-changed-p (&optional frame) "Return non-nil when the size of FRAME has changed. More precisely, return non-nil when the inner width or height of @@ -1886,7 +1947,7 @@ A geometry specification equivalent to SPEC for FRAME is returned, where the value is a cons with car `+', not numeric. SPEC is a frame geometry spec: (left . VALUE) or (top . VALUE). If VALUE is a number, then it is converted to a cons value, perhaps - relative to the opposite frame edge from that in the original spec. +relative to the opposite frame edge from that in the original spec. FRAME defaults to the selected frame. Examples (measures in pixels) - @@ -1907,24 +1968,36 @@ the opposite frame edge from the edge indicated in the input spec." (defun delete-other-frames (&optional frame) "Delete all frames on FRAME's terminal, except FRAME. If FRAME uses another frame's minibuffer, the minibuffer frame is -left untouched. FRAME must be a live frame and defaults to the -selected one." +left untouched. Do not delete any of FRAME's child frames. If +FRAME is a child frame, delete its siblings only. FRAME must be +a live frame and defaults to the selected one." (interactive) (setq frame (window-normalize-frame frame)) (let ((minibuffer-frame (window-frame (minibuffer-window frame))) (this (next-frame frame t)) + (parent (frame-parent frame)) next) ;; In a first round consider minibuffer-less frames only. (while (not (eq this frame)) (setq next (next-frame this t)) - (unless (eq (window-frame (minibuffer-window this)) this) + (unless (or (eq (window-frame (minibuffer-window this)) this) + ;; When FRAME is a child frame, delete its siblings + ;; only. + (and parent (not (eq (frame-parent this) parent))) + ;; Do not delete a child frame of FRAME. + (eq (frame-parent this) frame)) (delete-frame this)) (setq this next)) ;; In a second round consider all remaining frames. (setq this (next-frame frame t)) (while (not (eq this frame)) (setq next (next-frame this t)) - (unless (eq this minibuffer-frame) + (unless (or (eq this minibuffer-frame) + ;; When FRAME is a child frame, delete its siblings + ;; only. + (and parent (not (eq (frame-parent this) parent))) + ;; Do not delete a child frame of FRAME. + (eq (frame-parent this) frame)) (delete-frame this)) (setq this next)))) diff --git a/lisp/frameset.el b/lisp/frameset.el index 2dd3050ef76..ebf09d3ab5c 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -446,6 +446,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) + (delete-before . :never) (font . frameset-filter-shelve-param) (foreground-color . frameset-filter-sanitize-color) (fullscreen . frameset-filter-shelve-param) @@ -455,7 +456,9 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) + (parent-frame . :never) (parent-id . :never) + (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) @@ -717,9 +720,18 @@ If nil, check all live frames." ;; Saving framesets -(defun frameset--record-minibuffer-relationships (frame-list) - "Process FRAME-LIST and record minibuffer relationships. -FRAME-LIST is a list of frames. Internal use only." +(defun frameset--record-relationships (frame-list) + "Process FRAME-LIST and record relationships. +FRAME-LIST is a list of frames. + +The relationships recorded for each frame are + +- `minibuffer' via `frameset--mini' +- `delete-before' via `frameset--delete-before' +- `parent-frame' via `frameset--parent-frame' +- `mouse-wheel-frame' via `frameset--mouse-wheel-frame' + +Internal use only." ;; Record frames with their own minibuffer (dolist (frame (minibuffer-frame-list)) (when (memq frame frame-list) @@ -730,22 +742,41 @@ FRAME-LIST is a list of frames. Internal use only." (set-frame-parameter frame 'frameset--mini (cons t (eq frame default-minibuffer-frame))))) - ;; Now link minibufferless frames with their minibuffer frames + ;; Now link minibufferless frames with their minibuffer frames and + ;; store `parent-frame', `delete-before' and `mouse-wheel-frame' + ;; relationships in a similar way. (dolist (frame frame-list) - (unless (frame-parameter frame 'frameset--mini) - (frameset--set-id frame) - (let ((mb-frame (window-frame (minibuffer-window frame)))) - ;; For minibufferless frames, frameset--mini is a cons - ;; (nil . FRAME-ID), where FRAME-ID is the frameset--id of - ;; the frame containing its minibuffer window. - ;; FRAME-ID can be set to nil, if FRAME-LIST doesn't contain - ;; the minibuffer frame of a minibufferless frame; we allow - ;; it without trying to second-guess the user. - (set-frame-parameter frame - 'frameset--mini - (cons nil - (and mb-frame - (frameset-frame-id mb-frame)))))))) + (let ((parent-frame (frame-parent frame)) + (delete-before (frame-parameter frame 'delete-before)) + (mouse-wheel-frame (frame-parameter frame 'mouse-wheel-frame)) + (nomini (not (frame-parameter frame 'frameset--mini)))) + (when (or nomini parent-frame delete-before mouse-wheel-frame) + (when nomini + (frameset--set-id frame)) + (when parent-frame + (set-frame-parameter + frame 'frameset--parent-frame (frameset-frame-id parent-frame))) + (when delete-before + (set-frame-parameter + frame 'frameset--delete-before (frameset-frame-id delete-before))) + (when mouse-wheel-frame + (set-frame-parameter + frame 'frameset--mouse-wheel-frame + (frameset-frame-id mouse-wheel-frame))) + (when nomini + (let ((mb-frame (window-frame (minibuffer-window frame)))) + ;; For minibufferless frames, frameset--mini is a cons + ;; (nil . FRAME-ID), where FRAME-ID is the frameset--id of + ;; the frame containing its minibuffer window. + ;; FRAME-ID can be set to nil, if FRAME-LIST doesn't contain + ;; the minibuffer frame of a minibufferless frame; we allow + ;; it without trying to second-guess the user. + (set-frame-parameter + frame + 'frameset--mini + (cons nil + (and mb-frame + (frameset-frame-id mb-frame)))))))))) ;;;###autoload (cl-defun frameset-save (frame-list @@ -768,7 +799,7 @@ PROPERTIES is a user-defined property list to add to the frameset." (cl-delete-if-not predicate list) list))) fs) - (frameset--record-minibuffer-relationships frames) + (frameset--record-relationships frames) (setq fs (frameset--make :app app :name name @@ -993,6 +1024,14 @@ Internal use only." (frameset--initial-params filtered-cfg)))) (puthash frame :created frameset--action-map)) + ;; Try to assign parent-frame right here - it will improve things + ;; for minibuffer-less child frames. + (let* ((frame-id (frame-parameter frame 'frameset--parent-frame)) + (parent-frame + (and frame-id (frameset-frame-with-id frame-id)))) + (when (frame-live-p parent-frame) + (set-frame-parameter frame 'parent-frame parent-frame))) + (modify-frame-parameters frame (if (eq (frame-parameter frame 'fullscreen) fullscreen) ;; Workaround for bug#14949 @@ -1205,6 +1244,29 @@ All keyword parameters default to nil." (error (delay-warning 'frameset (error-message-string err) :error)))))) + ;; Setting the parent frame after the frame has been created is a + ;; pain because one can see the frame move on the screen. Ideally, + ;; we would restore minibuffer equipped child frames after their + ;; respective parents have been made but this might interfere with + ;; the reordering of minibuffer frames. Left to the experts ... + (dolist (frame (frame-list)) + (let* ((frame-id (frame-parameter frame 'frameset--parent-frame)) + (parent-frame + (and frame-id (frameset-frame-with-id frame-id)))) + (when (and (not (eq (frame-parameter frame 'parent-frame) parent-frame)) + (frame-live-p parent-frame)) + (set-frame-parameter frame 'parent-frame parent-frame))) + (let* ((frame-id (frame-parameter frame 'frameset--delete-before)) + (delete-before + (and frame-id (frameset-frame-with-id frame-id)))) + (when (frame-live-p delete-before) + (set-frame-parameter frame 'delete-before delete-before))) + (let* ((frame-id (frame-parameter frame 'frameset--mouse-wheel-frame)) + (mouse-wheel-frame + (and frame-id (frameset-frame-with-id frame-id)))) + (when (frame-live-p mouse-wheel-frame) + (set-frame-parameter frame 'mouse-wheel-frame mouse-wheel-frame)))) + ;; In case we try to delete the initial frame, we want to make sure that ;; other frames are already visible (discussed in thread for bug#14841). (sit-for 0 t) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index eaeb831e844..958c6e831b7 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -190,14 +190,33 @@ This can be slightly disconcerting, but some people prefer it." This should be bound only to mouse buttons 4 and 5 on non-Windows systems." (interactive (list last-input-event)) - (let* ((curwin (if mouse-wheel-follow-mouse - (prog1 - (selected-window) - (select-window (mwheel-event-window event))))) - (buffer (window-buffer curwin)) - (opoint (with-current-buffer buffer - (when (eq (car-safe transient-mark-mode) 'only) - (point)))) + (let* ((selected-window (selected-window)) + (scroll-window + (or (catch 'found + (let* ((window (if mouse-wheel-follow-mouse + (mwheel-event-window event) + (selected-window))) + (frame (when (window-live-p window) + (frame-parameter + (window-frame window) 'mouse-wheel-frame)))) + (when (frame-live-p frame) + (let* ((pos (mouse-absolute-pixel-position)) + (pos-x (car pos)) + (pos-y (cdr pos))) + (walk-window-tree + (lambda (window-1) + (let ((edges (window-edges window-1 nil t t))) + (when (and (<= (nth 0 edges) pos-x) + (<= pos-x (nth 2 edges)) + (<= (nth 1 edges) pos-y) + (<= pos-y (nth 3 edges))) + (throw 'found window-1)))) + frame nil t))))) + (mwheel-event-window event))) + (old-point + (and (eq scroll-window selected-window) + (eq (car-safe transient-mark-mode) 'only) + (window-point))) (mods (delq 'click (delq 'double (delq 'triple (event-modifiers event))))) (amt (assoc mods mouse-wheel-scroll-amount))) @@ -232,18 +251,18 @@ systems." ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) (t (error "Bad binding in mwheel-scroll")))) - (if curwin (select-window curwin))) - ;; If there is a temporarily active region, deactivate it if - ;; scrolling moves point. - (when opoint - (with-current-buffer buffer - (when (/= opoint (point)) - ;; Call `deactivate-mark' at the original position, so that - ;; the original region is saved to the X selection. - (let ((newpoint (point))) - (goto-char opoint) - (deactivate-mark) - (goto-char newpoint)))))) + (if (eq scroll-window selected-window) + ;; If there is a temporarily active region, deactivate it if + ;; scrolling moved point. + (when (and old-point (/= old-point (window-point))) + ;; Call `deactivate-mark' at the original position, so that + ;; the original region is saved to the X selection. + (let ((new-point (window-point))) + (goto-char old-point) + (deactivate-mark) + (goto-char new-point))) + (select-window selected-window t)))) + (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time) (if mwheel-inhibit-click-event-timer (cancel-timer mwheel-inhibit-click-event-timer) diff --git a/lisp/window.el b/lisp/window.el index 505024342ed..bea8383fcde 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1533,7 +1533,7 @@ return the minimum pixel-size of WINDOW." (window-normalize-window window) horizontal ignore pixelwise)) (defun window--min-size-ignore-p (window ignore) - "Return non-nil if IGNORE says to ignore height restrictions for WINDOW." + "Return non-nil if IGNORE says to ignore size restrictions for WINDOW." (if (window-valid-p ignore) (eq window ignore) (not (memq ignore '(nil preserved))))) @@ -8735,13 +8735,14 @@ means suspend autoselection." If the mouse position has stabilized in a non-selected window, select that window. The minibuffer window is selected only if the minibuffer is active. This function is run by `mouse-autoselect-window-timer'." - (ignore-errors - (let* ((mouse-position (mouse-position)) - (window - (ignore-errors - (window-at (cadr mouse-position) (cddr mouse-position) - (car mouse-position))))) - (cond + (let* ((mouse-position (mouse-position)) + (mouse-x (and (numberp (cadr mouse-position)) + (cadr mouse-position))) + (mouse-y (and (numberp (cddr mouse-position)) + (cddr mouse-position))) + (frame (and mouse-x mouse-y (car mouse-position))) + (window (and frame (window-at mouse-x mouse-y frame)))) + (cond ((or (and (fboundp 'menu-or-popup-active-p) (menu-or-popup-active-p)) (and window (let ((coords (coordinates-in-window-p @@ -8752,72 +8753,63 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; text region of WINDOW: Suspend autoselection temporarily. (mouse-autoselect-window-start mouse-position nil t)) ((or (eq mouse-autoselect-window-state 'suspend) - ;; When the mouse is at its first recorded position, restart - ;; delayed autoselection. This works around a scenario with - ;; two two-window frames with identical dimensions: select the - ;; first window of the first frame, switch to the second - ;; frame, move the mouse to its second window, minimize the - ;; second frame. Now the second window of the first frame - ;; gets selected although the mouse never really "moved" into - ;; that window. - (and (numberp mouse-autoselect-window) - (equal (mouse-position) mouse-autoselect-window-position-1))) - ;; Delayed autoselection was temporarily suspended, reenable it. - (mouse-autoselect-window-start mouse-position)) - ((and window (not (eq window (selected-window))) - (or (not (numberp mouse-autoselect-window)) - (and (>= mouse-autoselect-window 0) - ;; If `mouse-autoselect-window' is non-negative, - ;; select window if it's the same as before. - (eq window mouse-autoselect-window-window)) - ;; Otherwise select window iff the mouse is at the same - ;; position as before. Observe that the first test - ;; after starting autoselection usually fails since the - ;; value of `mouse-autoselect-window-position' recorded - ;; there is the position where the mouse has entered the - ;; new window and not necessarily where the mouse has - ;; stopped moving. - (equal mouse-position mouse-autoselect-window-position)) - ;; The minibuffer is a candidate window if it's active. - (or (not (window-minibuffer-p window)) - (eq window (active-minibuffer-window)))) - ;; Mouse position has stabilized in non-selected window: Cancel - ;; delayed autoselection and try to select that window. - (mouse-autoselect-window-cancel t) - ;; Select window where mouse appears unless the selected window is the - ;; minibuffer. Use `unread-command-events' in order to execute pre- - ;; and post-command hooks and trigger idle timers. To avoid delaying - ;; autoselection again, set `mouse-autoselect-window-state'." - (unless (window-minibuffer-p) - (setq mouse-autoselect-window-state 'select) - (setq unread-command-events - (cons (list 'select-window (list window)) - unread-command-events)))) - ((or (and window (eq window (selected-window))) - (not (numberp mouse-autoselect-window)) - (equal mouse-position mouse-autoselect-window-position)) - ;; Mouse position has either stabilized in the selected window or at - ;; `mouse-autoselect-window-position': Cancel delayed autoselection. - (mouse-autoselect-window-cancel t)) - (t - ;; Mouse position has not stabilized yet, resume delayed - ;; autoselection. - (mouse-autoselect-window-start mouse-position window)))))) + ;; When the mouse is at its first recorded position, restart + ;; delayed autoselection. This works around a scenario with + ;; two two-window frames with identical dimensions: select the + ;; first window of the first frame, switch to the second + ;; frame, move the mouse to its second window, minimize the + ;; second frame. Now the second window of the first frame + ;; gets selected although the mouse never really "moved" into + ;; that window. + (and (numberp mouse-autoselect-window) + (equal (mouse-position) mouse-autoselect-window-position-1))) + ;; Delayed autoselection was temporarily suspended, reenable it. + (mouse-autoselect-window-start mouse-position)) + ((and window + (or (not (numberp mouse-autoselect-window)) + (and (>= mouse-autoselect-window 0) + ;; If `mouse-autoselect-window' is non-negative, + ;; select window if it's the same as before. + (eq window mouse-autoselect-window-window)) + ;; Otherwise select window iff the mouse is at the same + ;; position as before. Observe that the first test + ;; after starting autoselection usually fails since the + ;; value of `mouse-autoselect-window-position' recorded + ;; there is the position where the mouse has entered the + ;; new window and not necessarily where the mouse has + ;; stopped moving. + (equal mouse-position mouse-autoselect-window-position)) + ;; The minibuffer is a candidate window if it's active. + (or (not (window-minibuffer-p window)) + (eq window (active-minibuffer-window)))) + ;; Mouse position has stabilized in non-selected window: Cancel + ;; delayed autoselection and try to select that window. + (mouse-autoselect-window-cancel t) + ;; Use `unread-command-events' in order to execute pre- and + ;; post-command hooks and trigger idle timers. To avoid delaying + ;; autoselection again, set `mouse-autoselect-window-state'." + (setq mouse-autoselect-window-state 'select) + (setq unread-command-events + (cons (list 'select-window (list window)) + unread-command-events))) + ((or (not (numberp mouse-autoselect-window)) + (equal mouse-position mouse-autoselect-window-position)) + ;; Mouse position has stabilized at + ;; `mouse-autoselect-window-position': Cancel delayed + ;; autoselection. + (mouse-autoselect-window-cancel t)) + (window + ;; Mouse position has not stabilized yet, resume delayed + ;; autoselection. + (mouse-autoselect-window-start mouse-position window))))) (defun handle-select-window (event) "Handle select-window events." (interactive "^e") - (let ((window (posn-window (event-start event)))) + (let* ((window (posn-window (event-start event))) + (frame (and (window-live-p window) (window-frame window))) + (old-frame (selected-frame))) (unless (or (not (window-live-p window)) - ;; Don't switch if we're currently in the minibuffer. - ;; This tries to work around problems where the - ;; minibuffer gets unselected unexpectedly, and where - ;; you then have to move your mouse all the way down to - ;; the minibuffer to select it. - (window-minibuffer-p) - ;; Don't switch to minibuffer window unless it's active. - (and (window-minibuffer-p window) - (not (minibuffer-window-active-p window))) ;; Don't switch when autoselection shall be delayed. (and (numberp mouse-autoselect-window) (not (eq mouse-autoselect-window-state 'select)) @@ -8830,15 +8822,40 @@ is active. This function is run by `mouse-autoselect-window-timer'." (mouse-autoselect-window-start position window) ;; Executing a command cancels delayed autoselection. (add-hook - 'pre-command-hook 'mouse-autoselect-window-cancel)))) - (when mouse-autoselect-window - ;; Reset state of delayed autoselection. - (setq mouse-autoselect-window-state nil) - ;; Run `mouse-leave-buffer-hook' when autoselecting window. - (run-hooks 'mouse-leave-buffer-hook)) + 'pre-command-hook 'mouse-autoselect-window-cancel))) + ;; Don't switch to a `no-accept-focus' frame unless it's + ;; already selected. + (and (not (eq frame (selected-frame))) + (frame-parameter frame 'no-accept-focus)) + ;; Don't switch to minibuffer window unless it's active. + (and (window-minibuffer-p window) + (not (minibuffer-window-active-p window)))) + ;; Reset state of delayed autoselection. + (setq mouse-autoselect-window-state nil) + ;; Run `mouse-leave-buffer-hook' when autoselecting window. + (run-hooks 'mouse-leave-buffer-hook) ;; Clear echo area. (message nil) - (select-window window)))) + ;; Select the window before giving the frame focus since otherwise + ;; we might get two windows with an active cursor. + (select-window window) + (cond + ((or (not (memq (window-system frame) '(x w32 ns))) + (not focus-follows-mouse) + ;; Focus FRAME if it's either a child frame or an ancestor + ;; of the frame switched from. + (and (not (frame-parameter frame 'parent-frame)) + (not (frame-ancestor-p frame old-frame))))) + ((eq focus-follows-mouse 'auto-raise) + ;; Focus and auto-raise frame. + (x-focus-frame frame) + ;; This doesn't seem to work when we move from a normal frame + ;; right into the child frame of another frame - we should raise + ;; that child frame's ancestor frame first ... + (raise-frame frame)) + (t + ;; Just focus frame. + (x-focus-frame frame)))))) (defun truncated-partial-width-window-p (&optional window) "Return non-nil if lines in WINDOW are specifically truncated due to its width. |