[clfswm-cvs] r86 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri Apr 25 21:45:06 UTC 2008
Author: pbrochard
Date: Fri Apr 25 17:45:03 2008
New Revision: 86
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/config.lisp
clfswm/src/package.lisp
Log:
Managed type: new frame parameter. This allow to choose what window type a frame must handle.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Apr 25 17:45:03 2008
@@ -1,5 +1,18 @@
2008-04-25 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-util.lisp (current-frame-manage-window-type): Let the
+ user choose what window type the current frame must handle.
+ (display-current-window-info): New function.
+ (current-frame-manage-all-window-type)
+ (current-frame-manage-only-normal-window-type)
+ (current-frame-manage-no-window-type): New functions.
+
+ * src/clfswm-internal.lisp (managed-window-p): New function.
+
+ * src/package.lisp (frame): Managed type: new frame
+ parameter. This allow to choose what window type a frame must
+ handle.
+
* src/*.lisp: Rename all 'father' occurrences to 'parent'.
* src/clfswm-nw-hooks.lisp
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Fri Apr 25 17:45:03 2008
@@ -7,7 +7,7 @@
===============
Should handle these soon.
-- Add a frame parameter to choose what window type to handle. [Philippe]
+- Allow to move/resize unmanaged windows [Philippe]
- Move the autodoc in its own file (clfswm-autodoc.lisp) and make the autodoc
for the menu system.
@@ -24,8 +24,6 @@
- Add boundaries in the info window [Philippe]
-- Allow to move/resize transient windows [Philippe]
-
MAYBE
=====
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Fri Apr 25 17:45:03 2008
@@ -89,6 +89,7 @@
(add-menu-key 'frame-menu "o" 'frame-layout-once-menu)
(add-menu-key 'frame-menu "n" 'frame-nw-hook-menu)
(add-sub-menu 'frame-menu "m" 'frame-movement-menu "Frame movement menu")
+(add-sub-menu 'frame-menu "w" 'managed-window-menu "Managed window type menu")
(add-sub-menu 'frame-menu "i" 'frame-info-menu "Frame info menu")
(add-menu-key 'frame-menu "r" 'rename-current-child)
(add-menu-key 'frame-menu "u" 'renumber-current-frame)
@@ -127,17 +128,25 @@
(add-menu-key 'frame-resize-menu #\a 'current-frame-resize-all-dir-minimal)
+(add-menu-key 'managed-window-menu "m" 'current-frame-manage-window-type)
+(add-menu-key 'managed-window-menu "a" 'current-frame-manage-all-window-type)
+(add-menu-key 'managed-window-menu "n" 'current-frame-manage-only-normal-window-type)
+(add-menu-key 'managed-window-menu "u" 'current-frame-manage-no-window-type)
+
+
(add-menu-key 'frame-info-menu "s" 'show-all-frames-info)
(add-menu-key 'frame-info-menu "h" 'hide-all-frames-info)
-(add-menu-key 'window-menu "i" 'force-window-in-frame)
+(add-menu-key 'window-menu "i" 'display-current-window-info)
+(add-menu-key 'window-menu "f" 'force-window-in-frame)
(add-menu-key 'window-menu "c" 'force-window-center-in-frame)
(add-menu-key 'window-menu "a" 'adapt-current-frame-to-window-hints)
(add-menu-key 'window-menu "w" 'adapt-current-frame-to-window-width-hint)
(add-menu-key 'window-menu "h" 'adapt-current-frame-to-window-height-hint)
+
(add-menu-key 'selection-menu "x" 'cut-current-child)
(add-menu-key 'selection-menu "c" 'copy-current-child)
(add-menu-key 'selection-menu "v" 'paste-selection)
@@ -171,6 +180,10 @@
"Open the frame menu"
(open-menu (find-menu 'frame-menu)))
+(defun open-window-menu ()
+ "Open the window menu"
+ (open-menu (find-menu 'window-menu)))
+
(defun open-action-by-name-menu ()
"Open the action by name menu"
(open-menu (find-menu 'action-by-name-menu)))
@@ -182,6 +195,7 @@
(define-second-key ("m") 'open-menu)
(define-second-key ("f") 'open-frame-menu)
+(define-second-key ("w") 'open-window-menu)
(define-second-key ("n") 'open-action-by-name-menu)
(define-second-key ("u") 'open-action-by-number-menu)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Apr 25 17:45:03 2008
@@ -94,6 +94,11 @@
(defsetf frame-data-slot set-frame-data-slot)
+(defun managed-window-p (window frame)
+ "Return t only if window is managed by frame"
+ (or (member :all (frame-managed-type frame))
+ (member (window-type window) (frame-managed-type frame))))
+
@@ -366,7 +371,7 @@
(defmethod adapt-child-to-parent ((window xlib:window) parent)
(with-xlib-protect
- (if (eql (window-type window) :normal)
+ (if (managed-window-p window parent)
(multiple-value-bind (nx ny nw nh raise-p)
(get-parent-layout window parent)
(setf nw (max nw 1) nh (max nh 1))
@@ -767,7 +772,7 @@
(eql win *no-focus-window*))
(when (or (eql map-state :viewable)
(eql wm-state +iconic-state+))
- (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
+ (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win) win)
(unhide-window win)
(process-new-window win)
(xlib:map-window win)
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Fri Apr 25 17:45:03 2008
@@ -54,10 +54,10 @@
(defun get-managed-child (parent)
- "Return only window in normal mode who can be tiled"
+ "Return only the windows that are managed for tiling"
(when (frame-p parent)
(remove-if #'(lambda (x)
- (and (xlib:window-p x) (not (eql (window-type x) :normal))))
+ (and (xlib:window-p x) (not (managed-window-p x parent))))
(frame-child parent))))
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Fri Apr 25 17:45:03 2008
@@ -51,9 +51,9 @@
(defun default-window-placement (frame window)
- (case (window-type window)
- (:normal (adapt-child-to-parent window frame))
- (t (place-window-from-hints window))))
+ (if (managed-window-p window frame)
+ (adapt-child-to-parent window frame)
+ (place-window-from-hints window)))
(defun leave-if-not-frame (child)
"Leave the child if it's not a frame"
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Apr 25 17:45:03 2008
@@ -868,3 +868,51 @@
(defun adapt-current-frame-to-window-height-hint ()
"Adapt the current frame to the current window minimal height hint"
(adapt-current-frame-to-window-hints-generic nil t))
+
+
+
+
+;;; Managed window type functions
+(defun current-frame-manage-window-type ()
+ "Change window types to be managed by a frame"
+ (when (frame-p *current-child*)
+ (let* ((type-str (query-string "Managed window type: (all, normal, transient, maxsize, desktop, dock, toolbar, menu, utility, splash, dialog)"
+ (format nil "~{~:(~A~)~}" (frame-managed-type *current-child*))))
+ (type-list (loop :for type :in (split-string type-str)
+ :collect (intern (string-upcase type) :keyword))))
+ (setf (frame-managed-type *current-child*) type-list)))
+ (leave-second-mode))
+
+
+(defun current-frame-manage-window-type-generic (type-list)
+ (when (frame-p *current-child*)
+ (setf (frame-managed-type *current-child*) type-list))
+ (leave-second-mode))
+
+(defun current-frame-manage-all-window-type ()
+ "Manage all window type"
+ (current-frame-manage-window-type-generic '(:all)))
+
+(defun current-frame-manage-only-normal-window-type ()
+ "Manage only normal window type"
+ (current-frame-manage-window-type-generic '(:normal)))
+
+(defun current-frame-manage-no-window-type ()
+ "Do not manage any window type"
+ (current-frame-manage-window-type-generic nil))
+
+
+
+
+(defun display-current-window-info ()
+ "Display information on the current window"
+ (let ((window (typecase *current-child*
+ (xlib:window *current-child*)
+ (frame (first (frame-child *current-child*))))))
+ (when window
+ (info-mode (list (format nil "Window: ~A" window)
+ (format nil "Window name: ~A" (xlib:wm-name window))
+ (format nil "Window class: ~A" (xlib:get-wm-class window))
+ (format nil "Window type: ~:(~A~)" (window-type window))))))
+ (leave-second-mode))
+
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri Apr 25 17:45:03 2008
@@ -71,10 +71,12 @@
(when (has-bw value-mask)
(setf (xlib:drawable-border-width window) border-width))
(if (find-child window *current-root*)
- (case (window-type window)
- (:normal (adapt-child-to-parent window (find-parent-frame window *current-root*))
- (send-configuration-notify window))
- (t (adjust-from-request)))
+ (let ((parent (find-parent-frame window *current-root*)))
+ (if (and parent (managed-window-p window parent))
+ (progn
+ (adapt-child-to-parent window parent)
+ (send-configuration-notify window))
+ (adjust-from-request)))
(adjust-from-request))
(when (has-stackmode value-mask)
(case stack-mode
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Fri Apr 25 17:45:03 2008
@@ -47,6 +47,7 @@
;; (values 100 100 800 600))
+
;;; Hook definitions
;;;
;;; A hook is a function, a symbol or a list of functions with a rest
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Fri Apr 25 17:45:03 2008
@@ -60,6 +60,15 @@
(defparameter *default-frame-data*
(list '(:tile-size 0.8) '(:tile-space-size 0.1)))
+
+;;; CONFIG - Default managed window type for a frame
+;;; type can be :all, :normal, :transient, :maxsize, :desktop, :dock, :toolbar, :menu, :utility, :splash, :dialog
+(defparameter *default-managed-type* '(:normal))
+;;(defparameter *default-managed-type* '(:normal :maxsize :transient))
+;;(defparameter *default-managed-type* '(:normal :transient :maxsize :desktop :dock :toolbar :menu :utility :splash :dialog))
+;;(defparameter *default-managed-type* '())
+;;(defparameter *default-managed-type* '(:all))
+
(defclass frame ()
((name :initarg :name :accessor frame-name :initform nil)
(number :initarg :number :accessor frame-number :initform 0)
@@ -74,9 +83,13 @@
(ry :initarg :ry :accessor frame-ry :initform 0)
(rw :initarg :rw :accessor frame-rw :initform 800)
(rh :initarg :rh :accessor frame-rh :initform 600)
- (layout :initarg :layout :accessor frame-layout :initform nil)
+ (layout :initarg :layout :accessor frame-layout :initform nil
+ :documentation "Layout to display windows on a frame")
(nw-hook :initarg :nw-hook :accessor frame-nw-hook :initform nil
- :documentation "Hook done by the frame when a new window is mapped")
+ :documentation "Hook done by the frame when a new window is mapped")
+ (managed-type :initarg :managed-type :accessor frame-managed-type
+ :initform *default-managed-type*
+ :documentation "Managed window type")
(window :initarg :window :accessor frame-window :initform nil)
(gc :initarg :gc :accessor frame-gc :initform nil)
(child :initarg :child :accessor frame-child :initform nil)
More information about the clfswm-cvs
mailing list