23.0.50; Display bug with vline.el and viper

[Lennart Borgman (gmail)]

Scrolling down with down arrow get stuck in a loop in some positions. 
Cursor goes down to the bottom of the screem, but then the cursor jumps 
up some lines. The page is not scrolled down as it should be. The cursor 
is stuck in this loop.

To reproduce this start with

  emacs -Q

then open the attached file (vline.el) and do

  M-x eval-buffer
  M-x vline-mode
  M-x viper
  <down-arrow>

Just hold <down-arrow> down and the bug will eventually show up. To make 
it easier to see what happens you can reduce frame height first.




In GNU Emacs 23.0.50.1 (i386-mingw-nt5.1.2600)
 of 2008-01-13 on my-pc
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (3.4) --cflags -Ic:/g/include'

Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: ENU
  locale-coding-system: cp1252
  default-enable-multibyte-characters: t

Major mode: Emacs-Lisp

Minor modes in effect:
  vline-mode: t
  tooltip-mode: t
  tool-bar-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  unify-8859-on-encoding-mode: t
  utf-translate-cjk-mode: t
  auto-compression-mode: t
  line-number-mode: t

Recent input:
C-x C-f v l <tab> <return> M-x e v a l - b u f f e
r <return> M-x v i p e r - m o d e <return> M-x v l
i n e - m o d e <return> <help-echo> <help-echo> <help-echo>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <down> <down> <down>
<down> <help-echo> <help-echo> M-h <f10> <menu-bar>
<help-menu> <send-emacs-bug-report>

Recent messages:
Warning: no fonts matching 
`-*-opensymbol-normal-r-normal-*-12-*-*-*-c-*-iso8859-1' available [2 times]
For information about GNU Emacs and the GNU system, type C-h C-a.
Loading subst-ksc...done
Loading subst-gb2312...done
Loading subst-big5...done
Loading subst-jis...done
Loading viper...
Loading c:/Documents and Settings/Lennart Borgman/Application 
Data/.viper...done
Loading viper...done
Vline mode enabled

;;; vline.el --- show vertical line mode.

;; Copyright (C) 2002, 2008 by Taiki SUGAWARA <address@hidden>

;; Author: Taiki SUGAWARA <address@hidden>
;; Keywords: faces, editing, emulating

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Usage
;; put followings your .emacs
;;   (require 'vline)
;;
;; if you display a vertical line, type M-x vline-mode. `vline-mode' doesn't
;; effect other buffers, because it is a buffer local minor mode. if you hide
;; a vertical line, type M-x vline-mode again.
;;
;; if you display a vertical line in all buffers, type M-x vline-global-mode.
;;
;; `vline-style' provides a display style of vertical line. see `vline-style' 
docstring.

;;; Changes
;;
;; 2008-01-20, Lennart Borgman
;; - Added vline-face
;; - Added :group 'vline

;;; Code:

