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)))