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

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

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

revision 1.21 by nickrob, Thu Dec 9 23:05:36 2004 UTC revision 1.22 by nickrob, Wed Jan 12 06:13:08 2005 UTC
# Line 43  Line 43 
43    
44  ;; Support multi-click -- somehow.  ;; Support multi-click -- somehow.
45    
 ;; Clicking on the mode-line does not work, although it should.  
   
46  ;;; Code:  ;;; Code:
47    
48  (define-key function-key-map "\e[M" 'xterm-mouse-translate)  (define-key function-key-map "\e[M" 'xterm-mouse-translate)
49    
50  (defvar xterm-mouse-last)  (defvar xterm-mouse-last)
51    
52    ;; Mouse events symbols must have an 'event-kind property with
53    ;; the value 'mouse-click.
54    (dolist (event-type '(mouse-1 mouse-2 mouse-3))
55      (put event-type 'event-kind 'mouse-click))
56    
57  (defun xterm-mouse-translate (event)  (defun xterm-mouse-translate (event)
58    "Read a click and release event from XTerm."    "Read a click and release event from XTerm."
59    (save-excursion    (save-excursion
# Line 78  Line 81 
81                 (click-where (nth 1 click-data)))                 (click-where (nth 1 click-data)))
82            (if (memq down-binding '(nil ignore))            (if (memq down-binding '(nil ignore))
83                (if (and (symbolp click-where)                (if (and (symbolp click-where)
84                         (not (eq 'menu-bar click-where)))                         (consp click-where))
85                    (vector (list click-where click-data) click)                    (vector (list click-where click-data) click)
86                  (vector click))                  (vector click))
87              (setq unread-command-events              (setq unread-command-events
# Line 92  Line 95 
95                           0                           0
96                         (list (intern (format "drag-mouse-%d"                         (list (intern (format "drag-mouse-%d"
97                                               (+ 1 xterm-mouse-last)))                                               (+ 1 xterm-mouse-last)))
98                               down-data click-data))                               down-data click-data)))))
                      )))  
99              (if (and (symbolp down-where)              (if (and (symbolp down-where)
100                       (not (eq 'menu-bar down-where)))                       (consp down-where))
101                  (vector (list down-where down-data) down)                  (vector (list down-where down-data) down)
102                (vector down))))))))                (vector down))))))))
103    
# Line 124  Line 126 
126    (let* ((type (- (xterm-mouse-event-read) #o40))    (let* ((type (- (xterm-mouse-event-read) #o40))
127           (x (- (xterm-mouse-event-read) #o40 1))           (x (- (xterm-mouse-event-read) #o40 1))
128           (y (- (xterm-mouse-event-read) #o40 1))           (y (- (xterm-mouse-event-read) #o40 1))
          (point (cons x y))  
          (window (window-at x y))  
          (where (if window  
                     (coordinates-in-window-p point window)  
                   'menu-bar))  
          (pos (if (consp where)  
                   (progn  
                     (select-window window)  
                     (goto-char (window-start window))  
                     (move-to-window-line (-  
                                           (cdr where)  
                                           (if (or header-line-format  
                                                   default-header-line-format)  
                                               1  
                                             0)))  
                     (move-to-column (- (+ (car where) (current-column)  
                                        (if (string-match "\\` \\*Minibuf"  
                                                          (buffer-name))  
                                            (- (minibuffer-prompt-width))  
                                          0)  
                                        (max 0 (1- (window-hscroll))))  
                                        left-margin-width))  
                     (point))  
                 where))  
129           (mouse (intern           (mouse (intern
130                   ;; For buttons > 3, the release-event looks                   ;; For buttons > 3, the release-event looks
131                   ;; differently (see xc/programs/xterm/button.c,                   ;; differently (see xc/programs/xterm/button.c,
# Line 159  Line 137 
137                          (format "mouse-%d" (+ 1 xterm-mouse-last)))                          (format "mouse-%d" (+ 1 xterm-mouse-last)))
138                         (t                         (t
139                          (setq xterm-mouse-last type)                          (setq xterm-mouse-last type)
140                          (format "down-mouse-%d" (+ 1 type)))))))                          (format "down-mouse-%d" (+ 1 type))))))
141             (w (window-at x y)))
142      (setq xterm-mouse-x x      (setq xterm-mouse-x x
143            xterm-mouse-y y)            xterm-mouse-y y)
144      (list mouse      (if w
145            (list window pos point          (list mouse (posn-at-x-y x (if menu-bar-mode (- y 1) y) w))
146                  (/ (nth 2 (current-time)) 1000)))))        (list mouse
147                (append (list nil 'menu-bar)
148                        (nthcdr 2 (posn-at-x-y
149                                   x (if menu-bar-mode (- y 1) y) w)))))))
150    
151  ;;;###autoload  ;;;###autoload
152  (define-minor-mode xterm-mouse-mode  (define-minor-mode xterm-mouse-mode

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

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