diff options
| -rw-r--r-- | core.lisp | 20 | ||||
| -rw-r--r-- | events.lisp | 8 | ||||
| -rw-r--r-- | floating-group.lisp | 30 | ||||
| -rw-r--r-- | group.lisp | 12 | ||||
| -rw-r--r-- | primitives.lisp | 30 | ||||
| -rw-r--r-- | window.lisp | 24 |
6 files changed, 101 insertions, 23 deletions
@@ -25,8 +25,26 @@ (in-package :stumpwm) -;;; keyboard helper functions +(export '(grab-pointer ungrab-pointer)) + +;; Wow, is there an easier way to do this? +(defmacro def-thing-attr-macro (thing hash-slot) + (let ((attr (gensym "ATTR")) + (obj (gensym "METAOBJ")) + (val (gensym "METAVAL"))) + `(defmacro ,(intern1 (format nil "DEF-~a-ATTR" thing)) (,attr) + "Create a new attribute and corresponding get/set functions." + (let ((,obj (gensym "OBJ")) + (,val (gensym "VAL"))) + `(progn + (defun ,(intern1 (format nil ,(format nil "~a-~~a" thing) ,attr)) (,,obj) + (gethash ,,attr (,(quote ,hash-slot) ,,obj))) + (defun (setf ,(intern1 (format nil ,(format nil "~a-~~a" thing) ,attr))) (,,val ,,obj) + (setf (gethash ,,attr (,(quote ,hash-slot) ,,obj))) ,,val)))))) + + +;;; keyboard helper functions (defun key-to-keycode+state (key) (let ((code (xlib:keysym->keycodes *display* (key-keysym key)))) (cond ((eq (xlib:keycode->keysym *display* code 0) (key-keysym key)) diff --git a/events.lisp b/events.lisp index 4789a60..67ac9da 100644 --- a/events.lisp +++ b/events.lisp @@ -73,14 +73,6 @@ (when (has-bw value-mask) (setf (xlib:drawable-border-width xwin) border-width))))) -(defun update-configuration (win) - ;; Send a synthetic configure-notify event so that the window - ;; knows where it is onscreen. - (xwin-send-configuration-notify (window-xwin win) - (xlib:drawable-x (window-parent win)) - (xlib:drawable-y (window-parent win)) - (window-width win) (window-height win) 0)) - (define-stump-event-handler :configure-request (stack-mode #|parent|# window #|above-sibling|# x y width height border-width value-mask) (labels ((has-x () (= 1 (logand value-mask 1))) (has-y () (= 2 (logand value-mask 2))) diff --git a/floating-group.lisp b/floating-group.lisp index 027a341..d2b0d81 100644 --- a/floating-group.lisp +++ b/floating-group.lisp @@ -1,6 +1,8 @@ ;;; implementation of a floating style window management group +(defpackage #:stumpwm.floating-group + (:use :cl :stumpwm)) -(in-package :stumpwm) +(in-package :stumpwm.floating-group) ;;; floating window @@ -34,7 +36,9 @@ (defun float-window-move-resize (win &key x y width height (border *float-window-border*)) ;; x and y position the parent window while width, height resize the ;; xwin (meaning the parent will have a larger width). - (with-slots (xwin parent) win + (with-accessors ((xwin window-xwin) + (parent window-parent)) + win (xlib:with-state (parent) (xlib:with-state (xwin) (when x @@ -89,10 +93,19 @@ (eql (window-state win) +normal-state+)) (defmethod (setf window-fullscreen) :after (val (window float-window)) - (with-slots (last-x last-y last-width last-height parent) window + (with-accessors ((last-x float-window-last-x) + (last-y float-window-last-y) + (last-width float-window-last-width) + (last-height float-window-last-height) + (parent window-parent)) + window (if val (let ((head (window-head window))) - (with-slots (x y width height) window + (with-accessors ((x window-x) + (y window-y) + (width window-width) + (height window-height)) + window (format t "major on: ~a ~a ~a ~a~%" x y width height)) (set-window-geometry window :x 0 :y 0) (float-window-move-resize window @@ -150,7 +163,11 @@ (first (screen-heads (group-screen group))))) (defun float-window-align (window) - (with-slots (parent xwin width height) window + (with-accessors ((parent window-parent) + (xwin window-xwin) + (width window-width) + (height window-height)) + window (set-window-geometry window :x *float-window-border* :y *float-window-title-height*) (xlib:with-state (parent) (setf (xlib:drawable-width parent) (+ width (* 2 *float-window-border*)) @@ -229,7 +246,8 @@ (case event-key (:button-release :done) (:motion-notify - (with-slots (parent) window + (with-accessors ((parent window-parent)) + window (xlib:with-state (parent) ;; Either move or resize the window (cond @@ -24,7 +24,17 @@ (in-package #:stumpwm) -(export '(current-group group-windows move-window-to-group)) +(export '(current-group group-windows move-window-to-group add-group + ;; Group accessors + group group-screen group-windows group-number group-name + ;; Group API + group-startup group-add-window group-delete-window group-wake-up + group-suspend group-current-window group-current-head + group-resize-request group-move-request group-raise-request + group-lost-focus group-indicate-focus group-focus-window + group-button-press group-root-exposure group-add-head + group-remove-head group-resize-head group-sync-all-heads + group-sync-head)) (defvar *default-group-type* 'tile-group "The type of group that should be created by default.") diff --git a/primitives.lisp b/primitives.lisp index fc086c0..631216b 100644 --- a/primitives.lisp +++ b/primitives.lisp @@ -133,7 +133,35 @@ with-restarts-menu with-data-file move-to-head - format-expand)) + format-expand + + ;; Frame accessors + frame-x + frame-y + frame-width + frame-height + + ;; Screen accessors + screen-heads + screen-root + screen-focus + screen-float-focus-color + screen-float-unfocus-color + + ;; Window states + +withdrawn-state+ + +normal-state+ + +iconic-state+ + + ;; Modifiers + modifiers + modifiers-p + modifiers-alt + modifiers-altgr + modifiers-super + modifiers-meta + modifiers-hyper + modifiers-numlock)) ;;; Message Timer diff --git a/window.lisp b/window.lisp index 77d800a..231bba9 100644 --- a/window.lisp +++ b/window.lisp @@ -32,12 +32,16 @@ set-window-geometry)) (export - '( - window-xwin window-width window-height window-x window-y window-gravity - window-group window-number window-parent window-title window-user-title - window-class window-type window-res window-role window-unmap-ignores - window-state window-normal-hints window-marked window-plist - window-fullscreen)) + '(window window-xwin window-width window-height window-x window-y + window-gravity window-group window-number window-parent window-title + window-user-title window-class window-type window-res window-role + window-unmap-ignores window-state window-normal-hints window-marked + window-plist window-fullscreen window-screen + ;; Window utilities + update-configuration no-focus + ;; Window management API + update-decoration focus-window raise-window window-visible-p window-sync + window-head)) (defvar *default-window-name* "Unnamed" "The name given to a window that does not supply its own name.") @@ -334,6 +338,14 @@ _NET_WM_STATE_DEMANDS_ATTENTION set" (xwin-net-wm-name win) (xlib:wm-name win)))) +(defun update-configuration (win) + ;; Send a synthetic configure-notify event so that the window + ;; knows where it is onscreen. + (xwin-send-configuration-notify (window-xwin win) + (xlib:drawable-x (window-parent win)) + (xlib:drawable-y (window-parent win)) + (window-width win) (window-height win) 0)) + (defun window-fullscreen-locked-p (win) (let* ((xwin (window-xwin win)) (hints (xlib:wm-normal-hints xwin))) |