Commit f1a64115 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):

Use a timer instead of post-command-hook.
(hscroll-timer): New variable.
parent 2a48d24b
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA. ;; Boston, MA 02111-1307, USA.
;;; Commentary:a ;;; Commentary:
;; ;;
;; Automatically scroll horizontally when the point moves off the ;; Automatically scroll horizontally when the point moves off the
;; left or right edge of the window. ;; left or right edge of the window.
...@@ -109,6 +109,8 @@ Set this to nil to conserve valuable mode line space." ...@@ -109,6 +109,8 @@ Set this to nil to conserve valuable mode line space."
"Non-nil if HScroll mode is enabled.") "Non-nil if HScroll mode is enabled.")
(make-variable-buffer-local 'hscroll-mode) (make-variable-buffer-local 'hscroll-mode)
(defvar hscroll-timer nil
"Timer used by HScroll mode.")
(defvar hscroll-old-truncate-local nil) (defvar hscroll-old-truncate-local nil)
(defvar hscroll-old-truncate-was-global nil) (defvar hscroll-old-truncate-was-global nil)
...@@ -134,7 +136,6 @@ In HScroll mode, truncated lines will automatically scroll left or ...@@ -134,7 +136,6 @@ In HScroll mode, truncated lines will automatically scroll left or
right when point gets near either edge of the window. right when point gets near either edge of the window.
See also \\[hscroll-global-mode]." See also \\[hscroll-global-mode]."
(interactive "P") (interactive "P")
(make-local-hook 'post-command-hook)
(let ((newmode (if (null arg) (let ((newmode (if (null arg)
(not hscroll-mode) (not hscroll-mode)
(> (prefix-numeric-value arg) 0)))) (> (prefix-numeric-value arg) 0))))
...@@ -148,9 +149,8 @@ right when point gets near either edge of the window. ...@@ -148,9 +149,8 @@ right when point gets near either edge of the window.
(setq hscroll-old-truncate-local truncate-lines)) (setq hscroll-old-truncate-local truncate-lines))
(setq hscroll-old-truncate-was-global (not localp)) (setq hscroll-old-truncate-was-global (not localp))
(setq truncate-lines t) (setq truncate-lines t)
(add-hook 'post-command-hook (setq hscroll-timer
(function hscroll-window-maybe) nil t) (run-with-idle-timer 0 t 'hscroll-window-maybe))))
))
;; turn it off ;; turn it off
(if hscroll-mode (if hscroll-mode
;; it was on ;; it was on
...@@ -160,14 +160,10 @@ right when point gets near either edge of the window. ...@@ -160,14 +160,10 @@ right when point gets near either edge of the window.
(setq truncate-lines hscroll-old-truncate-local)) (setq truncate-lines hscroll-old-truncate-local))
(if (not truncate-lines) (if (not truncate-lines)
(set-window-hscroll (selected-window) 0)) (set-window-hscroll (selected-window) 0))
(remove-hook 'post-command-hook (cancel-timer hscroll-timer))))
(function hscroll-window-maybe) t)
))
)
(setq hscroll-mode newmode) (setq hscroll-mode newmode)
(force-mode-line-update nil) (force-mode-line-update nil)))
))
;;;###autoload ;;;###autoload
...@@ -192,20 +188,17 @@ will have no effect on it). ...@@ -192,20 +188,17 @@ will have no effect on it).
(setq hscroll-old-truncate-default (default-value truncate-lines)) (setq hscroll-old-truncate-default (default-value truncate-lines))
(setq hscroll-old-truncate-was-global t) (setq hscroll-old-truncate-was-global t)
(setq-default truncate-lines t) (setq-default truncate-lines t)
(add-hook 'post-command-hook (function hscroll-window-maybe)) (setq hscroll-timer
)) (run-with-idle-timer 0 t 'hscroll-window-maybe))))
;; turn it off ;; turn it off
(if hscroll-mode (if hscroll-mode
;; it was on ;; it was on
(progn (progn
(setq-default truncate-lines hscroll-old-truncate-default) (setq-default truncate-lines hscroll-old-truncate-default)
(remove-hook 'post-command-hook (function hscroll-window-maybe)) (cancel-timer hscroll-timer))))
))
)
(setq-default hscroll-mode newmode) (setq-default hscroll-mode newmode)
(force-mode-line-update t) (force-mode-line-update t)))
))
(defun hscroll-window-maybe () (defun hscroll-window-maybe ()
"Scroll horizontally if point is off or nearly off the edge of the window. "Scroll horizontally if point is off or nearly off the edge of the window.
...@@ -221,8 +214,7 @@ invoked as well (i.e., it can be bound to a key)." ...@@ -221,8 +214,7 @@ invoked as well (i.e., it can be bound to a key)."
(and truncate-partial-width-windows (and truncate-partial-width-windows
(< (window-width) (frame-width))))) (< (window-width) (frame-width)))))
(let ((linelen (save-excursion (end-of-line) (current-column))) (let ((linelen (save-excursion (end-of-line) (current-column)))
(rightmost-char (+ (window-width) (window-hscroll))) (rightmost-char (+ (window-width) (window-hscroll))))
)
(if (< (current-column) hscroll-snap-threshold) (if (< (current-column) hscroll-snap-threshold)
(set-window-hscroll (set-window-hscroll
(selected-window) (selected-window)
...@@ -244,9 +236,7 @@ invoked as well (i.e., it can be bound to a key)." ...@@ -244,9 +236,7 @@ invoked as well (i.e., it can be bound to a key)."
;; Scroll to the right a proportion of the window's width. ;; Scroll to the right a proportion of the window's width.
(set-window-hscroll (set-window-hscroll
(selected-window) (selected-window)
(- (current-column) (/ (* (window-width) hscroll-step-percent) 100))) (- (current-column) (/ (* (window-width) hscroll-step-percent) 100)))))))))
)))
)))
;;; ;;;
;;; It's not a bug, it's a *feature* ;;; It's not a bug, it's a *feature*
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment