;;; mouse-sel.el --- multi-click selection support for Emacs 19
-;; Copyright (C) 1993, 1994, 1995, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
-;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
+;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Mouse sets selection, and pastes from kill-ring
;; mouse-1 mouse-select
-;; mouse-2 mouse-yank-at-click
+;; 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
;; * 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 behaviour with:
+;; 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 behaviour with:
+;; Disable this behavior with:
;;
;; (setq mouse-sel-cycle-clicks nil)
;;
"Mouse selection enhancement."
:group 'mouse)
-(defcustom mouse-sel-mode nil
- "Toggle Mouse Sel mode.
-When Mouse Sel mode is enabled, mouse selection is enhanced in various ways.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `mouse-sel-mode'."
- :set (lambda (symbol value)
- (mouse-sel-mode (or value 0)))
- :initialize 'custom-initialize-default
- :type 'boolean
- :group 'mouse-sel
- :require 'mouse-sel)
-
(defcustom mouse-sel-leave-point-near-mouse t
- "*Leave point near last mouse position.
+ "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."
:group 'mouse-sel)
(defcustom mouse-sel-cycle-clicks t
- "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks."
+ "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."
+ "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
-(defun mouse-sel-mode (&optional arg)
+(define-minor-mode mouse-sel-mode
"Toggle Mouse Sel mode.
With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
Returns the new status of Mouse Sel mode (non-nil means on).
Quad-clicking selects paragraphs.
- Selecting sets the region & X primary selection, but does NOT affect
-the kill-ring, nor do the kill-ring function change the X selection.
+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.
+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).
- 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."
- (interactive "P")
- (let ((on-p (if arg
- (> (prefix-numeric-value arg) 0)
- (not mouse-sel-mode))))
- (if on-p
- (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
- (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook))
- (mouse-sel-bindings on-p)
- (setq mouse-sel-mode on-p)))
-
-;;=== Key bindings ========================================================
-
-(defun mouse-sel-bindings (bind)
- (cond ((not bind)
- ;; These bindings are taken from mouse.el, i.e., they are the default
- ;; bindings. It would be better to restore the previous bindings.
- ;; Primary selection bindings.
- (global-set-key [mouse-1] 'mouse-set-point)
- (global-set-key [mouse-2] 'mouse-yank-at-click)
- (global-set-key [mouse-3] 'mouse-save-then-kill)
- (global-set-key [down-mouse-1] 'mouse-drag-region)
- (global-set-key [drag-mouse-1] 'mouse-set-region)
- (global-set-key [double-mouse-1] 'mouse-set-point)
- (global-set-key [triple-mouse-1] 'mouse-set-point)
- ;; Secondary selection bindings.
- (global-set-key [M-mouse-1] 'mouse-start-secondary)
- (global-set-key [M-mouse-2] 'mouse-yank-secondary)
- (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
- (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
- (global-set-key [M-down-mouse-1] 'mouse-drag-secondary))
- (mouse-sel-default-bindings
- ;;
- ;; Primary selection bindings.
-
- ;; Bind keys to `ignore' instead of unsetting them because
- ;; modes may bind `down-mouse-1', for instance, without
- ;; binding other `up-mouse-1' or `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.
- (global-set-key [mouse-1] 'ignore)
- (global-set-key [drag-mouse-1] 'ignore)
- (global-set-key [mouse-3] 'ignore)
- (global-set-key [down-mouse-1] 'mouse-select)
- (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- (global-set-key [mouse-2] 'mouse-insert-selection)
- (setq interprogram-cut-function nil
- interprogram-paste-function nil))
- (global-set-key [down-mouse-3] 'mouse-extend)
- ;;
- ;; Secondary selection bindings.
- (global-set-key [M-mouse-1] 'ignore)
- (global-set-key [M-drag-mouse-1] 'ignore)
- (global-set-key [M-mouse-3] 'ignore)
- (global-set-key [M-down-mouse-1] 'mouse-select-secondary)
- (global-set-key [M-mouse-2] 'mouse-insert-secondary)
- (global-set-key [M-down-mouse-3] 'mouse-extend-secondary))))
-
-;;=== Command Variable ====================================================
-
-;; This has to come after the function `mouse-sel-mode' and its callee.
-;; An alternative is to put the option `mouse-sel-mode' here and remove its
-;; `:initialize' keyword.
-(when mouse-sel-mode
- (mouse-sel-mode t))
+ :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))))
;;=== Internal Variables/Constants ========================================
SELECTION-THING-SYMBOL = name of variable where the current selection
type for this selection should be stored.")
+(declare-function x-select-text "term/x-win" (text &optional push))
+
(defvar mouse-sel-set-selection-function
(if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
'x-set-selection
This sets the selection as well as the cut buffer for the older applications,
unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
+(declare-function x-cut-buffer-or-selection-value "term/x-win" ())
+
(defvar mouse-sel-get-selection-function
(lambda (selection)
(if (eq selection 'PRIMARY)
- (or (x-cut-buffer-or-selection-value) x-last-selected-text)
+ (or (x-cut-buffer-or-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:
((= nclicks 3) 'line)
((>= nclicks 4) 'paragraph)
((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
- ((memq next-char '(? ?\t ?\n)) 'whitespace)
+ ((memq next-char '(?\s ?\t ?\n)) 'whitespace)
((eq char-syntax ?_) 'symbol)
((eq char-syntax ?w) 'word))))
This should be bound to a down-mouse event."
(interactive "@e")
- (let (direction)
+ (let (select)
(unwind-protect
- (setq direction (mouse-select-internal 'PRIMARY event))
- (mouse-sel-primary-to-region direction))))
+ (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.
(mouse-select-internal 'SECONDARY event))
(defun mouse-select-internal (selection event)
- "Set SELECTION using the mouse."
+ "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)))
(car object-bounds) (cdr object-bounds)
(current-buffer)))
(move-overlay overlay (point) (point) (current-buffer)))))
- (mouse-extend-internal selection)))
+ (catch 'follow-link
+ (mouse-extend-internal selection event t))))
;;=== Extend ==============================================================
(save-window-excursion
(mouse-extend-internal 'SECONDARY event)))
-(defun mouse-extend-internal (selection &optional initial-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 to
-process.
+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
;; Handle dragging
(track-mouse
- (while (if initial-event ; Use initial event
+ (while (if (and initial-event (not no-process))
+ ;; Use initial event
(prog1
(setq event initial-event)
(setq initial-event nil))
))) ; 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)))
))))
+(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)
+(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")
- (mouse-insert-selection-internal 'PRIMARY event))
+ (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.
(mouse-set-point event))
(when mouse-sel-get-selection-function
(push-mark (point) 'nomsg)
- (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
+ (insert-for-yank
+ (or (funcall mouse-sel-get-selection-function selection) ""))))
;;=== Handle loss of selections ===========================================
(let ((overlay (mouse-sel-selection-overlay selection)))
(delete-overlay overlay)))
-;;=== Bug reporting =======================================================
-
-;(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
-
-;(defun mouse-sel-submit-bug-report ()
-; "Submit a bug report on mouse-sel.el via mail."
-; (interactive)
-; (require 'reporter)
-; (reporter-submit-bug-report
-; mouse-sel-maintainer-address
-; (concat "mouse-sel.el "
-; (or (condition-case nil mouse-sel-version (error))
-; "(distributed with Emacs)"))
-; (list 'transient-mark-mode
-; 'delete-selection-mode
-; 'mouse-sel-default-bindings
-; 'mouse-sel-leave-point-near-mouse
-; 'mouse-sel-cycle-clicks
-; 'mouse-sel-selection-alist
-; 'mouse-sel-set-selection-function
-; 'mouse-sel-get-selection-function
-; 'mouse-yank-at-point)))
-
(provide 'mouse-sel)
+;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
;;; mouse-sel.el ends here