Package: emacs;
Reported by: Keith David Bershatsky <esq <at> lawlist.com>
Date: Tue, 19 Jan 2016 05:50:01 UTC
Severity: wishlist
Found in version 25.1.50
View this message in rfc822 format
From: Keith David Bershatsky <esq <at> lawlist.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 22404 <at> debbugs.gnu.org Subject: bug#22404: 25.1.50; Forcing `window-scroll-functions` to run. Date: Tue, 02 Feb 2016 12:00:23 -0800
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 line 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`.")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.