[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/positioned-lambdas 90f008d1de2 1/3: Merge branch 'master' into f
|
From: |
Alan Mackenzie |
|
Subject: |
feature/positioned-lambdas 90f008d1de2 1/3: Merge branch 'master' into feature/positioned-lambdas |
|
Date: |
Sun, 24 Mar 2024 12:03:22 -0400 (EDT) |
branch: feature/positioned-lambdas
commit 90f008d1de23c3105dd4103ff683ff5cdc74d479
Merge: c3b3fc82e8a 3ed5777fa73
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>
Merge branch 'master' into feature/positioned-lambdas
---
admin/syncdoc-type-hierarchy.el | 26 ++-
doc/lispref/Makefile.in | 5 +-
doc/lispref/elisp_type_hierarchy.jpg | Bin 345570 -> 288444 bytes
doc/lispref/elisp_type_hierarchy.txt | 66 +++---
doc/lispref/objects.texi | 6 +-
doc/lispref/os.texi | 9 +-
doc/lispref/symbols.texi | 78 ++++---
etc/NEWS | 12 ++
java/AndroidManifest.xml.in | 7 +
java/org/gnu/emacs/EmacsActivity.java | 21 ++
java/org/gnu/emacs/EmacsDesktopNotification.java | 160 ++++++++++++--
java/org/gnu/emacs/EmacsNative.java | 6 +
java/org/gnu/emacs/EmacsPreferencesActivity.java | 5 +-
java/org/gnu/emacs/EmacsService.java | 25 +++
lisp/calc/calc-prog.el | 16 +-
lisp/emacs-lisp/bindat.el | 3 +
lisp/emacs-lisp/pp.el | 58 +++--
lisp/erc/erc-button.el | 3 +-
lisp/erc/erc-goodies.el | 37 ++--
lisp/erc/erc-stamp.el | 9 +-
lisp/erc/erc.el | 34 +++
lisp/gnus/gnus-start.el | 18 +-
lisp/gnus/legacy-gnus-agent.el | 260 -----------------------
lisp/net/browse-url.el | 17 +-
lisp/net/dbus.el | 6 +-
lisp/subr.el | 5 -
src/android.c | 163 +++++++++++++-
src/android.h | 8 +
src/androidfns.c | 4 +-
src/androidgui.h | 29 +++
src/androidselect.c | 243 +++++++++++++++++++--
src/androidterm.c | 22 +-
src/androidterm.h | 6 +
src/androidvfs.c | 2 +-
src/data.c | 38 ++--
src/keyboard.c | 84 ++++----
src/keyboard.h | 1 +
src/macros.c | 54 +++++
src/macros.h | 5 +
src/process.c | 8 +-
src/termhooks.h | 4 +
test/lisp/erc/erc-goodies-tests.el | 153 +++++++++----
test/lisp/erc/erc-tests.el | 52 +++++
test/src/data-tests.el | 5 +
44 files changed, 1218 insertions(+), 555 deletions(-)
diff --git a/admin/syncdoc-type-hierarchy.el b/admin/syncdoc-type-hierarchy.el
index e14d7fb54e1..bfbbbc45aa4 100644
--- a/admin/syncdoc-type-hierarchy.el
+++ b/admin/syncdoc-type-hierarchy.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'cl-lib)
-(require 'org-table)
(defconst syncdoc-file (or (macroexp-file-name) buffer-file-name))
@@ -51,21 +50,24 @@
(when (cl-find-class type)
(push type res)))
obarray)
- res)
+ (nreverse
+ (merge-ordered-lists
+ (sort
+ (mapcar (lambda (type) (cl--class-allparents (cl-find-class type)))
+ res)
+ (lambda (ts1 ts2) (> (length ts1) (length ts2)))))))
"List of all types.")
-(declare-function 'comp--direct-supertypes "comp-cstr.el")
-
(defconst syncdoc-hierarchy
(progn
;; Require it here so we don't load it before `syncdoc-all-types' is
;; computed.
- (require 'comp-cstr)
(cl-loop
- with comp-ctxt = (make-comp-cstr-ctxt)
with h = (make-hash-table :test #'eq)
for type in syncdoc-all-types
- do (puthash type (comp--direct-supertypes type) h)
+ do (puthash type (mapcar #'cl--class-name
+ (cl--class-parents (cl-find-class type)))
+ h)
finally return h)))
(defun syncdoc-insert-dot-content (rankdir)
@@ -90,10 +92,14 @@
(dolist (parent parents)
(push type (alist-get parent subtypes))))
syncdoc-hierarchy)
- (cl-loop for (type . children) in (reverse subtypes)
+ (sort subtypes
+ (lambda (x1 x2)
+ (< (length (memq (car x2) syncdoc-all-types))
+ (length (memq (car x1) syncdoc-all-types)))))
+ (cl-loop for (type . children) in subtypes
do (insert "|" (symbol-name type) " |")
do (cl-loop with x = 0
- for child in (reverse children)
+ for child in children
for child-len = (length (symbol-name child))
when (> (+ x child-len 2) 60)
do (progn
@@ -102,6 +108,8 @@
do (insert (symbol-name child) " ")
do (cl-incf x (1+ child-len)) )
do (insert "\n")))
+ (require 'org-table)
+ (declare-function 'org-table-align "org")
(org-table-align)))
(defun syncdoc-update-type-hierarchy0 ()
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 9b7b6d8ea9d..0a228271be3 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -144,7 +144,7 @@ ps: $(PS_TARGETS)
${buildinfodir}:
${MKDIR_P} $@
-auxfiles: $(buildinfodir)/elisp_type_hierarchy.txt
$(buildinfodir)/elisp_type_hierarchy.jpg
+auxfiles = $(buildinfodir)/elisp_type_hierarchy.txt
$(buildinfodir)/elisp_type_hierarchy.jpg
$(buildinfodir)/elisp_type_hierarchy.txt: $(srcdir)/elisp_type_hierarchy.txt |
${buildinfodir}
cp $< $@
@@ -152,7 +152,7 @@ $(buildinfodir)/elisp_type_hierarchy.txt:
$(srcdir)/elisp_type_hierarchy.txt | $
$(buildinfodir)/elisp_type_hierarchy.jpg: $(srcdir)/elisp_type_hierarchy.jpg |
${buildinfodir}
cp $< $@
-$(buildinfodir)/elisp.info: $(srcs) auxfiles | ${buildinfodir}
+$(buildinfodir)/elisp.info: $(srcs) $(auxfiles) | ${buildinfodir}
$(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $<
elisp.dvi: $(srcs)
@@ -187,6 +187,7 @@ infoclean:
$(buildinfodir)/elisp.info \
$(buildinfodir)/elisp.info-[1-9] \
$(buildinfodir)/elisp.info-[1-9][0-9]
+ rm -f $(auxfiles)
bootstrap-clean maintainer-clean: distclean infoclean
rm -f TAGS
diff --git a/doc/lispref/elisp_type_hierarchy.jpg
b/doc/lispref/elisp_type_hierarchy.jpg
index a2e14490dfa..386954e1007 100644
Binary files a/doc/lispref/elisp_type_hierarchy.jpg and
b/doc/lispref/elisp_type_hierarchy.jpg differ
diff --git a/doc/lispref/elisp_type_hierarchy.txt
b/doc/lispref/elisp_type_hierarchy.txt
index d1be8f56c72..bb93cd831b9 100644
--- a/doc/lispref/elisp_type_hierarchy.txt
+++ b/doc/lispref/elisp_type_hierarchy.txt
@@ -1,33 +1,33 @@
-| Type | Derived Types
|
-|---------------------+------------------------------------------------------------|
-| atom | mutex record font-spec frame number-or-marker
|
-| | tree-sitter-compiled-query tree-sitter-node
font-entity |
-| | tree-sitter-parser hash-table window-configuration
|
-| | function user-ptr overlay array process font-object
symbol |
-| | obarray condvar buffer terminal thread window
|
-| | native-comp-unit
|
-| cl-structure-object | xref-elisp-location org-cite-processor
cl--generic-method |
-| | cl--random-state register-preview-info cl--generic
|
-| | cl--class cl-slot-descriptor uniquify-item registerv
|
-| | isearch--state cl--generic-generalizer
lisp-indent-state |
-| t | sequence atom
|
-| compiled-function | subr byte-code-function
|
-| integer | fixnum bignum
|
-| symbol | symbol-with-pos keyword boolean
|
-| accessor | oclosure-accessor
|
-| oclosure | advice cconv--interactive-helper advice--forward
accessor |
-| | save-some-buffers-function cl--generic-nnm
|
-| cons | ppss decoded-time
|
-| cl--class | cl-structure-class oclosure--class built-in-class
|
-| subr | subr-primitive subr-native-elisp
|
-| array | string vector bool-vector char-table
|
-| number | float integer
|
-| number-or-marker | integer-or-marker number
|
-| function | oclosure compiled-function interpreted-function
|
-| | module-function
|
-| sequence | list array
|
-| integer-or-marker | integer marker
|
-| boolean | null
|
-| list | null cons
|
-| record | cl-structure-object
|
-| vector | timer
|
+| Type | Derived Types
|
+|---------------------+-----------------------------------------------------------|
+| t | sequence atom
|
+| atom | number-or-marker array record symbol function
|
+| | window-configuration font-object font-entity mutex
|
+| | tree-sitter-node buffer overlay tree-sitter-parser
thread |
+| | font-spec native-comp-unit tree-sitter-compiled-query
|
+| | terminal window frame hash-table user-ptr obarray
condvar |
+| | process
|
+| sequence | array list
|
+| list | null cons
|
+| function | oclosure compiled-function module-function
|
+| | interpreted-function
|
+| symbol | boolean symbol-with-pos keyword
|
+| compiled-function | subr byte-code-function
|
+| oclosure | accessor advice--forward cconv--interactive-helper
|
+| | cl--generic-nnm advice save-some-buffers-function
|
+| record | cl-structure-object
|
+| cl-structure-object | cl--class lisp-indent-state cl--random-state registerv
|
+| | xref-elisp-location isearch--state cl-slot-descriptor
|
+| | cl--generic-generalizer uniquify-item
cl--generic-method |
+| | register-preview-info cl--generic
|
+| cons | ppss decoded-time
|
+| array | vector string char-table bool-vector
|
+| number-or-marker | number integer-or-marker
|
+| integer-or-marker | integer marker
|
+| number | integer float
|
+| cl--class | built-in-class cl-structure-class oclosure--class
|
+| subr | subr-native-elisp subr-primitive
|
+| accessor | oclosure-accessor
|
+| vector | timer
|
+| boolean | null
|
+| integer | fixnum bignum
|
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 41171bcaafc..279f449a994 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2399,10 +2399,10 @@ The @code{equal} function recursively compares the
contents of objects
if they are integers, strings, markers, vectors, bool-vectors,
byte-code function objects, char-tables, records, or font objects.
-If @var{object1} or @var{object2} is a symbol with position,
-@code{equal} regards it as its bare symbol when
+If @var{object1} or @var{object2} contains symbols with position,
+@code{equal} treats them as if they were their bare symbols when
@code{symbols-with-pos-enabled} is non-@code{nil}. Otherwise
-@code{equal} compares two symbols with position by recursively
+@code{equal} compares two symbols with position by
comparing their components. @xref{Symbols with Position}.
Other objects are considered @code{equal} only if they are @code{eq}.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 60ae57d4c1d..435886320fd 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -3241,11 +3241,16 @@ of parameters analogous to its namesake in
@item :title @var{title}
@item :body @var{body}
@item :replaces-id @var{replaces-id}
+@item :on-action @var{on-action}
+@item :on-cancel @var{on-close}
+@item :actions @var{actions}
+@item :resident @var{resident}
These have the same meaning as they do when used in calls to
-@code{notifications-notify}.
+@code{notifications-notify}, except that no more than three non-default
+actions will be displayed.
@item :urgency @var{urgency}
-The set of values for @var{urgency} is the same as with
+The set of accepted values for @var{urgency} is the same as with
@code{notifications-notify}, but the urgency applies to all
notifications displayed with the defined @var{group}, except under
Android 7.1 and earlier.
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 6f9b1ef0ec7..c76bf3d3820 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -780,13 +780,16 @@ Symbol forms whose names start with @samp{#_} are not
transformed.
@cindex symbol with position
@cindex bare symbol
-A @dfn{symbol with position} is a symbol, the @dfn{bare symbol},
-together with an unsigned integer called the @dfn{position}. Symbols
-with position don't themselves have entries in the obarray (though
-their bare symbols do; @pxref{Creating Symbols}).
-
-Symbols with position are for the use of the byte compiler, which
-records in them the position of each symbol occurrence and uses those
+A @dfn{symbol with position} is a symbol, called the @dfn{bare symbol},
+together with a nonnegative fixnum called the @dfn{position}.
+Even though a symbol with position often acts like its bare symbol,
+it is not a symbol: instead, it is an object that has both a bare symbol
+and a position. Because symbols with position are not symbols,
+they don't have entries in the obarray, though their bare symbols
+typically do (@pxref{Creating Symbols}).
+
+The byte compiler uses symbols with position,
+records in them the position of each symbol occurrence, and uses those
positions in warning and error messages. They shouldn't normally be
used otherwise. Doing so can cause unexpected results with basic
Emacs functions such as @code{eq} and @code{equal}.
@@ -799,22 +802,19 @@ just the bare symbol to be printed by binding the variable
operation. The byte compiler does this before writing its output to
the compiled Lisp file.
-For most purposes, when the flag variable
-@code{symbols-with-pos-enabled} is non-@code{nil}, symbols with
-positions behave just as their bare symbols would. For example,
-@samp{(eq #<symbol foo at 12345> foo)} has a value @code{t} when the
-variable is set; likewise, @code{equal} will treat a symbol with
-position argument as its bare symbol.
+When the flag variable @code{symbols-with-pos-enabled} is non-@code{nil},
+a symbol with position ordinarily behaves like its bare symbol.
+For example, @samp{(eq (position-symbol 'foo 12345) 'foo)} yields @code{t},
+and @code{equal} likewise treats a symbol with position as its bare symbol.
-When @code{symbols-with-pos-enabled} is @code{nil}, any symbols with
-position continue to exist, but do not behave as symbols, or have the
-other useful properties outlined in the previous paragraph. @code{eq}
-returns @code{t} when given identical arguments, and @code{equal}
-returns @code{t} when given arguments with @code{equal} components.
+When @code{symbols-with-pos-enabled} is @code{nil}, symbols with
+position behave as themselves, not as symbols. For example, @samp{(eq
+(position-symbol 'foo 12345) 'foo)} yields @code{nil}, and @code{equal}
+likewise treats a symbol with position as not equal to its bare symbol.
Most of the time in Emacs @code{symbols-with-pos-enabled} is
@code{nil}, but the byte compiler and the native compiler bind it to
-@code{t} when they run.
+@code{t} when they run and Emacs runs a little more slowly in this case.
Typically, symbols with position are created by the byte compiler
calling the reader function @code{read-positioning-symbols}
@@ -822,36 +822,44 @@ calling the reader function
@code{read-positioning-symbols}
@code{position-symbol}.
@defvar symbols-with-pos-enabled
-When this variable is non-@code{nil}, a symbol with position behaves
-like the contained bare symbol. Emacs runs a little more slowly in
-this case.
+This variable affects the behavior of symbols with position when they
+are not being printed and are not arguments to one of the functions
+defined later in this section. When this variable is non-@code{nil},
+such a symbol with position behaves like its bare symbol; otherwise it
+behaves as itself, not as a symbol.
@end defvar
@defvar print-symbols-bare
When bound to non-@code{nil}, the Lisp printer prints only the bare
symbol of a symbol with position, ignoring the position.
+Otherwise a symbol with position prints as itself, not as a symbol.
@end defvar
-@defun symbol-with-pos-p symbol
-This function returns @code{t} if @var{symbol} is a symbol with
+@defun symbol-with-pos-p object
+This function returns @code{t} if @var{object} is a symbol with
position, @code{nil} otherwise.
+Unlike @code{symbolp}, this function ignores @code{symbols-with-pos-enabled}.
@end defun
-@defun bare-symbol symbol
-This function returns the bare symbol contained in @var{symbol}, or
-@var{symbol} itself if it is already a bare symbol. For any other
-type of object, it signals an error.
+@defun bare-symbol sym
+This function returns the bare symbol of the symbol with
+position @var{sym}, or @var{sym} itself if it is already a symbol.
+For any other type of object, it signals an error.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
-@defun symbol-with-pos-pos symbol
-This function returns the position, a number, from a symbol with
-position. For any other type of object, it signals an error.
+@defun symbol-with-pos-pos sympos
+This function returns the position, a nonnegative fixnum, from the symbol with
+position @var{sympos}. For any other type of object, it signals an error.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
@defun position-symbol sym pos
-Make a new symbol with position. @var{sym} is either a bare symbol or
-a symbol with position, and supplies the symbol part of the new
-object. @var{pos} is either an integer which becomes the number part
-of the new object, or a symbol with position whose position is used.
+Make a new symbol with position. The new object's bare symbol is taken
+from @var{sym}, which is either a symbol, or a symbol with position
+whose bare symbol is used. The new object's position is taken from
+@var{pos}, which is either a nonnegative fixnum, or a symbol with
+position whose position is used.
Emacs signals an error if either argument is invalid.
+This function ignores @code{symbols-with-pos-enabled}.
@end defun
diff --git a/etc/NEWS b/etc/NEWS
index 2e51c0490fe..19cd170e5c7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2141,6 +2141,18 @@ Like the variable with the same name, it adds menus from
the list that
is the value of the property to context menus shown when clicking on the
text which as this property.
+---
+** Detecting the end of an iteration of a keyboard macro
+'read-event', 'read-char', and 'read-char-exclusive' no longer return -1
+when called at the end of an iteration of a the execution of a keyboard
+macro. Instead, they will transparently continue reading available input
+(e.g., from the keyboard). If you need to detect the end of a macro
+iteration, check the following condition before calling one of the
+aforementioned functions:
+
+ (and (arrayp executing-kbd-macro)
+ (>= executing-kbd-macro-index (length executing-kbd-macro))))
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index 27af9c912fe..4d23c752747 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -316,6 +316,13 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
</intent-filter>
</provider>
+ <receiver android:name=".EmacsDesktopNotification$CancellationReceiver"
+ android:exported="false">
+ <intent-filter>
+ <action android:name="org.gnu.emacs.DISMISSED" />
+ </intent-filter>
+ </receiver>
+
<service android:name="org.gnu.emacs.EmacsService"
android:directBootAware="false"
android:enabled="true"
diff --git a/java/org/gnu/emacs/EmacsActivity.java
b/java/org/gnu/emacs/EmacsActivity.java
index 66a1e41d84c..06b9c0f005d 100644
--- a/java/org/gnu/emacs/EmacsActivity.java
+++ b/java/org/gnu/emacs/EmacsActivity.java
@@ -453,6 +453,27 @@ public class EmacsActivity extends Activity
syncFullscreenWith (window);
}
+ @Override
+ public final void
+ onNewIntent (Intent intent)
+ {
+ String tag, action;
+
+ /* This function is called when EmacsActivity is relaunched from a
+ notification. */
+
+ if (intent == null || EmacsService.SERVICE == null)
+ return;
+
+ tag = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_TAG);
+ action
+ = intent.getStringExtra (EmacsDesktopNotification.NOTIFICATION_ACTION);
+
+ if (tag == null || action == null)
+ return;
+
+ EmacsNative.sendNotificationAction (tag, action);
+ }
@Override
diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java
b/java/org/gnu/emacs/EmacsDesktopNotification.java
index fb35e3fea1f..d05ed2e6203 100644
--- a/java/org/gnu/emacs/EmacsDesktopNotification.java
+++ b/java/org/gnu/emacs/EmacsDesktopNotification.java
@@ -24,9 +24,12 @@ import android.app.NotificationManager;
import android.app.NotificationChannel;
import android.app.PendingIntent;
+import android.content.BroadcastReceiver;
import android.content.Context;
import android.content.Intent;
+import android.net.Uri;
+
import android.os.Build;
import android.widget.RemoteViews;
@@ -44,6 +47,16 @@ import android.widget.RemoteViews;
public final class EmacsDesktopNotification
{
+ /* Intent tag for notification action data. */
+ public static final String NOTIFICATION_ACTION = "emacs:notification_action";
+
+ /* Intent tag for notification IDs. */
+ public static final String NOTIFICATION_TAG = "emacs:notification_tag";
+
+ /* Action ID assigned to the broadcast receiver which should be
+ notified of any notification's being dismissed. */
+ public static final String NOTIFICATION_DISMISSED =
"org.gnu.emacs.DISMISSED";
+
/* The content of this desktop notification. */
public final String content;
@@ -66,10 +79,15 @@ public final class EmacsDesktopNotification
/* The importance of this notification's group. */
public final int importance;
+ /* Array of actions and their user-facing text to be offered by this
+ notification. */
+ public final String[] actions, titles;
+
public
EmacsDesktopNotification (String title, String content,
String group, String tag, int icon,
- int importance)
+ int importance,
+ String[] actions, String[] titles)
{
this.content = content;
this.title = title;
@@ -77,12 +95,68 @@ public final class EmacsDesktopNotification
this.tag = tag;
this.icon = icon;
this.importance = importance;
+ this.actions = actions;
+ this.titles = titles;
}
/* Functions for displaying desktop notifications. */
+ /* Insert each action in actions and titles into the notification
+ builder BUILDER, with pending intents created with CONTEXT holding
+ suitable metadata. */
+
+ @SuppressWarnings ("deprecation")
+ private void
+ insertActions (Context context, Notification.Builder builder)
+ {
+ int i;
+ PendingIntent pending;
+ Intent intent;
+ Notification.Action.Builder action;
+
+ if (actions == null)
+ return;
+
+ for (i = 0; i < actions.length; ++i)
+ {
+ /* Actions named default should not be displayed. */
+ if (actions[i].equals ("default"))
+ continue;
+
+ intent = new Intent (context, EmacsActivity.class);
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK);
+
+ /* Pending intents are specific to combinations of class, action
+ and data, but not information provided as extras. In order
+ that its target may be invoked with the action and tag set
+ below, generate a URL from those two elements and specify it
+ as the intent data, which ensures that the intent allocated
+ fully reflects the duo. */
+
+ intent.setData (new Uri.Builder ().scheme ("action")
+ .appendPath (tag).appendPath (actions[i])
+ .build ());
+ intent.putExtra (NOTIFICATION_ACTION, actions[i]);
+ intent.putExtra (NOTIFICATION_TAG, tag);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
+ pending = PendingIntent.getActivity (context, 0, intent,
+ PendingIntent.FLAG_IMMUTABLE);
+ else
+ pending = PendingIntent.getActivity (context, 0, intent, 0);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.M)
+ {
+ action = new Notification.Action.Builder (0, titles[i], pending);
+ builder.addAction (action.build ());
+ }
+ else
+ builder.addAction (0, titles[i], pending);
+ }
+ }
+
/* Internal helper for `display' executed on the main thread. */
@SuppressWarnings ("deprecation") /* Notification.Builder (Context). */
@@ -97,6 +171,7 @@ public final class EmacsDesktopNotification
Intent intent;
PendingIntent pending;
int priority;
+ Notification.Builder builder;
tem = context.getSystemService (Context.NOTIFICATION_SERVICE);
manager = (NotificationManager) tem;
@@ -108,13 +183,16 @@ public final class EmacsDesktopNotification
(such as its importance) will be overridden. */
channel = new NotificationChannel (group, group, importance);
manager.createNotificationChannel (channel);
+ builder = new Notification.Builder (context, group);
- /* Create a notification object and display it. */
- notification = (new Notification.Builder (context, group)
- .setContentTitle (title)
- .setContentText (content)
- .setSmallIcon (icon)
- .build ());
+ /* Create and configure a notification object and display
+ it. */
+
+ builder.setContentTitle (title);
+ builder.setContentText (content);
+ builder.setSmallIcon (icon);
+ insertActions (context, builder);
+ notification = builder.build ();
}
else if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
{
@@ -138,12 +216,16 @@ public final class EmacsDesktopNotification
break;
}
- notification = (new Notification.Builder (context)
- .setContentTitle (title)
- .setContentText (content)
- .setSmallIcon (icon)
- .setPriority (priority)
- .build ());
+ builder = new Notification.Builder (context);
+ builder.setContentTitle (title);
+ builder.setContentText (content);
+ builder.setSmallIcon (icon);
+ builder.setPriority (priority);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN)
+ insertActions (context, builder);
+
+ notification = builder.build ();
if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN)
notification.priority = priority;
@@ -170,6 +252,12 @@ public final class EmacsDesktopNotification
intent = new Intent (context, EmacsActivity.class);
intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK);
+ intent.setData (new Uri.Builder ()
+ .scheme ("action")
+ .appendPath (tag)
+ .build ());
+ intent.putExtra (NOTIFICATION_ACTION, "default");
+ intent.putExtra (NOTIFICATION_TAG, tag);
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
pending = PendingIntent.getActivity (context, 0, intent,
@@ -179,6 +267,25 @@ public final class EmacsDesktopNotification
notification.contentIntent = pending;
+ /* Provide a cancellation intent to respond to notification
+ dismissals. */
+
+ intent = new Intent (context, CancellationReceiver.class);
+ intent.setAction (NOTIFICATION_DISMISSED);
+ intent.setPackage ("org.gnu.emacs");
+ intent.setData (new Uri.Builder ()
+ .scheme ("action")
+ .appendPath (tag)
+ .build ());
+ intent.putExtra (NOTIFICATION_TAG, tag);
+
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
+ pending = PendingIntent.getBroadcast (context, 0, intent,
+ PendingIntent.FLAG_IMMUTABLE);
+ else
+ pending = PendingIntent.getBroadcast (context, 0, intent, 0);
+
+ notification.deleteIntent = pending;
manager.notify (tag, 2, notification);
}
@@ -199,4 +306,31 @@ public final class EmacsDesktopNotification
}
});
}
+
+
+
+ /* Broadcast receiver. This is something of a system-wide callback
+ arranged to be invoked whenever a notification posted by Emacs is
+ dismissed, in order to relay news of its dismissal to
+ androidselect.c and run or remove callbacks as appropriate. */
+
+ public static class CancellationReceiver extends BroadcastReceiver
+ {
+ @Override
+ public void
+ onReceive (Context context, Intent intent)
+ {
+ String tag, action;
+
+ if (intent == null || EmacsService.SERVICE == null)
+ return;
+
+ tag = intent.getStringExtra (NOTIFICATION_TAG);
+
+ if (tag == null)
+ return;
+
+ EmacsNative.sendNotificationDeleted (tag);
+ }
+ };
};
diff --git a/java/org/gnu/emacs/EmacsNative.java
b/java/org/gnu/emacs/EmacsNative.java
index cd0e70923d1..6845f833908 100644
--- a/java/org/gnu/emacs/EmacsNative.java
+++ b/java/org/gnu/emacs/EmacsNative.java
@@ -196,6 +196,12 @@ public final class EmacsNative
public static native long sendDndText (short window, int x, int y,
String text);
+ /* Send an ANDROID_NOTIFICATION_CANCELED event. */
+ public static native void sendNotificationDeleted (String tag);
+
+ /* Send an ANDROID_NOTIFICATION_ACTION event. */
+ public static native void sendNotificationAction (String tag, String action);
+
/* Return the file name associated with the specified file
descriptor, or NULL if there is none. */
public static native byte[] getProcName (int fd);
diff --git a/java/org/gnu/emacs/EmacsPreferencesActivity.java
b/java/org/gnu/emacs/EmacsPreferencesActivity.java
index 330adbea223..766e2e11d46 100644
--- a/java/org/gnu/emacs/EmacsPreferencesActivity.java
+++ b/java/org/gnu/emacs/EmacsPreferencesActivity.java
@@ -38,8 +38,9 @@ import android.preference.*;
option, which would not be possible otherwise, as there is no
command line on Android.
- Android provides a preferences activity, but it is deprecated.
- Unfortunately, there is no alternative that looks the same way. */
+ This file extends a deprecated preferences activity, but no suitable
+ alternative exists that is identical in appearance to system settings
+ forms. */
@SuppressWarnings ("deprecation")
public class EmacsPreferencesActivity extends PreferenceActivity
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index d17ba597d8e..9bc40d63311 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -1967,4 +1967,29 @@ public final class EmacsService extends Service
else
requestStorageAccess30 ();
}
+
+
+
+ /* Notification miscellany. */
+
+ /* Cancel any notification displayed with the tag TAG. */
+
+ public void
+ cancelNotification (final String string)
+ {
+ Object tem;
+ final NotificationManager manager;
+
+ tem = getSystemService (Context.NOTIFICATION_SERVICE);
+ manager = (NotificationManager) tem;
+
+ runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ manager.cancel (string, 2);
+ }
+ });
+ }
};
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 03210995eb3..8dff7f1f264 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1225,13 +1225,17 @@ Redefine the corresponding command."
(interactive)
(calc-kbd-if))
+(defun calc--at-end-of-kmacro-p ()
+ (and (arrayp executing-kbd-macro)
+ (>= executing-kbd-macro-index (length executing-kbd-macro))))
+
(defun calc-kbd-skip-to-else-if (else-okay)
(let ((count 0)
ch)
(while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z[ in keyboard macro"))
+ (setq ch (read-char))
(if (= ch ?Z)
(progn
(setq ch (read-char))
@@ -1299,9 +1303,9 @@ Redefine the corresponding command."
(or executing-kbd-macro
(message "Reading loop body..."))
(while (>= count 0)
- (setq ch (read-event))
- (if (eq ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z%c in keyboard macro" open))
+ (setq ch (read-event))
(if (eq ch ?Z)
(progn
(setq ch (read-event)
@@ -1427,9 +1431,9 @@ Redefine the corresponding command."
(if defining-kbd-macro
(message "Reading body..."))
(while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
+ (if (calc--at-end-of-kmacro-p)
(error "Unterminated Z` in keyboard macro"))
+ (setq ch (read-char))
(if (= ch ?Z)
(progn
(setq ch (read-char)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 69a8d02531e..2bc47d79536 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -204,6 +204,9 @@
('str (bindat--unpack-str len))
('strz (bindat--unpack-strz len))
('vec
+ (when (> len (length bindat-raw))
+ (error "Vector length %d is greater than raw data length %d"
+ len (length bindat-raw)))
(let ((v (make-vector len 0)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 1d722051406..569f70ca604 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -430,23 +430,33 @@ the bounds of a region containing Lisp code to
pretty-print."
(replace-match ""))
(insert-into-buffer obuf)))))
+(defvar pp--quoting-syntaxes
+ `((quote . "'")
+ (function . "#'")
+ (,backquote-backquote-symbol . "`")
+ (,backquote-unquote-symbol . ",")
+ (,backquote-splice-symbol . ",@")))
+
+(defun pp--quoted-or-unquoted-form-p (cons)
+ ;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X
+ (let ((head (car cons)))
+ (and (symbolp head)
+ (assq head pp--quoting-syntaxes)
+ (let ((rest (cdr cons)))
+ (and (consp rest) (null (cdr rest)))))))
+
(defun pp--insert-lisp (sexp)
(cl-case (type-of sexp)
(vector (pp--format-vector sexp))
(cons (cond
((consp (cdr sexp))
- (if (and (length= sexp 2)
- (memq (car sexp) '(quote function)))
- (cond
- ((symbolp (cadr sexp))
- (let ((print-quoted t))
- (prin1 sexp (current-buffer))))
- ((consp (cadr sexp))
- (insert (if (eq (car sexp) 'quote)
- "'" "#'"))
- (pp--format-list (cadr sexp)
- (set-marker (make-marker) (1- (point))))))
- (pp--format-list sexp)))
+ (let ((head (car sexp)))
+ (if-let (((null (cddr sexp)))
+ (syntax-entry (assq head pp--quoting-syntaxes)))
+ (progn
+ (insert (cdr syntax-entry))
+ (pp--insert-lisp (cadr sexp)))
+ (pp--format-list sexp))))
(t
(prin1 sexp (current-buffer)))))
;; Print some of the smaller integers as characters, perhaps?
@@ -458,6 +468,8 @@ the bounds of a region containing Lisp code to
pretty-print."
(string
(let ((print-escape-newlines t))
(prin1 sexp (current-buffer))))
+ (symbol
+ (prin1 sexp (current-buffer)))
(otherwise (princ sexp (current-buffer)))))
(defun pp--format-vector (sexp)
@@ -468,15 +480,29 @@ the bounds of a region containing Lisp code to
pretty-print."
(insert "]"))
(defun pp--format-list (sexp &optional start)
- (if (and (symbolp (car sexp))
- (not pp--inhibit-function-formatting)
- (not (keywordp (car sexp))))
+ (if (not (let ((head (car sexp)))
+ (or pp--inhibit-function-formatting
+ (not (symbolp head))
+ (keywordp head)
+ (let ((l sexp))
+ (catch 'not-funcall
+ (while l
+ (when (or
+ (atom l) ; SEXP is a dotted list
+ ;; Does SEXP have a form like (ELT... . ,X) ?
+ (pp--quoted-or-unquoted-form-p l))
+ (throw 'not-funcall t))
+ (setq l (cdr l)))
+ nil)))))
(pp--format-function sexp)
(insert "(")
(pp--insert start (pop sexp))
(while sexp
(if (consp sexp)
- (pp--insert " " (pop sexp))
+ (if (not (pp--quoted-or-unquoted-form-p sexp))
+ (pp--insert " " (pop sexp))
+ (pp--insert " . " sexp)
+ (setq sexp nil))
(pp--insert " . " sexp)
(setq sexp nil)))
(insert ")")))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 6b78e451b54..4b4930e5bff 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -528,7 +528,8 @@ that `erc-button-add-button' adds, except for the face."
'(erc-callback nil
erc-data nil
mouse-face nil
- keymap nil)))
+ keymap nil))
+ (erc--restore-important-text-props '(mouse-face)))
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
"Create a button between FROM and TO with callback FUN and data DATA.
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 7e30b1060fd..da14f5bd728 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -661,13 +661,11 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
:group 'erc-faces)
(defface erc-inverse-face
- '((t :foreground "White" :background "Black"))
+ '((t :inverse-video t))
"ERC inverse face."
:group 'erc-faces)
-(defface erc-spoiler-face
- '((((background light)) :foreground "DimGray" :background "DimGray")
- (((background dark)) :foreground "LightGray" :background "LightGray"))
+(defface erc-spoiler-face '((t :inherit default))
"ERC spoiler face."
:group 'erc-faces)
@@ -675,6 +673,16 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
"ERC underline face."
:group 'erc-faces)
+(defface erc-control-default-fg '((t :inherit default))
+ "ERC foreground face for the \"default\" color code."
+ :group 'erc-faces)
+
+(defface erc-control-default-bg '((t :inherit default))
+ "ERC background face for the \"default\" color code."
+ :group 'erc-faces)
+
+;; FIXME rename these to something like `erc-control-color-N-fg',
+;; and deprecate the old names via `define-obsolete-face-alias'.
(defface fg:erc-color-face0 '((t :foreground "White"))
"ERC face."
:group 'erc-faces)
@@ -804,7 +812,7 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
(intern (concat "bg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :background (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) '(default)))))
+ (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg))))
(defun erc-get-fg-color-face (n)
"Fetches the right face for foreground color N (0-15)."
@@ -820,7 +828,7 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
(intern (concat "fg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :foreground (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) '(default)))))
+ (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg))))
;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
(define-erc-module irccontrols nil
@@ -968,13 +976,16 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend
properties
to a region in the current buffer."
- (if (and fg bg (equal fg bg))
- (progn
- (setq fg 'erc-spoiler-face
- bg nil)
- (put-text-property from to 'mouse-face 'erc-inverse-face str))
- (when fg (setq fg (erc-get-fg-color-face fg)))
- (when bg (setq bg (erc-get-bg-color-face bg))))
+ (when (and fg bg (equal fg bg) (not (equal fg "99")))
+ (add-text-properties from to '( mouse-face erc-spoiler-face
+ cursor-face erc-spoiler-face)
+ str)
+ (erc--reserve-important-text-props from to
+ '( mouse-face erc-spoiler-face
+ cursor-face erc-spoiler-face)
+ str))
+ (when fg (setq fg (erc-get-fg-color-face fg)))
+ (when bg (setq bg (erc-get-bg-color-face bg)))
(font-lock-prepend-text-property
from
to
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index a8190a2c94a..44f92c5a7e2 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -723,9 +723,6 @@ inserted is a date stamp."
'hash-table))
(erc-timestamp-last-inserted-left rendered)
erc-timestamp-format erc-away-timestamp-format)
- ;; FIXME delete once convinced adjustment correct.
- (cl-assert (string= rendered
- (erc-stamp--format-date-stamp aligned)))
(erc-add-timestamp))
(setq erc-timestamp-last-inserted-left rendered)))))
@@ -833,7 +830,11 @@ left-sided stamps and date stamps inserted by this
function."
(decoded (decode-time current-time erc-stamp--tz)))
(setf (decoded-time-second decoded) 0
(decoded-time-minute decoded) 0
- (decoded-time-hour decoded) 0)
+ (decoded-time-hour decoded) 0
+ (decoded-time-dst decoded) -1
+ (decoded-time-weekday decoded) nil
+ (decoded-time-zone decoded)
+ (and erc-stamp--tz (car (current-time-zone nil erc-stamp--tz))))
(encode-time decoded))) ; may return an integer
(defun erc-format-timestamp (time format)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index cce3b2508fb..3cc9bd54228 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3532,6 +3532,40 @@ repeatedly with VAL set to each of VAL's members."
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--reserve-important-text-props (beg end plist &optional object)
+ "Record text-property pairs in PLIST as important between BEG and END.
+Also mark the message being inserted as containing these important props
+so modules performing destructive modifications can later restore them.
+Expect to run in a narrowed buffer at message-insertion time."
+ (when erc--msg-props
+ (let ((existing (erc--check-msg-prop 'erc--important-prop-names)))
+ (puthash 'erc--important-prop-names (cl-union existing (map-keys plist))
+ erc--msg-props)))
+ (erc--merge-prop beg end 'erc--important-props plist object))
+
+(defun erc--restore-important-text-props (props &optional beg end)
+ "Restore PROPS where recorded in the accessible portion of the buffer.
+Expect to run in a narrowed buffer at message-insertion time. Limit the
+effect to the region between buffer positions BEG and END, when non-nil.
+
+Callers should be aware that this function fails if the property
+`erc--important-props' has an empty value almost anywhere along the
+affected region. Use the function `erc--remove-from-prop-value-list' to
+ensure that props with empty values are excised completely."
+ (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names))
+ (present (seq-intersection props registered))
+ (b (or beg (point-min)))
+ (e (or end (point-max))))
+ (while-let
+ (((setq b (text-property-not-all b e 'erc--important-props nil)))
+ (val (get-text-property b 'erc--important-props))
+ (q (next-single-property-change b 'erc--important-props nil e)))
+ (while-let ((k (pop val))
+ (v (pop val)))
+ (when (memq k present)
+ (put-text-property b q k v)))
+ (setq b q))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index f337278994c..05ad4303b5c 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2285,14 +2285,16 @@ If FORCE is non-nil, the .newsrc file is read."
;; doesn't change with each release) and the
;; function that must be applied to convert the
;; previous version into the current version.
- '(("September Gnus v0.1" nil
- gnus-convert-old-ticks)
- ("Oort Gnus v0.08" "legacy-gnus-agent"
- gnus-agent-convert-to-compressed-agentview)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unlist-expire-days)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unhook-expire-days)))
+ '(;;These all date back to 2004 or earlier!
+ ;; ("September Gnus v0.1" nil
+ ;; gnus-convert-old-ticks)
+ ;; ("Oort Gnus v0.08" "legacy-gnus-agent"
+ ;; gnus-agent-convert-to-compressed-agentview)
+ ;; ("Gnus v5.10.7" "legacy-gnus-agent"
+ ;; gnus-agent-unlist-expire-days)
+ ;; ("Gnus v5.10.7" "legacy-gnus-agent"
+ ;; gnus-agent-unhook-expire-days)
+ ))
#'car-less-than-car)))
;; Skip converters older than the file version
(while (and converters (>= fcv (caar converters)))
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
deleted file mode 100644
index d4f08c72de8..00000000000
--- a/lisp/gnus/legacy-gnus-agent.el
+++ /dev/null
@@ -1,260 +0,0 @@
-;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*-
lexical-binding: t; -*-
-
-;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
-
-;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
-;; Keywords: news
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Conversion functions for the Agent.
-
-;;; Code:
-(require 'gnus-start)
-(require 'gnus-util)
-(require 'gnus-range)
-(require 'gnus-agent)
-
-;; Oort Gnus v0.08 - This release updated agent to no longer use
-;; history file and to support a compressed alist.
-
-(defvar gnus-agent-compressed-agentview-search-only nil)
-
-(defun gnus-agent-convert-to-compressed-agentview (converting-to)
- "Iterates over all agentview files to ensure that they have been
-converted to the compressed format."
-
- (let ((search-in (list gnus-agent-directory))
- here
- members
- member
- converted-something)
- (while (setq here (pop search-in))
- (setq members (directory-files here t))
- (while (setq member (pop members))
- (cond ((string-match "/\\.\\.?$" member)
- nil)
- ((file-directory-p member)
- (push member search-in))
- ((equal (file-name-nondirectory member) ".agentview")
- (setq converted-something
- (or (gnus-agent-convert-agentview member)
- converted-something))))))
-
- (if converted-something
- (gnus-message 4 "Successfully converted Gnus %s offline (agent) files
to %s" gnus-newsrc-file-version converting-to))))
-
-(defun gnus-agent-convert-to-compressed-agentview-prompt ()
- (catch 'found-file-to-convert
- (let ((gnus-agent-compressed-agentview-search-only t))
- (gnus-agent-convert-to-compressed-agentview nil))))
-
-(gnus-convert-mark-converter-prompt
'gnus-agent-convert-to-compressed-agentview
'gnus-agent-convert-to-compressed-agentview-prompt)
-
-(defun gnus-agent-convert-agentview (file)
- "Load FILE and do a `read' there."
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let ((inhibit-quit t)
- (alist (read (current-buffer)))
- (version (condition-case nil (read (current-buffer))
- (end-of-file 0)))
- changed-version
- history-file)
-
- (cond
- ((= version 0)
- (let (entry
- (gnus-command-method nil))
- (mm-disable-multibyte) ;; everything is binary
- (erase-buffer)
- (insert "\n")
- (let ((file (concat (file-name-directory file) "/history")))
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)
- (setq history-file file)))
-
- (goto-char (point-min))
- (while (not (eobp))
- (if (and (looking-at
- "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
- (string= (gnus-agent-article-name ".agentview"
(match-string 2))
- file)
- (setq entry (assoc (string-to-number (match-string 3))
alist)))
- (setcdr entry (string-to-number (match-string 1))))
- (forward-line 1))
- (setq changed-version t)))
- ((= version 1)
- (setq changed-version t)))
-
- (when changed-version
- (when gnus-agent-compressed-agentview-search-only
- (throw 'found-file-to-convert t))
-
- (erase-buffer)
- (let (article-id day-of-download comp-list compressed)
- (while alist
- (setq article-id (caar alist)
- day-of-download (cdar alist)
- comp-list (assq day-of-download compressed)
- alist (cdr alist))
- (if comp-list
- (setcdr comp-list (cons article-id (cdr comp-list)))
- (push (list day-of-download article-id) compressed)))
- (setq alist compressed)
- (while alist
- (setq comp-list (pop alist))
- (setcdr comp-list
- (gnus-compress-sequence (nreverse (cdr comp-list)))))
- (princ compressed (current-buffer)))
- (insert "\n2\n")
- (write-file file)
- (when history-file
- (delete-file history-file))
- t))))
-
-;; End of Oort Gnus v0.08 updates
-
-;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
-;; from previous versions. Therefore, the previous
-;; hacks to handle a gnus-agent-expire-days that
-;; specifies a list of values can be removed.
-
-(defun gnus-agent-unlist-expire-days (converting-to)
- (when (listp gnus-agent-expire-days)
- (let (buffer)
- (unwind-protect
- (save-window-excursion
- (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
- (set-buffer buffer)
- (erase-buffer)
- (insert "The definition of gnus-agent-expire-days has been
changed.\nYou currently have it set to the list:\n ")
- (gnus-pp gnus-agent-expire-days)
-
- (insert
- (format-message
- "\nIn order to use version `%s' of gnus, you will need to set\n"
- converting-to))
- (insert "gnus-agent-expire-days to an integer. If you still wish
to set different\n")
- (insert "expiration days to individual groups, you must instead
set the\n")
- (insert (format-message
- "`agent-days-until-old' group and/or topic parameter.\n"))
- (insert "\n")
- (insert "If you would like, gnus can iterate over every group
comparing its name to the\n")
- (insert "regular expressions that you currently have in
gnus-agent-expire-days. When\n")
- (insert (format-message
- "gnus finds a match, it will update that group's
`agent-days-until-old' group\n"))
- (insert "parameter to the value associated with the regular
expression.\n")
- (insert "\n")
- (insert "Whether gnus assigns group parameters, or not, gnus will
terminate with an\n")
- (insert "ERROR as soon as this function completes. The reason is
that you must\n")
- (insert "manually edit your configuration to either not set
gnus-agent-expire-days or\n")
- (insert "to set it to an integer before gnus can be used.\n")
- (insert "\n")
- (insert "Once you have successfully edited gnus-agent-expire-days,
gnus will be able to\n")
- (insert "execute past this function.\n")
- (insert "\n")
- (insert "Should gnus use gnus-agent-expire-days to assign\n")
- (insert "agent-days-until-old parameters to individual groups?
(Y/N)")
-
- (switch-to-buffer buffer)
- (beep)
- (beep)
-
- (let ((echo-keystrokes 0)
- c)
- (while (progn (setq c (read-char-exclusive))
- (cond ((or (eq c ?y) (eq c ?Y))
- (save-excursion
- (let ((groups
(gnus-group-listed-groups)))
- (while groups
- (let* ((group (pop groups))
- (days
gnus-agent-expire-days)
- (day (catch 'found
- (while days
- (when (eq 0
(string-match
-
(caar days)
-
group))
- (throw 'found
(cadr (car days))))
- (setq days (cdr
days)))
- nil)))
- (when day
- (gnus-group-set-parameter
group 'agent-days-until-old
-
day))))))
- nil
- )
- ((or (eq c ?n) (eq c ?N))
- nil)
- (t
- t))))))
- (kill-buffer buffer))
- (error "Change gnus-agent-expire-days to an integer for gnus to
start"))))
-
-;; The gnus-agent-unlist-expire-days has its own conversion prompt.
-;; Therefore, hide the default prompt.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
-
-(defun gnus-agent-unhook-expire-days (_converting-to)
- "Remove every lambda from `gnus-group-prepare-hook' that mention the
-symbol `gnus-agent-do-once' in their definition. This should NOT be
-necessary as gnus-agent.el no longer adds them. However, it is
-possible that the hook was persistently saved."
- (let ((h t)) ; Iterate from bgn of hook.
- (while h
- (let ((func (progn (when (eq h t)
- ;; Init h to list of functions.
- (setq h (cond ((listp gnus-group-prepare-hook)
- gnus-group-prepare-hook)
- ((boundp 'gnus-group-prepare-hook)
- (list gnus-group-prepare-hook)))))
- (pop h))))
-
- (when (cond ((byte-code-function-p func)
- ;; Search def. of compiled function for
- ;; gnus-agent-do-once string.
- (let* (definition
- print-level
- print-length
- (standard-output
- (lambda (char)
- (setq definition (cons char definition)))))
- (princ func) ; Populates definition with reversed list
- ; of characters.
- (let* ((i (length definition))
- (s (make-string i 0)))
- (while definition
- (aset s (setq i (1- i)) (pop definition)))
-
- (string-match "\\bgnus-agent-do-once\\b" s))))
- ((listp func)
- (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles
eval'd lambda.
- ))
-
- (remove-hook 'gnus-group-prepare-hook func)
- ;; I don't what remove-hook is going to actually do to the
- ;; hook list so start over from the beginning.
- (setq h t))))))
-
-;; gnus-agent-unhook-expire-days is safe in that it does not modify
-;; the .newsrc.eld file.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
-
-(provide 'legacy-gnus-agent)
-
-;;; legacy-gnus-agent.el ends here
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index ddc57724343..f22aa19f5e3 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -704,8 +704,10 @@ it defaults to the current region, else to the URL at or
before
point. If invoked with a mouse button, it moves point to the
position clicked before acting.
-This function returns a list (URL NEW-WINDOW-FLAG)
-for use in `interactive'."
+This function returns a list (URL NEW-WINDOW-FLAG) for use in
+`interactive'. NEW-WINDOW-FLAG is the prefix arg; if
+`browse-url-new-window-flag' is non-nil, invert the prefix arg
+instead."
(let ((event (elt (this-command-keys) 0)))
(mouse-set-point event))
(list (read-string prompt (or (and transient-mark-mode mark-active
@@ -715,8 +717,7 @@ for use in `interactive'."
(buffer-substring-no-properties
(region-beginning) (region-end))))
(browse-url-url-at-point)))
- (not (eq (null browse-url-new-window-flag)
- (null current-prefix-arg)))))
+ (xor browse-url-new-window-flag current-prefix-arg)))
;; called-interactive-p needs to be called at a function's top-level, hence
;; this macro. We use that rather than interactive-p because
@@ -879,8 +880,8 @@ The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use.
-This command prompts for a URL, defaulting to the URL at or
-before point.
+Interactively, this command prompts for a URL, defaulting to the
+URL at or before point.
The additional ARGS are passed to the browser function. See the
doc strings of the actual functions, starting with
@@ -888,7 +889,9 @@ doc strings of the actual functions, starting with
significance of ARGS (most of the functions ignore it).
If ARGS are omitted, the default is to pass
-`browse-url-new-window-flag' as ARGS."
+`browse-url-new-window-flag' as ARGS. Interactively, pass the
+prefix arg as ARGS; if `browse-url-new-window-flag' is non-nil,
+invert the prefix arg instead."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 77b334e704e..46f85daba24 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -371,11 +371,7 @@ object is returned instead of a list containing this
single Lisp object.
(apply
#'dbus-message-internal dbus-message-type-method-call
bus service path interface method #'dbus-call-method-handler args))
- (result (unless executing-kbd-macro (cons :pending nil))))
-
- ;; While executing a keyboard macro, we run into an infinite loop,
- ;; receiving the event -1. So we don't try to get the result.
- ;; (Bug#62018)
+ (result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
;; `dbus-return-values-table'. If no timeout is given, use the
diff --git a/lisp/subr.el b/lisp/subr.el
index 89ff1338f70..5ccaf17e73c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3554,11 +3554,6 @@ causes it to evaluate `help-form' and display the
result."
(help-form-show)))
((memq char chars)
(setq done t))
- ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd macro and
- ;; there are no more events in the macro. Attempt to
- ;; get an event interactively.
- (setq executing-kbd-macro nil))
((not inhibit-keyboard-quit)
(cond
((and (null esc-flag) (eq char ?\e))
diff --git a/src/android.c b/src/android.c
index d7bd06f1f34..dcd5c6d99c7 100644
--- a/src/android.c
+++ b/src/android.c
@@ -1688,6 +1688,8 @@ android_init_emacs_service (void)
"externalStorageAvailable", "()Z");
FIND_METHOD (request_storage_access,
"requestStorageAccess", "()V");
+ FIND_METHOD (cancel_notification,
+ "cancelNotification", "(Ljava/lang/String;)V");
#undef FIND_METHOD
}
@@ -2457,7 +2459,7 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
jshort window, jint x, jint y)
{
@@ -2477,7 +2479,7 @@ NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
jshort window, jint x, jint y,
jstring string)
@@ -2514,7 +2516,7 @@ NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
return event_serial;
}
-JNIEXPORT jboolean JNICALL
+JNIEXPORT jlong JNICALL
NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
jshort window, jint x, jint y,
jstring string)
@@ -2551,6 +2553,85 @@ NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
return event_serial;
}
+JNIEXPORT jlong JNICALL
+NATIVE_NAME (sendNotificationDeleted) (JNIEnv *env, jobject object,
+ jstring tag)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const char *characters;
+
+ event.notification.type = ANDROID_NOTIFICATION_DELETED;
+ event.notification.serial = ++event_serial;
+ event.notification.window = ANDROID_NONE;
+
+ /* TAG is guaranteed to be an ASCII string, of which the JNI character
+ encoding is a superset. */
+ characters = (*env)->GetStringUTFChars (env, tag, NULL);
+ if (!characters)
+ return 0;
+
+ event.notification.tag = strdup (characters);
+ (*env)->ReleaseStringUTFChars (env, tag, characters);
+ if (!event.notification.tag)
+ return 0;
+
+ event.notification.action = NULL;
+ event.notification.length = 0;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
+JNIEXPORT jlong JNICALL
+NATIVE_NAME (sendNotificationAction) (JNIEnv *env, jobject object,
+ jstring tag, jstring action)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const void *characters;
+ jsize length;
+ uint16_t *buffer;
+
+ event.notification.type = ANDROID_NOTIFICATION_ACTION;
+ event.notification.serial = ++event_serial;
+ event.notification.window = ANDROID_NONE;
+
+ /* TAG is guaranteed to be an ASCII string, of which the JNI character
+ encoding is a superset. */
+ characters = (*env)->GetStringUTFChars (env, tag, NULL);
+ if (!characters)
+ return 0;
+
+ event.notification.tag = strdup (characters);
+ (*env)->ReleaseStringUTFChars (env, tag, characters);
+ if (!event.notification.tag)
+ return 0;
+
+ length = (*env)->GetStringLength (env, action);
+ buffer = malloc (length * sizeof *buffer);
+ characters = (*env)->GetStringChars (env, action, NULL);
+
+ if (!characters)
+ {
+ /* The JVM has run out of memory; return and let the out of memory
+ error take its course. */
+ xfree (event.notification.tag);
+ return 0;
+ }
+
+ memcpy (buffer, characters, length * sizeof *buffer);
+ (*env)->ReleaseStringChars (env, action, characters);
+
+ event.notification.action = buffer;
+ event.notification.length = length;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
jobject object)
@@ -6310,6 +6391,82 @@ android_exception_check_4 (jobject object, jobject
object1,
memory_full (0);
}
+/* Like android_exception_check_4, except it takes more than four local
+ reference arguments. */
+
+void
+android_exception_check_5 (jobject object, jobject object1,
+ jobject object2, jobject object3,
+ jobject object4)
+{
+ if (likely (!(*android_java_env)->ExceptionCheck (android_java_env)))
+ return;
+
+ __android_log_print (ANDROID_LOG_WARN, __func__,
+ "Possible out of memory error. "
+ " The Java exception follows: ");
+ /* Describe exactly what went wrong. */
+ (*android_java_env)->ExceptionDescribe (android_java_env);
+ (*android_java_env)->ExceptionClear (android_java_env);
+
+ if (object)
+ ANDROID_DELETE_LOCAL_REF (object);
+
+ if (object1)
+ ANDROID_DELETE_LOCAL_REF (object1);
+
+ if (object2)
+ ANDROID_DELETE_LOCAL_REF (object2);
+
+ if (object3)
+ ANDROID_DELETE_LOCAL_REF (object3);
+
+ if (object4)
+ ANDROID_DELETE_LOCAL_REF (object4);
+
+ memory_full (0);
+}
+
+
+/* Like android_exception_check_5, except it takes more than five local
+ reference arguments. */
+
+void
+android_exception_check_6 (jobject object, jobject object1,
+ jobject object2, jobject object3,
+ jobject object4, jobject object5)
+{
+ if (likely (!(*android_java_env)->ExceptionCheck (android_java_env)))
+ return;
+
+ __android_log_print (ANDROID_LOG_WARN, __func__,
+ "Possible out of memory error. "
+ " The Java exception follows: ");
+ /* Describe exactly what went wrong. */
+ (*android_java_env)->ExceptionDescribe (android_java_env);
+ (*android_java_env)->ExceptionClear (android_java_env);
+
+ if (object)
+ ANDROID_DELETE_LOCAL_REF (object);
+
+ if (object1)
+ ANDROID_DELETE_LOCAL_REF (object1);
+
+ if (object2)
+ ANDROID_DELETE_LOCAL_REF (object2);
+
+ if (object3)
+ ANDROID_DELETE_LOCAL_REF (object3);
+
+ if (object4)
+ ANDROID_DELETE_LOCAL_REF (object4);
+
+ if (object5)
+ ANDROID_DELETE_LOCAL_REF (object5);
+
+ memory_full (0);
+}
+
/* Check for JNI problems based on the value of OBJECT.
Signal out of memory if OBJECT is NULL. OBJECT1 means the
diff --git a/src/android.h b/src/android.h
index e1834cebf68..2ca3d7e1446 100644
--- a/src/android.h
+++ b/src/android.h
@@ -118,6 +118,10 @@ extern void android_exception_check_1 (jobject);
extern void android_exception_check_2 (jobject, jobject);
extern void android_exception_check_3 (jobject, jobject, jobject);
extern void android_exception_check_4 (jobject, jobject, jobject, jobject);
+extern void android_exception_check_5 (jobject, jobject, jobject, jobject,
+ jobject);
+extern void android_exception_check_6 (jobject, jobject, jobject, jobject,
+ jobject, jobject);
extern void android_exception_check_nonnull (void *, jobject);
extern void android_exception_check_nonnull_1 (void *, jobject, jobject);
@@ -298,6 +302,7 @@ struct android_emacs_service
jmethodID valid_authority;
jmethodID external_storage_available;
jmethodID request_storage_access;
+ jmethodID cancel_notification;
};
extern JNIEnv *android_java_env;
@@ -306,6 +311,9 @@ extern JNIEnv *android_java_env;
extern JavaVM *android_jvm;
#endif /* THREADS_ENABLED */
+/* The Java String class. */
+extern jclass java_string_class;
+
/* The EmacsService object. */
extern jobject emacs_service;
diff --git a/src/androidfns.c b/src/androidfns.c
index 0675a0a3c98..83cf81c1f07 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -3398,9 +3398,9 @@ syms_of_androidfns_for_pdumper (void)
string, data);
}
}
- }
- ANDROID_DELETE_LOCAL_REF (string);
+ ANDROID_DELETE_LOCAL_REF (string);
+ }
/* And variant. */
diff --git a/src/androidgui.h b/src/androidgui.h
index 73b60c483d3..d89aee51055 100644
--- a/src/androidgui.h
+++ b/src/androidgui.h
@@ -251,6 +251,8 @@ enum android_event_type
ANDROID_DND_DRAG_EVENT,
ANDROID_DND_URI_EVENT,
ANDROID_DND_TEXT_EVENT,
+ ANDROID_NOTIFICATION_DELETED,
+ ANDROID_NOTIFICATION_ACTION,
};
struct android_any_event
@@ -535,6 +537,29 @@ struct android_dnd_event
size_t length;
};
+struct android_notification_event
+{
+ /* Type of the event. */
+ enum android_event_type type;
+
+ /* The event serial. */
+ unsigned long serial;
+
+ /* The window that gave rise to the event (None). */
+ android_window window;
+
+ /* The identifier of the notification whose status changed.
+ Must be deallocated with `free'. */
+ char *tag;
+
+ /* The action that was activated, if any. Must be deallocated with
+ `free'. */
+ unsigned short *action;
+
+ /* Length of that data. */
+ size_t length;
+};
+
union android_event
{
enum android_event_type type;
@@ -571,6 +596,10 @@ union android_event
protocol, whereas there exist several competing X protocols
implemented in terms of X client messages. */
struct android_dnd_event dnd;
+
+ /* X provides no equivalent interface for displaying
+ notifications. */
+ struct android_notification_event notification;
};
enum
diff --git a/src/androidselect.c b/src/androidselect.c
index 61f1c6045db..521133976a7 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "coding.h"
#include "android.h"
#include "androidterm.h"
+#include "termhooks.h"
/* Selection support on Android is confined to copying and pasting of
plain text and MIME data from the clipboard. There is no primary
@@ -490,6 +491,9 @@ struct android_emacs_desktop_notification
/* Methods provided by the EmacsDesktopNotification class. */
static struct android_emacs_desktop_notification notification_class;
+/* Hash table pairing notification identifiers with callbacks. */
+static Lisp_Object notification_table;
+
/* Initialize virtual function IDs and class pointers tied to the
EmacsDesktopNotification class. */
@@ -521,7 +525,8 @@ android_init_emacs_desktop_notification (void)
FIND_METHOD (init, "<init>", "(Ljava/lang/String;"
"Ljava/lang/String;Ljava/lang/String;"
- "Ljava/lang/String;II)V");
+ "Ljava/lang/String;II[Ljava/lang/String;"
+ "[Ljava/lang/String;)V");
FIND_METHOD (display, "display", "()V");
#undef FIND_METHOD
}
@@ -562,25 +567,32 @@ android_locate_icon (const char *name)
}
/* Display a desktop notification with the provided TITLE, BODY,
- REPLACES_ID, GROUP, ICON, and URGENCY. Return an identifier for
- the resulting notification. */
+ REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and
+ CLOSE_CB. Return an identifier for the resulting notification. */
static intmax_t
android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
Lisp_Object replaces_id,
Lisp_Object group, Lisp_Object icon,
- Lisp_Object urgency)
+ Lisp_Object urgency, Lisp_Object actions,
+ Lisp_Object resident, Lisp_Object action_cb,
+ Lisp_Object close_cb)
{
static intmax_t counter;
intmax_t id;
jstring title1, body1, group1, identifier1;
jint type, icon1;
jobject notification;
+ jobjectArray action_keys, action_titles;
char identifier[INT_STRLEN_BOUND (int)
+ INT_STRLEN_BOUND (long int)
+ INT_STRLEN_BOUND (intmax_t)
+ sizeof "..."];
struct timespec boot_time;
+ Lisp_Object key, value, tem;
+ jint nitems, i;
+ jstring item;
+ Lisp_Object length;
if (EQ (urgency, Qlow))
type = 2; /* IMPORTANCE_LOW */
@@ -591,6 +603,29 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
else
signal_error ("Invalid notification importance given", urgency);
+ nitems = 0;
+
+ /* If ACTIONS is provided, split it into two arrays of Java strings
+ holding keys and titles. */
+
+ if (!NILP (actions))
+ {
+ /* Count the number of items to be inserted. */
+
+ length = Flength (actions);
+ if (!TYPE_RANGED_FIXNUMP (jint, length))
+ error ("Action list too long");
+ nitems = XFIXNAT (length);
+ if (nitems & 1)
+ error ("Length of action list is invalid");
+ nitems /= 2;
+
+ /* Verify that the list consists exclusively of strings. */
+ tem = actions;
+ FOR_EACH_TAIL (tem)
+ CHECK_STRING (XCAR (tem));
+ }
+
if (NILP (replaces_id))
{
/* Generate a new identifier. */
@@ -626,14 +661,62 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
= (*android_java_env)->NewStringUTF (android_java_env, identifier);
android_exception_check_3 (title1, body1, group1);
+ /* Create the arrays for action identifiers and titles if
+ provided. */
+
+ if (nitems)
+ {
+ action_keys = (*android_java_env)->NewObjectArray (android_java_env,
+ nitems,
+ java_string_class,
+ NULL);
+ android_exception_check_4 (title, body1, group1, identifier1);
+ action_titles = (*android_java_env)->NewObjectArray (android_java_env,
+ nitems,
+ java_string_class,
+ NULL);
+ android_exception_check_5 (title, body1, group1, identifier1,
+ action_keys);
+
+ for (i = 0; i < nitems; ++i)
+ {
+ key = XCAR (actions);
+ value = XCAR (XCDR (actions));
+ actions = XCDR (XCDR (actions));
+
+ /* Create a string for this action. */
+ item = android_build_string (key, body1, group1, identifier1,
+ action_keys, action_titles, NULL);
+ (*android_java_env)->SetObjectArrayElement (android_java_env,
+ action_keys, i,
+ item);
+ ANDROID_DELETE_LOCAL_REF (item);
+
+ /* Create a string for this title. */
+ item = android_build_string (value, body1, group1, identifier1,
+ action_keys, action_titles, NULL);
+ (*android_java_env)->SetObjectArrayElement (android_java_env,
+ action_titles, i,
+ item);
+ ANDROID_DELETE_LOCAL_REF (item);
+ }
+ }
+ else
+ {
+ action_keys = NULL;
+ action_titles = NULL;
+ }
+
/* Create the notification. */
notification
= (*android_java_env)->NewObject (android_java_env,
notification_class.class,
notification_class.init,
title1, body1, group1,
- identifier1, icon1, type);
- android_exception_check_4 (title1, body1, group1, identifier1);
+ identifier1, icon1, type,
+ action_keys, action_titles);
+ android_exception_check_6 (title1, body1, group1, identifier1,
+ action_titles, action_keys);
/* Delete unused local references. */
ANDROID_DELETE_LOCAL_REF (title1);
@@ -641,6 +724,12 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
ANDROID_DELETE_LOCAL_REF (group1);
ANDROID_DELETE_LOCAL_REF (identifier1);
+ if (action_keys)
+ ANDROID_DELETE_LOCAL_REF (action_keys);
+
+ if (action_titles)
+ ANDROID_DELETE_LOCAL_REF (action_titles);
+
/* Display the notification. */
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
notification,
@@ -649,6 +738,13 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
android_exception_check_1 (notification);
ANDROID_DELETE_LOCAL_REF (notification);
+ /* If callbacks are provided, save them into notification_table. */
+
+ if (!NILP (action_cb) || !NILP (close_cb) || !NILP (resident))
+ Fputhash (build_string (identifier), list3 (action_cb, close_cb,
+ resident),
+ notification_table);
+
/* Return the ID. */
return id;
}
@@ -659,14 +755,30 @@ DEFUN ("android-notifications-notify",
Fandroid_notifications_notify,
ARGS must contain keywords followed by values. Each of the following
keywords is understood:
- :title The notification title.
- :body The notification body.
- :replaces-id The ID of a previous notification to supersede.
- :group The notification group, or nil.
- :urgency One of the symbols `low', `normal' or `critical',
- defining the importance of the notification group.
- :icon The name of a drawable resource to display as the
- notification's icon.
+ :title The notification title.
+ :body The notification body.
+ :replaces-id The ID of a previous notification to supersede.
+ :group The notification group, or nil.
+ :urgency One of the symbols `low', `normal' or `critical',
+ defining the importance of the notification group.
+ :icon The name of a drawable resource to display as the
+ notification's icon.
+ :actions A list of actions of the form:
+ (KEY TITLE KEY TITLE ...)
+ where KEY and TITLE are both strings.
+ The action for which CALLBACK is called when the
+ notification itself is selected is named "default",
+ its existence is implied, and its TITLE is ignored.
+ No more than three actions can be defined, not
+ counting any action with "default" as its key.
+ :resident When set the notification will not be automatically
+ dismissed when it or an action is selected.
+ :on-action Function to call when an action is invoked.
+ The notification id and the key of the action are
+ provided as arguments to the function.
+ :on-close Function to call if the notification is dismissed,
+ with the notification id and the symbol `undefined'
+ for arguments.
The notification group is ignored on Android 7.1 and earlier versions
of Android. Outside such older systems, it identifies a category that
@@ -686,6 +798,9 @@ within the "android.R.drawable" class designating an icon
with a
transparent background. If no icon is provided (or the icon is absent
from this system), it defaults to "ic_dialog_alert".
+Actions specified with :actions cannot be displayed on Android 4.0 and
+earlier versions of the system.
+
When the system is running Android 13 or later, notifications sent
will be silently disregarded unless permission to display
notifications is expressly granted from the "App Info" settings panel
@@ -699,16 +814,17 @@ this function.
usage: (android-notifications-notify &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object title, body, replaces_id, group, urgency;
+ Lisp_Object title, body, replaces_id, group, urgency, resident;
Lisp_Object icon;
- Lisp_Object key, value;
+ Lisp_Object key, value, actions, action_cb, close_cb;
ptrdiff_t i;
if (!android_init_gui)
error ("No Android display connection!");
/* Clear each variable above. */
- title = body = replaces_id = group = icon = urgency = Qnil;
+ title = body = replaces_id = group = icon = urgency = actions = Qnil;
+ resident = action_cb = close_cb = Qnil;
/* If NARGS is odd, error. */
@@ -734,6 +850,14 @@ usage: (android-notifications-notify &rest ARGS) */)
urgency = value;
else if (EQ (key, QCicon))
icon = value;
+ else if (EQ (key, QCactions))
+ actions = value;
+ else if (EQ (key, QCresident))
+ resident = value;
+ else if (EQ (key, QCon_action))
+ action_cb = value;
+ else if (EQ (key, QCon_close))
+ close_cb = value;
}
/* Demand at least TITLE and BODY be present. */
@@ -758,7 +882,83 @@ usage: (android-notifications-notify &rest ARGS) */)
CHECK_STRING (icon);
return make_int (android_notifications_notify_1 (title, body, replaces_id,
- group, icon, urgency));
+ group, icon, urgency,
+ actions, resident,
+ action_cb, close_cb));
+}
+
+/* Run callbacks in response to a notification being deleted.
+ Save any input generated for the keyboard within *IE.
+ EVENT should be the notification deletion event. */
+
+void
+android_notification_deleted (struct android_notification_event *event,
+ struct input_event *ie)
+{
+ Lisp_Object item, tag;
+ intmax_t id;
+
+ tag = build_string (event->tag);
+ item = Fgethash (tag, notification_table, Qnil);
+
+ if (!NILP (item))
+ Fremhash (tag, notification_table);
+
+ if (CONSP (item) && FUNCTIONP (XCAR (XCDR (item)))
+ && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0)
+ {
+ ie->kind = NOTIFICATION_EVENT;
+ ie->arg = list3 (XCAR (XCDR (item)), make_int (id),
+ Qundefined);
+ }
+}
+
+/* Run callbacks in response to one of a notification's actions being
+ invoked, saving any input generated for the keyboard within *IE.
+ EVENT should be the notification deletion event, and ACTION the
+ action key. */
+
+void
+android_notification_action (struct android_notification_event *event,
+ struct input_event *ie, Lisp_Object action)
+{
+ Lisp_Object item, tag;
+ intmax_t id;
+ jstring tag_object;
+ jmethodID method;
+
+ tag = build_string (event->tag);
+ item = Fgethash (tag, notification_table, Qnil);
+
+ if (CONSP (item) && FUNCTIONP (XCAR (item))
+ && sscanf (event->tag, "%*d.%*ld.%jd", &id) > 0)
+ {
+ ie->kind = NOTIFICATION_EVENT;
+ ie->arg = list3 (XCAR (item), make_int (id), action);
+ }
+
+ /* Test whether ITEM is resident. Non-resident notifications must be
+ removed when activated. */
+
+ if (!CONSP (item) || NILP (XCAR (XCDR (XCDR (item)))))
+ {
+ method = service_class.cancel_notification;
+ tag_object
+ = (*android_java_env)->NewStringUTF (android_java_env,
+ event->tag);
+ android_exception_check ();
+
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method, tag_object);
+ android_exception_check_1 (tag_object);
+ ANDROID_DELETE_LOCAL_REF (tag_object);
+
+ /* Remove the notification from the callback table. */
+ if (!NILP (item))
+ Fremhash (tag, notification_table);
+ }
}
@@ -800,6 +1000,10 @@ syms_of_androidselect (void)
DEFSYM (QCgroup, ":group");
DEFSYM (QCurgency, ":urgency");
DEFSYM (QCicon, ":icon");
+ DEFSYM (QCactions, ":actions");
+ DEFSYM (QCresident, ":resident");
+ DEFSYM (QCon_action, ":on-action");
+ DEFSYM (QCon_close, ":on-close");
DEFSYM (Qlow, "low");
DEFSYM (Qnormal, "normal");
@@ -814,4 +1018,7 @@ syms_of_androidselect (void)
defsubr (&Sandroid_get_clipboard_data);
defsubr (&Sandroid_notifications_notify);
+
+ notification_table = CALLN (Fmake_hash_table, QCtest, Qequal);
+ staticpro (¬ification_table);
}
diff --git a/src/androidterm.c b/src/androidterm.c
index baf26abe322..f68f8a9ef62 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -1761,6 +1761,26 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
free (event->dnd.uri_or_string);
goto OTHER;
+ case ANDROID_NOTIFICATION_DELETED:
+ case ANDROID_NOTIFICATION_ACTION:
+
+ if (event->notification.type == ANDROID_NOTIFICATION_DELETED)
+ android_notification_deleted (&event->notification, &inev.ie);
+ else
+ {
+ Lisp_Object action;
+
+ action = android_decode_utf16 (event->notification.action,
+ event->notification.length);
+ android_notification_action (&event->notification, &inev.ie,
+ action);
+ }
+
+ /* Free dynamically allocated data. */
+ free (event->notification.tag);
+ free (event->notification.action);
+ goto OTHER;
+
default:
goto OTHER;
}
@@ -4740,7 +4760,7 @@ android_sync_edit (void)
/* Return a copy of the specified Java string and its length in
*LENGTH. Use the JNI environment ENV. Value is NULL if copying
- *the string fails. */
+ the string fails. */
static unsigned short *
android_copy_java_string (JNIEnv *env, jstring string, size_t *length)
diff --git a/src/androidterm.h b/src/androidterm.h
index 41c93067e82..ca6929bef0e 100644
--- a/src/androidterm.h
+++ b/src/androidterm.h
@@ -25,6 +25,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "character.h"
#include "dispextern.h"
#include "font.h"
+#include "termhooks.h"
struct android_bitmap_record
{
@@ -464,6 +465,11 @@ extern void syms_of_sfntfont_android (void);
#ifndef ANDROID_STUBIFY
+extern void android_notification_deleted (struct android_notification_event *,
+ struct input_event *);
+extern void android_notification_action (struct android_notification_event *,
+ struct input_event *, Lisp_Object);
+
extern void init_androidselect (void);
extern void syms_of_androidselect (void);
diff --git a/src/androidvfs.c b/src/androidvfs.c
index d618e351204..4bb652f3eb7 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -292,7 +292,7 @@ struct android_parcel_file_descriptor_class
};
/* The java.lang.String class. */
-static jclass java_string_class;
+jclass java_string_class;
/* Fields and methods associated with the Cursor class. */
static struct android_cursor_class cursor_class;
diff --git a/src/data.c b/src/data.c
index 00e33ec3d8c..4d987e5b357 100644
--- a/src/data.c
+++ b/src/data.c
@@ -339,7 +339,8 @@ DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1,
1, 0,
}
DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a symbol together with position. */
+ doc: /* Return t if OBJECT is a symbol together with position.
+Ignore `symbols-with-pos-enabled'. */
attributes: const)
(Lisp_Object object)
{
@@ -789,26 +790,32 @@ Doing that might make Emacs dysfunctional, and might even
crash Emacs. */)
}
DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0,
- doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */)
+ doc: /* Extract, if need be, the bare symbol from SYM.
+SYM is either a symbol or a symbol with position.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym)
{
- if (!SYMBOL_WITH_POS_P (sym))
- CHECK_SYMBOL (sym);
- return BARE_SYMBOL_P (sym) ? sym : XSYMBOL_WITH_POS_SYM (sym);
+ if (BARE_SYMBOL_P (sym))
+ return sym;
+ if (SYMBOL_WITH_POS_P (sym))
+ return XSYMBOL_WITH_POS_SYM (sym);
+ xsignal2 (Qwrong_type_argument, list2 (Qsymbolp, Qsymbol_with_pos_p), sym);
}
DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1,
1, 0,
- doc: /* Extract the position from a symbol with position. */)
- (register Lisp_Object ls)
+ doc: /* Extract the position from the symbol with position SYMPOS.
+Ignore `symbols-with-pos-enabled'. */)
+ (register Lisp_Object sympos)
{
- CHECK_TYPE (SYMBOL_WITH_POS_P (ls), Qsymbol_with_pos_p, ls);
- return XSYMBOL_WITH_POS_POS (ls);
+ CHECK_TYPE (SYMBOL_WITH_POS_P (sympos), Qsymbol_with_pos_p, sympos);
+ return XSYMBOL_WITH_POS_POS (sympos);
}
DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol,
Sremove_pos_from_symbol, 1, 1, 0,
doc: /* If ARG is a symbol with position, return it without the
position.
-Otherwise, return ARG unchanged. Compare with `bare-symbol'. */)
+Otherwise, return ARG unchanged. Ignore `symbols-with-pos-enabled'.
+Compare with `bare-symbol'. */)
(register Lisp_Object arg)
{
if (SYMBOL_WITH_POS_P (arg))
@@ -817,10 +824,11 @@ Otherwise, return ARG unchanged. Compare with
`bare-symbol'. */)
}
DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0,
- doc: /* Create a new symbol with position.
+ doc: /* Make a new symbol with position.
SYM is a symbol, with or without position, the symbol to position.
-POS, the position, is either a fixnum or a symbol with position from which
-the position will be taken. */)
+POS, the position, is either a nonnegative fixnum,
+or a symbol with position from which the position will be taken.
+Ignore `symbols-with-pos-enabled'. */)
(register Lisp_Object sym, register Lisp_Object pos)
{
Lisp_Object bare = Fbare_symbol (sym);
@@ -852,7 +860,7 @@ signal a `cyclic-function-indirection' error. */)
eassert (valid_lisp_object_p (definition));
/* Ensure non-circularity. */
- for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s);
+ for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s);,
s = XSYMBOL (s)->u.s.function)
if (EQ (s, symbol))
xsignal1 (Qcyclic_function_indirection, symbol);
@@ -4382,7 +4390,7 @@ This variable cannot be set; trying to do so will signal
an error. */);
DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled");
DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled,
- doc: /* Non-nil when "symbols with position" can be used as
symbols.
+ doc: /* If non-nil, a symbol with position ordinarily behaves
as its bare symbol.
Bind this to non-nil in applications such as the byte compiler. */);
symbols_with_pos_enabled = false;
diff --git a/src/keyboard.c b/src/keyboard.c
index eb0de98bad1..91faf4582fa 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2620,7 +2620,8 @@ read_char (int commandflag, Lisp_Object map,
goto reread_for_input_method;
}
- if (!NILP (Vexecuting_kbd_macro))
+ /* If we're executing a macro, process it unless we are at its end. */
+ if (!NILP (Vexecuting_kbd_macro) && !at_end_of_macro_p ())
{
/* We set this to Qmacro; since that's not a frame, nobody will
try to switch frames on us, and the selected window will
@@ -2634,16 +2635,6 @@ read_char (int commandflag, Lisp_Object map,
selected. */
Vlast_event_frame = internal_last_event_frame = Qmacro;
- /* Exit the macro if we are at the end.
- Also, some things replace the macro with t
- to force an early exit. */
- if (EQ (Vexecuting_kbd_macro, Qt)
- || executing_kbd_macro_index >= XFIXNAT (Flength
(Vexecuting_kbd_macro)))
- {
- XSETINT (c, -1);
- goto exit;
- }
-
c = Faref (Vexecuting_kbd_macro, make_int (executing_kbd_macro_index));
if (STRINGP (Vexecuting_kbd_macro)
&& (XFIXNAT (c) & 0x80) && (XFIXNAT (c) <= 0xff))
@@ -4196,6 +4187,16 @@ kbd_buffer_get_event (KBOARD **kbp,
break;
}
+#ifdef HAVE_ANDROID
+ case NOTIFICATION_EVENT:
+ {
+ kbd_fetch_ptr = next_kbd_event (event);
+ input_pending = readable_events (0);
+ CALLN (Fapply, XCAR (event->ie.arg), XCDR (event->ie.arg));
+ break;
+ }
+#endif /* HAVE_ANDROID */
+
#ifdef HAVE_EXT_MENU_BAR
case MENU_BAR_ACTIVATE_EVENT:
{
@@ -10451,9 +10452,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
Lisp_Object original_uppercase UNINIT;
int original_uppercase_position = -1;
- /* Gets around Microsoft compiler limitations. */
- bool dummyflag = false;
-
#ifdef HAVE_TEXT_CONVERSION
bool disabled_conversion;
@@ -10695,8 +10693,16 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
}
used_mouse_menu = used_mouse_menu_history[t];
}
-
- /* If not, we should actually read a character. */
+ /* If we're at the end of a macro, exit it by returning 0,
+ unless there are unread events pending. */
+ else if (!NILP (Vexecuting_kbd_macro)
+ && at_end_of_macro_p ()
+ && !requeued_events_pending_p ())
+ {
+ t = 0;
+ goto done;
+ }
+ /* Otherwise, we should actually read a character. */
else
{
{
@@ -10788,18 +10794,6 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
return -1;
}
- /* read_char returns -1 at the end of a macro.
- Emacs 18 handles this by returning immediately with a
- zero, so that's what we'll do. */
- if (FIXNUMP (key) && XFIXNUM (key) == -1)
- {
- t = 0;
- /* The Microsoft C compiler can't handle the goto that
- would go here. */
- dummyflag = true;
- break;
- }
-
/* If the current buffer has been changed from under us, the
keymap may have changed, so replay the sequence. */
if (BUFFERP (key))
@@ -11301,10 +11295,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
&& help_char_p (EVENT_HEAD (key)) && t > 1)
{
read_key_sequence_cmd = Vprefix_help_command;
- /* The Microsoft C compiler can't handle the goto that
- would go here. */
- dummyflag = true;
- break;
+ goto done;
}
/* If KEY is not defined in any of the keymaps,
@@ -11353,8 +11344,9 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
}
}
}
- if (!dummyflag)
- read_key_sequence_cmd = current_binding;
+ read_key_sequence_cmd = current_binding;
+
+ done:
read_key_sequence_remapped
/* Remap command through active keymaps.
Do the remapping here, before the unbind_to so it uses the keymaps
@@ -11566,18 +11558,26 @@ clear_input_pending (void)
input_pending = false;
}
-/* Return true if there are pending requeued events.
- This isn't used yet. The hope is to make wait_reading_process_output
- call it, and return if it runs Lisp code that unreads something.
- The problem is, kbd_buffer_get_event needs to be fixed to know what
- to do in that case. It isn't trivial. */
+/* Return true if there are pending requeued command events. */
bool
-requeued_events_pending_p (void)
+requeued_command_events_pending_p (void)
{
return (CONSP (Vunread_command_events));
}
+/* Return true if there are any pending requeued events (command events
+ or events to be processed by other levels of the input processing
+ stages). */
+
+bool
+requeued_events_pending_p (void)
+{
+ return (requeued_command_events_pending_p ()
+ || !NILP (Vunread_post_input_method_events)
+ || !NILP (Vunread_input_method_events));
+}
+
DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
doc: /* Return t if command input is currently available with no wait.
Actually, the value is nil only if we can be sure that no input is available;
@@ -11586,9 +11586,7 @@ if there is a doubt, the value is t.
If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
(Lisp_Object check_timers)
{
- if (CONSP (Vunread_command_events)
- || !NILP (Vunread_post_input_method_events)
- || !NILP (Vunread_input_method_events))
+ if (requeued_events_pending_p ())
return (Qt);
/* Process non-user-visible events (Bug#10195). */
diff --git a/src/keyboard.h b/src/keyboard.h
index 68e68bc2ae3..2ce003fd444 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -483,6 +483,7 @@ extern void set_poll_suppress_count (int);
extern int gobble_input (void);
extern bool input_polling_used (void);
extern void clear_input_pending (void);
+extern bool requeued_command_events_pending_p (void);
extern bool requeued_events_pending_p (void);
extern void bind_polling_period (int);
extern int make_ctrl_char (int) ATTRIBUTE_CONST;
diff --git a/src/macros.c b/src/macros.c
index 5f71bcbd361..230195d9488 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -314,6 +314,48 @@ buffer before the macro is executed. */)
Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
+ /* The following loop starts the execution of possibly multiple
+ iterations of the macro.
+
+ The state variables that control the execution of a single
+ iteration are Vexecuting_kbd_macro and executing_kbd_macro_index,
+ which can be accessed from lisp. The purpose of the variables
+ executing_kbd_macro and executing_kbd_macro_iteration is to
+ remember the most recently started macro and its iteration count.
+ This makes it possible to produce a meaningful message in case of
+ errors during the execution of the macro.
+
+ In a single iteration, individual characters from the macro are
+ read by read_char, which takes care of incrementing
+ executing_kbd_macro_index after each character.
+
+ The end of a macro iteration is handled as follows:
+ - read_key_sequence asks at_end_of_macro_p whether the end of the
+ iteration has been reached. If so, it returns the magic value 0
+ to command_loop_1.
+ - command_loop_1 returns Qnil to command_loop_2.
+ - command_loop_2 returns Qnil to this function
+ (but only the returning is relevant, not the actual value).
+
+ Macro executions form a stack. After the last iteration of the
+ execution of one stack item, or in case of an error during one of
+ the iterations, pop_kbd_macro (invoked via unwind-protect) will
+ restore Vexecuting_kbd_macro and executing_kbd_macro_index, and
+ run 'kbd-macro-termination-hook'.
+
+ If read_char happens to be called at the end of a macro interation,
+ but before read_key_sequence could handle the end (e.g., when lisp
+ code calls 'read-event', 'read-char', or 'read-char-exclusive'),
+ read_char will simply continue reading other available input
+ (Bug#68272). Vexecuting_kbd_macro and executing_kbd_macro remain
+ untouched until the end of the iteration is handled.
+
+ This is similar (in observable behavior) to a posibly simpler
+ implementation of keyboard macros in which this function pushed all
+ characters of the macro into the incoming event queue and returned
+ immediately. Maybe this is the implementation that we ideally
+ would like to have, but switching to it will require a larger code
+ change. */
do
{
Vexecuting_kbd_macro = final;
@@ -353,6 +395,18 @@ init_macros (void)
executing_kbd_macro = Qnil;
}
+/* Whether the execution of a macro has reached its end.
+ This should be called only while executing a macro. */
+
+bool
+at_end_of_macro_p (void)
+{
+ eassume (!NILP (Vexecuting_kbd_macro));
+ /* Some things replace the macro with t to force an early exit. */
+ return EQ (Vexecuting_kbd_macro, Qt)
+ || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro));
+}
+
void
syms_of_macros (void)
{
diff --git a/src/macros.h b/src/macros.h
index 51599a29bcd..cb6ac8aa206 100644
--- a/src/macros.h
+++ b/src/macros.h
@@ -47,4 +47,9 @@ extern void finalize_kbd_macro_chars (void);
extern void store_kbd_macro_char (Lisp_Object);
+/* Whether the execution of a macro has reached its end.
+ This should be called only while executing a macro. */
+
+extern bool at_end_of_macro_p (void);
+
#endif /* EMACS_MACROS_H */
diff --git a/src/process.c b/src/process.c
index 48a2c0c8e53..6b8b483cdf7 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5439,7 +5439,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* This is so a breakpoint can be put here. */
@@ -5849,7 +5849,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* If we are not checking for keyboard input now,
@@ -8036,7 +8036,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd != 0
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
if (timespec_valid_p (timer_delay))
@@ -8109,7 +8109,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
/* If there is unread keyboard input, also return. */
if (read_kbd
- && requeued_events_pending_p ())
+ && requeued_command_events_pending_p ())
break;
/* If wait_for_cell. check for keyboard input
diff --git a/src/termhooks.h b/src/termhooks.h
index 8defebb20bd..d828c62ce33 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -343,6 +343,10 @@ enum event_kind
the notification that was clicked. */
, NOTIFICATION_CLICKED_EVENT
#endif /* HAVE_HAIKU */
+#ifdef HAVE_ANDROID
+ /* In a NOTIFICATION_EVENT, .arg is a lambda to evaluate. */
+ , NOTIFICATION_EVENT
+#endif /* HAVE_ANDROID */
};
/* Bit width of an enum event_kind tag at the start of structs and unions. */
diff --git a/test/lisp/erc/erc-goodies-tests.el
b/test/lisp/erc/erc-goodies-tests.el
index 7013ce0c8fc..c8fb0544a72 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -29,19 +29,23 @@
(defun erc-goodies-tests--assert-face (beg end-str present &optional absent)
(setq beg (+ beg (point-min)))
(let ((end (+ beg (1- (length end-str)))))
- (while (and beg (< beg end))
- (let* ((val (get-text-property beg 'font-lock-face))
- (ft (flatten-tree (ensure-list val))))
- (dolist (p (ensure-list present))
- (if (consp p)
- (should (member p val))
- (should (memq p ft))))
- (dolist (a (ensure-list absent))
- (if (consp a)
- (should-not (member a val))
- (should-not (memq a ft))))
- (setq beg (text-property-not-all beg (point-max)
- 'font-lock-face val))))))
+ (ert-info ((format "beg: %S, end-str: %S" beg end-str))
+ (while (and beg (< beg end))
+ (let* ((val (get-text-property beg 'font-lock-face))
+ (ft (flatten-tree (ensure-list val))))
+ (ert-info ((format "looking-at: %S, val: %S"
+ (buffer-substring-no-properties beg end)
+ val))
+ (dolist (p (ensure-list present))
+ (if (consp p)
+ (should (member p val))
+ (should (memq p ft))))
+ (dolist (a (ensure-list absent))
+ (if (consp a)
+ (should-not (member a val))
+ (should-not (memq a ft)))))
+ (setq beg (text-property-not-all beg (point-max)
+ 'font-lock-face val)))))))
;; These are from the "Examples" section of
;; https://modern.ircdocs.horse/formatting.html
@@ -129,39 +133,100 @@
;; Hovering over the redacted area should reveal its underlying text
;; in a high-contrast face.
-(ert-deftest erc-controls-highlight--inverse ()
+(ert-deftest erc-controls-highlight--spoilers ()
(should (eq t erc-interpret-controls-p))
- (let ((erc-insert-modify-hook '(erc-controls-highlight))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (with-current-buffer (get-buffer-create "#chan")
- (erc-mode)
- (setq-local erc-interpret-mirc-color t)
- (erc--initialize-markers (point) nil)
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (let* ((raw (concat "BEGIN "
+ "\C-c0,0 WhiteOnWhite "
+ "\C-c1,1 BlackOnBlack "
+ "\C-c99,99 Default "
+ "\C-o END"))
+ (msg (erc-format-privmessage "bob" raw nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ ;; Narrow to EOL or start of right-side stamp.
+ (narrow-to-region (point) (line-end-position))
+ (save-excursion
+ (search-forward "WhiteOn")
+ (should (eq (get-text-property (point) 'mouse-face)
+ 'erc-spoiler-face))
+ (search-forward "BlackOn")
+ (should (eq (get-text-property (point) 'mouse-face)
+ 'erc-spoiler-face)))
+ ;; Start wtih ERC default face.
+ (erc-goodies-tests--assert-face
+ 0 "BEGIN " 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))
+ ;; Masked in all white.
+ (erc-goodies-tests--assert-face
+ 6 "WhiteOnWhite" '(fg:erc-color-face0 bg:erc-color-face0)
+ '(fg:erc-color-face1 bg:erc-color-face1))
+ ;; Masked in all black.
+ (erc-goodies-tests--assert-face
+ 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1)
+ '(erc-control-default-fg erc-control-default-bg))
+ ;; Explicit "default" code ignoerd.
+ (erc-goodies-tests--assert-face
+ 34 "Default" '(erc-control-default-fg erc-control-default-bg)
+ '(fg:erc-color-face1 bg:erc-color-face1))
+ (erc-goodies-tests--assert-face
+ 43 "END" 'erc-default-face
+ '(erc-control-default-bg erc-control-default-fg))))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
- (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!")
- (msg (erc-format-privmessage "bob" m nil t)))
- (erc-display-message nil nil (current-buffer) msg))
- (forward-line -1)
- (should (search-forward "<bob> " nil t))
- (save-restriction
- (narrow-to-region (point) (pos-eol))
- (should (eq (get-text-property (+ 9 (point)) 'mouse-face)
- 'erc-inverse-face))
- (should (eq (get-text-property (1- (pos-eol)) 'mouse-face)
- 'erc-inverse-face))
- (erc-goodies-tests--assert-face
- 0 "Spoiler: " 'erc-default-face
- '(fg:erc-color-face0 bg:erc-color-face0))
- (erc-goodies-tests--assert-face
- 9 "Hello" '(erc-spoiler-face)
- '( fg:erc-color-face0 bg:erc-color-face0
- fg:erc-color-face1 bg:erc-color-face1))
- (erc-goodies-tests--assert-face
- 18 " World" '(erc-spoiler-face)
- '( fg:erc-color-face0 bg:erc-color-face0
- fg:erc-color-face1 bg:erc-color-face1 )))
- (when noninteractive
- (kill-buffer)))))
+(ert-deftest erc-controls-highlight--inverse ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let* ((erc-fill-column 90)
+ (raw (concat "BEGIN "
+ "\C-c3,13 GreenOnPink "
+ "\C-v PinkOnGreen "
+ "\C-c99,99 ReversedDefault "
+ "\C-v NormalDefault "
+ "\C-o END"))
+ (msg (erc-format-privmessage "bob" raw nil t)))
+ (erc-display-message nil nil (current-buffer) msg))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (save-restriction
+ ;; Narrow to EOL or start of right-side stamp.
+ (narrow-to-region (point) (line-end-position))
+ ;; Baseline.
+ (erc-goodies-tests--assert-face
+ 0 "BEGIN " 'erc-default-face
+ '(fg:erc-color-face0 bg:erc-color-face0))
+ ;; Normal fg/bg combo.
+ (erc-goodies-tests--assert-face
+ 6 "GreenOnPink" '(fg:erc-color-face3 bg:erc-color-face13)
+ '(erc-inverse-face))
+ ;; Reverse of previous, so former-bg on former-fg.
+ (erc-goodies-tests--assert-face
+ 19 "PinkOnGreen"
+ '(erc-inverse-face fg:erc-color-face3 bg:erc-color-face13)
+ nil)
+ ;; The inverse of `default' because reverse still in effect.
+ (erc-goodies-tests--assert-face
+ 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg
+ erc-control-default-bg)
+ '(fg:erc-color-face3 bg:erc-color-face13))
+ (erc-goodies-tests--assert-face
+ 49 "NormalDefault" '(erc-control-default-fg
+ erc-control-default-bg)
+ '(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1))
+ (erc-goodies-tests--assert-face
+ 64 "END" 'erc-default-face
+ '( erc-control-default-fg erc-control-default-bg
+ fg:erc-color-face0 bg:erc-color-face0))))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
(defvar erc-goodies-tests--motd
;; This is from ergo's MOTD
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 53b11104384..6b455a30b41 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2244,6 +2244,58 @@
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--restore-important-text-props ()
+ (erc-mode)
+ (let ((erc--msg-props (map-into '((erc--important-prop-names a))
+ 'hash-table)))
+ (insert (propertize "foo" 'a 'A 'b 'B 'erc--important-props '(a A))
+ " "
+ (propertize "bar" 'c 'C 'a 'A 'b 'B
+ 'erc--important-props '(a A c C)))
+
+ ;; Attempt to restore a and c when only a is registered.
+ (remove-list-of-text-properties (point-min) (point-max) '(a c))
+ (erc--restore-important-text-props '(a c))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar"
+ 0 3 (a A b B erc--important-props (a A))
+ 4 7 (a A b B erc--important-props (a A c C)))))
+
+ ;; Add d between 3 and 6.
+ (erc--reserve-important-text-props 3 6 '(d D))
+ (put-text-property 3 6 'd 'D)
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar" ; #1
+ 0 2 (a A b B erc--important-props (a A))
+ 2 3 (d D a A b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D a A b B erc--important-props (d D a A c C))
+ 5 7 (a A b B erc--important-props (a A c C)))))
+ ;; Remove a and d, and attempt to restore d.
+ (remove-list-of-text-properties (point-min) (point-max) '(a d))
+ (erc--restore-important-text-props '(d))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar"
+ 0 2 (b B erc--important-props (a A))
+ 2 3 (d D b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D b B erc--important-props (d D a A c C))
+ 5 7 (b B erc--important-props (a A c C)))))
+
+ ;; Restore a only.
+ (erc--restore-important-text-props '(a))
+ (should (erc-tests-common-equal-with-props
+ (buffer-string)
+ #("foo bar" ; same as #1 above
+ 0 2 (a A b B erc--important-props (a A))
+ 2 3 (d D a A b B erc--important-props (d D a A))
+ 3 4 (d D erc--important-props (d D))
+ 4 5 (d D a A b B erc--important-props (d D a A c C))
+ 5 7 (a A b B erc--important-props (a A c C)))))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 8af7e902109..ad3b2071254 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -833,4 +833,9 @@ comparing the subr with a much slower Lisp implementation."
(should-error (defalias 'data-tests--da-c 'data-tests--da-d)
:type 'cyclic-function-indirection))
+(ert-deftest data-tests-bare-symbol ()
+ (dolist (symbols-with-pos-enabled '(nil t))
+ (dolist (sym (list nil t 'xyzzy (make-symbol "")))
+ (should (eq sym (bare-symbol (position-symbol sym 0)))))))
+
;;; data-tests.el ends here