Annotation of 43BSD/contrib/emacs/lisp/x-mouse.el, revision 1.1.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)

unix.superglobalmegacorp.com

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