aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSimon Marshall1997-07-15 07:43:48 +0000
committerSimon Marshall1997-07-15 07:43:48 +0000
commitad3f1e65bde1bc50b3d92c8126e10ebd0f410994 (patch)
tree6139fbf91453084b4ab4467512b1c58790226eb4
parent92d874e6873c4366fc222ae504c4a709fe117b22 (diff)
downloademacs-ad3f1e65bde1bc50b3d92c8126e10ebd0f410994.tar.gz
emacs-ad3f1e65bde1bc50b3d92c8126e10ebd0f410994.zip
Customise. Don't install bindings on file load; use a fn.
-rw-r--r--lisp/mouse-sel.el252
1 files changed, 172 insertions, 80 deletions
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index e86737c197f..d2c0a48fde2 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -137,24 +137,144 @@
137 137
138;;; Code: 138;;; Code:
139 139
140(provide 'mouse-sel)
141
142(require 'mouse) 140(require 'mouse)
143(require 'thingatpt) 141(require 'thingatpt)
144 142
143(eval-when-compile
144 (require 'cl))
145
145;;=== User Variables ====================================================== 146;;=== User Variables ======================================================
146 147
147(defvar mouse-sel-leave-point-near-mouse t 148(defgroup mouse-sel nil
149 "Mouse selection enhancement."
150 :group 'mouse)
151
152(defcustom mouse-sel-mode nil
153 "Toggle Mouse Sel mode.
154When Mouse Sel mode is enabled, mouse selection is enhanced in various ways.
155You must modify via \\[customize] for this variable to have an effect."
156 :set (lambda (symbol value)
157 (mouse-sel-mode (or value 0)))
158 :initialize 'custom-initialize-default
159 :type 'boolean
160 :group 'mouse-sel
161 :require 'mouse-sel)
162
163(defcustom mouse-sel-leave-point-near-mouse t
148 "*Leave point near last mouse position. 164 "*Leave point near last mouse position.
149If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end 165If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
150of the region nearest to where the mouse last was. 166of the region nearest to where the mouse last was.
151If nil, point will always be placed at the beginning of the region.") 167If nil, point will always be placed at the beginning of the region."
168 :type 'boolean
169 :group 'mouse-sel)
170
171(defcustom mouse-sel-cycle-clicks t
172 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks."
173 :type 'boolean
174 :group 'mouse-sel)
175
176(defcustom mouse-sel-default-bindings t
177 "*Control mouse bindings."
178 :type '(choice (const :tag "none" nil)
179 (const :tag "default bindings" t)
180 (const :tag "cut and paste" interprogram-cut-paste))
181 :group 'mouse-sel)
182
183;;=== User Command ========================================================
184
185;;;###autoload
186(defun mouse-sel-mode (&optional arg)
187 "Toggle Mouse Sel mode.
188With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
189Returns the new status of Mouse Sel mode (non-nil means on).
190
191When Mouse Sel mode is enabled, mouse selection is enhanced in various ways:
192
193- Clicking mouse-1 starts (cancels) selection, dragging extends it.
194
195- Clicking or dragging mouse-3 extends the selection as well.
196
197- Double-clicking on word constituents selects words.
198Double-clicking on symbol constituents selects symbols.
199Double-clicking on quotes or parentheses selects sexps.
200Double-clicking on whitespace selects whitespace.
201Triple-clicking selects lines.
202Quad-clicking selects paragraphs.
203
204- Selecting sets the region & X primary selection, but does NOT affect
205the kill-ring. Because the mouse handlers set the primary selection
206directly, mouse-sel sets the variables interprogram-cut-function
207and interprogram-paste-function to nil.
152 208
153(defvar mouse-sel-cycle-clicks t 209- Clicking mouse-2 inserts the contents of the primary selection at
154 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.") 210the mouse position (or point, if mouse-yank-at-point is non-nil).
155 211
156(defvar mouse-sel-default-bindings t 212- Pressing mouse-2 while selecting or extending copies selection
157 "Set to nil before loading `mouse-sel' to prevent default mouse bindings.") 213to the kill ring. Pressing mouse-1 or mouse-3 kills it.
214
215- Double-clicking mouse-3 also kills selection.
216
217- M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
218& mouse-3, but operate on the X secondary selection rather than the
219primary selection and region."
220 (interactive "P")
221 (let ((on-p (if arg
222 (> (prefix-numeric-value arg) 0)
223 (not mouse-sel-mode))))
224 (if on-p
225 (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
226 (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook))
227 (mouse-sel-bindings on-p)
228 (setq mouse-sel-mode on-p)))
229
230;;=== Key bindings ========================================================
231
232(defun mouse-sel-bindings (bind)
233 (cond ((not bind)
234 ;; These bindings are taken from mouse.el, i.e., they are the default
235 ;; bindings. It would be better to restore the previous bindings.
236 ;; Primary selection bindings.
237 (global-set-key [mouse-1] 'mouse-set-point)
238 (global-set-key [mouse-2] 'mouse-yank-at-click)
239 (global-set-key [mouse-3] 'mouse-save-then-kill)
240 (global-set-key [down-mouse-1] 'mouse-drag-region)
241 (global-set-key [drag-mouse-1] 'mouse-set-region)
242 (global-set-key [double-mouse-1] 'mouse-set-point)
243 (global-set-key [triple-mouse-1] 'mouse-set-point)
244 ;; Secondary selection bindings.
245 (global-set-key [M-mouse-1] 'mouse-start-secondary)
246 (global-set-key [M-mouse-2] 'mouse-yank-secondary)
247 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
248 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
249 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary))
250 (mouse-sel-default-bindings
251 ;;
252 ;; Primary selection bindings.
253 (global-unset-key [mouse-1])
254 (global-unset-key [drag-mouse-1])
255 (global-unset-key [mouse-3])
256 (global-set-key [down-mouse-1] 'mouse-select)
257 (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
258 (global-set-key [mouse-2] 'mouse-insert-selection)
259 (setq interprogram-cut-function nil
260 interprogram-paste-function nil))
261 (global-set-key [down-mouse-3] 'mouse-extend)
262 ;;
263 ;; Secondary selection bindings.
264 (global-unset-key [M-mouse-1])
265 (global-unset-key [M-drag-mouse-1])
266 (global-unset-key [M-mouse-3])
267 (global-set-key [M-down-mouse-1] 'mouse-select-secondary)
268 (global-set-key [M-mouse-2] 'mouse-insert-secondary)
269 (global-set-key [M-down-mouse-3] 'mouse-extend-secondary))))
270
271;;=== Command Variable ====================================================
272
273;; This has to come after the function `mouse-sel-mode' and its callee.
274;; An alternative is to put the option `mouse-sel-mode' here and remove its
275;; `:initialize' keyword.
276(when mouse-sel-mode
277 (mouse-sel-mode t))
158 278
159;;=== Internal Variables/Constants ======================================== 279;;=== Internal Variables/Constants ========================================
160 280
@@ -167,7 +287,7 @@ If nil, point will always be placed at the beginning of the region.")
167(make-variable-buffer-local 'mouse-sel-secondary-thing) 287(make-variable-buffer-local 'mouse-sel-secondary-thing)
168 288
169;; Ensure that secondary overlay is defined 289;; Ensure that secondary overlay is defined
170(if (overlayp mouse-secondary-overlay) nil 290(unless (overlayp mouse-secondary-overlay)
171 (setq mouse-secondary-overlay (make-overlay 1 1)) 291 (setq mouse-secondary-overlay (make-overlay 1 1))
172 (overlay-put mouse-secondary-overlay 'face 'secondary-selection)) 292 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
173 293
@@ -184,25 +304,27 @@ where SELECTION-NAME = name of selection
184 SELECTION-THING-SYMBOL = name of variable where the current selection 304 SELECTION-THING-SYMBOL = name of variable where the current selection
185 type for this selection should be stored.") 305 type for this selection should be stored.")
186 306
187(defvar mouse-sel-set-selection-function 307(defvar mouse-sel-set-selection-function
188 (function (lambda (selection value) 308 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
189 (if (eq selection 'PRIMARY) 309 'x-set-selection
190 (x-select-text value) 310 (lambda (selection value)
191 (x-set-selection selection value)))) 311 (if (eq selection 'PRIMARY)
312 (x-select-text value)
313 (x-set-selection selection value))))
192 "Function to call to set selection. 314 "Function to call to set selection.
193Called with two arguments: 315Called with two arguments:
194 316
195 SELECTION, the name of the selection concerned, and 317 SELECTION, the name of the selection concerned, and
196 VALUE, the text to store. 318 VALUE, the text to store.
197This sets the selection as well as the cut buffer for the older applications. 319
198Use (setq mouse-sel-set-selection-function 'x-set-selection) if you don't care 320This sets the selection as well as the cut buffer for the older applications,
199for them.") 321unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
200 322
201(defvar mouse-sel-get-selection-function 323(defvar mouse-sel-get-selection-function
202 (function (lambda (selection) 324 (lambda (selection)
203 (if (eq selection 'PRIMARY) 325 (if (eq selection 'PRIMARY)
204 (or (x-cut-buffer-or-selection-value) x-last-selected-text) 326 (or (x-cut-buffer-or-selection-value) x-last-selected-text)
205 (x-get-selection selection)))) 327 (x-get-selection selection)))
206 "Function to call to get the selection. 328 "Function to call to get the selection.
207Called with one argument: 329Called with one argument:
208 330
@@ -350,7 +472,7 @@ This should be bound to a down-mouse event."
350 (mouse-sel-primary-to-region direction)))) 472 (mouse-sel-primary-to-region direction))))
351 473
352(defun mouse-select-secondary (event) 474(defun mouse-select-secondary (event)
353 "Set secondary selection using the mouse. 475 "Set secondary selection using the mouse.
354 476
355Click sets the start of the secondary selection to click position. 477Click sets the start of the secondary selection to click position.
356Dragging extends the secondary selection. 478Dragging extends the secondary selection.
@@ -362,7 +484,7 @@ Clicking mouse-2 while selecting copies selected text to the kill-ring.
362Clicking mouse-1 or mouse-3 kills the selected text. 484Clicking mouse-1 or mouse-3 kills the selected text.
363 485
364This should be bound to a down-mouse event." 486This should be bound to a down-mouse event."
365 (interactive "e") 487 (interactive "e")
366 (mouse-select-internal 'SECONDARY event)) 488 (mouse-select-internal 'SECONDARY event))
367 489
368(defun mouse-select-internal (selection event) 490(defun mouse-select-internal (selection event)
@@ -575,12 +697,11 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
575(defun mouse-insert-selection-internal (selection event) 697(defun mouse-insert-selection-internal (selection event)
576 "Insert the contents of the named SELECTION at mouse click. 698 "Insert the contents of the named SELECTION at mouse click.
577If `mouse-yank-at-point' is non-nil, insert at point instead." 699If `mouse-yank-at-point' is non-nil, insert at point instead."
578 (or mouse-yank-at-point 700 (unless mouse-yank-at-point
579 (mouse-set-point event)) 701 (mouse-set-point event))
580 (if mouse-sel-get-selection-function 702 (when mouse-sel-get-selection-function
581 (progn 703 (push-mark (point) 'nomsg)
582 (push-mark (point) 'nomsg) 704 (insert (or (funcall mouse-sel-get-selection-function selection) ""))))
583 (insert (or (funcall mouse-sel-get-selection-function selection) "")))))
584 705
585;;=== Handle loss of selections =========================================== 706;;=== Handle loss of selections ===========================================
586 707
@@ -589,58 +710,29 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
589 (let ((overlay (mouse-sel-selection-overlay selection))) 710 (let ((overlay (mouse-sel-selection-overlay selection)))
590 (delete-overlay overlay))) 711 (delete-overlay overlay)))
591 712
592(add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
593
594;;=== Key bindings ========================================================
595
596(if (not mouse-sel-default-bindings) nil
597
598 (global-unset-key [mouse-1])
599 (global-unset-key [drag-mouse-1])
600 (global-unset-key [mouse-3])
601
602 (global-set-key [down-mouse-1] 'mouse-select)
603 (global-set-key [down-mouse-3] 'mouse-extend)
604
605 (global-unset-key [M-mouse-1])
606 (global-unset-key [M-drag-mouse-1])
607 (global-unset-key [M-mouse-3])
608
609 (global-set-key [M-down-mouse-1] 'mouse-select-secondary)
610 (global-set-key [M-down-mouse-3] 'mouse-extend-secondary)
611
612 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
613
614 (global-set-key [mouse-2] 'mouse-insert-selection)
615
616 (setq interprogram-cut-function nil
617 interprogram-paste-function nil))
618
619 (global-set-key [M-mouse-2] 'mouse-insert-secondary)
620
621 )
622
623;;=== Bug reporting ======================================================= 713;;=== Bug reporting =======================================================
624 714
625(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz") 715;(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
626 716
627(defun mouse-sel-submit-bug-report () 717;(defun mouse-sel-submit-bug-report ()
628 "Submit a bug report on mouse-sel.el via mail." 718; "Submit a bug report on mouse-sel.el via mail."
629 (interactive) 719; (interactive)
630 (require 'reporter) 720; (require 'reporter)
631 (reporter-submit-bug-report 721; (reporter-submit-bug-report
632 mouse-sel-maintainer-address 722; mouse-sel-maintainer-address
633 (concat "mouse-sel.el " 723; (concat "mouse-sel.el "
634 (or (condition-case nil mouse-sel-version (error)) 724; (or (condition-case nil mouse-sel-version (error))
635 "(distributed with Emacs)")) 725; "(distributed with Emacs)"))
636 (list 'transient-mark-mode 726; (list 'transient-mark-mode
637 'delete-selection-mode 727; 'delete-selection-mode
638 'mouse-sel-default-bindings 728; 'mouse-sel-default-bindings
639 'mouse-sel-leave-point-near-mouse 729; 'mouse-sel-leave-point-near-mouse
640 'mouse-sel-cycle-clicks 730; 'mouse-sel-cycle-clicks
641 'mouse-sel-selection-alist 731; 'mouse-sel-selection-alist
642 'mouse-sel-set-selection-function 732; 'mouse-sel-set-selection-function
643 'mouse-sel-get-selection-function 733; 'mouse-sel-get-selection-function
644 'mouse-yank-at-point))) 734; 'mouse-yank-at-point)))
735
736(provide 'mouse-sel)
645 737
646;; mouse-sel.el ends here. 738;; mouse-sel.el ends here.