/[emacs]/emacs/lisp/emulation/viper-mous.el
ViewVC logotype

Diff of /emacs/lisp/emulation/viper-mous.el

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

revision 1.30 by kifer, Tue Jan 8 04:36:00 2002 UTC revision 1.30.4.1 by miles, Fri Apr 4 06:20:19 2003 UTC
# Line 58  Line 58 
58    
59    
60  ;;; Variables  ;;; Variables
61      
62  ;; Variable used for catching the switch-frame event.  ;; Variable used for catching the switch-frame event.
63  ;; If non-nil, indicates that previous-frame should be the selected  ;; If non-nil, indicates that previous-frame should be the selected
64  ;; one.  Used by viper-mouse-click-get-word.  Not a user option.  ;; one.  Used by viper-mouse-click-get-word.  Not a user option.
65  (defvar viper-frame-of-focus nil)  (defvar viper-frame-of-focus nil)
66        
67  ;; Frame that was selected before the switch-frame event.  ;; Frame that was selected before the switch-frame event.
68  (defconst viper-current-frame-saved (selected-frame))  (defconst viper-current-frame-saved (selected-frame))
69      
70  (defcustom viper-surrounding-word-function 'viper-surrounding-word  (defcustom viper-surrounding-word-function 'viper-surrounding-word
71    "*Function that determines what constitutes a word for clicking events.    "*Function that determines what constitutes a word for clicking events.
72  Takes two parameters: a COUNT, indicating how many words to return,  Takes two parameters: a COUNT, indicating how many words to return,
73  and CLICK-COUNT, telling whether this is the first click, a double-click,  and CLICK-COUNT, telling whether this is the first click, a double-click,
74  or a tripple-click."  or a tripple-click."
75    :type 'symbol    :type 'symbol
76    :group 'viper-mouse)    :group 'viper-mouse)
77          
78  ;; time interval in millisecond within which successive clicks are  ;; time interval in millisecond within which successive clicks are
79  ;; considered related  ;; considered related
80  (defcustom viper-multiclick-timeout (if (viper-window-display-p)  (defcustom viper-multiclick-timeout (if (viper-window-display-p)
# Line 94  considered related." Line 94  considered related."
94    
95  ;; Local variable used to toggle wraparound search on click.  ;; Local variable used to toggle wraparound search on click.
96  (viper-deflocalvar  viper-mouse-click-search-noerror t)  (viper-deflocalvar  viper-mouse-click-search-noerror t)
97            
98  ;; Local variable used to delimit search after wraparound.  ;; Local variable used to delimit search after wraparound.
99  (viper-deflocalvar  viper-mouse-click-search-limit nil)  (viper-deflocalvar  viper-mouse-click-search-limit nil)
100            
101  ;; remembers prefix argument to pass along to commands invoked by second  ;; remembers prefix argument to pass along to commands invoked by second
102  ;; click.  ;; click.
103  ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg  ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
# Line 147  considered related." Line 147  considered related."
147     (event-point click) ; xemacs     (event-point click) ; xemacs
148     (posn-point (event-start click)) ; emacs     (posn-point (event-start click)) ; emacs
149     ))     ))
150                
151    
152  (defun viper-surrounding-word (count click-count)  (defun viper-surrounding-word (count click-count)
153     "Returns word surrounding point according to a heuristic.     "Returns word surrounding point according to a heuristic.
# Line 174  is ignored." Line 174  is ignored."
174             (setq beg (point))             (setq beg (point))
175             (end-of-line)             (end-of-line)
176             (setq result (buffer-substring beg (point))))             (setq result (buffer-substring beg (point))))
177          
178         (if (and (not (viper-looking-at-alphasep))         (if (and (not (viper-looking-at-alphasep))
179                  (or (save-excursion (viper-backward-char-carefully)                  (or (save-excursion (viper-backward-char-carefully)
180                                      (viper-looking-at-alpha))                                      (viper-looking-at-alpha))
# Line 194  is ignored." Line 194  is ignored."
194                                 (t (char-to-string (following-char))))                                 (t (char-to-string (following-char))))
195                           )                           )
196                   ))                   ))
197          
198         ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp         ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
199         (or (looking-at "-")         (or (looking-at "-")
200             (not (string-match "lisp" (symbol-name major-mode)))             (not (string-match "lisp" (symbol-name major-mode)))
201             (setq modifiers (concat modifiers "C-C-")))             (setq modifiers (concat modifiers "C-C-")))
202          
203          
204         (save-excursion         (save-excursion
205           (cond ((> click-count 1) (viper-skip-nonseparators 'backward))           (cond ((> click-count 1) (viper-skip-nonseparators 'backward))
206                 ((viper-looking-at-alpha modifiers)                 ((viper-looking-at-alpha modifiers)
# Line 212  is ignored." Line 212  is ignored."
212                      (viper-skip-alpha-backward modifiers))))                      (viper-skip-alpha-backward modifiers))))
213    
214           (setq word-beg (point))           (setq word-beg (point))
215            
216           (setq skip-flag nil) ; don't move 1 char forw the first time           (setq skip-flag nil) ; don't move 1 char forw the first time
217           (while (> count 0)           (while (> count 0)
218             (if skip-flag (viper-forward-char-carefully 1))             (if skip-flag (viper-forward-char-carefully 1))
# Line 237  is ignored." Line 237  is ignored."
237  Click may be in another window.  Current window and buffer isn't changed.  Click may be in another window.  Current window and buffer isn't changed.
238  On single or double click, returns the word as determined by  On single or double click, returns the word as determined by
239  `viper-surrounding-word-function'."  `viper-surrounding-word-function'."
240        
241    (let ((click-word "")    (let ((click-word "")
242          (click-pos (viper-mouse-click-posn click))          (click-pos (viper-mouse-click-posn click))
243          (click-buf (viper-mouse-click-window-buffer click)))          (click-buf (viper-mouse-click-window-buffer click)))
244      (or (natnump count) (setq count 1))      (or (natnump count) (setq count 1))
245      (or (natnump click-count) (setq click-count 1))      (or (natnump click-count) (setq click-count 1))
246        
247      (save-excursion      (save-excursion
248        (save-window-excursion        (save-window-excursion
249          (if click-pos          (if click-pos
250              (progn              (progn
251                (set-buffer click-buf)                (set-buffer click-buf)
252            
253                (goto-char click-pos)                (goto-char click-pos)
254                (setq click-word                (setq click-word
255                      (funcall viper-surrounding-word-function count click-count)))                      (funcall viper-surrounding-word-function count click-count)))
# Line 280  See `viper-surrounding-word' for the def Line 280  See `viper-surrounding-word' for the def
280            ((and (listp arg) (integerp (car arg)))            ((and (listp arg) (integerp (car arg)))
281             (setq arg (car arg)))             (setq arg (car arg)))
282            (t (setq arg 1)))            (t (setq arg 1)))
283        
284      (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)      (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
285                   'viper-mouse-catch-frame-switch))                   'viper-mouse-catch-frame-switch))
286          () ; do nothing          () ; do nothing
# Line 309  See `viper-surrounding-word' for the def Line 309  See `viper-surrounding-word' for the def
309                     (not (viper-mouse-event-p interrupting-event)))                     (not (viper-mouse-event-p interrupting-event)))
310                (viper-set-unread-command-events interrupting-event))                (viper-set-unread-command-events interrupting-event))
311            )))))            )))))
312      
313  ;; Arg is an event.  Accepts symbols and numbers, too  ;; Arg is an event.  Accepts symbols and numbers, too
314  (defun viper-mouse-event-p (event)  (defun viper-mouse-event-p (event)
315    (if (eventp event)    (if (eventp event)
316        (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"        (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
317                      (prin1-to-string (viper-event-key event)))))                      (prin1-to-string (viper-event-key event)))))
318      
319  ;; XEmacs has no double-click events.  So, we must simulate.  ;; XEmacs has no double-click events.  So, we must simulate.
320  ;; So, we have to simulate event-click-count.  ;; So, we have to simulate event-click-count.
321  (defun viper-event-click-count (click)  (defun viper-event-click-count (click)
# Line 323  See `viper-surrounding-word' for the def Line 323  See `viper-surrounding-word' for the def
323     (viper-event-click-count-xemacs click) ; xemacs     (viper-event-click-count-xemacs click) ; xemacs
324     (event-click-count click) ; emacs     (event-click-count click) ; emacs
325     ))     ))
326        
327  ;; kind of semaphore for updating viper-current-click-count  ;; kind of semaphore for updating viper-current-click-count
328  (defvar viper-counting-clicks-p nil)  (defvar viper-counting-clicks-p nil)
329  (viper-cond-compile-for-xemacs-or-emacs  (viper-cond-compile-for-xemacs-or-emacs
# Line 346  See `viper-surrounding-word' for the def Line 346  See `viper-surrounding-word' for the def
346       ))       ))
347    nil ; emacs    nil ; emacs
348   )   )
349        
350    
351  (defun viper-mouse-click-search-word (click arg)  (defun viper-mouse-click-search-word (click arg)
352     "Find the word clicked or double-clicked on.  Word may be in another window.     "Find the word clicked or double-clicked on.  Word may be in another window.
# Line 367  this command." Line 367  this command."
367        () ; do nothing, if binding isn't right or not over text        () ; do nothing, if binding isn't right or not over text
368      (let ((previous-search-string viper-s-string)      (let ((previous-search-string viper-s-string)
369            click-word click-count)            click-word click-count)
370        
371        (if (and        (if (and
372             (viper-multiclick-p)             (viper-multiclick-p)
373             ;; This trick checks if there is a pending mouse event if so, we use             ;; This trick checks if there is a pending mouse event if so, we use
# Line 387  this command." Line 387  this command."
387          ;; uninterrupted wait          ;; uninterrupted wait
388          (setq click-count (viper-event-click-count click))          (setq click-count (viper-event-click-count click))
389          (setq click-word (viper-mouse-click-get-word click nil click-count))          (setq click-word (viper-mouse-click-get-word click nil click-count))
390            
391          (if (> click-count 1)          (if (> click-count 1)
392              (setq arg viper-global-prefix-argument              (setq arg viper-global-prefix-argument
393                    viper-global-prefix-argument nil))                    viper-global-prefix-argument nil))
394          (setq arg (or arg 1))          (setq arg (or arg 1))
395            
396          (viper-deactivate-mark)          (viper-deactivate-mark)
397          (if (or (not (string= click-word viper-s-string))          (if (or (not (string= click-word viper-s-string))
398                  (not (markerp viper-search-start-marker))                  (not (markerp viper-search-start-marker))
# Line 404  this command." Line 404  this command."
404                       viper-local-search-start-marker viper-search-start-marker                       viper-local-search-start-marker viper-search-start-marker
405                       viper-mouse-click-search-noerror t                       viper-mouse-click-search-noerror t
406                       viper-mouse-click-search-limit nil)                       viper-mouse-click-search-limit nil)
407                  
408                ;; make search string known to Viper                ;; make search string known to Viper
409                (setq viper-s-string (if viper-re-search                (setq viper-s-string (if viper-re-search
410                                         (regexp-quote click-word)                                         (regexp-quote click-word)
# Line 413  this command." Line 413  this command."
413                    (setq viper-search-history                    (setq viper-search-history
414                          (cons viper-s-string viper-search-history)))                          (cons viper-s-string viper-search-history)))
415                ))                ))
416            
417          (push-mark nil t)          (push-mark nil t)
418          (while (> arg 0)          (while (> arg 0)
419            (viper-forward-word 1)            (viper-forward-word 1)
# Line 431  this command." Line 431  this command."
431                                     (marker-buffer viper-local-search-start-marker))                                     (marker-buffer viper-local-search-start-marker))
432                                    (goto-char viper-local-search-start-marker))                                    (goto-char viper-local-search-start-marker))
433                                (viper-line-pos 'end)))                                (viper-line-pos 'end)))
434                          
435                        (goto-char (point-min))                        (goto-char (point-min))
436                        (search-forward click-word                        (search-forward click-word
437                                        viper-mouse-click-search-limit nil)))                                        viper-mouse-click-search-limit nil)))
# Line 452  this command." Line 452  this command."
452                        click-word (buffer-name (current-buffer)))                        click-word (buffer-name (current-buffer)))
453                       (setq arg 1) ;; to terminate the loop                       (setq arg 1) ;; to terminate the loop
454                       (sit-for 2))                       (sit-for 2))
455                     (setq  viper-mouse-click-search-noerror t)                     (setq  viper-mouse-click-search-noerror t)
456                     (setq  viper-mouse-click-search-limit nil)                     (setq  viper-mouse-click-search-limit nil)
457                     (if (and (markerp viper-local-search-start-marker)                     (if (and (markerp viper-local-search-start-marker)
458                              (marker-buffer viper-local-search-start-marker))                              (marker-buffer viper-local-search-start-marker))
459                         (goto-char viper-local-search-start-marker))))                         (goto-char viper-local-search-start-marker))))
460            (setq arg (1- arg)))            (setq arg (1- arg)))
461          ))))          ))))
462      
463  (defun viper-mouse-catch-frame-switch (event arg)  (defun viper-mouse-catch-frame-switch (event arg)
464    "Catch the event of switching frame.    "Catch the event of switching frame.
465  Usually is bound to a `down-mouse' event to work properly.  See sample  Usually is bound to a `down-mouse' event to work properly.  See sample
# Line 472  bindings in the Viper manual." Line 472  bindings in the Viper manual."
472        (setq viper-frame-of-focus viper-current-frame-saved))        (setq viper-frame-of-focus viper-current-frame-saved))
473    ;; make Emacs forget that it executed viper-mouse-catch-frame-switch    ;; make Emacs forget that it executed viper-mouse-catch-frame-switch
474    (setq this-command last-command))    (setq this-command last-command))
475          
476  ;; Called just before switching frames.  Saves the old selected frame.  ;; Called just before switching frames.  Saves the old selected frame.
477  ;; Sets last-command to handle-switch-frame (this is done automatically in  ;; Sets last-command to handle-switch-frame (this is done automatically in
478  ;; Emacs.  ;; Emacs.
479  ;; The semantics of switching frames is different in Emacs and XEmacs.  ;; The semantics of switching frames is different in Emacs and XEmacs.
480  ;; In Emacs, if you select-frame A while mouse is over frame B and then  ;; In Emacs, if you select-frame A while mouse is over frame B and then
481  ;; start typing, input goes to frame B, which becomes selected.  ;; start typing, input goes to frame B, which becomes selected.
# Line 575  bindings in the Viper manual." Line 575  bindings in the Viper manual."
575    (cond ((or (null viper-mouse-up-search-key-parsed)    (cond ((or (null viper-mouse-up-search-key-parsed)
576               (null viper-mouse-down-search-key-parsed))               (null viper-mouse-down-search-key-parsed))
577           nil) ; just quit           nil) ; just quit
578          ((and (null force)          ((and (null force)
579                (key-binding viper-mouse-up-search-key-parsed)                (key-binding viper-mouse-up-search-key-parsed)
580                (not (eq (key-binding viper-mouse-up-search-key-parsed)                (not (eq (key-binding viper-mouse-up-search-key-parsed)
581                         'viper-mouse-click-search-word)))                         'viper-mouse-click-search-word)))
582           (message           (message
583            "%S already bound to a mouse event.  Viper mouse-search feature disabled"            "%S already bound to a mouse event.  Viper mouse-search feature disabled"
584            viper-mouse-up-search-key-parsed))            viper-mouse-up-search-key-parsed))
585          ((and (null force)          ((and (null force)
586                (key-binding viper-mouse-down-search-key-parsed)                (key-binding viper-mouse-down-search-key-parsed)
587                (not (eq (key-binding viper-mouse-down-search-key-parsed)                (not (eq (key-binding viper-mouse-down-search-key-parsed)
588                         'viper-mouse-catch-frame-switch)))                         'viper-mouse-catch-frame-switch)))
589           (message           (message
590            "%S already bound to a mouse event.  Viper mouse-search feature disabled"            "%S already bound to a mouse event.  Viper mouse-search feature disabled"
591            viper-mouse-down-search-key-parsed))            viper-mouse-down-search-key-parsed))
592          (t          (t
593           (global-set-key viper-mouse-up-search-key-parsed           (global-set-key viper-mouse-up-search-key-parsed
594                           'viper-mouse-click-search-word)                           'viper-mouse-click-search-word)
595           (global-set-key viper-mouse-down-search-key-parsed           (global-set-key viper-mouse-down-search-key-parsed
# Line 608  bindings in the Viper manual." Line 608  bindings in the Viper manual."
608                (key-binding viper-mouse-up-insert-key-parsed)                (key-binding viper-mouse-up-insert-key-parsed)
609                (not (eq (key-binding viper-mouse-up-insert-key-parsed)                (not (eq (key-binding viper-mouse-up-insert-key-parsed)
610                         'viper-mouse-click-insert-word)))                         'viper-mouse-click-insert-word)))
611           (message           (message
612            "%S already bound to a mouse event.  Viper mouse-insert feature disabled"            "%S already bound to a mouse event.  Viper mouse-insert feature disabled"
613            viper-mouse-up-insert-key-parsed))            viper-mouse-up-insert-key-parsed))
614          ((and (null force)          ((and (null force)
# Line 618  bindings in the Viper manual." Line 618  bindings in the Viper manual."
618           (message           (message
619            "%S already bound to a mouse event.  Viper mouse-insert feature disabled"            "%S already bound to a mouse event.  Viper mouse-insert feature disabled"
620            viper-mouse-down-insert-key-parsed))            viper-mouse-down-insert-key-parsed))
621          (t          (t
622           (global-set-key viper-mouse-up-insert-key-parsed           (global-set-key viper-mouse-up-insert-key-parsed
623                           'viper-mouse-click-insert-word)                           'viper-mouse-click-insert-word)
624           (global-set-key viper-mouse-down-insert-key-parsed           (global-set-key viper-mouse-down-insert-key-parsed
# Line 666  This buffer may be different from the on Line 666  This buffer may be different from the on
666                 (integer :tag "Button"))                 (integer :tag "Button"))
667    :set 'viper-reset-mouse-insert-key    :set 'viper-reset-mouse-insert-key
668    :group 'viper-mouse)    :group 'viper-mouse)
669              
670    
671    
672  ;;; Local Variables:  ;;; Local Variables:

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

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