Return to x-mouse.el CVS log

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

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