cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- implemented a new method to move focus between windows (using 'M-arrowkeys').

This commit is contained in:
cage 2021-04-28 16:26:10 +02:00
parent bcb6867a61
commit 8e924ded74
5 changed files with 114 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
etc/init.lisp
View File

@ -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)

9
src/package.lisp
View File

@ -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

12
src/stack.lisp
View File

@ -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))

89
src/ui-goodies.lisp
View File

@ -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))))

2
src/windows.lisp
View File

@ -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)