From: Lars Magne Ingebrigtsen Date: Tue, 10 Apr 2012 17:08:36 +0000 (+0200) Subject: Moved mouse-sel.el to the lisp/obsolete directory X-Git-Tag: emacs-24.2.90~471^2~365^2~8 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8c906ebab6ea800e09dfff8516b8dc6941bd5652;p=emacs.git Moved mouse-sel.el to the lisp/obsolete directory --- diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el deleted file mode 100644 index 773302246dc..00000000000 --- a/lisp/mouse-sel.el +++ /dev/null @@ -1,752 +0,0 @@ -;;; mouse-sel.el --- multi-click selection support - -;; Copyright (C) 1993-1995, 2001-2012 Free Software Foundation, Inc. - -;; Author: Mike Williams -;; Keywords: mouse - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This module provides multi-click mouse support for GNU Emacs versions -;; 19.18 and later. I've tried to make it behave more like standard X -;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers. -;; Basically: -;; -;; * Clicking mouse-1 starts (cancels) selection, dragging extends it. -;; -;; * Clicking or dragging mouse-3 extends the selection as well. -;; -;; * Double-clicking on word constituents selects words. -;; Double-clicking on symbol constituents selects symbols. -;; Double-clicking on quotes or parentheses selects sexps. -;; Double-clicking on whitespace selects whitespace. -;; Triple-clicking selects lines. -;; Quad-clicking selects paragraphs. -;; -;; * Selecting sets the region & X primary selection, but does NOT affect -;; the kill-ring. Because the mouse handlers set the primary selection -;; directly, mouse-sel sets the variables interprogram-cut-function -;; and interprogram-paste-function to nil. -;; -;; * Clicking mouse-2 inserts the contents of the primary selection at -;; the mouse position (or point, if mouse-yank-at-point is non-nil). -;; -;; * Pressing mouse-2 while selecting or extending copies selection -;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. -;; -;; * Double-clicking mouse-3 also kills selection. -;; -;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 -;; & mouse-3, but operate on the X secondary selection rather than the -;; primary selection and region. -;; -;; This module requires my thingatpt.el module, which it uses to find the -;; bounds of words, lines, sexps, etc. -;; -;; Thanks to KevinB@bartley.demon.co.uk for his useful input. -;; -;;--- Customization ------------------------------------------------------- -;; -;; * You may want to use none or more of following: -;; -;; ;; Enable region highlight -;; (transient-mark-mode 1) -;; -;; ;; But only in the selected window -;; (setq highlight-nonselected-windows nil) -;; -;; ;; Enable pending-delete -;; (delete-selection-mode 1) -;; -;; * You can control the way mouse-sel binds its keys by setting the value -;; of mouse-sel-default-bindings before loading mouse-sel. -;; -;; (a) If mouse-sel-default-bindings = t (the default) -;; -;; Mouse sets and insert selection -;; mouse-1 mouse-select -;; mouse-2 mouse-insert-selection -;; mouse-3 mouse-extend -;; -;; Selection/kill-ring interaction is disabled -;; interprogram-cut-function = nil -;; interprogram-paste-function = nil -;; -;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste -;; -;; Mouse sets selection, and pastes from kill-ring -;; mouse-1 mouse-select -;; mouse-2 mouse-insert-selection -;; mouse-3 mouse-extend -;; In this mode, mouse-insert-selection just calls mouse-yank-at-click. -;; -;; Selection/kill-ring interaction is retained -;; interprogram-cut-function = x-select-text -;; interprogram-paste-function = x-selection-value -;; -;; What you lose is the ability to select some text in -;; delete-selection-mode and yank over the top of it. -;; -;; (c) If mouse-sel-default-bindings = nil, no bindings are made. -;; -;; * By default, mouse-insert-selection (mouse-2) inserts the selection at -;; the mouse position. You can tell it to insert at point instead with: -;; -;; (setq mouse-yank-at-point t) -;; -;; * I like to leave point at the end of the region nearest to where the -;; mouse was, even though this makes region highlighting mis-leading (the -;; cursor makes it look like one extra character is selected). You can -;; disable this behavior with: -;; -;; (setq mouse-sel-leave-point-near-mouse nil) -;; -;; * By default, mouse-select cycles the click count after 4 clicks. That -;; is, clicking mouse-1 five times has the same effect as clicking it -;; once, clicking six times has the same effect as clicking twice, etc. -;; Disable this behavior with: -;; -;; (setq mouse-sel-cycle-clicks nil) -;; -;; * The variables mouse-sel-{set,get}-selection-function control how the -;; selection is handled. Under X Windows, these variables default so -;; that the X primary selection is used. Under other windowing systems, -;; alternate functions are used, which simply store the selection value -;; in a variable. - -;;; Code: - -(require 'mouse) -(require 'thingatpt) - -(eval-when-compile - (require 'cl)) - -;;=== User Variables ====================================================== - -(defgroup mouse-sel nil - "Mouse selection enhancement." - :group 'mouse) - -(defcustom mouse-sel-leave-point-near-mouse t - "Leave point near last mouse position. -If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end -of the region nearest to where the mouse last was. -If nil, point will always be placed at the beginning of the region." - :type 'boolean - :group 'mouse-sel) - -(defcustom mouse-sel-cycle-clicks t - "If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks." - :type 'boolean - :group 'mouse-sel) - -(defcustom mouse-sel-default-bindings t - "Control mouse bindings." - :type '(choice (const :tag "none" nil) - (const :tag "cut and paste" interprogram-cut-paste) - (other :tag "default bindings" t)) - :group 'mouse-sel) - -;;=== Key bindings ======================================================== - -(defconst mouse-sel-bound-events - '(;; Primary selection bindings. - ;; - ;; Bind keys to `ignore' instead of unsetting them because modes may - ;; bind `down-mouse-1', for instance, without binding `mouse-1'. - ;; If we unset `mouse-1', this leads to a bitch_at_user when the - ;; mouse goes up because no matching binding is found for that. - ([mouse-1] . ignore) - ([drag-mouse-1] . ignore) - ([mouse-3] . ignore) - ([down-mouse-1] . mouse-select) - ([down-mouse-3] . mouse-extend) - ([mouse-2] . mouse-insert-selection) - ;; Secondary selection bindings. - ([M-mouse-1] . ignore) - ([M-drag-mouse-1] . ignore) - ([M-mouse-3] . ignore) - ([M-down-mouse-1] . mouse-select-secondary) - ([M-mouse-2] . mouse-insert-secondary) - ([M-down-mouse-3] . mouse-extend-secondary)) - "An alist of events that `mouse-sel-mode' binds.") - -;;=== User Command ======================================================== - -(defvar mouse-sel-has-been-enabled nil - "Non-nil if Mouse Sel mode has been enabled at least once.") - -(defvar mouse-sel-original-bindings nil) -(defvar mouse-sel-original-interprogram-cut-function nil) -(defvar mouse-sel-original-interprogram-paste-function nil) - -;;;###autoload -(define-minor-mode mouse-sel-mode - "Toggle Mouse Sel mode. -With a prefix argument ARG, enable Mouse Sel mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -Mouse Sel mode is a global minor mode. When enabled, mouse -selection is enhanced in various ways: - -- Double-clicking on symbol constituents selects symbols. -Double-clicking on quotes or parentheses selects sexps. -Double-clicking on whitespace selects whitespace. -Triple-clicking selects lines. -Quad-clicking selects paragraphs. - -- Selecting sets the region & X primary selection, but does NOT affect -the `kill-ring', nor do the kill-ring functions change the X selection. -Because the mouse handlers set the primary selection directly, -mouse-sel sets the variables `interprogram-cut-function' and -`interprogram-paste-function' to nil. - -- Clicking mouse-2 inserts the contents of the primary selection at -the mouse position (or point, if `mouse-yank-at-point' is non-nil). - -- mouse-2 while selecting or extending copies selection to the -kill ring; mouse-1 or mouse-3 kills it." - :global t - :group 'mouse-sel - (if mouse-sel-mode - (progn - ;; If mouse-2 has never been done by the user, initialize the - ;; `event-kind' property to ensure that `follow-link' clicks - ;; are interpreted correctly. - (put 'mouse-2 'event-kind 'mouse-click) - (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) - (when mouse-sel-default-bindings - ;; Save original bindings and replace them with new ones. - (setq mouse-sel-original-bindings - (mapcar (lambda (binding) - (let ((event (car binding))) - (prog1 (cons event (lookup-key global-map event)) - (global-set-key event (cdr binding))))) - mouse-sel-bound-events)) - ;; Update interprogram functions. - (setq mouse-sel-original-interprogram-cut-function - interprogram-cut-function - mouse-sel-original-interprogram-paste-function - interprogram-paste-function - mouse-sel-has-been-enabled t) - (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste) - (setq interprogram-cut-function nil - interprogram-paste-function nil)))) - - ;; Restore original bindings - (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) - (dolist (binding mouse-sel-original-bindings) - (global-set-key (car binding) (cdr binding))) - ;; Restore the old values of these variables, - ;; only if they were actually saved previously. - (if mouse-sel-has-been-enabled - (setq interprogram-cut-function - mouse-sel-original-interprogram-cut-function - interprogram-paste-function - mouse-sel-original-interprogram-paste-function)))) - -(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.2") - -;;=== Internal Variables/Constants ======================================== - -(defvar mouse-sel-primary-thing nil - "Type of PRIMARY selection in current buffer.") -(make-variable-buffer-local 'mouse-sel-primary-thing) - -(defvar mouse-sel-secondary-thing nil - "Type of SECONDARY selection in current buffer.") -(make-variable-buffer-local 'mouse-sel-secondary-thing) - -;; Ensure that secondary overlay is defined -(unless (overlayp mouse-secondary-overlay) - (setq mouse-secondary-overlay (make-overlay 1 1)) - (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) - -(defconst mouse-sel-primary-overlay - (let ((ol (make-overlay (point-min) (point-min)))) - (delete-overlay ol) - (overlay-put ol 'face 'region) - ol) - "An overlay which records the current primary selection. -This is used by Mouse Sel mode only.") - -(defconst mouse-sel-selection-alist - '((PRIMARY mouse-sel-primary-overlay mouse-sel-primary-thing) - (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) - "Alist associating selections with variables. -Each element is of the form: - - (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL) - -where SELECTION-NAME = name of selection - OVERLAY-SYMBOL = name of variable containing overlay to use - SELECTION-THING-SYMBOL = name of variable where the current selection - type for this selection should be stored.") - -(declare-function x-select-text "term/common-win" (text)) - -(defvar mouse-sel-set-selection-function - (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) - 'x-set-selection - (lambda (selection value) - (if (eq selection 'PRIMARY) - (x-select-text value) - (x-set-selection selection value)))) - "Function to call to set selection. -Called with two arguments: - - SELECTION, the name of the selection concerned, and - VALUE, the text to store. - -This sets the selection, unless `mouse-sel-default-bindings' -is `interprogram-cut-paste'.") - -(declare-function x-selection-value "term/x-win" ()) - -(defvar mouse-sel-get-selection-function - (lambda (selection) - (if (eq selection 'PRIMARY) - (or (x-selection-value) - (bound-and-true-p x-last-selected-text) - (bound-and-true-p x-last-selected-text-primary)) - (x-get-selection selection))) - "Function to call to get the selection. -Called with one argument: - - SELECTION: the name of the selection concerned.") - -;;=== Support/access functions ============================================ - -(defun mouse-sel-determine-selection-thing (nclicks) - "Determine what `thing' `mouse-sel' should operate on. -The first argument is NCLICKS, is the number of consecutive -mouse clicks at the same position. - -Double-clicking on word constituents selects words. -Double-clicking on symbol constituents selects symbols. -Double-clicking on quotes or parentheses selects sexps. -Double-clicking on whitespace selects whitespace. -Triple-clicking selects lines. -Quad-clicking selects paragraphs. - -Feel free to re-define this function to support your own desired -multi-click semantics." - (let* ((next-char (char-after (point))) - (char-syntax (if next-char (char-syntax next-char)))) - (if mouse-sel-cycle-clicks - (setq nclicks (1+ (% (1- nclicks) 4)))) - (cond - ((= nclicks 1) nil) - ((= nclicks 3) 'line) - ((>= nclicks 4) 'paragraph) - ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) - ((memq next-char '(?\s ?\t ?\n)) 'whitespace) - ((eq char-syntax ?_) 'symbol) - ((eq char-syntax ?w) 'word)))) - -(defun mouse-sel-set-selection (selection value) - "Set the specified SELECTION to VALUE." - (if mouse-sel-set-selection-function - (funcall mouse-sel-set-selection-function selection value) - (put 'mouse-sel-internal-selection selection value))) - -(defun mouse-sel-get-selection (selection) - "Get the value of the specified SELECTION." - (if mouse-sel-get-selection-function - (funcall mouse-sel-get-selection-function selection) - (get 'mouse-sel-internal-selection selection))) - -(defun mouse-sel-selection-overlay (selection) - "Return overlay corresponding to SELECTION." - (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist)))) - (or symbol (error "No overlay corresponding to %s selection" selection)) - (symbol-value symbol))) - -(defun mouse-sel-selection-thing (selection) - "Return overlay corresponding to SELECTION." - (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist)))) - (or symbol (error "No symbol corresponding to %s selection" selection)) - symbol)) - -(defun mouse-sel-region-to-primary (orig-window) - "Convert region to PRIMARY overlay and deactivate region. -Argument ORIG-WINDOW specifies the window the cursor was in when the -originating command was issued, and is used to determine whether the -region was visible or not." - (if transient-mark-mode - (let ((overlay (mouse-sel-selection-overlay 'PRIMARY))) - (cond - ((and mark-active - (or highlight-nonselected-windows - (eq orig-window (selected-window)))) - ;; Region was visible, so convert region to overlay - (move-overlay overlay (region-beginning) (region-end) - (current-buffer))) - ((eq orig-window (selected-window)) - ;; Point was visible, so set overlay at point - (move-overlay overlay (point) (point) (current-buffer))) - (t - ;; Nothing was visible, so remove overlay - (delete-overlay overlay))) - (setq mark-active nil)))) - -(defun mouse-sel-primary-to-region (&optional direction) - "Convert PRIMARY overlay to region. -Optional argument DIRECTION specifies the mouse drag direction: a value of -1 indicates that the mouse was dragged left-to-right, otherwise it was -dragged right-to-left." - (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY)) - (start (overlay-start overlay)) - (end (overlay-end overlay))) - (if (eq start end) - (progn - (if start (goto-char start)) - (deactivate-mark)) - (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) - (progn - (goto-char end) - (push-mark start 'nomsg 'active)) - (goto-char start) - (push-mark end 'nomsg 'active))) - (if transient-mark-mode (delete-overlay overlay)))) - -(defmacro mouse-sel-eval-at-event-end (event &rest forms) - "Evaluate forms at mouse position. -Move to the end position of EVENT, execute FORMS, and restore original -point and window." - `(let ((posn (event-end ,event))) - (if posn (mouse-minibuffer-check ,event)) - (if (and posn (not (windowp (posn-window posn)))) - (error "Cursor not in text area of window")) - (let (orig-window orig-point-marker) - (setq orig-window (selected-window)) - (if posn (select-window (posn-window posn))) - (setq orig-point-marker (point-marker)) - (if (and posn (numberp (posn-point posn))) - (goto-char (posn-point posn))) - (unwind-protect - (progn - ,@forms) - (goto-char (marker-position orig-point-marker)) - (move-marker orig-point-marker nil) - (select-window orig-window))))) - -(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1) - -;;=== Select ============================================================== - -(defun mouse-select (event) - "Set region/selection using the mouse. - -Click sets point & mark to click position. -Dragging extends region/selection. - -Multi-clicking selects word/lines/paragraphs, as determined by -'mouse-sel-determine-selection-thing. - -Clicking mouse-2 while selecting copies selected text to the kill-ring. -Clicking mouse-1 or mouse-3 kills the selected text. - -This should be bound to a down-mouse event." - (interactive "@e") - (let (select) - (unwind-protect - (setq select (mouse-select-internal 'PRIMARY event)) - (if (and select (listp select)) - (push (cons 'mouse-2 (cdr event)) unread-command-events) - (mouse-sel-primary-to-region select))))) - -(defun mouse-select-secondary (event) - "Set secondary selection using the mouse. - -Click sets the start of the secondary selection to click position. -Dragging extends the secondary selection. - -Multi-clicking selects word/lines/paragraphs, as determined by -'mouse-sel-determine-selection-thing. - -Clicking mouse-2 while selecting copies selected text to the kill-ring. -Clicking mouse-1 or mouse-3 kills the selected text. - -This should be bound to a down-mouse event." - (interactive "e") - (mouse-select-internal 'SECONDARY event)) - -(defun mouse-select-internal (selection event) - "Set SELECTION using the mouse, with EVENT as the initial down-event. -Normally, this returns the direction in which the selection was -made: a value of 1 indicates that the mouse was dragged -left-to-right, otherwise it was dragged right-to-left. - -However, if `mouse-1-click-follows-link' is non-nil and the -subsequent mouse events specify following a link, this returns -the final mouse-event. In that case, the selection is not set." - (mouse-sel-eval-at-event-end event - (let ((thing-symbol (mouse-sel-selection-thing selection)) - (overlay (mouse-sel-selection-overlay selection))) - (set thing-symbol - (mouse-sel-determine-selection-thing (event-click-count event))) - (let ((object-bounds (bounds-of-thing-at-point - (symbol-value thing-symbol)))) - (if object-bounds - (progn - (move-overlay overlay - (car object-bounds) (cdr object-bounds) - (current-buffer))) - (move-overlay overlay (point) (point) (current-buffer))))) - (catch 'follow-link - (mouse-extend-internal selection event t)))) - -;;=== Extend ============================================================== - -(defun mouse-extend (event) - "Extend region/selection using the mouse." - (interactive "e") - (let ((orig-window (selected-window)) - direction) - (select-window (posn-window (event-end event))) - (unwind-protect - (progn - (mouse-sel-region-to-primary orig-window) - (setq direction (mouse-extend-internal 'PRIMARY event))) - (mouse-sel-primary-to-region direction)))) - -(defun mouse-extend-secondary (event) - "Extend secondary selection using the mouse." - (interactive "e") - (save-window-excursion - (mouse-extend-internal 'SECONDARY event))) - -(defun mouse-extend-internal (selection &optional initial-event no-process) - "Extend specified SELECTION using the mouse. -Track mouse-motion events, adjusting the SELECTION appropriately. -Optional argument INITIAL-EVENT specifies an initial down-mouse event. -Optional argument NO-PROCESS means not to process the initial -event. - -See documentation for mouse-select-internal for more details." - (mouse-sel-eval-at-event-end initial-event - (let ((orig-cursor-type - (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))) - (unwind-protect - - (let* ((thing-symbol (mouse-sel-selection-thing selection)) - (overlay (mouse-sel-selection-overlay selection)) - (orig-window (selected-window)) - (top (nth 1 (window-edges orig-window))) - (bottom (nth 3 (window-edges orig-window))) - (mark-active nil) ; inhibit normal region highlight - (echo-keystrokes 0) ; don't echo mouse events - min max - direction - event) - - ;; Get current bounds of overlay - (if (eq (overlay-buffer overlay) (current-buffer)) - (setq min (overlay-start overlay) - max (overlay-end overlay)) - (setq min (point) - max min) - (set thing-symbol nil)) - - - ;; Bar cursor - (if (fboundp 'modify-frame-parameters) - (modify-frame-parameters (selected-frame) - '((cursor-type . bar)))) - - ;; Handle dragging - (track-mouse - - (while (if (and initial-event (not no-process)) - ;; Use initial event - (prog1 - (setq event initial-event) - (setq initial-event nil)) - (setq event (read-event)) - (and (consp event) - (memq (car event) '(mouse-movement switch-frame)))) - - (let ((selection-thing (symbol-value thing-symbol)) - (end (event-end event))) - - (cond - - ;; Ignore any movement outside the frame - ((eq (car-safe event) 'switch-frame) nil) - ((and (posn-window end) - (not (eq (let ((posn-w (posn-window end))) - (if (windowp posn-w) - (window-frame posn-w) - posn-w)) - (window-frame orig-window)))) nil) - - ;; Different window, same frame - ((not (eq (posn-window end) orig-window)) - (let ((end-row (cdr (cdr (mouse-position))))) - (cond - ((and end-row (not (bobp)) (< end-row top)) - (mouse-scroll-subr orig-window (- end-row top) - overlay max)) - ((and end-row (not (eobp)) (>= end-row bottom)) - (mouse-scroll-subr orig-window (1+ (- end-row bottom)) - overlay min)) - ))) - - ;; On the mode line - ((eq (posn-point end) 'mode-line) - (mouse-scroll-subr orig-window 1 overlay min)) - - ;; In original window - (t (goto-char (posn-point end))) - - ) - - ;; Determine direction of drag - (cond - ((and (not direction) (not (eq min max))) - (setq direction (if (< (point) (/ (+ min max) 2)) -1 1))) - ((and (not (eq direction -1)) (<= (point) min)) - (setq direction -1)) - ((and (not (eq direction 1)) (>= (point) max)) - (setq direction 1))) - - (if (not selection-thing) nil - - ;; If dragging forward, goal is next character - (if (and (eq direction 1) (not (eobp))) (forward-char 1)) - - ;; Move to start/end of selected thing - (let ((goal (point))) - (goto-char (if (eq 1 direction) min max)) - (condition-case nil - (progn - (while (> (* direction (- goal (point))) 0) - (forward-thing selection-thing direction)) - (let ((end (point))) - (forward-thing selection-thing (- direction)) - (goto-char - (if (> (* direction (- goal (point))) 0) - end (point))))) - (error)))) - - ;; Move overlay - (move-overlay overlay - (if (eq 1 direction) min (point)) - (if (eq -1 direction) max (point)) - (current-buffer)) - - ))) ; end track-mouse - - ;; Detect follow-link events - (when (mouse-sel-follow-link-p initial-event event) - (throw 'follow-link event)) - - ;; Finish up after dragging - (let ((overlay-start (overlay-start overlay)) - (overlay-end (overlay-end overlay))) - - ;; Set selection - (if (not (eq overlay-start overlay-end)) - (mouse-sel-set-selection - selection - (buffer-substring overlay-start overlay-end))) - - ;; Handle copy/kill - (let (this-command) - (cond - ((eq (event-basic-type last-input-event) 'mouse-2) - (copy-region-as-kill overlay-start overlay-end) - (read-event) (read-event)) - ((and (memq (event-basic-type last-input-event) - '(mouse-1 mouse-3)) - (memq 'down (event-modifiers last-input-event))) - (kill-region overlay-start overlay-end) - (move-overlay overlay overlay-start overlay-start) - (read-event) (read-event)) - ((and (eq (event-basic-type last-input-event) 'mouse-3) - (memq 'double (event-modifiers last-input-event))) - (kill-region overlay-start overlay-end) - (move-overlay overlay overlay-start overlay-start))))) - - direction) - - ;; Restore cursor - (if (fboundp 'modify-frame-parameters) - (modify-frame-parameters - (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) - - )))) - -(defun mouse-sel-follow-link-p (initial final) - "Return t if we should follow a link, given INITIAL and FINAL mouse events. -See `mouse-1-click-follows-link' for details. Currently, Mouse -Sel mode does not support using a `double' value to follow links -using double-clicks." - (and initial final mouse-1-click-follows-link - (eq (car initial) 'down-mouse-1) - (mouse-on-link-p (event-start initial)) - (= (posn-point (event-start initial)) - (posn-point (event-end final))) - (= (event-click-count initial) 1) - (or (not (integerp mouse-1-click-follows-link)) - (let ((t0 (posn-timestamp (event-start initial))) - (t1 (posn-timestamp (event-end final)))) - (and (integerp t0) (integerp t1) - (if (> mouse-1-click-follows-link 0) - (<= (- t1 t0) mouse-1-click-follows-link) - (< (- t0 t1) mouse-1-click-follows-link))))))) - -;;=== Paste =============================================================== - -(defun mouse-insert-selection (event arg) - "Insert the contents of the PRIMARY selection at mouse click. -If `mouse-yank-at-point' is non-nil, insert at point instead." - (interactive "e\nP") - (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) - (mouse-yank-at-click event arg) - (mouse-insert-selection-internal 'PRIMARY event))) - -(defun mouse-insert-secondary (event) - "Insert the contents of the SECONDARY selection at mouse click. -If `mouse-yank-at-point' is non-nil, insert at point instead." - (interactive "e") - (mouse-insert-selection-internal 'SECONDARY event)) - -(defun mouse-insert-selection-internal (selection event) - "Insert the contents of the named SELECTION at mouse click. -If `mouse-yank-at-point' is non-nil, insert at point instead." - (unless mouse-yank-at-point - (mouse-set-point event)) - (when mouse-sel-get-selection-function - (push-mark (point) 'nomsg) - (insert-for-yank - (or (funcall mouse-sel-get-selection-function selection) "")))) - -;;=== Handle loss of selections =========================================== - -(defun mouse-sel-lost-selection-hook (selection) - "Remove the overlay for a lost selection." - (let ((overlay (mouse-sel-selection-overlay selection))) - (delete-overlay overlay))) - -(provide 'mouse-sel) - -;;; mouse-sel.el ends here diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el new file mode 100644 index 00000000000..773302246dc --- /dev/null +++ b/lisp/obsolete/mouse-sel.el @@ -0,0 +1,752 @@ +;;; mouse-sel.el --- multi-click selection support + +;; Copyright (C) 1993-1995, 2001-2012 Free Software Foundation, Inc. + +;; Author: Mike Williams +;; Keywords: mouse + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This module provides multi-click mouse support for GNU Emacs versions +;; 19.18 and later. I've tried to make it behave more like standard X +;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers. +;; Basically: +;; +;; * Clicking mouse-1 starts (cancels) selection, dragging extends it. +;; +;; * Clicking or dragging mouse-3 extends the selection as well. +;; +;; * Double-clicking on word constituents selects words. +;; Double-clicking on symbol constituents selects symbols. +;; Double-clicking on quotes or parentheses selects sexps. +;; Double-clicking on whitespace selects whitespace. +;; Triple-clicking selects lines. +;; Quad-clicking selects paragraphs. +;; +;; * Selecting sets the region & X primary selection, but does NOT affect +;; the kill-ring. Because the mouse handlers set the primary selection +;; directly, mouse-sel sets the variables interprogram-cut-function +;; and interprogram-paste-function to nil. +;; +;; * Clicking mouse-2 inserts the contents of the primary selection at +;; the mouse position (or point, if mouse-yank-at-point is non-nil). +;; +;; * Pressing mouse-2 while selecting or extending copies selection +;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. +;; +;; * Double-clicking mouse-3 also kills selection. +;; +;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 +;; & mouse-3, but operate on the X secondary selection rather than the +;; primary selection and region. +;; +;; This module requires my thingatpt.el module, which it uses to find the +;; bounds of words, lines, sexps, etc. +;; +;; Thanks to KevinB@bartley.demon.co.uk for his useful input. +;; +;;--- Customization ------------------------------------------------------- +;; +;; * You may want to use none or more of following: +;; +;; ;; Enable region highlight +;; (transient-mark-mode 1) +;; +;; ;; But only in the selected window +;; (setq highlight-nonselected-windows nil) +;; +;; ;; Enable pending-delete +;; (delete-selection-mode 1) +;; +;; * You can control the way mouse-sel binds its keys by setting the value +;; of mouse-sel-default-bindings before loading mouse-sel. +;; +;; (a) If mouse-sel-default-bindings = t (the default) +;; +;; Mouse sets and insert selection +;; mouse-1 mouse-select +;; mouse-2 mouse-insert-selection +;; mouse-3 mouse-extend +;; +;; Selection/kill-ring interaction is disabled +;; interprogram-cut-function = nil +;; interprogram-paste-function = nil +;; +;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste +;; +;; Mouse sets selection, and pastes from kill-ring +;; mouse-1 mouse-select +;; mouse-2 mouse-insert-selection +;; mouse-3 mouse-extend +;; In this mode, mouse-insert-selection just calls mouse-yank-at-click. +;; +;; Selection/kill-ring interaction is retained +;; interprogram-cut-function = x-select-text +;; interprogram-paste-function = x-selection-value +;; +;; What you lose is the ability to select some text in +;; delete-selection-mode and yank over the top of it. +;; +;; (c) If mouse-sel-default-bindings = nil, no bindings are made. +;; +;; * By default, mouse-insert-selection (mouse-2) inserts the selection at +;; the mouse position. You can tell it to insert at point instead with: +;; +;; (setq mouse-yank-at-point t) +;; +;; * I like to leave point at the end of the region nearest to where the +;; mouse was, even though this makes region highlighting mis-leading (the +;; cursor makes it look like one extra character is selected). You can +;; disable this behavior with: +;; +;; (setq mouse-sel-leave-point-near-mouse nil) +;; +;; * By default, mouse-select cycles the click count after 4 clicks. That +;; is, clicking mouse-1 five times has the same effect as clicking it +;; once, clicking six times has the same effect as clicking twice, etc. +;; Disable this behavior with: +;; +;; (setq mouse-sel-cycle-clicks nil) +;; +;; * The variables mouse-sel-{set,get}-selection-function control how the +;; selection is handled. Under X Windows, these variables default so +;; that the X primary selection is used. Under other windowing systems, +;; alternate functions are used, which simply store the selection value +;; in a variable. + +;;; Code: + +(require 'mouse) +(require 'thingatpt) + +(eval-when-compile + (require 'cl)) + +;;=== User Variables ====================================================== + +(defgroup mouse-sel nil + "Mouse selection enhancement." + :group 'mouse) + +(defcustom mouse-sel-leave-point-near-mouse t + "Leave point near last mouse position. +If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end +of the region nearest to where the mouse last was. +If nil, point will always be placed at the beginning of the region." + :type 'boolean + :group 'mouse-sel) + +(defcustom mouse-sel-cycle-clicks t + "If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks." + :type 'boolean + :group 'mouse-sel) + +(defcustom mouse-sel-default-bindings t + "Control mouse bindings." + :type '(choice (const :tag "none" nil) + (const :tag "cut and paste" interprogram-cut-paste) + (other :tag "default bindings" t)) + :group 'mouse-sel) + +;;=== Key bindings ======================================================== + +(defconst mouse-sel-bound-events + '(;; Primary selection bindings. + ;; + ;; Bind keys to `ignore' instead of unsetting them because modes may + ;; bind `down-mouse-1', for instance, without binding `mouse-1'. + ;; If we unset `mouse-1', this leads to a bitch_at_user when the + ;; mouse goes up because no matching binding is found for that. + ([mouse-1] . ignore) + ([drag-mouse-1] . ignore) + ([mouse-3] . ignore) + ([down-mouse-1] . mouse-select) + ([down-mouse-3] . mouse-extend) + ([mouse-2] . mouse-insert-selection) + ;; Secondary selection bindings. + ([M-mouse-1] . ignore) + ([M-drag-mouse-1] . ignore) + ([M-mouse-3] . ignore) + ([M-down-mouse-1] . mouse-select-secondary) + ([M-mouse-2] . mouse-insert-secondary) + ([M-down-mouse-3] . mouse-extend-secondary)) + "An alist of events that `mouse-sel-mode' binds.") + +;;=== User Command ======================================================== + +(defvar mouse-sel-has-been-enabled nil + "Non-nil if Mouse Sel mode has been enabled at least once.") + +(defvar mouse-sel-original-bindings nil) +(defvar mouse-sel-original-interprogram-cut-function nil) +(defvar mouse-sel-original-interprogram-paste-function nil) + +;;;###autoload +(define-minor-mode mouse-sel-mode + "Toggle Mouse Sel mode. +With a prefix argument ARG, enable Mouse Sel mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +Mouse Sel mode is a global minor mode. When enabled, mouse +selection is enhanced in various ways: + +- Double-clicking on symbol constituents selects symbols. +Double-clicking on quotes or parentheses selects sexps. +Double-clicking on whitespace selects whitespace. +Triple-clicking selects lines. +Quad-clicking selects paragraphs. + +- Selecting sets the region & X primary selection, but does NOT affect +the `kill-ring', nor do the kill-ring functions change the X selection. +Because the mouse handlers set the primary selection directly, +mouse-sel sets the variables `interprogram-cut-function' and +`interprogram-paste-function' to nil. + +- Clicking mouse-2 inserts the contents of the primary selection at +the mouse position (or point, if `mouse-yank-at-point' is non-nil). + +- mouse-2 while selecting or extending copies selection to the +kill ring; mouse-1 or mouse-3 kills it." + :global t + :group 'mouse-sel + (if mouse-sel-mode + (progn + ;; If mouse-2 has never been done by the user, initialize the + ;; `event-kind' property to ensure that `follow-link' clicks + ;; are interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click) + (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) + (when mouse-sel-default-bindings + ;; Save original bindings and replace them with new ones. + (setq mouse-sel-original-bindings + (mapcar (lambda (binding) + (let ((event (car binding))) + (prog1 (cons event (lookup-key global-map event)) + (global-set-key event (cdr binding))))) + mouse-sel-bound-events)) + ;; Update interprogram functions. + (setq mouse-sel-original-interprogram-cut-function + interprogram-cut-function + mouse-sel-original-interprogram-paste-function + interprogram-paste-function + mouse-sel-has-been-enabled t) + (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste) + (setq interprogram-cut-function nil + interprogram-paste-function nil)))) + + ;; Restore original bindings + (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook) + (dolist (binding mouse-sel-original-bindings) + (global-set-key (car binding) (cdr binding))) + ;; Restore the old values of these variables, + ;; only if they were actually saved previously. + (if mouse-sel-has-been-enabled + (setq interprogram-cut-function + mouse-sel-original-interprogram-cut-function + interprogram-paste-function + mouse-sel-original-interprogram-paste-function)))) + +(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.2") + +;;=== Internal Variables/Constants ======================================== + +(defvar mouse-sel-primary-thing nil + "Type of PRIMARY selection in current buffer.") +(make-variable-buffer-local 'mouse-sel-primary-thing) + +(defvar mouse-sel-secondary-thing nil + "Type of SECONDARY selection in current buffer.") +(make-variable-buffer-local 'mouse-sel-secondary-thing) + +;; Ensure that secondary overlay is defined +(unless (overlayp mouse-secondary-overlay) + (setq mouse-secondary-overlay (make-overlay 1 1)) + (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) + +(defconst mouse-sel-primary-overlay + (let ((ol (make-overlay (point-min) (point-min)))) + (delete-overlay ol) + (overlay-put ol 'face 'region) + ol) + "An overlay which records the current primary selection. +This is used by Mouse Sel mode only.") + +(defconst mouse-sel-selection-alist + '((PRIMARY mouse-sel-primary-overlay mouse-sel-primary-thing) + (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing)) + "Alist associating selections with variables. +Each element is of the form: + + (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL) + +where SELECTION-NAME = name of selection + OVERLAY-SYMBOL = name of variable containing overlay to use + SELECTION-THING-SYMBOL = name of variable where the current selection + type for this selection should be stored.") + +(declare-function x-select-text "term/common-win" (text)) + +(defvar mouse-sel-set-selection-function + (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) + 'x-set-selection + (lambda (selection value) + (if (eq selection 'PRIMARY) + (x-select-text value) + (x-set-selection selection value)))) + "Function to call to set selection. +Called with two arguments: + + SELECTION, the name of the selection concerned, and + VALUE, the text to store. + +This sets the selection, unless `mouse-sel-default-bindings' +is `interprogram-cut-paste'.") + +(declare-function x-selection-value "term/x-win" ()) + +(defvar mouse-sel-get-selection-function + (lambda (selection) + (if (eq selection 'PRIMARY) + (or (x-selection-value) + (bound-and-true-p x-last-selected-text) + (bound-and-true-p x-last-selected-text-primary)) + (x-get-selection selection))) + "Function to call to get the selection. +Called with one argument: + + SELECTION: the name of the selection concerned.") + +;;=== Support/access functions ============================================ + +(defun mouse-sel-determine-selection-thing (nclicks) + "Determine what `thing' `mouse-sel' should operate on. +The first argument is NCLICKS, is the number of consecutive +mouse clicks at the same position. + +Double-clicking on word constituents selects words. +Double-clicking on symbol constituents selects symbols. +Double-clicking on quotes or parentheses selects sexps. +Double-clicking on whitespace selects whitespace. +Triple-clicking selects lines. +Quad-clicking selects paragraphs. + +Feel free to re-define this function to support your own desired +multi-click semantics." + (let* ((next-char (char-after (point))) + (char-syntax (if next-char (char-syntax next-char)))) + (if mouse-sel-cycle-clicks + (setq nclicks (1+ (% (1- nclicks) 4)))) + (cond + ((= nclicks 1) nil) + ((= nclicks 3) 'line) + ((>= nclicks 4) 'paragraph) + ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) + ((memq next-char '(?\s ?\t ?\n)) 'whitespace) + ((eq char-syntax ?_) 'symbol) + ((eq char-syntax ?w) 'word)))) + +(defun mouse-sel-set-selection (selection value) + "Set the specified SELECTION to VALUE." + (if mouse-sel-set-selection-function + (funcall mouse-sel-set-selection-function selection value) + (put 'mouse-sel-internal-selection selection value))) + +(defun mouse-sel-get-selection (selection) + "Get the value of the specified SELECTION." + (if mouse-sel-get-selection-function + (funcall mouse-sel-get-selection-function selection) + (get 'mouse-sel-internal-selection selection))) + +(defun mouse-sel-selection-overlay (selection) + "Return overlay corresponding to SELECTION." + (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist)))) + (or symbol (error "No overlay corresponding to %s selection" selection)) + (symbol-value symbol))) + +(defun mouse-sel-selection-thing (selection) + "Return overlay corresponding to SELECTION." + (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist)))) + (or symbol (error "No symbol corresponding to %s selection" selection)) + symbol)) + +(defun mouse-sel-region-to-primary (orig-window) + "Convert region to PRIMARY overlay and deactivate region. +Argument ORIG-WINDOW specifies the window the cursor was in when the +originating command was issued, and is used to determine whether the +region was visible or not." + (if transient-mark-mode + (let ((overlay (mouse-sel-selection-overlay 'PRIMARY))) + (cond + ((and mark-active + (or highlight-nonselected-windows + (eq orig-window (selected-window)))) + ;; Region was visible, so convert region to overlay + (move-overlay overlay (region-beginning) (region-end) + (current-buffer))) + ((eq orig-window (selected-window)) + ;; Point was visible, so set overlay at point + (move-overlay overlay (point) (point) (current-buffer))) + (t + ;; Nothing was visible, so remove overlay + (delete-overlay overlay))) + (setq mark-active nil)))) + +(defun mouse-sel-primary-to-region (&optional direction) + "Convert PRIMARY overlay to region. +Optional argument DIRECTION specifies the mouse drag direction: a value of +1 indicates that the mouse was dragged left-to-right, otherwise it was +dragged right-to-left." + (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY)) + (start (overlay-start overlay)) + (end (overlay-end overlay))) + (if (eq start end) + (progn + (if start (goto-char start)) + (deactivate-mark)) + (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) + (progn + (goto-char end) + (push-mark start 'nomsg 'active)) + (goto-char start) + (push-mark end 'nomsg 'active))) + (if transient-mark-mode (delete-overlay overlay)))) + +(defmacro mouse-sel-eval-at-event-end (event &rest forms) + "Evaluate forms at mouse position. +Move to the end position of EVENT, execute FORMS, and restore original +point and window." + `(let ((posn (event-end ,event))) + (if posn (mouse-minibuffer-check ,event)) + (if (and posn (not (windowp (posn-window posn)))) + (error "Cursor not in text area of window")) + (let (orig-window orig-point-marker) + (setq orig-window (selected-window)) + (if posn (select-window (posn-window posn))) + (setq orig-point-marker (point-marker)) + (if (and posn (numberp (posn-point posn))) + (goto-char (posn-point posn))) + (unwind-protect + (progn + ,@forms) + (goto-char (marker-position orig-point-marker)) + (move-marker orig-point-marker nil) + (select-window orig-window))))) + +(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1) + +;;=== Select ============================================================== + +(defun mouse-select (event) + "Set region/selection using the mouse. + +Click sets point & mark to click position. +Dragging extends region/selection. + +Multi-clicking selects word/lines/paragraphs, as determined by +'mouse-sel-determine-selection-thing. + +Clicking mouse-2 while selecting copies selected text to the kill-ring. +Clicking mouse-1 or mouse-3 kills the selected text. + +This should be bound to a down-mouse event." + (interactive "@e") + (let (select) + (unwind-protect + (setq select (mouse-select-internal 'PRIMARY event)) + (if (and select (listp select)) + (push (cons 'mouse-2 (cdr event)) unread-command-events) + (mouse-sel-primary-to-region select))))) + +(defun mouse-select-secondary (event) + "Set secondary selection using the mouse. + +Click sets the start of the secondary selection to click position. +Dragging extends the secondary selection. + +Multi-clicking selects word/lines/paragraphs, as determined by +'mouse-sel-determine-selection-thing. + +Clicking mouse-2 while selecting copies selected text to the kill-ring. +Clicking mouse-1 or mouse-3 kills the selected text. + +This should be bound to a down-mouse event." + (interactive "e") + (mouse-select-internal 'SECONDARY event)) + +(defun mouse-select-internal (selection event) + "Set SELECTION using the mouse, with EVENT as the initial down-event. +Normally, this returns the direction in which the selection was +made: a value of 1 indicates that the mouse was dragged +left-to-right, otherwise it was dragged right-to-left. + +However, if `mouse-1-click-follows-link' is non-nil and the +subsequent mouse events specify following a link, this returns +the final mouse-event. In that case, the selection is not set." + (mouse-sel-eval-at-event-end event + (let ((thing-symbol (mouse-sel-selection-thing selection)) + (overlay (mouse-sel-selection-overlay selection))) + (set thing-symbol + (mouse-sel-determine-selection-thing (event-click-count event))) + (let ((object-bounds (bounds-of-thing-at-point + (symbol-value thing-symbol)))) + (if object-bounds + (progn + (move-overlay overlay + (car object-bounds) (cdr object-bounds) + (current-buffer))) + (move-overlay overlay (point) (point) (current-buffer))))) + (catch 'follow-link + (mouse-extend-internal selection event t)))) + +;;=== Extend ============================================================== + +(defun mouse-extend (event) + "Extend region/selection using the mouse." + (interactive "e") + (let ((orig-window (selected-window)) + direction) + (select-window (posn-window (event-end event))) + (unwind-protect + (progn + (mouse-sel-region-to-primary orig-window) + (setq direction (mouse-extend-internal 'PRIMARY event))) + (mouse-sel-primary-to-region direction)))) + +(defun mouse-extend-secondary (event) + "Extend secondary selection using the mouse." + (interactive "e") + (save-window-excursion + (mouse-extend-internal 'SECONDARY event))) + +(defun mouse-extend-internal (selection &optional initial-event no-process) + "Extend specified SELECTION using the mouse. +Track mouse-motion events, adjusting the SELECTION appropriately. +Optional argument INITIAL-EVENT specifies an initial down-mouse event. +Optional argument NO-PROCESS means not to process the initial +event. + +See documentation for mouse-select-internal for more details." + (mouse-sel-eval-at-event-end initial-event + (let ((orig-cursor-type + (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))) + (unwind-protect + + (let* ((thing-symbol (mouse-sel-selection-thing selection)) + (overlay (mouse-sel-selection-overlay selection)) + (orig-window (selected-window)) + (top (nth 1 (window-edges orig-window))) + (bottom (nth 3 (window-edges orig-window))) + (mark-active nil) ; inhibit normal region highlight + (echo-keystrokes 0) ; don't echo mouse events + min max + direction + event) + + ;; Get current bounds of overlay + (if (eq (overlay-buffer overlay) (current-buffer)) + (setq min (overlay-start overlay) + max (overlay-end overlay)) + (setq min (point) + max min) + (set thing-symbol nil)) + + + ;; Bar cursor + (if (fboundp 'modify-frame-parameters) + (modify-frame-parameters (selected-frame) + '((cursor-type . bar)))) + + ;; Handle dragging + (track-mouse + + (while (if (and initial-event (not no-process)) + ;; Use initial event + (prog1 + (setq event initial-event) + (setq initial-event nil)) + (setq event (read-event)) + (and (consp event) + (memq (car event) '(mouse-movement switch-frame)))) + + (let ((selection-thing (symbol-value thing-symbol)) + (end (event-end event))) + + (cond + + ;; Ignore any movement outside the frame + ((eq (car-safe event) 'switch-frame) nil) + ((and (posn-window end) + (not (eq (let ((posn-w (posn-window end))) + (if (windowp posn-w) + (window-frame posn-w) + posn-w)) + (window-frame orig-window)))) nil) + + ;; Different window, same frame + ((not (eq (posn-window end) orig-window)) + (let ((end-row (cdr (cdr (mouse-position))))) + (cond + ((and end-row (not (bobp)) (< end-row top)) + (mouse-scroll-subr orig-window (- end-row top) + overlay max)) + ((and end-row (not (eobp)) (>= end-row bottom)) + (mouse-scroll-subr orig-window (1+ (- end-row bottom)) + overlay min)) + ))) + + ;; On the mode line + ((eq (posn-point end) 'mode-line) + (mouse-scroll-subr orig-window 1 overlay min)) + + ;; In original window + (t (goto-char (posn-point end))) + + ) + + ;; Determine direction of drag + (cond + ((and (not direction) (not (eq min max))) + (setq direction (if (< (point) (/ (+ min max) 2)) -1 1))) + ((and (not (eq direction -1)) (<= (point) min)) + (setq direction -1)) + ((and (not (eq direction 1)) (>= (point) max)) + (setq direction 1))) + + (if (not selection-thing) nil + + ;; If dragging forward, goal is next character + (if (and (eq direction 1) (not (eobp))) (forward-char 1)) + + ;; Move to start/end of selected thing + (let ((goal (point))) + (goto-char (if (eq 1 direction) min max)) + (condition-case nil + (progn + (while (> (* direction (- goal (point))) 0) + (forward-thing selection-thing direction)) + (let ((end (point))) + (forward-thing selection-thing (- direction)) + (goto-char + (if (> (* direction (- goal (point))) 0) + end (point))))) + (error)))) + + ;; Move overlay + (move-overlay overlay + (if (eq 1 direction) min (point)) + (if (eq -1 direction) max (point)) + (current-buffer)) + + ))) ; end track-mouse + + ;; Detect follow-link events + (when (mouse-sel-follow-link-p initial-event event) + (throw 'follow-link event)) + + ;; Finish up after dragging + (let ((overlay-start (overlay-start overlay)) + (overlay-end (overlay-end overlay))) + + ;; Set selection + (if (not (eq overlay-start overlay-end)) + (mouse-sel-set-selection + selection + (buffer-substring overlay-start overlay-end))) + + ;; Handle copy/kill + (let (this-command) + (cond + ((eq (event-basic-type last-input-event) 'mouse-2) + (copy-region-as-kill overlay-start overlay-end) + (read-event) (read-event)) + ((and (memq (event-basic-type last-input-event) + '(mouse-1 mouse-3)) + (memq 'down (event-modifiers last-input-event))) + (kill-region overlay-start overlay-end) + (move-overlay overlay overlay-start overlay-start) + (read-event) (read-event)) + ((and (eq (event-basic-type last-input-event) 'mouse-3) + (memq 'double (event-modifiers last-input-event))) + (kill-region overlay-start overlay-end) + (move-overlay overlay overlay-start overlay-start))))) + + direction) + + ;; Restore cursor + (if (fboundp 'modify-frame-parameters) + (modify-frame-parameters + (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) + + )))) + +(defun mouse-sel-follow-link-p (initial final) + "Return t if we should follow a link, given INITIAL and FINAL mouse events. +See `mouse-1-click-follows-link' for details. Currently, Mouse +Sel mode does not support using a `double' value to follow links +using double-clicks." + (and initial final mouse-1-click-follows-link + (eq (car initial) 'down-mouse-1) + (mouse-on-link-p (event-start initial)) + (= (posn-point (event-start initial)) + (posn-point (event-end final))) + (= (event-click-count initial) 1) + (or (not (integerp mouse-1-click-follows-link)) + (let ((t0 (posn-timestamp (event-start initial))) + (t1 (posn-timestamp (event-end final)))) + (and (integerp t0) (integerp t1) + (if (> mouse-1-click-follows-link 0) + (<= (- t1 t0) mouse-1-click-follows-link) + (< (- t0 t1) mouse-1-click-follows-link))))))) + +;;=== Paste =============================================================== + +(defun mouse-insert-selection (event arg) + "Insert the contents of the PRIMARY selection at mouse click. +If `mouse-yank-at-point' is non-nil, insert at point instead." + (interactive "e\nP") + (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) + (mouse-yank-at-click event arg) + (mouse-insert-selection-internal 'PRIMARY event))) + +(defun mouse-insert-secondary (event) + "Insert the contents of the SECONDARY selection at mouse click. +If `mouse-yank-at-point' is non-nil, insert at point instead." + (interactive "e") + (mouse-insert-selection-internal 'SECONDARY event)) + +(defun mouse-insert-selection-internal (selection event) + "Insert the contents of the named SELECTION at mouse click. +If `mouse-yank-at-point' is non-nil, insert at point instead." + (unless mouse-yank-at-point + (mouse-set-point event)) + (when mouse-sel-get-selection-function + (push-mark (point) 'nomsg) + (insert-for-yank + (or (funcall mouse-sel-get-selection-function selection) "")))) + +;;=== Handle loss of selections =========================================== + +(defun mouse-sel-lost-selection-hook (selection) + "Remove the overlay for a lost selection." + (let ((overlay (mouse-sel-selection-overlay selection))) + (delete-overlay overlay))) + +(provide 'mouse-sel) + +;;; mouse-sel.el ends here