]> code.delx.au - gnu-emacs/blobdiff - lisp/term/sun-mouse.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / term / sun-mouse.el
index 2b3dc5d6732e815af9bf2912c3368d06147bcd4c..dcc56d503e904211e1f6ae867930fbc64eaadde5 100644 (file)
@@ -1,12 +1,12 @@
 ;;; sun-mouse.el --- mouse handling for Sun windows
 
+;; Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007 Free Software Foundation, Inc.
+
 ;; Author: Jeff Peck
 ;; Maintainer: FSF
-;; Last-Modified: 14 Jul 1992
 ;; Keywords: hardware
 
-;; 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
 ;; 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.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
-;;; Jeff Peck, Sun Microsystems, Jan 1987.
-;;; Original idea by Stan Jefferson
+;; 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
-;;;
+;;     Modeled 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:
 
@@ -60,13 +59,18 @@ Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
   "Returns a new mousemap."
   (cons 'mousemap nil))
 
+;;; initialize mouse maps
+(defvar current-global-mousemap (make-mousemap))
+(defvar current-local-mousemap nil)
+(make-variable-buffer-local 'current-local-mousemap)
+
 (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 specifing a mouse hit according to these rules:
+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.
@@ -135,28 +139,28 @@ Just like the Common Lisp function of the same name."
 
 ;;; All the useful code bits
 (defmacro sm::hit-code (hit)
-  (` (nth 0 (, hit))))
+  `(nth 0 ,hit))
 ;;; The button, or buttons if a chord.
 (defmacro sm::hit-button (hit)
-  (` (logand sm::ButtonBits (nth 0 (, hit)))))
+  `(logand sm::ButtonBits (nth 0 ,hit)))
 ;;; The shift, control, and meta flags.
 (defmacro sm::hit-shiftmask (hit)
-  (` (logand sm::ShiftmaskBits (nth 0 (, 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)))))
+  `(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)))))
+  `(logand sm::UpBits (nth 0 ,hit)))
 ;;; Screen x position.
 (defmacro sm::hit-x (hit) (list 'nth 1 hit))
 ;;; Screen y position.
 (defmacro sm::hit-y (hit) (list 'nth 2 hit))
-;;; Millisconds since last hit.
+;;; Milliseconds since last hit.
 (defmacro sm::hit-delta (hit) (list 'nth 3 hit))
 
-(defmacro sm::hit-up-p (hit)           ; A predicate.
-  (` (not (zerop (sm::hit-up (, hit))))))
+(defmacro sm::hit-up-p (hit)    ; A predicate.
+  `(not (zerop (sm::hit-up ,hit))))
 
 ;;;
 ;;; Loc accessors.  for sm::window-xy
@@ -168,12 +172,12 @@ Just like the Common Lisp function of the same name."
 (defmacro eval-in-buffer (buffer &rest forms)
   "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
   ;; When you don't need the complete window context of eval-in-window
-  (` (let ((StartBuffer (current-buffer)))
+  `(let ((StartBuffer (current-buffer)))
     (unwind-protect
-       (progn
-         (set-buffer (, buffer))
-         (,@ forms))
-    (set-buffer StartBuffer)))))
+         (progn
+           (set-buffer ,buffer)
+           ,@forms)
+      (set-buffer StartBuffer))))
 
 (put 'eval-in-buffer 'lisp-indent-function 1)
 
@@ -181,12 +185,12 @@ Just like the Common Lisp function of the same name."
 ;;;
 (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)))))
+  `(let ((OriginallySelectedWindow (selected-window)))
+    (unwind-protect
+         (progn
+           (select-window ,window)
+           ,@forms)
+      (select-window OriginallySelectedWindow))))
 (put 'eval-in-window 'lisp-indent-function 1)
 
 ;;;
@@ -198,14 +202,14 @@ Just like the Common Lisp function of the same name."
   "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)))))
+  `(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)
@@ -234,9 +238,9 @@ Handles wrapped and horizontally scrolled lines correctly."
 \f
 (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.  
+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.
@@ -252,8 +256,8 @@ Returns nil."
                    (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 
+                  (error "Undefined mouse event: %s"
+                         (prin1-to-string
                           (mouse-code-to-mouse-list mouse-code)))))
              ((symbolp form)
               (setq this-command form)
@@ -274,13 +278,13 @@ Returns 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.
+    (if (not (sm::hit-up-p hit1))      ; Up hits don't 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) 
+             (setcar hit1 (logior (sm::hit-code hit1)
                                   (sm::hit-code hit2)
-                                  (if (= (sm::hit-button hit1) 
+                                  (if (= (sm::hit-button hit1)
                                          (sm::hit-button hit2))
                                       sm::DoubleBits 0))))))
     hit1))
@@ -290,7 +294,7 @@ Returns nil."
 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)) 
+                      (prog1 (setq char (read-char))
                         (setq char-list (cons char char-list))))))
     (read (mapconcat 'char-to-string (nreverse char-list) ""))
     ))
@@ -319,12 +323,14 @@ but that uses minibuffer, and mucks up last-command."
     (let ((pc1 (read-char)))
       (if (or (not (equal pc1 mouse-prefix1))
              (sit-for-millisecs 3))    ; a mouse prefix will have second char
-         (progn (setq unread-command-char pc1) ; Can get away with one unread.
+         ;; 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-char pc1) ; put back the ^X
-;;; Too bad can't do two: (setq unread-command-char (list pc1 pc2))
+             (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.
@@ -339,7 +345,7 @@ but that uses minibuffer, and mucks up last-command."
 Returns list (window x y) where x and y are relative to window."
   (or
    (catch 'found
-     (eval-in-windows 
+     (eval-in-windows
       (let ((we (window-edges (selected-window))))
        (let ((le (nth 0 we))
              (te (nth 1 we))
@@ -350,12 +356,12 @@ Returns list (window x y) where x and y are relative to 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.
+             ;; id est, if window is not multiple of char size.
              (setq be (1+ be)))
 
          (if (and (>= x le) (< x re)
                   (>= y te) (< y be))
-             (throw 'found 
+             (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.
@@ -373,7 +379,7 @@ Returns one of (text scrollbar modeline minibuffer)"
       (cond ((minibuffer-window-p w) 'minibuffer)
            ((>= y bottom) 'modeline)
            ((>= x right) 'scrollbar)
-           ;; far right column (window seperator) is always a scrollbar
+           ;; far right column (window separator) is always a scrollbar
            ((and scrollbar-width
                  ;; mouse within scrollbar-width of edge.
                  (>= x (- right scrollbar-width))
@@ -390,7 +396,7 @@ Returns one of (text scrollbar modeline minibuffer)"
 ;;; The encoding of mouse events into a mousemap.
 ;;; These values must agree with coding in emacstool:
 ;;;
-(defconst sm::keyword-alist 
+(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)
@@ -461,7 +467,7 @@ where L-UNIQUE is considered to be union'ized already."
       (setq l (cdr l)))
     result))
 
-(defun mouse-union-first-prefered (l1 l2)
+(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)))
@@ -470,7 +476,7 @@ based on the code's, with preference going to elements in L1."
   "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-prefered
+    (mouse-union-first-preferred
      (mouse-mask-lookup mask (cdr current-local-mousemap))
      (mouse-mask-lookup mask (cdr current-global-mousemap))
      )))
@@ -546,7 +552,7 @@ where each mouse-list is bound to the function in REGION."
 
 (defun describe-mouse-briefly (mouse-list)
   "Print a short description of the function bound to MOUSE-LIST."
-  (interactive "xDescibe mouse list briefly: ")
+  (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)
@@ -592,10 +598,10 @@ of MENU.  MENU (or its symbol-value) should be a menu defined by defmenu.
 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, 
+  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 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 selectible."
+  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)))
@@ -603,7 +609,7 @@ is used as a label for the menu, i.e. it's inverted and not selectible."
 (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\". 
+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)
@@ -615,7 +621,7 @@ CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
     (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))))
+    (cons (string-to-number y) (string-to-number x))))
 
 (defun sm::font-size ()
   "Returns font size in pixels: (cons Ysize Xsize)"
@@ -623,9 +629,9 @@ CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
        (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 
+(defvar sm::menu-kludge-x nil
   "Cached frame-to-window X-Offset for sm::menu-kludge")
-(defvar sm::menu-kludge-y nil 
+(defvar sm::menu-kludge-y nil
   "Cached frame-to-window Y-Offset for sm::menu-kludge")
 
 (defun sm::menu-kludge ()
@@ -640,14 +646,14 @@ CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
 \f
 ;;;
 ;;;  Function interface to selection/region
-;;;  primative functions are defined in sunfns.c
+;;;  primitive functions are defined in sunfns.c
 ;;;
 (defun sun-yank-selection ()
-  "Set mark and yank the contents of the current sunwindows selection
-into the current buffer at point."
+  "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)))
+  (insert (sun-get-selection)))
 
 (defun sun-select-region (beg end)
   "Set the sunwindows selection to the region in the current buffer."
@@ -659,22 +665,18 @@ into the current buffer at point."
 ;;; This closes the window instead of stopping emacs.
 ;;;
 (defun suspend-emacstool (&optional stuffstring)
-  "If running under as a detached process emacstool,
-you don't want to suspend  (there is no way to resume), 
+  "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)
+(provide 'term/sun-mouse)              ; have to (require 'term/sun-mouse)
 
+;;; arch-tag: 6e879372-b899-4509-833f-d7f6250e309a
 ;;; sun-mouse.el ends here