diff options
author | Jim Blandy <[email protected]> | 1991-12-20 07:15:37 +0000 |
---|---|---|
committer | Jim Blandy <[email protected]> | 1991-12-20 07:15:37 +0000 |
commit | cc0a8174baf4c25d69545fe5cd6cabddba6b1d2c (patch) | |
tree | 571d3cff4372149149e4ddd84e484f97e3ab846f /lisp | |
parent | 6367dc09a13bb1944db02f9f76ab25e4ccb159d6 (diff) |
*** empty log message ***
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/mouse.el | 392 | ||||
-rw-r--r-- | lisp/term/news.el | 100 |
2 files changed, 197 insertions, 295 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el index 533731290e..2fa8cecf9e 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1,170 +1,95 @@ -;; Mouse support that is independent of window systems. -;; Copyright (C) 1988 Free Software Foundation, Inc. +;;; Window system-independent mouse support. +;;; Copyright (C) 1988 Free Software Foundation, Inc. -;; This file is part of GNU Emacs. +;;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 1, or (at your option) +;;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. (provide 'mouse) -(defun mouse-select () - "Select the Emacs window the mouse is on." - (interactive "@")) +;;; Utility functions. -(defun mouse-delete-window () - "Delete the Emacs window the mouse is on." - (interactive "@") - (delete-window)) +(defun mouse-movement-p (event) + (and (consp event) + (eq (car event) 'mouse-movement))) -(defun mouse-keep-one-window () - "Select Emacs window mouse is on, then kill all other Emacs windows." - (interactive "@") - (delete-other-windows)) +(defun event-window (event) (nth 1 event)) +(defun event-point (event) (nth 2 event)) +(defun mouse-coords (event) (nth 3 event)) +(defun mouse-timestamp (event) (nth 4 event)) -(defun mouse-select-and-split () - "Select Emacs window mouse is on, then split it vertically in half." - (interactive "@") - (split-window-vertically nil)) +;;; Indent track-mouse like progn. +(put 'track-mouse 'lisp-indent-function 0) -(defun mouse-set-point (event) - "Select Emacs window mouse is on, and move point to mouse position." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - ;; Note that hscroll must get above 1 - ;; before the text actually starts to move. - (move-to-column (+ (car relative-coordinate) (current-column) - (1- (max 1 (window-hscroll (selected-window)))))) - (what-line))))) - -(defun mouse-eval-last-sexpr (event) - (interactive "@e") - (save-excursion - (mouse-set-point event) - (eval-last-sexp nil))) + +(defun mouse-delete-window (click) + "Delete the window clicked on. +This must be bound to a mouse click." + (interactive "K") + (delete-window (event-window click))) + +(defun mouse-delete-other-windows (click) + "Select Emacs window clicked on, then kill all other Emacs windows. +This must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) + (delete-other-windows)) -(defun mouse-line-length (event) - "Print the length of the line indicated by the pointer." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (save-excursion - (move-to-window-line (car (cdr relative-coordinate))) - (end-of-line) - (push-mark nil t) - (beginning-of-line) - (message "Line length: %d" - (- (region-end) (region-beginning))) - (sleep-for 1))))) - -(defun mouse-set-mark (event) - "Select Emacs window mouse is on, and set mark at mouse position. -Display cursor at that position for a second." - (interactive "@e") +(defun mouse-split-window-vertically (click) + "Select Emacs window mouse is on, then split it vertically in half. +The window is split at the line clicked on. +This command must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) + (split-window-vertically (1+ (cdr (mouse-coords click))))) + +(defun mouse-set-point (click) + "Move point to the position clicked on with the mouse. +This must be bound to a mouse click." + (interactive "K") + (select-window (event-window click)) + (goto-char (event-point click))) + +(defun mouse-set-mark (click) + "Set mark at the position clicked on with the mouse. +Display cursor at that position for a second. +This must be bound to a mouse click." + (interactive "K") (let ((point-save (point))) (unwind-protect - (progn (mouse-set-point event) + (progn (mouse-set-point click) (push-mark nil t) (sit-for 1)) (goto-char point-save)))) -(defun mouse-fill-paragraph (event) - "Fill the paragraph at the mouse position." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (fill-paragraph))) - -(defun mouse-fill-paragraph-with-prefix (event) - "Fill the paragraph at the mouse position with specified fill prefix. -Click at the end of the fill prefix that you want; -The text before the mouse position, on the same line, is used as the prefix." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (let ((fill-prefix (buffer-substring (save-excursion (beginning-of-line) - (point)) - (point)))) - (fill-paragraph)))) - -(defun mouse-scroll (event) - "Scroll point to the mouse position." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (recenter (car (cdr relative-coordinate))) - (scroll-right (+ (car relative-coordinate) (current-column))))))) - -(defun mouse-del-char (event) - "Delete the char pointed to by the mouse." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - (move-to-column (+ (car relative-coordinate) (current-column))) - (delete-char 1 nil))))) +(defun mouse-kill (click) + "Kill the region between point and the mouse click. +The text is saved in the kill ring, as with \\[kill-region]." + (interactive "K") + (mouse-set-mark click) + (kill-region)) -(defun mouse-kill-line (event) - "Kill the line pointed to by the mouse." - (interactive "@e") - (let ((relative-coordinate - (coordinates-in-window-p (car event) (selected-window)))) - (if (consp relative-coordinate) - (progn - (move-to-window-line (car (cdr relative-coordinate))) - (move-to-column (+ (car relative-coordinate) (current-column))) - (kill-line nil))))) +(defun mouse-kill-ring-save + "Copy the region between point and the mouse click in the kill ring. +This does not delete the region; it acts like \\[kill-ring-save]." + (interactive "K") + (mouse-set-mark click) + (kill-ring-save)) -(defun narrow-window-to-region (m n) - "Narrow window to region between point and last mark" - (interactive "r") - (save-excursion - (save-restriction - (if (eq (selected-window) (next-window)) - (split-window)) - (goto-char m) - (recenter 0) - (if (eq (selected-window) - (if (zerop (minibuffer-depth)) - (next-window))) - () - (shrink-window (- (- (window-height) (count-lines m n)) 1)))))) - -(defun mouse-window-to-region (event) - "Narrow window to region between cursor and mouse pointer." - (interactive "@e") - (let ((point-save (point))) - (unwind-protect - (progn (mouse-set-point event) - (push-mark nil t) - (sit-for 1)) - (goto-char point-save) - (narrow-window-to-region (region-beginning) (region-end))))) -(defun mouse-ignore () - "Don't do anything." - (interactive)) ;; Commands for the scroll bar. @@ -231,77 +156,77 @@ The text before the mouse position, on the same line, is used as the prefix." ;; Set up these commands, including the prefix keys for the scroll bar. -(fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-scroll-bar-prefix - 'mouse-vertical-scroll-bar-prefix) - -(defun mouse-scroll-motion (event) - (interactive "e") - (let ((pos (car (car event))) - (length (car (cdr (car event))))) - (message "[%d %d]" pos length))) - -(let ((map (function mouse-vertical-scroll-bar-prefix))) - (define-key map mouse-button-right 'mouse-scroll-down) - (define-key map mouse-button-left 'mouse-scroll-up) - (define-key map mouse-button-middle 'mouse-scroll-absolute) - (define-key map mouse-motion 'x-horizontal-line)) - -;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap)) -;(define-key global-mouse-map mouse-vertical-slider-prefix -; 'mouse-vertical-slider-prefix) - -;(let ((map (function mouse-vertical-slider-prefix))) -; (define-key map mouse-button-right 'mouse-scroll-move-cursor) -; (define-key map mouse-button-left 'mouse-scroll-move-cursor) -; (define-key map mouse-button-middle 'mouse-scroll-move-cursor)) - -(fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-thumbup-prefix - 'mouse-vertical-thumbup-prefix) - -(let ((map (function mouse-vertical-thumbup-prefix))) - (define-key map mouse-button-right 'mouse-scroll-down-full) - (define-key map mouse-button-left 'mouse-scroll-down-full) - (define-key map mouse-button-middle 'mouse-scroll-down-full)) - -(fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-vertical-thumbdown-prefix - 'mouse-vertical-thumbdown-prefix) - -(let ((map (function mouse-vertical-thumbdown-prefix))) - (define-key map mouse-button-right 'mouse-scroll-up-full) - (define-key map mouse-button-left 'mouse-scroll-up-full) - (define-key map mouse-button-middle 'mouse-scroll-up-full)) - -;; Horizontal bar - -(fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-scroll-bar-prefix - 'mouse-horizontal-scroll-bar-prefix) - -(let ((map (function mouse-horizontal-scroll-bar-prefix))) - (define-key map mouse-button-right 'mouse-scroll-right) - (define-key map mouse-button-left 'mouse-scroll-left) - (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally)) - -(fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-thumbleft-prefix - 'mouse-horizontal-thumbleft-prefix) - -(let ((map (function mouse-horizontal-thumbleft-prefix))) - (define-key map mouse-button-right 'mouse-scroll-left-full) - (define-key map mouse-button-left 'mouse-scroll-left-full) - (define-key map mouse-button-middle 'mouse-scroll-left-full)) - -(fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap)) -(define-key global-mouse-map mouse-horizontal-thumbright-prefix - 'mouse-horizontal-thumbright-prefix) - -(let ((map (function mouse-horizontal-thumbright-prefix))) - (define-key map mouse-button-right 'mouse-scroll-right-full) - (define-key map mouse-button-left 'mouse-scroll-right-full) - (define-key map mouse-button-middle 'mouse-scroll-right-full)) +;;; (fset 'mouse-vertical-scroll-bar-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-scroll-bar-prefix +;;; 'mouse-vertical-scroll-bar-prefix) +;;; +;;; (defun mouse-scroll-motion (event) +;;; (interactive "e") +;;; (let ((pos (car (car event))) +;;; (length (car (cdr (car event))))) +;;; (message "[%d %d]" pos length))) +;;; +;;; (let ((map (function mouse-vertical-scroll-bar-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-down) +;;; (define-key map mouse-button-left 'mouse-scroll-up) +;;; (define-key map mouse-button-middle 'mouse-scroll-absolute) +;;; (define-key map mouse-motion 'x-horizontal-line)) +;;; +;;; ;(fset 'mouse-vertical-slider-prefix (make-sparse-keymap)) +;;; ;(define-key global-mouse-map mouse-vertical-slider-prefix +;;; ; 'mouse-vertical-slider-prefix) +;;; +;;; ;(let ((map (function mouse-vertical-slider-prefix))) +;;; ; (define-key map mouse-button-right 'mouse-scroll-move-cursor) +;;; ; (define-key map mouse-button-left 'mouse-scroll-move-cursor) +;;; ; (define-key map mouse-button-middle 'mouse-scroll-move-cursor)) +;;; +;;; (fset 'mouse-vertical-thumbup-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-thumbup-prefix +;;; 'mouse-vertical-thumbup-prefix) +;;; +;;; (let ((map (function mouse-vertical-thumbup-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-down-full) +;;; (define-key map mouse-button-left 'mouse-scroll-down-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-down-full)) +;;; +;;; (fset 'mouse-vertical-thumbdown-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-vertical-thumbdown-prefix +;;; 'mouse-vertical-thumbdown-prefix) +;;; +;;; (let ((map (function mouse-vertical-thumbdown-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-up-full) +;;; (define-key map mouse-button-left 'mouse-scroll-up-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-up-full)) +;;; +;;; ;; Horizontal bar +;;; +;;; (fset 'mouse-horizontal-scroll-bar-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-scroll-bar-prefix +;;; 'mouse-horizontal-scroll-bar-prefix) +;;; +;;; (let ((map (function mouse-horizontal-scroll-bar-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-right) +;;; (define-key map mouse-button-left 'mouse-scroll-left) +;;; (define-key map mouse-button-middle 'mouse-scroll-absolute-horizontally)) +;;; +;;; (fset 'mouse-horizontal-thumbleft-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-thumbleft-prefix +;;; 'mouse-horizontal-thumbleft-prefix) +;;; +;;; (let ((map (function mouse-horizontal-thumbleft-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-left-full) +;;; (define-key map mouse-button-left 'mouse-scroll-left-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-left-full)) +;;; +;;; (fset 'mouse-horizontal-thumbright-prefix (make-sparse-keymap)) +;;; (define-key global-mouse-map mouse-horizontal-thumbright-prefix +;;; 'mouse-horizontal-thumbright-prefix) +;;; +;;; (let ((map (function mouse-horizontal-thumbright-prefix))) +;;; (define-key map mouse-button-right 'mouse-scroll-right-full) +;;; (define-key map mouse-button-left 'mouse-scroll-right-full) +;;; (define-key map mouse-button-middle 'mouse-scroll-right-full)) ;;;; @@ -402,10 +327,10 @@ The text before the mouse position, on the same line, is used as the prefix." (x-erase-rectangle (selected-screen)) (setq last-line-drawn nil)))) -(defun test-x-rectangle () - (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) - (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) - (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) +;;; (defun test-x-rectangle () +;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) +;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) +;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) ;; ;; Here is how to do double clicking in lisp. About to change. @@ -433,10 +358,10 @@ The text before the mouse position, on the same line, is used as the prefix." (> (- (nth 4 event ) double-start) double-click-interval) (setq double-start nil))) -(defun x-test-doubleclick () - (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) - (define-key doubleclick-test-map mouse-button-left 'double-down) - (define-key doubleclick-test-map mouse-button-left-up 'double-up)) +;;; (defun x-test-doubleclick () +;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) +;;; (define-key doubleclick-test-map mouse-button-left 'double-down) +;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up)) ;; ;; This scrolls while button is depressed. Use preferable in scrollbar. @@ -467,12 +392,12 @@ The text before the mouse position, on the same line, is used as the prefix." (setq scrolled-lines 0) (sleep-for 1)) -(defun x-testing-scroll () - (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) - (define-key scrolling-map mouse-button-left 'incr-scroll-down) - (define-key scrolling-map mouse-button-right 'incr-scroll-up) - (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) - (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) +;;; (defun x-testing-scroll () +;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) +;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down) +;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up) +;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) +;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) ;; ;; Some playthings suitable for picture mode? They need work. @@ -522,3 +447,10 @@ The text before the mouse position, on the same line, is used as the prefix." (mouse-multiple-insert (- (car relative-coordinate) (current-column)) " ")) ((= (current-column) (car relative-coordinate)) (ding)))))) + + +;;; Bindings for mouse commands. + +(global-set-key [mouse-1] 'mouse-set-point) +(global-set-key [S-mouse-1] 'mouse-set-mark) +(global-set-key [mouse-3] 'mouse-delete-other-windows) diff --git a/lisp/term/news.el b/lisp/term/news.el index 16b79e291c..9a75500029 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -18,68 +18,38 @@ ;; file named COPYING. Among other things, the copyright notice ;; and this notice must be preserved on all copies. -;; This file effects a mapping from the raw escape sequences of various -;; keypad and function keys to the symbols used by emacs to represent -;; those keys. The mapping from key symbol to the function performed -;; when that key is pressed is handled keyboard-independently by the file -;; ../keypad.el. - -;; Note that his file is also used under X11. For this to work, the variable -;; names must not change from keyboard file to keyboard file, nor can the -;; structure of keypad-maps change. - -(require 'keypad) - -(defvar keypads nil - "Keypad and function keys keymap for Sony News machine.") - -(defvar keypad-maps nil - "A list of strings sent by the keypad and function keys on the Sony News. -There is an element for each unique prefix. Each element is of the form -(PREFIX map map ...), each map being (string . symbol).") - -(setq keypad-maps '(("\eO" - ("P" . function-1) - ("Q" . function-2) - ("R" . function-3) - ("S" . function-4) - ("T" . function-5) - ("U" . function-6) - ("V" . function-7) - ("W" . function-8) - ("X" . function-9) - ("Y" . function-10) - - ("m" . keypad-subtract) - ("k" . keypad-add) - ("l" . keypad-comma) - ("n" . keypad-period) - ("M" . keypad-enter) - - ("p" . keypad-0) - ("q" . keypad-1) - ("r" . keypad-2) - ("s" . keypad-3) - ("t" . keypad-4) - ("u" . keypad-5) - ("v" . keypad-6) - ("w" . keypad-7) - ("x" . keypad-8) - ("y" . keypad-9) - - ; These three strings are just made up. - ("a" . execute) ; enter - ("b" . select) ; nfer - ("c" . cancel)))) ; xfer - -(let ((pads keypad-maps)) - (while pads - (unwind-protect - (let* ((prefix (car (car pads))) - (stringmap (cdr (car pads))) - (padmap (if (lookup-key global-map prefix) - (error "Keymap entry for keypad prefix already exisists") - (make-sparse-keymap)))) - (define-key global-map prefix padmap) - (setup-terminal-keymap padmap stringmap)) - (setq pads (cdr pads))))) +;; This file places entries in function-key-map for the raw escape +;; sequences of various keypad and function keys, binding them to +;; their symbolic forms. + +(define-prefix-command 'news-fkey-prefix 'news-fkey-map) +(define-key function-key-map "\eO" 'news-fkey-prefix) + +(define-key news-fkey-map "P" [f1]) +(define-key news-fkey-map "Q" [f2]) +(define-key news-fkey-map "R" [f3]) +(define-key news-fkey-map "S" [f4]) +(define-key news-fkey-map "T" [f5]) +(define-key news-fkey-map "U" [f6]) +(define-key news-fkey-map "V" [f7]) +(define-key news-fkey-map "W" [f8]) +(define-key news-fkey-map "X" [f9]) +(define-key news-fkey-map "Y" [f10]) +(define-key news-fkey-map "m" [kp-subtract]) +(define-key news-fkey-map "k" [kp-add]) +(define-key news-fkey-map "l" [kp-separator]) +(define-key news-fkey-map "n" [kp-period]) +(define-key news-fkey-map "M" [kp-enter]) +(define-key news-fkey-map "p" [kp-0]) +(define-key news-fkey-map "q" [kp-1]) +(define-key news-fkey-map "r" [kp-2]) +(define-key news-fkey-map "s" [kp-3]) +(define-key news-fkey-map "t" [kp-4]) +(define-key news-fkey-map "u" [kp-5]) +(define-key news-fkey-map "v" [kp-6]) +(define-key news-fkey-map "w" [kp-7]) +(define-key news-fkey-map "x" [kp-8]) +(define-key news-fkey-map "y" [kp-9]) +(define-key news-fkey-map "a" [execute]) +(define-key news-fkey-map "b" [select]) +(define-key news-fkey-map "c" [cancel]) |