diff options
| author | Gerd Moellmann <gerd@gnu.org> | 1999-07-21 21:43:03 +0000 |
|---|---|---|
| committer | Gerd Moellmann <gerd@gnu.org> | 1999-07-21 21:43:03 +0000 |
| commit | cf4eb316c1a3c33882e2fad6cf943abe93933d85 (patch) | |
| tree | ba28d21bd481f6109a01dedc90fa5755788fd5f9 /lisp/scroll-bar.el | |
| parent | e724900d94ba3be4271471a46d25fc5297c160a1 (diff) | |
| download | emacs-cf4eb316c1a3c33882e2fad6cf943abe93933d85.tar.gz | |
(scroll-bar-timer): New.
(scroll-bar-toolkit-scroll): Start and cancel scroll-bar-timer.
(scroll-bar-toolkit-scroll): Handle `top' and `bottom'.
(scroll-bar-toolkit-scroll): New.
(global): Use different key bindings if using toolkit scroll bars.
Diffstat (limited to 'lisp/scroll-bar.el')
| -rw-r--r-- | lisp/scroll-bar.el | 73 |
1 files changed, 66 insertions, 7 deletions
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index d8e21921458..4499c0b0b5f 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -284,16 +284,75 @@ EVENT should be a scroll bar click." (setq point-before-scroll before-scroll))))) -;;;; Bindings. +;;; Tookit scroll bars. -;;; For now, we'll set things up to work like xterm. -(global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) -(global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up) +;; Due to its event handling, Emacs is currently not able to handle Xt +;; timeouts which toolkit scroll bars use to implement auto-repeat. +;; As a workaround, we start a timer whenever a scroll bar action +;; occurs, and remove it again when are notified that the user no +;; longer interacts with the scroll bar. The timer function gives Xt +;; the chance to call Xt timeout functions. + +(defvar scroll-bar-timer nil + "Timer running while scroll bar is active.") -(global-set-key [vertical-scroll-bar down-mouse-2] 'scroll-bar-drag) +(defun scroll-bar-toolkit-scroll (event) + (interactive "e") + (let* ((end-position (event-end event)) + (window (nth 0 end-position)) + (part (nth 4 end-position)) + before-scroll) + (cond ((eq part 'end-scroll) + (when scroll-bar-timer + (cancel-timer scroll-bar-timer) + (setq scroll-bar-timer nil))) + (t + (with-current-buffer (window-buffer window) + (setq before-scroll point-before-scroll)) + (save-selected-window + (select-window window) + (setq before-scroll (or before-scroll (point))) + (cond ((eq part 'above-handle) + (scroll-up '-)) + ((eq part 'below-handle) + (scroll-up nil)) + ((eq part 'up) + (scroll-up -1)) + ((eq part 'down) + (scroll-up 1)) + ((eq part 'top) + (set-window-start window (point-min))) + ((eq part 'bottom) + (goto-char (point-max)) + (recenter)) + ((eq part 'handle) + (scroll-bar-drag-1 event)))) + (sit-for 0) + (unless scroll-bar-timer + (setq scroll-bar-timer + (run-with-timer 0.1 0.1 'xt-process-timeouts))) + (with-current-buffer (window-buffer window) + (setq point-before-scroll before-scroll)))))) -(global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down) -(global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down) + + +;;;; Bindings. + +;;; For now, we'll set things up to work like xterm. +(cond (x-toolkit-scroll-bars-p + (global-set-key [vertical-scroll-bar mouse-1] + 'scroll-bar-toolkit-scroll)) + (t + (global-set-key [vertical-scroll-bar mouse-1] + 'scroll-bar-scroll-up) + (global-set-key [vertical-scroll-bar drag-mouse-1] + 'scroll-bar-scroll-up) + (global-set-key [vertical-scroll-bar down-mouse-2] + 'scroll-bar-drag) + (global-set-key [vertical-scroll-bar mouse-3] + 'scroll-bar-scroll-down) + (global-set-key [vertical-scroll-bar drag-mouse-3] + 'scroll-bar-scroll-down))) (provide 'scroll-bar) |