bug#19416: 25.0.50; enhancement of xterm mouse tracking: draging the mouse now generates mouse-movement events

[olaf . rogalsky]

Hi,

xterm-mouse-mode (of cause, when used in a xterm window) currently does
not create mouse-motion events while dragging the mouse. Therefore,
selecting a region with mouse (press button-1 and start dragging, not
yet releasing the button) gives no visible feedback about the so far
selected region. Similar, dragging the mode-line of a window in a
splitted frame gives no feedback of the amount of window size
change. The effect of dragging the mouse becomes appearent only after
release of the button.

I prepared a patch, which greates motion-events while dragging, so that
visible feedback now is given immediately.

Further, the patch unifies the code for the default mouse protocol
encoding (enabled by "\e[?1000h" or "\e[?1002h") and the extended
encoding ("\e[?1005h").

It would be nice, if the patch could find its way into emacs.

Thanks,
Olaf

--- /home/olaf/src/emacs/emacs/lisp/xt-mouse.el 2014-12-13 18:29:19.515492821 
+0100
+++ xt-mouse.el 2014-12-19 17:58:20.240967393 +0100
@@ -60,8 +60,8 @@
           (ev-data    (nth 1 event))
           (ev-where   (nth 1 ev-data))
           (vec (vector event))
-          (is-down (string-match "down-" (symbol-name ev-command))))
-
+          (is-down (string-match "down-" (symbol-name ev-command)))
+           (is-move (eq 'mouse-movement ev-command)))
       ;; Mouse events symbols must have an 'event-kind property with
       ;; the value 'mouse-click.
       (when ev-command (put ev-command 'event-kind 'mouse-click))
@@ -71,11 +71,12 @@
        (is-down
        (setf (terminal-parameter nil 'xterm-mouse-last-down) event)
        vec)
+       (is-move vec)
        (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)
+          (setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
          (cond
           ((null down)
            ;; This is an "up-only" event.  Pretend there was an up-event
@@ -132,65 +133,106 @@
             (fdiff (- f (* 1.0 maxwrap dbig))))
        (+ (truncate fdiff) (* maxwrap dbig))))))
 
-;; Normal terminal mouse click reporting: expect three bytes, of the
-;; form <BUTTON+32> <X+32> <Y+32>.  Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1000 ()
-  (let* ((code (- (read-event) 32))
-         (type
-         ;; For buttons > 3, the release-event looks differently
-         ;; (see xc/programs/xterm/button.c, function EditorButton),
-         ;; and come in a release-event only, no down-event.
-         (cond ((>= code 64)
-                (format "mouse-%d" (- code 60)))
-               ((memq code '(8 9 10))
-                (format "M-down-mouse-%d" (- code 7)))
-               ((memq code '(3 11))
-                 (let ((down (car (terminal-parameter
-                                   nil 'xterm-mouse-last-down))))
-                   (when (and down (string-match "[0-9]" (symbol-name down)))
-                     (format (if (eq code 3) "mouse-%s" "M-mouse-%s")
-                             (match-string 0 (symbol-name down))))))
-               ((memq code '(0 1 2))
-                (format "down-mouse-%d" (+ 1 code)))))
-         (x (- (read-event) 33))
-         (y (- (read-event) 33)))
-    (and type (wholenump x) (wholenump y)
-         (list (intern type) x y))))
-
-;; XTerm's 1006-mode terminal mouse click reporting has the form
-;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
-;; in encoded (decimal) form.  Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1006 ()
-  (let (button-bytes x-bytes y-bytes c)
-    (while (not (eq (setq c (read-event)) ?\;))
-      (push c button-bytes))
-    (while (not (eq (setq c (read-event)) ?\;))
-      (push c x-bytes))
-    (while (not (memq (setq c (read-event)) '(?m ?M)))
-      (push c y-bytes))
-    (list (let* ((code (string-to-number
-                       (apply 'string (nreverse button-bytes))))
-                (wheel (>= code 64))
-                (down (and (not wheel)
-                           (eq c ?M))))
-           (intern (format "%s%smouse-%d"
-                           (cond (wheel "")
-                                 ((< code 4)  "")
-                                 ((< code 8)  "S-")
-                                 ((< code 12) "M-")
-                                 ((< code 16) "M-S-")
-                                 ((< code 20) "C-")
-                                 ((< code 24) "C-S-")
-                                 ((< code 28) "C-M-")
-                                 ((< code 32) "C-M-S-")
-                                 (t
-                                  (error "Unexpected escape sequence from 
XTerm")))
-                           (if down "down-" "")
-                           (if wheel
-                               (- code 60)
-                             (1+ (mod code 4))))))
-         (1- (string-to-number (apply 'string (nreverse x-bytes))))
-         (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+;; The following code relies on the evaluation order of function
+;; paramerters, which must be evaluated from left to right. According
+;; to the elips manual "Evaluation of Function Forms" this is true.
+;; Ther is no error checking performed wether the utf-8 character is
+;; encoded with minimal number of bytes.
+(defun read-utf8-char (&optional prompt seconds)
+  "Read an utf-8 encoded character from the current terminal.
+This function reads and returns an utf-8 encoded character of
+command input. If the user generates an event which is not a
+character (i.e., a mouse click or function key event), read-char
+signals an error.
+
+The returned event may come directly from the user, or from a
+keyboard macro. It is not decoded by the keyboard's input coding
+system and always treated with an utf-8 input encoding.
+
+The optional arguments prompt and seconds work like in
+`read-event'. But note, that if the utf character is encoded with
+several bytes, then `read-utf8-char' waits for each of those
+bytes for the given time.
+
+There is no provision for error detecting of illegal utf-8
+sequences."
+  (let ((c (read-char prompt nil seconds)))
+    (cond
+     ((< c 128)
+      c)
+     ((< c 224)
+      (+ (lsh (logand c 31) 6)
+         (logand (read-char prompt nil seconds) 63)))
+     ((< c 240)
+      (+ (lsh (logand c 15) 12)
+         (lsh (logand (read-char prompt nil seconds) 63) 6)
+         (logand (read-char prompt nil seconds) 63)))
+     ((< c 248)
+      (+ (lsh (logand c 7) 18)
+         (lsh (logand (read-char prompt nil seconds) 63) 12)
+         (lsh (logand (read-char prompt nil seconds) 63) 6)
+         (logand (read-char prompt nil seconds) 63)))
+     (t
+      (error "An iIllegal utf-8 character code was received from the 
terminal")))))
+
+;; In default mode each numeric parameter of XTerm's mouse reports is
+;; a single char, possibly encoded as utf-8.  The actual numeric
+;; parameter then is obtained by subtracting 32 from the character
+;; code.  In extendend mode the parameters are returned as decimal
+;; string delemited either by semicolons or for the last parameter by
+;; one of the characters "m" or "M". If the last character is a "m",
+;; then the mouse event was a button release, else it was a button
+;; press or a mouse motion.
+(defmacro xterm-mouse--read-number-from-terminal (c extension)
+  `(if ,extension
+       (let ((n 0))
+         (while (progn
+                  (setq ,c (read-utf8-char))
+                  (<= ?0 ,c ?9))
+           (setq n (+ (* 10 n) ,c ,(- ?0))))
+         n)
+     (- (setq ,c (read-utf8-char)) 32)))
+
+;; XTerm reports mouse events as
+;; <EVENT-CODE> <X> <Y> in default mode, and
+;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
+;; The macro read-number-from-terminal takes care of reading
+;; the response parameters appropriatly. The event codes differ
+;; slightly between default and extended mode.
+;; Return a list (EVENT-TYPE-SYMBOL X Y).
+(defun xterm-mouse--read-event-sequence (&optional extension)
+  (let* (c ; remember last read char
+         (code (xterm-mouse--read-number-from-terminal c extension))
+         (x (1- (xterm-mouse--read-number-from-terminal c extension)))
+         (y (1- (xterm-mouse--read-number-from-terminal c extension)))
+         (wheel (/= (logand code 64) 0))
+         (move (/= (logand code 32) 0))
+         (ctrl (/= (logand code 16) 0))
+         (meta (/= (logand code 8) 0))
+         (shift (/= (logand code 4) 0))
+         (down (and (not wheel)
+                    (not move)
+                    (if extension
+                        (eq c ?M)
+                      (/= (logand code 3) 3))))
+         (btn (if (or extension down wheel)
+                  (+ (logand code 3) (if wheel 4 1))
+                ;; The default mouse protocol does not report the button
+                ;; number in release events: use the button from the last
+                ;; button-down event.
+                (terminal-parameter nil 'xterm-mouse-last-button)
+                ;; Spurious release event without previous button-down
+                ;; event: assume, that the last button was button 1.
+                1))
+         (sym (if move 'mouse-movement
+                (intern (concat (if ctrl "C-" "")
+                                (if meta "M-" "")
+                                (if shift "S-" "")
+                                (if down "down-" "")
+                                "mouse-"
+                                (number-to-string btn))))))
+    (if down (set-terminal-parameter nil 'xterm-mouse-last-button btn))
+    (list sym x y)))
 
 (defun xterm-mouse--set-click-count (event click-count)
   (setcdr (cdr event) (list click-count))
@@ -207,10 +249,8 @@
 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 ((null extension)
-                      (xterm-mouse--read-event-sequence-1000))
-                     ((eq extension 1006)
-                      (xterm-mouse--read-event-sequence-1006))
+  (let* ((click (cond ((or (null extension) (= extension 1006))
+                      (xterm-mouse--read-event-sequence extension))
                      (t
                       (error "Unsupported XTerm mouse protocol")))))
     (when click
@@ -291,13 +331,13 @@
     (setq mouse-position-function nil)))
 
 (defconst xterm-mouse-tracking-enable-sequence
-  "\e[?1000h\e[?1006h"
+  "\e[?1000h\e[?1002h\e[?1005h\e[?1006h"
   "Control sequence to enable xterm mouse tracking.
 Enables basic tracking, then extended tracking on
 terminals that support it.")
 
 (defconst xterm-mouse-tracking-disable-sequence
-  "\e[?1006l\e[?1000l"
+  "\e[?1006l\e[?1005l\e[?1002h\e[?1000l"
   "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
 
 (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)




In GNU Emacs 25.0.50.1 (x86_64-unknown-linux-gnu, GTK+ Version 3.10.8)
 of 2014-12-13 on blaubaer
Repository revision: 30f603836c64a045fa59b5258d09b99da582eb75
System Description:     Ubuntu 14.04.1 LTS

Configured using:
 `configure --prefix /home/olaf/local --with-x-toolkit=gtk3
 --without-gconf --without-gsettings'

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS NOTIFY ACL
LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF XFT ZLIB

Important settings:
  value of $LANG: de_DE.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Emacs-Lisp

Minor modes in effect:
  savehist-mode: t
  global-page-break-lines-mode: t
  page-break-lines-mode: t
  rainbow-delimiters-mode: t
  indent-guide-global-mode: t
  indent-guide-mode: t
  global-auto-complete-mode: t
  auto-complete-mode: t
  recentf-mode: t
  xterm-clip-mode: t
  xterm-mouse-mode: t
  auto-compile-on-load-mode: t
  auto-compile-on-save-mode: t
  auto-compile-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  size-indication-mode: t
  column-number-mode: t
  line-number-mode: t

Recent messages:
Done (Total of 4 files compiled, 1 skipped)
Contacting host: debbugs.gnu.org:80 [2 times]
Mark saved where search started
Mark set
Mark saved where search started
Contacting host: debbugs.gnu.org:80
Wrote /tmp/gnus-temp-group-7890x00
Opening nndoc server on /tmp/gnus-temp-group-7890x00-ephemeral...done
Mark set [3 times]
Making completion list...

Load-path shadows:
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-meta hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-meta
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-main hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-main
/home/olaf/.local/share/emacs/site-lisp/mu4e/org-mu4e hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/org-mu4e
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-speedbar hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-speedbar
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-utils hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-utils
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-headers hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-headers
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-contrib hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-contrib
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-vars hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-vars
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-mark hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-mark
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-proc hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-proc
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-draft hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-draft
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-about hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-about
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-lists hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-lists
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-view hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-view
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-compose hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-compose
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-message hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-message
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e
/home/olaf/.local/share/emacs/site-lisp/mu4e/mu4e-actions hides 
/home/olaf/local/share/emacs/site-lisp/mu4e/mu4e-actions
/home/olaf/.emacs.d/lisp/custom hides 
/home/olaf/local/share/emacs/25.0.50/lisp/custom
/home/olaf/.emacs.d/lisp/xt-mouse hides 
/home/olaf/local/share/emacs/25.0.50/lisp/xt-mouse

Features:
(shadow emacsbug sendmail flow-fill sort gnus-cite mail-extr qp
gnus-async gnus-bcklg gnus-agent gnus-srvr gnus-score score-mode
nnvirtual nntp gnus-ml gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime
smime dig nndoc gnus-cache gnus-sum gnus-group gnus-undo gnus-start
gnus-cloud nnimap nnmail mail-source utf7 netrc nnoo parse-time
gnus-spec gnus-int gnus-range gnus-win gnus gnus-ems nnheader misearch
multi-isearch crm org org-macro org-footnote org-pcomplete pcomplete
org-list org-faces org-entities noutline outline org-version
ob-emacs-lisp ob ob-tangle ob-ref ob-lob ob-table ob-exp org-src ob-keys
ob-comint ob-core ob-eval org-compat org-macs org-loaddefs find-func
cal-menu calendar cal-loaddefs debbugs-gnu debbugs cl soap-client
warnings xml autoload lisp-mnt tar-mode mm-archive message dired
format-spec rfc822 mml mml-sec mailabbrev gmm-utils mailheader mm-decode
mm-bodies mm-encode mail-utils network-stream nsm starttls url-http tls
mail-parse rfc2231 rfc2047 rfc2045 ietf-drums url-gw url-cache url-auth
url url-proxy url-privacy url-expand url-methods url-history url-cookie
url-domsuf url-util mailcap url-handlers url-parse auth-source cl-macs
gv eieio eieio-core gnus-util mm-util mail-prsvr password-cache url-vars
finder-inf thingatpt xterm flymake compile comint ring disp-table
my-key-bindings my-packages savehist saveplace page-break-lines paren
mic-paren rainbow-delimiters rainbow-mode ansi-color color key-chord
indent-guide browse-kill-ring loccur easy-mmode auto-complete edmacro
kmacro popup epa-file epa derived epg recentf tree-widget wid-edit linum
xterm-clip my-xt-mouse my-defaults my-functions time-date
sanityinc-tomorrow-eighties-theme color-theme-sanityinc-tomorrow delsel
cus-start cus-load info easymenu package epg-config jka-compr
auto-compile byte-opt advice help-fns packed bytecomp byte-compile
cl-extra cl-loaddefs cl-lib cconv tooltip eldoc electric uniquify
ediff-hook vc-hooks lisp-float-type mwheel x-win x-dnd tool-bar dnd
fontset image regexp-opt fringe tabulated-list newcomment elisp-mode
lisp-mode prog-mode register page menu-bar rfn-eshadow timer select
scroll-bar mouse jit-lock font-lock syntax facemenu font-core frame cham
georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese hebrew greek romanian slovak czech european ethiopic
indian cyrillic chinese case-table epa-hook jka-cmpr-hook help simple
abbrev minibuffer nadvice loaddefs button faces cus-face macroexp files
text-properties overlay sha1 md5 base64 format env code-pages mule
custom widget hashtable-print-readable backquote make-network-process
dbusbind gfilenotify dynamic-setting font-render-setting move-toolbar
gtk x-toolkit x multi-tty emacs)

Memory information:
((conses 16 409431 11818)
 (symbols 48 41443 0)
 (miscs 40 119 427)
 (strings 32 95528 15266)
 (string-bytes 1 2802468)
 (vectors 16 33843)
 (vector-slots 8 625886 5281)
 (floats 8 664 852)
 (intervals 56 7715 113)
 (buffers 976 21)
 (heap 1024 41003 1594))