From: Nick Roberts <nickrob@snap.net.nz>
Subject: [PATCH] xt-mouse.el
Date: Sun, 9 Jan 2005 19:42:03 +1300 [thread overview]
Message-ID: <16864.53819.330845.617109@farnswood.snap.net.nz> (raw)
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
next reply other threads:[~2005-01-09 6:42 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2005-01-09 6:42 Nick Roberts [this message]
2005-01-09 23:52 ` [PATCH] xt-mouse.el Richard Stallman
2005-01-10 8:17 ` Nick Roberts
2005-01-10 20:28 ` Richard Stallman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=16864.53819.330845.617109@farnswood.snap.net.nz \
--to=nickrob@snap.net.nz \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).