spencer@spline.eecs.umich.edu (Spencer W. Thomas) (05/04/88)
Here is a mouse support package I hacked from the sun-mouse package
that came with a (long-ago) version of Gnu emacs. It works under X10,
I don't have Gnu X11 support yet (we're a little slow here), but I
assume it should also work there.
It provides a mnemonic way to bind functions to mouse buttons and
actions (like drag). Unfortunately, the functions must know they are
being executed in response to a mouse click. It ought to be possible
to fix it so this does not need to be true.
The shar file contains two .el files: swt-xmouse, which provides the
basic xmouse support, and xmouse-fns, which contains lots of functions
to bind to the mouse. I have also thrown in a LaTeX file that prints
out a nice chart of the bindings.
=Spencer (spencer@crim.eecs.umich.edu)
: Run this shell script with "sh" not "csh"
PATH=:/bin:/usr/bin:/usr/ucb
export PATH
all=FALSE
if [ $1x = -ax ]; then
all=TRUE
fi
/bin/echo 'Extracting xmouse-fns.el'
sed 's/^X//' <<'//go.sysin dd *' >xmouse-fns.el
;;;
;;; Functions to bind to X mouse keys (and default bindings). Requires
;;; swt-xmouse.el.
;;;
;;; swt-xmouse lives in a utah subdirectory. The provide in it must
;;; provide 'utah/swt-xmouse, too. This is a mess. I wish there was some
;;; other way to force a load at compile time (we need the macros defined
;;; in swt-xmouse during compilation).
(require 'utah/swt-xmouse)
;;;
;;;
;;;
(defun x-mouse-mark-and-point (window x y)
"Set mark at previous cursor position, move cursor to mouse."
(let ((was-window *initial-mouse-window*)
(dot *initial-mouse-point*))
(eval-in-buffer (window-buffer was-window)
(if (or (null (mark)) (/= dot (mark)))
(push-mark dot))))
nil)
(defun x-mouse-select-window (window x y)
(select-window window)
(if *initial-window-point*
(goto-char *initial-window-point*))
nil)
(defvar x-mouse-yank-prv-pos nil)
(defun x-mouse-yank (window x y)
"Yank at mouse position. If repeated in same place, yank from kill ring."
(unwind-protect
(if (and (eq last-command 'x-mouse-yank)
(equal x-mouse-yank-prv-pos (list window x y)))
(progn
(delete-region (point) *initial-mouse-point*)
(rotate-yank-pointer 1)
(yank nil))
(progn
(yank nil)))
(setq x-mouse-yank-prv-pos (list window x y)))
nil)
(defun x-mouse-copy-region (window x y)
"Copy dragged region to kill buffer.
Leave cursor at end of region."
(let ((begin-point (point)))
(move-to-loc x y)
(copy-region-as-kill begin-point (point))
(setq this-command 'x-mouse-copy-region)))
(defun x-mouse-kill-region (window x y)
"Kill the dragged region.
Leave cursor at end of region."
(let ((begin-point (point)))
(move-to-loc x y)
(kill-region begin-point (point))
(setq this-command 'x-mouse-kill-region)))
(defun x-mouse-indent-region (window x y)
"Re-indent the dragged region.
Leave cursor at end."
(let ((begin-point (point)))
(move-to-loc x y)
(indent-region begin-point (point) nil)))
(defun x-mouse-re-enter-line (window x y)
"Copy from mouse to end of line to X cut buffer, insert at end of buffer.
Most useful in shell windows, probably."
(let ((begin-point (point)))
(x-store-cut-buffer
(buffer-substring begin-point (progn (end-of-line) (point))))
(goto-char (point-max))
(insert (x-get-cut-buffer))
(setq unread-command-char ?\^m)))
(defun x-mouse-cut (window x y)
"Copy dragged region into X cut buffer.
Leave cursor at end of region."
(let ((begin-point (point)))
(move-to-loc x y)
(x-store-cut-buffer (buffer-substring begin-point (point)))))
(defun x-mouse-insert-cut (window x y)
"Insert X cut buffer at mouse position."
(insert (x-get-cut-buffer)))
;;;
;;; Mode line functions
;;;
(defun x-mouse-pct-x (arg window)
(let* ((xpos (car arg))
(bounds (window-edges window))
(xpct (/ (* 100 (- xpos (nth 0 bounds)))
(- (nth 2 bounds) (nth 0 bounds)))))
xpct))
(defun x-mouse-scroll-down (window x y)
"Scroll the pointed to window down
by an amount determined by mouse horizontal position."
(eval-in-window window
(let* ((height (window-height window))
(nlines (min (max 1 (/ (* (x-mouse-pct-x arg window)
height) 70))
(- height 2))))
(scroll-down nlines))))
(defun x-mouse-scroll-up (window x y)
"Scroll the pointed to window up
by an amount determined by mouse horizontal position."
(eval-in-window window
(let* ((height (window-height window))
(nlines (min (max 1 (/ (* (x-mouse-pct-x arg window)
height) 70))
(- height 2))))
(scroll-up nlines))))
(defun x-mouse-beginning-of-defun (window x y)
"Move to the beginning of the current defun in window pointed to.
Cursor remains in current window."
(eval-in-window window
(beginning-of-defun nil)))
(defun x-mouse-end-of-defun (window x y)
"Move to the end of the current defun in window pointed to.
Cursor remains in current window."
(eval-in-window window
(end-of-defun nil)))
(defun x-mouse-resize (window x y)
"Resize a window by moving the mode line."
(let ((mouse-y (+ y (nth 1 (window-edges window))))
(oy (+ *start-mouse-y* (nth 1 (window-edges *start-mouse-window*))))
(owin (selected-window)))
(select-window *start-mouse-window*)
(enlarge-window (- mouse-y oy))
(if (not (eq *start-mouse-window* owin))
(select-window owin))))
(defun x-mouse-split (window x y)
"Split a window by dragging the mode line."
(let ((mouse-y (+ y (nth 1 (window-edges window))))
(oy (+ *start-mouse-y* (nth 1 (window-edges *start-mouse-window*))))
(wsize (window-height *start-mouse-window*)))
(eval-in-window *start-mouse-window*
(if (> mouse-y oy)
(progn
(enlarge-window (- mouse-y oy))
(split-window *start-mouse-window* wsize))
(split-window *start-mouse-window* (- wsize (- oy mouse-y)))))))
(defun x-mouse-invoke-buffer-menu (window x y)
"Invoke the function bound to C-x C-b in the pointed at window."
(select-window window)
(apply (key-binding "\C-x\C-b") '(nil)))
;;;
;;; Scrollbar bindings
;;;
(defun x-mouse-line-to-top (window x y)
"Move line cursor is pointing to to top of window.
Cursor remains in current window."
(eval-in-window window
(move-to-loc x y)
(recenter 0))
(not (eq window *initial-mouse-window*)))
(defun x-mouse-line-to-bottom (window x y)
"Move line mouse is pointing to to bottom of window.
Cursor remains in current window."
(eval-in-window window
(move-to-loc x y)
(recenter -1))
(not (eq window *initial-mouse-window*)))
(defun x-mouse-scroll-up-down (window x y)
"Scroll window down if mouse is in upper part of window, up otherwise.
Cursor remains in current window."
(eval-in-window window
(if (> y (/ (window-height window) 2))
(scroll-up nil)
(scroll-down nil)))
(not (eq window *initial-mouse-window*)))
(defun x-mouse-drag-scroll (window x y)
"Scroll window by amount mouse is moved up or down.
Cursor remains in current window."
(eval-in-window *start-mouse-window*
(scroll-down (- y *start-mouse-y*)))
(not (eq window *initial-mouse-window*)))
;;;
;;; Bindings for electric-buffer-list selection
;;;
(defun x-mouse-ebuff-select (window x y)
(setq unread-command-char ?\ )
nil)
(defun x-mouse-ebuff-delete (window x y)
(setq unread-command-char ?\d)
nil)
(defun x-mouse-ebuff-unmark (window x y)
(setq unread-command-char ?\u)
nil)
(defun x-mouse-ebuff-mark (window x y)
(setq unread-command-char ?\m)
nil)
(defun x-mouse-ebuff-quit (window x y)
(setq unread-command-char ?\q)
nil)
;;;
;;; Default bindings
;;;
(if (not (and (boundp 'xmouse-do-not-bind) xmouse-do-not-bind))
(progn
(global-set-mouse '(left text) 'x-mouse-mark-and-point)
(global-set-mouse '(middle text) 'x-mouse-yank)
(global-set-mouse '(right text) 'x-mouse-select-window)
(global-set-mouse '(left drag text) 'x-mouse-copy-region)
(global-set-mouse '(middle drag text) 'x-mouse-kill-region)
(global-set-mouse '(right drag text) 'x-mouse-indent-region)
(global-set-mouse '(left shift text) 'x-mouse-re-enter-line)
(global-set-mouse '(right shift text) 'x-mouse-insert-cut)
(global-set-mouse '(middle shift drag text) 'x-mouse-cut)
(global-set-mouse '(left modeline) 'x-mouse-scroll-down)
(global-set-mouse '(middle modeline) 'x-mouse-invoke-buffer-menu)
(global-set-mouse '(right modeline) 'x-mouse-scroll-up)
(global-set-mouse '(left shift modeline) 'x-mouse-beginning-of-defun)
(global-set-mouse '(right shift modeline) 'x-mouse-end-of-defun)
(global-set-mouse '(left drag modeline) 'x-mouse-resize)
(global-set-mouse '(middle drag modeline) 'x-mouse-split)
(global-set-mouse '(left scrollbar) 'x-mouse-line-to-bottom)
(global-set-mouse '(middle scrollbar) 'x-mouse-scroll-up-down)
(global-set-mouse '(right scrollbar) 'x-mouse-line-to-top)
(global-set-mouse '(middle scrollbar drag) 'x-mouse-drag-scroll)
))
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 664 xmouse-fns.el
/bin/echo -n ' '; /bin/ls -ld xmouse-fns.el
fi
/bin/echo 'Extracting swt-xmouse.el'
sed 's/^X//' <<'//go.sysin dd *' >swt-xmouse.el
;; Mouse handling for X windows
;; Copyright (C) 1987 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Spencer W. Thomas, University of Utah, Sept 1987
;;; based on sun-mouse.el by:
;;; Jeff Peck, Sun Microsystems, Jan 1987.
;;; Original idea by Stan Jefferson
;;; Don't need standard x-mouse package here (but X startup requires it, so
;;; fake it out)
(provide 'x-mouse)
(provide 'utah/swt-xmouse)
;;;
;;; Modelled after the GNUEMACS keymap interface.
;;;
;;; User Functions: (don't believe this list... SWT)
;;; make-mousemap, copy-mousemap,
;;; define-mouse, global-set-mouse, local-set-mouse,
;;; use-global-mousemap, use-local-mousemap,
;;; mouse-lookup, describe-mouse-bindings
;;;
;;; Options:
;;; scrollbar-width
;;;
(defvar scrollbar-width 5
"*The character width of the scrollbar.
The cursor is deemed to be in the right edge scrollbar if it is this near the
right edge, and more than two chars past the end of the indicated line.
Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
(defvar *start-mouse-window* nil
"Window in which a mouse action started. Set on down click.")
(defvar *start-mouse-x* nil
"X posn within window at which mouse action started. Set on down click.")
(defvar *start-mouse-y* nil
"Y posn within window at which mouse action started. Set on down click.")
(defvar *initial-mouse-window* nil
"window cursor was in before mouse down event.")
(defvar *initial-mouse-point* nil
"Point cursor was at before mouse down event.")
(defvar *initial-window-point* nil
"Point in mouse window before mouse down event. Set on down click.
Only set when mouse is depressed in a text window.")
;;;
;;; Mousemaps
;;;
(defun make-mousemap ()
"Returns a new mousemap."
(cons 'mousemap nil))
(defun copy-mousemap (mousemap)
"Return a copy of mousemap."
(copy-alist mousemap))
(defun define-mouse (mousemap mouse-list def)
"Args MOUSEMAP, MOUSE-LIST, DEF.Define MOUSE-LIST in MOUSEMAP as DEF.
MOUSE-LIST is a list of atoms specifing a mouse hit according to these rules:
* One of these atoms specifies the active region of the definition.
text, scrollbar, modeline, minibuffer
* One of these atoms specify the button.
left, middle, right
* Any combination of these atoms specify the active shift keys.
control, shift
* You can add
drag
to indicate a dragging action.
The atom `double' is used with a button designator to denote a double click.
See x-mouse-handler for the treatment of the form DEF."
(mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def))
(defun global-set-mouse (mouse-list def)
"Give MOUSE-EVENT-LIST a local definition of DEF.
See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
that local definition will continue to shadow any global definition."
(interactive "xMouse event: \nxDefinition: ")
(define-mouse current-global-mousemap mouse-list def))
(defun local-set-mouse (mouse-list def)
"Give MOUSE-EVENT-LIST a local definition of DEF.
See define-mouse for a description of the arguments.
The definition goes in the current buffer's local mousemap.
Normally buffers in the same major mode share a local mousemap."
(interactive "xMouse event: \nxDefinition: ")
(if (null current-local-mousemap)
(setq current-local-mousemap (make-mousemap)))
(define-mouse current-local-mousemap mouse-list def))
(defun use-global-mousemap (mousemap)
"Selects MOUSEMAP as the global mousemap."
(setq current-global-mousemap mousemap))
(defun use-local-mousemap (mousemap)
"Selects MOUSEMAP as the local mousemap.
nil for MOUSEMAP means no local mousemap."
(setq current-local-mousemap mousemap))
;;;
;;; Interface to mouse driver
;;;
;;;
;;; Hit accessors.
;;;
(defconst xm::ButtonBits 3) ; right=0, middle=1, left=2
(defconst xm::UpBits 4) ; Bit 3.
(defconst xm::ShiftmaskBits 112) ; Bits 5-7 (Shift/Meta/Control)
(defconst xm::DoubleBits 0) ; No double clicks in X
(defmacro x-button-bind (sym val)
(let ((name (intern (concat "xm::" (symbol-name sym)))))
(` (progn (defconst (, sym) (char-to-string (, val)))
(defun (, name) (arg)
(x-mouse-handler (cons (, val) arg)))
(define-key mouse-map (, sym) '(, name))))))
(x-button-bind x-button-right 0)
(x-button-bind x-button-u-right 4)
(x-button-bind x-button-middle 1)
(x-button-bind x-button-u-middle 5)
(x-button-bind x-button-left 2)
(x-button-bind x-button-u-left 6)
(x-button-bind x-button-s-right 16)
(x-button-bind x-button-s-u-right 20)
(x-button-bind x-button-s-middle 17)
(x-button-bind x-button-s-u-middle 21)
(x-button-bind x-button-s-left 18)
(x-button-bind x-button-s-u-left 22)
(x-button-bind x-button-m-right 32)
(x-button-bind x-button-m-u-right 36)
(x-button-bind x-button-m-middle 33)
(x-button-bind x-button-m-u-middle 37)
(x-button-bind x-button-m-left 34)
(x-button-bind x-button-m-u-left 38)
(x-button-bind x-button-c-right 64)
(x-button-bind x-button-c-u-right 68)
(x-button-bind x-button-c-middle 65)
(x-button-bind x-button-c-u-middle 69)
(x-button-bind x-button-c-left 66)
(x-button-bind x-button-c-u-left 70)
(x-button-bind x-button-m-s-right 48)
(x-button-bind x-button-m-s-u-right 52)
(x-button-bind x-button-m-s-middle 49)
(x-button-bind x-button-m-s-u-middle 53)
(x-button-bind x-button-m-s-left 50)
(x-button-bind x-button-m-s-u-left 54)
(x-button-bind x-button-c-s-right 80)
(x-button-bind x-button-c-s-u-right 84)
(x-button-bind x-button-c-s-middle 81)
(x-button-bind x-button-c-s-u-middle 85)
(x-button-bind x-button-c-s-left 82)
(x-button-bind x-button-c-s-u-left 86)
(x-button-bind x-button-c-m-right 96)
(x-button-bind x-button-c-m-u-right 100)
(x-button-bind x-button-c-m-middle 97)
(x-button-bind x-button-c-m-u-middle 101)
(x-button-bind x-button-c-m-left 98)
(x-button-bind x-button-c-m-u-left 102)
(x-button-bind x-button-c-m-s-right 112)
(x-button-bind x-button-c-m-s-u-right 116)
(x-button-bind x-button-c-m-s-middle 113)
(x-button-bind x-button-c-m-s-u-middle 117)
(x-button-bind x-button-c-m-s-left 114)
(x-button-bind x-button-c-m-s-u-left 118)
(defmacro eval-in-buffer (buffer &rest forms)
"Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
;; When you don't need the complete window context of eval-in-window
(` (let ((StartBuffer (current-buffer)))
(unwind-protect
(progn
(set-buffer (, buffer))
(,@ forms))
(set-buffer StartBuffer)))))
(put 'eval-in-buffer 'lisp-indent-hook 1)
;;; this is used extensively by mouse functions?
;;;
(defmacro eval-in-window (window &rest forms)
"Switch to WINDOW, evaluate FORMS, return to original window."
(` (let ((OriginallySelectedWindow (selected-window)))
(unwind-protect
(progn
(select-window (, window))
(,@ forms))
(select-window OriginallySelectedWindow)))))
(put 'eval-in-window 'lisp-indent-hook 1)
;;;
;;; handy utility, generalizes window_loop
;;;
;;; It's a macro (and does not evaluate its arguments).
(defmacro eval-in-windows (form &optional yesmini)
"Switches to each window and evaluates FORM. Optional argument
YESMINI says to include the minibuffer as a window.
This is a macro, and does not evaluate its arguments."
(` (let ((OriginallySelectedWindow (selected-window)))
(unwind-protect
(while (progn
(, form)
(not (eq OriginallySelectedWindow
(select-window
(next-window nil (, yesmini)))))))
(select-window OriginallySelectedWindow)))))
(put 'eval-in-windows 'lisp-indent-hook 0)
(defun move-to-loc (x y)
"Move cursor to window location X, Y.
Handles wrapped and horizontally scrolled lines correctly."
(move-to-window-line y)
;; window-line-end expects this to return the window column it moved to.
(let ((cc (current-column))
(nc (move-to-column
(if (zerop (window-hscroll))
(+ (current-column)
(min (- (window-width) 2) ; To stay on the line.
x))
(+ (window-hscroll) -1
(min (1- (window-width)) ; To stay on the line.
x))))))
(- nc cc)))
(defun minibuffer-window-p (window)
"True iff this WINDOW is minibuffer."
(= (screen-height)
(nth 3 (window-edges window)) ; The bottom edge.
))
;;;
;;; First, some generally useful functions:
;;;
(defun logtest (x y)
"True if any bits set in X are also set in Y.
Just like the Common Lisp function of the same name."
(not (zerop (logand x y))))
;;; All the useful code bits
(defmacro xm::hit-code (hit)
(` (nth 0 (, hit))))
;;; The button
(defmacro xm::hit-button (hit)
(` (logand xm::ButtonBits (nth 0 (, hit)))))
;;; The shift, control, and meta flags.
(defmacro xm::hit-shiftmask (hit)
(` (logand xm::ShiftmaskBits (nth 0 (, hit)))))
;;; Set if a double click
(defmacro xm::hit-double (hit)
(` (logand xm::DoubleBits (nth 0 (, hit)))))
;;; Set on button release (as opposed to button press).
(defmacro xm::hit-up (hit)
(` (logand xm::UpBits (nth 0 (, hit)))))
;;; Ignore up/down info in hit list
(defmacro xm::hit-no-up (hit)
(` (cons (logand (lognot xm::UpBits) (nth 0 (, hit))) (cdr (, hit)))))
;;; Screen x position.
(defmacro xm::hit-x (hit) (list 'nth 1 hit))
;;; Screen y position.
(defmacro xm::hit-y (hit) (list 'nth 2 hit))
(defmacro xm::hit-up-p (hit) ; A predicate.
(` (not (zerop (xm::hit-up (, hit))))))
;;;
;;; Loc accessors. for xm::window-xy
;;;
(defmacro xm::loc-w (loc) (list 'nth 0 loc))
(defmacro xm::loc-x (loc) (list 'nth 1 loc))
(defmacro xm::loc-y (loc) (list 'nth 2 loc))
;;;
;;; Handle mouse events
;;;
(defun x-flush-mouse-queue ()
"Process all queued mouse events."
;; A mouse event causes a special character sequence to be given
;; as keyboard input. That runs this function, which process all
;; queued mouse events and returns.
(interactive)
;; Don't let 'x-flush-mouse-queue get on last-command,
;; since this function should be transparent.
(if (eq this-command 'x-flush-mouse-queue)
(setq this-command last-command))
(while (> (x-mouse-events) 0)
(x-proc-mouse-event))
(and (boundp 'x-process-mouse-hook)
(symbol-value 'x-process-mouse-hook)
(funcall x-process-mouse-hook x-mouse-pos x-mouse-item)))
(defun x-mouse-handler (hit)
"Evaluates the function or list associated with a mouse hit.
Expecting to read a hit, which is a list: (button x y).
A down click just remembers the current position, and, if the mouse is
in the text, moves the text cursor to the mouse position. On an up click
a form bound to button by define-mouse is found by mouse-lookup.
The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.
If the mouse action was a drag,the variables *start-mouse-window*,
*start-mouse-x*, and *start-mouse-y* are bound to the values that
*mouse-window*, *mouse-x*, and *mouse-y* had on the down click.
If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
the form is eval'ed; if the form is neither of these, it is an error.
If the form returns a non-nil value, the cursor will be returned to the
position it was in before executing the form.
Returns nil."
(let ((loc (xm::window-xy (xm::hit-x hit) (xm::hit-y hit)))
(start-loc (list *start-mouse-window*
*start-mouse-x* *start-mouse-y*)))
(let ((*mouse-window* (xm::loc-w loc))
(*mouse-x* (xm::loc-x loc))
(*mouse-y* (xm::loc-y loc))
(mouse-code (mouse-event-code
(xm::hit-no-up hit) loc start-loc)))
(if (not (xm::hit-up-p hit))
(xm::down-action) ; Down moves cursor, sets state vars
(let ((form (eval-in-buffer (window-buffer *mouse-window*)
(mouse-lookup mouse-code))))
(cond ((null form)
(xm::clear-action t)
(error "Undefined mouse event: %s"
(prin1-to-string
(mouse-code-to-mouse-list mouse-code))))
((symbolp form)
(setq this-command form)
(xm::clear-action
(funcall form *mouse-window* *mouse-x* *mouse-y*))
)
((listp form)
(setq this-command (car form))
(xm::clear-action (eval form)))
(t
(error "Mouse action must be symbol or list, but was: %s"
form)))))))
;; (message (prin1-to-string this-command)) ; to see what your buttons did
nil)
(defun xm::down-action ()
"Remember current state on down mouse transition.
Sets the vars *start-mouse-window*, *start-mouse-x*, and *start-mouse-y*
to current values of *mouse-window*, *mouse-x*, and *mouse-y*. Also sets
*initial-mouse-window* and *initial-mouse-point* to the window and point of
the current cursor location. Sets *initial-window-point* to point value in
window mouse is depressed in. Moves cursor to mouse position if in text."
(setq *initial-mouse-window* (selected-window)
*initial-mouse-point* (point)
*start-mouse-window* *mouse-window*
*start-mouse-x* *mouse-x*
*start-mouse-y* *mouse-y*
*initial-window-point* nil)
(let ((region (xm::window-region (list *mouse-window* *mouse-x* *mouse-y*))))
(if (eq region 'text)
(progn
(select-window *mouse-window*)
(setq *initial-window-point* (point))
(move-to-loc *mouse-x* *mouse-y*)))))
(defun xm::clear-action (&optional arg)
"Clear the mouse state.
If optional ARG is non-nil, return to original cursor position first."
(if arg
(condition-case nil
(progn
(if *initial-window-point*
(progn
(select-window *start-mouse-window*)
(goto-char *initial-window-point*)))
(select-window *initial-mouse-window*)
(goto-char *initial-mouse-point*))
(error nil)))
(setq *initial-mouse-window* nil
*initial-mouse-point* nil
*start-mouse-window* nil
*start-mouse-x* nil
*start-mouse-y* nil
*initial-window-point* nil))
(defun xm::window-xy (x y)
"Find window containing screen coordinates X and Y.
Returns list (window x y) where x and y are relative to window."
(or
(catch 'found
(eval-in-windows
(let ((we (window-edges (selected-window))))
(let ((le (nth 0 we))
(te (nth 1 we))
(re (nth 2 we))
(be (nth 3 we)))
(if (= re (screen-width))
;; include the continuation column with this window
(setq re (1+ re)))
(if (= be (screen-height))
;; include partial line at bottom of screen with this window
;; id est, if window is not multple of char size.
(setq be (1+ be)))
(if (and (>= x le) (< x re)
(>= y te) (< y be))
(throw 'found
(list (selected-window) (- x le) (- y te))))))
t)) ; include minibuffer in eval-in-windows
;;If x,y from a real mouse click, we shouldn't get here.
(list nil x y)
))
(defun xm::window-region (loc)
"Parse LOC into a region symbol.
Returns one of (text scrollbar modeline minibuffer)"
(let ((w (xm::loc-w loc))
(x (xm::loc-x loc))
(y (xm::loc-y loc)))
(let ((right (1- (window-width w)))
(bottom (1- (window-height w))))
(cond ((minibuffer-window-p w) 'minibuffer)
((>= y bottom) 'modeline)
((>= x right) 'scrollbar)
;; far right column (window seperator) is always a scrollbar
((and scrollbar-width
;; mouse within scrollbar-width of edge.
(>= x (- right scrollbar-width))
;; mouse a few chars past the end of line.
(>= x (+ 2 (window-line-end w x y))))
'scrollbar)
(t 'text)))))
(defun window-line-end (w x y)
"Return WINDOW column (ignore X) containing end of line Y"
(eval-in-window w (save-excursion (move-to-loc (screen-width) y))))
;;;
;;; The encoding of mouse events into a mousemap.
;;; These values must agree with coding in C source:
;;; The first three values MUST have values 0, 1, 2.
;;;
(defconst xm::keyword-alist
'((right . 0) (middle . 1) (left . 2)
(shift . 16) (meta . 32) (control . 64) (drag . 128)
(text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)
))
(defun mouse-event-code (hit loc start-loc)
"Maps MOUSE-HIT and LOC into a mouse-code."
;;;Region is a code for one of text, modeline, scrollbar, or minibuffer.
(logior (xm::hit-code hit)
(if (null (xm::loc-w start-loc))
(mouse-region-to-code (xm::window-region loc))
(logior
(mouse-region-to-code (xm::window-region start-loc))
(if (not (equal loc start-loc))
(mouse-region-to-code 'drag)
0)))))
(defun mouse-region-to-code (region)
"Returns partial mouse-code for specified REGION."
(cdr (assq region xm::keyword-alist)))
(defun mouse-list-to-mouse-code (mouse-list)
"Map a MOUSE-LIST to a mouse-code."
(apply 'logior
(mapcar (function (lambda (x)
(cdr (assq x xm::keyword-alist))))
mouse-list)))
;;; Get button name
(defmacro xm::mouse-code-button-name (mouse-code)
(` (car (nth (logand xm::ButtonBits (, mouse-code)) xm::keyword-alist))))
;;; Ignore button bits
(defmacro xm::mouse-code-no-button (mouse-code)
(` (logand (lognot xm::ButtonBits) (, mouse-code))))
(defun mouse-code-to-mouse-list (mouse-code)
"Map a MOUSE-CODE to a mouse-list."
(let ((code (xm::mouse-code-no-button mouse-code)))
(cons (xm::mouse-code-button-name mouse-code)
(apply 'nconc (mapcar
(function (lambda (x)
(if (logtest code (cdr x))
(list (car x)))))
xm::keyword-alist)))))
(defun mousemap-set (code mousemap value)
(let* ((alist (cdr mousemap))
(assq-result (assq code alist)))
(if assq-result
(setcdr assq-result value)
(setcdr mousemap (cons (cons code value) alist)))))
(defun mousemap-get (code mousemap)
(cdr (assq code (cdr mousemap))))
(defun mouse-lookup (mouse-code)
"Look up MOUSE-EVENT and return the definition. nil means undefined."
(or (mousemap-get mouse-code current-local-mousemap)
(mousemap-get mouse-code current-global-mousemap)))
;;;
;;; I (jpeck) don't understand the utility of the next four functions
;;; ask Steven Greenbaum <froud@kestrel>
;;;
(defun mouse-mask-lookup (mask list)
"Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
Returns a list of elements of LIST whose code or'ed with MASK is non-zero."
(let ((result nil))
(while list
(if (logtest mask (car (car list)))
(setq result (cons (car list) result)))
(setq list (cdr list)))
result))
(defun mouse-union (l l-unique)
"Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
where L-UNIQUE is considered to be union'ized already."
(let ((result l-unique))
(while l
(let ((code-form-pair (car l)))
(if (not (assq (car code-form-pair) result))
(setq result (cons code-form-pair result))))
(setq l (cdr l)))
result))
(defun mouse-union-first-prefered (l1 l2)
"Return the union of lists of mouse (code . form) pairs L1 and L2,
based on the code's, with preference going to elements in L1."
(mouse-union l2 (mouse-union l1 nil)))
(defun mouse-code-function-pairs-of-region (region)
"Return a list of (code . function) pairs, where each code is
currently set in the REGION."
(let ((mask (mouse-region-to-code region)))
(mouse-union-first-prefered
(mouse-mask-lookup mask (cdr current-local-mousemap))
(mouse-mask-lookup mask (cdr current-global-mousemap))
)))
;;;
;;; Functions for DESCRIBE-MOUSE-BINDINGS
;;; And other mouse documentation functions
;;; Still need a good procedure to print out a help sheet in readable format.
;;;
(defun one-line-doc-string (function)
"Returns first line of documentation string for FUNCTION.
If there is no documentation string, then the string
\"No documentation\" is returned."
(while (consp function) (setq function (car function)))
(let ((doc (documentation function)))
(if (null doc)
"No documentation."
(string-match "^.*$" doc)
(substring doc 0 (match-end 0)))))
(defun print-mouse-format (binding)
(princ (car binding))
(princ ": ")
(mapcar (function
(lambda (mouse-list)
(princ mouse-list)
(princ " ")))
(cdr binding))
(terpri)
(princ " ")
(princ (one-line-doc-string (car binding)))
(terpri)
)
(defun print-mouse-bindings (region)
"Prints mouse-event bindings for REGION."
(mapcar 'print-mouse-format (xm::event-bindings region)))
(defun xm::event-bindings (region)
"Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
where each mouse-list is bound to the function in REGION."
(let ((mouse-bindings (mouse-code-function-pairs-of-region region))
(result nil))
(while mouse-bindings
(let* ((code-function-pair (car mouse-bindings))
(current-entry (assoc (cdr code-function-pair) result)))
(if current-entry
(setcdr current-entry
(cons (mouse-code-to-mouse-list (car code-function-pair))
(cdr current-entry)))
(setq result (cons (cons (cdr code-function-pair)
(list (mouse-code-to-mouse-list
(car code-function-pair))))
result))))
(setq mouse-bindings (cdr mouse-bindings))
)
result))
(defun describe-mouse-bindings ()
"Lists all current mouse-event bindings."
(interactive)
(with-output-to-temp-buffer "*Help*"
(princ "Text Region") (terpri)
(princ "---- ------") (terpri)
(print-mouse-bindings 'text) (terpri)
(princ "Modeline Region") (terpri)
(princ "-------- ------") (terpri)
(print-mouse-bindings 'modeline) (terpri)
(princ "Scrollbar Region") (terpri)
(princ "--------- ------") (terpri)
(print-mouse-bindings 'scrollbar)))
(defun describe-mouse-briefly (mouse-list)
"Print a short description of the function bound to MOUSE-LIST."
(interactive "xDescibe mouse list briefly: ")
(let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list))))
(if function
(message "%s runs the command %s" mouse-list function)
(message "%s is undefined" mouse-list))))
;;;
;;; (Finally!) Functions bound to mouse keys
;;;
;;; This is useful to just get a "move cursor" action.
(defun x-mouse-no-op (window x y))
;;;
;;; initialize mouse maps
;;;
(make-variable-buffer-local 'current-local-mousemap)
(setq-default current-local-mousemap nil)
(defvar current-global-mousemap (make-mousemap))
(global-set-key "\C-x\C-@" 'x-flush-mouse-queue)
(global-set-key "\C-x\C-m" 'x-flush-mouse-queue)
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 664 swt-xmouse.el
/bin/echo -n ' '; /bin/ls -ld swt-xmouse.el
fi
/bin/echo 'Extracting xgnukeys.tex'
sed 's/^X//' <<'//go.sysin dd *' >xgnukeys.tex
% X windows gnuemacs key bindings, in LaTeX.
\documentstyle{article}
\begin{document}
\begin{tabular}{|ll|l|l|l|}
\hline
\multicolumn{5}{|c|}{``xmouse-fns'' Gnu Emacs Mouse Key Bindings} \\
\hline \hline
\multicolumn{2}{|c|}{} &
\multicolumn{3}{|c|}{Context} \\ \cline{3-5}
\multicolumn{2}{|c|}{Button} &
\multicolumn{1}{c|}{Window} &
\multicolumn{1}{c|}{Mode line} &
\multicolumn{1}{c|}{Scrollbar}\\ \hline
& L & Mark, point @mouse & scroll down
& line to bottom \\
& M & yank @mouse & buffer-menu
& page up or down \\
& R & & scroll up
& line to top\\ \hline
Drag & L & Copy region & Resize window & \\
& M & Kill region & split window
& drag scroll \\
& R & Indent region & & \\ \hline
Shift & L & copy to eol to X & end-of-defun & \\
& M & & & \\
& R & insert from X & beginning-of-defun
& \\ \hline
Shift & L & & & \\
Drag & M & copy region to X & & \\
& R & & & \\ \hline
\end{tabular}
\end{document}
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 644 xgnukeys.tex
/bin/echo -n ' '; /bin/ls -ld xgnukeys.tex
fi
exit 0
=Spencer (spencer@crim.eecs.umich.edu)