;; Mouse hacks ;; Based on ime-emacs.el by Arnaldo Mandel (version sep/93) ;; Adapted by Jorge Stolfi on 93-09-23 ;;; Until the polls come out: (defun mouse-drag-region (start-event) "Set the region to the text that the mouse is dragged over. Highlight the drag area as the user moves the mouse. This must be bound to a button-down mouse event." (interactive "e") (let* ((start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) (start-frame (window-frame start-window)) (bounds (window-edges start-window)) (top (nth 1 bounds)) (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds))))) (select-window start-window) (goto-char start-point) (move-overlay mouse-drag-overlay start-point start-point (window-buffer start-window)) (deactivate-mark) (let (event end end-point) (track-mouse (while (progn (setq event (read-event)) (or (mouse-movement-p event) (eq (car-safe event) 'switch-frame))) (if (eq (car-safe event) 'switch-frame) nil (setq end (event-end event) end-point (posn-point end)) (cond ;; Ignore switch-frame events. ((eq (car-safe event) 'switch-frame)) ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (goto-char end-point) (move-overlay mouse-drag-overlay start-point (point))) ;; Are we moving on a different window on the same frame? ((and (windowp (posn-window end)) (eq (window-frame (posn-window end)) start-frame)) (let ((mouse-row (+ (nth 1 (window-edges (posn-window end))) (cdr (posn-col-row end))))) (cond ((< mouse-row top) (mouse-scroll-subr (- mouse-row top) mouse-drag-overlay start-point)) ((and (not (eobp)) (>= mouse-row bottom)) (mouse-scroll-subr (1+ (- mouse-row bottom)) mouse-drag-overlay start-point))))) ;; Otherwise, we have no idea where the mouse is. (t))))) (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) (eq (posn-window (event-end event)) start-window) (numberp (posn-point (event-end event)))) (goto-char (posn-point (event-end event)))) (if (= (point) start-point) (deactivate-mark) (set-mark start-point) (kill-new (buffer-substring (point) (mark)))) (delete-overlay mouse-drag-overlay))))