(defvar vline-overlay-table-size 200)
(defvar vline-overlay-table (make-vector vline-overlay-table-size nil))
(defvar vline-line-char ?|)
(defvar vline-style 'face
  "*This variable holds vertical line display style.
Available values are followings:
`face'      : use face.
`compose'   : use composit char.
`mixed'     : use face and composit char.")

(defface vline
  '((t (:background "gray90")))
  "Default face of vertical line.")

(defcustom vline-face 'vline
  "Face to use for vertical line."
  :type 'face
  :group 'vline)

(define-minor-mode vline-mode
  "Display vertical line mode."
  :global nil
  :lighter " VL"
  :group 'vline
  (if vline-mode
      (progn
        (add-hook 'post-command-hook 'vline-show nil t)
        (add-hook 'pre-command-hook 'vline-clear nil t))
    (vline-clear)
    (remove-hook 'post-command-hook 'vline-show t)
    (remove-hook 'pre-command-hook 'vline-clear t)))

(define-minor-mode vline-global-mode
  "Display vertical line mode as globally."
  :global t
  :lighter " VL"
  :group 'vline
  (if vline-global-mode
      (progn
        (add-hook 'post-command-hook 'vline-global-post-command-hook)
        (add-hook 'pre-command-hook 'vline-global-pre-command-hook))
    (vline-clear)
    (remove-hook 'post-command-hook 'vline-global-post-command-hook)
    (remove-hook 'pre-command-hook 'vline-global-pre-command-hook)))


(defun vline-post-command-hook ()
  (when (and vline-mode (not (minibufferp)))
    (vline-show)))

(defun vline-pre-command-hook ()
  (when (and vline-mode (not (minibufferp)))
    (vline-clear)))

(defun vline-global-post-command-hook ()
  (when (and vline-global-mode (not (minibufferp)))
    (vline-show)))

(defun vline-global-pre-command-hook ()
  (when (and vline-global-mode (not (minibufferp)))
    (vline-clear)))


(defun vline-clear ()
  (mapcar (lambda (ovr)
            (and ovr (delete-overlay ovr)))
          vline-overlay-table))

(defun vline-show (&optional point)
  (save-excursion
    (if point
        (goto-char point)
      (setq point (point)))
    (let* ((column (current-column))
           (i 0)
           (compose-p (memq vline-style '(compose mixed)))
           (face-p (memq vline-style '(face mixed)))
           (line-char (if compose-p vline-line-char ? ))
           (line-str (make-string 1 line-char)))
      (when face-p
        (setq line-str (propertize line-str 'face vline-face)))
      (goto-char (window-start))
      (while (and (< i (1- (window-height)))
                  (< i (length vline-overlay-table))
                  (not (eobp)))
        (move-to-column column)
        ;; non-cursor line only.
        (unless (= (point) point)
          ;; if column over the cursor's column (when tab or multi char is 
appered.
          (when (> (current-column) column)
            (backward-char))
          (let ((ovr (aref vline-overlay-table i))
                ;; consider a newline, tab and multi char.
                (str (concat (make-string (- column (current-column)) ? )
                             line-str))
                (char (char-after)))
            ;; create overlay if not found.
            (unless ovr
              (setq ovr (make-overlay 0 0))
              (overlay-put ovr 'rear-nonsticky t)
              (aset vline-overlay-table i ovr))

            ;; initialize overlay.
            (move-overlay ovr (point) (1+ (point)))
            (overlay-put ovr 'face nil)
            (overlay-put ovr 'before-string nil)
            (overlay-put ovr 'after-string nil)
            (overlay-put ovr 'invisible nil)
            (overlay-put ovr 'window (selected-window))

            (cond
             ;; space
             ((eq char ? )
              (overlay-put ovr 'invisible t)
              (overlay-put ovr 'after-string str))
             ;; tab, wide-space.
             ((memq char '(?\t ?　))
              (setq str
                    (concat str
                            (make-string (- (save-excursion (forward-char)
                                                            (current-column))
                                            (current-column)
                                            (string-width str))
                                         ? )))
              (overlay-put ovr 'invisible t)
              (overlay-put ovr 'after-string str))
             ;; eol
             ((eolp)
              (overlay-put ovr 'before-string str))
             (t
              (cond
               (compose-p
                (let (str)
                  (when char
                    (setq str (compose-chars
                               char
                               (cond ((= (char-width char) 1)
                                      '(tc . tc))
                                     ((= (current-column) column)
                                      '(tc . tr))
                                     (t
                                      '(tc . tl)))
                               line-char))
                    (when face-p
                      (setq str (propertize str 'face vline-face)))
                    (overlay-put ovr 'invisible t)
                    (overlay-put ovr 'after-string str))))
               (face-p
                (overlay-put ovr 'face vline-face)))))))
        (setq i (1+ i))
        (forward-line)))))

(provide 'vline)

;;; vline.el ends here