Annotation of 43BSD/contrib/emacs/lisp/bg-mouse.el, revision 1.1.1.1

1.1       root        1: ;; GNU Emacs code for BBN Bitgraph mouse.
                      2: ;; Copyright (C) Free Software Foundation Oct 1985.
                      3: 
                      4: ;; This file is part of GNU Emacs.
                      5: 
                      6: ;; GNU Emacs is distributed in the hope that it will be useful,
                      7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
                      8: ;; accepts responsibility to anyone for the consequences of using it
                      9: ;; or for whether it serves any particular purpose or works at all,
                     10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
                     11: ;; License for full details.
                     12: 
                     13: ;; Everyone is granted permission to copy, modify and redistribute
                     14: ;; GNU Emacs, but only under the conditions described in the
                     15: ;; GNU Emacs General Public License.   A copy of this license is
                     16: ;; supposed to have been given to you along with GNU Emacs so you
                     17: ;; can know your rights and responsibilities.  It should be in a
                     18: ;; file named COPYING.  Among other things, the copyright notice
                     19: ;; and this notice must be preserved on all copies.
                     20: 
                     21: 
                     22: ;;;  Original version by John Robinson ([email protected], bbncca!jr), Oct 1985
                     23: 
                     24: ;;;  User customization option:
                     25: 
                     26: (defvar bg-mouse-fast-select-window nil
                     27:   "*Non-nil for mouse hits to select new window, then execute; else just select.")
                     28: 
                     29: ;;;  Defuns:
                     30: 
                     31: (defun bg-mouse-report ()
                     32:   "Read and parse BBN BitGraph mouse report, and do what it asks.
                     33: 
                     34: L-- move point          *  |---- These apply for mouse click in a window.
                     35: --R set mark            *  | If bg-mouse-fast-select-window is nil,
                     36: L-R kill region            | a starred command on a nonselected window
                     37: -C- move point and yank *  | just selects that window.
                     38: LC- yank-pop
                     39: -CR or LCR undo                   | \"Scroll bar\" is right-hand window column.
                     40: 
                     41: on modeline                on \"scroll bar\"   in minibuffer
                     42: L-- scroll-up              line to top         execute-extended-command
                     43: --R scroll-down                    line to bottom      eval-expression
                     44: -C- proportional goto-char  line to middle     suspend-emacs
                     45: 
                     46: To reenable the mouse if terminal is reset, type ESC : RET ."
                     47:   (interactive)
                     48:   (bg-get-tty-num ?\;)
                     49:   (let*
                     50:       ((x (min (1- (screen-width))
                     51:               (/ (bg-get-tty-num ?\;) 9)))     ; Don't hit column 86!
                     52:        (y (- (1- (screen-height))
                     53:             (/ (bg-get-tty-num ?\;) 16)))      ; Assume default font size.
                     54:        (buttons (% (bg-get-tty-num ?c) 8))
                     55:        (window (bg-pos-to-window x y))
                     56:        (edges (window-edges window))
                     57:        (old-window (selected-window))
                     58:        (in-minibuf-p (eq y (1- (screen-height))))
                     59:        (same-window-p (and (not in-minibuf-p) (eq window old-window)))
                     60:        (in-modeline-p (eq y (1- (nth 3 edges))))
                     61:        (in-scrollbar-p (>= x (1- (nth 2 edges)))))
                     62:     (setq x (- x (nth 0 edges)))
                     63:     (setq y (- y (nth 1 edges)))
                     64:     (cond (in-modeline-p
                     65:           (select-window window)
                     66:           (cond ((= buttons 4)
                     67:                  (scroll-up))
                     68:                 ((= buttons 1)
                     69:                  (scroll-down))
                     70:                 ((= buttons 2)
                     71:                  (goto-char (/ (* x
                     72:                                   (- (point-max) (point-min)))
                     73:                                (1- (window-width))))
                     74:                  (beginning-of-line)
                     75:                  (what-cursor-position)))
                     76:           (select-window old-window))
                     77:          (in-scrollbar-p
                     78:           (select-window window)
                     79:           (scroll-up
                     80:            (cond ((= buttons 4)
                     81:                   y)
                     82:                 ((= buttons 1)
                     83:                   (+ y (- 2 (window-height))))
                     84:                 ((= buttons 2)
                     85:                   (/ (+ 2 y y (- (window-height))) 2))
                     86:                 (t
                     87:                  0)))
                     88:           (select-window old-window))
                     89:          (same-window-p
                     90:           (cond ((= buttons 4)
                     91:                  (bg-move-point-to-x-y x y))
                     92:                 ((= buttons 1)
                     93:                  (push-mark)
                     94:                  (bg-move-point-to-x-y x y)
                     95:                  (exchange-point-and-mark))
                     96:                 ((= buttons 5)
                     97:                  (kill-region (mark) (point)))
                     98:                 ((= buttons 2)
                     99:                  (bg-move-point-to-x-y x y)
                    100:                  (setq this-command 'yank)
                    101:                  (yank))
                    102:                 ((= buttons 6)
                    103:                  (yank-pop 1))
                    104:                 ((or (= buttons 3) (= buttons 7))
                    105:                  (undo))
                    106:                 )
                    107:           )
                    108:          (in-minibuf-p
                    109:           (cond ((= buttons 1)
                    110:                  (call-interactively 'eval-expression))
                    111:                 ((= buttons 4)
                    112:                  (call-interactively 'execute-extended-command))
                    113:                 ((= buttons 2)
                    114:                  (suspend-emacs))
                    115:                 ))
                    116:          (t                            ;in another window
                    117:           (select-window window)
                    118:           (cond ((not bg-mouse-fast-select-window))
                    119:                 ((= buttons 4)
                    120:                  (bg-move-point-to-x-y x y))
                    121:                 ((= buttons 1)
                    122:                  (push-mark)
                    123:                  (bg-move-point-to-x-y x y)
                    124:                  (exchange-point-and-mark))
                    125:                 ((= buttons 2)
                    126:                  (bg-move-point-to-x-y x y)
                    127:                  (setq this-command 'yank)
                    128:                  (yank))
                    129:                 ))
                    130:          )))
                    131: 
                    132: (defun bg-get-tty-num (term-char)
                    133:   "Read from terminal until TERM-CHAR is read, and return intervening number.
                    134: Upon non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
                    135:   (let
                    136:       ((num 0)
                    137:        (char (- (read-char) 48)))
                    138:     (while (and (>= char 0)
                    139:                (<= char 9))
                    140:       (setq num (+ (* num 10) char))
                    141:       (setq char (- (read-char) 48)))
                    142:     (or (eq term-char (+ char 48))
                    143:        (progn
                    144:          (bg-program-mouse)
                    145:          (error "Invalid data format in mouse command")))
                    146:     num))
                    147: 
                    148: (defun bg-move-point-to-x-y (x y)
                    149:   "Position cursor in window coordinates.
                    150: X and Y are 0-based character positions in the window."
                    151:   (move-to-window-line y)
                    152:   (move-to-column x)
                    153:   )
                    154: 
                    155: (defun bg-pos-to-window (x y)
                    156:   "Find window corresponding to screen coordinates.
                    157: X and Y are 0-based character positions on the screen."
                    158:   (let ((edges (window-edges))
                    159:        (window nil))
                    160:     (while (and (not (eq window (selected-window)))
                    161:                (or (<  y (nth 1 edges))
                    162:                    (>= y (nth 3 edges))
                    163:                    (<  x (nth 0 edges))
                    164:                    (>= x (nth 2 edges))))
                    165:       (setq window (next-window window))
                    166:       (setq edges (window-edges window))
                    167:       )
                    168:     (or window (selected-window))
                    169:     )
                    170:   )
                    171: 
                    172: (defun bg-program-mouse ()
                    173:   (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
                    174: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.