;; GNU Emacs code for Interlisp-D mouse using CHATEMACS.
;; Copyright (C) Free Software Foundation March 1987.
;; 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.
;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
;;; Adapted from code for BBN Bitgraph by Randy Gobbel, March 1987
;;; User customization option:
(defconst shift 1)
(defconst control 2)
(defconst shift-control 3)
(defconst meta 4)
(defconst left 4)
(defconst middle 1)
(defconst right 2)
(defvar il-mouse-kill-emacs
(symbol-function 'kill-emacs))
(defvar il-mouse-fast-select-window t
"*Non-nil for mouse hits to select new window, then execute; else just select.")
(defvar scrollbar-enabled t "Non-nil to use last column as scrollbar")
(defvar auto-switch-enabled nil "Non-nil to send init string to terminal")
;;; Defuns:
(defun il-mouse-report ()
"Read and parse Interlisp ChatEmacs mouse report, and do what it asks.
L-- move point * |---- These apply for mouse click in a window.
--R set mark * | If il-mouse-fast-select-window is nil,
-C- depends on shift * | just selects that window.
middle-button actions:
shift: yank region to point
control: kill region
shift-control: copy region to killbuffer
on modeline on \"scroll bar\" in minibuffer
L-- scroll-up line to top execute-extended-command
--R scroll-down line to bottom eval-expression
-C- proportional goto-char proportional suspend-emacs
Meta-mouse-button actions are same as scrollbar."
(interactive)
;; (il-get-tty-num ?\;)
(let*
((x (min (1- (screen-width))
(il-get-tty-num ?\;)))
(y (min (1- (screen-height))
(il-get-tty-num ?\;)))
(buttons (il-get-tty-num ?\;))
(bucky-bits (il-get-tty-num ?\;))
(window (il-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))))
(in-scrollbar-p (>= x (1- (nth 2 edges)))))
(setq x (- x (nth 0 edges)))
(setq y (- y (nth 1 edges)))
(cond (in-modeline-p
(select-window window)
(cond ((= buttons left)
(scroll-up))
((= buttons right)
(scroll-down))
((= buttons middle)
(goto-char (* x (/ (- (point-max) (point-min))
(1- (window-width)))))
(beginning-of-line)
(what-cursor-position)))
(select-window old-window))
((or (and scrollbar-enabled in-scrollbar-p)
(eq bucky-bits meta))
(select-window window)
(cond ((= buttons left)
(scroll-up y))
((= buttons right)
(scroll-down y))
((= buttons middle)
(goto-char (* y (/ (- (point-max) (point-min))
(1- (window-height)))))
(beginning-of-line)
(what-cursor-position)))
(select-window old-window))
(same-window-p (il-button-command x y buttons bucky-bits))
(in-minibuf-p
(cond ((= buttons middle)
(call-interactively 'eval-expression))
((= buttons left)
(call-interactively 'execute-extended-command))
((= buttons right)
(suspend-emacs))
))
(t ;in another window
(select-window window)
(cond ((not il-mouse-fast-select-window))
(t (il-button-command x y buttons bucky-bits)))
))))
(defun il-button-command (x y buttons bucky-bits)
(cond ((= buttons left)
(cond ((eq bucky-bits 0)
(il-move-point-to-x-y x y))
((eq bucky-bits control)
(push-mark)
(il-move-point-to-x-y x y)
(kill-region (mark) (point)))
((eq bucky-bits shift)
(copy-region-as-kill (mark) (point))
(il-move-point-to-x-y x y)
(setq this-command 'yank)
(yank))
((eq bucky-bits shift-control)
(kill-region (mark) (point))
(il-move-point-to-x-y x y)
(setq this-command 'yank)
(yank))
)
)
; ((= buttons middle)
; (cond ((eq bucky-bits 0)
; (il-move-point-to-x-y x y)
; (il-balance-beam-word)
; (mark-word 1))
; ((eq bucky-bits control)
; (il-balance-beam-word)
; (push-mark)
; (il-move-point-to-x-y x y)
; (mark-word 1)
; (kill-region (mark) (point)))
; ((eq bucky-bits shift)
; (il-move-point-to-x-y x y)
; (backward-word)
; (setq this-command 'yank)
; (yank))
; ((eq bucky-bits shift-control)
; (push-mark)
; (il-move-point-to-x-y x y)
; (backward-word)
; (copy-region-as-kill (mark) (point)))
; )
; )
((= buttons right)
(push-mark)
(il-move-point-to-x-y x y)
(if (eq bucky-bits control)
(kill-region (mark) (point))
(progn
(sit-for 1)
(exchange-point-and-mark))
)
)
)
)
;(defun il-balance-beam-word ()
; (let (left-distance left-point right-point (start-point (point)))
; (save-excursion
; (backward-word 1)
; (setq left-point (point))
; (setq left-distance (- start-point (point)))
; (forward-word 1)
; (setq right-point (point)))
; (if (<= left-distance (- (point) start-point)) left-point right-point)
; )
; )
(defun il-get-tty-num (term-char)
"Read from terminal until TERM-CHAR is read, and return intervening number.
Upon non-numeric not matching TERM-CHAR, signal an error."
(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))
; (progn
; (il-program-mouse)
(error "Invalid data format in mouse command"))
num))
(defun il-move-point-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 il-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))
)
)
(defun suspend-hook-fn ()
(interactive)
(send-string-to-terminal "\e0")
nil
)
(defun suspend-resume-hook-fn ()
(interactive)
(send-string-to-terminal "\e1")
nil
)
(global-set-key "\C-\\" 'il-mouse-report)
(if auto-switch-enabled
(progn
(send-string-to-terminal "\e1")
(defun kill-emacs ()
(interactive)
(send-string-to-terminal "\e0")
(funcall il-mouse-kill-emacs)
)
(setq suspend-hook (symbol-function 'suspend-hook-fn))
(setq suspend-resume-hook (symbol-function 'suspend-resume-hook-fn))
)
)