Return to x-mouse.el CVS log

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

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

1.1     ! root        1: ;; Mouse support for X window system.
        !             2: ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
        !             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: (provide 'x-mouse)
        !            23: 
        !            24: (defconst x-button-right (char-to-string 0))
        !            25: (defconst x-button-middle (char-to-string 1))
        !            26: (defconst x-button-left (char-to-string 2))
        !            27: 
        !            28: (defconst x-button-right-up (char-to-string 4))
        !            29: (defconst x-button-middle-up (char-to-string 5))
        !            30: (defconst x-button-left-up (char-to-string 6))
        !            31: 
        !            32: (defconst x-button-s-right (char-to-string 16))
        !            33: (defconst x-button-s-middle (char-to-string 17))
        !            34: (defconst x-button-s-left (char-to-string 18))
        !            35: 
        !            36: (defconst x-button-s-right-up (char-to-string 20))
        !            37: (defconst x-button-s-middle-up (char-to-string 21))
        !            38: (defconst x-button-s-left-up (char-to-string 22))
        !            39: 
        !            40: (defconst x-button-m-right (char-to-string 32))
        !            41: (defconst x-button-m-middle (char-to-string 33))
        !            42: (defconst x-button-m-left (char-to-string 34))
        !            43: 
        !            44: (defconst x-button-m-right-up (char-to-string 36))
        !            45: (defconst x-button-m-middle-up (char-to-string 37))
        !            46: (defconst x-button-m-left-up (char-to-string 38))
        !            47: 
        !            48: (defconst x-button-c-right (char-to-string 64))
        !            49: (defconst x-button-c-middle (char-to-string 65))
        !            50: (defconst x-button-c-left (char-to-string 66))
        !            51: 
        !            52: (defconst x-button-c-right-up (char-to-string 68))
        !            53: (defconst x-button-c-middle-up (char-to-string 69))
        !            54: (defconst x-button-c-left-up (char-to-string 70))
        !            55: 
        !            56: (defconst x-button-m-s-right (char-to-string 48))
        !            57: (defconst x-button-m-s-middle (char-to-string 49))
        !            58: (defconst x-button-m-s-left (char-to-string 50))
        !            59: 
        !            60: (defconst x-button-m-s-right-up (char-to-string 52))
        !            61: (defconst x-button-m-s-middle-up (char-to-string 53))
        !            62: (defconst x-button-m-s-left-up (char-to-string 54))
        !            63: 
        !            64: (defconst x-button-c-s-right (char-to-string 80))
        !            65: (defconst x-button-c-s-middle (char-to-string 81))
        !            66: (defconst x-button-c-s-left (char-to-string 82))
        !            67: 
        !            68: (defconst x-button-c-s-right-up (char-to-string 84))
        !            69: (defconst x-button-c-s-middle-up (char-to-string 85))
        !            70: (defconst x-button-c-s-left-up (char-to-string 86))
        !            71: 
        !            72: (defconst x-button-c-m-right (char-to-string 96))
        !            73: (defconst x-button-c-m-middle (char-to-string 97))
        !            74: (defconst x-button-c-m-left (char-to-string 98))
        !            75: 
        !            76: (defconst x-button-c-m-right-up (char-to-string 100))
        !            77: (defconst x-button-c-m-middle-up (char-to-string 101))
        !            78: (defconst x-button-c-m-left-up (char-to-string 102))
        !            79: 
        !            80: (defconst x-button-c-m-s-right (char-to-string 112))
        !            81: (defconst x-button-c-m-s-middle (char-to-string 113))
        !            82: (defconst x-button-c-m-s-left (char-to-string 114))
        !            83: 
        !            84: (defconst x-button-c-m-s-right-up (char-to-string 116))
        !            85: (defconst x-button-c-m-s-middle-up (char-to-string 117))
        !            86: (defconst x-button-c-m-s-left-up (char-to-string 118))
        !            87: 
        !            88: (defvar x-process-mouse-hook nil
        !            89:   "Hook to run after each mouse event is processed.  Should take two
        !            90: arguments; the first being a list (XPOS YPOS) corresponding to character
        !            91: offset from top left of screen and the second being a specifier for the
        !            92: buttons/keys.
        !            93: 
        !            94: This will normally be set on a per-buffer basis.")
        !            95: 
        !            96: (defun x-flush-mouse-queue () 
        !            97:   "Process all queued mouse events."
        !            98:   ;; A mouse event causes a special character sequence to be given
        !            99:   ;; as keyboard input.  That runs this function, which process all
        !           100:   ;; queued mouse events and returns.
        !           101:   (interactive)
        !           102:   (while (> (x-mouse-events) 0)
        !           103:     (x-proc-mouse-event)
        !           104:     (and (boundp 'x-process-mouse-hook)
        !           105:         (symbol-value 'x-process-mouse-hook)
        !           106:         (funcall x-process-mouse-hook x-mouse-pos x-mouse-item))))
        !           107: 
        !           108: (define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)
        !           109: (define-key global-map "\C-x\C-@" 'x-flush-mouse-queue)
        !           110: 
        !           111: (defun x-mouse-select (arg)
        !           112:   "Select Emacs window the mouse is on."
        !           113:   (let ((start-w (selected-window))
        !           114:        (done nil)
        !           115:        (w (selected-window))
        !           116:        (rel-coordinate nil))
        !           117:     (while (and (not done)
        !           118:                (null (setq rel-coordinate
        !           119:                            (coordinates-in-window-p arg w))))
        !           120:       (setq w (next-window w))
        !           121:       (if (eq w start-w)
        !           122:          (setq done t)))
        !           123:     (select-window w)
        !           124:     rel-coordinate))
        !           125: 
        !           126: (defun x-mouse-keep-one-window (arg)
        !           127:   "Select Emacs window mouse is on, then kill all other Emacs windows."
        !           128:   (if (x-mouse-select arg)
        !           129:       (delete-other-windows)))
        !           130: 
        !           131: (defun x-mouse-select-and-split (arg)
        !           132:   "Select Emacs window mouse is on, then split it vertically in half."
        !           133:   (if (x-mouse-select arg)
        !           134:       (split-window-vertically nil)))
        !           135: 
        !           136: (defun x-mouse-set-point (arg)
        !           137:   "Select Emacs window mouse is on, and move point to mouse position."
        !           138:   (let* ((relative-coordinate (x-mouse-select arg))
        !           139:         (rel-x (car relative-coordinate))
        !           140:         (rel-y (car (cdr relative-coordinate))))
        !           141:     (if relative-coordinate
        !           142:        (progn
        !           143:          (move-to-window-line rel-y)
        !           144:          (move-to-column (+ rel-x (current-column)))))))
        !           145: 
        !           146: (defun x-mouse-set-mark (arg)
        !           147:   "Select Emacs window mouse is on, and set mark at mouse position.
        !           148: Display cursor at that position for a second."
        !           149:   (if (x-mouse-select arg)
        !           150:       (let ((point-save (point)))
        !           151:        (unwind-protect
        !           152:            (progn (x-mouse-set-point arg)
        !           153:                   (push-mark nil t)
        !           154:                   (sit-for 1))
        !           155:          (goto-char point-save)))))
        !           156: 
        !           157: (defun x-cut-text (arg &optional kill)
        !           158:   "Copy text between point and mouse position into window system cut buffer.
        !           159: Save in Emacs kill ring also."
        !           160:   (if (coordinates-in-window-p arg (selected-window))
        !           161:       (save-excursion
        !           162:        (let ((opoint (point))
        !           163:              beg end)
        !           164:          (x-mouse-set-point arg)
        !           165:          (setq beg (min opoint (point))
        !           166:                end (max opoint (point)))
        !           167:          (x-store-cut-buffer (buffer-substring beg end))
        !           168:          (copy-region-as-kill beg end)
        !           169:          (if kill (delete-region beg end))))
        !           170:     (message "Mouse not in selected window")))
        !           171: 
        !           172: (defun x-paste-text (arg)
        !           173:   "Move point to mouse position and insert window system cut buffer contents."
        !           174:   (x-mouse-set-point arg)
        !           175:   (insert (x-get-cut-buffer)))
        !           176: 
        !           177: (defun x-cut-and-wipe-text (arg)
        !           178:   "Kill text between point and mouse; also copy to window system cut buffer."
        !           179:   (x-cut-text arg t))
        !           180: 
        !           181: (defun x-mouse-ignore (arg)
        !           182:   "Don't do anything.")
        !           183: 
        !           184: (defun x-buffer-menu (arg)
        !           185:   "Pop up a menu of buffers for selection with the mouse."
        !           186:   (let ((menu
        !           187:         (list "Buffer Menu"
        !           188:               (cons "Select Buffer"
        !           189:                     (let ((tail (buffer-list))
        !           190:                           head)
        !           191:                       (while tail
        !           192:                         (let ((elt (car tail)))
        !           193:                           (if (not (string-match "^ "
        !           194:                                                  (buffer-name elt)))
        !           195:                               (setq head (cons
        !           196:                                           (cons
        !           197:                                            (format
        !           198:                                             "%14s   %s"
        !           199:                                             (buffer-name elt)
        !           200:                                             (or (buffer-file-name elt) ""))
        !           201:                                            elt)
        !           202:                                           head))))
        !           203:                         (setq tail (cdr tail)))
        !           204:                       (reverse head))))))
        !           205:     (switch-to-buffer (or (x-popup-menu arg menu) (current-buffer)))))
        !           206: 
        !           207: (defun x-help (arg)
        !           208:   "Enter a menu-based help system."
        !           209:   (let ((selection
        !           210:         (x-popup-menu
        !           211:          arg
        !           212:          '("Help" ("Is there a command that..."
        !           213:                    ("Command apropos" . command-apropos)
        !           214:                    ("Apropos" . apropos))
        !           215:                   ("Key Commands <==> Functions"
        !           216:                    ("List all keystroke commands" . describe-bindings)
        !           217:                    ("Describe key briefly" . describe-key-briefly)
        !           218:                    ("Describe key verbose" . describe-key)
        !           219:                    ("Describe Lisp function" . describe-function)
        !           220:                    ("Where is this command" . where-is))
        !           221:                   ("Manual and tutorial"
        !           222:                    ("Info system" . info)
        !           223:                    ("Invoke Emacs tutorial" . help-with-tutorial))
        !           224:                   ("Odds and ends"
        !           225:                    ("Last 100 Keystrokes" . view-lossage)
        !           226:                    ("Describe syntax table" . describe-syntax))
        !           227:                   ("Modes"
        !           228:                    ("Describe current major mode" . describe-mode)
        !           229:                    ("List all keystroke commands" . describe-bindings))
        !           230:                   ("Administrivia"
        !           231:                    ("View Emacs news" . view-emacs-news)
        !           232:                    ("View the GNU Emacs license" . describe-copying)
        !           233:                    ("Describe distribution" . describe-distribution)
        !           234:                    ("Describe (non)warranty" . describe-no-warranty))))))
        !           235:     (and selection (call-interactively selection))))
        !           236: 
        !           237: ; Prevent beeps on button-up.  If the button isn't bound to anything, it
        !           238: ; will beep on button-down.
        !           239: (define-key mouse-map x-button-right-up 'x-mouse-ignore)
        !           240: (define-key mouse-map x-button-middle-up 'x-mouse-ignore)
        !           241: (define-key mouse-map x-button-left-up 'x-mouse-ignore)
        !           242: (define-key mouse-map x-button-s-right-up 'x-mouse-ignore)
        !           243: (define-key mouse-map x-button-s-middle-up 'x-mouse-ignore)
        !           244: (define-key mouse-map x-button-s-left-up 'x-mouse-ignore)
        !           245: (define-key mouse-map x-button-m-right-up 'x-mouse-ignore)
        !           246: (define-key mouse-map x-button-m-middle-up 'x-mouse-ignore)
        !           247: (define-key mouse-map x-button-m-left-up 'x-mouse-ignore)
        !           248: (define-key mouse-map x-button-c-right-up 'x-mouse-ignore)
        !           249: (define-key mouse-map x-button-c-middle-up 'x-mouse-ignore)
        !           250: (define-key mouse-map x-button-c-left-up 'x-mouse-ignore)
        !           251: (define-key mouse-map x-button-m-s-right-up 'x-mouse-ignore)
        !           252: (define-key mouse-map x-button-m-s-middle-up 'x-mouse-ignore)
        !           253: (define-key mouse-map x-button-m-s-left-up 'x-mouse-ignore)
        !           254: (define-key mouse-map x-button-c-s-right-up 'x-mouse-ignore)
        !           255: (define-key mouse-map x-button-c-s-middle-up 'x-mouse-ignore)
        !           256: (define-key mouse-map x-button-c-s-left-up 'x-mouse-ignore)
        !           257: (define-key mouse-map x-button-c-m-right-up 'x-mouse-ignore)
        !           258: (define-key mouse-map x-button-c-m-middle-up 'x-mouse-ignore)
        !           259: (define-key mouse-map x-button-c-m-left-up 'x-mouse-ignore)
        !           260: (define-key mouse-map x-button-c-m-s-right-up 'x-mouse-ignore)
        !           261: (define-key mouse-map x-button-c-m-s-middle-up 'x-mouse-ignore)
        !           262: (define-key mouse-map x-button-c-m-s-left-up 'x-mouse-ignore)
        !           263: 
        !           264: (define-key mouse-map x-button-c-s-left 'x-buffer-menu)
        !           265: (define-key mouse-map x-button-c-s-middle 'x-help)
        !           266: (define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)
        !           267: (define-key mouse-map x-button-s-middle 'x-cut-text)
        !           268: (define-key mouse-map x-button-s-right 'x-paste-text)
        !           269: (define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)
        !           270: (define-key mouse-map x-button-c-right 'x-mouse-select-and-split)
        !           271: 
        !           272: (if (= window-system-version 10)
        !           273:     (progn
        !           274:       (define-key mouse-map x-button-right 'x-mouse-select)
        !           275:       (define-key mouse-map x-button-left 'x-mouse-set-mark)
        !           276:       (define-key mouse-map x-button-middle 'x-mouse-set-point))
        !           277:   (define-key mouse-map x-button-right 'x-cut-text)
        !           278:   (define-key mouse-map x-button-left 'x-mouse-set-point)
        !           279:   (define-key mouse-map x-button-middle 'x-paste-text))

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