Function: xterm-mouse-event

xterm-mouse-event is a byte-compiled function defined in xt-mouse.el.gz.

Signature

(xterm-mouse-event &optional EXTENSION)

Documentation

Convert XTerm mouse event to Emacs mouse event.

EXTENSION, if non-nil, means to use an extension to the usual terminal mouse protocol; we currently support the value 1006, which is the "1006" extension implemented in Xterm >= 277.

Source Code

;; Defined in /usr/src/emacs/lisp/xt-mouse.el.gz
(defun xterm-mouse-event (&optional extension)
  "Convert XTerm mouse event to Emacs mouse event.
EXTENSION, if non-nil, means to use an extension to the usual
terminal mouse protocol; we currently support the value 1006,
which is the \"1006\" extension implemented in Xterm >= 277."
  (let ((click (cond ((memq extension '(1006 nil))
		      (xterm-mouse--read-event-sequence extension))
		     (t
		      (error "Unsupported XTerm mouse protocol")))))
    (when (and click
               ;; In very obscure circumstances, the click may become
               ;; invalid (see bug#17378).
               (>= (nth 1 click) 0))
      (let* ((type (nth 0 click))
             (x    (nth 1 click))
             (y    (nth 2 click))
             ;; Emulate timestamp information.  This is accurate enough
             ;; for default value of mouse-1-click-follows-link (450msec).
	     (timestamp (if (not xt-mouse-epoch)
			    (progn (setq xt-mouse-epoch (float-time)) 0)
			  (car (time-convert (time-since xt-mouse-epoch)
					     1000))))
             ;; FIXME: The test for running in batch mode is here solely
             ;; for the sake of xt-mouse-tests where the only frame is
             ;; the initial frame.  The same goes for the computation of
             ;; x and y.
             (frame-and-xy (unless noninteractive (tty-frame-at x y)))
             (frame (nth 0 frame-and-xy))
             (x (or (nth 1 frame-and-xy) x))
             (y (or (nth 2 frame-and-xy) y))
             (w (window-at x y frame))
             (posn
	      (if w
		  (let* ((ltrb (window-edges w))
			 (left (nth 0 ltrb))
			 (top (nth 1 ltrb)))
		    (posn-at-x-y (- x left) (- y top) w t))
		(let* ((frame-has-menu-bar
			(not (zerop (frame-parameter frame 'menu-bar-lines))))
		       (frame-has-tab-bar
			(not (zerop (frame-parameter frame 'tab-bar-lines))))
		       (item
			(cond
                         ((and frame-has-menu-bar (eq y 0))
			  'menu-bar)
			 ((and frame-has-tab-bar
			       (or (and frame-has-menu-bar
					(eq y 1))
				   (eq y 0)))
                          'tab-bar)
			 ((eq x -1)
			  (cond
			   ((eq y -1) 'top-left-corner)
			   ((eq y (frame-height frame)) 'bottom-left-corner)
			   (t 'left-edge)))
			 ((eq x (frame-width frame))
			  (cond
			   ((eq y -1) 'top-right-corner)
			   ((eq y (frame-height frame)) 'bottom-right-corner)
			   (t 'right-edge)))
			 ((eq y -1) 'top-edge)
			 (t 'bottom-edge))))
		  (append (list (unless (memq item '(menu-bar tab-bar))
				  frame)
				item)
			  (nthcdr 2 (posn-at-x-y x y (selected-frame)))))))
             (event (list type posn)))
        (setcar (nthcdr 3 posn) timestamp)

        ;; Try to handle double/triple clicks.
        (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click))
               (last-type (nth 0 last-click))
               (last-name (symbol-name last-type))
               (last-time (nth 1 last-click))
               (click-count (nth 2 last-click))
               (last-x (nth 3 last-click))
               (last-y (nth 4 last-click))
               (this-time (float-time))
               (name (symbol-name type)))
          (cond
           ((not (string-match "down-" name))
            ;; For up events, make the up side match the down side.
            (setq this-time last-time)
            (when (and click-count (> click-count 1)
                       (string-match "down-" last-name)
                       (equal name (replace-match "" t t last-name)))
              (xterm-mouse--set-click-count event click-count)))
           ((and last-time
                 double-click-time
                 (or (eq double-click-time t)
                     (> double-click-time (* 1000 (- this-time last-time))))
                 (<= (abs (- x last-x))
                     (/ double-click-fuzz 8))
                 (<= (abs (- y last-y))
                     (/ double-click-fuzz 8))
                 (equal last-name (replace-match "" t t name)))
            (setq click-count (1+ click-count))
            (xterm-mouse--set-click-count event click-count))
           (t (setq click-count 1)))
          (set-terminal-parameter nil 'xterm-mouse-last-click
                                  (list type this-time click-count x y)))

        (set-terminal-parameter nil 'xterm-mouse-x x)
        (set-terminal-parameter nil 'xterm-mouse-y y)
        (set-terminal-parameter nil 'xterm-mouse-frame frame)
        (setq last-input-event event)))))