Mercurial > emacs

comparison lisp/scroll-bar.el @ 2698:6940c6b5d988

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(scroll-bar-drag, scroll-bar-drag-1): New functions. Put scroll-bar-drag on down-mouse-2 in scroll bar. Leave up-events on mouse-2 unbound.
author Richard M. Stallman <rms@gnu.org>
date Sat, 08 May 1993 23:49:17 +0000
parents 9e7ec92a4fdf
children 1b51f5e18410
comparison
equal deleted inserted replaced
2697:05ff97695d32 2698:6940c6b5d988
77 (cons 'horizontal-scroll-bars scroll-bar-mode))) 77 (cons 'horizontal-scroll-bars scroll-bar-mode)))
78 (setq frames (cdr frames))))) 78 (setq frames (cdr frames)))))
79 79
80 ;;;; Buffer navigation using the scroll bar. 80 ;;;; Buffer navigation using the scroll bar.
81 81
82 ;;; This was used for up-events on button 2, but no longer.
82 (defun scroll-bar-set-window-start (event) 83 (defun scroll-bar-set-window-start (event)
83 "Set the window start according to where the scroll bar is dragged. 84 "Set the window start according to where the scroll bar is dragged.
84 EVENT should be a scroll bar click or drag event." 85 EVENT should be a scroll bar click or drag event."
85 (interactive "e") 86 (interactive "e")
86 (let* ((end-position (event-end event)) 87 (let* ((end-position (event-end event))
90 (set-buffer (window-buffer window)) 91 (set-buffer (window-buffer window))
91 (save-excursion 92 (save-excursion
92 (goto-char (scroll-bar-scale portion-whole (buffer-size))) 93 (goto-char (scroll-bar-scale portion-whole (buffer-size)))
93 (beginning-of-line) 94 (beginning-of-line)
94 (set-window-start window (point)))))) 95 (set-window-start window (point))))))
96
97 ;; Scroll the window to the proper position for EVENT.
98 (defun scroll-bar-drag-1 (event)
99 (let* ((start-position (event-start event))
100 (window (nth 0 start-position))
101 (portion-whole (nth 2 start-position)))
102 (save-excursion
103 (set-buffer (window-buffer window))
104 (goto-char (scroll-bar-scale portion-whole (buffer-size)))
105 (beginning-of-line)
106 (set-window-start window (point)))))
107
108 (defun scroll-bar-drag (event)
109 "Scroll the window by dragging the scroll bar slider.
110 If you click outside the slider, the window scrolls to bring the slider there."
111 (interactive "e")
112 (let* (done)
113 (scroll-bar-drag-1 event)
114 (track-mouse
115 (while (not done)
116 (setq event (read-event))
117 (if (eq (car-safe event) 'mouse-movement)
118 (setq event (read-event)))
119 (cond ((eq (car-safe event) 'scroll-bar-movement)
120 (scroll-bar-drag-1 event))
121 (t
122 ;; Exit when we get the drag event; ignore that event.
123 (setq done t)))))))
95 124
96 (defun scroll-bar-scroll-down (event) 125 (defun scroll-bar-scroll-down (event)
97 "Scroll the window's top line down to the location of the scroll bar click. 126 "Scroll the window's top line down to the location of the scroll bar click.
98 EVENT should be a scroll bar click." 127 EVENT should be a scroll bar click."
99 (interactive "e") 128 (interactive "e")
128 157
129 ;;; For now, we'll set things up to work like xterm. 158 ;;; For now, we'll set things up to work like xterm.
130 (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) 159 (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up)
131 (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up) 160 (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up)
132 161
133 (global-set-key [vertical-scroll-bar mouse-2] 'scroll-bar-set-window-start) 162 (global-set-key [vertical-scroll-bar down-mouse-2] 'scroll-bar-drag)
134 (global-set-key [vertical-scroll-bar drag-mouse-2] 'scroll-bar-set-window-start) 163
135
136 (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down) 164 (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down)
137 (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down) 165 (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down)
138 166
139 167
140 (provide 'scroll-bar) 168 (provide 'scroll-bar)