Return to bg-mouse.el CVS log

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

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

1.1     ! root        1: ;; GNU Emacs code for BBN Bitgraph mouse.
        !             2: ;; Copyright (C) Free Software Foundation, Inc. Oct 1985.
        !             3: ;; Time stamp <89/03/21 14:27:08 gildea>
        !             4: 
        !             5: ;; This file is part of GNU Emacs.
        !             6: 
        !             7: ;; GNU Emacs is distributed in the hope that it will be useful,
        !             8: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !             9: ;; accepts responsibility to anyone for the consequences of using it
        !            10: ;; or for whether it serves any particular purpose or works at all,
        !            11: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            12: ;; License for full details.
        !            13: 
        !            14: ;; Everyone is granted permission to copy, modify and redistribute
        !            15: ;; GNU Emacs, but only under the conditions described in the
        !            16: ;; GNU Emacs General Public License.   A copy of this license is
        !            17: ;; supposed to have been given to you along with GNU Emacs so you
        !            18: ;; can know your rights and responsibilities.  It should be in a
        !            19: ;; file named COPYING.  Among other things, the copyright notice
        !            20: ;; and this notice must be preserved on all copies.
        !            21: 
        !            22: 
        !            23: ;;;  Original version by John Robinson ([email protected], bbncca!jr), Oct 1985
        !            24: ;;;  Modularized and enhanced by [email protected] Nov 1987
        !            25: 
        !            26: (provide 'bg-mouse)
        !            27: 
        !            28: ;;;  User customization option:
        !            29: 
        !            30: (defvar bg-mouse-fast-select-window nil
        !            31:   "*Non-nil for mouse hits to select new window, then execute; else just select.")
        !            32: 
        !            33: ;;; These numbers are summed to make the index into the mouse-map.
        !            34: ;;; The low three bits correspond to what the mouse actually sends.
        !            35: (defconst bg-button-r 1)
        !            36: (defconst bg-button-m 2)
        !            37: (defconst bg-button-c 2)
        !            38: (defconst bg-button-l 4)
        !            39: (defconst bg-in-modeline 8)
        !            40: (defconst bg-in-scrollbar 16)
        !            41: (defconst bg-in-minibuf 24)
        !            42: 
        !            43: ;;; semicolon screws up indenting, so use this instead
        !            44: (defconst semicolon ?\;)
        !            45: 
        !            46: ;;;  Defuns:
        !            47: 
        !            48: (defun bg-mouse-report (prefix-arg)
        !            49:   "Read, parse, and execute a BBN BitGraph mouse click.
        !            50: 
        !            51: L-- move point             | These apply for mouse click in a window.
        !            52: --R set mark               | If bg-mouse-fast-select-window is nil,
        !            53: L-R kill region            | these commands on a nonselected window
        !            54: -C- move point and yank    | just select that window.
        !            55: LC- yank-pop              |
        !            56: -CR or LCR undo                   | \"Scroll bar\" is right-hand window column.
        !            57: 
        !            58: on modeline:               on \"scroll bar\":  in minibuffer:
        !            59: L-- scroll-up              line to top         execute-extended-command
        !            60: --R scroll-down                    line to bottom      eval-expression
        !            61: -C- proportional goto-char  line to middle     suspend-emacs
        !            62: 
        !            63: To reinitialize the mouse if the terminal is reset, type ESC : RET"
        !            64:   (interactive "P")
        !            65:   (bg-get-tty-num semicolon)
        !            66:   (let*
        !            67:       ((screen-mouse-x (min (1- (screen-width))        ;don't hit column 86!
        !            68:                            (/ (bg-get-tty-num semicolon) 9)))
        !            69:        (screen-mouse-y (- (1- (screen-height)) ;assume default font size.
        !            70:                          (/ (bg-get-tty-num semicolon) 16))) 
        !            71:        (bg-mouse-buttons (% (bg-get-tty-num ?c) 8))
        !            72:        (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y))
        !            73:        (bg-cursor-window (selected-window))
        !            74:        (edges (window-edges bg-mouse-window))
        !            75:        (minibuf-p (= screen-mouse-y (1- (screen-height))))
        !            76:        (in-modeline-p (and (not minibuf-p)
        !            77:                           (= screen-mouse-y (1- (nth 3 edges)))))
        !            78:        (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p)
        !            79:                            (>= screen-mouse-x (1- (nth 2 edges)))))
        !            80:        (same-window-p (eq bg-mouse-window bg-cursor-window))
        !            81:        (in-minibuf-p (and minibuf-p
        !            82:                          (not bg-mouse-window))) ;minibuf must be inactive
        !            83:        (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0)
        !            84:                        (if in-modeline-p bg-in-modeline 0)
        !            85:                        (if in-scrollbar-p bg-in-scrollbar 0)))
        !            86:        (bg-command
        !            87:         (lookup-key mouse-map
        !            88:                     (char-to-string (+ bg-mode-bits bg-mouse-buttons))))
        !            89:        (bg-mouse-x (- screen-mouse-x (nth 0 edges)))
        !            90:        (bg-mouse-y (- screen-mouse-y (nth 1 edges))))
        !            91:     (cond ((or in-modeline-p in-scrollbar-p)
        !            92:           (select-window bg-mouse-window)
        !            93:           (bg-command-execute bg-command)
        !            94:           (select-window bg-cursor-window))
        !            95:          ((or same-window-p in-minibuf-p)
        !            96:           (bg-command-execute bg-command))
        !            97:          (t                            ;in another window
        !            98:            (select-window bg-mouse-window)
        !            99:            (if bg-mouse-fast-select-window
        !           100:                (bg-command-execute bg-command)))
        !           101:          )))
        !           102: 
        !           103: 
        !           104: ;;; Library of commands:
        !           105: 
        !           106: (defun bg-set-point ()
        !           107:   "Move point to location of BitGraph mouse."
        !           108:   (interactive)
        !           109:   (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
        !           110:   (setq this-command 'next-line)       ;make subsequent line moves work
        !           111:   (setq temporary-goal-column bg-mouse-x))
        !           112: 
        !           113: (defun bg-set-mark ()
        !           114:   "Set mark at location of BitGraph mouse."
        !           115:   (interactive)
        !           116:   (push-mark)
        !           117:   (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
        !           118:   (exchange-point-and-mark))
        !           119: 
        !           120: (defun bg-yank ()
        !           121:   "Move point to location of BitGraph mouse and yank."
        !           122:   (interactive "*")
        !           123:   (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
        !           124:   (setq this-command 'yank)
        !           125:   (yank))
        !           126: 
        !           127: (defun yank-pop-1 ()
        !           128:   (interactive "*")
        !           129:   (yank-pop 1))
        !           130: 
        !           131: (defun bg-yank-or-pop ()
        !           132:   "Move point to location of BitGraph mouse and yank or yank-pop.
        !           133: Do a yank unless last command was a yank, in which case do a yank-pop."
        !           134:   (interactive "*")
        !           135:   (if (eql last-command 'yank)
        !           136:       (yank-pop 1)
        !           137:     (bg-yank)))
        !           138: 
        !           139: ;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum
        !           140: (defconst bg-most-positive-fixnum 8388607)
        !           141: 
        !           142: (defun bg-move-by-percentage ()
        !           143:   "Go to location in buffer that is the same percentage of the
        !           144: way through the buffer as the BitGraph mouse's X position in the window."
        !           145:   (interactive)
        !           146:   ;; check carefully for overflow in intermediate calculations
        !           147:   (goto-char
        !           148:    (cond ((zerop bg-mouse-x)
        !           149:          0)
        !           150:         ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x))
        !           151:          ;; no danger of overflow: compute it exactly
        !           152:          (/ (* bg-mouse-x (buffer-size))
        !           153:             (1- (window-width))))
        !           154:         (t
        !           155:          ;; overflow possible: approximate
        !           156:          (* (/ (buffer-size) (1- (window-width)))
        !           157:             bg-mouse-x))))
        !           158:   (beginning-of-line)
        !           159:   (what-cursor-position))
        !           160: 
        !           161: (defun bg-mouse-line-to-top ()
        !           162:   "Scroll the line pointed to by the BitGraph mouse to the top of the window."
        !           163:   (interactive)
        !           164:   (scroll-up bg-mouse-y))
        !           165: 
        !           166: (defun bg-mouse-line-to-center ()
        !           167:   "Scroll the line pointed to by the BitGraph mouse to the center 
        !           168: of the window"
        !           169:   (interactive)
        !           170:   (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2)))
        !           171: 
        !           172: (defun bg-mouse-line-to-bottom ()
        !           173:   "Scroll the line pointed to by the mouse to the bottom of the window."
        !           174:   (interactive)
        !           175:   (scroll-up (+ bg-mouse-y (- 2 (window-height)))))
        !           176: 
        !           177: (defun bg-kill-region ()
        !           178:   (interactive "*")
        !           179:   (kill-region (region-beginning) (region-end)))
        !           180: 
        !           181: (defun bg-insert-moused-sexp ()
        !           182:   "Insert a copy of the word (actually sexp) that the mouse is pointing at.
        !           183: Sexp is inserted into the buffer at point (where the text cursor is).
        !           184: By gildea 7 Feb 89"
        !           185:   (interactive)
        !           186:   (let ((moused-text
        !           187:          (save-excursion
        !           188:            (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
        !           189:            (forward-sexp 1)
        !           190:            (buffer-substring (save-excursion (backward-sexp 1) (point))
        !           191:                              (point)))))
        !           192:     (select-window bg-cursor-window)
        !           193:     (delete-horizontal-space)
        !           194:     (cond
        !           195:      ((bolp)
        !           196:       (indent-according-to-mode))
        !           197:      ;; In Lisp assume double-quote is closing; in Text assume opening.
        !           198:      ;; Why?  Because it does the right thing most often.
        !           199:      ((save-excursion (forward-char -1)
        !           200:                      (and (not (looking-at "\\s\""))
        !           201:                           (looking-at "[`'\"\\]\\|\\s(")))
        !           202:       nil)
        !           203:      (t
        !           204:       (insert-string " ")))
        !           205:     (insert-string moused-text)
        !           206:     (or (eolp)
        !           207:        (looking-at "\\s.\\|\\s)")
        !           208:        (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode
        !           209:        (save-excursion (insert-string " ")))))
        !           210: 
        !           211: ;;; Utility functions:
        !           212: 
        !           213: (defun bg-get-tty-num (term-char)
        !           214:   "Read from terminal until TERM-CHAR is read, and return intervening number.
        !           215: If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
        !           216:   (let
        !           217:       ((num 0)
        !           218:        (char (- (read-char) 48)))
        !           219:     (while (and (>= char 0)
        !           220:                (<= char 9))
        !           221:       (setq num (+ (* num 10) char))
        !           222:       (setq char (- (read-char) 48)))
        !           223:     (or (eq term-char (+ char 48))
        !           224:        (progn
        !           225:          (bg-program-mouse)
        !           226:          (error
        !           227:            "Invalid data format in bg-mouse command: mouse reinitialized.")))
        !           228:     num))
        !           229: 
        !           230: ;;; Note that this fails in the minibuf because move-to-column doesn't
        !           231: ;;; allow for the width of the prompt.
        !           232: (defun bg-move-point-to-x-y (x y)
        !           233:   "Position cursor in window coordinates.
        !           234: X and Y are 0-based character positions in the window."
        !           235:   (move-to-window-line y)
        !           236:   ;; if not on a wrapped line, zero-column will be 0
        !           237:   (let ((zero-column (current-column))
        !           238:        (scroll-offset (window-hscroll)))
        !           239:     ;; scrolling takes up column 0 to display the $
        !           240:     (if (> scroll-offset 0)
        !           241:        (setq scroll-offset (1- scroll-offset)))
        !           242:     (move-to-column (+ zero-column scroll-offset x))
        !           243:     ))
        !           244: 
        !           245: ;;; Returns the window that screen position (x, y) is in or nil if none,
        !           246: ;;; meaning we are in the echo area with a non-active minibuffer.
        !           247: ;;; If coordinates-in-window-p were not in an X-windows-specific file
        !           248: ;;; we could use that.  In Emacs 19 can even use locate-window-from-coordinates
        !           249: (defun bg-window-from-x-y (x y)
        !           250:   "Find window corresponding to screen coordinates.
        !           251: X and Y are 0-based character positions on the screen."
        !           252:   (let ((edges (window-edges))
        !           253:        (window nil))
        !           254:     (while (and (not (eq window (selected-window)))
        !           255:                (or (<  y (nth 1 edges))
        !           256:                    (>= y (nth 3 edges))
        !           257:                    (<  x (nth 0 edges))
        !           258:                    (>= x (nth 2 edges))))
        !           259:       (setq window (next-window window))
        !           260:       (setq edges (window-edges window)))
        !           261:     (cond ((eq window (selected-window))
        !           262:           nil)                         ;we've looped: not found
        !           263:          ((not window)
        !           264:           (selected-window))           ;just starting: current window
        !           265:          (t
        !           266:            window))
        !           267:     ))
        !           268: 
        !           269: (defun bg-command-execute (bg-command)
        !           270:   (if (commandp bg-command)
        !           271:       (command-execute bg-command)
        !           272:     (ding)))
        !           273: 
        !           274: (defun bg-program-mouse ()
        !           275:   (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
        !           276: 
        !           277: ;;; Note that the doc string for mouse-map (as defined in subr.el)
        !           278: ;;; says it is for the X-window mouse.  This is wrong; that keymap
        !           279: ;;; should be used for your mouse no matter what terminal you have.
        !           280: 
        !           281: (or (keymapp mouse-map)
        !           282:     (setq mouse-map (make-keymap)))
        !           283: 
        !           284: (defun bind-bg-mouse-click (click-code function)
        !           285:   "Bind bg-mouse CLICK-CODE to run FUNCTION."
        !           286:   (define-key mouse-map (char-to-string click-code) function))
        !           287: 
        !           288: (bind-bg-mouse-click bg-button-l 'bg-set-point) 
        !           289: (bind-bg-mouse-click bg-button-m 'bg-yank)
        !           290: (bind-bg-mouse-click bg-button-r 'bg-set-mark)
        !           291: (bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1)
        !           292: (bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region)
        !           293: (bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo)
        !           294: (bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo)
        !           295: (bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up)
        !           296: (bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage)
        !           297: (bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down)
        !           298: (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top)
        !           299: (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center)
        !           300: (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom)
        !           301: (bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command)
        !           302: (bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs)
        !           303: (bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression)
        !           304: 

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