From: Keith David Bershatsky <esq@lawlist.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 22404@debbugs.gnu.org
Subject: bug#22404: 25.1.50; Forcing `window-scroll-functions` to run.
Date: Tue, 02 Feb 2016 12:00:23 -0800 [thread overview]
Message-ID: <m2egcurig8.wl%esq@lawlist.com> (raw)
In-Reply-To: <m260yqdsp7.wl%esq@lawlist.com>
I will go through your most recent e-mail in a little while, but I wanted to get this test minor-mode over to you so that you can visually see exactly what I see when performing these tests. It is a scaled-down example of my current usage -- this example just draws line numbers in the left margin of the visible window and uses `forward-line` instead of `vertical-motion`. This minor-mode will work with your new `post-redisplay-hook` and it also works with the latest example `window_start_end.diff` that I e-mailed last night. I have included an exception for `mhweel-scroll` so that we can use the mouse wheel to scroll up/down to see how the overlays have been placed. If we use a large buffer for testing and go to `beginning-of-buffer` or `end-of-buffer` or scroll-up or scroll-down, the l
ine numbers should be drawn by the time that redisplay finishes. I have already taken the liberty of adding `ln-draw-numbers` to the `post-redisplay-hook` in anticipation of its future creation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar ln-before-string-list nil
"Doc-string -- `ln-before-string-list`.")
(make-variable-buffer-local 'ln-before-string-list)
(defvar ln-str-list nil
"Doc-string -- `ln-str-list`.")
(make-variable-buffer-local 'ln-str-list)
(defvar ln-this-command nil
"This local variable is set within the `post-command-hook`; and,
is also used by the `window-start-end-hook` hook.")
(make-variable-buffer-local 'ln-this-command)
(defvar ln-overlays nil "Overlays used in this buffer.")
(defvar ln-available nil "Overlays available for reuse.")
(mapc #'make-variable-buffer-local '(ln-overlays ln-available))
(defgroup ln nil
"Show line numbers in the left margin."
:group 'convenience)
(defface ln-active-face
'((t (:background "black" :foreground "#eab700" :weight normal :italic nil
:underline nil :box nil :overline nil)))
"Face for `ln-active-face'."
:group 'ln)
(defface ln-inactive-face
'((t (:background "black" :foreground "SteelBlue" :weight normal :italic nil
:underline nil :box nil :overline nil)))
"Face for `ln-inactive-face'."
:group 'ln)
(defvar ln-mode nil)
(defun ln-record-this-command ()
(setq ln-this-command this-command))
(defun ln-draw-numbers (win &optional start end pbol-start peol-end force)
"Update line numbers for the portion visible in window WIN."
(message "win: %s | start: %s | end: %s | pbol-start: %s | peol-end: %s"
win start end pbol-start peol-end)
(when
(and
ln-mode
(or ln-this-command force)
(not (eq ln-this-command 'mwheel-scroll))
(window-live-p win)
(not (minibufferp))
(pos-visible-in-window-p nil nil nil) )
(setq ln-available ln-overlays)
(setq ln-overlays nil)
(setq ln-before-string-list nil)
(setq ln-str-list nil)
(let* (
line
my-initial-line
(inhibit-point-motion-hooks t)
(opoint (point))
(ln-current-line-number (string-to-number (format-mode-line "%l")))
(window-start (if start start (window-start win)))
(window-end (if end end (window-end win t)))
(max-digits-string (number-to-string (length (progn (goto-char (point-max)) (format-mode-line "%l")))))
(width 0) )
(goto-char window-start)
(setq my-initial-line (string-to-number (format-mode-line "%l")))
(setq line my-initial-line)
(catch 'done
(while t
(when (= (point) (point-at-bol))
(let* (
(str
(propertize
(format (concat "%" max-digits-string "d") line)
'face (if (eq line ln-current-line-number) 'ln-active-face 'ln-inactive-face)))
(ln-before-string
(propertize " " 'display `((margin left-margin) ,str)))
(visited
(catch 'visited
(dolist (o (overlays-in (point) (point)))
(when (equal-including-properties (overlay-get o 'ln-str) str)
(unless (memq o ln-overlays)
(push o ln-overlays))
(setq ln-available (delq o ln-available))
(throw 'visited t))))) )
(push ln-before-string ln-before-string-list)
(push str ln-str-list)
(unless visited
(let ((ov (if (null ln-available)
(make-overlay (point) (point))
(move-overlay (pop ln-available) (point) (point)))))
(push ov ln-overlays)
(overlay-put ov 'before-string ln-before-string)
(overlay-put ov 'ln-str str)))
(setq width (max width (length str)))))
(if (and (not (eobp)) (< (point) window-end))
(progn
(forward-line)
(setq line (1+ line)))
(throw 'done nil))))
(set-window-margins win width (cdr (window-margins win)))
(mapc #'delete-overlay ln-available)
(setq ln-available nil)
(setq ln-this-command nil)
(goto-char opoint))))
(defsubst lawlist-remove-overlays (beg end name val)
"Remove the overlays that are `equal-including-properties`.
Includes a unique situation when an overlay with an `'after-string` property
is at the very end of a narrowed-buffer."
(let* (
(point-max (point-max))
(point-min (point-min))
(narrowed-p (buffer-narrowed-p))
(beg (if beg beg point-min))
(end
(cond
((and
(not narrowed-p)
end)
end)
((and
(not narrowed-p)
(null end))
point-max)
((and
narrowed-p
end
(< end point-max))
end)
((and
narrowed-p
end
(= end point-max))
(1+ end))
((and
narrowed-p
(null end))
(1+ point-max)) ))
(overlays
(progn
(overlay-recenter end)
(overlays-in beg end))) )
(when (and beg end name val)
(dolist (o overlays)
(cond
((and
(eq name 'face)
(eq (overlay-get o name) val))
(if (< (overlay-start o) beg)
(if (> (overlay-end o) end)
(progn
(move-overlay (copy-overlay o)
(overlay-start o) beg)
(move-overlay o end (overlay-end o)))
(move-overlay o (overlay-start o) beg))
(if (> (overlay-end o) end)
(move-overlay o end (overlay-end o))
(delete-overlay o))))
((and
(not (eq name 'face))
(equal-including-properties (overlay-get o name) val))
(delete-overlay o)))))))
(define-minor-mode ln-mode
"A minor-mode for line-numbers in the left-hand margin."
:init-value nil
:lighter " #"
:keymap nil
:global nil
:group 'ln
(cond
(ln-mode
(setq window-start-end-var t)
(add-hook 'pre-command-hook 'ln-record-this-command nil t)
(add-hook 'window-start-end-hook 'ln-draw-numbers nil t)
(add-hook 'post-redisplay-hook 'ln-draw-numbers nil t)
(ln-draw-numbers (selected-window) nil nil nil nil 'force)
(when (called-interactively-p 'any)
(message "Turned ON `ln-mode`.")))
(t
(remove-hook 'pre-command-hook 'ln-record-this-command t)
(remove-hook 'window-start-end-hook 'ln-draw-numbers t)
(remove-hook 'post-redisplay-hook 'ln-draw-numbers t)
(kill-local-variable 'ln-overlays)
(kill-local-variable 'ln-available)
(dolist (val ln-str-list)
(lawlist-remove-overlays nil nil 'ln-str val))
(kill-local-variable 'ln-str-list)
(dolist (val ln-before-string-list)
(lawlist-remove-overlays nil nil 'before-string val))
(kill-local-variable 'ln-before-string-list)
(kill-local-variable 'window-start-end-var)
(dolist (w (get-buffer-window-list (current-buffer) nil t))
(set-window-margins w 0 (cdr (window-margins w))))
(when (called-interactively-p 'any)
(message "Turned OFF `ln-mode`.")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
next prev parent reply other threads:[~2016-02-02 20:00 UTC|newest]
Thread overview: 40+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-01-19 5:49 bug#22404: 25.1.50; Forcing `window-scroll-functions` to run Keith David Bershatsky
2016-01-19 17:50 ` Eli Zaretskii
2016-01-19 18:49 ` Keith David Bershatsky
2016-01-19 19:39 ` Eli Zaretskii
2016-01-19 18:53 ` John Wiegley
2016-01-19 19:26 ` Keith David Bershatsky
2016-01-19 20:35 ` Keith David Bershatsky
2016-01-20 13:34 ` Eli Zaretskii
2016-01-19 23:07 ` Keith David Bershatsky
2016-01-21 2:32 ` Keith David Bershatsky
2016-01-21 17:41 ` Eli Zaretskii
2016-01-21 19:54 ` Keith David Bershatsky
2016-01-21 20:28 ` Eli Zaretskii
2016-01-29 12:00 ` Michael Heerdegen
2016-01-29 14:37 ` Eli Zaretskii
2016-01-29 14:57 ` Michael Heerdegen
2016-01-29 15:33 ` Eli Zaretskii
2016-01-21 21:11 ` Keith David Bershatsky
2016-01-29 2:14 ` John Wiegley
2016-01-29 3:08 ` Keith David Bershatsky
2016-01-29 8:42 ` Eli Zaretskii
2016-01-29 15:54 ` Keith David Bershatsky
2016-02-01 3:50 ` Keith David Bershatsky
2016-02-01 19:54 ` Eli Zaretskii
2016-02-01 13:18 ` Keith David Bershatsky
2016-02-02 16:34 ` Eli Zaretskii
2016-02-02 5:58 ` Keith David Bershatsky
2016-02-02 18:16 ` Keith David Bershatsky
2016-02-02 18:43 ` Eli Zaretskii
2016-02-02 20:00 ` Keith David Bershatsky [this message]
2016-02-02 21:05 ` Keith David Bershatsky
2016-02-08 8:51 ` Keith David Bershatsky
2016-02-08 17:17 ` Eli Zaretskii
2016-02-09 16:00 ` Keith David Bershatsky
2016-02-09 17:48 ` Eli Zaretskii
2016-02-12 0:14 ` Keith David Bershatsky
2016-02-12 8:18 ` Eli Zaretskii
2016-02-16 3:39 ` Keith David Bershatsky
2016-02-22 6:05 ` Keith David Bershatsky
2016-03-11 16:21 ` Keith David Bershatsky
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=m2egcurig8.wl%esq@lawlist.com \
--to=esq@lawlist.com \
--cc=22404@debbugs.gnu.org \
--cc=eliz@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).