changeset 621:29117767b6b8

[xemacs-hg @ 2001-06-19 07:00:09 by ben] removed sun-mouse.el sun.el internal.el
author ben
date Tue, 19 Jun 2001 07:00:10 +0000
parents 5af4f6f788c4
children 11502791fc1c
files lisp/term/internal.el lisp/term/sun-mouse.el lisp/term/sun.el
diffstat 3 files changed, 0 insertions(+), 1033 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/term/internal.el	Tue Jun 19 06:47:52 2001 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,81 +0,0 @@
-;; internal.el -- setup support for PC keyboards and screens, internal terminal
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder <terra@diku.dk>
-;; Version: 1,02
-
-;; 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 2, 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.
-
-;; 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.
-;; ---------------------------------------------------------------------------
-;; screen setup -- that's easy!
-(standard-display-8bit 127 254)
-;; ---------------------------------------------------------------------------
-;; keyboard setup -- that's simple!
-(set-input-mode nil nil 0)
-(define-key function-key-map [backspace] "\177") ; Normal behavior for BS
-(define-key function-key-map [delete] "\C-d")    ; ... and Delete
-(define-key function-key-map [tab] [?\t])
-(define-key function-key-map [linefeed] [?\n])
-(define-key function-key-map [clear] [11])
-(define-key function-key-map [return] [13])
-(define-key function-key-map [escape] [?\e])
-(define-key function-key-map [M-backspace] [?\M-\d])
-(define-key function-key-map [M-delete] [?\M-\d])
-(define-key function-key-map [M-tab] [?\M-\t])
-(define-key function-key-map [M-linefeed] [?\M-\n])
-(define-key function-key-map [M-clear] [?\M-\013])
-(define-key function-key-map [M-return] [?\M-\015])
-(define-key function-key-map [M-escape] [?\M-\e])
-
-;; ---------------------------------------------------------------------------
-;; We want to do this when Emacs is started because it depends on the
-;; country code.
-(let* ((i 128)
-      (modify (function
-	       (lambda (ch sy) 
-		 (modify-syntax-entry ch sy text-mode-syntax-table)
-		 (if (boundp 'tex-mode-syntax-table)
-		     (modify-syntax-entry ch sy tex-mode-syntax-table))
-		 (modify-syntax-entry ch sy (standard-syntax-table))
-		 )))
-      (table (standard-case-table))
-      ;; The following are strings of letters, first lower then upper case.
-      ;; This will look funny on terminals which display other code pages.
-      (chars
-       (cond
-	((= dos-codepage 850)
-	 "‡€š‚ƒķ„Ž…·†ÆĮ ĩˆŌ‰ÓŠÔ‹ØŒŨÞĄÖ‘’“â”™•ãĒā›–ęĢé—ë˜YėíĄIĢéĪĨÐŅįč")
-	((= dos-codepage 865)
-	 "‡€š‚ƒA„Ž…A†ˆE‰EŠE‹IŒII‘’“O”™•O–UĢU˜Y› AĄIĒOĢUĪĨ")
-	;; default is 437
-	(t "‡€š‚ƒA„Ž…A†ˆE‰EŠE‹IŒII‘’“O”™•O–UĢU˜Y AĄIĒOĢUĪĨ"))))
-
-  (while (< i 256)
-    (funcall modify i "_")
-    (setq i (1+ i)))
-
-  (setq i 0)
-  (while (< i (length chars))
-    (let ((ch1 (aref chars i))
-	  (ch2 (aref chars (1+ i))))
-      (if (> ch2 127)
-	  (set-case-syntax-pair ch2 ch1 table))
-      (setq i (+ i 2))))
-  (save-excursion
-    (mapcar (lambda (b) (set-buffer b) (set-case-table table))
-	    (buffer-list)))
-  (set-standard-case-table table))
--- a/lisp/term/sun-mouse.el	Tue Jun 19 06:47:52 2001 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,673 +0,0 @@
-;;; sun-mouse.el --- mouse handling for Sun windows
-
-;; Copyright (C) 1987, 1997 Free Software Foundation, Inc.
-
-;; Author: Jeff Peck
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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 2, or (at your option)
-;; any later version.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with:  Unknown
-
-;;; Commentary:
-
-;; Jeff Peck, Sun Microsystems, Jan 1987.
-;; Original idea by Stan Jefferson
-
-;;
-;;     Modelled after the GNUEMACS keymap interface.
-;;
-;; User Functions:
-;;   make-mousemap, copy-mousemap,
-;;   define-mouse, global-set-mouse, local-set-mouse,
-;;   use-global-mousemap, use-local-mousemap,
-;;   mouse-lookup, describe-mouse-bindings
-;;
-;; Options:
-;;   extra-click-wait, scrollbar-width
-;;
-
-;;; Code:
-
-(defvar extra-click-wait 150
-  "*Number of milliseconds to wait for an extra click.
-Set this to zero if you don't want chords or double clicks.")
-
-(defvar scrollbar-width 5
-  "*The character width of the scrollbar.
-The cursor is deemed to be in the right edge scrollbar if it is this near the
-right edge, and more than two chars past the end of the indicated line.
-Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
-
-;;;
-;;; Mousemaps
-;;;
-(defun make-mousemap ()
-  "Returns a new mousemap."
-  (cons 'mousemap nil))
-
-(defun copy-mousemap (mousemap)
-  "Return a copy of mousemap."
-  (copy-alist mousemap))
-
-(defun define-mouse (mousemap mouse-list def)
-  "Args MOUSEMAP, MOUSE-LIST, DEF.  Define MOUSE-LIST in MOUSEMAP as DEF.
-MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules:
-  * One of these atoms specifies the active region of the definition.
-	text, scrollbar, modeline, minibuffer
-  * One or two or these atoms specify the button or button combination.
-        left, middle, right, double
-  * Any combination of these atoms specify the active shift keys.
-        control, shift, meta
-  * With a single unshifted button, you can add
-	up
-    to indicate an up-click.
-The atom `double' is used with a button designator to denote a double click.
-Two button chords are denoted by listing the two buttons.
-See sun-mouse-handler for the treatment of the form DEF."
-  (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def))
-
-(defun global-set-mouse (mouse-list def)
-  "Give MOUSE-EVENT-LIST a local definition of DEF.
-See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
-Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
-that local definition will continue to shadow any global definition."
-  (interactive "xMouse event: \nxDefinition: ")
-  (define-mouse current-global-mousemap mouse-list def))
-
-(defun local-set-mouse (mouse-list def)
-  "Give MOUSE-EVENT-LIST a local definition of DEF.
-See define-mouse for a description of the arguments.
-The definition goes in the current buffer's local mousemap.
-Normally buffers in the same major mode share a local mousemap."
-  (interactive "xMouse event: \nxDefinition: ")
-  (if (null current-local-mousemap)
-      (setq current-local-mousemap (make-mousemap)))
-  (define-mouse current-local-mousemap mouse-list def))
-
-(defun use-global-mousemap (mousemap)
-  "Selects MOUSEMAP as the global mousemap."
-  (setq current-global-mousemap mousemap))
-
-(defun use-local-mousemap (mousemap)
-  "Selects MOUSEMAP as the local mousemap.
-nil for MOUSEMAP means no local mousemap."
-  (setq current-local-mousemap mousemap))
-
-
-;;;
-;;; Interface to the Mouse encoding defined in Emacstool.c
-;;;
-;;; Called when mouse-prefix is sent to emacs, additional
-;;; information is read in as a list (button x y time-delta)
-;;;
-;;; First, some generally useful functions:
-;;;
-
-(defun logtest (x y)
-  "True if any bits set in X are also set in Y.
-Just like the Common Lisp function of the same name."
-  (not (zerop (logand x y))))
-
-
-;;;
-;;; Hit accessors.
-;;;
-
-(defconst sm::ButtonBits 7)		; Lowest 3 bits.
-(defconst sm::ShiftmaskBits 56)		; Second lowest 3 bits (56 = 63 - 7).
-(defconst sm::DoubleBits 64)		; Bit 7.
-(defconst sm::UpBits 128)		; Bit 8.
-
-;;; All the useful code bits
-(defmacro sm::hit-code (hit)
-  `(nth 0 ,hit))
-;;; The button, or buttons if a chord.
-(defmacro sm::hit-button (hit)
-  `(logand sm::ButtonBits (nth 0 ,hit)))
-;;; The shift, control, and meta flags.
-(defmacro sm::hit-shiftmask (hit)
-  `(logand sm::ShiftmaskBits (nth 0 ,hit)))
-;;; Set if a double click (but not a chord).
-(defmacro sm::hit-double (hit)
-  `(logand sm::DoubleBits (nth 0 ,hit)))
-;;; Set on button release (as opposed to button press).
-(defmacro sm::hit-up (hit)
-  `(logand sm::UpBits (nth 0 ,hit)))
-;;; Screen x position.
-(defmacro sm::hit-x (hit) `(nth 1 ,hit))
-;;; Screen y position.
-(defmacro sm::hit-y (hit) `(nth 2 ,hit))
-;;; Milliseconds since last hit.
-(defmacro sm::hit-delta (hit) `(nth 3 ,hit))
-
-(defmacro sm::hit-up-p (hit)		; A predicate.
-  `(not (zerop (sm::hit-up ,hit))))
-
-;;;
-;;; Loc accessors.  for sm::window-xy
-;;;
-(defmacro sm::loc-w (loc) `(nth 0 ,loc))
-(defmacro sm::loc-x (loc) `(nth 1 ,loc))
-(defmacro sm::loc-y (loc) `(nth 2 ,loc))
-
-;;; this is used extensively by sun-fns.el
-;;;
-(defmacro eval-in-window (window &rest forms)
-  "Switch to WINDOW, evaluate FORMS, return to original window."
-  `(let ((OriginallySelectedWindow (selected-window)))
-     (unwind-protect
-	 (progn
-	   (select-window ,window)
-	   ,@forms)
-       (select-window OriginallySelectedWindow))))
-(put 'eval-in-window 'lisp-indent-function 1)
-
-;;;
-;;; handy utility, generalizes window_loop
-;;;
-
-;;; It's a macro (and does not evaluate its arguments).
-(defmacro eval-in-windows (form &optional yesmini)
-  "Switches to each window and evaluates FORM.  Optional argument
-YESMINI says to include the minibuffer as a window.
-This is a macro, and does not evaluate its arguments."
-  `(let ((OriginallySelectedWindow (selected-window)))
-     (unwind-protect
-	 (while (progn
-		  ,form
-		  (not (eq OriginallySelectedWindow
-			   (select-window
-			    (next-window nil ,yesmini))))))
-       (select-window OriginallySelectedWindow))))
-(put 'eval-in-window 'lisp-indent-function 0)
-
-(defun move-to-loc (x y)
-  "Move cursor to window location X, Y.
-Handles wrapped and horizontally scrolled lines correctly."
-  (move-to-window-line y)
-  ;; window-line-end expects this to return the window column it moved to.
-  (let ((cc (current-column))
-	(nc (move-to-column
-	     (if (zerop (window-hscroll))
-		 (+ (current-column)
-		    (min (- (window-width) 2)	; To stay on the line.
-			 x))
-	       (+ (window-hscroll) -1
-		  (min (1- (window-width))	; To stay on the line.
-		       x))))))
-    (- nc cc)))
-
-
-(defun minibuffer-window-p (window)
-  "Return t if this WINDOW is a minibuffer."
-  (= (frame-height)
-     (nth 3 (window-edges window))	; The bottom edge.
-     ))
-
-
-(defun sun-mouse-handler (&optional hit)
-  "Evaluates the function or list associated with a mouse hit.
-Expecting to read a hit, which is a list: (button x y delta).
-A form bound to button by define-mouse is found by mouse-lookup.
-The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.
-If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
-*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
-the form is eval'ed; if the form is neither of these, it is an error.
-Returns nil."
-  (interactive)
-  (if (null hit) (setq hit (sm::combined-hits)))
-  (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit))))
-    (let ((*mouse-window* (sm::loc-w loc))
-	  (*mouse-x* (sm::loc-x loc))
-	  (*mouse-y* (sm::loc-y loc))
-	  (mouse-code (mouse-event-code hit loc)))
-      (let ((form (with-current-buffer (window-buffer *mouse-window*)
-		    (mouse-lookup mouse-code))))
-	(cond ((null form)
-	       (if (not (sm::hit-up-p hit))	; undefined up hits are ok.
-		   (error "Undefined mouse event: %s"
-			  (prin1-to-string
-			   (mouse-code-to-mouse-list mouse-code)))))
-	      ((symbolp form)
-	       (setq this-command form)
-	       (funcall form *mouse-window* *mouse-x* *mouse-y*))
-	      ((listp form)
-	       (setq this-command (car form))
-	       (eval form))
-	      (t
-	       (error "Mouse action must be symbol or list, but was: %s"
-		      form))))))
-  ;; Don't let 'sun-mouse-handler get on last-command,
-  ;; since this function should be transparent.
-  (if (eq this-command 'sun-mouse-handler)
-      (setq this-command last-command))
-  ;; (message (prin1-to-string this-command))	; to see what your buttons did
-  nil)
-
-(defun sm::combined-hits ()
-  "Read and return next mouse-hit, include possible double click"
-  (let ((hit1 (mouse-hit-read)))
-    (if (not (sm::hit-up-p hit1))	; Up hits dont start doubles or chords.
-	(let ((hit2 (mouse-second-hit extra-click-wait)))
-	  (if hit2	; we cons'd it, we can smash it.
-	      ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...))
-	      (setcar hit1 (logior (sm::hit-code hit1)
-				   (sm::hit-code hit2)
-				   (if (= (sm::hit-button hit1)
-					  (sm::hit-button hit2))
-				       sm::DoubleBits 0))))))
-    hit1))
-
-(defun mouse-hit-read ()
-  "Read mouse-hit list from keyboard.  Like (read 'read-char),
-but that uses minibuffer, and mucks up last-command."
-  (let ((char-list nil) (char nil))
-    (while (not (equal 13		; Carriage return.
-		       (prog1 (setq char (read-char))
-			 (setq char-list (cons char char-list))))))
-    (read (mapconcat 'char-to-string (nreverse char-list) ""))
-    ))
-
-;;; Second Click Hackery....
-;;; if prefix is not mouse-prefix, need a way to unread the char...
-;;; or else have mouse flush input queue, or else need a peek at next char.
-
-;;; There is no peek, but since one character can be unread, we only
-;;; have to flush the queue when the command after a mouse click
-;;; starts with mouse-prefix1 (see below).
-;;;   Something to do later:  We could buffer the read commands and
-;;; execute them ourselves after doing the mouse command (using
-;;; lookup-key ??).
-
-(defvar mouse-prefix1 24		; C-x
-  "First char of mouse-prefix.  Used to detect double clicks and chords.")
-
-(defvar mouse-prefix2 0			; C-@
-  "Second char of mouse-prefix.  Used to detect double clicks and chords.")
-
-
-(defun mouse-second-hit (hit-wait)
-  "Returns the next mouse hit occurring within HIT-WAIT milliseconds."
-  (if (sit-for-millisecs hit-wait) nil	; No input within hit-wait millisecs.
-    (let ((pc1 (read-char)))
-      (if (or (not (equal pc1 mouse-prefix1))
-	      (sit-for-millisecs 3))	; a mouse prefix will have second char
-	  ;; Can get away with one unread.
-	  (progn (setq unread-command-events (list pc1))
-		 nil)			; Next input not mouse event.
-	(let ((pc2 (read-char)))
-	  (if (not (equal pc2 mouse-prefix2))
-	      (progn (setq unread-command-events (list pc1)) ; put back the ^X
-;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2))
-;;; Well, now we can, but I don't understand this code well enough to fix it...
-		(ding)			; user will have to retype that pc2.
-		nil)			; This input is not a mouse event.
-	    ;; Next input has mouse prefix and is within time limit.
-	    (let ((new-hit (mouse-hit-read))) ; Read the new hit.
-		(if (sm::hit-up-p new-hit)	; Ignore up events when timing.
-		    (mouse-second-hit (- hit-wait (sm::hit-delta new-hit)))
-		  new-hit		; New down hit within limit, return it.
-		  ))))))))
-
-(defun sm::window-xy (x y)
-  "Find window containing screen coordinates X and Y.
-Returns list (window x y) where x and y are relative to window."
-  (or
-   (catch 'found
-     (eval-in-windows
-      (let ((we (window-edges (selected-window))))
-	(let ((le (nth 0 we))
-	      (te (nth 1 we))
-	      (re (nth 2 we))
-	      (be (nth 3 we)))
-	  (if (= re (frame-width))
-	      ;; include the continuation column with this window
-	      (setq re (1+ re)))
-	  (if (= be (frame-height))
-	      ;; include partial line at bottom of frame with this window
-	      ;; id est, if window is not multple of char size.
-	      (setq be (1+ be)))
-
-	  (if (and (>= x le) (< x re)
-		   (>= y te) (< y be))
-	      (throw 'found
-		     (list (selected-window) (- x le) (- y te))))))
-      t))				; include minibuffer in eval-in-windows
-   ;;If x,y from a real mouse click, we shouldn't get here.
-   (list nil x y)
-   ))
-
-(defun sm::window-region (loc)
-  "Parse LOC into a region symbol.
-Returns one of (text scrollbar modeline minibuffer)"
-  (let ((w (sm::loc-w loc))
-	(x (sm::loc-x loc))
-	(y (sm::loc-y loc)))
-    (let ((right (1- (window-width w)))
-	  (bottom (1- (window-height w))))
-      (cond ((minibuffer-window-p w) 'minibuffer)
-	    ((>= y bottom) 'modeline)
-	    ((>= x right) 'scrollbar)
-	    ;; far right column (window separator) is always a scrollbar
-	    ((and scrollbar-width
-		  ;; mouse within scrollbar-width of edge.
-		  (>= x (- right scrollbar-width))
-		  ;; mouse a few chars past the end of line.
-		  (>= x (+ 2 (window-line-end w x y))))
-	     'scrollbar)
-	    (t 'text)))))
-
-(defun window-line-end (w x y)
-  "Return WINDOW column (ignore X) containing end of line Y."
-  (eval-in-window w (save-excursion (move-to-loc (frame-width) y))))
-
-;;;
-;;; The encoding of mouse events into a mousemap.
-;;; These values must agree with coding in emacstool:
-;;;
-(defconst sm::keyword-alist
-  '((left . 1) (middle . 2) (right . 4)
-    (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128)
-    (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)
-    ))
-
-(defun mouse-event-code (hit loc)
-  "Maps MOUSE-HIT and LOC into a mouse-code."
-;;;Region is a code for one of text, modeline, scrollbar, or minibuffer.
-  (logior (sm::hit-code hit)
-	  (mouse-region-to-code (sm::window-region loc))))
-
-(defun mouse-region-to-code (region)
-  "Returns partial mouse-code for specified REGION."
-  (cdr (assq region sm::keyword-alist)))
-
-(defun mouse-list-to-mouse-code (mouse-list)
-  "Map a MOUSE-LIST to a mouse-code."
-  (apply 'logior
-	 (mapcar (function (lambda (x)
-			     (cdr (assq x sm::keyword-alist))))
-		  mouse-list)))
-
-(defun mouse-code-to-mouse-list (mouse-code)
-  "Map a MOUSE-CODE to a mouse-list."
-  (apply 'nconc (mapcar
-		 (function (lambda (x)
-			     (if (logtest mouse-code (cdr x))
-				 (list (car x)))))
-		 sm::keyword-alist)))
-
-(defun mousemap-set (code mousemap value)
-  (let* ((alist (cdr mousemap))
-	 (assq-result (assq code alist)))
-    (if assq-result
-	(setcdr assq-result value)
-      (setcdr mousemap (cons (cons code value) alist)))))
-
-(defun mousemap-get (code mousemap)
-  (cdr (assq code (cdr mousemap))))
-
-(defun mouse-lookup (mouse-code)
-  "Look up MOUSE-EVENT and return the definition. nil means undefined."
-  (or (mousemap-get mouse-code current-local-mousemap)
-      (mousemap-get mouse-code current-global-mousemap)))
-
-;;;
-;;; I (jpeck) don't understand the utility of the next four functions
-;;; ask Steven Greenbaum <froud@kestrel>
-;;;
-(defun mouse-mask-lookup (mask list)
-  "Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
-Returns a list of elements of LIST whose code or'ed with MASK is non-zero."
-  (let ((result nil))
-    (while list
-      (if (logtest mask (car (car list)))
-	  (setq result (cons (car list) result)))
-      (setq list (cdr list)))
-    result))
-
-(defun mouse-union (l l-unique)
-  "Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
-where L-UNIQUE is considered to be union'ized already."
-  (let ((result l-unique))
-    (while l
-      (let ((code-form-pair (car l)))
-	(if (not (assq (car code-form-pair) result))
-	    (setq result (cons code-form-pair result))))
-      (setq l (cdr l)))
-    result))
-
-(defun mouse-union-first-preferred (l1 l2)
-  "Return the union of lists of mouse (code . form) pairs L1 and L2,
-based on the code's, with preference going to elements in L1."
-  (mouse-union l2 (mouse-union l1 nil)))
-
-(defun mouse-code-function-pairs-of-region (region)
-  "Return a list of (code . function) pairs, where each code is
-currently set in the REGION."
-  (let ((mask (mouse-region-to-code region)))
-    (mouse-union-first-preferred
-     (mouse-mask-lookup mask (cdr current-local-mousemap))
-     (mouse-mask-lookup mask (cdr current-global-mousemap))
-     )))
-
-;;;
-;;; Functions for DESCRIBE-MOUSE-BINDINGS
-;;; And other mouse documentation functions
-;;; Still need a good procedure to print out a help sheet in readable format.
-;;;
-
-(defun one-line-doc-string (function)
-  "Returns first line of documentation string for FUNCTION.
-If there is no documentation string, then the string
-\"No documentation\" is returned."
-  (while (consp function) (setq function (car function)))
-  (let ((doc (documentation function)))
-    (if (null doc)
-	"No documentation."
-      (string-match "^.*$" doc)
-      (substring doc 0 (match-end 0)))))
-
-(defun print-mouse-format (binding)
-  (princ (car binding))
-  (princ ": ")
-  (mapcar (function
-	   (lambda (mouse-list)
-	     (princ mouse-list)
-	     (princ " ")))
-	  (cdr binding))
-  (terpri)
-  (princ "  ")
-  (princ (one-line-doc-string (car binding)))
-  (terpri)
-  )
-
-(defun print-mouse-bindings (region)
-  "Prints mouse-event bindings for REGION."
-  (mapcar 'print-mouse-format (sm::event-bindings region)))
-
-(defun sm::event-bindings (region)
-  "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
-where each mouse-list is bound to the function in REGION."
-  (let ((mouse-bindings (mouse-code-function-pairs-of-region region))
-	(result nil))
-    (while mouse-bindings
-      (let* ((code-function-pair (car mouse-bindings))
-	     (current-entry (assoc (cdr code-function-pair) result)))
-	(if current-entry
-	    (setcdr current-entry
-		    (cons (mouse-code-to-mouse-list (car code-function-pair))
-			  (cdr current-entry)))
-	  (setq result (cons (cons (cdr code-function-pair)
-				   (list (mouse-code-to-mouse-list
-					  (car code-function-pair))))
-			     result))))
-      (setq mouse-bindings (cdr mouse-bindings))
-      )
-    result))
-
-(defun describe-mouse-bindings ()
-  "Lists all current mouse-event bindings."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (princ "Text Region") (terpri)
-    (princ "---- ------") (terpri)
-    (print-mouse-bindings 'text) (terpri)
-    (princ "Modeline Region") (terpri)
-    (princ "-------- ------") (terpri)
-    (print-mouse-bindings 'modeline) (terpri)
-    (princ "Scrollbar Region") (terpri)
-    (princ "--------- ------") (terpri)
-    (print-mouse-bindings 'scrollbar)))
-
-(defun describe-mouse-briefly (mouse-list)
-  "Print a short description of the function bound to MOUSE-LIST."
-  (interactive "xDescribe mouse list briefly: ")
-  (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list))))
-    (if function
-	(message "%s runs the command %s" mouse-list function)
-      (message "%s is undefined" mouse-list))))
-
-(defun mouse-help-menu (function-and-binding)
-  (cons (prin1-to-string (car function-and-binding))
-	(menu-create	; Two sub-menu items of form ("String" . nil)
-	 (list (list (one-line-doc-string (car function-and-binding)))
-	       (list (prin1-to-string (cdr function-and-binding)))))))
-
-(defun mouse-help-region (w x y &optional region)
-  "Displays a menu of mouse functions callable in this region."
-  (let* ((region (or region (sm::window-region (list w x y))))
-	 (mlist (mapcar (function mouse-help-menu)
-			(sm::event-bindings region)))
-	 (menu (menu-create (cons (list (symbol-name region)) mlist)))
-	 (item (sun-menu-evaluate w 0 y menu))
-	 )))
-
-;;;
-;;; Menu interface functions
-;;;
-;;; use defmenu, because this interface is subject to change
-;;; really need a menu-p, but we use vectorp and the context...
-;;;
-(defun menu-create (items)
-  "Functional form for defmenu, given a list of ITEMS returns a menu.
-Each ITEM is a (STRING . VALUE) pair."
-  (apply 'vector items)
-  )
-
-(defmacro defmenu (menu &rest itemlist)
-  "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs.
-See sun-menu-evaluate for interpretation of ITEMS."
-  (list 'defconst menu (funcall 'menu-create itemlist))
-  )
-
-(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu)
-  "Display a pop-up menu in WINDOW at X Y and evaluate selected item
-of MENU.  MENU (or its symbol-value) should be a menu defined by defmenu.
-  A menu ITEM is a (STRING . FORM) pair;
-the FORM associated with the selected STRING is evaluated,
-and the resulting value is returned.  Generally these FORMs are
-evaluated for their side-effects rather than their values.
-  If the selected form is a menu or a symbol whose value is a menu,
-then it is displayed and evaluated as a pullright menu item.
-  If the FORM of the first ITEM is nil, the STRING of the item
-is used as a label for the menu, i.e. it's inverted and not selectable."
-
-  (if (symbolp menu) (setq menu (symbol-value menu)))
-  (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu)))
-
-(defun sun-get-frame-data (code)
-  "Sends the tty-sub-window escape sequence CODE to terminal,
-and returns a cons of the two numbers in returned escape sequence.
-That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\".
-CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
-  (send-string-to-terminal (concat "\033[" (int-to-string code) "t"))
-  (let (char str x y)
-    (while (not (equal 116 (setq char (read-char)))) ; #\t = 116
-      (setq str (cons char str)))
-    (setq str (mapconcat 'char-to-string (nreverse str) ""))
-    (string-match ";[0-9]*" str)
-    (setq y (substring str (1+ (match-beginning 0)) (match-end 0)))
-    (setq str (substring str (match-end 0)))
-    (string-match ";[0-9]*" str)
-    (setq x (substring str (1+ (match-beginning 0)) (match-end 0)))
-    (cons (string-to-int y) (string-to-int x))))
-
-(defun sm::font-size ()
-  "Returns font size in pixels: (cons Ysize Xsize)"
-  (let ((pix (sun-get-frame-data 14))	; returns size in pixels
-	(chr (sun-get-frame-data 18)))	; returns size in chars
-    (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr)))))
-
-(defvar sm::menu-kludge-x nil
-  "Cached frame-to-window X-Offset for sm::menu-kludge")
-(defvar sm::menu-kludge-y nil
-  "Cached frame-to-window Y-Offset for sm::menu-kludge")
-
-(defun sm::menu-kludge ()
-  "If sunfns.c uses <Menu_Base_Kludge> this function must be here!"
-  (or sm::menu-kludge-y
-      (let ((fs (sm::font-size)))
-	(setq sm::menu-kludge-y (+ 8 (car fs))	; a title line and borders
-	      sm::menu-kludge-x 4)))	; best values depend on .defaults/Menu
-  (let ((wl (sun-get-frame-data 13)))		; returns frame location
-    (cons (+ (car wl) sm::menu-kludge-y)
-	  (+ (cdr wl) sm::menu-kludge-x))))
-
-;;;
-;;;  Function interface to selection/region
-;;;  primitive functions are defined in sunfns.c
-;;;
-(defun sun-yank-selection ()
-  "Set mark and yank the contents of the current sunwindows selection.
-Insert contents into the current buffer at point."
-  (interactive "*")
-  (set-mark-command nil)
-  (insert-string (sun-get-selection)))
-
-(defun sun-select-region (start end)
-  "Set the sunwindows selection to the region in the current buffer."
-  (interactive "r")
-  (sun-set-selection (buffer-substring start end)))
-
-;;;
-;;; Support for emacstool
-;;; This closes the window instead of stopping emacs.
-;;;
-(defun suspend-emacstool (&optional stuffstring)
-  "Suspend emacstool.
-If running under as a detached process emacstool,
-you don't want to suspend  (there is no way to resume),
-just close the window, and wait for reopening."
-  (interactive)
-  (run-hooks 'suspend-hook)
-  (if stuffstring (send-string-to-terminal stuffstring))
-  (send-string-to-terminal "\033[2t")	; To close EmacsTool window.
-  (run-hooks 'suspend-resume-hook))
-;;;
-;;; initialize mouse maps
-;;;
-
-(make-variable-buffer-local 'current-local-mousemap)
-(setq-default current-local-mousemap nil)
-(defvar current-global-mousemap (make-mousemap))
-
-(provide 'sun-mouse)
-
-;;; sun-mouse.el ends here
--- a/lisp/term/sun.el	Tue Jun 19 06:47:52 2001 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,279 +0,0 @@
-;; sun.el --- keybinding for standard default sunterm keys
-
-;; Author: Jeff Peck <peck@sun.com>
-;; Keywords: terminals
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;;; 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 2, 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.
-;;;
-;;; 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.
-
-;;; Commentary:
-
-;; The function key sequences for the console have been converted for
-;; use with function-key-map, but the *tool stuff hasn't been touched.
-
-;;; Code:
-
-(defun ignore-key ()
-  "interactive version of ignore"
-  (interactive)
-  (ignore))
-
-(defun scroll-down-in-place (n)
-  (interactive "p")
-  (previous-line n)
-  (scroll-down n))
-
-(defun scroll-up-in-place (n)
-  (interactive "p")
-  (next-line n)
-  (scroll-up n))
-
-(defun kill-region-and-unmark (start end)
-  "Like kill-region, but pops the mark [which equals point, anyway.]"
-  (interactive "r")
-  (kill-region start end)
-  (setq this-command 'kill-region-and-unmark)
-  (set-mark-command t))
-
-(defun select-previous-complex-command ()
-  "Select Previous-complex-command"
-  (interactive)
-  (if (zerop (minibuffer-depth))
-      (repeat-complex-command 1)
-    (previous-complex-command 1)))
-
-(defun rerun-prev-command ()
-  "Repeat Previous-complex-command."
-  (interactive)
-  (eval (nth 0 command-history)))
-
-(defvar grep-arg nil "Default arg for RE-search")
-(defun grep-arg ()
-  (if (memq last-command '(research-forward research-backward)) grep-arg
-    (let* ((command (car command-history))
-	   (command-name (symbol-name (car command)))
-	   (search-arg (car (cdr command)))
-	   (search-command
-	    (and command-name (string-match "search" command-name)))
-	   )
-      (if (and search-command (stringp search-arg)) (setq grep-arg search-arg)
-	(setq search-command this-command
-	      grep-arg (read-string "REsearch: " grep-arg)
-	      this-command search-command)
-	grep-arg))))
-
-(defun research-forward ()
-  "Repeat RE search forward."
-  (interactive)
-  (re-search-forward (grep-arg)))
-
-(defun research-backward ()
-  "Repeat RE search backward."
-  (interactive)
-  (re-search-backward (grep-arg)))
-
-;;;
-;;; handle sun's extra function keys
-;;; this version for those who run with standard .ttyswrc and no emacstool
-;;;
-;;; sunview picks up expose and open on the way UP,
-;;; so we ignore them on the way down
-;;;
-
-(defvar sun-esc-bracket nil
-  "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
-
-(defvar sun-raw-prefix (make-sparse-keymap))
-(define-key function-key-map "\e[" sun-raw-prefix)
-
-(define-key sun-raw-prefix "210z" [r3])
-(define-key sun-raw-prefix "213z" [r6])
-(define-key sun-raw-prefix "214z" [r7])
-(define-key sun-raw-prefix "216z" [r9])
-(define-key sun-raw-prefix "218z" [r11])
-(define-key sun-raw-prefix "220z" [r13])
-(define-key sun-raw-prefix "222z" [r15])
-(define-key sun-raw-prefix "193z" [redo])
-(define-key sun-raw-prefix "194z" [props])
-(define-key sun-raw-prefix "195z" [undo])
-; (define-key sun-raw-prefix "196z" 'ignore-key)		; Expose-down
-; (define-key sun-raw-prefix "197z" [put])
-; (define-key sun-raw-prefix "198z" 'ignore-key)		; Open-down
-; (define-key sun-raw-prefix "199z" [get])
-(define-key sun-raw-prefix "200z" [find])
-; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark)	; Delete
-(define-key sun-raw-prefix "226z" [t3])
-(define-key sun-raw-prefix "227z" [t4])
-(define-key sun-raw-prefix "229z" [t6])
-(define-key sun-raw-prefix "230z" [t7])
-(define-key sun-raw-prefix "A" [up])			; R8
-(define-key sun-raw-prefix "B" [down])			; R14
-(define-key sun-raw-prefix "C" [right])			; R12
-(define-key sun-raw-prefix "D" [left])			; R10
-
-(global-set-key [r3]	'backward-page)
-(global-set-key [r6]	'forward-page)
-(global-set-key [r7]	'beginning-of-buffer)
-(global-set-key [r9]	'scroll-down)
-(global-set-key [r11]	'recenter)
-(global-set-key [r13]	'end-of-buffer)
-(global-set-key [r15]	'scroll-up)
-(global-set-key [redo]	'redraw-display)
-(global-set-key [props]	'list-buffers)
-(global-set-key [undo]	'undo)
-(global-set-key [put]	'sun-select-region)
-(global-set-key [get]	'sun-yank-selection)
-(global-set-key [find]	'exchange-point-and-mark)
-(global-set-key [t3]	'scroll-down-in-place)
-(global-set-key [t4]	'scroll-up-in-place)
-(global-set-key [t6]	'shrink-window)
-(global-set-key [t7]	'enlarge-window)
-
-
-(if sun-esc-bracket (global-unset-key "\e["))
-
-;;; Since .emacs gets loaded before this file, a hook is supplied
-;;; for you to put your own bindings in.
-
-(defvar sun-raw-prefix-hooks nil
-  "List of forms to evaluate after setting sun-raw-prefix.")
-
-(let ((hooks sun-raw-prefix-hooks))
-  (while hooks
-    (eval (car hooks))
-    (setq hooks (cdr hooks))
-    ))
-
-
-;;; This section adds definitions for the emacstool users
-;;; emacstool event filter converts function keys to C-x*{c}{lrt}
-;;;
-;;; for example the Open key (L7) would be encoded as "\C-x*gl"
-;;; the control, meta, and shift keys modify the character {lrt}
-;;; note that (unshifted) C-l is ",",  C-r is "2", and C-t is "4"
-;;;
-;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT.
-;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys)
-;;; as ANSI escape sequences.  Use the shell command
-;;; % setkeys noarrows
-;;; if you want these to come through for emacstool.
-;;;
-;;; If you are not using EmacsTool,
-;;; you can also use this by creating a .ttyswrc file to do the conversion.
-;;; but it won't include the CONTROL, META, or SHIFT keys!
-;;;
-;;; Important to define SHIFTed sequence before matching unshifted sequence.
-;;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%)
-;;;  this is worse than C-S/C-Q flow control anyday!
-;;;  Do *YOU* run in capslock mode?
-;;;
-
-;;; Note:  al, el and gl are trapped by EmacsTool, so they never make it here.
-
-(defvar meta-flag t)
-
-(defvar suntool-map (make-sparse-keymap)
-  "*Keymap for Emacstool bindings.")
-
-(define-key suntool-map "gr" 'beginning-of-buffer)	; r7
-(define-key suntool-map "iR" 'backward-page)		; R9
-(define-key suntool-map "ir" 'scroll-down)		; r9
-(define-key suntool-map "kr" 'recenter)			; r11
-(define-key suntool-map "mr" 'end-of-buffer)		; r13
-(define-key suntool-map "oR" 'forward-page)		; R15
-(define-key suntool-map "or" 'scroll-up)		; r15
-(define-key suntool-map "b\M-L" 'rerun-prev-command)	; M-AGAIN
-(define-key suntool-map "b\M-l" 'prev-complex-command)	; M-Again
-(define-key suntool-map "bl" 'redraw-display)		; Again
-(define-key suntool-map "cl" 'list-buffers)		; Props
-(define-key suntool-map "dl" 'undo)			; Undo
-(define-key suntool-map "el" 'ignore-key)		; Expose-Open
-(define-key suntool-map "fl" 'sun-select-region)	; Put
-(define-key suntool-map "f," 'copy-region-as-kill)	; C-Put
-(define-key suntool-map "gl" 'ignore-key)		; Open-Open
-(define-key suntool-map "hl" 'sun-yank-selection)	; Get
-(define-key suntool-map "h," 'yank)			; C-Get
-(define-key suntool-map "il" 'research-forward)		; Find
-(define-key suntool-map "i," 're-search-forward)	; C-Find
-(define-key suntool-map "i\M-l" 'research-backward)	; M-Find
-(define-key suntool-map "i\M-," 're-search-backward)	; C-M-Find
-
-(define-key suntool-map "jL" 'yank)			; DELETE
-(define-key suntool-map "jl" 'kill-region-and-unmark)	; Delete
-(define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete
-(define-key suntool-map "j,"
-  #'(lambda () (interactive) (pop-mark 1)))		; C-Delete
-
-(define-key suntool-map "fT" 'shrink-window-horizontally)	; T6
-(define-key suntool-map "gT" 'enlarge-window-horizontally)	; T7
-(define-key suntool-map "ft" 'shrink-window)			; t6
-(define-key suntool-map "gt" 'enlarge-window)			; t7
-(define-key suntool-map "cT" #'(lambda(n) (interactive "p") (scroll-down n)))
-(define-key suntool-map "dT" #'(lambda(n) (interactive "p") (scroll-up n)))
-(define-key suntool-map "ct" 'scroll-down-in-place)		; t3
-(define-key suntool-map "dt" 'scroll-up-in-place)		; t4
-(define-key ctl-x-map "*" suntool-map)
-
-;;; Since .emacs gets loaded before this file, a hook is supplied
-;;; for you to put your own bindings in.
-
-(defvar suntool-map-hooks nil
-  "List of forms to evaluate after setting suntool-map.")
-
-(let ((hooks suntool-map-hooks))
-  (while hooks
-    (eval (car hooks))
-    (setq hooks (cdr hooks))
-    ))
-
-;;;
-;;; If running under emacstool, arrange to call suspend-emacstool
-;;; instead of suspend-emacs.
-;;;
-;;; First mouse blip is a clue that we are in emacstool.
-;;;
-;;; C-x C-@ is the mouse command prefix.
-
-(autoload 'sun-mouse-handler "sun-mouse"
-	  "Sun Emacstool handler for mouse blips (not loaded)." t)
-
-(defun emacstool-init ()
-  "Set up Emacstool window, if you know you are in an emacstool."
-  ;; Make sure sun-mouse and sun-fns are loaded.
-  (require 'sun-fns)
-  (define-key ctl-x-map "\C-@" 'sun-mouse-handler)
-
-  (if (< (sun-window-init) 0)
-      (message "Not a Sun Window")
-    (progn
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map)
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map)
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map))
-      (send-string-to-terminal
-       (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\"))
-    ))
-
-(defun sun-mouse-once ()
-  "Converts to emacstool and sun-mouse-handler on first mouse hit."
-  (interactive)
-  (emacstool-init)
-  (sun-mouse-handler)			; Now, execute this mouse blip.
-  )
-(define-key ctl-x-map "\C-@" 'sun-mouse-once)
-
-;;; sun.el ends here