Return to sup-mouse.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/sup-mouse.el, revision 1.1

1.1     ! root        1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !             2: ;;                                                                          ;;
        !             3: ;;     File:     sup-mouse.el                                               ;;
        !             4: ;;     Author:   Wolfgang Rupprecht                                         ;;
        !             5: ;;     Created:  Fri Nov 21 19:22:22 1986                                   ;;
        !             6: ;;     Contents: supdup mouse support for lisp machines                     ;;
        !             7: ;;                                                                          ;;
        !             8: ;;     (from code originally written by John Robinson@bbn for the bitgraph)  ;;
        !             9: ;;                                                                          ;;
        !            10: ;;     $Log$                                                                ;;
        !            11: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !            12: 
        !            13: ;; GNU Emacs code for lambda/supdup mouse
        !            14: ;; Copyright (C) Free Software Foundation 1985, 1986
        !            15: 
        !            16: ;; This file is part of GNU Emacs.
        !            17: 
        !            18: ;; GNU Emacs is distributed in the hope that it will be useful,
        !            19: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !            20: ;; accepts responsibility to anyone for the consequences of using it
        !            21: ;; or for whether it serves any particular purpose or works at all,
        !            22: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            23: ;; License for full details.
        !            24: 
        !            25: ;; Everyone is granted permission to copy, modify and redistribute
        !            26: ;; GNU Emacs, but only under the conditions described in the
        !            27: ;; GNU Emacs General Public License.   A copy of this license is
        !            28: ;; supposed to have been given to you along with GNU Emacs so you
        !            29: ;; can know your rights and responsibilities.  It should be in a
        !            30: ;; file named COPYING.  Among other things, the copyright notice
        !            31: ;; and this notice must be preserved on all copies.
        !            32: 
        !            33: ;;;  User customization option:
        !            34: 
        !            35: (defvar sup-mouse-fast-select-window nil
        !            36:   "*Non-nil for mouse hits to select new window, then execute; else just select.")
        !            37: 
        !            38: (defconst mouse-left 0)
        !            39: (defconst mouse-center 1)
        !            40: (defconst mouse-right 2)
        !            41: 
        !            42: (defconst mouse-2left 4)
        !            43: (defconst mouse-2center 5)
        !            44: (defconst mouse-2right 6)
        !            45: 
        !            46: (defconst mouse-3left 8)
        !            47: (defconst mouse-3center 9)
        !            48: (defconst mouse-3right 10)
        !            49: 
        !            50: ;;;  Defuns:
        !            51: 
        !            52: (defun sup-mouse-report ()
        !            53:   "This function is called directly by the mouse, it parses and
        !            54: executes the mouse commands.
        !            55: 
        !            56:  L move point          *  |---- These apply for mouse click in a window.
        !            57: 2L delete word            |
        !            58: 3L copy word             | If sup-mouse-fast-select-window is nil,
        !            59:  C move point and yank *  | just selects that window.
        !            60: 2C yank pop              |
        !            61:  R set mark            *  |
        !            62: 2R delete region         |
        !            63: 3R copy region           |
        !            64: 
        !            65: on modeline                on \"scroll bar\"   in minibuffer
        !            66:  L scroll-up               line to top         execute-extended-command
        !            67:  C proportional goto-char   line to middle     mouse-help
        !            68:  R scroll-down             line to bottom      eval-expression"
        !            69:   
        !            70:   (interactive)
        !            71:   (let*
        !            72: ;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
        !            73:       ((buttons (sup-get-tty-num ?\;))
        !            74:        (x (sup-get-tty-num ?\;))
        !            75:        (y (sup-get-tty-num ?c))
        !            76:        (window (sup-pos-to-window x y))
        !            77:        (edges (window-edges window))
        !            78:        (old-window (selected-window))
        !            79:        (in-minibuf-p (eq y (1- (screen-height))))
        !            80:        (same-window-p (and (not in-minibuf-p) (eq window old-window)))
        !            81:        (in-modeline-p (eq y (1- (nth 3 edges))))
        !            82:        (in-scrollbar-p (>= x (1- (nth 2 edges)))))
        !            83:     (setq x (- x (nth 0 edges)))
        !            84:     (setq y (- y (nth 1 edges)))
        !            85: 
        !            86: ;    (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
        !            87: 
        !            88:     (cond (in-modeline-p
        !            89:           (select-window window)
        !            90:           (cond ((= buttons mouse-left)
        !            91:                  (scroll-up))
        !            92:                 ((= buttons mouse-right)
        !            93:                  (scroll-down))
        !            94:                 ((= buttons mouse-center)
        !            95:                  (goto-char (/ (* x
        !            96:                                   (- (point-max) (point-min)))
        !            97:                                (1- (window-width))))
        !            98:                  (beginning-of-line)
        !            99:                  (what-cursor-position)))
        !           100:           (select-window old-window))
        !           101:          (in-scrollbar-p
        !           102:           (select-window window)
        !           103:           (scroll-up
        !           104:            (cond ((= buttons mouse-left)
        !           105:                   y)
        !           106:                  ((= buttons mouse-right)
        !           107:                   (+ y (- 2 (window-height))))
        !           108:                  ((= buttons mouse-center)
        !           109:                   (/ (+ 2 y y (- (window-height))) 2))
        !           110:                  (t
        !           111:                   0)))
        !           112:           (select-window old-window))
        !           113:          (same-window-p
        !           114:           (cond ((= buttons mouse-left)
        !           115:                  (sup-move-point-to-x-y x y))
        !           116:                 ((= buttons mouse-2left)
        !           117:                  (sup-move-point-to-x-y x y)
        !           118:                  (kill-word 1))
        !           119:                 ((= buttons mouse-3left)
        !           120:                  (sup-move-point-to-x-y x y)
        !           121:                  (save-excursion
        !           122:                    (copy-region-as-kill
        !           123:                     (point) (progn (forward-word 1) (point))))
        !           124:                  (setq this-command 'yank)
        !           125:                  )
        !           126:                 ((= buttons mouse-right)
        !           127:                  (push-mark)
        !           128:                  (sup-move-point-to-x-y x y)
        !           129:                  (exchange-point-and-mark))
        !           130:                 ((= buttons mouse-2right)
        !           131:                  (push-mark)
        !           132:                  (sup-move-point-to-x-y x y)
        !           133:                  (kill-region (mark) (point)))
        !           134:                 ((= buttons mouse-3right)
        !           135:                  (push-mark)
        !           136:                  (sup-move-point-to-x-y x y)
        !           137:                  (copy-region-as-kill (mark) (point))
        !           138:                  (setq this-command 'yank))
        !           139:                 ((= buttons mouse-center)
        !           140:                  (sup-move-point-to-x-y x y)
        !           141:                  (setq this-command 'yank)
        !           142:                  (yank))
        !           143:                 ((= buttons mouse-2center)
        !           144:                  (yank-pop 1))
        !           145:                 )
        !           146:           )
        !           147:          (in-minibuf-p
        !           148:           (cond ((= buttons mouse-right)
        !           149:                  (call-interactively 'eval-expression))
        !           150:                 ((= buttons mouse-left)
        !           151:                  (call-interactively 'execute-extended-command))
        !           152:                 ((= buttons mouse-center)
        !           153:                  (describe-function 'sup-mouse-report)); silly self help 
        !           154:                 ))
        !           155:          (t                            ;in another window
        !           156:           (select-window window)
        !           157:           (cond ((not sup-mouse-fast-select-window))
        !           158:                 ((= buttons mouse-left)
        !           159:                  (sup-move-point-to-x-y x y))
        !           160:                 ((= buttons mouse-right)
        !           161:                  (push-mark)
        !           162:                  (sup-move-point-to-x-y x y)
        !           163:                  (exchange-point-and-mark))
        !           164:                 ((= buttons mouse-center)
        !           165:                  (sup-move-point-to-x-y x y)
        !           166:                  (setq this-command 'yank)
        !           167:                  (yank))
        !           168:                 ))
        !           169:          )))
        !           170: 
        !           171: 
        !           172: (defun sup-get-tty-num (term-char)
        !           173:   "Read from terminal until TERM-CHAR is read, and return intervening number.
        !           174: Upon non-numeric not matching TERM-CHAR signal an error."
        !           175:   (let
        !           176:       ((num 0)
        !           177:        (char (read-char)))
        !           178:     (while (and (>= char ?0)
        !           179:                (<= char ?9))
        !           180:       (setq num (+ (* num 10) (- char ?0)))
        !           181:       (setq char (read-char)))
        !           182:     (or (eq term-char char)
        !           183:        (error "Invalid data format in mouse command"))
        !           184:     num))
        !           185: 
        !           186: (defun sup-move-point-to-x-y (x y)
        !           187:   "Position cursor in window coordinates.
        !           188: X and Y are 0-based character positions in the window."
        !           189:   (move-to-window-line y)
        !           190:   (move-to-column x)
        !           191:   )
        !           192: 
        !           193: (defun sup-pos-to-window (x y)
        !           194:   "Find window corresponding to screen coordinates.
        !           195: X and Y are 0-based character positions on the screen."
        !           196:   (let ((edges (window-edges))
        !           197:        (window nil))
        !           198:     (while (and (not (eq window (selected-window)))
        !           199:                (or (<  y (nth 1 edges))
        !           200:                    (>= y (nth 3 edges))
        !           201:                    (<  x (nth 0 edges))
        !           202:                    (>= x (nth 2 edges))))
        !           203:       (setq window (next-window window))
        !           204:       (setq edges (window-edges window))
        !           205:       )
        !           206:     (or window (selected-window))
        !           207:     )
        !           208:   )

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