summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorMartin Rudalics <rudalics@gmx.at>2017-04-12 10:38:25 +0200
committerMartin Rudalics <rudalics@gmx.at>2017-04-12 10:38:25 +0200
commit3fdd3bb56c006a2a24761b8fcea0cbd9b0cba422 (patch)
treea0b8f5e431ba812b4fe69261a8515e973a3e7ed3 /lisp
parent449bc49c768a4733411c7e05186be7efc163cd7c (diff)
downloademacs-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.el6
-rw-r--r--lisp/frame.el117
-rw-r--r--lisp/frameset.el100
-rw-r--r--lisp/mwheel.el59
-rw-r--r--lisp/window.el169
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.