[PATCH] xt-mouse.el

[PATCH] xt-mouse.el

[Nick Roberts]

Here's a patch that makes clicking on the mode-line (and header-line) position
dependent when using Emacs in an xterm. Please note that it contains some code
from t-mouse.el (a powerset generator). The two modes have some natural
overlap and I see that there has been some interaction between the two modes
in the past, as Per Abrahamsen, author of xt-mouse.el is credited with some
functions in t-mouse.el.

Note to RMS: I have no way of determining the authorship of t-mouse.el other
than reading the file header, so I am hoping that Alessandro Rubini will
follow that up.

Nick


*** /home/nick/emacs/lisp/xt-mouse.el.~1.21.~	2004-12-09 21:22:18.000000000 +1300
--- /home/nick/emacs/lisp/xt-mouse.el	2005-01-09 19:38:35.000000000 +1300
***************
*** 43,56 ****
  
  ;; Support multi-click -- somehow.
  
- ;; Clicking on the mode-line does not work, although it should.
- 
  ;;; Code:
  
  (define-key function-key-map "\e[M" 'xterm-mouse-translate)
  
  (defvar xterm-mouse-last)
  
  (defun xterm-mouse-translate (event)
    "Read a click and release event from XTerm."
    (save-excursion
--- 43,93 ----
  
  ;; Support multi-click -- somehow.
  
  ;;; Code:
  
  (define-key function-key-map "\e[M" 'xterm-mouse-translate)
  
  (defvar xterm-mouse-last)
  
+ ;;; begin LIFTED FROM t-mouse.el
+ ;; now get this:  the Emacs C code that generates these fake events
+ ;; depends on certain things done by the very lowest level input
+ ;; handlers; namely the symbols for the events (for instance
+ ;; 'C-S-double-mouse-2) must have an 'event-kind property, set to
+ ;; 'mouse-click.  Since events from unread-command-events do not pass
+ ;; through the low level handlers, they don't get this property unless
+ ;; I set it myself.  I imagine this has caused innumerable attempts by
+ ;; hackers to do things similar to t-mouse to lose.
+ 
+ ;; The next page of code is devoted to fixing this ugly problem.
+ 
+ ;; WOW! a fully general powerset generator
+ ;; (C) Ian Zimmerman Mon Mar 23 12:00:16 PST 1998 :-)
+ (defun t-mouse-powerset (l)
+   (if (null l) '(nil)
+     (let ((l1 (t-mouse-powerset (cdr l)))
+           (first (nth 0 l)))
+       (append
+        (mapcar (function (lambda (l) (cons first l))) l1) l1))))
+ 
+ ;; and a slightly less general cartesian product
+ (defun t-mouse-cartesian (l1 l2)
+   (if (null l1) l2
+     (append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2)
+             (t-mouse-cartesian (cdr l1) l2))))
+       
+ (let* ((modifier-sets (t-mouse-powerset '(control meta shift)))
+        (typed-sets (t-mouse-cartesian '((down) (drag))
+                                       '((mouse-1) (mouse-2) (mouse-3))))
+        (multipled-sets (t-mouse-cartesian '((double) (triple)) typed-sets))
+        (all-sets (t-mouse-cartesian modifier-sets multipled-sets)))
+   (while all-sets
+     (let ((event-sym (event-convert-list (nth 0 all-sets))))
+       (if (not (get event-sym 'event-kind))
+           (put event-sym 'event-kind 'mouse-click)))
+     (setq all-sets (cdr all-sets))))
+ ;;; end LIFTED FROM t-mouse.el
+ 
  (defun xterm-mouse-translate (event)
    "Read a click and release event from XTerm."
    (save-excursion
***************
*** 78,84 ****
  	       (click-where (nth 1 click-data)))
  	  (if (memq down-binding '(nil ignore))
  	      (if (and (symbolp click-where)
! 		       (not (eq 'menu-bar click-where)))
  		  (vector (list click-where click-data) click)
  		(vector click))
  	    (setq unread-command-events
--- 115,121 ----
  	       (click-where (nth 1 click-data)))
  	  (if (memq down-binding '(nil ignore))
  	      (if (and (symbolp click-where)
! 		       (consp click-where))
  		  (vector (list click-where click-data) click)
  		(vector click))
  	    (setq unread-command-events
***************
*** 92,101 ****
  			 0
  		       (list (intern (format "drag-mouse-%d"
  					     (+ 1 xterm-mouse-last)))
! 			     down-data click-data))
! 		     )))
  	    (if (and (symbolp down-where)
! 		     (not (eq 'menu-bar down-where)))
  		(vector (list down-where down-data) down)
  	      (vector down))))))))
  
--- 129,137 ----
  			 0
  		       (list (intern (format "drag-mouse-%d"
  					     (+ 1 xterm-mouse-last)))
! 			     down-data click-data)))))
  	    (if (and (symbolp down-where)
! 		     (consp down-where))
  		(vector (list down-where down-data) down)
  	      (vector down))))))))
  
***************
*** 124,153 ****
    (let* ((type (- (xterm-mouse-event-read) #o40))
  	 (x (- (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))
  	 (mouse (intern
  		 ;; For buttons > 3, the release-event looks
  		 ;; differently (see xc/programs/xterm/button.c,
--- 160,165 ----
***************
*** 159,170 ****
  			(format "mouse-%d" (+ 1 xterm-mouse-last)))
  		       (t
  			(setq xterm-mouse-last type)
! 			(format "down-mouse-%d" (+ 1 type)))))))
      (setq xterm-mouse-x x
  	  xterm-mouse-y y)
!     (list mouse
! 	  (list window pos point
! 		(/ (nth 2 (current-time)) 1000)))))
  
  ;;;###autoload
  (define-minor-mode xterm-mouse-mode
--- 171,212 ----
  			(format "mouse-%d" (+ 1 xterm-mouse-last)))
  		       (t
  			(setq xterm-mouse-last type)
! 			(format "down-mouse-%d" (+ 1 type))))))
! 	 (w (window-at x y))
!          (left-top-right-bottom (window-edges w))
!          (left (nth 0 left-top-right-bottom))
!          (top (nth 1 left-top-right-bottom))
!          (right (nth 2 left-top-right-bottom))
!          (bottom (nth 3 left-top-right-bottom))
! 	 (coords-or-part (if w (coordinates-in-window-p (cons x y) w) nil))
! 	 (timestamp (/ (nth 2 (current-time)) 1000)))
      (setq xterm-mouse-x x
  	  xterm-mouse-y y)
