Return to bg-mouse.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

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

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