bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#22404: 25.1.50; Forcing `window-scroll-functions` to run.


From: Keith David Bershatsky
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`.")))))

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





reply via email to

[Prev in Thread] Current Thread [Next in Thread]