/[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.34 by mdub, Mon Jul 15 11:48:44 2002 UTC revision 1.35 by monnier, Tue Jul 16 13:27:05 2002 UTC
# 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-cut-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                                  (global-set-key event (cdr binding)))))
250                            mouse-sel-bound-events))
251              ;; Update interprogram functions.
252              (setq mouse-sel-original-interprogram-cut-function
253                    interprogram-cut-function
254                    mouse-sel-original-interprogram-paste-function
255                    interprogram-paste-function)
256              (unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
257                (setq interprogram-cut-function nil
258                      interprogram-paste-function nil))))
259    
 (defconst mouse-sel-bound-events  
   '([down-mouse-1] [mouse-1] [drag-mouse-1]  
     [mouse-2]  
     [down-mouse-3] [mouse-3]  
     [M-mouse-2]  
     [M-down-mouse-1] [M-mouse-1] [M-drag-mouse-1]  
     [M-down-mouse-3] [M-mouse-3])  
   "A list of events that mouse-sel binds.")  
   
 (defun mouse-sel-bindings (bind)  
   (cond  
   
    ;; Default mouse-sel bindings  
    ((and bind mouse-sel-default-bindings)  
   
     ;; Save original bindings  
     (setq mouse-sel-original-bindings nil)  
     (mapc (function  
            (lambda (event)  
              (setq mouse-sel-original-bindings  
                    (cons (cons event (lookup-key global-map event))  
                          mouse-sel-original-bindings))))  
           mouse-sel-bound-events)  
     (setq mouse-sel-original-interprogram-cut-function  
           interprogram-cut-function  
           mouse-sel-original-interprogram-paste-function  
           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))  
     
    ((not bind)  
260      ;; Restore original bindings      ;; Restore original bindings
261      (mapc (function      (remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
262             (lambda (binding)      (dolist (binding mouse-sel-original-bindings)
263               (if (cdr binding)        (global-set-key (car binding) (cdr binding)))
264                   (global-set-key (car binding) (cdr binding))      (setq interprogram-cut-function
                (global-unset-key (car binding)))))  
           mouse-sel-original-bindings)  
     (setq interprogram-cut-function  
265            mouse-sel-original-interprogram-cut-function            mouse-sel-original-interprogram-cut-function
266            interprogram-paste-function            interprogram-paste-function
267            mouse-sel-original-interprogram-paste-function))            mouse-sel-original-interprogram-paste-function)))
     
    ))  
   
 ;;=== 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 711  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.

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

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