!     (cond
!      ((consp coords-or-part)
!       (let ((wx (car coords-or-part)) (wy (cdr coords-or-part)))
! 	(select-window w)
! 	(goto-char (window-start w))
! 	(move-to-window-line (- wy (if (or header-line-format
! 					   default-header-line-format) 1 0)))
! 	(move-to-column (- (+ wx (current-column)
! 			      (if (string-match "\\` \\*Minibuf" (buffer-name))
! 				  (- (minibuffer-prompt-width)) 0)
! 			      (max 0 (1- (window-hscroll))))
! 			   left-margin-width))
! 	(list mouse (list w (point) coords-or-part timestamp))))
!       ((eq coords-or-part 'mode-line)
!        (list mouse (list w 'mode-line (cons (- x left) 0) timestamp 
! 			 (cons (format-mode-line mode-line-format)
! 			       (- x left)))))
!       ((eq coords-or-part 'header-line)
!        (list mouse (list w 'header-line (cons (- x left) 0) timestamp
! 			 (cons (format-mode-line header-line-format)
! 			       (- x left)))))
!       ((eq coords-or-part nil)
!        (list mouse (list w 'menu-bar (cons (- x left) 0) timestamp)))
!       ((eq coords-or-part 'vertical-line)
!        (list mouse (list w 'vertical-line (cons 0 (- y top)) timestamp))))))
  
  ;;;###autoload
  (define-minor-mode xterm-mouse-mode

Re: [PATCH] xt-mouse.el

[Richard Stallman]

We can't install this under present circumstances.
We would need to know who wrote that code, or else finish getting
papers for t-mouse.el and install it.

Re: [PATCH] xt-mouse.el

[Nick Roberts]

 > We can't install this under present circumstances.
 > We would need to know who wrote that code, or else finish getting
 > papers for t-mouse.el and install it.

I am now trying to contact Ian Zimmerman. If that fails, xt-mouse.el only uses
20 lines of code from t-mouse.el, so that could be rewritten presumably. I can
now set and clear breakpoints in the margin using the mouse, both from a text
terminal and an xterm. So I would really like to include this, if possible.

Nick

Re: [PATCH] xt-mouse.el

[Richard Stallman]

    I am now trying to contact Ian Zimmerman. If that fails, xt-mouse.el only uses
    20 lines of code from t-mouse.el, so that could be rewritten presumably.

Yes.