Mercurial > emacs

comparison lisp/mouse.el @ 65640:906677409870

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(mouse-move-drag-overlay): New function. (mouse-drag-region-1): Use it. Try to simplify a bit the state handling. Handle clicks on links inside intangible areas. (mouse-save-then-kill): Minor simplification. (mouse-secondary-overlay): Make it always non-nil instead of recreating it each time. (mouse-start-secondary, mouse-set-secondary, mouse-drag-secondary) (mouse-kill-secondary, mouse-secondary-save-then-kill): Simplify accordingly.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 21 Sep 2005 20:24:00 +0000
parents fcbaf6135d19
children b16e4baf1a72
comparison
equal deleted inserted replaced
65639:f552d54d9430 65640:906677409870
741 (sit-for mouse-scroll-delay))))) 741 (sit-for mouse-scroll-delay)))))
742 (or (eq window (selected-window)) 742 (or (eq window (selected-window))
743 (goto-char opoint)))) 743 (goto-char opoint))))
744 744
745 ;; Create an overlay and immediately delete it, to get "overlay in no buffer". 745 ;; Create an overlay and immediately delete it, to get "overlay in no buffer".
746 (defvar mouse-drag-overlay (make-overlay 1 1)) 746 (defconst mouse-drag-overlay
747 (delete-overlay mouse-drag-overlay) 747 (let ((ol (make-overlay (point-min) (point-min))))
748 (overlay-put mouse-drag-overlay 'face 'region) 748 (delete-overlay ol)
749 (overlay-put ol 'face 'region)
750 ol))
749 751
750 (defvar mouse-selection-click-count 0) 752 (defvar mouse-selection-click-count 0)
751 753
752 (defvar mouse-selection-click-count-buffer nil) 754 (defvar mouse-selection-click-count-buffer nil)
753 755
854 (< mouse-1-click-follows-link 0)) "Long ") 856 (< mouse-1-click-follows-link 0)) "Long ")
855 (t "")) 857 (t ""))
856 "mouse-1" (substring msg 7))))))) 858 "mouse-1" (substring msg 7)))))))
857 msg) 859 msg)
858 860
861 (defun mouse-move-drag-overlay (ol start end mode)
862 (unless (= start end)
863 ;; Go to START first, so that when we move to END, if it's in the middle
864 ;; of intangible text, point jumps in the direction away from START.
865 ;; Don't do it if START=END otherwise a single click risks selecting
866 ;; a region if it's on intangible text. This exception was originally
867 ;; only applied on entry to mouse-drag-region, which had the problem
868 ;; that a tiny move during a single-click would cause the intangible
869 ;; text to be selected.
870 (goto-char start)
871 (goto-char end))
872 (let ((range (mouse-start-end start (point) mode)))
873 (move-overlay ol (car range) (nth 1 range))))
874
859 (defun mouse-drag-region-1 (start-event) 875 (defun mouse-drag-region-1 (start-event)
860 (mouse-minibuffer-check start-event) 876 (mouse-minibuffer-check start-event)
861 (let* ((echo-keystrokes 0) 877 (setq mouse-selection-click-count-buffer (current-buffer))
878 (let* ((original-window (selected-window))
879 ;; We've recorded what we needed from the current buffer and
880 ;; window, now let's jump to the place of the event, where things
881 ;; are happening.
882 (_ (mouse-set-point start-event))
883 (echo-keystrokes 0)
862 (start-posn (event-start start-event)) 884 (start-posn (event-start start-event))
863 (start-point (posn-point start-posn)) 885 (start-point (posn-point start-posn))
864 (start-window (posn-window start-posn)) 886 (start-window (posn-window start-posn))
865 (start-window-start (window-start start-window)) 887 (start-window-start (window-start start-window))
866 (start-hscroll (window-hscroll start-window)) 888 (start-hscroll (window-hscroll start-window))
871 (nth 3 bounds) 893 (nth 3 bounds)
872 ;; Don't count the mode line. 894 ;; Don't count the mode line.
873 (1- (nth 3 bounds)))) 895 (1- (nth 3 bounds))))
874 (on-link (and mouse-1-click-follows-link 896 (on-link (and mouse-1-click-follows-link
875 (or mouse-1-click-in-non-selected-windows 897 (or mouse-1-click-in-non-selected-windows
876 (eq start-window (selected-window))))) 898 (eq start-window original-window))
877 remap-double-click 899 ;; Use start-point before the intangibility
878 (click-count (1- (event-click-count start-event)))) 900 ;; treatment, in case we click on a link inside an
901 ;; intangible text.
902 (mouse-on-link-p start-point)))
903 (click-count (1- (event-click-count start-event)))
904 (remap-double-click (and on-link
905 (eq mouse-1-click-follows-link 'double)
906 (= click-count 1))))
879 (setq mouse-selection-click-count click-count) 907 (setq mouse-selection-click-count click-count)
880 (setq mouse-selection-click-count-buffer (current-buffer))
881 (mouse-set-point start-event)
882 ;; In case the down click is in the middle of some intangible text, 908 ;; In case the down click is in the middle of some intangible text,
883 ;; use the end of that text, and put it in START-POINT. 909 ;; use the end of that text, and put it in START-POINT.
884 (if (< (point) start-point) 910 (if (< (point) start-point)
885 (goto-char start-point)) 911 (goto-char start-point))
886 (setq start-point (point)) 912 (setq start-point (point))
887 (setq on-link (and on-link 913 (if remap-double-click ;; Don't expand mouse overlay in links
888 (mouse-on-link-p start-point)))
889 (setq remap-double-click (and on-link
890 (eq mouse-1-click-follows-link 'double)
891 (= click-count 1)))
892 (if remap-double-click ;; Don't expand mouse overlay in links
893 (setq click-count 0)) 914 (setq click-count 0))
894 (let ((range (mouse-start-end start-point start-point click-count))) 915 (mouse-move-drag-overlay mouse-drag-overlay start-point start-point
895 (move-overlay mouse-drag-overlay (car range) (nth 1 range) 916 click-count)
896 (window-buffer start-window)) 917 (overlay-put mouse-drag-overlay 'window start-window)
897 (overlay-put mouse-drag-overlay 'window (selected-window)))
898 (deactivate-mark) 918 (deactivate-mark)
899 (let (event end end-point last-end-point) 919 (let (event end end-point last-end-point)
900 (track-mouse 920 (track-mouse
901 (while (progn 921 (while (progn
902 (setq event (read-event)) 922 (setq event (read-event))
903 (or (mouse-movement-p event) 923 (or (mouse-movement-p event)
904 (memq (car-safe event) '(switch-frame select-window)))) 924 (memq (car-safe event) '(switch-frame select-window))))
905 (if (memq (car-safe event) '(switch-frame select-window)) 925 (if (memq (car-safe event) '(switch-frame select-window))
906 nil 926 nil
907 (setq end (event-end event) 927 (setq end (event-end event)
908 end-point (posn-point end)) 928 end-point (posn-point end))
909 (if (numberp end-point) 929 (if (numberp end-point)
910 (setq last-end-point end-point)) 930 (setq last-end-point end-point))
911 931
912 (cond 932 (cond
913 ;; Are we moving within the original window? 933 ;; Are we moving within the original window?
914 ((and (eq (posn-window end) start-window) 934 ((and (eq (posn-window end) start-window)
915 (integer-or-marker-p end-point)) 935 (integer-or-marker-p end-point))
916 ;; Go to START-POINT first, so that when we move to END-POINT, 936 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
917 ;; if it's in the middle of intangible text,
918 ;; point jumps in the direction away from START-POINT.
919 (goto-char start-point)
920 (goto-char end-point)
921 (let ((range (mouse-start-end start-point (point) click-count)))
922 (move-overlay mouse-drag-overlay (car range) (nth 1 range))))
923 937
924 (t 938 (t
925 (let ((mouse-row (cdr (cdr (mouse-position))))) 939 (let ((mouse-row (cdr (cdr (mouse-position)))))
926 (cond 940 (cond
927 ((null mouse-row)) 941 ((null mouse-row))
928 ((< mouse-row top) 942 ((< mouse-row top)
929 (mouse-scroll-subr start-window (- mouse-row top) 943 (mouse-scroll-subr start-window (- mouse-row top)
930 mouse-drag-overlay start-point)) 944 mouse-drag-overlay start-point))
931 ((>= mouse-row bottom) 945 ((>= mouse-row bottom)
932 (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) 946 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
933 mouse-drag-overlay start-point))))))))) 947 mouse-drag-overlay start-point)))))))))
934 948
935 ;; In case we did not get a mouse-motion event 949 ;; In case we did not get a mouse-motion event
936 ;; for the final move of the mouse before a drag event 950 ;; for the final move of the mouse before a drag event
937 ;; pretend that we did get one. 951 ;; pretend that we did get one.
938 (when (and (memq 'drag (event-modifiers (car-safe event))) 952 (when (and (memq 'drag (event-modifiers (car-safe event)))
939 (setq end (event-end event) 953 (setq end (event-end event)
940 end-point (posn-point end)) 954 end-point (posn-point end))
941 (eq (posn-window end) start-window) 955 (eq (posn-window end) start-window)
942 (integer-or-marker-p end-point)) 956 (integer-or-marker-p end-point))
943 ;; Go to START-POINT first, so that when we move to END-POINT, 957 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
944 ;; if it's in the middle of intangible text,
945 ;; point jumps in the direction away from START-POINT.
946 (goto-char start-point)
947 (goto-char end-point)
948 (let ((range (mouse-start-end start-point (point) click-count)))
949 (move-overlay mouse-drag-overlay (car range) (nth 1 range))))
950 958
951 (if (consp event) 959 (if (consp event)
952 (let ((fun (key-binding (vector (car event))))) 960 (let ((fun (key-binding (vector (car event)))))
953 ;; Run the binding of the terminating up-event, if possible. 961 ;; Run the binding of the terminating up-event, if possible.
954 ;; In the case of a multiple click, it gives the wrong results, 962 ;; In the case of a multiple click, it gives the wrong results,
955 ;; because it would fail to set up a region. 963 ;; because it would fail to set up a region.
956 (if (not (= (overlay-start mouse-drag-overlay) 964 (if (not (= (overlay-start mouse-drag-overlay)
957 (overlay-end mouse-drag-overlay))) 965 (overlay-end mouse-drag-overlay)))
958 (let* ((stop-point 966 (let* ((stop-point
959 (if (numberp (posn-point (event-end event))) 967 (if (numberp (posn-point (event-end event)))
960 (posn-point (event-end event)) 968 (posn-point (event-end event))
961 last-end-point)) 969 last-end-point))
962 ;; The end that comes from where we ended the drag. 970 ;; The end that comes from where we ended the drag.
963 ;; Point goes here. 971 ;; Point goes here.
964 (region-termination 972 (region-termination
965 (if (and stop-point (< stop-point start-point)) 973 (if (and stop-point (< stop-point start-point))
966 (overlay-start mouse-drag-overlay) 974 (overlay-start mouse-drag-overlay)
967 (overlay-end mouse-drag-overlay))) 975 (overlay-end mouse-drag-overlay)))
968 ;; The end that comes from where we started the drag. 976 ;; The end that comes from where we started the drag.
969 ;; Mark goes there. 977 ;; Mark goes there.
970 (region-commencement 978 (region-commencement
971 (- (+ (overlay-end mouse-drag-overlay) 979 (- (+ (overlay-end mouse-drag-overlay)
972 (overlay-start mouse-drag-overlay)) 980 (overlay-start mouse-drag-overlay))
973 region-termination)) 981 region-termination))
974 last-command this-command) 982 last-command this-command)
975 (push-mark region-commencement t t) 983 (push-mark region-commencement t t)
976 (goto-char region-termination) 984 (goto-char region-termination)
977 ;; Don't let copy-region-as-kill set deactivate-mark. 985 ;; Don't let copy-region-as-kill set deactivate-mark.
978 (when mouse-drag-copy-region 986 (when mouse-drag-copy-region
979 (let (deactivate-mark) 987 (let (deactivate-mark)
980 (copy-region-as-kill (point) (mark t)))) 988 (copy-region-as-kill (point) (mark t))))
981 (let ((buffer (current-buffer))) 989 (let ((buffer (current-buffer)))
982 (mouse-show-mark) 990 (mouse-show-mark)
983 ;; mouse-show-mark can call read-event, 991 ;; mouse-show-mark can call read-event,
984 ;; and that means the Emacs server could switch buffers 992 ;; and that means the Emacs server could switch buffers
985 ;; under us. If that happened, 993 ;; under us. If that happened,
986 ;; avoid trying to use the region. 994 ;; avoid trying to use the region.
987 (and (mark t) mark-active 995 (and (mark t) mark-active
988 (eq buffer (current-buffer)) 996 (eq buffer (current-buffer))
989 (mouse-set-region-1)))) 997 (mouse-set-region-1))))
990 (delete-overlay mouse-drag-overlay) 998 (delete-overlay mouse-drag-overlay)
991 ;; Run the binding of the terminating up-event. 999 ;; Run the binding of the terminating up-event.
992 (when (and (functionp fun) 1000 (when (and (functionp fun)
993 (= start-hscroll (window-hscroll start-window)) 1001 (= start-hscroll (window-hscroll start-window))
994 ;; Don't run the up-event handler if the 1002 ;; Don't run the up-event handler if the
995 ;; window start changed in a redisplay after 1003 ;; window start changed in a redisplay after
996 ;; the mouse-set-point for the down-mouse 1004 ;; the mouse-set-point for the down-mouse
997 ;; event at the beginning of this function. 1005 ;; event at the beginning of this function.
998 ;; When the window start has changed, the 1006 ;; When the window start has changed, the
999 ;; up-mouse event will contain a different 1007 ;; up-mouse event will contain a different
1000 ;; position due to the new window contents, 1008 ;; position due to the new window contents,
1001 ;; and point is set again. 1009 ;; and point is set again.
1002 (or end-point 1010 (or end-point
1003 (= (window-start start-window) 1011 (= (window-start start-window)
1004 start-window-start))) 1012 start-window-start)))
1005 (if (and on-link 1013 (if (and on-link
1006 (or (not end-point) (= end-point start-point)) 1014 (or (not end-point) (= end-point start-point))
1007 (consp event) 1015 (consp event)
1008 (or remap-double-click 1016 (or remap-double-click
1009 (and 1017 (and
1010 (not (eq mouse-1-click-follows-link 'double)) 1018 (not (eq mouse-1-click-follows-link 'double))
1011 (= click-count 0) 1019 (= click-count 0)
1012 (= (event-click-count event) 1) 1020 (= (event-click-count event) 1)
1013 (not (input-pending-p)) 1021 (not (input-pending-p))
1014 (or (not (integerp mouse-1-click-follows-link)) 1022 (or (not (integerp mouse-1-click-follows-link))
1015 (let ((t0 (posn-timestamp (event-start start-event))) 1023 (let ((t0 (posn-timestamp (event-start start-event)))
1016 (t1 (posn-timestamp (event-end event)))) 1024 (t1 (posn-timestamp (event-end event))))
1017 (and (integerp t0) (integerp t1) 1025 (and (integerp t0) (integerp t1)
1018 (if (> mouse-1-click-follows-link 0) 1026 (if (> mouse-1-click-follows-link 0)
1019 (<= (- t1 t0) mouse-1-click-follows-link) 1027 (<= (- t1 t0) mouse-1-click-follows-link)
1020 (< (- t0 t1) mouse-1-click-follows-link))))) 1028 (< (- t0 t1) mouse-1-click-follows-link)))))
1021 (or (not double-click-time) 1029 (or (not double-click-time)
1022 (sit-for 0 (if (integerp double-click-time) 1030 (sit-for 0 (if (integerp double-click-time)
1023 double-click-time 500) t))))) 1031 double-click-time 500) t)))))
1024 (if (or (vectorp on-link) (stringp on-link)) 1032 (if (or (vectorp on-link) (stringp on-link))
1025 (setq event (aref on-link 0)) 1033 (setq event (aref on-link 0))
1026 (setcar event 'mouse-2))) 1034 (setcar event 'mouse-2)))
1027 (setq unread-command-events 1035 (push event unread-command-events))))
1028 (cons event unread-command-events))))) 1036
1037 ;; Case where the end-event is not a cons cell (it's just a boring
1038 ;; char-key-press).
1029 (delete-overlay mouse-drag-overlay))))) 1039 (delete-overlay mouse-drag-overlay)))))
1030 1040
1031 ;; Commands to handle xterm-style multiple clicks. 1041 ;; Commands to handle xterm-style multiple clicks.
1032
1033 (defun mouse-skip-word (dir) 1042 (defun mouse-skip-word (dir)
1034 "Skip over word, over whitespace, or over identical punctuation. 1043 "Skip over word, over whitespace, or over identical punctuation.
1035 If DIR is positive skip forward; if negative, skip backward." 1044 If DIR is positive skip forward; if negative, skip backward."
1036 (let* ((char (following-char)) 1045 (let* ((char (following-char))
1037 (syntax (char-to-string (char-syntax char)))) 1046 (syntax (char-to-string (char-syntax char))))
1336 (mouse-minibuffer-check click) 1345 (mouse-minibuffer-check click)
1337 (let ((click-posn (posn-point (event-start click))) 1346 (let ((click-posn (posn-point (event-start click)))
1338 ;; Don't let a subsequent kill command append to this one: 1347 ;; Don't let a subsequent kill command append to this one:
1339 ;; prevent setting this-command to kill-region. 1348 ;; prevent setting this-command to kill-region.
1340 (this-command this-command)) 1349 (this-command this-command))
1341 (if (and (save-excursion 1350 (if (and (with-current-buffer
1342 (set-buffer (window-buffer (posn-window (event-start click)))) 1351 (window-buffer (posn-window (event-start click)))
1343 (and (mark t) (> (mod mouse-selection-click-count 3) 0) 1352 (and (mark t) (> (mod mouse-selection-click-count 3) 0)
1344 ;; Don't be fooled by a recent click in some other buffer. 1353 ;; Don't be fooled by a recent click in some other buffer.
1345 (eq mouse-selection-click-count-buffer 1354 (eq mouse-selection-click-count-buffer
1346 (current-buffer))))) 1355 (current-buffer)))))
1347 (if (not (and (eq last-command 'mouse-save-then-kill) 1356 (if (not (and (eq last-command 'mouse-save-then-kill)
1400 ;; That is what xterm does, and it seems reasonable. 1409 ;; That is what xterm does, and it seems reasonable.
1401 (if (<= (abs (- new (point))) (abs (- new (mark t)))) 1410 (if (<= (abs (- new (point))) (abs (- new (mark t))))
1402 (goto-char new) 1411 (goto-char new)
1403 (set-mark new)) 1412 (set-mark new))
1404 (setq deactivate-mark nil))) 1413 (setq deactivate-mark nil)))
1405 (kill-new (buffer-substring (point) (mark t)) t) 1414 (kill-new (buffer-substring (point) (mark t)) t))
1406 (mouse-show-mark))
1407 ;; Set the mark where point is, then move where clicked. 1415 ;; Set the mark where point is, then move where clicked.
1408 (mouse-set-mark-fast click) 1416 (mouse-set-mark-fast click)
1409 (if before-scroll 1417 (if before-scroll
1410 (goto-char before-scroll)) 1418 (goto-char before-scroll))
1411 (exchange-point-and-mark) 1419 (exchange-point-and-mark) ;Why??? --Stef
1412 (kill-new (buffer-substring (point) (mark t))) 1420 (kill-new (buffer-substring (point) (mark t))))
1413 (mouse-show-mark)) 1421 (mouse-show-mark)
1414 (mouse-set-region-1) 1422 (mouse-set-region-1)
1415 (setq mouse-save-then-kill-posn 1423 (setq mouse-save-then-kill-posn
1416 (list (car kill-ring) (point) click-posn))))))) 1424 (list (car kill-ring) (point) click-posn)))))))
1417 1425
1418 (global-set-key [M-mouse-1] 'mouse-start-secondary) 1426 (global-set-key [M-mouse-1] 'mouse-start-secondary)
1419 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) 1427 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
1420 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary) 1428 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
1421 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill) 1429 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
1422 (global-set-key [M-mouse-2] 'mouse-yank-secondary) 1430 (global-set-key [M-mouse-2] 'mouse-yank-secondary)
1423 1431
1424 ;; An overlay which records the current secondary selection 1432 (defconst mouse-secondary-overlay
1425 ;; or else is deleted when there is no secondary selection. 1433 (let ((ol (make-overlay (point-min) (point-min))))
1426 ;; May be nil. 1434 (delete-overlay ol)
1427 (defvar mouse-secondary-overlay nil) 1435 (overlay-put ol 'face 'secondary-selection)
1436 ol)
1437 "An overlay which records the current secondary selection.
1438 It is deleted when there is no secondary selection.")
1428 1439
1429 (defvar mouse-secondary-click-count 0) 1440 (defvar mouse-secondary-click-count 0)
1430 1441
1431 ;; A marker which records the specified first end for a secondary selection. 1442 ;; A marker which records the specified first end for a secondary selection.
1432 ;; May be nil. 1443 ;; May be nil.
1437 Use \\[mouse-secondary-save-then-kill] to set the other end 1448 Use \\[mouse-secondary-save-then-kill] to set the other end
1438 and complete the secondary selection." 1449 and complete the secondary selection."
1439 (interactive "e") 1450 (interactive "e")
1440 (mouse-minibuffer-check click) 1451 (mouse-minibuffer-check click)
1441 (let ((posn (event-start click))) 1452 (let ((posn (event-start click)))
1442 (save-excursion 1453 (with-current-buffer (window-buffer (posn-window posn))
1443 (set-buffer (window-buffer (posn-window posn)))
1444 ;; Cancel any preexisting secondary selection. 1454 ;; Cancel any preexisting secondary selection.
1445 (if mouse-secondary-overlay 1455 (delete-overlay mouse-secondary-overlay)
1446 (delete-overlay mouse-secondary-overlay))
1447 (if (numberp (posn-point posn)) 1456 (if (numberp (posn-point posn))
1448 (progn 1457 (progn
1449 (or mouse-secondary-start 1458 (or mouse-secondary-start
1450 (setq mouse-secondary-start (make-marker))) 1459 (setq mouse-secondary-start (make-marker)))
1451 (move-marker mouse-secondary-start (posn-point posn))))))) 1460 (move-marker mouse-secondary-start (posn-point posn)))))))
1456 (interactive "e") 1465 (interactive "e")
1457 (mouse-minibuffer-check click) 1466 (mouse-minibuffer-check click)
1458 (let ((posn (event-start click)) 1467 (let ((posn (event-start click))
1459 beg 1468 beg
1460 (end (event-end click))) 1469 (end (event-end click)))
1461 (save-excursion 1470 (with-current-buffer (window-buffer (posn-window posn))
1462 (set-buffer (window-buffer (posn-window posn)))
1463 (if (numberp (posn-point posn)) 1471 (if (numberp (posn-point posn))
1464 (setq beg (posn-point posn))) 1472 (setq beg (posn-point posn)))
1465 (if mouse-secondary-overlay 1473 (move-overlay mouse-secondary-overlay beg (posn-point end)))))
1466 (move-overlay mouse-secondary-overlay beg (posn-point end))
1467 (setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
1468 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
1469 1474
1470 (defun mouse-drag-secondary (start-event) 1475 (defun mouse-drag-secondary (start-event)
1471 "Set the secondary selection to the text that the mouse is dragged over. 1476 "Set the secondary selection to the text that the mouse is dragged over.
1472 Highlight the drag area as you move the mouse. 1477 Highlight the drag area as you move the mouse.
1473 This must be bound to a button-down mouse event. 1478 This must be bound to a button-down mouse event.
1483 (bottom (if (window-minibuffer-p start-window) 1488 (bottom (if (window-minibuffer-p start-window)
1484 (nth 3 bounds) 1489 (nth 3 bounds)
1485 ;; Don't count the mode line. 1490 ;; Don't count the mode line.
1486 (1- (nth 3 bounds)))) 1491 (1- (nth 3 bounds))))
1487 (click-count (1- (event-click-count start-event)))) 1492 (click-count (1- (event-click-count start-event))))
1488 (save-excursion 1493 (with-current-buffer (window-buffer start-window)
1489 (set-buffer (window-buffer start-window))
1490 (setq mouse-secondary-click-count click-count) 1494 (setq mouse-secondary-click-count click-count)
1491 (or mouse-secondary-overlay
1492 (setq mouse-secondary-overlay
1493 (make-overlay (point) (point))))
1494 (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
1495 (if (> (mod click-count 3) 0) 1495 (if (> (mod click-count 3) 0)
1496 ;; Double or triple press: make an initial selection 1496 ;; Double or triple press: make an initial selection
1497 ;; of one word or line. 1497 ;; of one word or line.
1498 (let ((range (mouse-start-end start-point start-point click-count))) 1498 (let ((range (mouse-start-end start-point start-point click-count)))
1499 (set-marker mouse-secondary-start nil) 1499 (set-marker mouse-secondary-start nil)
1500 (move-overlay mouse-secondary-overlay 1 1 1500 ;; Why the double move? --Stef
1501 (window-buffer start-window)) 1501 ;; (move-overlay mouse-secondary-overlay 1 1
1502 ;; (window-buffer start-window))
1502 (move-overlay mouse-secondary-overlay (car range) (nth 1 range) 1503 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
1503 (window-buffer start-window))) 1504 (window-buffer start-window)))
1504 ;; Single-press: cancel any preexisting secondary selection. 1505 ;; Single-press: cancel any preexisting secondary selection.
1505 (or mouse-secondary-start 1506 (or mouse-secondary-start
1506 (setq mouse-secondary-start (make-marker))) 1507 (setq mouse-secondary-start (make-marker)))
1581 (if (listp click) 1582 (if (listp click)
1582 (window-buffer (posn-window (event-start click))) 1583 (window-buffer (posn-window (event-start click)))
1583 (current-buffer))) 1584 (current-buffer)))
1584 (error "Select or click on the buffer where the secondary selection is"))) 1585 (error "Select or click on the buffer where the secondary selection is")))
1585 (let (this-command) 1586 (let (this-command)
1586 (save-excursion 1587 (with-current-buffer (overlay-buffer mouse-secondary-overlay)
1587 (set-buffer (overlay-buffer mouse-secondary-overlay))
1588 (kill-region (overlay-start mouse-secondary-overlay) 1588 (kill-region (overlay-start mouse-secondary-overlay)
1589 (overlay-end mouse-secondary-overlay)))) 1589 (overlay-end mouse-secondary-overlay))))
1590 (delete-overlay mouse-secondary-overlay) 1590 (delete-overlay mouse-secondary-overlay)
1591 ;;; (x-set-selection 'SECONDARY nil) 1591 ;;; (x-set-selection 'SECONDARY nil)
1592 (setq mouse-secondary-overlay nil)) 1592 )
1593 1593
1594 (defun mouse-secondary-save-then-kill (click) 1594 (defun mouse-secondary-save-then-kill (click)
1595 "Save text to point in kill ring; the second time, kill the text. 1595 "Save text to point in kill ring; the second time, kill the text.
1596 You must use this in a buffer where you have recently done \\[mouse-start-secondary]. 1596 You must use this in a buffer where you have recently done \\[mouse-start-secondary].
1597 If the text between where you did \\[mouse-start-secondary] and where 1597 If the text between where you did \\[mouse-start-secondary] and where
1610 (click-posn (posn-point (event-start click))) 1610 (click-posn (posn-point (event-start click)))
1611 ;; Don't let a subsequent kill command append to this one: 1611 ;; Don't let a subsequent kill command append to this one:
1612 ;; prevent setting this-command to kill-region. 1612 ;; prevent setting this-command to kill-region.
1613 (this-command this-command)) 1613 (this-command this-command))
1614 (or (eq (window-buffer (posn-window posn)) 1614 (or (eq (window-buffer (posn-window posn))
1615 (or (and mouse-secondary-overlay 1615 (or (overlay-buffer mouse-secondary-overlay)
1616 (overlay-buffer mouse-secondary-overlay))
1617 (if mouse-secondary-start 1616 (if mouse-secondary-start
1618 (marker-buffer mouse-secondary-start)))) 1617 (marker-buffer mouse-secondary-start))))
1619 (error "Wrong buffer")) 1618 (error "Wrong buffer"))
1620 (save-excursion 1619 (with-current-buffer (window-buffer (posn-window posn))
1621 (set-buffer (window-buffer (posn-window posn)))
1622 (if (> (mod mouse-secondary-click-count 3) 0) 1620 (if (> (mod mouse-secondary-click-count 3) 0)
1623 (if (not (and (eq last-command 'mouse-secondary-save-then-kill) 1621 (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
1624 (equal click-posn 1622 (equal click-posn
1625 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) 1623 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
1626 ;; Find both ends of the object selected by this click. 1624 ;; Find both ends of the object selected by this click.
1695 (if mouse-secondary-start 1693 (if mouse-secondary-start
1696 ;; All we have is one end of a selection, 1694 ;; All we have is one end of a selection,
1697 ;; so put the other end here. 1695 ;; so put the other end here.
1698 (let ((start (+ 0 mouse-secondary-start))) 1696 (let ((start (+ 0 mouse-secondary-start)))
1699 (kill-ring-save start click-posn) 1697 (kill-ring-save start click-posn)
1700 (if mouse-secondary-overlay 1698 (move-overlay mouse-secondary-overlay start click-posn))))
1701 (move-overlay mouse-secondary-overlay start click-posn)
1702 (setq mouse-secondary-overlay (make-overlay start click-posn)))
1703 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
1704 (setq mouse-save-then-kill-posn 1699 (setq mouse-save-then-kill-posn
1705 (list (car kill-ring) (point) click-posn)))) 1700 (list (car kill-ring) (point) click-posn))))
1706 (if (overlay-buffer mouse-secondary-overlay) 1701 (if (overlay-buffer mouse-secondary-overlay)
1707 (x-set-selection 'SECONDARY 1702 (x-set-selection 'SECONDARY
1708 (buffer-substring 1703 (buffer-substring