1;;; mouse-sel.el --- multi-click selection support for Emacs 19 2 3;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Mike Williams <mdub@bigfoot.com> 7;; Keywords: mouse 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; This module provides multi-click mouse support for GNU Emacs versions 29;; 19.18 and later. I've tried to make it behave more like standard X 30;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers. 31;; Basically: 32;; 33;; * Clicking mouse-1 starts (cancels) selection, dragging extends it. 34;; 35;; * Clicking or dragging mouse-3 extends the selection as well. 36;; 37;; * Double-clicking on word constituents selects words. 38;; Double-clicking on symbol constituents selects symbols. 39;; Double-clicking on quotes or parentheses selects sexps. 40;; Double-clicking on whitespace selects whitespace. 41;; Triple-clicking selects lines. 42;; Quad-clicking selects paragraphs. 43;; 44;; * Selecting sets the region & X primary selection, but does NOT affect 45;; the kill-ring. Because the mouse handlers set the primary selection 46;; directly, mouse-sel sets the variables interprogram-cut-function 47;; and interprogram-paste-function to nil. 48;; 49;; * Clicking mouse-2 inserts the contents of the primary selection at 50;; the mouse position (or point, if mouse-yank-at-point is non-nil). 51;; 52;; * Pressing mouse-2 while selecting or extending copies selection 53;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. 54;; 55;; * Double-clicking mouse-3 also kills selection. 56;; 57;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 58;; & mouse-3, but operate on the X secondary selection rather than the 59;; primary selection and region. 60;; 61;; This module requires my thingatpt.el module, which it uses to find the 62;; bounds of words, lines, sexps, etc. 63;; 64;; Thanks to KevinB@bartley.demon.co.uk for his useful input. 65;; 66;;--- Customisation ------------------------------------------------------- 67;; 68;; * You may want to use none or more of following: 69;; 70;; ;; Enable region highlight 71;; (transient-mark-mode 1) 72;; 73;; ;; But only in the selected window 74;; (setq highlight-nonselected-windows nil) 75;; 76;; ;; Enable pending-delete 77;; (delete-selection-mode 1) 78;; 79;; * You can control the way mouse-sel binds its keys by setting the value 80;; of mouse-sel-default-bindings before loading mouse-sel. 81;; 82;; (a) If mouse-sel-default-bindings = t (the default) 83;; 84;; Mouse sets and insert selection 85;; mouse-1 mouse-select 86;; mouse-2 mouse-insert-selection 87;; mouse-3 mouse-extend 88;; 89;; Selection/kill-ring interaction is disabled 90;; interprogram-cut-function = nil 91;; interprogram-paste-function = nil 92;; 93;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste 94;; 95;; Mouse sets selection, and pastes from kill-ring 96;; mouse-1 mouse-select 97;; mouse-2 mouse-insert-selection 98;; mouse-3 mouse-extend 99;; In this mode, mouse-insert-selection just calls mouse-yank-at-click. 100;; 101;; Selection/kill-ring interaction is retained 102;; interprogram-cut-function = x-select-text 103;; interprogram-paste-function = x-cut-buffer-or-selection-value 104;; 105;; What you lose is the ability to select some text in 106;; delete-selection-mode and yank over the top of it. 107;; 108;; (c) If mouse-sel-default-bindings = nil, no bindings are made. 109;; 110;; * By default, mouse-insert-selection (mouse-2) inserts the selection at 111;; the mouse position. You can tell it to insert at point instead with: 112;; 113;; (setq mouse-yank-at-point t) 114;; 115;; * I like to leave point at the end of the region nearest to where the 116;; mouse was, even though this makes region highlighting mis-leading (the 117;; cursor makes it look like one extra character is selected). You can 118;; disable this behaviour with: 119;; 120;; (setq mouse-sel-leave-point-near-mouse nil) 121;; 122;; * By default, mouse-select cycles the click count after 4 clicks. That 123;; is, clicking mouse-1 five times has the same effect as clicking it 124;; once, clicking six times has the same effect as clicking twice, etc. 125;; Disable this behaviour with: 126;; 127;; (setq mouse-sel-cycle-clicks nil) 128;; 129;; * The variables mouse-sel-{set,get}-selection-function control how the 130;; selection is handled. Under X Windows, these variables default so 131;; that the X primary selection is used. Under other windowing systems, 132;; alternate functions are used, which simply store the selection value 133;; in a variable. 134;; 135;; * You can change the selection highlight face by altering the properties 136;; of mouse-drag-overlay, eg. 137;; 138;; (overlay-put mouse-drag-overlay 'face 'bold) 139 140;;; Code: 141 142(require 'mouse) 143(require 'thingatpt) 144 145(eval-when-compile 146 (require 'cl)) 147 148;;=== User Variables ====================================================== 149 150(defgroup mouse-sel nil 151 "Mouse selection enhancement." 152 :group 'mouse) 153 154(defcustom mouse-sel-leave-point-near-mouse t 155 "*Leave point near last mouse position. 156If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end 157of the region nearest to where the mouse last was. 158If nil, point will always be placed at the beginning of the region." 159 :type 'boolean 160 :group 'mouse-sel) 161 162(defcustom mouse-sel-cycle-clicks t 163 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks." 164 :type 'boolean 165 :group 'mouse-sel) 166 167(defcustom mouse-sel-default-bindings t 168 "*Control mouse bindings." 169 :type '(choice (const :tag "none" nil) 170 (const :tag "cut and paste" interprogram-cut-paste) 171 (other :tag "default bindings" t)) 172 :group 'mouse-sel) 173 174;;=== Key bindings ======================================================== 175 176(defconst mouse-sel-bound-events 177 '(;; Primary selection bindings. 178 ;; 179 ;; Bind keys to `ignore' instead of unsetting them because modes may 180 ;; bind `down-mouse-1', for instance, without binding `mouse-1'. 181 ;; If we unset `mouse-1', this leads to a bitch_at_user when the 182 ;; mouse goes up because no matching binding is found for that. 183 ([mouse-1] . ignore) 184 ([drag-mouse-1] . ignore) 185 ([mouse-3] . ignore) 186 ([down-mouse-1] . mouse-select) 187 ([down-mouse-3] . mouse-extend) 188 ([mouse-2] . mouse-insert-selection) 189 ;; Secondary selection bindings. 190 ([M-mouse-1] . ignore) 191 ([M-drag-mouse-1] . ignore) 192 ([M-mouse-3] . ignore) 193 ([M-down-mouse-1] . mouse-select-secondary) 194 ([M-mouse-2] . mouse-insert-secondary) 195 ([M-down-mouse-3] . mouse-extend-secondary)) 196 "An alist of events that `mouse-sel-mode' binds.") 197 198;;=== User Command ======================================================== 199 200(defvar mouse-sel-has-been-enabled nil 201 "Non-nil if Mouse Sel mode has been enabled at least once.") 202 203(defvar mouse-sel-original-bindings nil) 204(defvar mouse-sel-original-interprogram-cut-function nil) 205(defvar mouse-sel-original-interprogram-paste-function nil) 206 207;;;###autoload 208(define-minor-mode mouse-sel-mode 209 "Toggle Mouse Sel mode. 210With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive. 211Returns the new status of Mouse Sel mode (non-nil means on). 212 213When Mouse Sel mode is enabled, mouse selection is enhanced in various ways: 214 215- Clicking mouse-1 starts (cancels) selection, dragging extends it. 216 217- Clicking or dragging mouse-3 extends the selection as well. 218 219- Double-clicking on word constituents selects words. 220Double-clicking on symbol constituents selects symbols. 221Double-clicking on quotes or parentheses selects sexps. 222Double-clicking on whitespace selects whitespace. 223Triple-clicking selects lines. 224Quad-clicking selects paragraphs. 225 226- Selecting sets the region & X primary selection, but does NOT affect 227the `kill-ring', nor do the kill-ring functions change the X selection. 228Because the mouse handlers set the primary selection directly, 229mouse-sel sets the variables `interprogram-cut-function' and 230`interprogram-paste-function' to nil. 231 232- Clicking mouse-2 inserts the contents of the primary selection at 233the mouse position (or point, if `mouse-yank-at-point' is non-nil). 234 235- Pressing mouse-2 while selecting or extending copies selection 236to the kill ring. Pressing mouse-1 or mouse-3 kills it. 237 238- Double-clicking mouse-3 also kills selection. 239 240- M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 241& mouse-3, but operate on the X secondary selection rather than the 242primary selection and region." 243 :global t 244 :group 'mouse-sel 245 (if mouse-sel-mode 246 (progn 247 ;; If mouse-2 has never been done by the user, initialize the 248 ;; `event-kind' property to ensure that `follow-link' clicks 249 ;; are interpreted correctly. 250 (put 'mouse-2 'event-kind 'mouse-click) 251 (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) 252 (when mouse-sel-default-bindings 253 ;; Save original bindings and replace them with new ones. 254 (setq mouse-sel-original-bindings 255 (mapcar (lambda (binding) 256 (let ((event (car binding))) 257 (prog1 (cons event (lookup-key global-map event)) 258 (global-set-key event (cdr binding))))) 259 mouse-sel-bound-events)) 260 ;; Update interprogram functions. 261 (setq mouse-sel-original-interprogram-cut-function 262 interprogram-cut-function 263 mouse-sel-original-interprogram-paste-function 264 interprogram-paste-function 265 mouse-sel-has-been-enabled t) 266 (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste) 267 (setq interprogram-cut-function nil 268 interprogram-paste-function nil)))) 269 270 ;; Restore original bindings 271 (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) 272 (dolist (binding mouse-sel-original-bindings) 273 (global-set-key (car binding) (cdr binding))) 274 ;; Restore the old values of these variables, 275 ;; only if they were actually saved previously. 276 (if mouse-sel-has-been-enabled 277 (setq interprogram-cut-function 278 mouse-sel-original-interprogram-cut-function 279 interprogram-paste-function 280 mouse-sel-original-interprogram-paste-function)))) 281 282;;=== Internal Variables/Constants ======================================== 283 284(defvar mouse-sel-primary-thing nil 285 "Type of PRIMARY selection in current buffer.") 286(make-variable-buffer-local 'mouse-sel-primary-thing) 287 288(defvar mouse-sel-secondary-thing nil 289 "Type of SECONDARY selection in current buffer.") 290(make-variable-buffer-local 'mouse-sel-secondary-thing) 291 292;; Ensure that secondary overlay is defined 293(unless (overlayp mouse-secondary-overlay) 294 (setq mouse-secondary-overlay (make-overlay 1 1)) 295 (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) 296 297(defconst mouse-sel-selection-alist 298 '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) 299 (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) 300 "Alist associating selections with variables. 301Each element is of the form: 302 303 (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL) 304 305where SELECTION-NAME = name of selection 306 OVERLAY-SYMBOL = name of variable containing overlay to use 307 SELECTION-THING-SYMBOL = name of variable where the current selection 308 type for this selection should be stored.") 309 310(defvar mouse-sel-set-selection-function 311 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) 312 'x-set-selection 313 (lambda (selection value) 314 (if (eq selection 'PRIMARY) 315 (x-select-text value) 316 (x-set-selection selection value)))) 317 "Function to call to set selection. 318Called with two arguments: 319 320 SELECTION, the name of the selection concerned, and 321 VALUE, the text to store. 322 323This sets the selection as well as the cut buffer for the older applications, 324unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") 325 326(defvar mouse-sel-get-selection-function 327 (lambda (selection) 328 (if (eq selection 'PRIMARY) 329 (or (x-cut-buffer-or-selection-value) 330 (bound-and-true-p x-last-selected-text) 331 (bound-and-true-p x-last-selected-text-primary)) 332 (x-get-selection selection))) 333 "Function to call to get the selection. 334Called with one argument: 335 336 SELECTION: the name of the selection concerned.") 337 338;;=== Support/access functions ============================================ 339 340(defun mouse-sel-determine-selection-thing (nclicks) 341 "Determine what `thing' `mouse-sel' should operate on. 342The first argument is NCLICKS, is the number of consecutive 343mouse clicks at the same position. 344 345Double-clicking on word constituents selects words. 346Double-clicking on symbol constituents selects symbols. 347Double-clicking on quotes or parentheses selects sexps. 348Double-clicking on whitespace selects whitespace. 349Triple-clicking selects lines. 350Quad-clicking selects paragraphs. 351 352Feel free to re-define this function to support your own desired 353multi-click semantics." 354 (let* ((next-char (char-after (point))) 355 (char-syntax (if next-char (char-syntax next-char)))) 356 (if mouse-sel-cycle-clicks 357 (setq nclicks (1+ (% (1- nclicks) 4)))) 358 (cond 359 ((= nclicks 1) nil) 360 ((= nclicks 3) 'line) 361 ((>= nclicks 4) 'paragraph) 362 ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) 363 ((memq next-char '(?\s ?\t ?\n)) 'whitespace) 364 ((eq char-syntax ?_) 'symbol) 365 ((eq char-syntax ?w) 'word)))) 366 367(defun mouse-sel-set-selection (selection value) 368 "Set the specified SELECTION to VALUE." 369 (if mouse-sel-set-selection-function 370 (funcall mouse-sel-set-selection-function selection value) 371 (put 'mouse-sel-internal-selection selection value))) 372 373(defun mouse-sel-get-selection (selection) 374 "Get the value of the specified SELECTION." 375 (if mouse-sel-get-selection-function 376 (funcall mouse-sel-get-selection-function selection) 377 (get 'mouse-sel-internal-selection selection))) 378 379(defun mouse-sel-selection-overlay (selection) 380 "Return overlay corresponding to SELECTION." 381 (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist)))) 382 (or symbol (error "No overlay corresponding to %s selection" selection)) 383 (symbol-value symbol))) 384 385(defun mouse-sel-selection-thing (selection) 386 "Return overlay corresponding to SELECTION." 387 (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist)))) 388 (or symbol (error "No symbol corresponding to %s selection" selection)) 389 symbol)) 390 391(defun mouse-sel-region-to-primary (orig-window) 392 "Convert region to PRIMARY overlay and deactivate region. 393Argument ORIG-WINDOW specifies the window the cursor was in when the 394originating command was issued, and is used to determine whether the 395region was visible or not." 396 (if transient-mark-mode 397 (let ((overlay (mouse-sel-selection-overlay 'PRIMARY))) 398 (cond 399 ((and mark-active 400 (or highlight-nonselected-windows 401 (eq orig-window (selected-window)))) 402 ;; Region was visible, so convert region to overlay 403 (move-overlay overlay (region-beginning) (region-end) 404 (current-buffer))) 405 ((eq orig-window (selected-window)) 406 ;; Point was visible, so set overlay at point 407 (move-overlay overlay (point) (point) (current-buffer))) 408 (t 409 ;; Nothing was visible, so remove overlay 410 (delete-overlay overlay))) 411 (setq mark-active nil)))) 412 413(defun mouse-sel-primary-to-region (&optional direction) 414 "Convert PRIMARY overlay to region. 415Optional argument DIRECTION specifies the mouse drag direction: a value of 4161 indicates that the mouse was dragged left-to-right, otherwise it was 417dragged right-to-left." 418 (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY)) 419 (start (overlay-start overlay)) 420 (end (overlay-end overlay))) 421 (if (eq start end) 422 (progn 423 (if start (goto-char start)) 424 (deactivate-mark)) 425 (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) 426 (progn 427 (goto-char end) 428 (push-mark start 'nomsg 'active)) 429 (goto-char start) 430 (push-mark end 'nomsg 'active))) 431 (if transient-mark-mode (delete-overlay overlay)))) 432 433(defmacro mouse-sel-eval-at-event-end (event &rest forms) 434 "Evaluate forms at mouse position. 435Move to the end position of EVENT, execute FORMS, and restore original 436point and window." 437 `(let ((posn (event-end ,event))) 438 (if posn (mouse-minibuffer-check ,event)) 439 (if (and posn (not (windowp (posn-window posn)))) 440 (error "Cursor not in text area of window")) 441 (let (orig-window orig-point-marker) 442 (setq orig-window (selected-window)) 443 (if posn (select-window (posn-window posn))) 444 (setq orig-point-marker (point-marker)) 445 (if (and posn (numberp (posn-point posn))) 446 (goto-char (posn-point posn))) 447 (unwind-protect 448 (progn 449 ,@forms) 450 (goto-char (marker-position orig-point-marker)) 451 (move-marker orig-point-marker nil) 452 (select-window orig-window))))) 453 454(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1) 455 456;;=== Select ============================================================== 457 458(defun mouse-select (event) 459 "Set region/selection using the mouse. 460 461Click sets point & mark to click position. 462Dragging extends region/selection. 463 464Multi-clicking selects word/lines/paragraphs, as determined by 465'mouse-sel-determine-selection-thing. 466 467Clicking mouse-2 while selecting copies selected text to the kill-ring. 468Clicking mouse-1 or mouse-3 kills the selected text. 469 470This should be bound to a down-mouse event." 471 (interactive "@e") 472 (let (select) 473 (unwind-protect 474 (setq select (mouse-select-internal 'PRIMARY event)) 475 (if (and select (listp select)) 476 (push (cons 'mouse-2 (cdr event)) unread-command-events) 477 (mouse-sel-primary-to-region select))))) 478 479(defun mouse-select-secondary (event) 480 "Set secondary selection using the mouse. 481 482Click sets the start of the secondary selection to click position. 483Dragging extends the secondary selection. 484 485Multi-clicking selects word/lines/paragraphs, as determined by 486'mouse-sel-determine-selection-thing. 487 488Clicking mouse-2 while selecting copies selected text to the kill-ring. 489Clicking mouse-1 or mouse-3 kills the selected text. 490 491This should be bound to a down-mouse event." 492 (interactive "e") 493 (mouse-select-internal 'SECONDARY event)) 494 495(defun mouse-select-internal (selection event) 496 "Set SELECTION using the mouse, with EVENT as the initial down-event. 497Normally, this returns the direction in which the selection was 498made: a value of 1 indicates that the mouse was dragged 499left-to-right, otherwise it was dragged right-to-left. 500 501However, if `mouse-1-click-follows-link' is non-nil and the 502subsequent mouse events specify following a link, this returns 503the final mouse-event. In that case, the selection is not set." 504 (mouse-sel-eval-at-event-end event 505 (let ((thing-symbol (mouse-sel-selection-thing selection)) 506 (overlay (mouse-sel-selection-overlay selection))) 507 (set thing-symbol 508 (mouse-sel-determine-selection-thing (event-click-count event))) 509 (let ((object-bounds (bounds-of-thing-at-point 510 (symbol-value thing-symbol)))) 511 (if object-bounds 512 (progn 513 (move-overlay overlay 514 (car object-bounds) (cdr object-bounds) 515 (current-buffer))) 516 (move-overlay overlay (point) (point) (current-buffer))))) 517 (catch 'follow-link 518 (mouse-extend-internal selection event t)))) 519 520;;=== Extend ============================================================== 521 522(defun mouse-extend (event) 523 "Extend region/selection using the mouse." 524 (interactive "e") 525 (let ((orig-window (selected-window)) 526 direction) 527 (select-window (posn-window (event-end event))) 528 (unwind-protect 529 (progn 530 (mouse-sel-region-to-primary orig-window) 531 (setq direction (mouse-extend-internal 'PRIMARY event))) 532 (mouse-sel-primary-to-region direction)))) 533 534(defun mouse-extend-secondary (event) 535 "Extend secondary selection using the mouse." 536 (interactive "e") 537 (save-window-excursion 538 (mouse-extend-internal 'SECONDARY event))) 539 540(defun mouse-extend-internal (selection &optional initial-event no-process) 541 "Extend specified SELECTION using the mouse. 542Track mouse-motion events, adjusting the SELECTION appropriately. 543Optional argument INITIAL-EVENT specifies an initial down-mouse event. 544Optional argument NO-PROCESS means not to process the initial 545event. 546 547See documentation for mouse-select-internal for more details." 548 (mouse-sel-eval-at-event-end initial-event 549 (let ((orig-cursor-type 550 (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))) 551 (unwind-protect 552 553 (let* ((thing-symbol (mouse-sel-selection-thing selection)) 554 (overlay (mouse-sel-selection-overlay selection)) 555 (orig-window (selected-window)) 556 (orig-window-frame (window-frame orig-window)) 557 (top (nth 1 (window-edges orig-window))) 558 (bottom (nth 3 (window-edges orig-window))) 559 (mark-active nil) ; inhibit normal region highlight 560 (echo-keystrokes 0) ; don't echo mouse events 561 min max 562 direction 563 event) 564 565 ;; Get current bounds of overlay 566 (if (eq (overlay-buffer overlay) (current-buffer)) 567 (setq min (overlay-start overlay) 568 max (overlay-end overlay)) 569 (setq min (point) 570 max min) 571 (set thing-symbol nil)) 572 573 574 ;; Bar cursor 575 (if (fboundp 'modify-frame-parameters) 576 (modify-frame-parameters (selected-frame) 577 '((cursor-type . bar)))) 578 579 ;; Handle dragging 580 (track-mouse 581 582 (while (if (and initial-event (not no-process)) 583 ;; Use initial event 584 (prog1 585 (setq event initial-event) 586 (setq initial-event nil)) 587 (setq event (read-event)) 588 (and (consp event) 589 (memq (car event) '(mouse-movement switch-frame)))) 590 591 (let ((selection-thing (symbol-value thing-symbol)) 592 (end (event-end event))) 593 594 (cond 595 596 ;; Ignore any movement outside the frame 597 ((eq (car-safe event) 'switch-frame) nil) 598 ((and (posn-window end) 599 (not (eq (let ((posn-w (posn-window end))) 600 (if (windowp posn-w) 601 (window-frame posn-w) 602 posn-w)) 603 (window-frame orig-window)))) nil) 604 605 ;; Different window, same frame 606 ((not (eq (posn-window end) orig-window)) 607 (let ((end-row (cdr (cdr (mouse-position))))) 608 (cond 609 ((and end-row (not (bobp)) (< end-row top)) 610 (mouse-scroll-subr orig-window (- end-row top) 611 overlay max)) 612 ((and end-row (not (eobp)) (>= end-row bottom)) 613 (mouse-scroll-subr orig-window (1+ (- end-row bottom)) 614 overlay min)) 615 ))) 616 617 ;; On the mode line 618 ((eq (posn-point end) 'mode-line) 619 (mouse-scroll-subr orig-window 1 overlay min)) 620 621 ;; In original window 622 (t (goto-char (posn-point end))) 623 624 ) 625 626 ;; Determine direction of drag 627 (cond 628 ((and (not direction) (not (eq min max))) 629 (setq direction (if (< (point) (/ (+ min max) 2)) -1 1))) 630 ((and (not (eq direction -1)) (<= (point) min)) 631 (setq direction -1)) 632 ((and (not (eq direction 1)) (>= (point) max)) 633 (setq direction 1))) 634 635 (if (not selection-thing) nil 636 637 ;; If dragging forward, goal is next character 638 (if (and (eq direction 1) (not (eobp))) (forward-char 1)) 639 640 ;; Move to start/end of selected thing 641 (let ((goal (point))) 642 (goto-char (if (eq 1 direction) min max)) 643 (condition-case nil 644 (progn 645 (while (> (* direction (- goal (point))) 0) 646 (forward-thing selection-thing direction)) 647 (let ((end (point))) 648 (forward-thing selection-thing (- direction)) 649 (goto-char 650 (if (> (* direction (- goal (point))) 0) 651 end (point))))) 652 (error)))) 653 654 ;; Move overlay 655 (move-overlay overlay 656 (if (eq 1 direction) min (point)) 657 (if (eq -1 direction) max (point)) 658 (current-buffer)) 659 660 ))) ; end track-mouse 661 662 ;; Detect follow-link events 663 (when (mouse-sel-follow-link-p initial-event event) 664 (throw 'follow-link event)) 665 666 ;; Finish up after dragging 667 (let ((overlay-start (overlay-start overlay)) 668 (overlay-end (overlay-end overlay))) 669 670 ;; Set selection 671 (if (not (eq overlay-start overlay-end)) 672 (mouse-sel-set-selection 673 selection 674 (buffer-substring overlay-start overlay-end))) 675 676 ;; Handle copy/kill 677 (let (this-command) 678 (cond 679 ((eq (event-basic-type last-input-event) 'mouse-2) 680 (copy-region-as-kill overlay-start overlay-end) 681 (read-event) (read-event)) 682 ((and (memq (event-basic-type last-input-event) 683 '(mouse-1 mouse-3)) 684 (memq 'down (event-modifiers last-input-event))) 685 (kill-region overlay-start overlay-end) 686 (move-overlay overlay overlay-start overlay-start) 687 (read-event) (read-event)) 688 ((and (eq (event-basic-type last-input-event) 'mouse-3) 689 (memq 'double (event-modifiers last-input-event))) 690 (kill-region overlay-start overlay-end) 691 (move-overlay overlay overlay-start overlay-start))))) 692 693 direction) 694 695 ;; Restore cursor 696 (if (fboundp 'modify-frame-parameters) 697 (modify-frame-parameters 698 (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) 699 700 )))) 701 702(defun mouse-sel-follow-link-p (initial final) 703 "Return t if we should follow a link, given INITIAL and FINAL mouse events. 704See `mouse-1-click-follows-link' for details. Currently, Mouse 705Sel mode does not support using a `double' value to follow links 706using double-clicks." 707 (and initial final mouse-1-click-follows-link 708 (eq (car initial) 'down-mouse-1) 709 (mouse-on-link-p (event-start initial)) 710 (= (posn-point (event-start initial)) 711 (posn-point (event-end final))) 712 (= (event-click-count initial) 1) 713 (or (not (integerp mouse-1-click-follows-link)) 714 (let ((t0 (posn-timestamp (event-start initial))) 715 (t1 (posn-timestamp (event-end final)))) 716 (and (integerp t0) (integerp t1) 717 (if (> mouse-1-click-follows-link 0) 718 (<= (- t1 t0) mouse-1-click-follows-link) 719 (< (- t0 t1) mouse-1-click-follows-link))))))) 720 721;;=== Paste =============================================================== 722 723(defun mouse-insert-selection (event arg) 724 "Insert the contents of the PRIMARY selection at mouse click. 725If `mouse-yank-at-point' is non-nil, insert at point instead." 726 (interactive "e\nP") 727 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) 728 (mouse-yank-at-click event arg) 729 (mouse-insert-selection-internal 'PRIMARY event))) 730 731(defun mouse-insert-secondary (event) 732 "Insert the contents of the SECONDARY selection at mouse click. 733If `mouse-yank-at-point' is non-nil, insert at point instead." 734 (interactive "e") 735 (mouse-insert-selection-internal 'SECONDARY event)) 736 737(defun mouse-insert-selection-internal (selection event) 738 "Insert the contents of the named SELECTION at mouse click. 739If `mouse-yank-at-point' is non-nil, insert at point instead." 740 (unless mouse-yank-at-point 741 (mouse-set-point event)) 742 (when mouse-sel-get-selection-function 743 (push-mark (point) 'nomsg) 744 (insert-for-yank 745 (or (funcall mouse-sel-get-selection-function selection) "")))) 746 747;;=== Handle loss of selections =========================================== 748 749(defun mouse-sel-lost-selection-hook (selection) 750 "Remove the overlay for a lost selection." 751 (let ((overlay (mouse-sel-selection-overlay selection))) 752 (delete-overlay overlay))) 753 754(provide 'mouse-sel) 755 756;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7 757;;; mouse-sel.el ends here 758