Mercurial > emacs
diff lisp/mouse.el @ 4738:76a2ea569de5
(mouse-set-region): Put region in kill ring.
(mouse-drag-region): Handle double and triple clicks
when displaying region and when setting it.
(mouse-skip-word, mouse-start-end): New functions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 17 Sep 1993 21:26:18 +0000 |
parents | 168bcc1aeea3 |
children | c63ce262aa4d |
line wrap: on
line diff
--- a/lisp/mouse.el Fri Sep 17 18:52:33 1993 +0000 +++ b/lisp/mouse.el Fri Sep 17 21:26:18 1993 +0000 @@ -106,7 +106,7 @@ (goto-char (posn-point posn))))) (defun mouse-set-region (click) - "Set the region to the text that the mouse is dragged over. + "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event." (interactive "e") (let ((posn (event-start click)) @@ -121,7 +121,11 @@ (push-mark) (set-mark (point)) (if (numberp (posn-point end)) - (goto-char (posn-point end))))) + (goto-char (posn-point end))) + ;; Don't set this-command to kill-region, so that a following + ;; C-w will not double the text in the kill ring. + (let (this-command) + (copy-region-as-kill (mark) (point))))) (defvar mouse-scroll-delay 0.25 "*The pause between scroll steps caused by mouse drags, in seconds. @@ -174,11 +178,12 @@ (bottom (if (window-minibuffer-p start-window) (nth 3 bounds) ;; Don't count the mode line. - (1- (nth 3 bounds))))) + (1- (nth 3 bounds)))) + (click-count (1- (event-click-count start-event)))) (mouse-set-point start-event) - (move-overlay mouse-drag-overlay - start-point start-point - (window-buffer start-window)) + (let ((range (mouse-start-end start-point start-point click-count))) + (move-overlay mouse-drag-overlay (car range) (nth 1 range) + (window-buffer start-window))) (deactivate-mark) (let (event end end-point) (track-mouse @@ -201,8 +206,8 @@ ((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))) + (let ((range (mouse-start-end start-point (point) click-count))) + (move-overlay mouse-drag-overlay (car range) (nth 1 range)))) ;; Are we moving on a different window on the same frame? ((and (windowp (posn-window end)) @@ -233,56 +238,74 @@ (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)))) - (progn - (mouse-set-point event) - (if (= (point) start-point) - (deactivate-mark) - (set-mark start-point)))) + (let ((fun (key-binding (vector (car event))))) + (if (memq fun '(mouse-set-region mouse-set-point)) + (progn + (push-mark (overlay-start mouse-drag-overlay) t t) + (goto-char (overlay-end mouse-drag-overlay))) + (if (fboundp fun) + (funcall fun event))))) (delete-overlay mouse-drag-overlay)))) + +;; Commands to handle xterm-style multiple clicks. + +(defun mouse-skip-word (dir) + "Skip over word, over whitespace, or over identical punctuation. +If DIR is positive skip forward; if negative, skip backward." + (let* ((char (following-char)) + (syntax (char-to-string (char-syntax char)))) + (if (or (string= syntax "w") (string= syntax " ")) + (if (< dir 0) + (skip-syntax-backward syntax) + (skip-syntax-forward syntax)) + (if (< dir 0) + (while (= (preceding-char) char) + (forward-char -1)) + (while (= (following-char) char) + (forward-char 1)))))) -;;;! (defun mouse-drag-region (click) -;;;! "Set the region to the text that the mouse is dragged over. -;;;! This must be bound to a button-down mouse event." -;;;! (interactive "e") -;;;! (let ((posn (event-start click)) -;;;! done event (mark-active nil)) -;;;! (select-window (posn-window posn)) -;;;! ;; Set point temporarily, so user sees where it is. -;;;! (if (numberp (posn-point posn)) -;;;! (goto-char (posn-point posn))) -;;;! ;; Turn off the old mark when we set up an empty region. -;;;! (setq deactivate-mark t))) -;;;! -;;;! ;;;Nice hack, but too slow, so not normally in use. -;;;! (defun mouse-drag-region-1 (click) -;;;! "Set the region to the text that the mouse is dragged over. -;;;! This must be bound to a button-down mouse event." -;;;! (interactive "e") -;;;! (let (newmark) -;;;! (let ((posn (event-start click)) -;;;! done event omark (mark-active t)) -;;;! (select-window (posn-window posn)) -;;;! (setq omark (and mark-active (mark))) -;;;! (if (numberp (posn-point posn)) -;;;! (goto-char (posn-point posn))) -;;;! ;; Set mark temporarily, so highlighting does what we want. -;;;! (set-marker (mark-marker) (point)) -;;;! (track-mouse -;;;! (while (not done) -;;;! (setq event (read-event)) -;;;! (if (eq (car-safe event) 'mouse-movement) -;;;! (goto-char (posn-point (event-start event))) -;;;! ;; Exit when we get the drag event; ignore that event. -;;;! (setq done t)))) -;;;! (if (/= (mark) (point)) -;;;! (setq newmark (mark))) -;;;! ;; Restore previous mark status. -;;;! (if omark (set-marker (mark-marker) omark))) -;;;! ;; Now, if we dragged, set the mark at the proper place. -;;;! (if newmark -;;;! (push-mark newmark t t) -;;;! ;; Turn off the old mark when we set up an empty region. -;;;! (setq deactivate-mark t)))) +;; Return a list of region bounds based on START and END according to MODE. +;; If MODE is 0 then set point to (min START END), mark to (max START END). +;; If MODE is 1 then set point to start of word at (min START END), +;; mark to end of word at (max START END). +;; If MODE is 2 then do the same for lines. +;; Optional KEEP-END if non-nil means do not change end. +(defun mouse-start-end (start end mode &optional keep-end) + (if (> start end) + (let ((temp start)) + (setq start end + end temp))) + (cond ((= mode 0) + (list start end)) + ((and (= mode 1) + (= start end) + (= (char-syntax (char-after start)) ?\()) + (list start (save-excursion (forward-sexp 1) (point)))) + ((and (= mode 1) + (= start end) + (= (char-syntax (char-after start)) ?\))) + (list (save-excursion + (goto-char (1+ start)) + (backward-sexp 1)) + (1+ start))) + ((= mode 1) + (list (save-excursion + (goto-char start) + (mouse-skip-word -1) + (point)) + (save-excursion + (goto-char end) + (mouse-skip-word 1) + (point)))) + ((= mode 2) + (list (save-excursion + (goto-char start) + (beginning-of-line 1) + (point)) + (save-excursion + (goto-char end) + (forward-line 1) + (point)))))) ;; Subroutine: set the mark where CLICK happened, ;; but don't do anything else. @@ -983,6 +1006,10 @@ (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) +;; These are tested for in mouse-drag-region. +(global-set-key [double-mouse-1] 'mouse-set-point) +(global-set-key [triple-mouse-1] 'mouse-set-point) + (global-set-key [mouse-2] 'mouse-yank-at-click) (global-set-key [mouse-3] 'mouse-save-then-kill)