commit d65534d254b3965ea82a9300c12c5c07f88818b7 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Mon Dec 27 01:57:25 2021 -0500 * lisp/emacs-list/eieio-compat.el: Really move to obsolete diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el deleted file mode 100644 index a5f3750009..0000000000 --- a/lisp/emacs-lisp/eieio-compat.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; eieio-compat.el --- Compatibility with Older EIEIO versions -*- lexical-binding:t -*- - -;; Copyright (C) 1995-1996, 1998-2021 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam -;; Keywords: OO, lisp -;; Package: eieio -;; Obsolete-Since: 25.1 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Backward compatibility definition of old EIEIO functions in -;; terms of newer equivalent. - -;; The main elements are the old EIEIO `defmethod' and `defgeneric' which are -;; now implemented on top of cl-generic. The differences we have to -;; accommodate are: -;; - EIEIO's :static methods (turned into a new `eieio--static' specializer). -;; - EIEIO's support for `call-next-method' and `next-method-p' instead of -;; `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming). -;; - Different errors are signaled. -;; - EIEIO's defgeneric does not reset the function. -;; - EIEIO's no-next-method and no-applicable-method can't be aliases of -;; cl-generic's namesakes since they have different calling conventions, -;; which means that packages that (defmethod no-next-method ..) don't work. -;; - EIEIO's `call-next-method' and `next-method-p' had dynamic scope whereas -;; cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically -;; scoped. - -;;; Code: - -(require 'eieio-core) -(require 'cl-generic) - -(put 'eieio--defalias 'byte-hunk-handler - #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) -;;;###autoload -(defun eieio--defalias (name body) - "Like `defalias', but with less side-effects. -More specifically, it has no side-effects at all when the new function -definition is the same (`eq') as the old one." - (cl-assert (not (symbolp body))) - (while (and (fboundp name) (symbolp (symbol-function name))) - ;; Follow aliases, so methods applied to obsolete aliases still work. - (setq name (symbol-function name))) - (unless (and (fboundp name) - (eq (symbol-function name) body)) - (defalias name body))) - -;;;###autoload -(defmacro defgeneric (method args &optional doc-string) - "Create a generic function METHOD. -DOC-STRING is the base documentation for this class. A generic -function has no body, as its purpose is to decide which method body -is appropriate to use. Uses `defmethod' to create methods, and calls -`defgeneric' for you. With this implementation the ARGS are -currently ignored. You can use `defgeneric' to apply specialized -top level documentation to a method." - (declare (doc-string 3) (obsolete cl-defgeneric "25.1") - (indent defun)) - `(eieio--defalias ',method - (eieio--defgeneric-init-form - ',method - ,(if doc-string (help-add-fundoc-usage doc-string args))))) - -;;;###autoload -(defmacro defmethod (method &rest args) - "Create a new METHOD through `defgeneric' with ARGS. - -The optional second argument KEY is a specifier that -modifies how the method is called, including: - :before - Method will be called before the :primary - :primary - The default if not specified - :after - Method will be called after the :primary - :static - First arg could be an object or class -The next argument is the ARGLIST. The ARGLIST specifies the arguments -to the method as with `defun'. The first argument can have a type -specifier, such as: - ((VARNAME CLASS) ARG2 ...) -where VARNAME is the name of the local variable for the method being -created. The CLASS is a class symbol for a class made with `defclass'. -A DOCSTRING comes after the ARGLIST, and is optional. -All the rest of the args are the BODY of the method. A method will -return the value of the last form in the BODY. - -Summary: - - (defmethod mymethod [:before | :primary | :after | :static] - ((typearg class-name) arg2 &optional opt &rest rest) - \"doc-string\" - body)" - (declare (doc-string 3) (obsolete cl-defmethod "25.1") - (indent defun) - (debug - (&define ; this means we are defining something - [&name sexp] ;Allow (setf ...) additionally to symbols. - ;; ^^ This is the methods symbol - [ &optional symbolp ] ; this is key :before etc - cl-generic-method-args ; arguments - [ &optional stringp ] ; documentation string - def-body ; part to be debugged - ))) - (let* ((key (if (keywordp (car args)) (pop args))) - (params (car args)) - (arg1 (car params)) - (fargs (if (consp arg1) - (cons (car arg1) (cdr params)) - params)) - (class (if (consp arg1) (nth 1 arg1))) - (code `(lambda ,fargs ,@(cdr args)))) - `(progn - ;; Make sure there is a generic and the byte-compiler sees it. - (defgeneric ,method ,args) - (eieio--defmethod ',method ',key ',class #',code)))) - -(defun eieio--generic-static-symbol-specializers (tag &rest _) - (cl-assert (or (null tag) (eieio--class-p tag))) - (when (eieio--class-p tag) - (let ((superclasses (eieio--generic-subclass-specializers tag)) - (specializers ())) - (dolist (superclass superclasses) - (push superclass specializers) - (push `(eieio--static ,(cadr superclass)) specializers)) - (nreverse specializers)))) - -(cl-generic-define-generalizer eieio--generic-static-symbol-generalizer - ;; Give it a slightly higher priority than `subclass' so that the - ;; interleaved list comes before subclass's non-interleaved list. - 61 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name))) - #'eieio--generic-static-symbol-specializers) -(cl-generic-define-generalizer eieio--generic-static-object-generalizer - ;; Give it a slightly higher priority than `class' so that the - ;; interleaved list comes before the class's non-interleaved list. - 51 #'cl--generic-struct-tag - (lambda (tag &rest _) - (and (symbolp tag) (setq tag (cl--find-class tag)) - (eieio--class-p tag) - (let ((superclasses (eieio--class-precedence-list tag)) - (specializers ())) - (dolist (superclass superclasses) - (setq superclass (eieio--class-name superclass)) - (push superclass specializers) - (push `(eieio--static ,superclass) specializers)) - (nreverse specializers))))) - -(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static))) - (list eieio--generic-static-symbol-generalizer - eieio--generic-static-object-generalizer)) - -;;;###autoload -(defun eieio--defgeneric-init-form (method doc-string) - (if doc-string (put method 'function-documentation doc-string)) - (if (memq method '(no-next-method no-applicable-method)) - (symbol-function method) - (let ((generic (cl-generic-ensure-function method))) - (or (symbol-function (cl--generic-name generic)) - (cl--generic-make-function generic))))) - -;;;###autoload -(defun eieio--defmethod (method kind argclass code) - (setq kind (intern (downcase (symbol-name kind)))) - (let* ((specializer (if (not (eq kind :static)) - (or argclass t) - (setq kind nil) - `(eieio--static ,argclass))) - (uses-cnm (not (memq kind '(:before :after)))) - (specializers `((arg ,specializer))) - (code - ;; Backward compatibility for `no-next-method' and - ;; `no-applicable-method', which have slightly different calling - ;; convention than their cl-generic counterpart. - (pcase method - ('no-next-method - (setq method 'cl-no-next-method) - (setq specializers `(generic method ,@specializers)) - (lambda (_generic _method &rest args) (apply code args))) - ('no-applicable-method - (setq method 'cl-no-applicable-method) - (setq specializers `(generic ,@specializers)) - (lambda (generic arg &rest args) - (apply code arg (cl--generic-name generic) (cons arg args)))) - (_ code)))) - (cl-generic-define-method - method (unless (memq kind '(nil :primary)) (list kind)) - specializers uses-cnm - (if uses-cnm - (let* ((docstring (documentation code 'raw)) - (args (help-function-arglist code 'preserve-names)) - (doc-only (if docstring - (let ((split (help-split-fundoc docstring nil))) - (if split (cdr split) docstring))))) - (lambda (cnm &rest args) - (:documentation - (help-add-fundoc-usage doc-only (cons 'cl-cnm args))) - (cl-letf (((symbol-function 'call-next-method) cnm) - ((symbol-function 'next-method-p) - (lambda () (cl--generic-isnot-nnm-p cnm)))) - (apply code args)))) - code)) - ;; The old EIEIO code did not signal an error when there are methods - ;; applicable but only of the before/after kind. So if we add a :before - ;; or :after, make sure there's a matching dummy primary. - (when (and (memq kind '(:before :after)) - ;; FIXME: Use `cl-find-method'? - (not (cl-find-method method () - (mapcar (lambda (arg) - (if (consp arg) (nth 1 arg) t)) - specializers)))) - (cl-generic-define-method method () specializers t - (lambda (cnm &rest args) - (if (cl--generic-isnot-nnm-p cnm) - (apply cnm args))))) - method)) - -;; Compatibility with code which tries to catch `no-method-definition' errors. -(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions)) - -(defun generic-p (fname) (not (null (cl--generic fname)))) - -(defun no-next-method (&rest args) - (declare (obsolete cl-no-next-method "25.1")) - (apply #'cl-no-next-method 'unknown nil args)) - -(defun no-applicable-method (object method &rest args) - (declare (obsolete cl-no-applicable-method "25.1")) - (apply #'cl-no-applicable-method method object args)) - -(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1") -(defun next-method-p () - (declare (obsolete cl-next-method-p "25.1")) - ;; EIEIO's `next-method-p' just returned nil when called in an - ;; invalid context. - (message "next-method-p called outside of a primary or around method") - nil) - -;;;###autoload -(defun eieio-defmethod (method args) - "Obsolete work part of an old version of the `defmethod' macro." - (declare (obsolete cl-defmethod "24.1")) - (eval `(defmethod ,method ,@args)) - method) - -;;;###autoload -(defun eieio-defgeneric (method doc-string) - "Obsolete work part of an old version of the `defgeneric' macro." - (declare (obsolete cl-defgeneric "24.1")) - (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string)))) - ;; Return the method - 'method) - -;;;###autoload -(defun eieio-defclass (cname superclasses slots options) - (declare (obsolete eieio-defclass-internal "25.1")) - (eval `(defclass ,cname ,superclasses ,slots ,@options))) - - -;; Local Variables: -;; generated-autoload-file: "eieio-loaddefs.el" -;; End: - -(provide 'eieio-compat) - -;;; eieio-compat.el ends here commit 4fedbfbfca87849db343c09c4006b52c845f95d2 Merge: 53cf2cf81b d4e2850b32 Author: Stefan Kangas Date: Mon Dec 27 06:32:28 2021 +0100 Merge from origin/emacs-28 d4e2850b32 Update to Org 9.5.2-3-geb9f34 commit 53cf2cf81b224aab8a777aea847fbdc1e7a6b903 Author: Po Lu Date: Mon Dec 27 12:43:11 2021 +0800 * src/pgtkterm.c (pgtk_handle_event): Add pinch event support. diff --git a/src/pgtkterm.c b/src/pgtkterm.c index c6b56b271e..c75dab5130 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -4812,8 +4812,44 @@ pgtk_any_window_to_frame (GdkWindow * window) } static gboolean -pgtk_handle_event (GtkWidget * widget, GdkEvent * event, gpointer * data) +pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) { +#if GTK_CHECK_VERSION (3, 18, 0) + struct frame *f; + union buffered_input_event inev; + GtkWidget *frame_widget; + gint x, y; + + if (event->type == GDK_TOUCHPAD_PINCH + && (event->touchpad_pinch.phase + != GDK_TOUCHPAD_GESTURE_PHASE_END)) + { + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + frame_widget = FRAME_GTK_WIDGET (f); + + gtk_widget_translate_coordinates (widget, frame_widget, + lrint (event->touchpad_pinch.x), + lrint (event->touchpad_pinch.y), + &x, &y); + if (f) + { + + inev.ie.kind = PINCH_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + inev.ie.arg = list4 (make_float (event->touchpad_pinch.dx), + make_float (event->touchpad_pinch.dy), + make_float (event->touchpad_pinch.scale), + make_float (event->touchpad_pinch.angle_delta)); + inev.ie.modifiers = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), + event->touchpad_pinch.state); + evq_enqueue (&inev); + } + + return TRUE; + } +#endif return FALSE; } commit f522a064cf1ec8804fb938886b10bc82650e1a68 Author: Stefan Kangas Date: Mon Dec 27 03:07:50 2021 +0100 perl-mode: Recognize "when"/"given" keywords * lisp/progmodes/perl-mode.el (perl-font-lock-keywords-2): Add keywords "when", "given" and "default". (Bug#10560) (perl--syntax-exp-intro-keywords): Add "printf". * test/manual/indent/perl.perl: Add test for "when"/"given". diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 20834dd2e1..d4e4f07b76 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -191,7 +191,9 @@ ,(concat "\\<" (regexp-opt '("if" "until" "while" "elsif" "else" "unless" "do" "dump" "for" "foreach" "exit" "die" - "BEGIN" "END" "return" "exec" "eval") t) + "BEGIN" "END" "return" "exec" "eval" + "when" "given" "default") + t) "\\>") ;; ;; Fontify declarators and prefixes as types. @@ -212,7 +214,7 @@ (eval-and-compile (defconst perl--syntax-exp-intro-keywords - '("split" "if" "unless" "until" "while" "print" + '("split" "if" "unless" "until" "while" "print" "printf" "grep" "map" "not" "or" "and" "for" "foreach" "return")) (defconst perl--syntax-exp-intro-regexp diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl index 6ec04303b4..db94552a92 100755 --- a/test/manual/indent/perl.perl +++ b/test/manual/indent/perl.perl @@ -95,3 +95,15 @@ END s #lmn#opq#g; # FIXME: this should be a comment starting with "#lmn" /lmn/rst/g; # and this is the actual regular expression print; # prints "rstrst\n" + +given ($num) { + when ($num>10) { + printf "number is greater than 10\n"; + } + when ($num<10) { + printf "number is less than 10\n"; + } + default { + printf "number is equal to 10\n"; + } +} commit d9977018e045be002f2b48254215fda5f3a067fc Author: Po Lu Date: Mon Dec 27 10:02:39 2021 +0800 Fix menu window persistence and entry/leave events on Lucid on XI2 * src/xmenu.c (x_activate_menubar): Always clear the XI2 grab on Xt. * src/xterm.c (handle_one_xevent): On XI2, ignore LeaveNotify events coming from the shell widget and use `x_window_to_frame' to find the frame when handling XI_Leave events. diff --git a/src/xmenu.c b/src/xmenu.c index 9b0353f133..f3b7c45fff 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -448,11 +448,11 @@ x_activate_menubar (struct frame *f) XPutBackEvent (f->output_data.x->display_info->display, f->output_data.x->saved_menu_event); #else -#ifdef USE_MOTIF -#ifdef HAVE_XINPUT2 +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - /* Clear the XI2 grab so Motif can set a core grab. Otherwise some - versions of Motif will emit a warning and hang. */ + /* Clear the XI2 grab so Motif or lwlib can set a core grab. + Otherwise some versions of Motif will emit a warning and hang, + and lwlib will fail to destroy the menu window. */ if (dpyinfo->num_devices) { @@ -460,7 +460,6 @@ x_activate_menubar (struct frame *f) XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, CurrentTime); } -#endif #endif XtDispatchEvent (f->output_data.x->saved_menu_event); #endif diff --git a/src/xterm.c b/src/xterm.c index 4ca68848d2..9a4f5d39e2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9388,6 +9388,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_detect_focus_change (dpyinfo, any, event, &inev.ie); f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); +#if defined HAVE_X_TOOLKIT && defined HAVE_XINPUT2 + /* The XI2 event mask is set on the frame widget, so this event + likely originates from the shell widget, which we aren't + interested in. */ + if (dpyinfo->supports_xi2) + f = NULL; +#endif if (f) { if (f == hlinfo->mouse_face_mouse_frame) @@ -10052,7 +10059,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, xi_event->time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); +#ifndef USE_X_TOOLKIT f = x_top_window_to_frame (dpyinfo, leave->event); +#else + /* On Xt builds that have XI2, the enter and leave event + masks are set on the frame widget's window. */ + f = x_window_to_frame (dpyinfo, leave->event); +#endif if (f) { if (f == hlinfo->mouse_face_mouse_frame) commit 2ccb1568876f6ac7d8b980d60d91a689e797ab36 Author: Po Lu Date: Mon Dec 27 09:16:18 2021 +0800 Fix Lucid popup menu being stuck on XI2 builds * src/xmenu.c (x_activate_menubar): Make some changes conditional on XI2. (create_and_show_popup_menu): Clear XI2 grab before showing popup. * src/xterm.c (xi_grab_or_ungrab_device): Don't grab device if popup is activated on Lucid. diff --git a/src/xmenu.c b/src/xmenu.c index 4d969fa25f..9b0353f133 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -449,6 +449,7 @@ x_activate_menubar (struct frame *f) f->output_data.x->saved_menu_event); #else #ifdef USE_MOTIF +#ifdef HAVE_XINPUT2 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); /* Clear the XI2 grab so Motif can set a core grab. Otherwise some versions of Motif will emit a warning and hang. */ @@ -459,6 +460,7 @@ x_activate_menubar (struct frame *f) XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, CurrentTime); } +#endif #endif XtDispatchEvent (f->output_data.x->saved_menu_event); #endif @@ -1461,7 +1463,17 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); +#if defined HAVE_XINPUT2 && defined USE_LUCID + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + /* Clear the XI2 grab so lwlib can set a core grab. */ + if (dpyinfo->num_devices) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, + CurrentTime); + } +#endif /* Display the menu. */ lw_popup_menu (menu, &dummy); popup_activated_flag = 1; diff --git a/src/xterm.c b/src/xterm.c index 8ba4f46c2c..4ca68848d2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -638,7 +638,7 @@ xi_grab_or_ungrab_device (struct xi_device_t *device, XISetMask (m, XI_Leave); if (device->grab -#ifdef USE_MOTIF +#if defined USE_MOTIF || defined USE_LUCID && !popup_activated () #endif ) commit 736bf3aaa72e8fdd1c37bb9c8d003b17ffb612f9 Author: Po Lu Date: Mon Dec 27 09:02:20 2021 +0800 Store sign separately when accumulating precision scroll momentum * lisp/pixel-scroll.el (pixel-scroll-kinetic-state): Return vector in new format. (pixel-scroll-accumulate-velocity): Use new sign field. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 3abd4b2a72..e3a1729521 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -680,10 +680,10 @@ wheel." (defun pixel-scroll-kinetic-state () "Return the kinetic scroll state of the current window. -It is a vector of the form [ VELOCITY TIME ]." +It is a vector of the form [ VELOCITY TIME SIGN ]." (or (window-parameter nil 'kinetic-state) (set-window-parameter nil 'kinetic-state - (vector (make-ring 10) nil)))) + (vector (make-ring 10) nil nil)))) (defun pixel-scroll-accumulate-velocity (delta) "Accumulate DELTA into the current window's kinetic scroll state." @@ -693,9 +693,9 @@ It is a vector of the form [ VELOCITY TIME ]." (when (or (and time (> (- (float-time) time) 0.5)) (and (not (ring-empty-p ring)) (not (eq (< delta 0) - (< (cdr (ring-ref ring 0)) - 0))))) + (aref state 2))))) (aset state 0 (make-ring 10))) + (aset state 2 (< delta 0)) (ring-insert (aref state 0) (cons (aset state 1 (float-time)) delta)))) commit d4e2850b323fdce7b4d658ece50f6071432deae8 (refs/remotes/origin/emacs-28) Author: Kyle Meyer Date: Sun Dec 26 16:37:26 2021 -0500 Update to Org 9.5.2-3-geb9f34 diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 181516172d..01184200d7 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.5.1} +\def\orgversionnumber{9.5.2} \def\versionyear{2021} % latest update \input emacsver.tex diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 8c4a5957b9..17af2ae5b0 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -284,14 +284,25 @@ then create one. Return the initialized session. The current (defun org-babel-gnuplot-table-to-data (table data-file params) "Export TABLE to DATA-FILE in a format readable by gnuplot. Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (require 'ox-org) (with-temp-file data-file (insert (let ((org-babel-gnuplot-timestamp-fmt (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S"))) - (orgtbl-to-generic - table - (org-combine-plists - '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field :raw t :backend ascii) - params))))) + (replace-regexp-in-string + ;; org export backend adds "|" at the beginning/end of + ;; the table lines. Strip those. + "^|\\(.+\\)|$" + "\\1" + (orgtbl-to-generic + table + (org-combine-plists + '( :sep "\t" :fmt org-babel-gnuplot-quote-tsv-field + ;; Two setting below are needed to make :fmt work. + :raw t + ;; Use `org', not `ascii' because `ascii' may + ;; sometimes mishandle quoted strings. + :backend org) + params)))))) data-file) (provide 'ob-gnuplot) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 143ed4f123..6f83fe2bcb 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1747,7 +1747,7 @@ Optional argument N tells to change by that many units." (org-clock-timestamps-change 'up n)) (defun org-clock-timestamps-down (&optional n) - "Increase CLOCK timestamps at cursor. + "Decrease CLOCK timestamps at cursor. Optional argument N tells to change by that many units." (interactive "P") (org-clock-timestamps-change 'down n)) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 514f82ea4a..1053bbe22c 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.5.1")) + (let ((org-release "9.5.2")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5.1-31-ga18849")) + (let ((org-git-version "release_9.5.2-3-geb9f34")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index f784369f95..d58f6af550 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; Homepage: https://orgmode.org ;; Package-Requires: ((emacs "25.1")) -;; Version: 9.5.1 +;; Version: 9.5.2 ;; This file is part of GNU Emacs. ;; @@ -5114,7 +5114,6 @@ stacked delimiters is N. Escaping delimiters is not possible." '(invisible t)) (add-text-properties (match-beginning 3) (match-end 3) '(invisible t))) - (goto-char (match-end 0)) (throw :exit t)))))))) (defun org-emphasize (&optional char) commit d4353da0ad969a492c75bae130aed33ab204ed32 Author: Stefan Kangas Date: Sun Dec 26 21:52:56 2021 +0100 Use defvar-keymap in tests * test/lisp/button-tests.el (button-tests--map): * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-keymap): * test/lisp/help-tests.el (help-tests-remap-map) (help-tests-major-mode-map, help-tests-minor-mode-map): * test/lisp/kmacro-tests.el (kmacro-tests-keymap): * test/lisp/repeat-tests.el (repeat-tests-map) (repeat-tests-repeat-map): * test/src/keymap-tests.el (keymap-tests-minor-mode-map) (keymap-tests-major-mode-map): Use defvar-keymap. diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el index 2f5ad795df..a88387e025 100644 --- a/test/lisp/button-tests.el +++ b/test/lisp/button-tests.el @@ -21,11 +21,9 @@ (require 'ert) -(defvar button-tests--map - (let ((map (make-sparse-keymap))) - (define-key map "x" #'ignore) - map) - "Keymap for testing command substitution.") +(defvar-keymap button-tests--map + :doc "Keymap for testing command substitution." + "x" #'ignore) (ert-deftest button-at () "Test `button-at' behavior." diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 210bf24880..3ab5ac6a9a 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -53,22 +53,20 @@ Since `should' failures which happen inside `post-command-hook' will be trapped by the command loop, this preserves them until we get back to the top level.") -(defvar edebug-tests-keymap - (let ((map (make-sparse-keymap))) - (define-key map "@" 'edebug-tests-call-instrumented-func) - (define-key map "C-u" 'universal-argument) - (define-key map "C-p" 'previous-line) - (define-key map "C-n" 'next-line) - (define-key map "C-b" 'backward-char) - (define-key map "C-a" 'move-beginning-of-line) - (define-key map "C-e" 'move-end-of-line) - (define-key map "C-k" 'kill-line) - (define-key map "M-x" 'execute-extended-command) - (define-key map "C-M-x" 'eval-defun) - (define-key map "C-x X b" 'edebug-set-breakpoint) - (define-key map "C-x X w" 'edebug-where) - map) - "Keys used by the keyboard macros in Edebug's tests.") +(defvar-keymap edebug-tests-keymap + :doc "Keys used by the keyboard macros in Edebug's tests." + "@" 'edebug-tests-call-instrumented-func + "C-u" 'universal-argument + "C-p" 'previous-line + "C-n" 'next-line + "C-b" 'backward-char + "C-a" 'move-beginning-of-line + "C-e" 'move-end-of-line + "C-k" 'kill-line + "M-x" 'execute-extended-command + "C-M-x" 'eval-defun + "C-x X b" 'edebug-set-breakpoint + "C-x X w" 'edebug-where) ;;; Macros for defining tests: diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index a1ae838239..65b329c1cd 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -166,12 +166,11 @@ M-g M-c switch-to-completions (test "\\\\[abort-recursive-edit]" "C-]") (test "\\\\[eval-defun]" "C-M-x"))) -(defvar help-tests-remap-map - (let ((map (make-keymap))) - (define-key map (kbd "x") 'foo) - (define-key map (kbd "y") 'bar) - (define-key map [remap foo] 'bar) - map)) +(defvar-keymap help-tests-remap-map + :full t + "x" 'foo + "y" 'bar + " " 'bar) (ert-deftest help-tests-substitute-command-keys/remap () (should (equal (substitute-command-keys "\\\\[foo]") "y")) @@ -235,30 +234,28 @@ M-g M-c switch-to-completions (goto-char (point-min)) (should (looking-at "Type RET on")))) -(defvar help-tests-major-mode-map - (let ((map (make-keymap))) - (define-key map "x" 'foo-original) - (define-key map "1" 'foo-range) - (define-key map "2" 'foo-range) - (define-key map "3" 'foo-range) - (define-key map "4" 'foo-range) - (define-key map (kbd "C-e") 'foo-something) - (define-key map '[F1] 'foo-function-key1) - (define-key map "(" 'short-range) - (define-key map ")" 'short-range) - (define-key map "a" 'foo-other-range) - (define-key map "b" 'foo-other-range) - (define-key map "c" 'foo-other-range) - map)) +(defvar-keymap help-tests-major-mode-map + :full t + "x" 'foo-original + "1" 'foo-range + "2" 'foo-range + "3" 'foo-range + "4" 'foo-range + "C-e" 'foo-something + "" 'foo-function-key1 + "(" 'short-range + ")" 'short-range + "a" 'foo-other-range + "b" 'foo-other-range + "c" 'foo-other-range) (define-derived-mode help-tests-major-mode nil "Major mode for testing shadowing.") -(defvar help-tests-minor-mode-map - (let ((map (make-keymap))) - (define-key map "x" 'foo-shadow) - (define-key map (kbd "C-e") 'foo-shadow) - map)) +(defvar-keymap help-tests-minor-mode-map + :full t + "x" 'foo-shadow + "C-e" 'foo-shadow) (define-minor-mode help-tests-minor-mode "Minor mode for testing shadowing.") diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index ecd3d5fc22..49b4093538 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -91,33 +91,30 @@ body in KEYS-AND-BODY." ,docstring ,@keys (kmacro-tests-with-kmacro-clean-slate ,@body)))) -(defvar kmacro-tests-keymap - (let ((map (make-sparse-keymap))) - (dotimes (i 26) - (define-key map (string (+ ?a i)) 'self-insert-command)) - (dotimes (i 10) - (define-key map (string (+ ?0 i)) 'self-insert-command)) - ;; Define a few key sequences of different lengths. - (dolist (item '(("\C-a" . beginning-of-line) - ("\C-b" . backward-char) - ("\C-e" . end-of-line) - ("\C-f" . forward-char) - ("\C-r" . isearch-backward) - ("\C-u" . universal-argument) - ("\C-w" . kill-region) - ("\C-SPC" . set-mark-command) - ("\M-w" . kill-ring-save) - ("\M-x" . execute-extended-command) - ("\C-cd" . downcase-word) - ("\C-cxu" . upcase-word) - ("\C-cxq" . quoted-insert) - ("\C-cxi" . kmacro-insert-counter) - ("\C-x\C-k" . kmacro-keymap))) - (define-key map (car item) (cdr item))) - map) - "Keymap to use for testing keyboard macros. +(defvar-keymap kmacro-tests-keymap + :doc "Keymap to use for testing keyboard macros. This is used to obtain consistent results even if tests are run -in an environment with rebound keys.") +in an environment with rebound keys." + ;; Define a few key sequences of different lengths. + "C-a" 'beginning-of-line + "C-b" 'backward-char + "C-e" 'end-of-line + "C-f" 'forward-char + "C-r" 'isearch-backward + "C-u" 'universal-argument + "C-w" 'kill-region + "C-SPC" 'set-mark-command + "M-w" 'kill-ring-save + "M-x" 'execute-extended-command + "C-c d" 'downcase-word + "C-c x u" 'upcase-word + "C-c x q" 'quoted-insert + "C-c x i" 'kmacro-insert-counter + "C-x C-k" 'kmacro-keymap) +(dotimes (i 26) + (keymap-set kmacro-tests-keymap (string (+ ?a i)) 'self-insert-command)) +(dotimes (i 10) + (keymap-set kmacro-tests-keymap (string (+ ?0 i)) 'self-insert-command)) (defvar kmacro-tests-events nil "Input events used by the kmacro test in progress.") diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el index 02d9ddbc96..84a4d722a8 100644 --- a/test/lisp/repeat-tests.el +++ b/test/lisp/repeat-tests.el @@ -34,20 +34,16 @@ (interactive "p") (push `(,arg b) repeat-tests-calls)) -(defvar repeat-tests-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-x w a") 'repeat-tests-call-a) - (define-key map (kbd "M-C-a") 'repeat-tests-call-a) - (define-key map (kbd "M-C-z") 'repeat-tests-call-a) - map) - "Keymap for keys that initiate repeating sequences.") - -(defvar repeat-tests-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "a" 'repeat-tests-call-a) - (define-key map "b" 'repeat-tests-call-b) - map) - "Keymap for repeating sequences.") +(defvar-keymap repeat-tests-map + :doc "Keymap for keys that initiate repeating sequences." + "C-x w a" 'repeat-tests-call-a + "C-M-a" 'repeat-tests-call-a + "C-M-z" 'repeat-tests-call-a) + +(defvar-keymap repeat-tests-repeat-map + :doc "Keymap for repeating sequences." + "a" 'repeat-tests-call-a + "b" 'repeat-tests-call-b) (put 'repeat-tests-call-a 'repeat-map 'repeat-tests-repeat-map) (put 'repeat-tests-call-b 'repeat-map repeat-tests-repeat-map) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index bee48351e1..71fd972429 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -276,15 +276,11 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." (should (equal (where-is-internal 'foo map t) [?y])) (should (equal (where-is-internal 'bar map t) [?y])))) -(defvar keymap-tests-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "x" 'keymap-tests--command-2) - map)) +(defvar-keymap keymap-tests-minor-mode-map + "x" 'keymap-tests--command-2) -(defvar keymap-tests-major-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "x" 'keymap-tests--command-1) - map)) +(defvar-keymap keymap-tests-major-mode-map + "x" 'keymap-tests--command-1) (define-minor-mode keymap-tests-minor-mode "Test.") commit d8fc436bbb73634bae4b57a1a92ec6588ed2c5b1 Author: Stefan Kangas Date: Sun Dec 26 17:51:15 2021 +0100 Prefer the defcustom :risky property in gnus * lisp/gnus/gnus-art.el (gnus-button-alist) (gnus-header-button-alist): * lisp/gnus/gnus-group.el (gnus-group-highlight) (gnus-group-icon-list): * lisp/gnus/gnus-sum.el (gnus-summary-highlight): * lisp/gnus/mm-util.el (mm-charset-eval-alist): Prefer the defcustom :risky property to setting 'risky-local-variable manually. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 3b3564fc30..545b55bbea 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7935,8 +7935,8 @@ variable is the real callback function." (function :tag "Callback") (repeat :tag "Par" :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-button-alist 'risky-local-variable t) + (integer :tag "Regexp group")))) + :risky t) (defcustom gnus-header-button-alist '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" @@ -7975,8 +7975,8 @@ HEADER is a regexp to match a header. For a fuller explanation, see (function :tag "Callback") (repeat :tag "Par" :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-header-button-alist 'risky-local-variable t) + (integer :tag "Regexp group")))) + :risky t) ;;; Commands: diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2ec001faee..b04293067c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -380,8 +380,8 @@ variables in the Lisp expression: `group-age': Time in seconds since the group was last read (see info node `(gnus)Group Timestamp')." :group 'gnus-group-visual - :type '(repeat (cons (sexp :tag "Form") face))) -(put 'gnus-group-highlight 'risky-local-variable t) + :type '(repeat (cons (sexp :tag "Form") face)) + :risky t) (defcustom gnus-new-mail-mark ?% "Mark used for groups with new mail." @@ -409,8 +409,8 @@ requires an understanding of Lisp expressions. Hopefully this will change in a future release. For now, you can use the same variables in the Lisp expression as in `gnus-group-highlight'." :group 'gnus-group-icons - :type '(repeat (cons (sexp :tag "Form") file))) -(put 'gnus-group-icon-list 'risky-local-variable t) + :type '(repeat (cons (sexp :tag "Form") file)) + :risky t) (defcustom gnus-group-name-charset-method-alist nil "Alist of method and the charset for group names. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index adcc0dbd7b..cda6712f0d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1182,8 +1182,8 @@ mark: The article's mark. uncached: Non-nil if the article is uncached." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) - face))) -(put 'gnus-summary-highlight 'risky-local-variable t) + face)) + :risky t) (defcustom gnus-alter-header-function nil "Function called to allow alteration of article header structures. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index ddc228e490..a0b3288f13 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -101,9 +101,9 @@ version, you could use `autoload-coding-system' here." :type '(list (repeat :inline t :tag "Other options" (cons (symbol :tag "charset") - (symbol :tag "form")))) + (symbol :tag "form")))) + :risky t :group 'mime) -(put 'mm-charset-eval-alist 'risky-local-variable t) (defvar mm-charset-override-alist) commit 83e0acdf6e397eb2d340f3816d0991f2d6f05570 Author: Stefan Kangas Date: Sun Dec 26 17:25:31 2021 +0100 ; * lisp/subr.el (define-keymap): Fix typos. diff --git a/lisp/subr.el b/lisp/subr.el index 9c07606100..b77afaca94 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6549,10 +6549,10 @@ not a list, return a one-element list containing OBJECT." form) (defun define-keymap (&rest definitions) - "Create a new keymap and define KEY/DEFEFINITION pairs as key sequences. + "Create a new keymap and define KEY/DEFINITION pairs as key sequences. The new keymap is returned. -Options can be given as keywords before the KEY/DEFEFINITION +Options can be given as keywords before the KEY/DEFINITION pairs. Available keywords are: :full If non-nil, create a chartable alist (see `make-keymap'). commit 6ad79059d2f843a1be617c72ae0e9d8a02c9a203 Author: Stefan Kangas Date: Sun Dec 26 16:52:54 2021 +0100 Rewrite disabled-command to use read-multiple-choice * lisp/novice.el (disabled-command-function): Rewrite to use read-multiple-choice. Use command substitutions. diff --git a/lisp/novice.el b/lisp/novice.el index a4d043574a..0cf54df160 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -43,70 +43,65 @@ If nil, the feature is disabled, i.e., all commands work normally.") ;; because we won't get called otherwise. ;;;###autoload (defun disabled-command-function (&optional cmd keys) - (unless cmd (setq cmd this-command)) - (unless keys (setq keys (this-command-keys))) - (let (char) - (save-window-excursion - (with-output-to-temp-buffer "*Disabled Command*" ;; (help-buffer) - (if (or (eq (aref keys 0) - (if (stringp keys) - (aref "\M-x" 0) - ?\M-x)) - (and (>= (length keys) 2) - (eq (aref keys 0) meta-prefix-char) - (eq (aref keys 1) ?x))) - (princ (format "You have invoked the disabled command %s.\n" cmd)) - (princ (format "You have typed %s, invoking disabled command %s.\n" - (key-description keys) cmd))) - ;; Print any special message saying why the command is disabled. - (if (stringp (get cmd 'disabled)) - (princ (get cmd 'disabled)) - (princ "It is disabled because new users often find it confusing.\n") - (princ (substitute-command-keys - "Here's the first part of its description:\n\n")) - ;; Keep only the first paragraph of the documentation. - (with-current-buffer "*Disabled Command*" ;; standard-output - (goto-char (point-max)) - (let ((start (point))) - (save-excursion - (princ (or (condition-case () - (documentation cmd) - (error nil)) - "<< not documented >>"))) - (if (search-forward "\n\n" nil t) - (delete-region (match-beginning 0) (point-max))) - (goto-char (point-max)) - (indent-rigidly start (point) 3)))) - (princ "\n\nDo you want to use this command anyway?\n\n") - (princ (substitute-command-keys "You can now type -y to try it and enable it (no questions if you use it again). -n to cancel--don't try the command, and it remains disabled. -SPC to try the command just this once, but leave it disabled. -! to try it, and enable all disabled commands for this session only.")) - ;; Redundant since with-output-to-temp-buffer will do it anyway. - ;; (with-current-buffer standard-output - ;; (help-mode)) - ) - (fit-window-to-buffer (get-buffer-window "*Disabled Command*")) - (let ((cursor-in-echo-area t)) - (while (progn (setq char (read-event - "Type y, n, ! or SPC (the space bar): ")) - (or (not (numberp char)) - (not (memq (downcase char) - '(?! ?y ?n ?\s ?\C-g))))) - (ding)))) - (setq char (downcase char)) + (let* ((cmd (or cmd this-command)) + (keys (or keys (this-command-keys))) + (help-string + (concat + (if (or (eq (aref keys 0) + (if (stringp keys) + (aref "\M-x" 0) + ?\M-x)) + (and (>= (length keys) 2) + (eq (aref keys 0) meta-prefix-char) + (eq (aref keys 1) ?x))) + (format "You have invoked the disabled command %s.\n" cmd) + (substitute-command-keys + (format "You have typed \\`%s', invoking disabled command %s.\n" + (key-description keys) cmd))) + ;; Any special message saying why the command is disabled. + (if (stringp (get cmd 'disabled)) + (get cmd 'disabled) + (concat + "It is disabled because new users often find it confusing.\n" + (substitute-command-keys + "Here's the first part of its description:\n\n") + ;; Keep only the first paragraph of the documentation. + (with-temp-buffer + (insert (condition-case () + (documentation cmd) + (error "<< not documented >>"))) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (match-beginning 0) (point-max))) + (indent-rigidly (point-min) (point-max) 3) + (buffer-string)))) + (substitute-command-keys "\n +Do you want to use this command anyway? + +You can now type: + \\`y' to try it and enable it (no questions if you use it again). + \\`n' to cancel--don't try the command, and it remains disabled. + \\`SPC' to try the command just this once, but leave it disabled. + \\`!' to try it, and enable all disabled commands for this session only."))) + (char + (car (read-multiple-choice "Use this command?" + '((?y "yes") + (?n "no") + (?! "yes; enable for session") + (?\s "yes; once")) + help-string + "*Disabled Command*")))) (pcase char - (?\C-g (setq quit-flag t)) - (?! (setq disabled-command-function nil)) - (?y - (if (and user-init-file - (not (string= "" user-init-file)) - (y-or-n-p "Enable command for future editing sessions also? ")) - (enable-command cmd) - (put cmd 'disabled nil)))) - (or (char-equal char ?n) - (call-interactively cmd)))) + (?\C-g (setq quit-flag t)) + (?! (setq disabled-command-function nil)) + (?y + (if (and user-init-file + (not (string= "" user-init-file)) + (y-or-n-p "Enable command for future editing sessions also? ")) + (enable-command cmd) + (put cmd 'disabled nil)))) + (unless (char-equal char ?n) + (call-interactively cmd)))) (defun en/disable-command (command disable) (unless (commandp command) commit 40dcf9c2abd62425e599f30548dc53fa58fe2202 Author: Stefan Kangas Date: Sun Dec 26 06:47:15 2021 +0100 read-multiple-choice: Display "SPC" instead of " " * lisp/emacs-lisp/rmc.el (rmc--add-key-description): Improve display of the keys TAB, RET, SPC, DEL, and ESC. This fixes a bug where " " was highlighted in the description in a confusing way. * test/lisp/emacs-lisp/rmc-tests.el (test-rmc--add-key-description) (test-rmc--add-key-description/with-attributes): Update tests for the above change. diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 90fd8b370e..522d395eba 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -26,21 +26,23 @@ (require 'seq) (defun rmc--add-key-description (elem) - (let* ((name (cadr elem)) - (pos (seq-position name (car elem))) + (let* ((char (car elem)) + (name (cadr elem)) + (pos (seq-position name char)) + (desc (key-description (char-to-string char))) (graphical-terminal (display-supports-face-attributes-p '(:underline t) (window-frame))) (altered-name (cond - ;; Not in the name string. - ((not pos) - (let ((ch (char-to-string (car elem)))) - (format "[%s] %s" - (if graphical-terminal - (propertize ch 'face 'read-multiple-choice-face) - ch) - name))) + ;; Not in the name string, or a special character. + ((or (not pos) + (member desc '("ESC" "TAB" "RET" "DEL" "SPC"))) + (format "[%s] %s" + (if graphical-terminal + (propertize desc 'face 'read-multiple-choice-face) + desc) + name)) ;; The prompt character is in the name, so highlight ;; it on graphical terminals. (graphical-terminal @@ -57,7 +59,7 @@ (upcase (substring name pos (1+ pos))) "]" (substring name (1+ pos))))))) - (cons (car elem) altered-name))) + (cons char altered-name))) (defun rmc--show-help (prompt help-string show-help choices altered-names) (let* ((buf-name (if (stringp show-help) diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index a97254c46d..5a79c505ae 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -34,7 +34,9 @@ (should (equal (rmc--add-key-description '(?y "yes")) '(?y . "yes"))) (should (equal (rmc--add-key-description '(?n "foo")) - '(?n . "[n] foo"))))) + '(?n . "[n] foo"))) + (should (equal (rmc--add-key-description '(?\s "foo bar")) + `(?\s . "[SPC] foo bar"))))) (ert-deftest test-rmc--add-key-description/with-attributes () (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t))) @@ -43,7 +45,10 @@ `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es")))) (should (equal-including-properties (rmc--add-key-description '(?n "foo")) - `(?n . ,(concat "[" (propertize "n" 'face 'read-multiple-choice-face) "] foo")))))) + `(?n . ,(concat "[" (propertize "n" 'face 'read-multiple-choice-face) "] foo")))) + (should (equal-including-properties + (rmc--add-key-description '(?\s "foo bar")) + `(?\s . ,(concat "[" (propertize "SPC" 'face 'read-multiple-choice-face) "] foo bar")))))) (ert-deftest test-rmc--add-key-description/non-graphical-display () (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil))) commit 1e7786437d3d471bffe48d91a067556f9223e9cf Author: Stefan Kangas Date: Sun Dec 26 01:27:39 2021 +0100 read-multiple-choice: Add optional argument show-help * lisp/emacs-lisp/rmc.el (rmc--show-help): Factor out new function from read-multiple-choice. (read-multiple-choice): Add new optional argument show-help. * doc/lispref/commands.texi (Reading One Event): Document above new optional argument. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 31e4c5411c..b833b5bf85 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3032,7 +3032,7 @@ causes it to evaluate @code{help-form} and display the result. It then continues to wait for a valid input character, or keyboard-quit. @end defun -@defun read-multiple-choice prompt choices &optional help-string +@defun read-multiple-choice prompt choices &optional help-string show-help Ask user a multiple choice question. @var{prompt} should be a string that will be displayed as the prompt. @@ -3047,6 +3047,10 @@ a string with a more detailed description of all choices. It will be displayed in a help buffer instead of the default auto-generated description when the user types @kbd{?}. +If optional argument @var{show-help} is non-@code{nil}, the help +buffer will be displayed immediately, before any user input. If it is +a string, use it as the name of the help buffer. + The return value is the matching value from @var{choices}. @lisp diff --git a/etc/NEWS b/etc/NEWS index c9466d0fef..cfea513cca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -937,6 +937,10 @@ If non-nil, remove the definition from the keymap. This is subtly different from setting a definition to nil (when the keymap has a parent). ++++ +*** 'read-multiple-choice' now takes an optional SHOW-HELP argument. +If non-nil, show the help buffer immediately, before any user input. + +++ *** New function 'key-valid-p'. The 'kbd' function is quite permissive, and will try to return diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 6264220cd0..90fd8b370e 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -59,8 +59,65 @@ (substring name (1+ pos))))))) (cons (car elem) altered-name))) +(defun rmc--show-help (prompt help-string show-help choices altered-names) + (let* ((buf-name (if (stringp show-help) + show-help + "*Multiple Choice Help*")) + (buf (get-buffer-create buf-name))) + (if (stringp help-string) + (with-help-window buf + (with-current-buffer buf + (insert help-string))) + (with-help-window buf + (with-current-buffer buf + (erase-buffer) + (pop-to-buffer buf) + (insert prompt "\n\n") + (let* ((columns (/ (window-width) 25)) + (fill-column 21) + (times 0) + (start (point))) + (dolist (elem choices) + (goto-char start) + (unless (zerop times) + (if (zerop (mod times columns)) + ;; Go to the next "line". + (goto-char (setq start (point-max))) + ;; Add padding. + (while (not (eobp)) + (end-of-line) + (insert (make-string (max (- (* (mod times columns) + (+ fill-column 4)) + (current-column)) + 0) + ?\s)) + (forward-line 1)))) + (setq times (1+ times)) + (let ((text + (with-temp-buffer + (insert (format + "%c: %s\n" + (car elem) + (cdr (assq (car elem) altered-names)))) + (fill-region (point-min) (point-max)) + (when (nth 2 elem) + (let ((start (point))) + (insert (nth 2 elem)) + (unless (bolp) + (insert "\n")) + (fill-region start (point-max)))) + (buffer-string)))) + (goto-char start) + (dolist (line (split-string text "\n")) + (end-of-line) + (if (bolp) + (insert line "\n") + (insert line)) + (forward-line 1)))))))) + buf)) + ;;;###autoload -(defun read-multiple-choice (prompt choices &optional help-string) +(defun read-multiple-choice (prompt choices &optional help-string show-help) "Ask user to select an entry from CHOICES, promting with PROMPT. This function allows to ask the user a multiple-choice question. @@ -76,6 +133,9 @@ the optional argument HELP-STRING. This argument is a string that should contain a more detailed description of all of the possible choices. `read-multiple-choice' will display that description in a help buffer if the user requests that. +If optional argument SHOW-HELP is non-nil, show the help screen +immediately, before any user input. If SHOW-HELP is a string, +use it as the name of the help buffer. This function translates user input into responses by consulting the bindings in `query-replace-map'; see the documentation of @@ -101,8 +161,8 @@ Usage example: \\='((?a \"always\") (?s \"session only\") (?n \"no\")))" - (let* ((altered-names (mapcar #'rmc--add-key-description - (append choices '((?? "?"))))) + (let* ((choices (if show-help choices (append choices '((?? "?"))))) + (altered-names (mapcar #'rmc--add-key-description choices)) (full-prompt (format "%s (%s): " @@ -111,6 +171,9 @@ Usage example: tchar buf wrong-char answer) (save-window-excursion (save-excursion + (if show-help + (setq buf (rmc--show-help prompt help-string show-help + choices altered-names))) (while (not tchar) (message "%s%s" (if wrong-char @@ -166,57 +229,8 @@ Usage example: tchar nil) (when wrong-char (ding)) - (setq buf (get-buffer-create "*Multiple Choice Help*")) - (if (stringp help-string) - (with-help-window buf - (with-current-buffer buf - (insert help-string))) - (with-help-window buf - (with-current-buffer buf - (erase-buffer) - (pop-to-buffer buf) - (insert prompt "\n\n") - (let* ((columns (/ (window-width) 25)) - (fill-column 21) - (times 0) - (start (point))) - (dolist (elem choices) - (goto-char start) - (unless (zerop times) - (if (zerop (mod times columns)) - ;; Go to the next "line". - (goto-char (setq start (point-max))) - ;; Add padding. - (while (not (eobp)) - (end-of-line) - (insert (make-string (max (- (* (mod times columns) - (+ fill-column 4)) - (current-column)) - 0) - ?\s)) - (forward-line 1)))) - (setq times (1+ times)) - (let ((text - (with-temp-buffer - (insert (format - "%c: %s\n" - (car elem) - (cdr (assq (car elem) altered-names)))) - (fill-region (point-min) (point-max)) - (when (nth 2 elem) - (let ((start (point))) - (insert (nth 2 elem)) - (unless (bolp) - (insert "\n")) - (fill-region start (point-max)))) - (buffer-string)))) - (goto-char start) - (dolist (line (split-string text "\n")) - (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) - (forward-line 1)))))))))))) + (setq buf (rmc--show-help prompt help-string show-help + choices altered-names)))))) (when (buffer-live-p buf) (kill-buffer buf)) (assq tchar choices))) commit 787030b0212d5933c3e4a16ece60b4e2ba8caea4 Author: Stefan Kangas Date: Sun Dec 26 00:45:50 2021 +0100 read-multiple-choice: Add face when key not in name string * lisp/emacs-lisp/rmc.el (rmc--add-key-description): Add face property also when key is not in the name string. * test/lisp/emacs-lisp/rmc-tests.el (test-rmc--add-key-description/with-attributes) (test-rmc--add-key-description/non-graphical-display): Update tests. diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 2f4b10efbb..6264220cd0 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -28,15 +28,22 @@ (defun rmc--add-key-description (elem) (let* ((name (cadr elem)) (pos (seq-position name (car elem))) + (graphical-terminal + (display-supports-face-attributes-p + '(:underline t) (window-frame))) (altered-name (cond ;; Not in the name string. ((not pos) - (format "[%c] %s" (car elem) name)) + (let ((ch (char-to-string (car elem)))) + (format "[%s] %s" + (if graphical-terminal + (propertize ch 'face 'read-multiple-choice-face) + ch) + name))) ;; The prompt character is in the name, so highlight ;; it on graphical terminals. - ((display-supports-face-attributes-p - '(:underline t) (window-frame)) + (graphical-terminal (setq name (copy-sequence name)) (put-text-property pos (1+ pos) 'face 'read-multiple-choice-face diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index e858ed3940..a97254c46d 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; - ;;; Code: (require 'ert) @@ -45,13 +43,16 @@ `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es")))) (should (equal-including-properties (rmc--add-key-description '(?n "foo")) - '(?n . "[n] foo"))))) + `(?n . ,(concat "[" (propertize "n" 'face 'read-multiple-choice-face) "] foo")))))) (ert-deftest test-rmc--add-key-description/non-graphical-display () (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil))) (should (equal-including-properties (rmc--add-key-description '(?y "yes")) - '(?y . "[Y]es"))))) + '(?y . "[Y]es"))) + (should (equal-including-properties + (rmc--add-key-description '(?n "foo")) + '(?n . "[n] foo"))))) (ert-deftest test-read-multiple-choice () (dolist (char '(?y ?n)) @@ -60,6 +61,5 @@ (should (equal (list char str) (read-multiple-choice "Do it? " '((?y "yes") (?n "no")))))))) - (provide 'rmc-tests) ;;; rmc-tests.el ends here commit 68f15e815e0a475a13d8169cc5d163cf05e7e524 Author: Stefan Kangas Date: Sat Dec 25 22:58:59 2021 +0100 Factor out new function rmc--add-key-description * lisp/emacs-lisp/rmc.el (rmc--add-key-description): Factor out new function from... (read-multiple-choice): ...here. * test/lisp/emacs-lisp/rmc-tests.el (test-rmc--add-key-description) (test-rmc--add-key-description/with-attributes) (test-rmc--add-key-description/non-graphical-display): New tests. diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 8abe570e64..2f4b10efbb 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -25,6 +25,33 @@ (require 'seq) +(defun rmc--add-key-description (elem) + (let* ((name (cadr elem)) + (pos (seq-position name (car elem))) + (altered-name + (cond + ;; Not in the name string. + ((not pos) + (format "[%c] %s" (car elem) name)) + ;; The prompt character is in the name, so highlight + ;; it on graphical terminals. + ((display-supports-face-attributes-p + '(:underline t) (window-frame)) + (setq name (copy-sequence name)) + (put-text-property pos (1+ pos) + 'face 'read-multiple-choice-face + name) + name) + ;; And put it in [bracket] on non-graphical terminals. + (t + (concat + (substring name 0 pos) + "[" + (upcase (substring name pos (1+ pos))) + "]" + (substring name (1+ pos))))))) + (cons (car elem) altered-name))) + ;;;###autoload (defun read-multiple-choice (prompt choices &optional help-string) "Ask user to select an entry from CHOICES, promting with PROMPT. @@ -67,42 +94,13 @@ Usage example: \\='((?a \"always\") (?s \"session only\") (?n \"no\")))" - (let* ((altered-names nil) + (let* ((altered-names (mapcar #'rmc--add-key-description + (append choices '((?? "?"))))) (full-prompt (format "%s (%s): " prompt - (mapconcat - (lambda (elem) - (let* ((name (cadr elem)) - (pos (seq-position name (car elem))) - (altered-name - (cond - ;; Not in the name string. - ((not pos) - (format "[%c] %s" (car elem) name)) - ;; The prompt character is in the name, so highlight - ;; it on graphical terminals... - ((display-supports-face-attributes-p - '(:underline t) (window-frame)) - (setq name (copy-sequence name)) - (put-text-property pos (1+ pos) - 'face 'read-multiple-choice-face - name) - name) - ;; And put it in [bracket] on non-graphical terminals. - (t - (concat - (substring name 0 pos) - "[" - (upcase (substring name pos (1+ pos))) - "]" - (substring name (1+ pos))))))) - (push (cons (car elem) altered-name) - altered-names) - altered-name)) - (append choices '((?? "?"))) - ", "))) + (mapconcat (lambda (e) (cdr e)) altered-names ", "))) tchar buf wrong-char answer) (save-window-excursion (save-excursion diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index 9d8f3d4801..e858ed3940 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -28,8 +28,30 @@ (require 'ert) (require 'rmc) +(require 'cl-lib) (eval-when-compile (require 'cl-lib)) +(ert-deftest test-rmc--add-key-description () + (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t))) + (should (equal (rmc--add-key-description '(?y "yes")) + '(?y . "yes"))) + (should (equal (rmc--add-key-description '(?n "foo")) + '(?n . "[n] foo"))))) + +(ert-deftest test-rmc--add-key-description/with-attributes () + (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t))) + (should (equal-including-properties + (rmc--add-key-description '(?y "yes")) + `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es")))) + (should (equal-including-properties + (rmc--add-key-description '(?n "foo")) + '(?n . "[n] foo"))))) + +(ert-deftest test-rmc--add-key-description/non-graphical-display () + (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil))) + (should (equal-including-properties + (rmc--add-key-description '(?y "yes")) + '(?y . "[Y]es"))))) (ert-deftest test-read-multiple-choice () (dolist (char '(?y ?n)) commit 978987f7ad58cd66fe51cefde53ba4771b189aeb Author: Po Lu Date: Sun Dec 26 21:45:33 2021 +0800 * INSTALL: Document `--with-xinput2'. diff --git a/INSTALL b/INSTALL index 21298422af..9ecc50b6a8 100644 --- a/INSTALL +++ b/INSTALL @@ -324,6 +324,10 @@ Use --without-toolkit-scroll-bars to disable Motif or Xaw3d scroll bars. Use --without-xim to inhibit the default use of X Input Methods. In this case, the X resource useXIM can be used to turn on use of XIM. +Use --with-xinput2 to enable the use of version 2 of the X Input +Extension. This enables support for touchscreens, pinch gestures, and +scroll wheels that report scroll deltas at pixel-level precision. + Use --disable-largefile to omit support for files larger than 2GB, and --disable-year2038 to omit support for timestamps past the year 2038, on systems which allow omitting such support. This may help when commit 53093ce3662343a2d03174bc886e4469470673d7 Author: Eli Zaretskii Date: Sun Dec 26 14:21:36 2021 +0200 ; * doc/lispref/commands.texi (Misc Events): Fix wording. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 0268d4d73a..31e4c5411c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2095,7 +2095,7 @@ when the event occurred, @var{dx} is the change in the horizontal distance between the fingers since the last event in the same sequence, @var{dy} is the vertical movement of the fingers since the last event in the same sequence, @var{scale} is the ratio of the current distance -between the fingers and that distance at the start of the sequence, and +between the fingers to that distance at the start of the sequence, and @var{angle} is the angular difference in degrees between the direction of the line connecting the fingers in this event and the direction of that line in the last event of the same sequence. @@ -2109,10 +2109,13 @@ All arguments after @var{position} are floating point numbers. This event is usually sent as part of a sequence, which begins with the user placing two fingers on the touchpad, and ends with the user removing those fingers. @var{dx}, @var{dy}, and @var{angle} will be -@code{0.0} in the first event sent after a sequence begins. +@code{0.0} in the first event of a sequence; subsequent events will +report non-zero values for these members of the event structure. -@var{dx} and @var{dy} are represented in imaginary units, in which -@code{1.0} is the width and height of the touchpad respectively. +@var{dx} and @var{dy} are reported in imaginary relative units, in +which @code{1.0} is the width and height of the touchpad +respectively. They are usually interpreted as being relative to the +size of the object beneath the gesture: image, window, etc. @cindex @code{drag-n-drop} event @item (drag-n-drop @var{position} @var{files}) commit c609865258dbd16caf84e96c63db11a52c1d1cb5 Author: Po Lu Date: Sun Dec 26 20:07:47 2021 +0800 Accumulate deltas in pinch events that were skipped * src/keyboard.c (kbd_buffer_get_event): Accumulate relative deltas inside skipped events when coalescing them. diff --git a/src/keyboard.c b/src/keyboard.c index 304dff4a91..8b85911cc4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -65,6 +65,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include @@ -4037,6 +4038,8 @@ kbd_buffer_get_event (KBOARD **kbp, and build a real event from the queue entry. */ if (NILP (obj)) { + double pinch_dx, pinch_dy, pinch_angle; + /* Pinch events are often sent in rapid succession, so large amounts of such events have the potential to queue up inside the keyboard buffer. In that case, @@ -4048,11 +4051,16 @@ kbd_buffer_get_event (KBOARD **kbp, These events should always be sent so that we never miss a sequence starting, and they don't have the potential to queue up. */ - && (XFLOAT_DATA (XCAR (event->ie.arg)) != 0.0 + && ((pinch_dx + = XFLOAT_DATA (XCAR (event->ie.arg))) != 0.0 || XFLOAT_DATA (XCAR (XCDR (event->ie.arg))) != 0.0 - || XFLOAT_DATA (XCAR (XCDR (XCDR (event->ie.arg)))) != 1.0)) + || XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg)) != 0.0)) { union buffered_input_event *maybe_event = next_kbd_event (event); + + pinch_dy = XFLOAT_DATA (XCAR (XCDR (event->ie.arg))); + pinch_angle = XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg)); + while (maybe_event != kbd_store_ptr && maybe_event->ie.kind == PINCH_EVENT /* Make sure we never miss an event that has @@ -4066,9 +4074,21 @@ kbd_buffer_get_event (KBOARD **kbp, of a new pinch gesture sequence. */ && (XFLOAT_DATA (XCAR (maybe_event->ie.arg)) != 0.0 || XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))) != 0.0 - || XFLOAT_DATA (XCAR (XCDR (XCDR (maybe_event->ie.arg)))) != 1.0)) + || XFLOAT_DATA (Fnth (make_fixnum (3), + maybe_event->ie.arg)) != 0.0)) { event = maybe_event; + /* Add up relative deltas inside events we skip. */ + pinch_dx += XFLOAT_DATA (XCAR (maybe_event->ie.arg)); + pinch_dy += XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))); + pinch_angle += XFLOAT_DATA (Fnth (make_fixnum (3), + maybe_event->ie.arg)); + + XSETCAR (maybe_event->ie.arg, make_float (pinch_dx)); + XSETCAR (XCDR (maybe_event->ie.arg), make_float (pinch_dy)); + XSETCAR (Fnthcdr (make_fixnum (3), + maybe_event->ie.arg), + make_float (fmod (pinch_angle, 360.0))); maybe_event = next_kbd_event (event); } } commit e10369602499021cc4992e663465b696653888fd Author: Po Lu Date: Sun Dec 26 19:40:47 2021 +0800 Clarify situations where pinch events can be sent. * doc/lispref/commands.texi (Misc Events): Clarify the conditions under which pinch events will be sent. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index bfb1f5a947..0268d4d73a 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2100,6 +2100,10 @@ between the fingers and that distance at the start of the sequence, and of the line connecting the fingers in this event and the direction of that line in the last event of the same sequence. +As pinch events are only sent at the beginning or during a pinch +sequence, they do not report gestures where the user moves two fingers +on a touchpad in a rotating fashion without pinching the fingers. + All arguments after @var{position} are floating point numbers. This event is usually sent as part of a sequence, which begins with commit deab5f413fd0e335df39478726bfe1f631973238 Author: Po Lu Date: Sun Dec 26 19:36:18 2021 +0800 Coalesce pinch gestures in the keyboard buffer * src/keyboard.c (kbd_buffer_get_event): Coalesce consecutive pinch gesture events. diff --git a/src/keyboard.c b/src/keyboard.c index 5453811406..304dff4a91 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4037,6 +4037,42 @@ kbd_buffer_get_event (KBOARD **kbp, and build a real event from the queue entry. */ if (NILP (obj)) { + /* Pinch events are often sent in rapid succession, so + large amounts of such events have the potential to + queue up inside the keyboard buffer. In that case, + find the last pinch event in succession on the same + frame with the same modifiers, and send that instead. */ + + if (event->ie.kind == PINCH_EVENT + /* Ignore if this is the start of a pinch sequence. + These events should always be sent so that we + never miss a sequence starting, and they don't + have the potential to queue up. */ + && (XFLOAT_DATA (XCAR (event->ie.arg)) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (event->ie.arg))) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (XCDR (event->ie.arg)))) != 1.0)) + { + union buffered_input_event *maybe_event = next_kbd_event (event); + while (maybe_event != kbd_store_ptr + && maybe_event->ie.kind == PINCH_EVENT + /* Make sure we never miss an event that has + different modifiers. */ + && maybe_event->ie.modifiers == event->ie.modifiers + /* Make sure that the event is for the same + frame. */ + && EQ (maybe_event->ie.frame_or_window, + event->ie.frame_or_window) + /* Make sure that the event isn't the start + of a new pinch gesture sequence. */ + && (XFLOAT_DATA (XCAR (maybe_event->ie.arg)) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (XCDR (maybe_event->ie.arg)))) != 1.0)) + { + event = maybe_event; + maybe_event = next_kbd_event (event); + } + } + obj = make_lispy_event (&event->ie); #ifdef HAVE_EXT_MENU_BAR commit 97133fb3d0ae59e391a94c6189719318cb44a232 Author: Po Lu Date: Sun Dec 26 19:00:33 2021 +0800 Document the representation of DX and DY in pinch events * doc/lispref/commands.texi (Misc Events): Document the precise meaning of DX and DY in pinch events. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index dd36bace18..bfb1f5a947 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2107,6 +2107,9 @@ the user placing two fingers on the touchpad, and ends with the user removing those fingers. @var{dx}, @var{dy}, and @var{angle} will be @code{0.0} in the first event sent after a sequence begins. +@var{dx} and @var{dy} are represented in imaginary units, in which +@code{1.0} is the width and height of the touchpad respectively. + @cindex @code{drag-n-drop} event @item (drag-n-drop @var{position} @var{files}) This kind of event is generated when a group of files is commit 2958d0ec49713bd1f260a6058f80ca03530ccba4 Author: Po Lu Date: Sun Dec 26 18:51:48 2021 +0800 Document some missing commands related to text scaling * doc/emacs/display.texi (Text Scale): Document `text-scale-pinch' and `mouse-wheel-text-scale'. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 15cad88d59..f0dc8b776f 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -903,6 +903,20 @@ prefix argument. @code{text-scale-mode} if the current font scaling is other than 1, and disable it otherwise. +@cindex pinch to scale +@findex text-scale-pinch + The command @code{text-scale-pinch} increases or decreases the text +scale based on the distance between fingers on a touchpad when a pinch +gesture is performed by placing two fingers on a touchpad and moving +them towards or apart from each other. This is only available on some +systems with supported hardware. + +@findex mouse-wheel-text-scale + The command @code{mouse-wheel-text-scale} also changes the text +scale. Normally, it is run when you press @key{Ctrl} while moving the +mouse wheel. The text scale is increased when the wheel is moved +downwards, and it is decreased when the wheel is moved upwards. + @node Font Lock @section Font Lock mode @cindex Font Lock mode commit 9c0ad8893624b2decdb33adb82b88093b5e67d0e Author: Eli Zaretskii Date: Sun Dec 26 12:39:33 2021 +0200 ; * doc/lispref/commands.texi (Misc Events): Fix typos and wording. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 3306d1f019..dd36bace18 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2090,14 +2090,15 @@ what event types to expect for the mouse wheel. This kind of event is generated by the user performing a ``pinch'' gesture by placing two fingers on a touchpad and moving them towards or away from each other. @var{position} is a mouse position list -(@pxref{Click Events}) detailing the position of the mouse pointer -when the event occured, @var{dx} is the change between the horizontal -positions of the fingers since the last event in the same sequence, +(@pxref{Click Events}) that provides the position of the mouse pointer +when the event occurred, @var{dx} is the change in the horizontal +distance between the fingers since the last event in the same sequence, @var{dy} is the vertical movement of the fingers since the last event in the same sequence, @var{scale} is the ratio of the current distance -between the fingers and the distance at the start of the sequence, and -@var{angle} is the delta in degrees between the angles of the fingers -in this event and the fingers in the last event of the same sequence. +between the fingers and that distance at the start of the sequence, and +@var{angle} is the angular difference in degrees between the direction +of the line connecting the fingers in this event and the direction of +that line in the last event of the same sequence. All arguments after @var{position} are floating point numbers. commit 501e2096d65559645d305f5b22d80f9773d8cabf Author: Po Lu Date: Sun Dec 26 18:13:53 2021 +0800 Fix some issues with a recent change * doc/lispref/commands.texi (Misc Events): Improve documentation on pinch events. * etc/NEWS: Update documentation status for some recent changes and describe pinch events in more detail. * lisp/face-remap.el (text-scale-pinch): Prevent pinch events from being received in too quick succession. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index ccb9752841..3306d1f019 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2088,21 +2088,21 @@ what event types to expect for the mouse wheel. @cindex @code{pinch} event @item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle}) This kind of event is generated by the user performing a ``pinch'' -gesture with two fingers on a touchpad. @var{position} is a mouse -position list (@pxref{Click Events}) detailing the position of the -mouse cursor when the event occured, @var{dx} is the distance between -the horizontal positions of the fingers since the last event in the -same sequence, @var{dy} is the vertical movement of the fingers since -the last event in the same sequence, @var{scale} is the division of -the current distance between the fingers and the distance at the start -of the sequence, and @var{angle} is the delta in degrees between the -angles of the fingers in this event and the fingers in the last event -of the same sequence. +gesture by placing two fingers on a touchpad and moving them towards +or away from each other. @var{position} is a mouse position list +(@pxref{Click Events}) detailing the position of the mouse pointer +when the event occured, @var{dx} is the change between the horizontal +positions of the fingers since the last event in the same sequence, +@var{dy} is the vertical movement of the fingers since the last event +in the same sequence, @var{scale} is the ratio of the current distance +between the fingers and the distance at the start of the sequence, and +@var{angle} is the delta in degrees between the angles of the fingers +in this event and the fingers in the last event of the same sequence. All arguments after @var{position} are floating point numbers. This event is usually sent as part of a sequence, which begins with -the user placing two fingers on the touchpad and ends with the user +the user placing two fingers on the touchpad, and ends with the user removing those fingers. @var{dx}, @var{dy}, and @var{angle} will be @code{0.0} in the first event sent after a sequence begins. diff --git a/etc/NEWS b/etc/NEWS index aea6a46c1d..c9466d0fef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -312,7 +312,6 @@ effectively dragged. Customize this option to limit the number of entries in the menu "Edit->Paste from Kill Menu". The default is 60. ---- ** Performing a pinch gesture on a touchpad now increases the text scale. ** show-paren-mode @@ -890,8 +889,9 @@ wheel on some mice, or when the user's finger moves off the touchpad. +++ ** New event type 'pinch'. -This event is sent when a user peforms a two-finger pinch gesture on a -touchpad. +This event is sent when a user peforms a pinch gesture on a touchpad, +which is comprised of placing two fingers on the touchpad and moving +them towards or away from each other. ** Keymaps and key definitions diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 8507f7e8e3..67123ac7f8 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -396,8 +396,19 @@ a top-level keymap, `text-scale-increase' or ;;;###autoload (define-key global-map [pinch] 'text-scale-pinch) ;;;###autoload (defun text-scale-pinch (event) - "Adjust the height of the default face by the scale in EVENT." + "Adjust the height of the default face by the scale in the pinch event EVENT." (interactive "e") + (when (not (eq (event-basic-type event) 'pinch)) + (error "`text-scale-pinch' bound to bad event type")) + (let ((evt)) + (catch 'done + (while t + (unless (and (setq evt (read-event nil nil 0.01)) + (eq (car evt) 'pinch)) + (throw 'done nil)))) + (when (and (consp evt) + (eq (car evt) 'pinch)) + (setq event evt))) (let ((window (posn-window (nth 1 event))) (scale (nth 4 event)) (dx (nth 2 event)) commit 97218c311b506614db84233de120a012cc9b0493 Author: Eli Zaretskii Date: Sun Dec 26 10:20:05 2021 +0200 ; Fix last change: use 'utf-8-emacs-unix' encoding. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index ca15b40781..c58a9abe02 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -260,7 +260,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (with-temp-buffer (let* ((time (file-attribute-modification-time (file-attributes file))) - (coding-system-for-read 'utf-8-emacs)) + (coding-system-for-read 'utf-8-emacs-unix)) (insert-file-contents file) (let ((stored (read (current-buffer)))) (setf (multisession--cached-value object) stored @@ -329,7 +329,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (error (error "Unable to store unreadable value: %s" (buffer-string)))) ;; Write to a temp file in the same directory and rename to the ;; file for somewhat better atomicity. - (let ((coding-system-for-write 'utf-8-emacs) + (let ((coding-system-for-write 'utf-8-emacs-unix) (create-lockfiles nil) (temp (make-temp-name file)) (write-region-inhibit-fsync nil)) @@ -346,7 +346,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (url-unhex-string (file-name-sans-extension (car (last bits)))) (with-temp-buffer - (let ((coding-system-for-read 'utf-8-emacs)) + (let ((coding-system-for-read 'utf-8-emacs-unix)) (insert-file-contents file) (read (current-buffer))))))) (directory-files-recursively commit 9e45929d7c7653a31d28cabdc5ffa144c4d76e2d Author: Eli Zaretskii Date: Sun Dec 26 10:16:40 2021 +0200 Minor improvements in multisession.el * lisp/emacs-lisp/multisession.el (multisession--read-file-value): Handle 'file-missing' error when reading values from files. (multisession--backend-values, multisession--backend-set-value) (multisession--read-file-value): Use 'utf-8-emacs' encoding. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index 4bd7886d35..ca15b40781 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -260,16 +260,19 @@ DOC should be a doc string, and ARGS are keywords as applicable to (with-temp-buffer (let* ((time (file-attribute-modification-time (file-attributes file))) - (coding-system-for-read 'utf-8)) + (coding-system-for-read 'utf-8-emacs)) (insert-file-contents file) (let ((stored (read (current-buffer)))) (setf (multisession--cached-value object) stored (multisession--cached-sequence object) time) stored)))) ;; Windows uses OS-level file locking that may preclude - ;; reading the file in some circumstances. So when that - ;; happens, wait a bit and try again. - (permission-denied + ;; reading the file in some circumstances. In addition, + ;; rename-file is not an atomic operation on MS-Windows, + ;; when the target file already exists, so there could be a + ;; small race window when the file to read doesn't yet + ;; exist. So when these problems happen, wait a bit and retry. + ((permission-denied file-missing) (setq i (1+ i) last-error err) (sleep-for (+ 0.1 (/ (float (random 10)) 10)))))) @@ -326,7 +329,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (error (error "Unable to store unreadable value: %s" (buffer-string)))) ;; Write to a temp file in the same directory and rename to the ;; file for somewhat better atomicity. - (let ((coding-system-for-write 'utf-8) + (let ((coding-system-for-write 'utf-8-emacs) (create-lockfiles nil) (temp (make-temp-name file)) (write-region-inhibit-fsync nil)) @@ -343,7 +346,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (url-unhex-string (file-name-sans-extension (car (last bits)))) (with-temp-buffer - (let ((coding-system-for-read 'utf-8)) + (let ((coding-system-for-read 'utf-8-emacs)) (insert-file-contents file) (read (current-buffer))))))) (directory-files-recursively