Function: xterm-mouse-translate-1

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

Signature

(xterm-mouse-translate-1 &optional EXTENSION)

Source Code

;; Defined in /usr/src/emacs/lisp/xt-mouse.el.gz
(defun xterm-mouse-translate-1 (&optional extension)
  (save-excursion
    (let* ((event (xterm-mouse-event extension))
	   (ev-command (nth 0 event))
	   (ev-data    (nth 1 event))
	   (ev-where   (nth 1 ev-data))
	   (vec (vector event))
	   (is-move (eq 'mouse-movement ev-command))
	   (is-down (string-match "down-" (symbol-name ev-command))))

      ;; Mouse events symbols must have an 'event-kind property set.
      ;; Most of them use the value 'mouse-click, but 'mouse-movement has
      ;; a different value.  See head_table in keyboard.c. (bug#67457)
      (when ev-command (put ev-command 'event-kind
                            (if (eq ev-command 'mouse-movement)
                                'mouse-movement
                              'mouse-click)))

      (cond
       ((null event) nil)		;Unknown/bogus byte sequence!
       (is-down
	(setf (terminal-parameter nil 'xterm-mouse-last-down)
              ;; EVENT might be handed back to the input queue, which
              ;; might modify it.  Copy it into the terminal parameter
              ;; to guard against that.
              (copy-sequence event))
	vec)
       (is-move
        (xterm-mouse--handle-mouse-movement)
        (if track-mouse vec
          ;; Mouse movement events are currently supposed to be
          ;; suppressed.  Return no event.
          []))
       (t
	(let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
	       (down-data (nth 1 down))
	       (down-where (nth 1 down-data)))
	  (setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
	  (cond
	   ((null down)
	    ;; This is an "up-only" event.  Pretend there was an up-event
	    ;; right before and keep the up-event for later.
	    (push event unread-command-events)
	    (vector (cons (intern (replace-regexp-in-string
				   "\\`\\([ACMHSs]-\\)*" "\\&down-"
				   (symbol-name ev-command) t))
			  (cdr event))))
	   ((equal ev-where down-where) vec)
           (t
	    (let ((drag (if (symbolp ev-where)
			    0		;FIXME: Why?!?
			  (list (intern (replace-regexp-in-string
					 "\\`\\([ACMHSs]-\\)*" "\\&drag-"
					 (symbol-name ev-command) t))
				down-data ev-data))))
	      (if (null track-mouse)
		  (vector drag)
		(push drag unread-command-events)
                (xterm-mouse--handle-mouse-movement)
		(vector (list 'mouse-movement ev-data))))))))))))