unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
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`.")))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





  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).