From b5f124ae09ddb7d47abbb9133fcaebc463662e9f Mon Sep 17 00:00:00 2001 From: szos Date: Mon, 20 Jun 2022 00:42:46 +0200 Subject: [PATCH] change make-instance to make-swm-class-instance change all calls to make-instance to make-swm-class-instance in order to always keep new objects up to date with their relevant minor modes --- group.lisp | 13 ++--- screen.lisp | 115 +++++++++++++++++++++--------------------- window-placement.lisp | 2 +- 3 files changed, 66 insertions(+), 64 deletions(-) diff --git a/group.lisp b/group.lisp index 369d096..a68397b 100644 --- a/group.lisp +++ b/group.lisp @@ -354,12 +354,13 @@ Groups are known as \"virtual desktops\" in the NETWM standard." (defun %ensure-group (group-name group-type screen) "If there is a group named with GROUP-NAME in SCREEN return it, otherwise create it." (or (find-group screen group-name) - (let ((group (make-instance group-type - :screen screen - :number (if (char= (char group-name 0) #\.) - (find-free-hidden-group-number screen) - (find-free-group-number screen)) - :name group-name))) + (let ((group (make-swm-class-instance + group-type + :screen screen + :number (if (char= (char group-name 0) #\.) + (find-free-hidden-group-number screen) + (find-free-group-number screen)) + :name group-name))) (setf (screen-groups screen) (append (screen-groups screen) (list group))) (netwm-set-group-properties screen) (netwm-update-groups screen) diff --git a/screen.lisp b/screen.lisp index 292738d..438fb79 100644 --- a/screen.lisp +++ b/screen.lisp @@ -413,63 +413,64 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK." :border-width 1 :bit-gravity :north-east :event-mask '(:exposure))) - (screen (make-instance 'screen - :id id - :host host - :number screen-number - :border-color border-color - :fg-color fg-color - :bg-color bg-color - :win-bg-color win-bg-color - :focus-color focus-color - :unfocus-color unfocus-color - :float-focus-color float-focus-color - :float-unfocus-color float-unfocus-color - :msg-border-width 1 - :frame-outline-width +default-frame-outline-width+ - :fonts (list font) - :input-window (xlib:create-window - :parent screen-root - :x 0 :y 0 :width 20 :height 20 - :colormap default-colormap - :background bg-color - :border border-color - :border-width 1 - :event-mask '(:key-press :key-release)) - :focus-window (xlib:create-window - :parent screen-root - :x 0 :y 0 :width 1 :height 1) - :key-window (xlib:create-window - :parent screen-root - :x 0 :y 0 :width 1 :height 1 - :event-mask '(:key-press :key-release)) - :frame-window (xlib:create-window - :parent screen-root - :x 0 :y 0 :width 20 :height 20 - :colormap default-colormap - :background bg-color - :border border-color - :border-width 1 - :event-mask '(:exposure)) - :frame-outline-gc (xlib:create-gcontext - :drawable screen-root - :font (when (typep font 'xlib:font) font) - :foreground fg-color - :background fg-color - :line-style :double-dash - :line-width +default-frame-outline-width+) - :message-cc (make-ccontext - :win message-window - :font font - :gc (xlib:create-gcontext - :drawable message-window - :font (when (typep font 'xlib:font) font) - :foreground fg-color - :background bg-color)))) - (group (make-instance 'tile-group - :screen screen - :number 1 - :name *default-group-name*))) + (screen (make-swm-class-instance + 'screen + :id id + :host host + :number screen-number + :border-color border-color + :fg-color fg-color + :bg-color bg-color + :win-bg-color win-bg-color + :focus-color focus-color + :unfocus-color unfocus-color + :float-focus-color float-focus-color + :float-unfocus-color float-unfocus-color + :msg-border-width 1 + :frame-outline-width +default-frame-outline-width+ + :fonts (list font) + :input-window (xlib:create-window + :parent screen-root + :x 0 :y 0 :width 20 :height 20 + :colormap default-colormap + :background bg-color + :border border-color + :border-width 1 + :event-mask '(:key-press :key-release)) + :focus-window (xlib:create-window + :parent screen-root + :x 0 :y 0 :width 1 :height 1) + :key-window (xlib:create-window + :parent screen-root + :x 0 :y 0 :width 1 :height 1 + :event-mask '(:key-press :key-release)) + :frame-window (xlib:create-window + :parent screen-root + :x 0 :y 0 :width 20 :height 20 + :colormap default-colormap + :background bg-color + :border border-color + :border-width 1 + :event-mask '(:exposure)) + :frame-outline-gc (xlib:create-gcontext + :drawable screen-root + :font (when (typep font 'xlib:font) font) + :foreground fg-color + :background fg-color + :line-style :double-dash + :line-width +default-frame-outline-width+) + :message-cc (make-ccontext + :win message-window + :font font + :gc (xlib:create-gcontext + :drawable message-window + :font (when (typep font 'xlib:font) font) + :foreground fg-color + :background bg-color)))) + (group (make-swm-class-instance 'tile-group + :screen screen + :number 1 + :name *default-group-name*))) (setf (screen-groups screen) (list group) (screen-current-group screen) group (ccontext-screen (screen-message-cc screen)) screen diff --git a/window-placement.lisp b/window-placement.lisp index 9188c25..76e2ecb 100644 --- a/window-placement.lisp +++ b/window-placement.lisp @@ -4,7 +4,7 @@ (defun xwin-to-window (xwin) "Build a window for XWIN" - (make-instance 'window + (make-swm-class-instance 'window :xwin xwin :width (xlib:drawable-width xwin) :height (xlib:drawable-height xwin) :x (xlib:drawable-x xwin) :y (xlib:drawable-y xwin)