Return to x-mouse.el CVS log

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

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

1.1     ! root        1: ;; Mouse support for X window system.
        !             2: ;; Copyright (C) 1985 Richard M. Stallman.
        !             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: (defconst x-button-right (char-to-string 0))
        !            23: (defconst x-button-middle (char-to-string 1))
        !            24: (defconst x-button-left (char-to-string 2))
        !            25: 
        !            26: (defconst x-button-s-right (char-to-string 16))
        !            27: (defconst x-button-s-middle (char-to-string 17))
        !            28: (defconst x-button-s-left (char-to-string 18))
        !            29: 
        !            30: (defconst x-button-m-right (char-to-string 32))
        !            31: (defconst x-button-m-middle (char-to-string 33))
        !            32: (defconst x-button-m-left (char-to-string 34))
        !            33: 
        !            34: (defconst x-button-c-right (char-to-string 64))
        !            35: (defconst x-button-c-middle (char-to-string 65))
        !            36: (defconst x-button-c-left (char-to-string 66))
        !            37: 
        !            38: (defconst x-button-m-s-right (char-to-string 48))
        !            39: (defconst x-button-m-s-middle (char-to-string 49))
        !            40: (defconst x-button-m-s-left (char-to-string 50))
        !            41: 
        !            42: (defconst x-button-c-s-right (char-to-string 80))
        !            43: (defconst x-button-c-s-middle (char-to-string 81))
        !            44: (defconst x-button-c-s-left (char-to-string 82))
        !            45: 
        !            46: (defconst x-button-c-m-right (char-to-string 96))
        !            47: (defconst x-button-c-m-middle (char-to-string 97))
        !            48: (defconst x-button-c-m-left (char-to-string 98))
        !            49: 
        !            50: (defconst x-button-c-m-s-right (char-to-string 112))
        !            51: (defconst x-button-c-m-s-middle (char-to-string 113))
        !            52: (defconst x-button-c-m-s-left (char-to-string 114))
        !            53: 
        !            54: (defun x-flush-mouse-queue () 
        !            55:   "Process all queued mouse events."
        !            56:   ;; A mouse event causes a special character sequence to be given
        !            57:   ;; as keyboard input.  That runs this function, which process all
        !            58:   ;; queued mouse events and returns.
        !            59:   (interactive)
        !            60:   (while (> (x-mouse-events) 0)
        !            61:     (x-proc-mouse-event)))
        !            62: 
        !            63: (define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)
        !            64: 
        !            65: (defun x-mouse-select (arg)
        !            66:   "Select Emacs window the mouse is on."
        !            67:   (let ((start-w (selected-window))
        !            68:        (done nil)
        !            69:        (w (selected-window))
        !            70:        (rel-coordinate nil))
        !            71:     (while (and (not done)
        !            72:                (null (setq rel-coordinate
        !            73:                            (coordinates-in-window-p arg w))))
        !            74:       (setq w (next-window w))
        !            75:       (if (eq w start-w)
        !            76:          (setq done t)))
        !            77:     (select-window w)
        !            78:     rel-coordinate))
        !            79: 
        !            80: (defun x-mouse-keep-one-window (arg)
        !            81:   "Select Emacs window mouse is on, then kill all other Emacs windows."
        !            82:   (if (x-mouse-select arg)
        !            83:       (delete-other-windows)))
        !            84: 
        !            85: (defun x-mouse-select-and-split (arg)
        !            86:   "Select Emacs window mouse is on, then split it vertically in half."
        !            87:   (if (x-mouse-select arg)
        !            88:       (split-window-vertically nil)))
        !            89: 
        !            90: (defun x-mouse-set-point (arg)
        !            91:   "Select Emacs window mouse is on, and move point to mouse position."
        !            92:   (let* ((relative-coordinate (x-mouse-select arg))
        !            93:         (rel-x (car relative-coordinate))
        !            94:         (rel-y (car (cdr relative-coordinate))))
        !            95:     (if relative-coordinate
        !            96:        (progn
        !            97:          (move-to-window-line rel-y)
        !            98:          (move-to-column (+ rel-x (current-column)))))))
        !            99: 
        !           100: (defun x-mouse-set-mark (arg)
        !           101:   "Select Emacs window mouse is on, and set mark at mouse position.
        !           102: Display cursor at that position for a second."
        !           103:   (if (x-mouse-select arg)
        !           104:       (let ((point-save (point)))
        !           105:        (unwind-protect
        !           106:            (progn (x-mouse-set-point arg)
        !           107:                   (set-mark (point))
        !           108:                   (sit-for 1))
        !           109:          (goto-char point-save)))))
        !           110: 
        !           111: (defun x-cut-text (arg &optional kill)
        !           112:   "Copy text between point and mouse position into window system cut buffer.
        !           113: Save in Emacs kill ring also."
        !           114:   (if (coordinates-in-window-p arg (selected-window))
        !           115:       (save-excursion
        !           116:        (let ((opoint (point))
        !           117:              beg end)
        !           118:          (x-mouse-set-point arg)
        !           119:          (setq beg (min opoint (point))
        !           120:                end (max opoint (point)))
        !           121:          (x-store-cut-buffer (buffer-substring beg end))
        !           122:          (copy-region-as-kill beg end)
        !           123:          (if kill (delete-region beg end))))
        !           124:     (message "Mouse not in selected window")))
        !           125: 
        !           126: (defun x-paste-text (arg)
        !           127:   "Move point to mouse position and insert window system cut buffer contents."
        !           128:   (x-mouse-set-point arg)
        !           129:   (insert (x-get-cut-buffer)))
        !           130: 
        !           131: (defun x-cut-and-wipe-text (arg)
        !           132:   "Kill text between point and mouse; also copy to window system cut buffer."
        !           133:   (x-cut-text arg t))
        !           134: 
        !           135: (define-key mouse-map x-button-right 'x-mouse-select)
        !           136: (define-key mouse-map x-button-left 'x-mouse-set-mark)
        !           137: (define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)
        !           138: (define-key mouse-map x-button-c-right 'x-mouse-select-and-split)
        !           139: (define-key mouse-map x-button-middle 'x-mouse-set-point)
        !           140: (define-key mouse-map x-button-s-middle 'x-cut-text)
        !           141: (define-key mouse-map x-button-s-right 'x-paste-text)
        !           142: (define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)

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