From: Lennart Borgman <lennart.borgman@gmail.com>
To: Drew Adams <drew.adams@oracle.com>,
Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 7822@debbugs.gnu.org
Subject: bug#7822: 24.0.50; `fit-window-to-buffer': take display artefacts into account
Date: Wed, 12 Jan 2011 03:14:51 +0100 [thread overview]
Message-ID: <AANLkTi=5TD9ZUkGjk9x==s-uUxcDeQfhKOvshY18SrzM@mail.gmail.com> (raw)
In-Reply-To: <AANLkTimLU0v8=+R-4Y-VRG9bFUQUnaQcHJ822NUQFeMV@mail.gmail.com>
I started writing a solution for this (could we please move the
discussion here?). It is not ready, but I paste it here for comments.
The part currently fails because window-line-height returns nil -
which I think is another Emacs bug.
Anyway here is what I have written so far:
(defun winsize-fit-window-to-buffer (&optional window max-height min-height)
"A more complete `fit-window-to-buffer'. Fix-me: not ready, bug# 7822.
Find through an iterative search minimal height to display whole
buffer \(narrowed part if narrowed) and set window height to that
height. Or, if that can not be done then set the height to the
best possible height for fit.
Try first to adjust window below and if that is not enough window
above.
"
(let* ((window (or window (selected-window)))
(frm (window-frame window))
(frm-height (frame-height frm))
here
(above (windmove-find-other-window 'up nil window))
(below (windmove-find-other-window 'down nil window))
;;(wcfg (current-window-configuration frm))
window-configuration-change-hook
(eob-in-win (= (window-end window t) (point-max)))
(curh (window-height window))
(minh (if (not eob-in-win)
curh
(or min-height window-min-height)))
(orig-minh minh)
(maxh (if eob-in-win
curh
(or max-height frm-height)))
(orig-maxh maxh)
midh
done)
(when (window-minibuffer-p below)
(setq below nil))
(when (or above below)
(with-current-buffer (window-buffer window)
(setq here (point))
;; First try resizing window below.
(when below
(while (and (not done) (> maxh minh))
(setq midh (+ minh (/ (- maxh minh) 2)))
(let* ((winh (window-height window))
(delta (- midh winh))
did-it)
(condition-case err
(progn
(adjust-window-trailing-edge window delta nil)
(setq did-it t))
(error
(message "%S" err)))
(if did-it
(progn
(goto-char (point-min))
;; Fix-me: This unfortunately returns t even if
;; the last line is partly hidden (test example
;; help for posn-at-x-y):
(setq eob-in-win (= (window-end window t) (point-max)))
;; So let us try another way to check if eob is in window:
(let* ((edges (window-inside-pixel-edges))
(left (1+ (nth 0 edges)))
(bottom (1- (nth 3 edges))))
(setq eob-in-win
(= (point-max)
(posn-point (posn-at-x-y left bottom frm)))))
(if eob-in-win
;; Fix-me: This assumes that posn-at-point is
;; relative to window text area.
(let* ((loc (event-end (posn-at-point
(point-max) window)))
(loc-bottom (cdr loc))
(edges (window-inside-pixel-edges window))
(win-top (nth 1 edges))
(win-bottom (nth 3 edges))
(win-rel-bottom (- win-bottom win-top))
;; Fix-me: This returns nil even though
;; we have updated above with
;; (window-end window t) and also after
;; (redisplay t) or (sit-for 0).
(dummy (redisplay t))
(dummy2 (sit-for 0))
(bottom-line-height (window-line-height
(line-number-at-pos (1- (point-max)))
window)))
;; Make a guess if we are ready.
(when (> bottom-line-height
(- win-rel-bottom loc-bottom))
(setq done t))
(setq maxh midh))
(setq minh midh)))
(if (< 0 delta)
(setq maxh (1- maxh))
(setq minh (1+ minh))))
)))
;; If we are not done try window above.
(when above
(while (and (not done) (> maxh minh))
(setq midh (+ minh (/ (- maxh minh) 2)))
(let* ((winh (window-height window))
(delta (- winh midh))
did-it)
;; (when (> 0 delta) ;; Check window above min height
;; (setq delta (max delta
;; (- window-min-height
;; (window-height above))))
;; (setq midh (- delta winh)))
(condition-case err
(progn
(adjust-window-trailing-edge above delta nil)
(setq did-it t))
(error
(message "%S" err)))
(if did-it
(progn
(goto-char (point-min))
(setq eob-in-win (= (window-end window t) (point-max)))
(if eob-in-win
(setq maxh midh)
(setq minh midh)))
(if (> 0 delta)
(setq maxh (1- maxh))
(setq minh (1+ minh))))
)))
(goto-char here))
)))
next prev parent reply other threads:[~2011-01-12 2:14 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-01-11 0:21 bug#7822: 24.0.50; `fit-window-to-buffer': take display artefacts into account Drew Adams
2011-01-11 4:40 ` Lennart Borgman
2011-01-12 2:14 ` Lennart Borgman [this message]
2011-01-12 3:16 ` Drew Adams
2011-01-12 10:40 ` Lennart Borgman
2011-01-12 11:33 ` Lennart Borgman
2011-01-12 15:11 ` Drew Adams
2011-01-12 17:55 ` Lennart Borgman
2011-01-12 18:24 ` Drew Adams
-- strict thread matches above, loose matches on Subject: below --
2008-11-14 22:46 bug#1348: set-frame-width and set-frame-position seem buggy on at least MSWindows Themba Fletcher
2014-09-21 18:02 ` martin rudalics
2014-09-22 9:02 ` bug#7822: 24.0.50; `fit-window-to-buffer': take display artefacts into account martin rudalics
2014-09-22 14:02 ` Drew Adams
2014-09-22 17:42 ` martin rudalics
2014-09-22 18:24 ` Drew Adams
2014-09-22 19:31 ` Stefan Monnier
2014-09-22 20:24 ` Drew Adams
2014-09-22 20:54 ` Stefan Monnier
2014-09-22 21:04 ` Drew Adams
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='AANLkTi=5TD9ZUkGjk9x==s-uUxcDeQfhKOvshY18SrzM@mail.gmail.com' \
--to=lennart.borgman@gmail.com \
--cc=7822@debbugs.gnu.org \
--cc=drew.adams@oracle.com \
--cc=monnier@iro.umontreal.ca \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.