diff --git a/etc/init.lisp b/etc/init.lisp index 24c9d47..db76f0f 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -149,6 +149,14 @@ (define-key "M-g s r" #'gemlog-refresh-all) +(define-key "M-right" #'pass-focus-on-right) + +(define-key "M-left" #'pass-focus-on-left) + +(define-key "M-down" #'pass-focus-on-bottom) + +(define-key "M-up" #'pass-focus-on-top) + ;; focus (define-key "f1" #'focus-to-tags-window) diff --git a/src/package.lisp b/src/package.lisp index 0be3ea8..d334f3b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -632,7 +632,8 @@ :stack-pop :stack-find :stack-empty-p - :stack-remove + :stack-remove-element + :stack-select :stack-position :stack-raise-to-top :stack-empty-p @@ -2468,7 +2469,11 @@ :gemlog-refresh-all :gemlog-cancel-subscription :send-to-pipe - :send-message-to-pipe)) + :send-message-to-pipe + :pass-focus-on-left + :pass-focus-on-right + :pass-focus-on-bottom + :pass-focus-on-top)) (defpackage :scheduled-events (:use diff --git a/src/stack.lisp b/src/stack.lisp index 1c84786..9939582 100644 --- a/src/stack.lisp +++ b/src/stack.lisp @@ -38,7 +38,9 @@ (defgeneric stack-pop (object)) -(defgeneric stack-remove (object val)) +(defgeneric stack-remove-element (object val)) + +(defgeneric stack-select (object predicate)) (defgeneric stack-find (object val)) @@ -79,15 +81,19 @@ (defmethod stack-raise-to-top ((object stack) val) (with-accessors ((container container)) object - (stack-remove object val) + (stack-remove-element object val) (stack-push object val))) -(defmethod stack-remove ((object stack) val) +(defmethod stack-remove-element ((object stack) val) (with-accessors ((container container)) object (when-let ((val-position (stack-position object val))) (setf container (misc:safe-delete@ container val-position))) object)) +(defmethod stack-select ((object stack) predicate) + (with-accessors ((container container)) object + (remove-if-not predicate container))) + (defmacro do-stack-element ((element stack) &body body) `(loop for ,element in (reverse (container ,stack)) do ,@body)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index a5957ce..4a28748 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -374,6 +374,11 @@ Metadata includes: (when info-change-focus-message (info-message info-change-focus-message +maximum-event-priority+))) +(defun remove-focus-to-all-windows () + (stack:do-stack-element (window windows::*window-stack*) + (when (typep window 'main-window::focus-marked-window) + (setf (windows:in-focus window) nil)))) + (defmacro gen-focus-to-window (function-suffix window-get-focus &key (info-change-focus-message (_ "Focus changed")) @@ -1904,3 +1909,87 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (send-to-pipe-on-input-complete command message))) (ask-string-input #'on-input-complete :prompt (format nil (_ "Send message to command: ")))))) + +(defun pass-focus (all-adjacent-win-fn intersecting-fn sort-predicate) + (let* ((window (main-window:focused-window *main-window*)) + (all-adjacent-win (stack:stack-select windows::*window-stack* + all-adjacent-win-fn)) + (to-intersecting-win (remove-if-not intersecting-fn + all-adjacent-win)) + (intersect-sorted (sort to-intersecting-win + sort-predicate))) + (setf intersect-sorted + (remove window intersect-sorted)) + (setf intersect-sorted + (remove-if-not (lambda(a) (typep a 'main-window::focus-marked-window)) + intersect-sorted)) + (when intersect-sorted + (remove-focus-to-all-windows) + (give-focus (first-elt intersect-sorted) nil)))) + +(defun pass-focus-on-right () + "Pass the focus on the window placed on the right of the window that +current has focus" + (let* ((window (main-window:focused-window *main-window*)) + (x-focused (win-x window)) + (y-focused (win-y window)) + (w-focused (win-width window))) + (labels ((all-adjacent-fn (w) + (>= (win-x w) + (+ x-focused + w-focused))) + (intersect-fn (w) + (<= (win-y w) + y-focused + (+ (win-y w) (win-height w)))) + (sort-predicate (a b) + (< (win-y a) (win-y b)))) + (pass-focus #'all-adjacent-fn #'intersect-fn #'sort-predicate)))) + +(defun pass-focus-on-left () + "Pass the focus on the window placed on the left of the window that current has focus" + (let* ((window (main-window:focused-window *main-window*)) + (x-focused (win-x window)) + (y-focused (win-y window))) + (labels ((all-adjacent-fn (w) + (< (win-x w) + x-focused)) + (intersect-fn (w) + (<= (win-y w) + y-focused + (+ (win-y w) (win-height w)))) + (sort-predicate (a b) + (< (win-y a) (win-y b)))) + (pass-focus #'all-adjacent-fn #'intersect-fn #'sort-predicate)))) + +(defun pass-focus-on-bottom () + "Pass the focus on the window placed below the window that current has focus" + (let* ((window (main-window:focused-window *main-window*)) + (x-focused (win-x window)) + (y-focused (win-y window))) + (labels ((all-adjacent-fn (w) + (> (win-y w) + y-focused)) + (intersect-fn (w) + (<= (win-x w) + x-focused + (+ (win-x w) (win-width w)))) + (sort-predicate (a b) + (> (win-x a) (win-x b)))) + (pass-focus #'all-adjacent-fn #'intersect-fn #'sort-predicate)))) + +(defun pass-focus-on-top () + "Pass the focus on the window placed above the window that current has focus" + (let* ((window (main-window:focused-window *main-window*)) + (x-focused (win-x window)) + (y-focused (win-y window))) + (labels ((all-adjacent-fn (w) + (< (win-y w) + y-focused)) + (intersect-fn (w) + (<= (win-x w) + x-focused + (+ (win-x w) (win-width w)))) + (sort-predicate (a b) + (> (win-x a) (win-x b)))) + (pass-focus #'all-adjacent-fn #'intersect-fn #'sort-predicate)))) diff --git a/src/windows.lisp b/src/windows.lisp index f3a996e..f533aa7 100644 --- a/src/windows.lisp +++ b/src/windows.lisp @@ -141,7 +141,7 @@ height, position and so on)" (defun win-close (window) (with-croatoan-window (croatoan-window window) - (stack-remove *window-stack* window) + (stack-remove-element *window-stack* window) (close croatoan-window))) (defun win-raise-to-top (window)