[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk 2f6b519: Merge remote-tracking branch 'origin/master' into
|
From: |
Po Lu |
|
Subject: |
feature/pgtk 2f6b519: Merge remote-tracking branch 'origin/master' into feature/pgtk |
|
Date: |
Thu, 2 Dec 2021 04:54:13 -0500 (EST) |
branch: feature/pgtk
commit 2f6b519eaeb3be4ee6a912b40a21686be12d4d88
Merge: 78a3933 3f98188
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/pgtk
---
doc/lispref/commands.texi | 7 +++
doc/lispref/display.texi | 9 ++++
etc/NEWS | 5 +++
lisp/bindings.el | 2 +
lisp/cedet/semantic/bovine/c.el | 40 ++++++++---------
lisp/dired-x.el | 21 +++++----
lisp/emacs-lisp/cl-lib.el | 5 +++
lisp/emacs-lisp/macroexp.el | 15 ++++---
lisp/international/characters.el | 56 +++++++++++++++++-------
lisp/mouse.el | 8 ++--
lisp/net/browse-url.el | 2 +-
lisp/pixel-scroll.el | 76 ++++++++++++++++++++++++++++++---
lisp/textmodes/glyphless-mode.el | 1 +
src/keyboard.c | 17 ++++++++
src/termhooks.h | 7 +++
src/xterm.c | 49 +++++++++++++--------
test/lisp/cedet/srecode/fields-tests.el | 23 +++++-----
test/lisp/emacs-lisp/cl-lib-tests.el | 5 +++
18 files changed, 251 insertions(+), 97 deletions(-)
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 073cdd8..cc1c216 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1992,6 +1992,13 @@ This kind of event indicates that the user deiconified
@var{frame} using
the window manager. Its standard definition is @code{ignore}; since the
frame has already been made visible, Emacs has no work to do.
+@cindex @code{touch-end} event
+@item (touch-end (@var{position}))
+This kind of event indicates that the user's finger moved off the
+mouse wheel or the touchpad. The @var{position} element is a mouse
+position list (@pxref{Click Events}), specifying the position of the
+mouse cursor when the finger moved off the mouse wheel.
+
@cindex @code{wheel-up} event
@cindex @code{wheel-down} event
@item (wheel-up @var{position} @var{clicks} @var{lines} @var{pixel-delta})
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 275c15e..80ef24b 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -8280,6 +8280,15 @@ Characters of Unicode General Category [Cf], such as
U+200E
@sc{left-to-right mark}, but excluding characters that have graphic
images, such as U+00AD @sc{soft hyphen}.
+@item bidi-control
+This is a subset of @code{format-control}, but only includes
+characters that are related to bi-directional control, like U+2069
+@sc{pop directional isolate} and U+202A @sc{left-to-right embedding}.
+
+Characters of Unicode General Category [Cf], such as U+200E
+@sc{left-to-right mark}, but excluding characters that have graphic
+images, such as U+00AD @sc{soft hyphen}.
+
@item variation-selectors
Unicode VS-1 through VS-16 (U+FE00 through U+FE0F), which are used to
select between different glyphs for the same codepoints (typically
diff --git a/etc/NEWS b/etc/NEWS
index f1f1512..d783fc0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -758,6 +758,11 @@ property.
** New 'min-width' 'display' property.
This allows setting a minimum display width for a region of text.
++++
+** New event type 'touch-end'.
+This event is sent whenever the user's finger moves off the mouse
+wheel on some mice, and when the user's finger moves off the touchpad.
+
** Keymaps and key definitions
+++
diff --git a/lisp/bindings.el b/lisp/bindings.el
index e28b06a..578406d 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1261,6 +1261,8 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key global-map [kp-9] 'function-key-error)
;; (define-key global-map [kp-equal] 'function-key-error)
+(define-key global-map [touch-end] 'ignore)
+
;; X11 distinguishes these keys from the non-kp keys.
;; Make them behave like the non-kp keys unless otherwise bound.
;; FIXME: rather than list such mappings for every modifier-combination,
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index c7d59de..19e2fee 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1466,36 +1466,32 @@ Override function for `semantic-tag-protection'."
(prot nil))
;; Check the modifiers for protection if we are not a child
;; of some class type.
- (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
- (while (and (not prot) mods)
- (if (stringp (car mods))
- (let ((s (car mods)))
- ;; A few silly defaults to get things started.
- (cond ((or (string= s "extern")
- (string= s "export"))
- 'public)
- ((string= s "static")
- 'private))))
- (setq mods (cdr mods))))
- ;; If we have a typed parent, look for :public style labels.
- (when (and parent (eq (semantic-tag-class parent) 'type))
+ (if (not (and parent (eq (semantic-tag-class parent) 'type)))
+ (while (and (not prot) mods)
+ (if (stringp (car mods))
+ (let ((s (car mods)))
+ ;; A few silly defaults to get things started.
+ (setq prot (pcase s
+ ((or "extern" "export") 'public)
+ ("static" 'private)))))
+ (setq mods (cdr mods)))
+ ;; If we have a typed parent, look for :public style labels.
(let ((pp (semantic-tag-type-members parent)))
(while (and pp (not (semantic-equivalent-tag-p (car pp) tag)))
(when (eq (semantic-tag-class (car pp)) 'label)
(setq prot
- (cond ((string= (semantic-tag-name (car pp)) "public")
- 'public)
- ((string= (semantic-tag-name (car pp)) "private")
- 'private)
- ((string= (semantic-tag-name (car pp)) "protected")
- 'protected)))
+ (pcase (semantic-tag-name (car pp))
+ ("public" 'public)
+ ("private" 'private)
+ ("protected" 'protected)))
)
(setq pp (cdr pp)))))
(when (and (not prot) (eq (semantic-tag-class parent) 'type))
(setq prot
- (cond ((string= (semantic-tag-type parent) "class") 'private)
- ((string= (semantic-tag-type parent) "struct") 'public)
- (t 'unknown))))
+ (pcase (semantic-tag-type parent)
+ ("class" 'private)
+ ("struct" 'public)
+ (_ 'unknown))))
(or prot
(if (and parent (semantic-tag-of-class-p parent 'type))
'public
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index de21dcf..499d5cd 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -580,17 +580,16 @@ files in the active region if `dired-mark-region' is
non-nil."
(defalias 'virtual-dired 'dired-virtual)
(defun dired-virtual (dirname &optional switches)
- "Put this Dired buffer into Virtual Dired mode.
-
-In Virtual Dired mode, all commands that do not actually consult the
-filesystem will work.
-
-This is useful if you want to peruse and move around in an ls -lR
-output file, for example one you got from an ftp server. With
-ange-ftp, you can even Dired a directory containing an ls-lR file,
-visit that file and turn on Virtual Dired mode. But don't try to save
-this file, as `dired-virtual' indents the listing and thus changes the
-buffer.
+ "Try to make the current buffer into a Dired buffer.
+This command is rarely useful, but may be convenient if you want
+to peruse and move around in the output you got from \"ls
+-lR\" (or something similar), without having access to the actual
+file system.
+
+Most Dired commands that don't consult the file system will work
+as advertised, but commands that try to alter the file system
+will usually fail. (If the output is from the current system,
+most of those commands, too, will work fine.)
If you have saved a Dired buffer in a file you can use \\[dired-virtual] to
resume it in a later session.
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 317a4c6..b01a32c 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -560,4 +560,9 @@ of record objects."
(t
(advice-remove 'type-of #'cl--old-struct-type-of))))
+(defun cl-constantly (value)
+ "Return a function that takes any number of arguments, but returns VALUE."
+ (lambda (&rest _)
+ value))
+
;;; cl-lib.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 66c276e..48d9c68 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -137,7 +137,9 @@ Other uses risk returning non-nil value that point to the
wrong file."
(defun macroexp--warn-wrap (msg form category)
(let ((when-compiled (lambda ()
- (when (byte-compile-warning-enabled-p category)
+ (when (if (listp category)
+ (apply #'byte-compile-warning-enabled-p
category)
+ (byte-compile-warning-enabled-p category))
(byte-compile-warn "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
@@ -216,12 +218,11 @@ is executed without being compiled first."
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
- (and (byte-compile-warning-enabled-p 'obsolete fun)
- (macroexp--obsolete-warning
- fun obsolete
- (if (symbolp (symbol-function fun))
- "alias" "macro")))
- new-form 'obsolete))
+ (macroexp--obsolete-warning
+ fun obsolete
+ (if (symbolp (symbol-function fun))
+ "alias" "macro"))
+ new-form (list 'obsolete fun)))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 3b8924f..c7d5431 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1493,6 +1493,9 @@ Setup `char-width-table' appropriate for non-CJK language
environment."
(aset char-acronym-table #x202D "LRO") ; LEFT-TO-RIGHT OVERRIDE
(aset char-acronym-table #x202E "RLO") ; RIGHT-TO-LEFT OVERRIDE
(aset char-acronym-table #x2060 "WJ") ; WORD JOINER
+(aset char-acronym-table #x2066 "LTRI") ; LEFT-TO-RIGHT ISOLATE
+(aset char-acronym-table #x2067 "RTLI") ; RIGHT-TO-LEFT ISOLATE
+(aset char-acronym-table #x2069 "PDI") ; POP DIRECTIONAL ISOLATE
(aset char-acronym-table #x206A "ISS") ; INHIBIT SYMMETRIC SWAPPING
(aset char-acronym-table #x206B "ASS") ; ACTIVATE SYMMETRIC SWAPPING
(aset char-acronym-table #x206C "IAFS") ; INHIBIT ARABIC FORM SHAPING
@@ -1517,6 +1520,17 @@ Setup `char-width-table' appropriate for non-CJK
language environment."
(aset char-acronym-table (+ #xE0021 i) (format " %c TAG" (+ 33 i))))
(aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG
+(defvar glyphless--bidi-control-characters
+ '( ?\N{left-to-right embedding}
+ ?\N{right-to-left embedding}
+ ?\N{left-to-right override}
+ ?\N{right-to-left override}
+ ?\N{left-to-right isolate}
+ ?\N{right-to-left isolate}
+ ?\N{first strong isolate}
+ ?\N{pop directional formatting}
+ ?\N{pop directional isolate}))
+
(defun update-glyphless-char-display (&optional variable value)
"Make the setting of `glyphless-char-display-control' take effect.
This function updates the char-table `glyphless-char-display',
@@ -1527,8 +1541,9 @@ option `glyphless-char-display'."
(dolist (elt value)
(let ((target (car elt))
(method (cdr elt)))
- (or (memq method '(zero-width thin-space empty-box acronym hex-code))
- (error "Invalid glyphless character display method: %s" method))
+ (unless (memq method '( zero-width thin-space empty-box
+ acronym hex-code bidi-control))
+ (error "Invalid glyphless character display method: %s" method))
(cond ((eq target 'c0-control)
(glyphless-set-char-table-range glyphless-char-display
#x00 #x1F method)
@@ -1543,24 +1558,29 @@ option `glyphless-char-display'."
((eq target 'variation-selectors)
(glyphless-set-char-table-range glyphless-char-display
#xFE00 #xFE0F method))
- ((eq target 'format-control)
+ ((or (eq target 'format-control)
+ (eq target 'bidi-control))
(when unicode-category-table
(map-char-table
(lambda (char category)
- (if (eq category 'Cf)
- (let ((this-method method)
- from to)
- (if (consp char)
- (setq from (car char) to (cdr char))
- (setq from char to char))
- (while (<= from to)
- (when (/= from #xAD)
- (if (eq method 'acronym)
- (setq this-method
- (aref char-acronym-table from)))
+ (when (eq category 'Cf)
+ (let ((this-method method)
+ from to)
+ (if (consp char)
+ (setq from (car char) to (cdr char))
+ (setq from char to char))
+ (while (<= from to)
+ (when (/= from #xAD)
+ (when (eq method 'acronym)
+ (setq this-method
+ (or (aref char-acronym-table from)
+ "UNK")))
+ (when (or (eq target 'format-control)
+ (memq from
+ glyphless--bidi-control-characters))
(set-char-table-range glyphless-char-display
- from this-method))
- (setq from (1+ from))))))
+ from this-method)))
+ (setq from (1+ from))))))
unicode-category-table)))
((eq target 'no-font)
(set-char-table-extra-slot glyphless-char-display 0 method))
@@ -1607,6 +1627,9 @@ GROUP must be one of these symbols:
such as U+200C (ZWNJ), U+200E (LRM), but
excluding characters that have graphic images,
such as U+00AD (SHY).
+ `bidi-control': A subset of `format-control', but only characters
+ that are relevant for bi-directional control, like
+ U+2069 (PDI) and U+202B (RLE).
`variation-selectors':
Characters in the range U+FE00..U+FE0F, used for
selecting alternate glyph presentations, such as
@@ -1635,6 +1658,7 @@ function (`update-glyphless-char-display'), which updates
:options '((c0-control glyphless-char-display-method)
(c1-control glyphless-char-display-method)
(format-control glyphless-char-display-method)
+ (bidi-control glyphless-char-display-method)
(variation-selectors glyphless-char-display-method)
(no-font (glyphless-char-display-method :value hex-code)))
:set 'update-glyphless-char-display
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 3ab9fbc..ec43aec 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -330,10 +330,10 @@ the function `context-menu-filter-function'."
;; Remove duplicate separators
(let ((l menu))
(while (consp l)
- (when (and (equal (cdr-safe (car l)) menu-bar-separator)
- (equal (cdr-safe (cadr l)) menu-bar-separator))
- (setcdr l (cddr l)))
- (setq l (cdr l))))
+ (if (and (equal (cdr-safe (car l)) menu-bar-separator)
+ (equal (cdr-safe (cadr l)) menu-bar-separator))
+ (setcdr l (cddr l))
+ (setq l (cdr l)))))
(when (functionp context-menu-filter-function)
(setq menu (funcall context-menu-filter-function menu click)))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index b1f981f..645c28f 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -221,7 +221,7 @@ be used instead."
(defcustom browse-url-button-regexp
(concat
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
+ "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
(let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 9cd2352..092d721 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -68,6 +68,7 @@
(require 'mwheel)
(require 'subr-x)
+(require 'ring)
(defvar pixel-wait 0
"Idle time on each step of pixel scroll specified in second.
@@ -97,9 +98,17 @@ is always with pixel resolution.")
(let ((map (make-sparse-keymap)))
(define-key map [wheel-down] #'pixel-scroll-precision)
(define-key map [wheel-up] #'pixel-scroll-precision)
+ (define-key map [touch-end] #'pixel-scroll-start-momentum)
map)
"The key map used by `pixel-scroll-precision-mode'.")
+(defcustom pixel-scroll-precision-use-momentum nil
+ "If non-nil, continue to scroll the display after wheel movement stops.
+This is only effective if supported by your mouse or touchpad."
+ :group 'mouse
+ :type 'boolean
+ :version "29.1")
+
(defun pixel-scroll-in-rush-p ()
"Return non-nil if next scroll should be non-smooth.
When scrolling request is delivered soon after the previous one,
@@ -383,7 +392,7 @@ the height of the current window."
(desired-vscroll (cdr (posn-object-x-y desired-pos)))
(next-pos (save-excursion
(goto-char desired-start)
- (when (zerop (vertical-motion 1))
+ (when (zerop (vertical-motion (1+ scroll-margin)))
(signal 'end-of-buffer nil))
(point))))
(if (and (< (point) next-pos)
@@ -419,7 +428,7 @@ the height of the current window."
(point (posn-point posn))
(up-point (save-excursion
(goto-char point)
- (vertical-motion -1)
+ (vertical-motion (- (1+ scroll-margin)))
(point))))
(when (> (point) up-point)
(when (let ((pos-visible (pos-visible-in-window-p up-point nil t)))
@@ -475,9 +484,11 @@ wheel."
(mwheel-scroll event nil)
(with-selected-window window
(condition-case nil
- (if (< delta 0)
- (pixel-scroll-precision-scroll-down (- delta))
- (pixel-scroll-precision-scroll-up delta))
+ (progn
+ (if (< delta 0)
+ (pixel-scroll-precision-scroll-down (- delta))
+ (pixel-scroll-precision-scroll-up delta))
+ (pixel-scroll-accumulate-velocity delta))
;; Do not ding at buffer limits. Show a message instead.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
@@ -485,6 +496,61 @@ wheel."
(message (error-message-string '(end-of-buffer)))))))))
(mwheel-scroll event nil))))
+(defun pixel-scroll-kinetic-state ()
+ "Return the kinetic scroll state of the current window.
+It is a vector of the form [ VELOCITY TIME ]."
+ (or (window-parameter nil 'kinetic-state)
+ (set-window-parameter nil 'kinetic-state
+ (vector (make-ring 4) nil))))
+
+(defun pixel-scroll-accumulate-velocity (delta)
+ "Accumulate DELTA into the current window's kinetic scroll state."
+ (let* ((state (pixel-scroll-kinetic-state))
+ (time (aref state 1)))
+ (when (and time (> (- (float-time) time) 0.5))
+ (aset state 0 (make-ring 45)))
+ (ring-insert (aref state 0)
+ (cons (aset state 1 (float-time))
+ delta))))
+
+(defun pixel-scroll-calculate-velocity (state)
+ "Calculate velocity from the kinetic state vector STATE."
+ (let* ((ring (aref state 0))
+ (elts (ring-elements ring))
+ (total 0))
+ (dolist (tem elts)
+ (setq total (+ total (cdr tem))))
+ (/ total (* (- (caar elts)
+ (caar (last elts)))
+ 100))))
+
+(defun pixel-scroll-start-momentum (event)
+ "Start kinetic scrolling for the touch event EVENT."
+ (interactive "e")
+ (when pixel-scroll-precision-use-momentum
+ (let ((window (mwheel-event-window event))
+ (state nil))
+ (with-selected-window window
+ (setq state (pixel-scroll-kinetic-state))
+ (when (aref state 1)
+ (unwind-protect (progn
+ (aset state 0
+ (pixel-scroll-calculate-velocity state))
+ (let ((velocity (aref state 0)))
+ (if (> velocity 0)
+ (while (> velocity 0)
+ (pixel-scroll-precision-scroll-up 1)
+ (setq velocity (1- velocity))
+ (sit-for 0.1)
+ (redisplay t))
+ (while (< velocity 0)
+ (pixel-scroll-precision-scroll-down 1)
+ (setq velocity (1+ velocity))
+ (sit-for 0.1)
+ (redisplay t)))))
+ (aset state 0 (make-ring 45))
+ (aset state 1 nil)))))))
+
;;;###autoload
(define-minor-mode pixel-scroll-precision-mode
"Toggle pixel scrolling.
diff --git a/lisp/textmodes/glyphless-mode.el b/lisp/textmodes/glyphless-mode.el
index 3aeb360..9751b9f 100644
--- a/lisp/textmodes/glyphless-mode.el
+++ b/lisp/textmodes/glyphless-mode.el
@@ -34,6 +34,7 @@ The value can be any of the groups supported by
(const :tag "C0 Control" c0-control)
(const :tag "C1 Control" c1-control)
(const :tag "Format Control" format-control)
+ (const :tag "Bi-directional Control" bidi-control)
(const :tag "Variation Selectors" variation-selectors)
(const :tag "No Font" no-font)))
:group 'display)
diff --git a/src/keyboard.c b/src/keyboard.c
index 35b9884..df07cf2 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -5997,6 +5997,21 @@ make_lispy_event (struct input_event *event)
return list2 (head, position);
}
+ case TOUCH_END_EVENT:
+ {
+ Lisp_Object position;
+
+ /* Build the position as appropriate for this mouse click. */
+ struct frame *f = XFRAME (event->frame_or_window);
+
+ if (! FRAME_LIVE_P (f))
+ return Qnil;
+
+ position = make_lispy_position (f, event->x, event->y,
+ event->timestamp);
+
+ return list2 (Qtouch_end, position);
+ }
#ifdef USE_TOOLKIT_SCROLL_BARS
@@ -11754,6 +11769,8 @@ syms_of_keyboard (void)
DEFSYM (Qfile_notify, "file-notify");
#endif /* USE_FILE_NOTIFY */
+ DEFSYM (Qtouch_end, "touch-end");
+
/* Menu and tool bar item parts. */
DEFSYM (QCenable, ":enable");
DEFSYM (QCvisible, ":visible");
diff --git a/src/termhooks.h b/src/termhooks.h
index 649a423..b124e99 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -273,6 +273,13 @@ enum event_kind
/* Pre-edit text was changed. */
, PGTK_PREEDIT_TEXT_EVENT
#endif
+
+ /* Either the mouse wheel has been released without it being
+ clicked, or the user has lifted his finger from a touchpad.
+
+ In the future, this may take into account other multi-touch
+ events generated from touchscreens and such. */
+ , TOUCH_END_EVENT
};
/* Bit width of an enum event_kind tag at the start of structs and unions. */
diff --git a/src/xterm.c b/src/xterm.c
index d633953..3f7b956 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10025,42 +10025,55 @@ handle_one_xevent (struct x_display_info *dpyinfo,
val->emacs_value += delta;
if (mwheel_coalesce_scroll_events
- && (fabs (val->emacs_value) < 1))
+ && (fabs (val->emacs_value) < 1)
+ && (fabs (delta) > 0))
continue;
bool s = signbit (val->emacs_value);
- inev.ie.kind = (val->horizontal
- ? HORIZ_WHEEL_EVENT
- : WHEEL_EVENT);
+ inev.ie.kind = (fabs (delta) > 0
+ ? (val->horizontal
+ ? HORIZ_WHEEL_EVENT
+ : WHEEL_EVENT)
+ : TOUCH_END_EVENT);
inev.ie.timestamp = xev->time;
XSETINT (inev.ie.x, lrint (xev->event_x));
XSETINT (inev.ie.y, lrint (xev->event_y));
XSETFRAME (inev.ie.frame_or_window, f);
- inev.ie.modifiers = !s ? up_modifier : down_modifier;
- inev.ie.modifiers
- |= x_x_to_emacs_modifiers (dpyinfo,
- xev->mods.effective);
+ if (fabs (delta) > 0)
+ {
+ inev.ie.modifiers = !s ? up_modifier :
down_modifier;
+ inev.ie.modifiers
+ |= x_x_to_emacs_modifiers (dpyinfo,
+ xev->mods.effective);
+ }
scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0);
if (NUMBERP (Vx_scroll_event_delta_factor))
scroll_unit *= XFLOATINT
(Vx_scroll_event_delta_factor);
- if (val->horizontal)
+ if (fabs (delta) > 0)
{
- inev.ie.arg
- = list3 (Qnil,
- make_float (val->emacs_value
- * scroll_unit),
- make_float (0));
+ if (val->horizontal)
+ {
+ inev.ie.arg
+ = list3 (Qnil,
+ make_float (val->emacs_value
+ * scroll_unit),
+ make_float (0));
+ }
+ else
+ {
+ inev.ie.arg = list3 (Qnil, make_float (0),
+ make_float
(val->emacs_value
+ *
scroll_unit));
+ }
}
- else
+ else
{
- inev.ie.arg = list3 (Qnil, make_float (0),
- make_float (val->emacs_value
- * scroll_unit));
+ inev.ie.arg = Qnil;
}
kbd_buffer_store_event_hold (&inev.ie, hold_quit);
diff --git a/test/lisp/cedet/srecode/fields-tests.el
b/test/lisp/cedet/srecode/fields-tests.el
index 5f634a5..3c66f21 100644
--- a/test/lisp/cedet/srecode/fields-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -57,8 +57,7 @@ It is filled with some text."
(end-of-line)
(forward-word -1)
- (setq f (srecode-field "Test"
- :name "TEST"
+ (setq f (srecode-field :name "TEST"
:start 6
:end 8))
@@ -99,19 +98,17 @@ It is filled with some text."
(reg nil)
(fields
(list
- (srecode-field "Test1" :name "TEST-1" :start 5 :end 10)
- (srecode-field "Test2" :name "TEST-2" :start 15 :end 20)
- (srecode-field "Test3" :name "TEST-3" :start 25 :end 30)
+ (srecode-field :name "TEST-1" :start 5 :end 10)
+ (srecode-field :name "TEST-2" :start 15 :end 20)
+ (srecode-field :name "TEST-3" :start 25 :end 30)
- (srecode-field "Test4" :name "TEST-4" :start 35 :end 35))
- ))
+ (srecode-field :name "TEST-4" :start 35 :end 35))))
(when (not (= (length srecode-field-archive) 4))
(error "Region Test: Found %d fields. Expected 4"
(length srecode-field-archive)))
- (setq reg (srecode-template-inserted-region "REG"
- :start 4
+ (setq reg (srecode-template-inserted-region :start 4
:end 40))
(srecode-overlaid-activate reg)
@@ -183,10 +180,10 @@ It is filled with some text."
;; Test variable linkage.
(let* ((srecode-field-archive nil)
- (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8))
- (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30))
- (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40))
- (reg (srecode-template-inserted-region "REG" :start 4 :end 40)))
+ (f1 (srecode-field :name "TEST" :start 6 :end 8))
+ (f2 (srecode-field :name "TEST" :start 28 :end 30))
+ (f3 (srecode-field :name "NOTTEST" :start 35 :end 40))
+ (reg (srecode-template-inserted-region :start 4 :end 40)))
(srecode-overlaid-activate reg)
(when (not (string= (srecode-overlaid-text f1)
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index 854e371..a0facc8 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -551,4 +551,9 @@
(should cl-old-struct-compat-mode)
(cl-old-struct-compat-mode (if saved 1 -1))))
+(ert-deftest cl-constantly ()
+ (should (equal (mapcar (cl-constantly 3) '(a b c d))
+ '(3 3 3 3))))
+
+
;;; cl-lib-tests.el ends here