1 line
8.5 KiB
EmacsLisp
1 line
8.5 KiB
EmacsLisp
;; 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")
|
||
(defvar save-screen-width (screen-width))
|
||
(defvar save-screen-height (screen-height))
|
||
|
||
;;; Defuns:
|
||
|
||
(defun il-mouse-report ()
|
||
"Read Interlisp ChatEmacs mouse report, branch to appropriate sub-handler."
|
||
(interactive)
|
||
(let ((sub-char (read-char)))
|
||
(cond
|
||
((= sub-char ?s) (il-set-screen-size))
|
||
((= sub-char ?m) (il-mouse-command))))
|
||
)
|
||
|
||
(defun il-set-screen-size ()
|
||
(let ((cur-screen-width (il-get-tty-num ?\;))
|
||
(cur-screen-height (il-get-tty-num ?\;)))
|
||
(or (= cur-screen-width save-screen-width)
|
||
(progn
|
||
(setq save-screen-width cur-screen-width)
|
||
(set-screen-width cur-screen-width)))
|
||
(or (= cur-screen-height save-screen-height)
|
||
(progn
|
||
(setq save-screen-height cur-screen-height)
|
||
(set-screen-height cur-screen-height)))
|
||
)
|
||
)
|
||
|
||
|
||
(defun il-mouse-command ()
|
||
"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-- split-vertical line to top execute-extended-command
|
||
--R split-horizontal line to bottom eval-expression
|
||
-C- delete-window 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)
|
||
(split-window-vertically))
|
||
((= buttons right)
|
||
(delete-window))
|
||
((= buttons middle)
|
||
(split-window-horizontally))))
|
||
((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-move-point-to-x-y (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 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))
|
||
)
|
||
)
|