123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568 |
- (defgroup windmove nil
- "Directional selection of windows in a frame."
- :prefix "windmove-"
- :version "21.1"
- :group 'windows
- :group 'convenience)
- (defcustom windmove-wrap-around nil
- "Whether movement off the edge of the frame wraps around.
- If this variable is set to t, moving left from the leftmost window in
- a frame will find the rightmost one, and similarly for the other
- directions. The minibuffer is skipped over in up/down movements if it
- is inactive."
- :type 'boolean
- :group 'windmove)
- (defcustom windmove-window-distance-delta 1
- "How far away from the current window to look for an adjacent window.
- Measured in characters either horizontally or vertically; setting this
- to a value larger than 1 may be useful in getting around window-
- placement bugs in old versions of Emacs."
- :type 'number
- :group 'windmove)
- (defun windmove-coord-add (coord1 coord2)
- "Add the two coordinates.
- Both COORD1 and COORD2 are coordinate cons pairs, (HPOS . VPOS). The
- result is another coordinate cons pair."
- (cons (+ (car coord1) (car coord2))
- (+ (cdr coord1) (cdr coord2))))
- (defun windmove-constrain-to-range (n min-n max-n)
- "Ensure that N is between MIN-N and MAX-N inclusive by constraining.
- If N is less than MIN-N, return MIN-N; if greater than MAX-N, return
- MAX-N."
- (max min-n (min n max-n)))
- (defun windmove-constrain-around-range (n min-n max-n)
- "Ensure that N is between MIN-N and MAX-N inclusive by wrapping.
- If N is less than MIN-N, return MAX-N; if greater than MAX-N, return
- MIN-N."
- (cond
- ((< n min-n) max-n)
- ((> n max-n) min-n)
- (t n)))
- (defun windmove-frame-edges (window)
- "Return (X-MIN Y-MIN X-MAX Y-MAX) for the frame containing WINDOW.
- If WINDOW is nil, return the edges for the selected frame.
- \(X-MIN, Y-MIN) is the zero-based coordinate of the top-left corner
- of the frame; (X-MAX, Y-MAX) is the zero-based coordinate of the
- bottom-right corner of the frame.
- For example, if a frame has 76 rows and 181 columns, the return value
- from `windmove-frame-edges' will be the list (0 0 180 75)."
- (let* ((frame (if window
- (window-frame window)
- (selected-frame)))
- (top-left (window-edges (frame-first-window frame)))
- (x-min (nth 0 top-left))
- (y-min (nth 1 top-left))
- (x-max (1- (frame-width frame)))
- (y-max (1- (frame-height frame))))
- (list x-min y-min x-max y-max)))
- (defun windmove-constrain-loc-for-movement (coord window dir)
- "Constrain COORD so that it is reasonable for the given movement.
- This involves two things: first, make sure that the \"off\" coordinate
- -- the one not being moved on, e.g., y for horizontal movement -- is
- within frame boundaries; second, if the movement is down and we're not
- moving from the minibuffer, make sure that the y coordinate does not
- exceed the frame max-y, so that we don't overshoot the minibuffer
- accidentally. WINDOW is the window that movement is relative to; DIR
- is the direction of the movement, one of `left', `up', `right',
- or `down'.
- Returns the constrained coordinate."
- (let ((frame-edges (windmove-frame-edges window))
- (in-minibuffer (window-minibuffer-p window)))
- (let ((min-x (nth 0 frame-edges))
- (min-y (nth 1 frame-edges))
- (max-x (nth 2 frame-edges))
- (max-y (nth 3 frame-edges)))
- (let ((new-x
- (if (memq dir '(up down))
- (windmove-constrain-to-range (car coord) min-x max-x)
- (car coord)))
- (new-y
- (if (or (memq dir '(left right))
- (and (eq dir 'down)
- (not in-minibuffer)))
-
-
-
- (windmove-constrain-to-range (cdr coord) min-y max-y)
- (cdr coord))))
- (cons new-x new-y)))))
- (defun windmove-wrap-loc-for-movement (coord window)
- "Takes the constrained COORD and wraps it around for the movement.
- This makes an out-of-range x or y coordinate and wraps it around the
- frame, giving a coordinate (hopefully) in the window on the other edge
- of the frame. WINDOW is the window that movement is relative to (nil
- means the currently selected window). Returns the wrapped coordinate."
- (let* ((frame-edges (windmove-frame-edges window))
- (frame-minibuffer (minibuffer-window (if window
- (window-frame window)
- (selected-frame))))
- (minibuffer-active (minibuffer-window-active-p
- frame-minibuffer)))
- (let ((min-x (nth 0 frame-edges))
- (min-y (nth 1 frame-edges))
- (max-x (nth 2 frame-edges))
- (max-y (if (not minibuffer-active)
- (- (nth 3 frame-edges)
- (window-height frame-minibuffer))
- (nth 3 frame-edges))))
- (cons
- (windmove-constrain-around-range (car coord) min-x max-x)
- (windmove-constrain-around-range (cdr coord) min-y max-y)))))
- (defun windmove-reference-loc (&optional arg window)
- "Return the reference location for directional window selection.
- Return a coordinate (HPOS . VPOS) that is frame-based. If ARG is nil
- or not supplied, the reference point is the buffer's point in the
- currently-selected window, or WINDOW if supplied; otherwise, it is the
- top-left or bottom-right corner of the selected window, or WINDOW if
- supplied, if ARG is greater or smaller than zero, respectively."
- (let ((effective-arg (if (null arg) 0 (prefix-numeric-value arg)))
- (edges (window-inside-edges window)))
- (let ((top-left (cons (nth 0 edges)
- (nth 1 edges)))
-
-
- (bottom-right (cons (- (nth 2 edges) 1)
- (- (nth 3 edges) 1))))
- (cond
- ((> effective-arg 0)
- top-left)
- ((< effective-arg 0)
- bottom-right)
- ((= effective-arg 0)
- (windmove-coord-add
- top-left
-
-
-
- (posn-col-row
- (posn-at-point (window-point window) window))))))))
- (defun windmove-other-window-loc (dir &optional arg window)
- "Return a location in the window to be moved to.
- Return value is a frame-based (HPOS . VPOS) value that should be moved
- to. DIR is one of `left', `up', `right', or `down'; an optional ARG
- is handled as by `windmove-reference-loc'; WINDOW is the window that
- movement is relative to."
- (let ((edges (window-edges window))
- (refpoint (windmove-reference-loc arg window)))
- (cond
- ((eq dir 'left)
- (cons (- (nth 0 edges)
- windmove-window-distance-delta)
- (cdr refpoint)))
- ((eq dir 'up)
- (cons (car refpoint)
- (- (nth 1 edges)
- windmove-window-distance-delta)))
- ((eq dir 'right)
- (cons (+ (1- (nth 2 edges))
- windmove-window-distance-delta)
- (cdr refpoint)))
- ((eq dir 'down)
- (cons (car refpoint)
- (+ (1- (nth 3 edges))
- windmove-window-distance-delta)))
- (t (error "Invalid direction of movement: %s" dir)))))
- (defun windmove-find-other-window (dir &optional arg window)
- "Return the window object in direction DIR.
- DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'."
- (let* ((actual-current-window (or window (selected-window)))
- (raw-other-window-loc
- (windmove-other-window-loc dir arg actual-current-window))
- (constrained-other-window-loc
- (windmove-constrain-loc-for-movement raw-other-window-loc
- actual-current-window
- dir))
- (other-window-loc
- (if windmove-wrap-around
- (windmove-wrap-loc-for-movement constrained-other-window-loc
- actual-current-window)
- constrained-other-window-loc)))
- (window-at (car other-window-loc)
- (cdr other-window-loc))))
- (defun windmove-do-window-select (dir &optional arg window)
- "Move to the window at direction DIR.
- DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'.
- If no window is at direction DIR, an error is signaled."
- (let ((other-window (windmove-find-other-window dir arg window)))
- (cond ((null other-window)
- (error "No window %s from selected window" dir))
- ((and (window-minibuffer-p other-window)
- (not (minibuffer-window-active-p other-window)))
- (error "Minibuffer is inactive"))
- (t
- (select-window other-window)))))
- (defun windmove-left (&optional arg)
- "Select the window to the left of the current one.
- With no prefix argument, or with prefix argument equal to zero,
- \"left\" is relative to the position of point in the window; otherwise
- it is relative to the top edge (for positive ARG) or the bottom edge
- \(for negative ARG) of the current window.
- If no window is at the desired location, an error is signaled."
- (interactive "P")
- (windmove-do-window-select 'left arg))
- (defun windmove-up (&optional arg)
- "Select the window above the current one.
- With no prefix argument, or with prefix argument equal to zero, \"up\"
- is relative to the position of point in the window; otherwise it is
- relative to the left edge (for positive ARG) or the right edge (for
- negative ARG) of the current window.
- If no window is at the desired location, an error is signaled."
- (interactive "P")
- (windmove-do-window-select 'up arg))
- (defun windmove-right (&optional arg)
- "Select the window to the right of the current one.
- With no prefix argument, or with prefix argument equal to zero,
- \"right\" is relative to the position of point in the window;
- otherwise it is relative to the top edge (for positive ARG) or the
- bottom edge (for negative ARG) of the current window.
- If no window is at the desired location, an error is signaled."
- (interactive "P")
- (windmove-do-window-select 'right arg))
- (defun windmove-down (&optional arg)
- "Select the window below the current one.
- With no prefix argument, or with prefix argument equal to zero,
- \"down\" is relative to the position of point in the window; otherwise
- it is relative to the left edge (for positive ARG) or the right edge
- \(for negative ARG) of the current window.
- If no window is at the desired location, an error is signaled."
- (interactive "P")
- (windmove-do-window-select 'down arg))
- (defun windmove-default-keybindings (&optional modifier)
- "Set up keybindings for `windmove'.
- Keybindings are of the form MODIFIER-{left,right,up,down}.
- Default MODIFIER is 'shift."
- (interactive)
- (unless modifier (setq modifier 'shift))
- (global-set-key (vector (list modifier 'left)) 'windmove-left)
- (global-set-key (vector (list modifier 'right)) 'windmove-right)
- (global-set-key (vector (list modifier 'up)) 'windmove-up)
- (global-set-key (vector (list modifier 'down)) 'windmove-down))
- (provide 'windmove)
|