/[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.30 by monnier, Tue Aug 21 18:19:55 2001 UTC revision 1.31 by sds, Tue Nov 27 15:52:52 2001 UTC
# Line 50  Line 50 
50  ;;  ;;
51  ;;   * Pressing mouse-2 while selecting or extending copies selection  ;;   * Pressing mouse-2 while selecting or extending copies selection
52  ;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.  ;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
53  ;;      ;;
54  ;;   * Double-clicking mouse-3 also kills selection.  ;;   * Double-clicking mouse-3 also kills selection.
55  ;;      ;;
56  ;;   * 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
57  ;;     & mouse-3, but operate on the X secondary selection rather than the  ;;     & mouse-3, but operate on the X secondary selection rather than the
58  ;;     primary selection and region.  ;;     primary selection and region.
# Line 71  Line 71 
71  ;;  ;;
72  ;;      ;; But only in the selected window  ;;      ;; But only in the selected window
73  ;;      (setq highlight-nonselected-windows nil)  ;;      (setq highlight-nonselected-windows nil)
74  ;;        ;;
75  ;;      ;; Enable pending-delete  ;;      ;; Enable pending-delete
76  ;;      (delete-selection-mode 1)  ;;      (delete-selection-mode 1)
77  ;;  ;;
# Line 79  Line 79 
79  ;;   of mouse-sel-default-bindings before loading mouse-sel.  ;;   of mouse-sel-default-bindings before loading mouse-sel.
80  ;;  ;;
81  ;;   (a) If mouse-sel-default-bindings = t (the default)  ;;   (a) If mouse-sel-default-bindings = t (the default)
82  ;;    ;;
83  ;;       Mouse sets and insert selection  ;;       Mouse sets and insert selection
84  ;;         mouse-1              mouse-select  ;;         mouse-1              mouse-select
85  ;;         mouse-2              mouse-insert-selection  ;;         mouse-2              mouse-insert-selection
# Line 90  Line 90 
90  ;;         interprogram-paste-function = nil  ;;         interprogram-paste-function = nil
91  ;;  ;;
92  ;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste  ;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
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-yank-at-click
97  ;;         mouse-3              mouse-extend  ;;         mouse-3              mouse-extend
98  ;;    ;;
99  ;;       Selection/kill-ring interaction is retained  ;;       Selection/kill-ring interaction is retained
100  ;;         interprogram-cut-function   = x-select-text  ;;         interprogram-cut-function   = x-select-text
101  ;;         interprogram-paste-function = x-cut-buffer-or-selection-value  ;;         interprogram-paste-function = x-cut-buffer-or-selection-value
102  ;;          ;;
103  ;;       What you lose is the ability to select some text in  ;;       What you lose is the ability to select some text in
104  ;;       delete-selection-mode and yank over the top of it.  ;;       delete-selection-mode and yank over the top of it.
105  ;;        ;;
106  ;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.  ;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
107  ;;  ;;
108  ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at  ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
# Line 286  primary selection and region." Line 286  primary selection and region."
286    
287  ;;=== Internal Variables/Constants ========================================  ;;=== Internal Variables/Constants ========================================
288    
289  (defvar mouse-sel-primary-thing nil  (defvar mouse-sel-primary-thing nil
290    "Type of PRIMARY selection in current buffer.")    "Type of PRIMARY selection in current buffer.")
291  (make-variable-buffer-local 'mouse-sel-primary-thing)  (make-variable-buffer-local 'mouse-sel-primary-thing)
292    
293  (defvar mouse-sel-secondary-thing nil  (defvar mouse-sel-secondary-thing nil
294    "Type of SECONDARY selection in current buffer.")    "Type of SECONDARY selection in current buffer.")
295  (make-variable-buffer-local 'mouse-sel-secondary-thing)  (make-variable-buffer-local 'mouse-sel-secondary-thing)
296    
# Line 311  where   SELECTION-NAME          = name o Line 311  where   SELECTION-NAME          = name o
311          OVERLAY-SYMBOL          = name of variable containing overlay to use          OVERLAY-SYMBOL          = name of variable containing overlay to use
312          SELECTION-THING-SYMBOL  = name of variable where the current selection          SELECTION-THING-SYMBOL  = name of variable where the current selection
313                                    type for this selection should be stored.")                                    type for this selection should be stored.")
314        
315  (defvar mouse-sel-set-selection-function  (defvar mouse-sel-set-selection-function
316    (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)    (if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
317        'x-set-selection        'x-set-selection
# Line 356  Feel free to re-define this function to Line 356  Feel free to re-define this function to
356  multi-click semantics."  multi-click semantics."
357    (let* ((next-char (char-after (point)))    (let* ((next-char (char-after (point)))
358           (char-syntax (if next-char (char-syntax next-char))))           (char-syntax (if next-char (char-syntax next-char))))
359      (if mouse-sel-cycle-clicks      (if mouse-sel-cycle-clicks
360          (setq nclicks (1+ (% (1- nclicks) 4))))          (setq nclicks (1+ (% (1- nclicks) 4))))
361      (cond      (cond
362       ((= nclicks 1) nil)       ((= nclicks 1) nil)
# Line 393  multi-click semantics." Line 393  multi-click semantics."
393    
394  (defun mouse-sel-region-to-primary (orig-window)  (defun mouse-sel-region-to-primary (orig-window)
395    "Convert region to PRIMARY overlay and deactivate region.    "Convert region to PRIMARY overlay and deactivate region.
396  Argument ORIG-WINDOW specifies the window the cursor was in when the  Argument ORIG-WINDOW specifies the window the cursor was in when the
397  originating command was issued, and is used to determine whether the  originating command was issued, and is used to determine whether the
398  region was visible or not."  region was visible or not."
399    (if transient-mark-mode    (if transient-mark-mode
400        (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))        (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
401          (cond          (cond
402           ((and mark-active           ((and mark-active
403                 (or highlight-nonselected-windows                 (or highlight-nonselected-windows
404                     (eq orig-window (selected-window))))                     (eq orig-window (selected-window))))
405            ;; Region was visible, so convert region to overlay            ;; Region was visible, so convert region to overlay
406            (move-overlay overlay (region-beginning) (region-end)            (move-overlay overlay (region-beginning) (region-end)
407                          (current-buffer)))                          (current-buffer)))
408           ((eq orig-window (selected-window))           ((eq orig-window (selected-window))
409            ;; Point was visible, so set overlay at point            ;; Point was visible, so set overlay at point
# Line 437  dragged right-to-left." Line 437  dragged right-to-left."
437    "Evaluate forms at mouse position.    "Evaluate forms at mouse position.
438  Move to the end position of EVENT, execute FORMS, and restore original  Move to the end position of EVENT, execute FORMS, and restore original
439  point and window."  point and window."
440      (`    `(let ((posn (event-end ,event)))
441       (let ((posn (event-end (, event))))      (if posn (mouse-minibuffer-check ,event))
442         (if posn (mouse-minibuffer-check (, event)))      (if (and posn (not (windowp (posn-window posn))))
443         (if (and posn (not (windowp (posn-window posn))))          (error "Cursor not in text area of window"))
444             (error "Cursor not in text area of window"))      (let (orig-window orig-point-marker)
445         (let (orig-window orig-point-marker)        (setq orig-window (selected-window))
446           (setq orig-window (selected-window))        (if posn (select-window (posn-window posn)))
447           (if posn (select-window (posn-window posn)))        (setq orig-point-marker (point-marker))
448           (setq orig-point-marker (point-marker))        (if (and posn (numberp (posn-point posn)))
449           (if (and posn (numberp (posn-point posn)))            (goto-char (posn-point posn)))
450               (goto-char (posn-point posn)))        (unwind-protect
451           (unwind-protect             (progn
452               (progn               ,@forms)
453                 (,@ forms))          (goto-char (marker-position orig-point-marker))
454             (goto-char (marker-position orig-point-marker))          (move-marker orig-point-marker nil)
455             (move-marker orig-point-marker nil)          (select-window orig-window)))))
            (select-window orig-window)  
            )))))  
456    
457  (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)  (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
458    
# Line 466  point and window." Line 464  point and window."
464  Click sets point & mark to click position.  Click sets point & mark to click position.
465  Dragging extends region/selection.  Dragging extends region/selection.
466    
467  Multi-clicking selects word/lines/paragraphs, as determined by  Multi-clicking selects word/lines/paragraphs, as determined by
468  'mouse-sel-determine-selection-thing.  'mouse-sel-determine-selection-thing.
469    
470  Clicking mouse-2 while selecting copies selected text to the kill-ring.  Clicking mouse-2 while selecting copies selected text to the kill-ring.
# Line 485  This should be bound to a down-mouse eve Line 483  This should be bound to a down-mouse eve
483  Click sets the start of the secondary selection to click position.  Click sets the start of the secondary selection to click position.
484  Dragging extends the secondary selection.  Dragging extends the secondary selection.
485    
486  Multi-clicking selects word/lines/paragraphs, as determined by  Multi-clicking selects word/lines/paragraphs, as determined by
487  'mouse-sel-determine-selection-thing.  'mouse-sel-determine-selection-thing.
488    
489  Clicking mouse-2 while selecting copies selected text to the kill-ring.  Clicking mouse-2 while selecting copies selected text to the kill-ring.
# Line 535  This should be bound to a down-mouse eve Line 533  This should be bound to a down-mouse eve
533  (defun mouse-extend-internal (selection &optional initial-event)  (defun mouse-extend-internal (selection &optional initial-event)
534    "Extend specified SELECTION using the mouse.    "Extend specified SELECTION using the mouse.
535  Track mouse-motion events, adjusting the SELECTION appropriately.  Track mouse-motion events, adjusting the SELECTION appropriately.
536  Optional argument INITIAL-EVENT specifies an initial down-mouse event to  Optional argument INITIAL-EVENT specifies an initial down-mouse event to
537  process.  process.
538    
539  See documentation for mouse-select-internal for more details."  See documentation for mouse-select-internal for more details."
540    (mouse-sel-eval-at-event-end initial-event    (mouse-sel-eval-at-event-end initial-event
541      (let ((orig-cursor-type      (let ((orig-cursor-type
542             (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))             (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
543        (unwind-protect        (unwind-protect
544    
# Line 563  See documentation for mouse-select-inter Line 561  See documentation for mouse-select-inter
561                (setq min (point)                (setq min (point)
562                      max min)                      max min)
563                (set thing-symbol nil))                (set thing-symbol nil))
564                        
565    
566              ;; Bar cursor              ;; Bar cursor
567              (if (fboundp 'modify-frame-parameters)              (if (fboundp 'modify-frame-parameters)
568                  (modify-frame-parameters (selected-frame)                  (modify-frame-parameters (selected-frame)
569                                           '((cursor-type . bar))))                                           '((cursor-type . bar))))
570                
571              ;; Handle dragging              ;; Handle dragging
572              (track-mouse              (track-mouse
573                
574                (while (if initial-event  ; Use initial event                (while (if initial-event  ; Use initial event
575                           (prog1                           (prog1
576                               (setq event initial-event)                               (setq event initial-event)
# Line 580  See documentation for mouse-select-inter Line 578  See documentation for mouse-select-inter
578                         (setq event (read-event))                         (setq event (read-event))
579                         (and (consp event)                         (and (consp event)
580                              (memq (car event) '(mouse-movement switch-frame))))                              (memq (car event) '(mouse-movement switch-frame))))
581                    
582                  (let ((selection-thing (symbol-value thing-symbol))                  (let ((selection-thing (symbol-value thing-symbol))
583                        (end (event-end event)))                        (end (event-end event)))
584                    
585                    (cond                    (cond
586                        
587                     ;; Ignore any movement outside the frame                     ;; Ignore any movement outside the frame
588                     ((eq (car-safe event) 'switch-frame) nil)                     ((eq (car-safe event) 'switch-frame) nil)
589                     ((and (posn-window end)                     ((and (posn-window end)
# Line 594  See documentation for mouse-select-inter Line 592  See documentation for mouse-select-inter
592                                          (window-frame posn-w)                                          (window-frame posn-w)
593                                        posn-w))                                        posn-w))
594                                    (window-frame orig-window)))) nil)                                    (window-frame orig-window)))) nil)
595                        
596                     ;; Different window, same frame                     ;; Different window, same frame
597                     ((not (eq (posn-window end) orig-window))                     ((not (eq (posn-window end) orig-window))
598                      (let ((end-row (cdr (cdr (mouse-position)))))                      (let ((end-row (cdr (cdr (mouse-position)))))
# Line 606  See documentation for mouse-select-inter Line 604  See documentation for mouse-select-inter
604                          (mouse-scroll-subr orig-window (1+ (- end-row bottom))                          (mouse-scroll-subr orig-window (1+ (- end-row bottom))
605                                             overlay min))                                             overlay min))
606                         )))                         )))
607                      
608                     ;; On the mode line                     ;; On the mode line
609                     ((eq (posn-point end) 'mode-line)                     ((eq (posn-point end) 'mode-line)
610                      (mouse-scroll-subr orig-window 1 overlay min))                      (mouse-scroll-subr orig-window 1 overlay min))
611                      
612                     ;; In original window                     ;; In original window
613                     (t (goto-char (posn-point end)))                     (t (goto-char (posn-point end)))
614                      
615                     )                     )
616                      
617                    ;; Determine direction of drag                    ;; Determine direction of drag
618                    (cond                    (cond
619                     ((and (not direction) (not (eq min max)))                     ((and (not direction) (not (eq min max)))
# Line 624  See documentation for mouse-select-inter Line 622  See documentation for mouse-select-inter
622                      (setq direction -1))                      (setq direction -1))
623                     ((and (not (eq direction 1)) (>= (point) max))                     ((and (not (eq direction 1)) (>= (point) max))
624                      (setq direction 1)))                      (setq direction 1)))
625                      
626                    (if (not selection-thing) nil                    (if (not selection-thing) nil
627                        
628                      ;; If dragging forward, goal is next character                      ;; If dragging forward, goal is next character
629                      (if (and (eq direction 1) (not (eobp))) (forward-char 1))                      (if (and (eq direction 1) (not (eobp))) (forward-char 1))
630                        
631                      ;; Move to start/end of selected thing                      ;; Move to start/end of selected thing
632                      (let ((goal (point)))                      (let ((goal (point)))
633                        (goto-char (if (eq 1 direction) min max))                        (goto-char (if (eq 1 direction) min max))
# Line 643  See documentation for mouse-select-inter Line 641  See documentation for mouse-select-inter
641                                 (if (> (* direction (- goal (point))) 0)                                 (if (> (* direction (- goal (point))) 0)
642                                     end (point)))))                                     end (point)))))
643                          (error))))                          (error))))
644                      
645                    ;; Move overlay                    ;; Move overlay
646                    (move-overlay overlay                    (move-overlay overlay
647                                  (if (eq 1 direction) min (point))                                  (if (eq 1 direction) min (point))
648                                  (if (eq -1 direction) max (point))                                  (if (eq -1 direction) max (point))
649                                  (current-buffer))                                  (current-buffer))
650                      
651                    )))                   ; end track-mouse                    )))                   ; end track-mouse
652    
653              ;; Finish up after dragging              ;; Finish up after dragging
654              (let ((overlay-start (overlay-start overlay))              (let ((overlay-start (overlay-start overlay))
655                    (overlay-end (overlay-end overlay)))                    (overlay-end (overlay-end overlay)))
656                  
657                ;; Set selection                ;; Set selection
658                (if (not (eq overlay-start overlay-end))                (if (not (eq overlay-start overlay-end))
659                    (mouse-sel-set-selection                    (mouse-sel-set-selection
660                     selection                     selection
661                     (buffer-substring overlay-start overlay-end)))                     (buffer-substring overlay-start overlay-end)))
662                  
663                ;; Handle copy/kill                ;; Handle copy/kill
664                (let (this-command)                (let (this-command)
665                  (cond                  (cond
# Line 683  See documentation for mouse-select-inter Line 681  See documentation for mouse-select-inter
681    
682          ;; Restore cursor          ;; Restore cursor
683          (if (fboundp 'modify-frame-parameters)          (if (fboundp 'modify-frame-parameters)
684              (modify-frame-parameters              (modify-frame-parameters
685               (selected-frame) (list (cons 'cursor-type orig-cursor-type))))               (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
686            
687          ))))          ))))
688    
689  ;;=== Paste ===============================================================  ;;=== Paste ===============================================================
# Line 705  If `mouse-yank-at-point' is non-nil, ins Line 703  If `mouse-yank-at-point' is non-nil, ins
703  (defun mouse-insert-selection-internal (selection event)  (defun mouse-insert-selection-internal (selection event)
704    "Insert the contents of the named SELECTION at mouse click.    "Insert the contents of the named SELECTION at mouse click.
705  If `mouse-yank-at-point' is non-nil, insert at point instead."  If `mouse-yank-at-point' is non-nil, insert at point instead."
706    (unless mouse-yank-at-point    (unless mouse-yank-at-point
707      (mouse-set-point event))      (mouse-set-point event))
708    (when mouse-sel-get-selection-function    (when mouse-sel-get-selection-function
709      (push-mark (point) 'nomsg)      (push-mark (point) 'nomsg)

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

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