/[emacs]/emacs/lisp/mouse-sel.el
ViewVC logotype

Diff of /emacs/lisp/mouse-sel.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31 by sds, Tue Nov 27 15:52:52 2001 UTC revision 1.31.4.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 1  Line 1 
1  ;;; mouse-sel.el --- multi-click selection support for Emacs 19  ;;; mouse-sel.el --- multi-click selection support for Emacs 19
2    
3  ;; Copyright (C) 1993, 1994, 1995, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1993,1994,1995,2001,2002 Free Software Foundation, Inc.
4    
5  ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>  ;; Author: Mike Williams <mdub@bigfoot.com>
6  ;; Keywords: mouse  ;; Keywords: mouse
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 93  Line 93 
93  ;;  ;;
94  ;;       Mouse sets selection, and pastes from kill-ring  ;;       Mouse sets selection, and pastes from kill-ring
95  ;;         mouse-1              mouse-select  ;;         mouse-1              mouse-select
96  ;;         mouse-2              mouse-yank-at-click  ;;         mouse-2              mouse-insert-selection
97  ;;         mouse-3              mouse-extend  ;;         mouse-3              mouse-extend
98    ;;       In this mode, mouse-insert-selection just calls mouse-yank-at-click.
99  ;;  ;;
100  ;;       Selection/kill-ring interaction is retained  ;;       Selection/kill-ring interaction is retained
101  ;;         interprogram-cut-function   = x-select-text  ;;         interprogram-cut-function   = x-select-text
# Line 149  Line 150 
150    "Mouse selection enhancement."    "Mouse selection enhancement."
151    :group 'mouse)    :group 'mouse)
152    
 (defcustom mouse-sel-mode nil  
   "Toggle Mouse Sel mode.  
 When Mouse Sel mode is enabled, mouse selection is enhanced in various ways.  
 Setting this variable directly does not take effect;  
 use either \\[customize] or the function `mouse-sel-mode'."  
   :set (lambda (symbol value)  
          (mouse-sel-mode (or value 0)))  
   :initialize 'custom-initialize-default  
   :type 'boolean  
   :group 'mouse-sel  
   :require 'mouse-sel)  
   
153  (defcustom mouse-sel-leave-point-near-mouse t  (defcustom mouse-sel-leave-point-near-mouse t
154    "*Leave point near last mouse position.    "*Leave point near last mouse position.
155  If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end  If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
# Line 181  If nil, point will always be placed at t Line 170  If nil, point will always be placed at t
170                   (other :tag "default bindings" t))                   (other :tag "default bindings" t))
171    :group 'mouse-sel)    :group 'mouse-sel)
172    
173    ;;=== Key bindings ========================================================
174    
175    (defconst mouse-sel-bound-events
176      '(;; Primary selection bindings.
177        ;;
178        ;; Bind keys to `ignore' instead of unsetting them because modes may
179        ;; bind `down-mouse-1', for instance, without binding `mouse-1'.
180        ;; If we unset `mouse-1', this leads to a bitch_at_user when the
181        ;; mouse goes up because no matching binding is found for that.
182        ([mouse-1]          . ignore)
183        ([drag-mouse-1]     . ignore)
184        ([mouse-3]          . ignore)
185        ([down-mouse-1]     . mouse-select)
186        ([down-mouse-3]     . mouse-extend)
187        ([mouse-2]          . mouse-insert-selection)
188        ;; Secondary selection bindings.
189        ([M-mouse-1]        . ignore)
190        ([M-drag-mouse-1]   . ignore)
191        ([M-mouse-3]        . ignore)
192        ([M-down-mouse-1]   . mouse-select-secondary)
193        ([M-mouse-2]        . mouse-insert-secondary)
194        ([M-down-mouse-3]   . mouse-extend-secondary))
195      "An alist of events that `mouse-sel-mode' binds.")
196    
197  ;;=== User Command ========================================================  ;;=== User Command ========================================================
198    
199    (defvar mouse-sel-original-bindings nil)
200    (defvar mouse-sel-original-interprogram-cut-function nil)
201    (defvar mouse-sel-original-interprogram-paste-function nil)
202    
203  ;;;###autoload  ;;;###autoload
204  (defun mouse-sel-mode (&optional arg)  (define-minor-mode mouse-sel-mode
205    "Toggle Mouse Sel mode.    "Toggle Mouse Sel mode.
206  With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.  With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
207  Returns the new status of Mouse Sel mode (non-nil means on).  Returns the new status of Mouse Sel mode (non-nil means on).
# Line 203  Triple-clicking selects lines. Line 220  Triple-clicking selects lines.
220  Quad-clicking selects paragraphs.  Quad-clicking selects paragraphs.
221    
222  - Selecting sets the region & X primary selection, but does NOT affect  - Selecting sets the region & X primary selection, but does NOT affect
223  the kill-ring, nor do the kill-ring function change the X selection.  the `kill-ring', nor do the kill-ring functions change the X selection.
224  Because the mouse handlers set the primary selection directly,  Because the mouse handlers set the primary selection directly,
225  mouse-sel sets the variables interprogram-cut-function and  mouse-sel sets the variables `interprogram-cut-function' and
226  interprogram-paste-function to nil.  `interprogram-paste-function' to nil.
227    
228  - Clicking mouse-2 inserts the contents of the primary selection at  - Clicking mouse-2 inserts the contents of the primary selection at
229  the mouse position (or point, if `mouse-yank-at-point' is non-nil).  the mouse position (or point, if `mouse-yank-at-point' is non-nil).
# Line 219  to the kill ring.  Pressing mouse-1 or m Line 236  to the kill ring.  Pressing mouse-1 or m
236  - M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2  - M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
237  & mouse-3, but operate on the X secondary selection rather than the  & mouse-3, but operate on the X secondary selection rather than the
238  primary selection and region."  primary selection and region."
239    (interactive "P")    :global t
240    (let ((on-p (if arg    (if mouse-sel-mode
241                    (> (prefix-numeric-value arg) 0)        (progn
                 (not mouse-sel-mode))))  
     (if on-p  
242          (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)          (add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
243        (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook))          (when mouse-sel-default-bindings
244      (mouse-sel-bindings on-p)            ;; Save original bindings and replace them with new ones.
245      (setq mouse-sel-mode on-p)))            (setq mouse-sel-original-bindings
246                    (mapcar (lambda (binding)
247  ;;=== Key bindings ========================================================                            (let ((event (car binding)))
248                                (prog1 (cons event (lookup-key global-map event))
249  (defun mouse-sel-bindings (bind)                                (global-set-key event (cdr binding)))))
250    (cond ((not bind)                          mouse-sel-bound-events))
251           ;; These bindings are taken from mouse.el, i.e., they are the default            ;; Update interprogram functions.
252           ;; bindings.  It would be better to restore the previous bindings.            (setq mouse-sel-original-interprogram-cut-function
253           ;; Primary selection bindings.                  interprogram-cut-function
254           (global-set-key [mouse-1]      'mouse-set-point)                  mouse-sel-original-interprogram-paste-function
255           (global-set-key [mouse-2]      'mouse-yank-at-click)                  interprogram-paste-function)
256           (global-set-key [mouse-3]      'mouse-save-then-kill)            (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
257           (global-set-key [down-mouse-1]         'mouse-drag-region)              (setq interprogram-cut-function nil
258           (global-set-key [drag-mouse-1]         'mouse-set-region)                    interprogram-paste-function nil))))
259           (global-set-key [double-mouse-1]       'mouse-set-point)  
260           (global-set-key [triple-mouse-1]       'mouse-set-point)      ;; Restore original bindings
261           ;; Secondary selection bindings.      (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
262           (global-set-key [M-mouse-1]    'mouse-start-secondary)      (dolist (binding mouse-sel-original-bindings)
263           (global-set-key [M-mouse-2]    'mouse-yank-secondary)        (global-set-key (car binding) (cdr binding)))
264           (global-set-key [M-mouse-3]    'mouse-secondary-save-then-kill)      (setq interprogram-cut-function
265           (global-set-key [M-drag-mouse-1]       'mouse-set-secondary)            mouse-sel-original-interprogram-cut-function
266           (global-set-key [M-down-mouse-1]       'mouse-drag-secondary))            interprogram-paste-function
267          (mouse-sel-default-bindings            mouse-sel-original-interprogram-paste-function)))
          ;;  
          ;; Primary selection bindings.  
   
          ;; Bind keys to `ignore' instead of unsetting them because  
          ;; modes may bind `down-mouse-1', for instance, without  
          ;; binding other `up-mouse-1' or `mouse-1'.  If we unset  
          ;; `mouse-1', this leads to a bitch_at_user when the mouse  
          ;; goes up because no matching binding is found for that.  
          (global-set-key [mouse-1] 'ignore)  
          (global-set-key [drag-mouse-1] 'ignore)  
          (global-set-key [mouse-3] 'ignore)  
          (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-set-key [M-mouse-1] 'ignore)  
          (global-set-key [M-drag-mouse-1] 'ignore)  
          (global-set-key [M-mouse-3] 'ignore)  
          (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))  
268    
269  ;;=== Internal Variables/Constants ========================================  ;;=== Internal Variables/Constants ========================================
270    
# Line 363  multi-click semantics." Line 345  multi-click semantics."
345       ((= nclicks 3) 'line)       ((= nclicks 3) 'line)
346       ((>= nclicks 4) 'paragraph)       ((>= nclicks 4) 'paragraph)
347       ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)       ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
348       ((memq next-char '(? ?\t ?\n)) 'whitespace)       ((memq next-char '(?\s ?\t ?\n)) 'whitespace)
349       ((eq char-syntax ?_) 'symbol)       ((eq char-syntax ?_) 'symbol)
350       ((eq char-syntax ?w) 'word))))       ((eq char-syntax ?w) 'word))))
351    
# Line 688  See documentation for mouse-select-inter Line 670  See documentation for mouse-select-inter
670    
671  ;;=== Paste ===============================================================  ;;=== Paste ===============================================================
672    
673  (defun mouse-insert-selection (event)  (defun mouse-insert-selection (event arg)
674    "Insert the contents of the PRIMARY selection at mouse click.    "Insert the contents of the PRIMARY selection at mouse click.
675  If `mouse-yank-at-point' is non-nil, insert at point instead."  If `mouse-yank-at-point' is non-nil, insert at point instead."
676    (interactive "e")    (interactive "e\nP")
677    (mouse-insert-selection-internal 'PRIMARY event))    (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
678          (mouse-yank-at-click event arg)
679        (mouse-insert-selection-internal 'PRIMARY event)))
680    
681  (defun mouse-insert-secondary (event)  (defun mouse-insert-secondary (event)
682    "Insert the contents of the SECONDARY selection at mouse click.    "Insert the contents of the SECONDARY selection at mouse click.
# Line 716  If `mouse-yank-at-point' is non-nil, ins Line 700  If `mouse-yank-at-point' is non-nil, ins
700    (let ((overlay (mouse-sel-selection-overlay selection)))    (let ((overlay (mouse-sel-selection-overlay selection)))
701      (delete-overlay overlay)))      (delete-overlay overlay)))
702    
 ;;=== 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-yank-at-point)))  
   
703  (provide 'mouse-sel)  (provide 'mouse-sel)
704    
705  ;;; mouse-sel.el ends here  ;;; mouse-sel.el ends here

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.31.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26