diff options
| author | Chong Yidong | 2012-07-08 16:26:21 +0800 |
|---|---|---|
| committer | Chong Yidong | 2012-07-08 16:26:21 +0800 |
| commit | 01ac65bd7c0df6c895bf18810ee5c8d24704681a (patch) | |
| tree | 2c595fce43a388b9bee4aa461c894a3deaf6f08b | |
| parent | d75be97d549b7264098ff19f8941a0dd80bde080 (diff) | |
| download | emacs-01ac65bd7c0df6c895bf18810ee5c8d24704681a.tar.gz emacs-01ac65bd7c0df6c895bf18810ee5c8d24704681a.zip | |
Fix interaction of line-dragging with mouse-1-click-follows-link.
* lisp/mouse.el (mouse-drag-line): Rewrite the track-mouse loop.
Implement the mouse-1-click-follows-link handling properly.
* lisp/info.el (Info-link-keymap): Use follow-link mechanism for
header-line links.
Fixes: debbugs:374
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/info.el | 4 | ||||
| -rw-r--r-- | lisp/mouse.el | 156 |
3 files changed, 67 insertions, 99 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8a608ea7b10..dbe37763d7a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,11 @@ | |||
| 1 | 2012-07-08 Chong Yidong <cyd@gnu.org> | 1 | 2012-07-08 Chong Yidong <cyd@gnu.org> |
| 2 | 2 | ||
| 3 | * mouse.el (mouse-drag-line): Rewrite the track-mouse loop. | ||
| 4 | Implement the mouse-1-click-follows-link handling properly. | ||
| 5 | |||
| 6 | * info.el (Info-link-keymap): Use follow-link mechanism for | ||
| 7 | header-line links (Bug#374). | ||
| 8 | |||
| 3 | * simple.el (deactivate-mark): Do not set the primary selection | 9 | * simple.el (deactivate-mark): Do not set the primary selection |
| 4 | if another program has acquired it (Bug#11772). | 10 | if another program has acquired it (Bug#11772). |
| 5 | 11 | ||
diff --git a/lisp/info.el b/lisp/info.el index 9a62bc23fd0..0afb3f01339 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -4361,9 +4361,9 @@ the variable `Info-file-list-for-emacs'." | |||
| 4361 | 4361 | ||
| 4362 | (defvar Info-link-keymap | 4362 | (defvar Info-link-keymap |
| 4363 | (let ((keymap (make-sparse-keymap))) | 4363 | (let ((keymap (make-sparse-keymap))) |
| 4364 | (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link) | 4364 | (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line) |
| 4365 | (define-key keymap [header-line mouse-1] 'mouse-select-window) | ||
| 4365 | (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link) | 4366 | (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link) |
| 4366 | (define-key keymap [header-line down-mouse-1] 'ignore) | ||
| 4367 | (define-key keymap [mouse-2] 'Info-mouse-follow-link) | 4367 | (define-key keymap [mouse-2] 'Info-mouse-follow-link) |
| 4368 | (define-key keymap [follow-link] 'mouse-face) | 4368 | (define-key keymap [follow-link] 'mouse-face) |
| 4369 | keymap) | 4369 | keymap) |
diff --git a/lisp/mouse.el b/lisp/mouse.el index c130a27a8e4..a0d10a64945 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -388,10 +388,11 @@ This command must be bound to a mouse click." | |||
| 388 | 388 | ||
| 389 | ;; Note that `window-in-direction' replaces `mouse-drag-window-above' | 389 | ;; Note that `window-in-direction' replaces `mouse-drag-window-above' |
| 390 | ;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. | 390 | ;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. |
| 391 | |||
| 391 | (defun mouse-drag-line (start-event line) | 392 | (defun mouse-drag-line (start-event line) |
| 392 | "Drag some line with the mouse. | 393 | "Drag a mode line, header line, or vertical line with the mouse. |
| 393 | START-EVENT is the starting mouse-event of the drag action. LINE | 394 | START-EVENT is the starting mouse-event of the drag action. LINE |
| 394 | must be one of the symbols header, mode, or vertical." | 395 | must be one of the symbols `header', `mode', or `vertical'." |
| 395 | ;; Give temporary modes such as isearch a chance to turn off. | 396 | ;; Give temporary modes such as isearch a chance to turn off. |
| 396 | (run-hooks 'mouse-leave-buffer-hook) | 397 | (run-hooks 'mouse-leave-buffer-hook) |
| 397 | (let* ((echo-keystrokes 0) | 398 | (let* ((echo-keystrokes 0) |
| @@ -400,122 +401,85 @@ must be one of the symbols header, mode, or vertical." | |||
| 400 | (frame (window-frame window)) | 401 | (frame (window-frame window)) |
| 401 | (minibuffer-window (minibuffer-window frame)) | 402 | (minibuffer-window (minibuffer-window frame)) |
| 402 | (on-link (and mouse-1-click-follows-link | 403 | (on-link (and mouse-1-click-follows-link |
| 403 | (or mouse-1-click-in-non-selected-windows | ||
| 404 | (eq window (selected-window))) | ||
| 405 | (mouse-on-link-p start))) | 404 | (mouse-on-link-p start))) |
| 406 | (resize-minibuffer | 405 | (side (and (eq line 'vertical) |
| 407 | ;; Resize the minibuffer window if it's on the same frame as | 406 | (or (cdr (assq 'vertical-scroll-bars |
| 408 | ;; and immediately below the position window and it's either | 407 | (frame-parameters frame))) |
| 409 | ;; active or `resize-mini-windows' is nil. | 408 | 'right))) |
| 410 | (and (eq line 'mode) | 409 | (draggable t) |
| 411 | (eq (window-frame minibuffer-window) frame) | 410 | event position growth dragged) |
| 412 | (= (nth 1 (window-edges minibuffer-window)) | ||
| 413 | (nth 3 (window-edges window))) | ||
| 414 | (or (not resize-mini-windows) | ||
| 415 | (eq minibuffer-window (active-minibuffer-window))))) | ||
| 416 | (which-side | ||
| 417 | (and (eq line 'vertical) | ||
| 418 | (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame))) | ||
| 419 | 'right))) | ||
| 420 | done event mouse growth dragged) | ||
| 421 | (cond | 411 | (cond |
| 422 | ((eq line 'header) | 412 | ((eq line 'header) |
| 423 | ;; Check whether header-line can be dragged at all. | 413 | ;; Check whether header-line can be dragged at all. |
| 424 | (if (window-at-side-p window 'top) | 414 | (if (window-at-side-p window 'top) |
| 425 | (setq done t) | 415 | (setq draggable nil) |
| 426 | (setq window (window-in-direction 'above window t)))) | 416 | (setq window (window-in-direction 'above window t)))) |
| 427 | ((eq line 'mode) | 417 | ((eq line 'mode) |
| 428 | ;; Check whether mode-line can be dragged at all. | 418 | ;; Check whether mode-line can be dragged at all. |
| 429 | (when (and (window-at-side-p window 'bottom) | 419 | (and (window-at-side-p window 'bottom) |
| 430 | (not resize-minibuffer)) | 420 | ;; Allow resizing the minibuffer window if it's on the same |
| 431 | (setq done t))) | 421 | ;; frame as and immediately below the clicked window, and |
| 422 | ;; it's active or `resize-mini-windows' is nil. | ||
| 423 | (not (and (eq (window-frame minibuffer-window) frame) | ||
| 424 | (= (nth 1 (window-edges minibuffer-window)) | ||
| 425 | (nth 3 (window-edges window))) | ||
| 426 | (or (not resize-mini-windows) | ||
| 427 | (eq minibuffer-window | ||
| 428 | (active-minibuffer-window))))) | ||
| 429 | (setq draggable nil))) | ||
| 432 | ((eq line 'vertical) | 430 | ((eq line 'vertical) |
| 433 | ;; Get the window to adjust for the vertical case. | 431 | ;; Get the window to adjust for the vertical case. If the |
| 434 | (setq window | 432 | ;; scroll bar is on the window's right or there's no scroll bar |
| 435 | (if (eq which-side 'right) | 433 | ;; at all, adjust the window where the start-event occurred. If |
| 436 | ;; If the scroll bar is on the window's right or there's | 434 | ;; the scroll bar is on the start-event window's left, adjust |
| 437 | ;; no scroll bar at all, adjust the window where the | 435 | ;; the window on the left of it. |
| 438 | ;; start-event occurred. | 436 | (unless (eq side 'right) |
| 439 | window | 437 | (setq window (window-in-direction 'left window t))))) |
| 440 | ;; If the scroll bar is on the start-event window's left, | ||
| 441 | ;; adjust the window on the left of it. | ||
| 442 | (window-in-direction 'left window t))))) | ||
| 443 | 438 | ||
| 444 | ;; Start tracking. | 439 | ;; Start tracking. |
| 445 | (track-mouse | 440 | (track-mouse |
| 446 | ;; Loop reading events and sampling the position of the mouse. | 441 | ;; Loop reading events and sampling the position of the mouse, |
| 447 | (while (not done) | 442 | ;; until there is a non-mouse-movement event. Also, |
| 448 | (setq event (read-event)) | 443 | ;; scroll-bar-movement events are the same as mouse movement for |
| 449 | (setq mouse (mouse-position)) | 444 | ;; our purposes. (Why? -- cyd) |
| 450 | ;; Do nothing if | 445 | (while (progn |
| 451 | ;; - there is a switch-frame event. | 446 | (setq event (read-event)) |
| 452 | ;; - the mouse isn't in the frame that we started in | 447 | (memq (car-safe event) '(mouse-movement scroll-bar-movement))) |
| 453 | ;; - the mouse isn't in any Emacs frame | 448 | (setq position (mouse-position)) |
| 454 | ;; Drag if | ||
| 455 | ;; - there is a mouse-movement event | ||
| 456 | ;; - there is a scroll-bar-movement event (??) | ||
| 457 | ;; (same as mouse movement for our purposes) | ||
| 458 | ;; Quit if | ||
| 459 | ;; - there is a keyboard event or some other unknown event. | ||
| 460 | (cond | 449 | (cond |
| 461 | ((not (consp event)) | 450 | ((or (not (eq (car position) frame)) |
| 462 | (setq done t)) | 451 | (null (cadr position))) |
| 463 | ((memq (car event) '(switch-frame select-window)) | ||
| 464 | nil) | ||
| 465 | ((not (memq (car event) '(mouse-movement scroll-bar-movement))) | ||
| 466 | (when (consp event) | ||
| 467 | ;; Do not unread a drag-mouse-1 event to avoid selecting | ||
| 468 | ;; some other window. For vertical line dragging do not | ||
| 469 | ;; unread mouse-1 events either (but only if we dragged at | ||
| 470 | ;; least once to allow mouse-1 clicks get through. | ||
| 471 | (unless (and dragged | ||
| 472 | (if (eq line 'vertical) | ||
| 473 | (memq (car event) '(drag-mouse-1 mouse-1)) | ||
| 474 | (eq (car event) 'drag-mouse-1))) | ||
| 475 | (push event unread-command-events))) | ||
| 476 | (setq done t)) | ||
| 477 | ((or (not (eq (car mouse) frame)) (null (car (cdr mouse)))) | ||
| 478 | nil) | 452 | nil) |
| 479 | ((eq line 'vertical) | 453 | ((eq line 'vertical) |
| 480 | ;; Drag vertical divider (the calculations below are those | 454 | ;; Drag vertical divider. |
| 481 | ;; from Emacs 23). | 455 | (setq growth (- (cadr position) |
| 482 | (setq growth | 456 | (if (eq side 'right) 0 2) |
| 483 | (- (- (cadr mouse) | 457 | (nth 2 (window-edges window)) |
| 484 | (if (eq which-side 'right) 0 2)) | 458 | -1)) |
| 485 | (nth 2 (window-edges window)) | ||
| 486 | -1)) | ||
| 487 | (unless (zerop growth) | 459 | (unless (zerop growth) |
| 488 | ;; Remember that we dragged. | ||
| 489 | (setq dragged t)) | 460 | (setq dragged t)) |
| 490 | (adjust-window-trailing-edge window growth t)) | 461 | (adjust-window-trailing-edge window growth t)) |
| 491 | (t | 462 | (draggable |
| 492 | ;; Drag horizontal divider (the calculations below are those | 463 | ;; Drag horizontal divider. |
| 493 | ;; from Emacs 23). | ||
| 494 | (setq growth | 464 | (setq growth |
| 495 | (if (eq line 'mode) | 465 | (if (eq line 'mode) |
| 496 | (- (cddr mouse) (nth 3 (window-edges window)) -1) | 466 | (- (cddr position) (nth 3 (window-edges window)) -1) |
| 497 | ;; The window's top includes the header line! | 467 | ;; The window's top includes the header line! |
| 498 | (- (nth 3 (window-edges window)) (cddr mouse)))) | 468 | (- (nth 3 (window-edges window)) (cddr position)))) |
| 499 | |||
| 500 | (unless (zerop growth) | 469 | (unless (zerop growth) |
| 501 | ;; Remember that we dragged. | ||
| 502 | (setq dragged t)) | 470 | (setq dragged t)) |
| 471 | (adjust-window-trailing-edge window (if (eq line 'mode) | ||
| 472 | growth | ||
| 473 | (- growth))))))) | ||
| 474 | ;; Process the terminating event. | ||
| 475 | (when (and (mouse-event-p event) on-link (not dragged) | ||
| 476 | (mouse--remap-link-click-p start-event event)) | ||
| 477 | ;; If mouse-2 has never been done by the user, it doesn't have | ||
| 478 | ;; the necessary property to be interpreted correctly. | ||
| 479 | (put 'mouse-2 'event-kind 'mouse-click) | ||
| 480 | (setcar event 'mouse-2)) | ||
| 481 | (push event unread-command-events))) | ||
| 503 | 482 | ||
| 504 | (if (eq line 'mode) | ||
| 505 | (adjust-window-trailing-edge window growth) | ||
| 506 | (adjust-window-trailing-edge window (- growth)))))) | ||
| 507 | |||
| 508 | ;; Presumably, if this was just a click, the last event should be | ||
| 509 | ;; `mouse-1', whereas if this did move the mouse, it should be a | ||
| 510 | ;; `drag-mouse-1'. `dragged' nil tells us that we never dragged | ||
| 511 | ;; and `on-link' tells us that there is a link to follow. | ||
| 512 | (when (and on-link (not dragged) | ||
| 513 | (eq 'mouse-1 (car-safe (car unread-command-events)))) | ||
| 514 | ;; If mouse-2 has never been done by the user, it doesn't | ||
| 515 | ;; have the necessary property to be interpreted correctly. | ||
| 516 | (put 'mouse-2 'event-kind 'mouse-click) | ||
| 517 | (setcar unread-command-events | ||
| 518 | (cons 'mouse-2 (cdar unread-command-events))))))) | ||
| 519 | 483 | ||
| 520 | (defun mouse-drag-mode-line (start-event) | 484 | (defun mouse-drag-mode-line (start-event) |
| 521 | "Change the height of a window by dragging on the mode line." | 485 | "Change the height of a window by dragging on the mode line." |
| @@ -791,10 +755,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by | |||
| 791 | ;; Don't count the mode line. | 755 | ;; Don't count the mode line. |
| 792 | (1- (nth 3 bounds)))) | 756 | (1- (nth 3 bounds)))) |
| 793 | (on-link (and mouse-1-click-follows-link | 757 | (on-link (and mouse-1-click-follows-link |
| 794 | (or mouse-1-click-in-non-selected-windows | ||
| 795 | (eq start-window original-window)) | ||
| 796 | ;; Use start-point before the intangibility | 758 | ;; Use start-point before the intangibility |
| 797 | ;; treatment, in case we click on a link inside an | 759 | ;; treatment, in case we click on a link inside |
| 798 | ;; intangible text. | 760 | ;; intangible text. |
| 799 | (mouse-on-link-p start-posn))) | 761 | (mouse-on-link-p start-posn))) |
| 800 | (click-count (1- (event-click-count start-event))) | 762 | (click-count (1- (event-click-count start-event))) |