Mercurial > emacs
comparison lisp/mouse-sel.el @ 18784:5e56fda13c2f
Customise. Don't install bindings on file load; use a fn.
author | Simon Marshall <simon@gnu.org> |
---|---|
date | Tue, 15 Jul 1997 07:43:48 +0000 |
parents | 3e65698d4ce9 |
children | 2407b3d241a6 |
comparison
equal
deleted
inserted
replaced
18783:7032bbacd2fa | 18784:5e56fda13c2f |
---|---|
135 ;; | 135 ;; |
136 ;; (overlay-put mouse-drag-overlay 'face 'bold) | 136 ;; (overlay-put mouse-drag-overlay 'face 'bold) |
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. | |
154 When Mouse Sel mode is enabled, mouse selection is enhanced in various ways. | |
155 You 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. |
149 If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end | 165 If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end |
150 of the region nearest to where the mouse last was. | 166 of the region nearest to where the mouse last was. |
151 If nil, point will always be placed at the beginning of the region.") | 167 If nil, point will always be placed at the beginning of the region." |
152 | 168 :type 'boolean |
153 (defvar mouse-sel-cycle-clicks t | 169 :group 'mouse-sel) |
154 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.") | 170 |
155 | 171 (defcustom mouse-sel-cycle-clicks t |
156 (defvar mouse-sel-default-bindings t | 172 "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks." |
157 "Set to nil before loading `mouse-sel' to prevent default mouse bindings.") | 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. | |
188 With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive. | |
189 Returns the new status of Mouse Sel mode (non-nil means on). | |
190 | |
191 When 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. | |
198 Double-clicking on symbol constituents selects symbols. | |
199 Double-clicking on quotes or parentheses selects sexps. | |
200 Double-clicking on whitespace selects whitespace. | |
201 Triple-clicking selects lines. | |
202 Quad-clicking selects paragraphs. | |
203 | |
204 - Selecting sets the region & X primary selection, but does NOT affect | |
205 the kill-ring. Because the mouse handlers set the primary selection | |
206 directly, mouse-sel sets the variables interprogram-cut-function | |
207 and interprogram-paste-function to nil. | |
208 | |
209 - Clicking mouse-2 inserts the contents of the primary selection at | |
210 the mouse position (or point, if mouse-yank-at-point is non-nil). | |
211 | |
212 - Pressing mouse-2 while selecting or extending copies selection | |
213 to 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 | |
219 primary 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 |
161 (defvar mouse-sel-primary-thing nil | 281 (defvar mouse-sel-primary-thing nil |
162 "Type of PRIMARY selection in current buffer.") | 282 "Type of PRIMARY selection in current buffer.") |
165 (defvar mouse-sel-secondary-thing nil | 285 (defvar mouse-sel-secondary-thing nil |
166 "Type of SECONDARY selection in current buffer.") | 286 "Type of SECONDARY selection in current buffer.") |
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 |
174 (defconst mouse-sel-selection-alist | 294 (defconst mouse-sel-selection-alist |
175 '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) | 295 '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing) |
182 where SELECTION-NAME = name of selection | 302 where SELECTION-NAME = name of selection |
183 OVERLAY-SYMBOL = name of variable containing overlay to use | 303 OVERLAY-SYMBOL = name of variable containing overlay to use |
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. |
193 Called with two arguments: | 315 Called 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. |
197 This sets the selection as well as the cut buffer for the older applications. | 319 |
198 Use (setq mouse-sel-set-selection-function 'x-set-selection) if you don't care | 320 This sets the selection as well as the cut buffer for the older applications, |
199 for them.") | 321 unless `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. |
207 Called with one argument: | 329 Called with one argument: |
208 | 330 |
209 SELECTION: the name of the selection concerned.") | 331 SELECTION: the name of the selection concerned.") |
210 | 332 |
348 (unwind-protect | 470 (unwind-protect |
349 (setq direction (mouse-select-internal 'PRIMARY event)) | 471 (setq direction (mouse-select-internal 'PRIMARY 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 |
355 Click sets the start of the secondary selection to click position. | 477 Click sets the start of the secondary selection to click position. |
356 Dragging extends the secondary selection. | 478 Dragging extends the secondary selection. |
357 | 479 |
358 Multi-clicking selects word/lines/paragraphs, as determined by | 480 Multi-clicking selects word/lines/paragraphs, as determined by |
360 | 482 |
361 Clicking mouse-2 while selecting copies selected text to the kill-ring. | 483 Clicking mouse-2 while selecting copies selected text to the kill-ring. |
362 Clicking mouse-1 or mouse-3 kills the selected text. | 484 Clicking mouse-1 or mouse-3 kills the selected text. |
363 | 485 |
364 This should be bound to a down-mouse event." | 486 This 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) |
369 "Set SELECTION using the mouse." | 491 "Set SELECTION using the mouse." |
370 (mouse-sel-eval-at-event-end event | 492 (mouse-sel-eval-at-event-end event |
573 (mouse-insert-selection-internal 'SECONDARY event)) | 695 (mouse-insert-selection-internal 'SECONDARY event)) |
574 | 696 |
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. |
577 If `mouse-yank-at-point' is non-nil, insert at point instead." | 699 If `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 |
587 (defun mouse-sel-lost-selection-hook (selection) | 708 (defun mouse-sel-lost-selection-hook (selection) |
588 "Remove the overlay for a lost selection." | 709 "Remove the overlay for a lost selection." |
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. |