Mercurial > emacs
comparison lisp/mouse.el @ 3928:c5f9d7f928a7
* mouse.el (mouse-drag-region-1): Commented out.
(mouse-drag-region): Commented out, and replaced with new version,
which highlights the region as we drag.
(mouse-scroll-delay, mouse-drag-overlay): New variables.
(mouse-scroll-subr): New function.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Wed, 30 Jun 1993 04:47:37 +0000 |
parents | a0655a72182b |
children | e828d5f28ca2 |
comparison
equal
deleted
inserted
replaced
3927:1f1fefc400ed | 3928:c5f9d7f928a7 |
---|---|
116 (push-mark) | 116 (push-mark) |
117 (set-mark (point)) | 117 (set-mark (point)) |
118 (if (numberp (posn-point end)) | 118 (if (numberp (posn-point end)) |
119 (goto-char (posn-point end))))) | 119 (goto-char (posn-point end))))) |
120 | 120 |
121 (defun mouse-drag-region (click) | 121 (defvar mouse-scroll-delay 0.25 |
122 "*The pause between scroll steps caused by mouse drags, in seconds. | |
123 If you drag the mouse beyond the edge of a window, Emacs scrolls the | |
124 window to bring the text beyond that edge into view, with a delay of | |
125 this many seconds between scroll steps. Scrolling stops when you move | |
126 the mouse back into the window, or release the button. | |
127 This variable's value may be non-integral. | |
128 Setting this to zero causes Emacs to scroll as fast as it can.") | |
129 | |
130 (defun mouse-scroll-subr (jump &optional overlay start) | |
131 "Scroll the selected window JUMP lines at a time, until new input arrives. | |
132 If OVERLAY is an overlay, let it stretch from START to the far edge of | |
133 the newly visible text. | |
134 Upon exit, point is at the far edge of the newly visible text." | |
135 (while (progn | |
136 (goto-char (window-start)) | |
137 (if (not (zerop (vertical-motion jump))) | |
138 (progn | |
139 (set-window-start (selected-window) (point)) | |
140 (if (natnump jump) | |
141 (progn | |
142 (goto-char (window-end (selected-window))) | |
143 ;; window-end doesn't reflect the window's new | |
144 ;; start position until the next redisplay. Hurrah. | |
145 (vertical-motion (1- jump))) | |
146 (goto-char (window-start (selected-window)))) | |
147 (if overlay | |
148 (move-overlay overlay start (point))) | |
149 (if (not (eobp)) | |
150 (sit-for mouse-scroll-delay)))))) | |
151 (point)) | |
152 | |
153 (defvar mouse-drag-overlay (make-overlay 1 1)) | |
154 (overlay-put mouse-drag-overlay 'face 'region) | |
155 | |
156 (defun mouse-drag-region (start-event) | |
122 "Set the region to the text that the mouse is dragged over. | 157 "Set the region to the text that the mouse is dragged over. |
158 Highlight the drag area as the user moves the mouse. | |
123 This must be bound to a button-down mouse event." | 159 This must be bound to a button-down mouse event." |
124 (interactive "e") | 160 (interactive "e") |
125 (let ((posn (event-start click)) | 161 (let* ((start-posn (event-start start-event)) |
126 done event (mark-active nil)) | 162 (start-point (posn-point start-posn)) |
127 (select-window (posn-window posn)) | 163 (start-window (posn-window start-posn)) |
128 ;; Set point temporarily, so user sees where it is. | 164 (bounds (window-edges start-window)) |
129 (if (numberp (posn-point posn)) | 165 (top (nth 1 bounds)) |
130 (goto-char (posn-point posn))) | 166 (bottom (if (window-minibuffer-p start-window) |
131 ;; Turn off the old mark when we set up an empty region. | 167 (nth 3 bounds) |
132 (setq deactivate-mark t))) | 168 ;; Don't count the mode line. |
133 | 169 (1- (nth 3 bounds))))) |
134 ;;;Nice hack, but too slow, so not normally in use. | 170 (select-window start-window) |
135 (defun mouse-drag-region-1 (click) | 171 (goto-char start-point) |
136 "Set the region to the text that the mouse is dragged over. | 172 (move-overlay mouse-drag-overlay |
137 This must be bound to a button-down mouse event." | 173 start-point start-point |
138 (interactive "e") | 174 (window-buffer start-window)) |
139 (let (newmark) | 175 (setq mark-active nil) |
140 (let ((posn (event-start click)) | 176 (let (event end end-point) |
141 done event omark (mark-active t)) | |
142 (select-window (posn-window posn)) | |
143 (setq omark (and mark-active (mark))) | |
144 (if (numberp (posn-point posn)) | |
145 (goto-char (posn-point posn))) | |
146 ;; Set mark temporarily, so highlighting does what we want. | |
147 (set-marker (mark-marker) (point)) | |
148 (track-mouse | 177 (track-mouse |
149 (while (not done) | 178 (while (progn |
150 (setq event (read-event)) | 179 (setq event (read-event) |
151 (if (eq (car-safe event) 'mouse-movement) | 180 end (event-end event) |
152 (goto-char (posn-point (event-start event))) | 181 end-point (posn-point end)) |
153 ;; Exit when we get the drag event; ignore that event. | 182 (mouse-movement-p event)) |
154 (setq done t)))) | 183 ;; Is the mouse anywhere reasonable on the frame? |
155 (if (/= (mark) (point)) | 184 (if (windowp (posn-window end)) |
156 (setq newmark (mark))) | 185 ;; If the mouse is outside the current window, scroll it. |
157 ;; Restore previous mark status. | 186 (if (or (not (eq (posn-window end) start-window)) |
158 (if omark (set-marker (mark-marker) omark))) | 187 (not (integer-or-marker-p end-point))) |
159 ;; Now, if we dragged, set the mark at the proper place. | 188 ;; Which direction should we scroll the window? |
160 (if newmark | 189 (let ((mouse-row |
161 (push-mark newmark t t) | 190 (+ (nth 1 (window-edges (posn-window end))) |
162 ;; Turn off the old mark when we set up an empty region. | 191 (cdr (posn-col-row end))))) |
163 (setq deactivate-mark t)))) | 192 (cond |
193 ((< mouse-row top) | |
194 (mouse-scroll-subr | |
195 (- mouse-row top) mouse-drag-overlay start-point)) | |
196 ((and (not (eobp)) | |
197 (>= mouse-row bottom)) | |
198 (mouse-scroll-subr (1+ (- mouse-row bottom)) | |
199 mouse-drag-overlay start-point)))) | |
200 (goto-char end-point) | |
201 (move-overlay mouse-drag-overlay | |
202 start-point (point)))))) | |
203 (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) | |
204 (eq (posn-window (event-end event)) start-window) | |
205 (numberp (posn-point (event-end event)))) | |
206 (goto-char (posn-point (event-end event)))) | |
207 (if (= (point) start-point) | |
208 (setq mark-active nil) | |
209 (set-mark start-point)) | |
210 (delete-overlay mouse-drag-overlay)))) | |
211 | |
212 ;;;! (defun mouse-drag-region (click) | |
213 ;;;! "Set the region to the text that the mouse is dragged over. | |
214 ;;;! This must be bound to a button-down mouse event." | |
215 ;;;! (interactive "e") | |
216 ;;;! (let ((posn (event-start click)) | |
217 ;;;! done event (mark-active nil)) | |
218 ;;;! (select-window (posn-window posn)) | |
219 ;;;! ;; Set point temporarily, so user sees where it is. | |
220 ;;;! (if (numberp (posn-point posn)) | |
221 ;;;! (goto-char (posn-point posn))) | |
222 ;;;! ;; Turn off the old mark when we set up an empty region. | |
223 ;;;! (setq deactivate-mark t))) | |
224 ;;;! | |
225 ;;;! ;;;Nice hack, but too slow, so not normally in use. | |
226 ;;;! (defun mouse-drag-region-1 (click) | |
227 ;;;! "Set the region to the text that the mouse is dragged over. | |
228 ;;;! This must be bound to a button-down mouse event." | |
229 ;;;! (interactive "e") | |
230 ;;;! (let (newmark) | |
231 ;;;! (let ((posn (event-start click)) | |
232 ;;;! done event omark (mark-active t)) | |
233 ;;;! (select-window (posn-window posn)) | |
234 ;;;! (setq omark (and mark-active (mark))) | |
235 ;;;! (if (numberp (posn-point posn)) | |
236 ;;;! (goto-char (posn-point posn))) | |
237 ;;;! ;; Set mark temporarily, so highlighting does what we want. | |
238 ;;;! (set-marker (mark-marker) (point)) | |
239 ;;;! (track-mouse | |
240 ;;;! (while (not done) | |
241 ;;;! (setq event (read-event)) | |
242 ;;;! (if (eq (car-safe event) 'mouse-movement) | |
243 ;;;! (goto-char (posn-point (event-start event))) | |
244 ;;;! ;; Exit when we get the drag event; ignore that event. | |
245 ;;;! (setq done t)))) | |
246 ;;;! (if (/= (mark) (point)) | |
247 ;;;! (setq newmark (mark))) | |
248 ;;;! ;; Restore previous mark status. | |
249 ;;;! (if omark (set-marker (mark-marker) omark))) | |
250 ;;;! ;; Now, if we dragged, set the mark at the proper place. | |
251 ;;;! (if newmark | |
252 ;;;! (push-mark newmark t t) | |
253 ;;;! ;; Turn off the old mark when we set up an empty region. | |
254 ;;;! (setq deactivate-mark t)))) | |
164 | 255 |
165 ;; Subroutine: set the mark where CLICK happened, | 256 ;; Subroutine: set the mark where CLICK happened, |
166 ;; but don't do anything else. | 257 ;; but don't do anything else. |
167 (defun mouse-set-mark-fast (click) | 258 (defun mouse-set-mark-fast (click) |
168 (let ((posn (event-start click))) | 259 (let ((posn (event-start click))) |