jr@bbncc5.UUCP (John Robinson) (10/03/85)
Here are two short files to split up by hand. mouse-init.el can be
called from (or inserted into) your .emacs; it is intended to be
extended for other terminals' mouse inits some day by adding cond
clauses. The second is all the (rest of the) bitgraph-specific stuff;
it will autoload once you first use your mouse.
----- cut here -----
mouse-init.el
-----
;;; GNU Emacs code for terminal-dependent mouse initialization.
;;; Copyright (C) John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985.
;; 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.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; document "GNU Emacs copying permission notice". An exact copy
;; of the document is supposed to have been given to you along with
;; GNU Emacs so that you can know how you may redistribute it all.
;; It should be in a file named COPYING. Among other things, the
;; copyright notice and this notice must be preserved on all copies.
;;; Original version by John Robinson, Oct 1985
;; Mouse initialization by terminal type
(let ((term (getenv "TERM")))
(cond ((or (equal term "bg")
(equal term "bgnv")
(equal term "bgrv")
(equal term "bbn"))
(progn
(global-set-key "\e:" 'mouse-report)
(autoload 'mouse-report "bg-mouse")
(defun program-bg-mouse ()
(send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
(program-bg-mouse)
)
)
)
)
----- cut here -----
bg-mouse.el
-----
;;; GNU Emacs code for BBN Bitgraph mouse.
;;; Copyright (C) John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985.
;; 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.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; document "GNU Emacs copying permission notice". An exact copy
;; of the document is supposed to have been given to you along with
;; GNU Emacs so that you can know how you may redistribute it all.
;; It should be in a file named COPYING. Among other things, the
;; copyright notice and this notice must be preserved on all copies.
;;; Original version by John Robinson, Oct 1985
;;; User customization option:
(defvar mouse-fast-select-window nil
"*Non-nil for mouse hits to select new window, then execute; else just select.")
;;; Variables:
(defvar mouse-error-signal nil nil)
(put 'mouse-error-signal 'error-conditions (cons 'mouse-parse-error
(cons 'error nil)))
(put 'mouse-error-signal 'error-message "Mouse report format wrong.")
;;; Defuns:
(defun mouse-report ()
"Read and parse BBN BitGraph mouse report, and do what it asks.\n
in a window on modeline on minibuffer
L-- set dot (cursor) scroll-up execute-extended-command
-C- set mark proportional goto-char suspend-emacs
LC- kill region
--R set dot and yank scroll-down eval-expression
-CR yank-pop
L-R undo
LCR undo
mouse-fast-select-window lets first column commands L--, -C-, and --R
work on any visible window, else mouse hit just selects that window.
To reprogram the mouse, type ESC : <CR> ."
(interactive)
(condition-case nil
(progn
(get-tty-num ?\;)
(let*
((x (/ (get-tty-num ?\;) 9)) ; Assumes default font size.
(y (- (1- (screen-height)) (/ (get-tty-num ?\;) 16)))
(buttons (% (get-tty-num ?c) 8))
(window (pos-to-window x y))
(edges (window-edges window))
(old-window (selected-window))
(in-minibuf-p (eq y (1- (screen-height))))
(same-window-p (and (not in-minibuf-p) (eq window old-window)))
(in-modeline-p (eq y (1- (nth 3 edges)))))
(setq x (- x (nth 0 edges)))
(setq y (- y (nth 1 edges)))
(cond (in-modeline-p
(select-window window)
(cond ((= buttons 4)
(scroll-up (/ (window-height) 2)))
((= buttons 1)
(scroll-down (/ (window-height) 2)))
((= buttons 2)
(goto-char (/ (* x
(- (dot-max) (dot-min)))
(1- (window-width))))
(beginning-of-line)
(what-cursor-position)))
(select-window old-window))
(same-window-p
(cond ((= buttons 4)
(move-dot-to-x-y x y))
((= buttons 2)
(push-mark)
(move-dot-to-x-y x y)
(exchange-dot-and-mark))
((= buttons 6)
(kill-region (mark) (dot)))
((= buttons 1)
(move-dot-to-x-y x y)
(setq this-command 'yank)
(yank))
((= buttons 3)
(yank-pop 1))
((or (= buttons 5) (= buttons 7))
(undo))
)
)
(in-minibuf-p
(cond ((= buttons 1)
(call-interactively 'eval-expression))
((= buttons 4)
(call-interactively 'execute-extended-command))
((= buttons 2)
(suspend-emacs))
))
(t ;in another window
(select-window window)
(cond ((not mouse-fast-select-window))
((= buttons 4)
(move-dot-to-x-y x y))
((= buttons 2)
(push-mark)
(move-dot-to-x-y x y)
(exchange-dot-and-mark))
((= buttons 1)
(move-dot-to-x-y x y)
(setq this-command 'yank)
(yank))
))
)))
(mouse-parse-error
(progn
(message "Mouse report parse error.")
(program-bg-mouse)))
)
)
(defun get-tty-num (term-char)
"Read from terminal until TERM-CHAR is read, and return intervening number.
Non-numeric not matching CHAR will signal mouse-error-signal."
(let
((num 0)
(char (- (read-char) 48)))
(while (and (>= char 0)
(<= char 9))
(setq num (+ (* num 10) char))
(setq char (- (read-char) 48)))
(or (eq term-char (+ char 48))
(signal 'mouse-error-signal nil))
num))
(defun move-dot-to-x-y (x y)
"Position cursor in window coordinates.
X and Y are 0-based character positions in the window."
(move-to-window-line y)
(move-to-column x)
)
(defun pos-to-window (x y)
"Find window corresponding to screen coordinates.
X and Y are 0-based character positions on the screen."
(let ((edges (window-edges))
(window nil))
(while (and (not (eq window (selected-window)))
(or (< y (nth 1 edges))
(>= y (nth 3 edges))
(< x (nth 0 edges))
(>= x (nth 2 edges))))
(setq window (next-window window))
(setq edges (window-edges window))
)
(or window (selected-window))
)
)