diff options
| author | Simon Marshall | 1997-07-15 07:43:48 +0000 |
|---|---|---|
| committer | Simon Marshall | 1997-07-15 07:43:48 +0000 |
| commit | ad3f1e65bde1bc50b3d92c8126e10ebd0f410994 (patch) | |
| tree | 6139fbf91453084b4ab4467512b1c58790226eb4 | |
| parent | 92d874e6873c4366fc222ae504c4a709fe117b22 (diff) | |
| download | emacs-ad3f1e65bde1bc50b3d92c8126e10ebd0f410994.tar.gz emacs-ad3f1e65bde1bc50b3d92c8126e10ebd0f410994.zip | |
Customise. Don't install bindings on file load; use a fn.
| -rw-r--r-- | lisp/mouse-sel.el | 252 |
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. | ||
| 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." |
| 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. | ||
| 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. | ||
| 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.") | 210 | the 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.") | 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 | ||
| @@ -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. |
| 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 | ||
| @@ -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 | ||
| 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. |
| @@ -362,7 +484,7 @@ 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) |
| @@ -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. |
| 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 | ||
| @@ -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. |