Mercurial > emacs
comparison lisp/mouse.el @ 65640:906677409870
(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 |