[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[STUMP] [PATCH] add head resizing facility
From: |
Vitaly Mayatskikh |
Subject: |
[STUMP] [PATCH] add head resizing facility |
Date: |
Thu, 19 Mar 2009 21:48:38 +0100 |
User-agent: |
Wanderlust/2.15.6 (Almost Unreal) Emacs/22.3 Mule/5.0 (SAKAKI) |
This patch adds resize-head function for heads resizing :)
diff --git a/screen.lisp b/screen.lisp
index 19eebdb..8edec95 100644
--- a/screen.lisp
+++ b/screen.lisp
@@ -523,15 +523,17 @@ FOCUS-WINDOW is an extra window used for
_NET_SUPPORTING_WM_CHECK."
;; work with overlapping heads. Would it be better to walk
;; up the frame tree?
(defun frame-head (group frame)
- (dolist (head (screen-heads (group-screen group)))
- (when (and
- (>= (frame-x frame) (frame-x head))
- (>= (frame-y frame) (frame-y head))
- (<= (+ (frame-x frame) (frame-width frame))
- (+ (frame-x head) (frame-width head)))
- (<= (+ (frame-y frame) (frame-height frame))
- (+ (frame-y head) (frame-height head))))
- (return head))))
+ (let ((center-x (+ (frame-x frame) (ash (frame-width frame) -1)))
+ (center-y (+ (frame-y frame) (ash (frame-height frame) -1))))
+ (dolist (head (screen-heads (group-screen group)))
+ (when (and
+ (>= center-x (frame-x head))
+ (>= center-y (frame-y head))
+ (<= center-x
+ (+ (frame-x head) (frame-width head)))
+ (<= center-y
+ (+ (frame-y head) (frame-height head))))
+ (return head)))))
(defun group-heads (group)
(screen-heads (group-screen group)))
@@ -622,6 +624,18 @@ FOCUS-WINDOW is an extra window used for
_NET_SUPPORTING_WM_CHECK."
(scale-head screen oh nh)
(add-head screen nh))))
+(defun resize-head (number x y width height)
+ (let* ((screen (current-screen))
+ (oh (find number (screen-heads screen) :key 'head-number))
+ (nh (make-head :number number
+ :x x :y y
+ :width width
+ :height height
+ :window nil)))
+ (scale-head screen oh nh)
+ (mapc 'group-add-head (screen-groups screen))
+ (update-mode-lines screen)))
+
;;; Screen commands
(defcommand snext () ()
diff --git a/tile-group.lisp b/tile-group.lisp
index 483aa25..98fd8f0 100644
--- a/tile-group.lisp
+++ b/tile-group.lisp
@@ -568,15 +568,17 @@ LEAF. Return tree with leaf removed."
provided, reposition the TREE as well."
(let* ((tw (tree-width tree))
(th (tree-height tree))
- (wf (/ 1 (/ tw w)))
- (hf (/ 1 (/ th h)))
- (xo (if x (- x (tree-x tree)) 0))
- (yo (if y (- y (tree-y tree)) 0)))
+ (wf (/ w tw))
+ (hf (/ h th))
+ (xo (if x x 0))
+ (yo (if y y 0))
+ (tx (tree-x tree))
+ (ty (tree-y tree)))
(tree-iterate tree (lambda (f)
(setf (frame-height f) (round (* (frame-height f) hf))
- (frame-y f) (round (* (frame-y f) hf))
+ (frame-y f) (round (* (- (frame-y f) ty) hf))
(frame-width f) (round (* (frame-width f) wf))
- (frame-x f) (round (* (frame-x f) wf)))
+ (frame-x f) (round (* (- (frame-x f) tx) wf)))
(incf (frame-y f) yo)
(incf (frame-x f) xo)))
(dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree)
(tree-height tree))))
--
wbr, Vitaly
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [STUMP] [PATCH] add head resizing facility,
Vitaly Mayatskikh <=