Update of /project/eclipse/cvsroot/eclipse In directory common-lisp.net:/tmp/cvs-serv22947 Modified Files: wm.lisp package.lisp system.lisp Added Files: rectangles.lisp Log Message: Maximize fill implemented: - new file rectangles.lisp. - maximize-window modified to use the maximize-fill operaion. - new user configuration option: *maximize-fill* We now support the netwm-strut{-partial}, and don't overlap panels that should not be overlapped (gnome panels for exemple) package.lisp, system.lisp updated. Date: Mon Nov 24 11:57:46 2003 Author: ihatchondo Index: eclipse/wm.lisp diff -u eclipse/wm.lisp:1.23 eclipse/wm.lisp:1.24 --- eclipse/wm.lisp:1.23 Wed Nov 19 05:29:08 2003 +++ eclipse/wm.lisp Mon Nov 24 11:57:46 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: wm.lisp,v 1.23 2003/11/19 10:29:08 ihatchondo Exp $ +;;; $Id: wm.lisp,v 1.24 2003/11/24 16:57:46 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -53,34 +53,14 @@ (let ((widget (getf (decoration-children master) label))) (if (and widget window) (widget-window widget) widget))) -(defmethod decoration-min-width ((master decoration)) - (with-slots (hmargin) (decoration-frame-style master) - (+ hmargin (aref (slot-value master 'wm-size-hints) 0)))) -(defmethod decoration-min-height ((master decoration)) - (with-slots (vmargin) (decoration-frame-style master) - (+ vmargin (aref (slot-value master 'wm-size-hints) 1)))) -(defmethod decoration-max-width ((master decoration)) - (with-slots (hmargin) (decoration-frame-style master) - (+ hmargin (aref (slot-value master 'wm-size-hints) 2)))) -(defmethod decoration-max-height ((master decoration)) - (with-slots (vmargin) (decoration-frame-style master) - (+ vmargin (aref (slot-value master 'wm-size-hints) 3)))) -(defmethod decoration-base-width ((master decoration)) - (with-slots (hmargin) (decoration-frame-style master) - (+ hmargin (aref (slot-value master 'wm-size-hints) 6)))) -(defmethod decoration-base-height ((master decoration)) - (with-slots (vmargin) (decoration-frame-style master) - (+ vmargin (aref (slot-value master 'wm-size-hints) 7)))) -(defmethod decoration-inc-sizes ((master decoration)) - (with-slots (wm-size-hints) master - (values (aref wm-size-hints 4) (aref wm-size-hints 5)))) - (defmethod decoration-wm-hints ((master decoration)) - (with-slots (wm-size-hints) master - (values (decoration-min-width master) (decoration-min-height master) - (decoration-max-width master) (decoration-max-height master) - (aref wm-size-hints 4) (aref wm-size-hints 5) - (decoration-base-width master) (decoration-base-height master)))) + "return as a multiple value: minw minh maxw maxh incw inch basew baseh." + (with-slots (frame-style (wmsh wm-size-hints)) master + (with-slots ((hm hmargin) (vm vmargin)) frame-style + (values (+ hm (aref wmsh 0)) (+ vm (aref wmsh 1)) + (+ hm (aref wmsh 2)) (+ vm (aref wmsh 3)) + (aref wmsh 4) (aref wmsh 5) + (+ hm (aref wmsh 6)) (+ vm (aref wmsh 7)))))) (defmethod focused-p ((master decoration)) (focused-p (get-child master :application))) @@ -431,57 +411,80 @@ (when map (xlib:map-window window)) master)) -(defun maximize-window (application button-code) +(defun find-max-geometry (application direction fill-p &key x y w h) + (multiple-value-bind (ulx uly lrx lry) + (find-largest-empty-area + application + :area-include-me-p (or (/= 1 direction) fill-p) + :panels-only-p (not fill-p) + :direction (case direction (2 :vertical) (3 :horizontal) (t :both))) + (with-slots (window master) application + (with-slots ((hm hmargin) (vm vmargin)) + (if master (decoration-frame-style master) + (theme-default-style (lookup-theme "no-decoration"))) + (symbol-macrolet ((minw (aref wmsh 0)) (minh (aref wmsh 1)) + (maxw (aref wmsh 2)) (maxh (aref wmsh 3)) + (incw (aref wmsh 4)) (inch (aref wmsh 5)) + (basew (aref wmsh 6)) (baseh (aref wmsh 7))) + (let* ((wmsh (recompute-wm-normal-hints window hm vm)) + (ww (or w (check-size (- lrx ulx hm) basew incw minw maxw))) + (hh (or h (check-size (- lry uly vm) baseh inch minh maxh)))) + (when (> (+ ww hm) (- lrx ulx)) (decf ww incw)) + (when (> (+ hh vm) (- lry uly)) (decf hh inch)) + (make-geometry :w ww :h hh :x (or x ulx) :y (or y uly)))))))) + +(defun compute-max-geometry + (application x y w h direction fill-p vert-p horz-p) + (symbol-macrolet + ((ix (geometry-x initial-geometry)) (iy (geometry-y initial-geometry)) + (iw (geometry-w initial-geometry)) (ih (geometry-h initial-geometry))) + (with-slots (initial-geometry) application + (case direction + ;; Unmaximize or Maximize in both directions + (1 (if (or horz-p vert-p) + (copy-geometry initial-geometry) + (find-max-geometry application direction fill-p))) + ;; Unmaximize or Maximize Vertically + (2 (if vert-p + (make-geometry :x x :y iy :w w :h ih) + (find-max-geometry application direction fill-p :x x :w w))) + ;; Unmaximize or Maximize Horizontally + (3 (if horz-p + (make-geometry :x ix :y y :w iw :h h) + (find-max-geometry application direction fill-p :y y :h h))))))) + +(defun maximize-window (application code &key (fill-p *maximize-fill*)) (with-slots ((app-window window) initial-geometry full-geometry master) application (when (shaded-p master) (shade master)) - (let* ((new-sizes) + (let* ((new-g) (m-window (if master (widget-window master) app-window)) (prop (netwm:net-wm-state app-window)) (fullscreen-p (member :_net_wm_state_fullscreen prop)) - (vert-p (member :_net_wm_state_maximized_vert prop)) - (horz-p (member :_net_wm_state_maximized_horz prop)) - (wm-size-hints (if master - (slot-value master 'wm-size-hints) - (recompute-wm-normal-hints app-window 0 0)))) + (vert-p (car (member :_net_wm_state_maximized_vert prop))) + (horz-p (car (member :_net_wm_state_maximized_horz prop)))) (multiple-value-bind (x y) (window-position m-window) (multiple-value-bind (w h) (drawable-sizes app-window) (unless (or horz-p vert-p) (if fullscreen-p (setf initial-geometry (copy-geometry full-geometry)) (setf (geometry initial-geometry) (values x y w h)))) - (symbol-macrolet ((ix (geometry-x initial-geometry)) - (iy (geometry-y initial-geometry)) - (iw (geometry-w initial-geometry)) - (ih (geometry-h initial-geometry)) - (maxw (aref wm-size-hints 2)) - (maxh (aref wm-size-hints 3))) - (case button-code - ;; Unmaximize or Maximize in both directions - (1 (if (or horz-p vert-p) - (setf new-sizes (copy-geometry initial-geometry) - horz-p t vert-p t) - (setf new-sizes (make-geometry :w maxw :h maxh)))) - ;; Unmaximize or Maximize Vertically - (2 (if vert-p - (setf new-sizes (make-geometry :x x :y iy :w w :h ih)) - (setf new-sizes (make-geometry :x x :w w :h maxh)))) - ;; Unmaximize or Maximize Horizontally - (3 (if horz-p - (setf new-sizes (make-geometry :x ix :y y :w iw :h h)) - (setf new-sizes (make-geometry :y y :w maxw :h h)))))))) - (unless (= 3 button-code) + (setf new-g (compute-max-geometry + application x y w h code fill-p vert-p horz-p)))) + (when (and (= 1 code) (or horz-p vert-p)) + (setf (values horz-p vert-p) (values t t))) + (unless (= 3 code) (if vert-p (setf prop (delete :_net_wm_state_maximized_vert prop)) (pushnew :_net_wm_state_maximized_vert prop))) - (unless (= 2 button-code) + (unless (= 2 code) (if horz-p (setf prop (delete :_net_wm_state_maximized_horz prop)) (pushnew :_net_wm_state_maximized_horz prop))) (if fullscreen-p - (setf full-geometry new-sizes) - (setf (window-position m-window) (geometry-coordinates new-sizes) - (drawable-sizes app-window) (geometry-sizes new-sizes))) + (setf full-geometry new-g) + (setf (window-position m-window) (geometry-coordinates new-g) + (drawable-sizes app-window) (geometry-sizes new-g))) (setf (netwm:net-wm-state app-window) prop)))) ;;;; Focus management. According to ICCCM Index: eclipse/package.lisp diff -u eclipse/package.lisp:1.10 eclipse/package.lisp:1.11 --- eclipse/package.lisp:1.10 Thu Oct 9 07:40:38 2003 +++ eclipse/package.lisp Mon Nov 24 11:57:46 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: User -*- -;;; $Id: package.lisp,v 1.10 2003/10/09 11:40:38 ihatchondo Exp $ +;;; $Id: package.lisp,v 1.11 2003/11/24 16:57:46 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2002 Iban HATCHONDO @@ -235,15 +235,8 @@ "CLOSE-WIDGET" ;generic function "DECORATION-ACTIVE-P" ;generic function "DECORATION-APPLICATION-GRAVITY" ;generic function - "DECORATION-BASE-HEIGHT" ;generic function - "DECORATION-BASE-WIDTH" ;generic function "DECORATION-CHILDREN" ;generic function "DECORATION-FRAME-STYLE" ;generic function - "DECORATION-INC-SIZES" ;generic function - "DECORATION-MAX-HEIGHT" ;generic function - "DECORATION-MAX-WIDTH" ;generic function - "DECORATION-MIN-HEIGHT" ;generic function - "DECORATION-MIN-WIDTH" ;generic function "DECORATION-PRECEDENT-TIME" ;generic function "DECORATION-WM-HINTS" ;generic function "DECORATION-WM-SIZE-HINTS" ;generic function @@ -352,16 +345,21 @@ ;; user custom. "*CHANGE-DESKTOP-MESSAGE-ACTIVE-P*" ;variable "*CLOSE-DISPLAY-P*" ;variable + "*CYCLE-ICONS-P*" ;variable "*DOUBLE-CLICK-SPEED*" ;variable "*FOCUS-TYPE*" ;variable "*FOCUS-NEW-MAPPED-WINDOW*" ;variable "*FOCUS-WHEN-WINDOW-CYCLE*" ;variable "*ICON-BOX-SORT-FUNCTION*" ;variable "*ICON-HINTS*" ;variable + "*MAXIMIZE-FILL*" ;variable "*MENU-1-ITEMS*" ;variable "*MOVE-MODE*" ;variable "*RESIZE-MODE*" ;variable + "*SCREEN-EDGE-RESISTANT-P*" ;variable + "*STANDARD-WINDOW-EDGE-RESISTANT-P*" ;variable "*VERBOSE-MOVE*" ;variable "*VERBOSE-RESIZE*" ;variable + "*VERBOSE-WINDOW-CYCLING*" ;variable "*WARP-POINTER-WHEN-CYCLE*" ;variable )) Index: eclipse/system.lisp diff -u eclipse/system.lisp:1.7 eclipse/system.lisp:1.8 --- eclipse/system.lisp:1.7 Mon Nov 10 05:02:53 2003 +++ eclipse/system.lisp Mon Nov 24 11:57:46 2003 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: User -*- -;;; $Id: system.lisp,v 1.7 2003/11/10 10:02:53 ihatchondo Exp $ +;;; $Id: system.lisp,v 1.8 2003/11/24 16:57:46 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -72,6 +72,7 @@ "gestures" "widgets" "virtual-screen" + "rectangles" "wm" "input" "move-resize"