summaryrefslogtreecommitdiff
path: root/lisp/mouse-sel.el
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>1995-04-19 04:35:22 +0000
committerRichard M. Stallman <rms@gnu.org>1995-04-19 04:35:22 +0000
commitf250682621d101fb27f1d6a9ef3b76ce47195b26 (patch)
tree3796478574e8d09d1e742ba47f426280e1c6f707 /lisp/mouse-sel.el
parent43efaa48bdaf058f11c710dc3cb90b53a4dc55db (diff)
downloademacs-f250682621d101fb27f1d6a9ef3b76ce47195b26.tar.gz
Downcase function parameters.
Doc fixes. Rewrite to support secondary selection. (mouse-sel-maintainer-address): New constant. (mouse-sel-submit-bug-report): New function. Rename mouse-sel-selection-type to mouse-sel-primary-thing. (mouse-sel-secondary-thing): New variable. (mouse-sel-selection-alist): New constant. (mouse-sel-set-selection-function): Semantics changed. Value should now be a function taking two arguments. (mouse-sel-get-selection-function): Semantics changed. Value should now be a function taking one argument. (mouse-sel-selection-owner-p-function): New variable. Removed variable mouse-sel-check-selection-function. Rename mouse-sel-determine-selection-type to mouse-sel-determine-selection-thing. (mouse-sel-set-selection): New function. (mouse-sel-get-selection): New function. (mouse-sel-selection-owner-p): New function. (mouse-sel-selection-overlay): New function. (mouse-sel-selection-thing): New function. (mouse-sel-region-to-primary): New function. (mouse-sel-primary-to-region): New function. (mouse-sel-eval-at-event-end): New macro. (mouse-sel-determine-selection-thing): Quad-click selects paragraphs. Removed variable mouse-sel-retain-highlight; use inverse of transient-mark-mode instead. (mouse-select-internal): New function. (mouse-select): Re-written using mouse-select-internal and mouse-sel-primary-to-region. (mouse-select-secondary): New function. (mouse-extend-internal): New function. (mouse-extend): Re-written using mouse-extend-internal, mouse-sel-region-to-primary and mouse-sel-primary-to-region. (mouse-extend-secondary): New function. (mouse-insert-selection-internal): New function. (mouse-insert-selection): Re-written using mouse-insert-selection-internal. (mouse-insert-secondary): New function. (mouse-sel-validate-selection): Check all selections in mouse-sel-selection-alist.
Diffstat (limited to 'lisp/mouse-sel.el')
-rw-r--r--lisp/mouse-sel.el712
1 files changed, 460 insertions, 252 deletions
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index 9ca1687d38c..d323b70016d 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -1,10 +1,9 @@
;;; mouse-sel.el --- Multi-click selection support for Emacs 19
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Keywords: mouse
-;; Version: 2.1
;; This file is part of GNU Emacs.
@@ -34,19 +33,24 @@
;; 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 pastes contents of primary selection at the mouse
-;; position.
+;; * 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.
@@ -71,10 +75,10 @@
;;
;; (a) If mouse-sel-default-bindings = t (the default)
;;
-;; Mouse sets and pastes selection
+;; Mouse sets and insert selection
;; mouse-1 mouse-select
;; mouse-2 mouse-insert-selection
-;; mouse-3 mouse-extend
+;; mouse-3 mouse-extend
;;
;; Selection/kill-ring interaction is disabled
;; interprogram-cut-function = nil
@@ -83,9 +87,9 @@
;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
;;
;; Mouse sets selection, and pastes from kill-ring
-;; mouse-1 mouse-select
-;; mouse-2 mouse-yank-at-click
-;; mouse-3 mouse-extend
+;; mouse-1 mouse-select
+;; mouse-2 mouse-yank-at-click
+;; mouse-3 mouse-extend
;;
;; Selection/kill-ring interaction is retained
;; interprogram-cut-function = x-select-text
@@ -108,46 +112,23 @@
;;
;; (setq mouse-sel-leave-point-near-mouse nil)
;;
-;; * Normally, the selection highlight will be removed when the mouse is
-;; lifted. You can tell mouse-sel to retain the selection highlight
-;; (useful if you don't use transient-mark-mode) with:
-;;
-;; (setq mouse-sel-retain-highlight t)
-;;
-;; * By default, mouse-select cycles the click count after 3 clicks. That
-;; is, clicking mouse-1 four times has the same effect as clicking it
-;; once, clicking five times has the same effect as clicking twice, etc.
+;; * 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:
;;
;; (setq mouse-sel-cycle-clicks nil)
;;
-;; * The variables mouse-sel-{set,get,check}-selection-function control how
-;; the selection is handled. Under X Windows, these variables default so
+;; * 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.
;;
-;;--- Hints ---------------------------------------------------------------
-;;
;; * You can change the selection highlight face by altering the properties
;; of mouse-drag-overlay, eg.
;;
;; (overlay-put mouse-drag-overlay 'face 'bold)
-;;
-;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
-;; a two second delay). The following code will cause mouse-sel to use
-;; the cut buffer rather than the primary selection. However, be aware
-;; that cut buffers are OBSOLETE, and some X applications may not support
-;; them.
-;;
-;; (setq mouse-sel-set-selection-function 'x-select-text
-;; mouse-sel-get-selection-function 'x-get-cut-buffer)
-;;
-;;--- Warnings ------------------------------------------------------------
-;;
-;; * When selecting sexps, the selection extends by sexps at the same
-;; nesting level. This also means the selection cannot be extended out
-;; of the enclosing nesting level. This is INTENTIONAL.
;;; Code: =================================================================
@@ -155,280 +136,473 @@
(require 'mouse)
(require 'thingatpt)
-
-;;=== Version =============================================================
-
-(defconst mouse-sel-version "2.1"
- "The version number of mouse-sel (as string).")
+(require 'backquote)
;;=== User Variables ======================================================
(defvar mouse-sel-leave-point-near-mouse t
"*Leave point near last mouse position.
-If non-nil, \\[mouse-select] and \\[mouse-extend] leave point at the end
+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 is always placed at the beginning of the region.")
-
-(defvar mouse-sel-retain-highlight nil
- "*Retain highlight after dragging is finished.
-If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
-remain highlighted.
-If nil, highlighting turns off when you release the mouse button.")
+If nil, point will always be placed at the beginning of the region.")
(defvar mouse-sel-cycle-clicks t
- "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
-Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
+ "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.")
(defvar mouse-sel-default-bindings t
"Set to nil before loading `mouse-sel' to prevent default mouse bindings.")
-;;=== Selection ===========================================================
+;;=== 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
+(if (overlayp mouse-secondary-overlay) nil
+ (setq mouse-secondary-overlay (make-overlay 1 1))
+ (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
-(defvar mouse-sel-selection-type nil "Type of current selection")
-(make-variable-buffer-local 'mouse-sel-selection-type)
+(defconst mouse-sel-selection-alist
+ '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
+ (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
+ "Alist associating selections with variables. Each element is of
+the form:
-(defvar mouse-sel-selection ""
- "Store the selection value when using a window systems other than X.")
+ (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.")
+
(defvar mouse-sel-set-selection-function
(if (fboundp 'x-set-selection)
- (function (lambda (s) (x-set-selection 'PRIMARY s)))
- (function (lambda (s) (setq mouse-sel-selection s))))
+ 'x-set-selection)
"Function to call to set selection.
-Called with one argument, the text to select.")
+Called with two arguments:
+
+ SELECTION, the name of the selection concerned, and
+ VALUE, the text to store.")
(defvar mouse-sel-get-selection-function
(if (fboundp 'x-get-selection)
- 'x-get-selection
- (function (lambda () mouse-sel-selection)))
+ 'x-get-selection)
"Function to call to get the selection.
-Called with no argument.")
+Called with one argument:
-(defvar mouse-sel-check-selection-function
+ SELECTION: the name of the selection concerned.")
+
+(defvar mouse-sel-selection-owner-p-function
(if (fboundp 'x-selection-owner-p)
- 'x-selection-owner-p
- nil)
+ 'x-selection-owner-p)
"Function to check whether Emacs still owns the selection.
-Called with no arguments.")
+Called with one argument:
+
+ SELECTION: the name of the selection concerned.")
-(defun mouse-sel-determine-selection-type (NCLICKS)
- "Determine what \"thing\" `mouse-sel' should operate on.
-The first argument, NCLICKS, is the number of consecutive
-mouse clicks at the same position."
+;;=== 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)))
- (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
+ (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 3) 'line)
+ ((>= nclicks 4) 'paragraph)
((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
((memq next-char '(? ?\t ?\n)) 'whitespace)
((eq char-syntax ?_) 'symbol)
((eq char-syntax ?w) 'word))))
-(defun mouse-select (EVENT)
+(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-owner-p (selection)
+ "Determine whether Emacs owns the specified SELECTION."
+ (if mouse-sel-selection-owner-p-function
+ (funcall mouse-sel-selection-owner-p-function selection)
+ t))
+
+(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.
-Clicking sets point to click position, and deactivates the mark
-if you are in Transient Mark mode.
+Click sets point & mark to click position.
Dragging extends region/selection.
-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.
+Multi-clicking selects word/lines/paragraphs, as determined by
+'mouse-sel-determine-selection-thing.
-Clicking mouse-2 while selecting copies the region to the kill-ring.
-Clicking mouse-1 or mouse-3 kills the region.
+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-set-point EVENT)
- (setq mouse-sel-selection-type
- (mouse-sel-determine-selection-type (event-click-count EVENT)))
- (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
- (if object-bounds
- (progn
- (setq mark-active t)
- (goto-char (car object-bounds))
- (set-mark (cdr object-bounds)))
- (deactivate-mark)))
- (mouse-extend (if mouse-sel-selection-type EVENT)))
+ (interactive "@e")
+ (let (direction)
+ (unwind-protect
+ (setq direction (mouse-select-internal 'PRIMARY event))
+ (mouse-sel-primary-to-region direction))))
+
+(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.
-(defun mouse-extend (&optional EVENT)
- "Extend region/selection using the mouse.
+Multi-clicking selects word/lines/paragraphs, as determined by
+'mouse-sel-determine-selection-thing.
-See documentation for mouse-select for more details.
+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."
+ (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)))))
+ (mouse-extend-internal selection)))
+
+;;=== Extend ==============================================================
+
+(defun mouse-extend (event)
+ "Extend region/selection using the mouse."
(interactive "e")
- (if EVENT (select-window (posn-window (event-end EVENT))))
- (let* ((use-region (and (or EVENT transient-mark-mode) mark-active))
- (min (if use-region (region-beginning) (point)))
- (max (if use-region (region-end) (point)))
- (orig-window (selected-window))
- (orig-window-frame (window-frame orig-window))
- (top (nth 1 (window-edges orig-window)))
- (bottom (nth 3 (window-edges orig-window)))
- (orig-cursor-type
- (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
- direction
- event)
-
- ;; Inhibit normal region highlight
- (setq mark-active nil)
-
- ;; Highlight region (forcing re-highlight)
- (move-overlay mouse-drag-overlay min max (current-buffer))
- (overlay-put mouse-drag-overlay 'face
- (overlay-get mouse-drag-overlay 'face))
-
- ;; Bar cursor
- (if (fboundp 'modify-frame-parameters)
- (modify-frame-parameters (selected-frame) '((cursor-type . bar))))
-
- ;; Handle dragging
+ (let ((orig-window (selected-window))
+ direction)
+ (select-window (posn-window (event-end event)))
(unwind-protect
- (progn
- (track-mouse
-
- (while (if EVENT ; Use initial event
- (prog1
- (setq event EVENT)
- (setq EVENT nil))
- (setq event (read-event))
- (and (consp event)
- (memq (car event) '(mouse-movement switch-frame))))
-
- (let ((end (event-end event)))
+ (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)
+ "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.
+
+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))
+ (orig-window-frame (window-frame orig-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))
- (cond
+
+ ;; Bar cursor
+ (if (fboundp 'modify-frame-parameters)
+ (modify-frame-parameters (selected-frame)
+ '((cursor-type . bar))))
+
+ ;; Handle dragging
+ (track-mouse
+
+ (while (if initial-event ; 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)
+ ;; 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)
- mouse-drag-overlay max))
- ((and end-row (not (eobp)) (>= end-row bottom))
- (mouse-scroll-subr orig-window (1+ (- end-row bottom))
- mouse-drag-overlay min))
- )))
-
- ;; On the mode line
- ((eq (posn-point end) 'mode-line)
- (mouse-scroll-subr orig-window 1 mouse-drag-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 mouse-sel-selection-type) 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)))
+
+ )
- ;; If dragging forward, goal is next character
- (if (and (eq direction 1) (not (eobp))) (forward-char 1))
+ ;; 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)))
- ;; Move to start/end of selected thing
- (let ((goal (point))
- last)
- (goto-char (if (eq 1 direction) min max))
- (condition-case nil
- (progn
- (while (> (* direction (- goal (point))) 0)
- (setq last (point))
- (forward-thing mouse-sel-selection-type
- direction))
- (let ((end (point)))
- (forward-thing mouse-sel-selection-type
- (- direction))
- (goto-char
- (if (> (* direction (- goal (point))) 0)
- end last))))
- (error))))
-
- ;; Move overlay
- (move-overlay mouse-drag-overlay
- (if (eq 1 direction) min (point))
- (if (eq -1 direction) max (point))
- (current-buffer))
+ (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))
+ last)
+ (goto-char (if (eq 1 direction) min max))
+ (condition-case nil
+ (progn
+ (while (> (* direction (- goal (point))) 0)
+ (setq last (point))
+ (forward-thing selection-thing direction))
+ (let ((end (point)))
+ (forward-thing selection-thing (- direction))
+ (goto-char
+ (if (> (* direction (- goal (point))) 0)
+ end last))))
+ (error))))
+
+ ;; Move overlay
+ (move-overlay overlay
+ (if (eq 1 direction) min (point))
+ (if (eq -1 direction) max (point))
+ (current-buffer))
+
+ ))) ; end track-mouse
+
+ ;; Finish up after dragging
+ (let ((overlay-start (overlay-start overlay))
+ (overlay-end (overlay-end overlay)))
- ))) ; end track-mouse
-
- (let ((overlay-start (overlay-start mouse-drag-overlay))
- (overlay-end (overlay-end mouse-drag-overlay)))
-
- ;; Set region
- (if (eq overlay-start overlay-end)
- (deactivate-mark)
- (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
- (progn
- (set-mark overlay-start)
- (goto-char overlay-end))
- (set-mark overlay-end)
- (goto-char overlay-start)))
-
- ;; Set selection
- (if (and mark-active mouse-sel-set-selection-function)
- (funcall mouse-sel-set-selection-function
- (buffer-substring overlay-start overlay-end)))
+ ;; Set selection
+ (if (not (eq overlay-start overlay-end))
+ (mouse-sel-set-selection
+ selection
+ (buffer-substring overlay-start overlay-end)))
- ;; Handle copy/kill
- (cond
- ((eq (car-safe last-input-event) 'down-mouse-2)
- (copy-region-as-kill overlay-start overlay-end)
- (read-event) (read-event))
- ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
- (kill-region overlay-start overlay-end)
- (deactivate-mark)
- (read-event) (read-event))
- ((eq (car-safe last-input-event) 'double-mouse-3)
- (kill-region overlay-start overlay-end)
- (deactivate-mark)))))
-
- ;; Restore cursor
- (if (fboundp 'modify-frame-parameters)
- (modify-frame-parameters
- (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
-
- ;; Remove overlay
- (or mouse-sel-retain-highlight
- (delete-overlay mouse-drag-overlay)))))
-
-(defun mouse-insert-selection (click)
- "Insert the contents of the selection at mouse click.
+ ;; 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))))
+
+ ))))
+
+;;=== Paste ===============================================================
+
+(defun mouse-insert-selection (event)
+ "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))
+
+(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."
(or mouse-yank-at-point
- (mouse-set-point click))
- (deactivate-mark)
+ (mouse-set-point event))
(if mouse-sel-get-selection-function
- (insert (or (funcall mouse-sel-get-selection-function) ""))))
+ (progn
+ (push-mark (point) 'nomsg)
+ (insert (or (funcall mouse-sel-get-selection-function selection) "")))))
+
+;;=== Validate selection ==================================================
(defun mouse-sel-validate-selection ()
- "Remove selection highlight if emacs no longer owns the primary selection."
- (or (not mouse-sel-check-selection-function)
- (funcall mouse-sel-check-selection-function)
- (delete-overlay mouse-drag-overlay)))
+ "Validate selections in mouse-sel-selection-alist.
+For each listed selection, remove the selection overlay if Emacs no longer
+owns the selection."
+ (let ((owner-p-function mouse-sel-selection-owner-p-function)
+ (alist mouse-sel-selection-alist)
+ selection overlay)
+ (if owner-p-function
+ (while alist
+ (setq selection (car (car alist))
+ overlay (symbol-value (nth 1 (car alist)))
+ alist (cdr alist))
+ (or (funcall owner-p-function selection)
+ (delete-overlay overlay))))))
(add-hook 'pre-command-hook 'mouse-sel-validate-selection)
@@ -442,13 +616,47 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
(global-set-key [down-mouse-1] 'mouse-select)
(global-set-key [down-mouse-3] 'mouse-extend)
+
+ (global-unset-key [M-mouse-1])
+ (global-unset-key [M-drag-mouse-1])
+ (global-unset-key [M-mouse-3])
+ (global-set-key [M-down-mouse-1] 'mouse-select-secondary)
+ (global-set-key [M-down-mouse-3] 'mouse-extend-secondary)
+
(if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
- (global-set-key [mouse-2] 'mouse-insert-selection)
+ (global-set-key [mouse-2] 'mouse-insert-selection)
+
(setq interprogram-cut-function nil
interprogram-paste-function nil))
+ (global-set-key [M-mouse-2] 'mouse-insert-secondary)
+
)
+;;=== 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-sel-selection-owner-p-function
+ 'mouse-yank-at-point)))
+
;; mouse-sel.el ends here.