Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
emacs
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
emacs
emacs
Commits
20d385d6
Commit
20d385d6
authored
May 20, 2007
by
Nick Roberts
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Reduce to a minor-mode macro call.
parent
a7c03edb
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
15 additions
and
261 deletions
+15
-261
lisp/t-mouse.el
lisp/t-mouse.el
+15
-261
No files found.
lisp/t-mouse.el
View file @
20d385d6
;;; t-mouse.el --- mouse support within the text terminal
;; Author
s: Alessandro Rubini and Ian T Zimmerman
;; Maintainer:
Nick Roberts <nickrob@gnu.org>
;; Author
: Nick Roberts <nickrob@gnu.org>
;; Maintainer:
FSF
;; Keywords: mouse gpm linux
;; Copyright (C) 1994, 1995, 1998, 2006, 2007 Free Software Foundation, Inc.
...
...
@@ -25,249 +25,20 @@
;;; Commentary:
;; This package provides access to mouse event as reported by the
;; gpm-Linux package. It uses the program "mev" to get mouse events.
;; It tries to reproduce the functionality offered by Emacs under X.
;; This package provides access to mouse event as reported by the gpm-Linux
;; package. It tries to reproduce the functionality offered by Emacs under X.
;; The "gpm" server runs under Linux, so this package is rather
;; Linux-dependent.
;; Modified by Nick Roberts for Emacs 22. In particular, the mode-line is
;; now position sensitive.
(
defvar
t-mouse-process
nil
"Embeds the process which passes mouse events to Emacs.
It is used by the program t-mouse."
)
(
defvar
t-mouse-filter-accumulator
""
"Accumulates input from the mouse reporting process."
)
(
defvar
t-mouse-debug-buffer
nil
"Events normally posted to command queue are printed here in debug mode.
See `t-mouse-start-debug'."
)
(
defvar
t-mouse-current-xy
'
(
0
.
0
)
"Stores the last mouse position t-mouse has been told about."
)
(
defvar
t-mouse-drag-start
nil
"Whenever a drag starts in a special part of a window
\(not the text), the `translated' starting coordinates including the
window and part involved are saved here. This is necessary lest they
get re-translated when the button goes up, at which time window
configuration may have changed."
)
(
defvar
t-mouse-prev-set-selection-function
'x-set-selection
)
(
defvar
t-mouse-prev-get-selection-function
'x-get-selection
)
(
defvar
t-mouse-swap-alt-keys
nil
"When set, Emacs will handle mouse events with the right Alt
\(a.k.a. Alt-Ger) modifier, not with the regular left Alt modifier.
Useful for people who play strange games with their keyboard tables."
)
(
defvar
t-mouse-fix-21
nil
"Enable brain-dead chords for 2 button mice."
)
;; The file, t-mouse was originally written by Alessandro Rubini and Ian T
;; Zimmerman and communicated with Emacs through the client program mev. Now
;; the interface with gpm is directly through a Unix socket, so this file is
;; reduced to a minor mode macro call.
;;
;;; Code:
;; get the number of the current virtual console
(
defun
t-mouse-tty
()
"Return number of virtual terminal Emacs is running on, as a string.
For example, \"2\" for /dev/tty2."
(
with-temp-buffer
(
call-process
"ps"
nil
t
nil
"h"
(
format
"%s"
(
emacs-pid
)))
(
goto-char
(
point-min
))
(
if
(
or
;; Many versions of "ps", all different....
(
re-search-forward
" +tty\\(.?[0-9a-f]\\)"
nil
t
)
(
re-search-forward
"p \\([0-9a-f]\\)"
nil
t
)
(
re-search-forward
"v0\\([0-9a-f]\\)"
nil
t
)
(
re-search-forward
"[0-9]+ +\\([0-9]+\\)"
nil
t
)
(
re-search-forward
"[\\t ]*[0-9]+[\\t ]+\\([0-9]+\\)"
nil
t
)
(
re-search-forward
" +vc/\\(.?[0-9a-f]\\)"
nil
t
)
(
re-search-forward
" +pts/\\(.?[0-9a-f]\\)"
nil
t
))
(
buffer-substring
(
match-beginning
1
)
(
match-end
1
)))))
;; due to a horrible kludge in Emacs' keymap handler
;; (read_key_sequence) mouse clicks on funny parts of windows generate
;; TWO events, the first being a dummy of the sort '(mode-line).
;; That's why Per Abrahamsen's code in xt-mouse.el doesn't work for
;; the modeline, for instance.
;; 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
))))
(
defun
t-mouse-make-event-element
(
x-dot-y-avec-time
)
(
let*
((
x-dot-y
(
nth
0
x-dot-y-avec-time
))
(
time
(
nth
1
x-dot-y-avec-time
))
(
x
(
car
x-dot-y
))
(
y
(
cdr
x-dot-y
))
(
w
(
window-at
x
y
))
(
ltrb
(
window-edges
w
))
(
left
(
nth
0
ltrb
))
(
top
(
nth
1
ltrb
))
(
event
(
if
w
(
posn-at-x-y
(
-
x
left
)
(
-
y
top
)
w
t
)
(
append
(
list
nil
'menu-bar
)
(
nthcdr
2
(
posn-at-x-y
x
y
))))))
(
setcar
(
nthcdr
3
event
)
time
)
event
))
;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
(
defun
t-mouse-make-event
()
"Make a Lisp style event from the contents of mouse input accumulator.
Also trim the accumulator by all the data used to build the event."
(
let
(
ob
(
ob-pos
(
condition-case
nil
(
progn
;; this test is just needed for Fedora Core 3
(
if
(
string-match
"STILL RUNNING_1\n"
t-mouse-filter-accumulator
)
(
setq
t-mouse-filter-accumulator
(
substring
t-mouse-filter-accumulator
(
match-end
0
))))
(
read-from-string
t-mouse-filter-accumulator
))
(
error
nil
))))
;; this test is just needed for Fedora Core 3
(
if
(
or
(
eq
(
car
ob-pos
)
'STILL
)
(
eq
(
car
ob-pos
)
'***
)
(
not
ob-pos
))
nil
(
setq
ob
(
car
ob-pos
))
(
if
(
string-match
"mev:$"
(
prin1-to-string
ob
))
(
error
"Can't open mouse connection"
))
(
setq
t-mouse-filter-accumulator
(
substring
t-mouse-filter-accumulator
(
cdr
ob-pos
)))
;;now the real work
(
let
((
event-type
(
nth
0
ob
))
(
current-xy-avec-time
(
nth
1
ob
))
(
type-switch
(
length
ob
)))
(
if
t-mouse-fix-21
(
let
;;Acquire the event's symbol's name.
((
event-name-string
(
symbol-name
event-type
))
end-of-root-event-name
new-event-name-string
)
(
if
(
string-match
"-\\(21\\|\\12\\)$"
event-name-string
)
;;Transform the name to what it should have been.
(
progn
(
setq
end-of-root-event-name
(
match-beginning
0
))
(
setq
new-event-name-string
(
concat
(
substring
event-name-string
0
end-of-root-event-name
)
"-3"
))
;;Change the event to the symbol that corresponds to the
;;name we made. The proper symbol already exists.
(
setq
event-type
(
intern
new-event-name-string
))))))
;;store current position for mouse-position
(
setq
t-mouse-current-xy
(
nth
0
current-xy-avec-time
))
;;events have many types but fortunately they differ in length
(
cond
((
=
type-switch
4
)
;must be drag
(
let
((
count
(
nth
2
ob
))
(
start-element
(
or
t-mouse-drag-start
(
t-mouse-make-event-element
(
nth
3
ob
))))
(
end-element
(
t-mouse-make-event-element
current-xy-avec-time
)))
(
setq
t-mouse-drag-start
nil
)
(
list
event-type
start-element
end-element
count
)))
((
=
type-switch
3
)
;down or up
(
let
((
count
(
nth
2
ob
))
(
element
(
t-mouse-make-event-element
current-xy-avec-time
)))
(
if
(
and
(
not
t-mouse-drag-start
)
(
symbolp
(
nth
1
element
)))
;; OUCH! GOTCHA! emacs uses setc[ad]r on these!
(
setq
t-mouse-drag-start
(
copy-sequence
element
))
(
setq
t-mouse-drag-start
nil
))
(
list
event-type
element
count
)))
((
=
type-switch
2
)
;movement
(
list
(
if
(
eq
'vertical-scroll-bar
(
nth
1
t-mouse-drag-start
))
'scroll-bar-movement
'mouse-movement
)
(
t-mouse-make-event-element
current-xy-avec-time
))))))))
(
defun
t-mouse-process-filter
(
proc
string
)
(
setq
t-mouse-filter-accumulator
(
concat
t-mouse-filter-accumulator
string
))
(
let
((
event
(
t-mouse-make-event
)))
(
while
event
(
if
(
or
track-mouse
(
not
(
eq
'mouse-movement
(
event-basic-type
event
))))
(
setq
unread-command-events
(
nconc
unread-command-events
(
list
event
))))
(
if
t-mouse-debug-buffer
(
print
unread-command-events
t-mouse-debug-buffer
))
(
setq
event
(
t-mouse-make-event
)))))
(
defun
t-mouse-mouse-position-function
(
pos
)
"Return the t-mouse-position unless running with a window system.
The (secret) scrollbar interface is not implemented yet."
(
setcdr
pos
t-mouse-current-xy
)
pos
)
;; It should be possible to just send SIGTSTP to the inferior with
;; stop-process. That doesn't work; mev receives the signal fine but
;; is not really stopped: instead it returns from
;; kill(getpid(), SIGTSTP) immediately. I don't understand what's up
;; itz Tue Mar 24 14:27:38 PST 1998.
(
add-hook
'suspend-hook
(
function
(
lambda
()
(
and
t-mouse-process
;(stop-process t-mouse-process)
(
process-send-string
t-mouse-process
"push -enone -dall -Mnone\n"
)))))
(
add-hook
'suspend-resume-hook
(
function
(
lambda
()
(
and
t-mouse-process
;(continue-process t-mouse-process)
(
process-send-string
t-mouse-process
"pop\n"
)))))
;;;###autoload
(
define-minor-mode
t-mouse-mode
"Toggle t-mouse mode.
...
...
@@ -277,30 +48,13 @@ Turn it on to use Emacs mouse commands, and off to use t-mouse commands."
nil
" Mouse"
nil
:global
t
(
unless
window-system
(
if
t-mouse-mode
;; Turn it on. Starts getting a stream of mouse events from an
;; asynchronous process. Only works if Emacs is running on a virtual
;; terminal without a window system.
(
progn
(
setq
mouse-position-function
#'
t-mouse-mouse-position-function
)
(
let
((
tty
(
t-mouse-tty
))
(
process-connection-type
t
))
(
if
(
not
(
stringp
tty
))
(
error
"Cannot find a virtual terminal"
))
(
setq
t-mouse-process
(
start-process
"t-mouse"
nil
"mev"
"-i"
"-E"
"-C"
tty
(
if
t-mouse-swap-alt-keys
"-M-leftAlt"
"-M-rightAlt"
)
"-e-move"
"-dall"
"-d-hard"
"-f"
)))
(
setq
t-mouse-filter-accumulator
""
)
(
set-process-filter
t-mouse-process
't-mouse-process-filter
)
(
set-process-query-on-exit-flag
t-mouse-process
nil
))
;; Turn it off
(
setq
mouse-position-function
nil
)
(
delete-process
t-mouse-process
)
(
setq
t-mouse-process
nil
))))
(
unless
(
fboundp
'term-open-connection
)
(
error
"Emacs must be built with Gpm to use this mode"
))
(
unless
(
term-open-connection
)
(
error
"Can't open mouse connection"
)))
;; Turn it off
(
term-close-connection
))))
(
provide
't-mouse
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment