unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Lennart Borgman <lennart.borgman.073@student.lu.se>
Cc: emacs-devel@gnu.org
Subject: Re: mouse-drag-mode-line should maybe use window-tree
Date: Wed, 07 Dec 2005 23:42:16 +0100	[thread overview]
Message-ID: <43976548.8040507@student.lu.se> (raw)
In-Reply-To: <E1Ejft0-000707-KO@fencepost.gnu.org>

[-- Attachment #1: Type: text/plain, Size: 585 bytes --]

Richard M. Stallman wrote:

>    I think it copes with this. For the case of what I have called 
>    "interactive resize" (with the arrow keys) there are no problems. For 
>    the case of the new version of balance-windows (which I so far calls 
>    `bw-balance') I catch the errors and loop. So far I have seen no 
>    drawbacks with this.
>
>That is good.
>
>Could you please install your rewrite of balance-windows?
>That is a bug fix we want.  The other command is a new feature
>so it should not be installed now.
>
I have attached the patch. Could someone please install it?

[-- Attachment #2: windows-balance.patch --]
[-- Type: text/plain, Size: 10323 bytes --]

Index: window.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/window.el,v
retrieving revision 1.110
diff -c -r1.110 window.el
*** window.el	6 Dec 2005 09:00:49 -0000	1.110
--- window.el	7 Dec 2005 18:28:45 -0000
***************
*** 229,302 ****
  	  (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
  
  
! (defun balance-windows ()
!   "Make all visible windows the same height (approximately)."
    (interactive)
!   (let ((count -1) levels newsizes level-size
! 	;; Don't count the lines that are above the uppermost windows.
! 	;; (These are the menu bar lines, if any.)
! 	(mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))
! 	(last-window (previous-window (frame-first-window (selected-frame))))
! 	;; Don't count the lines that are past the lowest main window.
! 	total)
!     ;; Bottom edge of last window determines what size we have to work with.
!     (setq total
! 	  (+ (window-height last-window)
! 	     (nth 1 (window-edges last-window))))
! 
!     ;; Find all the different vpos's at which windows start,
!     ;; then count them.  But ignore levels that differ by only 1.
!     (let (tops (prev-top -2))
!       (walk-windows (function (lambda (w)
! 				(setq tops (cons (nth 1 (window-edges w))
! 						 tops))))
! 		    'nomini)
!       (setq tops (sort tops '<))
!       (while tops
! 	(if (> (car tops) (1+ prev-top))
! 	    (setq prev-top (car tops)
! 		  count (1+ count)))
! 	(setq levels (cons (cons (car tops) count) levels))
! 	(setq tops (cdr tops)))
!       (setq count (1+ count)))
!     ;; Subdivide the frame into desired number of vertical levels.
!     (setq level-size (/ (- total mbl) count))
!     (save-selected-window
!       ;; Set up NEWSIZES to map windows to their desired sizes.
!       ;; If a window ends at the bottom level, don't include
!       ;; it in NEWSIZES.  Those windows get the right sizes
!       ;; by adjusting the ones above them.
!       (walk-windows (function
! 		     (lambda (w)
! 		       (let ((newtop (cdr (assq (nth 1 (window-edges w))
! 						levels)))
! 			     (newbot (cdr (assq (+ (window-height w)
! 						   (nth 1 (window-edges w)))
! 						levels))))
! 			 (if newbot
! 			     (setq newsizes
! 				   (cons (cons w (* level-size (- newbot newtop)))
! 					 newsizes))))))
! 		    'nomini)
!       ;; Make walk-windows start with the topmost window.
!       (select-window (previous-window (frame-first-window (selected-frame))))
!       (let (done (count 0))
! 	;; Give each window its precomputed size, or at least try.
! 	;; Keep trying until they all get the intended sizes,
! 	;; but not more than 3 times (to prevent infinite loop).
! 	(while (and (not done) (< count 3))
! 	  (setq done t)
! 	  (setq count (1+ count))
! 	  (walk-windows (function (lambda (w)
! 				    (select-window w)
! 				    (let ((newsize (cdr (assq w newsizes))))
! 				      (when newsize
! 					(enlarge-window (- newsize
! 							   (window-height))
! 							nil)
! 					(unless (= (window-height) newsize)
! 					  (setq done nil))))))
! 			'nomini))))))
  \f
  ;; I think this should be the default; I think people will prefer it--rms.
  (defcustom split-window-keep-point t
--- 229,442 ----
  	  (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
  
  
! \f
! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! ;;; New code for `balance-windows' using `window-tree'
! 
! ;;; Translate from internal window tree format
! 
! (defun bw-get-tree (&optional window-or-frame)
!   "Get a window split tree in our format.
! 
! WINDOW-OR-FRAME must be nil, a frame or a window.  If it is nil
! then the whole window split tree for `selected-frame' is
! returned.  If it is a frame then this is used instead.  If it is
! a window then the smallest tree containing that window is
! returned."
!   (when window-or-frame
!     (unless (or (framep window-or-frame)
!                 (windowp window-or-frame))
!       (error "Not a frame or window: %s" frame)))
!   (let ((subtree (bw-find-tree-sub window-or-frame)))
!     (if (integerp subtree)
!         nil
!       (bw-get-tree-1 subtree))))
! 
! (defun bw-get-tree-1 (split)
!   (if (windowp split)
!       split
!     (let ((dir (car split))
!           (edges (car (cdr split)))
!           (childs (cdr (cdr split))))
!       (list
!        (cons 'dir (if dir 'ver 'hor))
!        (cons 'b (nth 3 edges))
!        (cons 'r (nth 2 edges))
!        (cons 't (nth 1 edges))
!        (cons 'l (nth 0 edges))
!        (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
! 
! (defun bw-find-tree-sub (window-or-frame &optional get-parent)
!   (let* ((window (when (windowp window-or-frame) window-or-frame))
!          (frame (when (windowp window) (window-frame window)))
!          (wt (car (window-tree frame))))
!     (when (< 1 (length (window-list frame 0)))
!       (if window
!           (bw-find-tree-sub-1 wt window get-parent)
!         wt))))
! 
! (defun bw-find-tree-sub-1 (tree win &optional get-parent)
!   (unless (windowp win) (error "Not a window: %s" win))
!   (if (memq win tree)
!       (if get-parent
!           get-parent
!         tree)
!     (let ((childs (cdr (cdr tree)))
!           child
!           subtree)
!       (while (and childs (not subtree))
!         (setq child (car childs))
!         (setq childs (cdr childs))
!         (when (and child (listp child))
!           (setq subtree (bw-find-tree-sub-1 child win get-parent))))
!       (if (integerp subtree)
!           (progn
!             (if (= 1 subtree)
!                 tree
!               (1- subtree)))
!         subtree
!         ))))
! 
! 
! 
! ;;; Window or object edges
! 
! (defun bw-l(obj)
!   "Left edge of OBJ."
!   (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
! (defun bw-t(obj)
!   "Top edge of OBJ."
!   (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
! (defun bw-r(obj)
!   "Right edge of OBJ."
!   (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
! (defun bw-b(obj)
!   "Bottom edge of OBJ."
!   (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
! 
! 
! 
! 
! 
! ;;; Split directions
! 
! (defun bw-dir(obj)
!   "Return window split tree direction if OBJ.
! If OBJ is a window return 'both. If it is a window split tree
! then return its direction."
!   (if (symbolp obj)
!       obj
!     (if (windowp obj)
!         'both
!       (let ((dir (cdr (assq 'dir obj))))
!         (unless (memq dir '(hor ver both))
!           (error "Can't find dir in %s" obj))
!         dir))))
! 
! (defun bw-eqdir(obj1 obj2)
!   "Return t if window split tree directions are equal.
! OBJ1 and OBJ2 should be either windows or window split trees in
! our format. The directions returned by `bw-dir' are compared and
! t is returned if they are `eq' or one of them is 'both."
!   (let ((dir1 (bw-dir obj1))
!         (dir2 (bw-dir obj2)))
!     (or (eq dir1 dir2)
!         (eq dir1 'both)
!         (eq dir2 'both))))
! 
! 
! 
! ;;; Building split tree
! 
! (defun bw-refresh-edges(obj)
!   "Refresh the edge information of OBJ and return OBJ."
!   (unless (windowp obj)
!     (let ((childs (cdr (assq 'childs obj)))
!           (ol 1000)
!           (ot 1000)
!           (or -1)
!           (ob -1))
!       (dolist (o childs)
!         (when (> ol (bw-l o)) (setq ol (bw-l o)))
!         (when (> ot (bw-t o)) (setq ot (bw-t o)))
!         (when (< or (bw-r o)) (setq or (bw-r o)))
!         (when (< ob (bw-b o)) (setq ob (bw-b o))))
!       (setq obj (delq 'l obj))
!       (setq obj (delq 't obj))
!       (setq obj (delq 'r obj))
!       (setq obj (delq 'b obj))
!       (add-to-list 'obj (cons 'l ol))
!       (add-to-list 'obj (cons 't ot))
!       (add-to-list 'obj (cons 'r or))
!       (add-to-list 'obj (cons 'b ob))
!       ))
!   obj)
! 
! 
! 
! 
! ;;; Balance windows
! 
! (defun balance-windows(&optional window-or-frame)
!   "Make windows the same heights or widths in window split subtrees.
! 
! When called non-interactively WINDOW-OR-FRAME may be either a
! window or a frame. It then balances the windows on the implied
! frame. If the parameter is a window only the corresponding window
! subtree is balanced."
    (interactive)
!   (let (
!         (wt (bw-get-tree window-or-frame))
!         (w)
!         (h)
!         (tried-sizes)
!         (last-sizes)
!         (windows (window-list nil 0))
!         (counter 0))
!     (when wt
!       (while (not (member last-sizes tried-sizes))
!         (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
!         (setq last-sizes (mapcar (lambda(w)
!                                    (window-edges w))
!                                  windows))
!         (when (eq 'hor (bw-dir wt))
!           (setq w (- (bw-r wt) (bw-l wt))))
!         (when (eq 'ver (bw-dir wt))
!           (setq h (- (bw-b wt) (bw-t wt))))
!         (bw-balance-sub wt w h)))))
! 
! (defun bw-adjust-window(window delta horizontal)
!   "Wrapper around `adjust-window-trailing-edge' with error checking.
! Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
!   (condition-case err
!       (adjust-window-trailing-edge window delta horizontal)
!     (error
!      ;;(message "adjust: %s" (error-message-string err))
!      )))
! 
! (defun bw-balance-sub(wt w h)
!   (setq wt (bw-refresh-edges wt))
!   (unless w (setq w (- (bw-r wt) (bw-l wt))))
!   (unless h (setq h (- (bw-b wt) (bw-t wt))))
!   (if (windowp wt)
!       (progn
!         (when w
!           (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
!             (when (/= 0 dw)
!                 (bw-adjust-window wt dw t))))
!         (when h
!           (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
!             (when (/= 0 dh)
!               (bw-adjust-window wt dh nil)))))
!     (let* ((childs (cdr (assq 'childs wt)))
!            (lastchild (car (last childs)))
!            (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
!            (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
!       (dolist (c childs)
!           (bw-balance-sub c cw ch)))))
! 
! ;;; End of new code for `balance-windows'
! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  \f
  ;; I think this should be the default; I think people will prefer it--rms.
  (defcustom split-window-keep-point t

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

  reply	other threads:[~2005-12-07 22:42 UTC|newest]

Thread overview: 21+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2005-11-24  0:29 mouse-drag-mode-line should maybe use window-tree Lennart Borgman
2005-11-25 15:50 ` Richard M. Stallman
2005-11-25 18:37   ` Peter Whaite
2005-11-27 19:36     ` Richard M. Stallman
2005-12-01 23:56       ` Lennart Borgman
2005-12-02 18:22         ` Richard M. Stallman
2005-12-04 23:20           ` Lennart Borgman
2005-12-05 16:37             ` Richard M. Stallman
2005-12-05 16:48               ` Lennart Borgman
2005-12-06 16:41                 ` Richard M. Stallman
2005-12-07 22:42                   ` Lennart Borgman [this message]
2005-12-05  0:20           ` Stefan Monnier
2005-12-05  0:37             ` Lennart Borgman
2005-12-05  0:42               ` Lennart Borgman
2005-12-05  0:42               ` Stefan Monnier
2005-12-05 16:37             ` Richard M. Stallman
2005-12-05 17:04               ` Lennart Borgman
2005-12-06 16:43                 ` Richard M. Stallman
2005-11-26 10:21   ` Lennart Borgman
2005-11-27  0:31     ` Richard M. Stallman
2005-11-28 23:57       ` Lennart Borgman

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=43976548.8040507@student.lu.se \
    --to=lennart.borgman.073@student.lu.se \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).