;; 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
;;; 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.
;;
;; (overlay-put mouse-drag-overlay 'face 'bold)
-;;; Code: =================================================================
-
-(provide 'mouse-sel)
+;;; Code:
(require 'mouse)
(require 'thingatpt)
-(require 'backquote)
+
+(eval-when-compile
+ (require 'cl))
;;=== User Variables ======================================================
-(defvar mouse-sel-leave-point-near-mouse t
+(defgroup mouse-sel 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.
+You must modify via \\[customize] for this variable to have an effect."
+ :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.
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.")
+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)
+
+;;=== User Command ========================================================
+
+;;;###autoload
+(defun mouse-sel-mode (&optional arg)
+ "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).
+
+When Mouse Sel mode is enabled, mouse selection is enhanced in various ways:
+
+- 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.
-(defvar mouse-sel-cycle-clicks t
- "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.")
+- Clicking mouse-2 inserts the contents of the primary selection at
+the mouse position (or point, if mouse-yank-at-point is non-nil).
-(defvar mouse-sel-default-bindings t
- "Set to nil before loading `mouse-sel' to prevent default mouse bindings.")
+- 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."
+ (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.
+ (global-unset-key [mouse-1])
+ (global-unset-key [drag-mouse-1])
+ (global-unset-key [mouse-3])
+ (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-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-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))
;;=== Internal Variables/Constants ========================================
(make-variable-buffer-local 'mouse-sel-secondary-thing)
;; Ensure that secondary overlay is defined
-(if (overlayp mouse-secondary-overlay) nil
+(unless (overlayp mouse-secondary-overlay)
(setq mouse-secondary-overlay (make-overlay 1 1))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))
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)
- 'x-set-selection)
+(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.")
+ VALUE, the text to store.
+
+This sets the selection as well as the cut buffer for the older applications,
+unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
(defvar mouse-sel-get-selection-function
- (if (fboundp 'x-get-selection)
- 'x-get-selection)
+ (lambda (selection)
+ (if (eq selection 'PRIMARY)
+ (or (x-cut-buffer-or-selection-value) x-last-selected-text)
+ (x-get-selection selection)))
"Function to call to get the selection.
Called with one argument:
SELECTION: the name of the selection concerned.")
-(defvar mouse-sel-selection-owner-p-function
- (if (fboundp 'x-selection-owner-p)
- 'x-selection-owner-p)
- "Function to check whether Emacs still owns the selection.
-Called with one argument:
-
- SELECTION: the name of the selection concerned.")
-
;;=== Support/access functions ============================================
(defun mouse-sel-determine-selection-thing (nclicks)
(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))))
(mouse-sel-primary-to-region direction))))
(defun mouse-select-secondary (event)
- "Set secondary selection using the mouse.
+ "Set secondary selection using the mouse.
Click sets the start of the secondary selection to click position.
Dragging extends the secondary selection.
Clicking mouse-1 or mouse-3 kills the selected text.
This should be bound to a down-mouse event."
- (interactive "e")
+ (interactive "e")
(mouse-select-internal 'SECONDARY event))
(defun mouse-select-internal (selection event)
(if (and (eq direction 1) (not (eobp))) (forward-char 1))
;; Move to start/end of selected thing
- (let ((goal (point))
- last)
+ (let ((goal (point)))
(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))))
+ end (point)))))
(error))))
;; Move overlay
(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 event))
- (if 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 ()
- "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)
+ (unless mouse-yank-at-point
+ (mouse-set-point event))
+ (when mouse-sel-get-selection-function
+ (push-mark (point) 'nomsg)
+ (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
-;;=== Key bindings ========================================================
+;;=== Handle loss of selections ===========================================
-(if (not mouse-sel-default-bindings) nil
-
- (global-unset-key [mouse-1])
- (global-unset-key [drag-mouse-1])
- (global-unset-key [mouse-3])
-
- (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)
-
- (setq interprogram-cut-function nil
- interprogram-paste-function nil))
-
- (global-set-key [M-mouse-2] 'mouse-insert-secondary)
-
- )
+(defun mouse-sel-lost-selection-hook (selection)
+ "Remove the overlay for a lost selection."
+ (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-sel-selection-owner-p-function
- 'mouse-yank-at-point)))
+;(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)
;; mouse-sel.el ends here.