[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Wed Feb 27 22:34:55 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv12961
Modified Files:
ChangeLog bindings-second-mode.lisp clfswm-internal.lisp
clfswm-layout.lisp clfswm-util.lisp clfswm.lisp config.lisp
Log Message:
Add a raise-p parameter for each layout
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2008/02/26 22:02:02 1.16
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2008/02/27 22:34:55 1.17
@@ -1,3 +1,8 @@
+2008-02-27 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-layout.lisp (*-layout): Add an optional raise-p
+ parameter in each layout.
+
2008-02-26 Philippe Brochard <hocwp at free.fr>
* clfswm-util.lisp (copy/cut-current-child): Does not affect the
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/26 22:02:02 1.13
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/27 22:34:55 1.14
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 26 22:41:08 2008
+;;; #Date#: Wed Feb 27 21:08:44 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -87,6 +87,7 @@
(defun action-by-name-menu ()
"Actions by name menu"
(info-mode-menu '((#\f focus-group-by-name)
+ (#\o open-group-by-name)
(#\d delete-group-by-name)
(#\m move-current-child-by-name)
(#\c copy-current-child-by-name))))
@@ -94,6 +95,7 @@
(defun action-by-number-menu ()
"Actions by number menu"
(info-mode-menu '((#\f focus-group-by-number)
+ (#\o open-group-by-number)
(#\d delete-group-by-number)
(#\m move-current-child-by-number)
(#\c copy-current-child-by-number))))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/26 22:02:02 1.15
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/27 22:34:55 1.16
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 26 22:49:18 2008
+;;; #Date#: Wed Feb 27 22:23:42 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -74,6 +74,7 @@
(group-name child))
(defmethod child-name (child)
+ (declare (ignore child))
"???")
@@ -242,13 +243,14 @@
(xlib:with-gcontext (gc :foreground (get-color (if (and (equal group *current-root*)
(equal group *current-child*))
"Red" "Green")))
- (xlib:draw-glyphs window gc 5 dy
- (format nil "Group: ~A~A" number
- (if name (format nil " - ~A" name) "")))
+ (xlib:draw-image-glyphs window gc 5 dy
+ (format nil "Group: ~A~A "
+ number
+ (if name (format nil " - ~A" name) "")))
(let ((pos dy))
(when (equal group *current-root*)
(xlib:draw-image-glyphs window gc 5 (incf pos dy)
- (format nil "~A hidden windows " (length (get-hidden-windows))))
+ (format nil "~A hidden windows " (length (get-hidden-windows))))
(when *child-selection*
(xlib:draw-image-glyphs window gc 5 (incf pos dy)
(with-output-to-string (str)
@@ -284,23 +286,25 @@
(defmethod adapt-child-to-father ((window xlib:window) father)
(with-xlib-protect
- (multiple-value-bind (nx ny nw nh)
+ (multiple-value-bind (nx ny nw nh raise-p)
(get-father-layout window father)
(setf (xlib:drawable-x window) nx
(xlib:drawable-y window) ny
(xlib:drawable-width window) nw
- (xlib:drawable-height window) nh))))
+ (xlib:drawable-height window) nh)
+ raise-p)))
(defmethod adapt-child-to-father ((group group) father)
(with-xlib-protect
- (multiple-value-bind (nx ny nw nh)
+ (multiple-value-bind (nx ny nw nh raise-p)
(get-father-layout group father)
(with-slots (rx ry rw rh window) group
(setf rx nx ry ny rw nw rh nh)
(setf (xlib:drawable-x window) rx
(xlib:drawable-y window) ry
(xlib:drawable-width window) rw
- (xlib:drawable-height window) rh)))))
+ (xlib:drawable-height window) rh)
+ raise-p))))
@@ -310,12 +314,13 @@
(defmethod show-child ((group group) father)
(with-xlib-protect
(with-slots (window) group
- (adapt-child-to-father group father)
- (when (or *show-root-group-p* (not (equal group *current-root*)))
- (setf (xlib:window-background window) (get-color "Black"))
- (xlib:map-window window)
- (raise-window window)
- (display-group-info group)))))
+ (let ((raise-p (adapt-child-to-father group father)))
+ (when (or *show-root-group-p* (not (equal group *current-root*)))
+ (setf (xlib:window-background window) (get-color "Black"))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window))
+ (display-group-info group))))))
(defmethod hide-child ((group group))
@@ -326,10 +331,12 @@
(defmethod show-child ((window xlib:window) father)
(with-xlib-protect
- (when (eql (window-type window) :normal)
- (adapt-child-to-father window father))
- (xlib:map-window window)
- (raise-window window)))
+ (let ((raise-p nil))
+ (when (eql (window-type window) :normal)
+ (setf raise-p (adapt-child-to-father window father)))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window)))))
(defmethod hide-child ((window xlib:window))
(hide-window window))
@@ -625,8 +632,8 @@
(eql win *no-focus-window*))
(when (or (eql map-state :viewable)
(eql wm-state +iconic-state+))
- (format t "Processing ~S ~S~%" (xlib:wm-name win) win)
- (unhide-window 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)
(push (xlib:window-id win) id-list)))))
--- /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp 2008/02/24 20:53:37 1.1
+++ /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp 2008/02/27 22:34:55 1.2
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Feb 22 21:34:48 2008
+;;; #Date#: Wed Feb 27 22:19:57 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Layout functions
@@ -32,7 +32,7 @@
;;;
;;; To add a new layout:
;;; 1- define your own layout: a method returning the real size of the
-;;; child in screen size (integer) as 4 values (rx, ry, rw, rh).
+;;; child in screen size (integer) as 5 values (rx, ry, rw, rh, raise-p).
;;; This method can use the float size of the child (x, y ,w , h).
;;; It can be specialised for xlib:window or group
;;; 2- Define a seter function for your layout
@@ -62,21 +62,21 @@
;;; No layout
-(defgeneric no-layout (child father))
+(defgeneric no-layout (child father)
+ (:documentation "Maximize windows in there group - leave group to there size"))
(defmethod no-layout ((child xlib:window) father)
- "Maximize windows in there group - leave group to there size"
(with-slots (rx ry rw rh) father
- (values (1+ rx) (1+ ry) (- rw 2) (- rh 2))))
+ (values (1+ rx) (1+ ry) (- rw 2) (- rh 2) nil)))
(defmethod no-layout ((child group) father)
- "Maximize windows in there group - leave group to there size"
(with-slots ((cx x) (cy y) (cw w) (ch h)) child
(with-slots ((frx rx) (fry ry) (frw rw) (frh rh)) father
(values (round (+ (* cx frw) frx))
(round (+ (* cy frh) fry))
(round (* cw frw))
- (round (* ch frh))))))
+ (round (* ch frh))
+ t))))
(defun set-no-layout ()
"Maximize windows in there group - leave group to there size"
@@ -88,10 +88,10 @@
;;; Tile layout
-(defgeneric tile-layout (child father))
+(defgeneric tile-layout (child father)
+ (:documentation "Tile child in its group"))
(defmethod tile-layout (child father)
- "Tile child in its group"
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
(len (length managed-childs))
@@ -101,7 +101,8 @@
(values (round (+ (group-rx father) (truncate (* (mod pos n) dx)) 1))
(round (+ (group-ry father) (truncate (* (truncate (/ pos n)) dy)) 1))
(round (- dx 2))
- (round (- dy 2)))))
+ (round (- dy 2))
+ nil)))
(defun set-tile-layout ()
"Tile child in its group"
@@ -120,10 +121,10 @@
-(defgeneric tile-left-layout (child father))
+(defgeneric tile-left-layout (child father)
+ (:documentation "Tile Left: main child on left and others on right"))
(defmethod tile-left-layout (child father)
- "Tile Left: main child on left and others on right"
(with-slots (rx ry rw rh) father
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
@@ -134,11 +135,13 @@
(values (1+ rx)
(1+ ry)
(- (round (* rw size)) 2)
- (- rh 2))
+ (- rh 2)
+ nil)
(values (1+ (round (+ rx (* rw size))))
(1+ (round (+ ry (* dy (1- pos)))))
(- (round (* rw (- 1 size))) 2)
- (- (round dy) 2))))))
+ (- (round dy) 2)
+ nil)))))
(defun set-tile-left-layout ()
@@ -151,10 +154,10 @@
;;; Tile right
-(defgeneric tile-right-layout (child father))
+(defgeneric tile-right-layout (child father)
+ (:documentation "Tile Right: main child on right and others on left"))
(defmethod tile-right-layout (child father)
- "Tile Right: main child on right and others on left"
(with-slots (rx ry rw rh) father
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
@@ -165,12 +168,13 @@
(values (1+ (round (+ rx (* rw (- 1 size)))))
(1+ ry)
(- (round (* rw size)) 2)
- (- rh 2))
+ (- rh 2)
+ nil)
(values (1+ rx)
(1+ (round (+ ry (* dy (1- pos)))))
(- (round (* rw (- 1 size))) 2)
- (- (round dy) 2))))))
-
+ (- (round dy) 2)
+ nil)))))
(defun set-tile-right-layout ()
@@ -185,10 +189,10 @@
;;; Tile Top
-(defgeneric tile-top-layout (child father))
+(defgeneric tile-top-layout (child father)
+ (:documentation "Tile Top: main child on top and others on bottom"))
(defmethod tile-top-layout (child father)
- "Tile Top: main child on top and others on bottom"
(with-slots (rx ry rw rh) father
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
@@ -199,11 +203,13 @@
(values (1+ rx)
(1+ ry)
(- rw 2)
- (- (round (* rh size)) 2))
+ (- (round (* rh size)) 2)
+ nil)
(values (1+ (round (+ rx (* dx (1- pos)))))
(1+ (round (+ ry (* rh size))))
(- (round dx) 2)
- (- (round (* rh (- 1 size))) 2))))))
+ (- (round (* rh (- 1 size))) 2)
+ nil)))))
(defun set-tile-top-layout ()
@@ -216,10 +222,10 @@
;;; Tile Bottom
-(defgeneric tile-bottom-layout (child father))
+(defgeneric tile-bottom-layout (child father)
+ (:documentation "Tile Bottom: main child on bottom and others on top"))
(defmethod tile-bottom-layout (child father)
- "Tile Bottom: main child on bottom and others on top"
(with-slots (rx ry rw rh) father
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
@@ -251,10 +257,10 @@
;;; Space layout
-(defgeneric tile-space-layout (child father))
+(defgeneric tile-space-layout (child father)
+ (:documentation "Tile Space: tile child in its group leaving spaces between them"))
(defmethod tile-space-layout (child father)
- "Tile Space: tile child in its group leaving spaces between them"
(with-slots (rx ry rw rh) father
(let* ((managed-childs (get-managed-child father))
(pos (position child managed-childs))
@@ -267,7 +273,8 @@
(values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
(round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
(round (- dx (* dx size 2) 2))
- (round (- dy (* dy size 2) 2))))))
+ (round (- dy (* dy size 2) 2))
+ nil))))
(defun set-space-tile-layout ()
"Tile Space: tile child in its group leaving spaces between them"
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/26 22:02:02 1.12
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/27 22:34:55 1.13
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 26 22:57:45 2008
+;;; #Date#: Wed Feb 27 21:09:58 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -451,7 +451,8 @@
(defun focus-group-by (group)
(when (group-p group)
(focus-all-child group (or (find-father-group group *current-root*)
- (find-father-group group)))))
+ (find-father-group group)
+ *root-group*))))
(defun focus-group-by-name ()
@@ -465,6 +466,23 @@
(leave-second-mode))
+;;; Open by functions
+(defun open-group-by (group)
+ (when (group-p group)
+ (push (create-group :name (query-string "Group name")) (group-child group))))
+
+
+
+(defun open-group-by-name ()
+ "Open a new group in a named group"
+ (open-group-by (find-group-by-name (ask-group-name "Open a new group in")))
+ (leave-second-mode))
+
+(defun open-group-by-number ()
+ "Open a new group in a numbered group"
+ (open-group-by (find-group-by-name (ask-group-name "Open a new group in the grou numbered:")))
+ (leave-second-mode))
+
;;; Delete by functions
(defun delete-group-by (group)
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/26 22:02:02 1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/27 22:34:55 1.15
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 26 22:03:18 2008
+;;; #Date#: Wed Feb 27 20:52:03 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -79,10 +79,10 @@
(defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
(declare (ignore event-slots))
(unless send-event-p
- (unhide-window window)
+;; (unhide-window window)
(process-new-window window)
(xlib:map-window window)
- (focus-window window)
+;; (focus-window window)
(show-all-childs)))
--- /project/clfswm/cvsroot/clfswm/config.lisp 2008/02/24 20:53:37 1.8
+++ /project/clfswm/cvsroot/clfswm/config.lisp 2008/02/27 22:34:55 1.9
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Feb 22 15:14:03 2008
+;;; #Date#: Wed Feb 27 22:15:01 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Configuration file
@@ -42,8 +42,9 @@
;;; CONFIG - Screen size
(defun get-fullscreen-size ()
- "Return the size of root child - you can tweak this to what you want"
- (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
+ "Return the size of root child (values rx ry rw rh raise-p)
+You can tweak this to what you want"
+ (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*) nil))
;; (values -1 -1 1024 768))
;; (values 100 100 800 600))
More information about the clfswm-cvs
mailing list