[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/icomplete-lazy-highlight-attempt-2 704855a 3/4: Merge branch 'ma
|
From: |
João Távora |
|
Subject: |
scratch/icomplete-lazy-highlight-attempt-2 704855a 3/4: Merge branch 'master' into scratch/icomplete-lazy-highlight-attempt-2 |
|
Date: |
Mon, 16 Aug 2021 05:57:01 -0400 (EDT) |
branch: scratch/icomplete-lazy-highlight-attempt-2
commit 704855af17a307077243572a41a9df9343b04ced
Merge: 4fa1935 ab23fa4
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>
Merge branch 'master' into scratch/icomplete-lazy-highlight-attempt-2
---
doc/lispref/modes.texi | 10 ++++-
doc/lispref/sequences.texi | 17 ++++++++
etc/NEWS | 35 ++++++++++++----
lisp/cus-theme.el | 2 +-
lisp/emacs-lisp/easymenu.el | 14 +++----
lisp/emacs-lisp/lisp-mnt.el | 18 +++-----
lisp/emacs-lisp/map.el | 60 ++++++++++++++++----------
lisp/emacs-lisp/memory-report.el | 5 +--
lisp/emacs-lisp/seq.el | 8 ++++
lisp/emacs-lisp/shortdoc.el | 11 ++---
lisp/emacs-lisp/subr-x.el | 1 +
lisp/font-lock.el | 14 ++++++-
lisp/mail/mail-extr.el | 5 ++-
lisp/mail/mail-parse.el | 39 +++++++++++++++++
lisp/minibuffer.el | 54 ++++++++++++++----------
lisp/progmodes/cc-engine.el | 62 ++++++++++++++++++---------
lisp/progmodes/python.el | 3 +-
lisp/simple.el | 29 +++++++++----
lisp/vc/diff-mode.el | 10 ++---
lisp/vc/vc-git.el | 65 ++++++++++++++++-------------
src/alloc.c | 4 +-
src/w32.c | 9 +++-
src/xdisp.c | 17 +++++---
test/lisp/autorevert-tests.el | 2 +-
test/lisp/emacs-lisp/map-tests.el | 24 +++++++----
test/lisp/emacs-lisp/memory-report-tests.el | 16 +++++++
test/lisp/emacs-lisp/seq-tests.el | 24 +++++++++++
test/lisp/mail/mail-parse-tests.el | 54 ++++++++++++++++++++++++
test/lisp/net/netrc-resources/netrc-folding | 6 +++
test/lisp/net/netrc-tests.el | 7 ++++
test/lisp/vc/diff-mode-tests.el | 12 ++++++
31 files changed, 470 insertions(+), 167 deletions(-)
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index d48c9cc..4274810 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -3444,9 +3444,17 @@ for string constants.
@item font-lock-doc-face
@vindex font-lock-doc-face
-for documentation strings in the code. This inherits, by default, from
+for documentation embedded in program code inside specially-formed
+comments or strings. This face inherits, by default, from
@code{font-lock-string-face}.
+@item font-lock-doc-markup-face
+@vindex font-lock-doc-markup-face
+for mark-up elements in text using @code{font-lock-doc-face}.
+It is typically used for the mark-up constructs in documentation embedded
+in program code, following conventions such as Haddock, Javadoc or Doxygen.
+This face inherits, by default, from @code{font-lock-constant-face}.
+
@item font-lock-negation-char-face
@vindex font-lock-negation-char-face
for easily-overlooked negation characters.
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 545fd40..20816ce 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1111,6 +1111,23 @@ The @code{pcase} patterns provide an alternative
facility for
destructuring binding, see @ref{Destructuring with pcase Patterns}.
@end defmac
+@defmac seq-setq var-sequence val-sequence
+@cindex sequence destructuring
+ This macro works similarly to @code{seq-let}, except that values are
+assigned to variables as if by @code{setq} instead of as in a
+@code{let} binding.
+
+@example
+@group
+(let ((a nil)
+ (b nil))
+ (seq-setq (_ a _ b) '(1 2 3 4))
+ (list a b))
+@result{} (2 4)
+@end group
+@end example
+@end defmac
+
@defun seq-random-elt sequence
This function returns an element of @var{sequence} taken at random.
diff --git a/etc/NEWS b/etc/NEWS
index b40c2bd..09ace73 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -149,6 +149,15 @@ invoked with the '--declarations' command-line option.
** New command 'font-lock-update', bound to 'C-x x f'.
This command updates the syntax highlighting in this buffer.
++++
+** A new standard face 'font-lock-doc-markup-face'.
+Intended for documentation mark-up syntax and tags inside text that
+uses 'font-lock-doc-face', with which it should harmonise. It would
+typically be used in structured documentation comments in program
+source code by language-specific modes, for mark-up conventions like
+Haddock, Javadoc or Doxygen. By default this face inherits from
+'font-lock-constant-face'.
+
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+++
@@ -952,12 +961,6 @@ keys, add the following to your init file:
** Change Logs and VC
-*** vc-git now sets the 'GIT_LITERAL_PATHSPECS' environment variable.
-This ensures that Git operations on files containing wildcard
-characters work as they're supposed to. However, this also affects
-scripts running from Git hooks, and these have to "unset
-GIT_LITERAL_PATHSPECS" to work as before.
-
*** More VC commands can be used from non-file buffers.
The relevant commands are those that don't change the VC state.
The non-file buffers which can use VC commands are those that have
@@ -1627,6 +1630,14 @@ This is a slightly deeper copy than the previous
'copy-sequence'.
---
*** The function 'map-contains-key' now supports plists.
+---
+*** More consistent duplicate key handling in 'map-merge-with'.
+Until now, 'map-merge-with' promised to call its function argument
+whenever multiple maps contained 'eql' keys. However, this did not
+always coincide with the keys that were actually merged, which could
+be 'equal' instead. The function argument is now called whenever keys
+are merged, for greater consistency with 'map-merge' and 'map-elt'.
+
** Package
---
@@ -2341,7 +2352,8 @@ a list.
---
*** New face 'diff-changed-unspecified'.
-This is used when 'diff-use-changed-face' is non-nil.
+This is used to highlight "changed" lines (those marked with '!') in
+context diffs, when 'diff-use-changed-face' is non-nil.
---
*** New 'diff-mode' font locking face 'diff-error'.
@@ -2426,6 +2438,15 @@ images are marked.
** Miscellaneous
---
+*** New function 'mail-header-parse-addresses-lax'.
+This takes a comma-separated string and returns a list of mail/name
+pairs.
+
+---
+*** New function 'mail-header-parse-address-lax'.
+Parse a string as a mail address-like string.
+
+---
*** 'shell-script-mode' now supports 'outline-minor-mode'.
The outline headings have lines that start with "###".
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index f4885d0..7457d9e 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -66,7 +66,7 @@ Do not call this mode function yourself. It is meant for
internal use."
shadow secondary-selection trailing-whitespace
font-lock-builtin-face font-lock-comment-delimiter-face
font-lock-comment-face font-lock-constant-face
- font-lock-doc-face font-lock-function-name-face
+ font-lock-doc-face font-lock-doc-markup-face font-lock-function-name-face
font-lock-keyword-face font-lock-negation-char-face
font-lock-preprocessor-face font-lock-regexp-grouping-backslash
font-lock-regexp-grouping-construct font-lock-string-face
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index f666154..360e685 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -175,16 +175,14 @@ This is expected to be bound to a mouse event."
(set symbol keymap)
(defalias symbol
(lambda (event) (:documentation doc) (interactive "@e")
- ;; FIXME: XEmacs uses popup-menu which calls the binding
- ;; while x-popup-menu only returns the selection.
(x-popup-menu event
- (or (and (symbolp symbol)
+ (or (and (symbolp keymap)
(funcall
- (or (plist-get (get symbol 'menu-prop)
+ (or (plist-get (get keymap 'menu-prop)
:filter)
#'identity)
- (symbol-function symbol)))
- symbol))))
+ (symbol-function keymap)))
+ keymap))))
;; These symbols are commands, but not interesting for users
;; to `M-x TAB'.
(function-put symbol 'completion-predicate #'ignore))
@@ -257,7 +255,7 @@ possibly preceded by keyword pairs as described in
`easy-menu-define'."
;; anyway, so we'd better not convert it at all (it will
;; be converted on the fly by easy-menu-filter-return).
menu-items
- (append menu (mapcar 'easy-menu-convert-item menu-items))))
+ (append menu (mapcar #'easy-menu-convert-item menu-items))))
(when prop
(setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop))
@@ -667,7 +665,7 @@ In some cases we use that to select between the local and
global maps."
(let* ((name (if path (format "%s" (car (reverse path)))))
(newmap (make-sparse-keymap name)))
(define-key (or map (current-local-map))
- (apply 'vector (mapcar 'easy-menu-intern path))
+ (apply #'vector (mapcar #'easy-menu-intern path))
(if name (cons name newmap) newmap))
newmap))))
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 4d1b42e..df14a5c 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -111,6 +111,8 @@
;;; Code:
+(require 'mail-parse)
+
;;; Variables:
(defgroup lisp-mnt nil
@@ -359,19 +361,9 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ...
\"YEARN\")"
(defun lm-crack-address (x)
"Split up email address(es) X into full name and real email address.
The value is a list of elements of the form (FULLNAME . ADDRESS)."
- (cond ((string-match
- (concat "[,\s\t]*\\(?:"
- "\\(.+?\\) +[(<]\\(\\S-+@\\S-+\\)[>)]"
- "\\|"
- "\\(?2:\\S-+@\\S-+\\) +[(<]\\(?1:[^,]*\\)[>)]"
- "\\|"
- "\\(?2:\\S-+@\\S-+\\)"
- "\\)")
- x)
- `((,(string-trim-right (match-string 1 x)) . ,(match-string 2 x))
- . ,(lm-crack-address (substring x (match-end 0)))))
- ((string-match "\\`[,\s\t]*\\'" x) nil)
- (t `((,x)))))
+ (mapcar (lambda (elem)
+ (cons (cdr elem) (car elem)))
+ (mail-header-parse-addresses-lax x)))
(defun lm-authors (&optional file)
"Return the author list of file FILE, or current buffer if FILE is nil.
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index c593428..988a62a 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, lisp
-;; Version: 3.0
+;; Version: 3.1
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -371,37 +371,51 @@ The default implementation delegates to `map-do'."
map)
t))
+(defun map--merge (merge type &rest maps)
+ "Merge into a map of TYPE all the key/value pairs in MAPS.
+MERGE is a function that takes the target MAP, a KEY, and a
+VALUE, merges KEY and VALUE into MAP, and returns the result.
+MAP may be of a type other than TYPE."
+ ;; Use a hash table internally if `type' is a list. This avoids
+ ;; both quadratic lookup behavior and the type ambiguity of nil.
+ (let* ((tolist (memq type '(list alist plist)))
+ (result (map-into (pop maps)
+ ;; Use same testfn as `map-elt' gv setter.
+ (cond ((eq type 'plist) '(hash-table :test eq))
+ (tolist '(hash-table :test equal))
+ (type)))))
+ (dolist (map maps)
+ (map-do (lambda (key value)
+ (setq result (funcall merge result key value)))
+ map))
+ ;; Convert internal representation to desired type.
+ (if tolist (map-into result type) result)))
+
(defun map-merge (type &rest maps)
"Merge into a map of TYPE all the key/value pairs in MAPS.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type)))
- (while maps
- ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
- ;; For small tables, this is fine, but for large tables, we
- ;; should probably use a hash-table internally which we convert
- ;; to an alist in the end.
- (map-do (lambda (key value)
- (setf (map-elt result key) value))
- (pop maps)))
- result))
+ (apply #'map--merge
+ (lambda (result key value)
+ (setf (map-elt result key) value)
+ result)
+ type maps))
(defun map-merge-with (type function &rest maps)
"Merge into a map of TYPE all the key/value pairs in MAPS.
-When two maps contain the same (`eql') key, call FUNCTION on the two
+When two maps contain the same key, call FUNCTION on the two
values and use the value returned by it.
Each of MAPS can be an alist, plist, hash-table, or array.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type))
- (not-found (list nil)))
- (while maps
- (map-do (lambda (key value)
- (cl-callf (lambda (old)
- (if (eql old not-found)
- value
- (funcall function old value)))
- (map-elt result key not-found)))
- (pop maps)))
- result))
+ (let ((not-found (list nil)))
+ (apply #'map--merge
+ (lambda (result key value)
+ (cl-callf (lambda (old)
+ (if (eql old not-found)
+ value
+ (funcall function old value)))
+ (map-elt result key not-found))
+ result)
+ type maps)))
(cl-defgeneric map-into (map type)
"Convert MAP into a map of TYPE.")
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 1125dde..aee2a00 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -230,8 +230,7 @@ by counted more than once."
(let ((total (+ (memory-report--size 'vector)
(* (memory-report--size 'object) (length value)))))
(cl-loop for elem across value
- do (setf (gethash elem counted) t)
- (cl-incf total (memory-report--object-size counted elem)))
+ do (cl-incf total (memory-report--object-size counted elem)))
total))
(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
@@ -239,8 +238,6 @@ by counted more than once."
(* (memory-report--size 'object) (hash-table-size value)))))
(maphash
(lambda (key elem)
- (setf (gethash key counted) t)
- (setf (gethash elem counted) t)
(cl-incf total (memory-report--object-size counted key))
(cl-incf total (memory-report--object-size counted elem)))
value)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index e8fc4a2..f0dc283 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -93,6 +93,14 @@ name to be bound to the rest of SEQUENCE."
(declare (indent 2) (debug (sexp form body)))
`(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
,@body))
+
+(defmacro seq-setq (args sequence)
+ "Assign to the variables in ARGS the elements of SEQUENCE.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQUENCE."
+ (declare (debug (sexp form)))
+ `(pcase-setq ,(seq--make-pcase-patterns args) ,sequence))
;;; Basic seq functions that have to be implemented by new sequence types
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index a74a5a4..1b0fbfd 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1317,7 +1317,8 @@ Example:
"Keymap for `shortdoc-mode'.")
(define-derived-mode shortdoc-mode special-mode "shortdoc"
- "Mode for shortdoc.")
+ "Mode for shortdoc."
+ :interactive nil)
(defun shortdoc--goto-section (arg sym &optional reverse)
(unless (natnump arg)
@@ -1332,26 +1333,26 @@ Example:
(defun shortdoc-next (&optional arg)
"Move cursor to the next function.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function))
(defun shortdoc-previous (&optional arg)
"Move cursor to the previous function.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function t)
(backward-char 1))
(defun shortdoc-next-section (&optional arg)
"Move cursor to the next section.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section))
(defun shortdoc-previous-section (&optional arg)
"Move cursor to the previous section.
With ARG, do it that many times."
- (interactive "p")
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section t)
(forward-line -2))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 468d124..4204d20 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -240,6 +240,7 @@ carriage return."
(substring string 0 (- (length string) (length suffix)))
string))
+;;;###autoload
(defun string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 4dc42d9..c00a62a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -312,6 +312,9 @@ If a number, only buffers greater than this size have
fontification messages."
(defvar font-lock-doc-face 'font-lock-doc-face
"Face name to use for documentation.")
+(defvar font-lock-doc-markup-face 'font-lock-doc-markup-face
+ "Face name to use for documentation mark-up.")
+
(defvar font-lock-keyword-face 'font-lock-keyword-face
"Face name to use for keywords.")
@@ -2003,7 +2006,16 @@ Sets various variables using `font-lock-defaults' and
(defface font-lock-doc-face
'((t :inherit font-lock-string-face))
- "Font Lock mode face used to highlight documentation."
+ "Font Lock mode face used to highlight documentation embedded in program
code.
+It is typically used for special documentation comments or strings."
+ :group 'font-lock-faces)
+
+(defface font-lock-doc-markup-face
+ '((t :inherit font-lock-constant-face))
+ "Font Lock mode face used to highlight embedded documentation mark-up.
+It is meant for mark-up elements in text that uses `font-lock-doc-face', such
+as the constructs of Haddock, Javadoc and similar systems."
+ :version "28.1"
:group 'font-lock-faces)
(defface font-lock-keyword-face
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 88fb086..24d8311 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -707,7 +707,10 @@ This function is primarily meant for when you're
displaying the
result to the user: Many prettifications are applied to the
result returned. If you want to decode an address for further
non-display use, you should probably use
-`mail-header-parse-address' instead."
+`mail-header-parse-address' instead. Also see
+`mail-header-parse-address-lax' for a function that's less strict
+than `mail-header-parse-address', but does less post-processing
+to the results."
(let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
(extraction-buffer (get-buffer-create " *extract address components*"))
value-list)
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index e72ed82..212fadf 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -71,6 +71,45 @@
(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
+(defun mail-header-parse-addresses-lax (string)
+ "Parse STRING as a comma-separated list of mail addresses.
+The return value is a list with mail/name pairs."
+ (delq nil
+ (mapcar (lambda (elem)
+ (or (mail-header-parse-address elem)
+ (mail-header-parse-address-lax elem)))
+ (mail-header-parse-addresses string t))))
+
+(defun mail-header-parse-address-lax (string)
+ "Parse STRING as a mail address.
+Returns a mail/name pair.
+
+This function will first try to parse STRING as a
+standards-compliant address string, and if that fails, try to use
+heuristics to determine the email address and the name in the
+string."
+ (with-temp-buffer
+ (insert (string-clean-whitespace string))
+ ;; Find the bit with the @ and guess that that's the mail.
+ (goto-char (point-max))
+ (when (search-backward "@" nil t)
+ (if (re-search-backward " " nil t)
+ (forward-char 1)
+ (goto-char (point-min)))
+ (let* ((start (point))
+ (mail (buffer-substring
+ start (or (re-search-forward " " nil t)
+ (goto-char (point-max))))))
+ (delete-region start (point))
+ ;; We've now removed the email bit, so the rest of the stuff
+ ;; has to be the name.
+ (cons (string-trim mail "[<]+" "[>]+")
+ (let ((name (string-trim (buffer-string)
+ "[ \t\n\r(]+" "[ \t\n\r)]+")))
+ (if (length= name 0)
+ nil
+ name)))))))
+
(provide 'mail-parse)
;;; mail-parse.el ends here
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0843f94..5ca5e8d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4000,27 +4000,39 @@ that is non-nil."
((compose-flex-sort-fn
(existing-sort-fn) ; wish `cl-flet' had proper indentation...
(lambda (completions)
- (let ((pre-sorted
- (if existing-sort-fn
- (funcall existing-sort-fn completions)
- completions)))
- (cond
- ((or (not (window-minibuffer-p))
- ;; JT@2019-12-23: FIXME: this is still wrong. What
- ;; we need to test here is "some input that actually
- ;; leads to flex filtering", not "something after
- ;; the minibuffer prompt". Among other
- ;; inconsistencies, the latter is always true for
- ;; file searches, meaning the next clauses will be
- ;; ignored.
- (> (point-max) (minibuffer-prompt-end)))
- (sort
- pre-sorted
- (lambda (c1 c2)
- (let ((s1 (get-text-property 0 'completion-score c1))
- (s2 (get-text-property 0 'completion-score c2)))
- (> (or s1 0) (or s2 0))))))
- (t pre-sorted))))))
+ (cond
+ (;; Sort by flex score whenever outside the minibuffer or
+ ;; in the minibuffer with some input. JT@2019-12-23:
+ ;; FIXME: this is still wrong. What we need to test here
+ ;; is "some input that actually leads to flex filtering",
+ ;; not "something after the minibuffer prompt". Among
+ ;; other inconsistencies, the latter is always true for
+ ;; file searches, meaning the next clauses in this cond
+ ;; will be ignored.
+ (or (not (window-minibuffer-p))
+ (> (point-max) (minibuffer-prompt-end)))
+ (sort
+ (if existing-sort-fn
+ (funcall existing-sort-fn completions)
+ completions)
+ (lambda (c1 c2)
+ (let ((s1 (get-text-property 0 'completion-score c1))
+ (s2 (get-text-property 0 'completion-score c2)))
+ (> (or s1 0) (or s2 0))))))
+ (;; If no existing sort fn and nothing flexy happening, use
+ ;; the customary sorting strategy.
+ ;;
+ ;; JT@2021-08-15: FIXME: ideally this wouldn't repeat
+ ;; logic in `completion-all-sorted-completions', but that
+ ;; logic has other context that is either expensive to
+ ;; compute or not easy to access here.
+ (not existing-sort-fn)
+ (let ((lalpha (minibuffer--sort-by-length-alpha completions))
+ (hist (and (minibufferp)
+ (and (not (eq minibuffer-history-variable t))
+ (symbol-value
minibuffer-history-variable)))))
+ (if hist (minibuffer--sort-by-position hist lalpha) lalpha)))
+ (t (funcall existing-sort-fn completions))))))
`(metadata
(display-sort-function
. ,(compose-flex-sort-fn
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 4222dbe..7f7175f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -7393,29 +7393,51 @@ multi-line strings (but not C++, for example)."
(save-excursion
(goto-char beg)
(when open-delim
+ ;; If BEG is in an opener, move back to a position we know to be "safe".
(if (<= beg (cadr open-delim))
(goto-char (cadr open-delim))
(c-ml-string-back-to-neutral (car open-delim))))
- (or (and c-ml-string-back-closer-re
- (looking-at c-ml-string-any-closer-re)
- (eq (c-in-literal) 'string)
- (goto-char (match-end 0)))
- (progn
- (while
- (and
- (search-forward-regexp
- c-ml-string-any-closer-re
- (min (+ end c-ml-string-max-closer-len-no-leader) (point-max))
- t)
- (save-excursion
- (goto-char (match-end 1))
- (not (c-in-literal)))
- (<= (point) beg)
- (not (save-excursion
- (goto-char (match-beginning 2))
- (c-literal-start)))))))
-
- (unless (or (and (not (eobp))
+
+ (let (saved-match-data)
+ (or
+ ;; If we might be in the middle of "context" bytes at the start of a
+ ;; closer, move to after the closer.
+ (and c-ml-string-back-closer-re
+ (looking-at c-ml-string-any-closer-re)
+ (eq (c-in-literal) 'string)
+ (setq saved-match-data (match-data))
+ (goto-char (match-end 0)))
+
+ ;; Otherwise, move forward over closers while we haven't yet reached
END,
+ ;; until we're after BEG.
+ (progn
+ (while
+ (let (found)
+ (while ; Go over a single real closer.
+ (and
+ (search-forward-regexp
+ c-ml-string-any-closer-re
+ (min (+ end c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ t)
+ (save-excursion
+ (goto-char (match-end 1))
+ (if (c-in-literal) ; a psuedo closer.
+ t
+ (setq saved-match-data (match-data))
+ (setq found t)
+ nil))))
+ (and found
+ (<= (point) beg))
+ ;; (not (save-excursion
+ ;; (goto-char (match-beginning 2))
+ ;; (c-literal-start)))
+ ))))
+ (set-match-data saved-match-data))
+
+ ;; Test whether we've found the sought closing delimiter.
+ (unless (or (null (match-data))
+ (and (not (eobp))
(<= (point) beg))
(> (match-beginning 0) beg)
(progn (goto-char (match-beginning 2))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2557704..20299c2 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3085,7 +3085,8 @@ t when called interactively."
(list (read-string "Python command: ") nil t))
(let ((process (or process (python-shell-get-process-or-error msg))))
(if (string-match ".\n+." string) ;Multiline.
- (let* ((temp-file-name (python-shell--save-temp-file string))
+ (let* ((temp-file-name (with-current-buffer (process-buffer process)
+ (python-shell--save-temp-file string)))
(file-name (or (buffer-file-name) temp-file-name)))
(python-shell-send-file file-name process temp-file-name t))
(comint-send-string process string)
diff --git a/lisp/simple.el b/lisp/simple.el
index 985beb0..1661346 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2194,6 +2194,8 @@ Also see `suggest-key-bindings'."
(setq binding candidate))))
binding))
+(defvar execute-extended-command--binding-timer nil)
+
(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
@@ -2258,15 +2260,24 @@ invoking, give a prefix argument to
`execute-extended-command'."
(setq binding (execute-extended-command--shorter
(symbol-name function) typed))))
(when binding
- (with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
- (sit-for (if (numberp suggest-key-bindings)
- suggest-key-bindings
- 2))))))))
+ ;; This is normally not necessary -- the timer should run
+ ;; immediately, but be defensive and ensure that we never
+ ;; have two of these timers in flight.
+ (when execute-extended-command--binding-timer
+ (cancel-timer execute-extended-command--binding-timer))
+ (setq execute-extended-command--binding-timer
+ (run-at-time
+ 0 nil
+ (lambda ()
+ (with-temp-message
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2)))))))))))
(defun execute-extended-command-for-buffer (prefixarg &optional
command-name typed)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index bb1c46c..eeb32f8 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -969,11 +969,11 @@ If the OLD prefix arg is passed, tell the file NAME of
the old file."
(list (match-string 1)))
header-files
;; this assumes that there are no spaces in filenames
- (when (re-search-backward
- "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?"
- nil t)
- (list (if old (match-string 2) (match-string 4))
- (if old (match-string 4) (match-string 2)))))))))
+ (and (re-search-backward "^diff " nil t)
+ (looking-at
+ "^diff \\(-[^ \t\nL]+ +\\)*\\(-L +\\S-+ +\\)*\\(\\S-+\\)\\(
+\\(\\S-+\\)\\)?")
+ (list (if old (match-string 3) (match-string 5))
+ (if old (match-string 4) (match-string 3)))))))))
(defun diff-find-file-name (&optional old noprompt prefix)
"Return the file corresponding to the current patch.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 1430871..ffe1e68 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -242,6 +242,15 @@ included in the completions."
;;;###autoload (load "vc-git" nil t)
;;;###autoload (vc-git-registered file))))
+(defun vc-git--literal-pathspec (pathspec)
+ "Prepend :(literal) path magic to PATHSPEC."
+ ;; Good example of PATHSPEC that needs this: "test[56].xx".
+ (and pathspec (concat ":(literal)" pathspec)))
+
+(defun vc-git--literal-pathspecs (pathspecs)
+ "Prepend :(literal) path magic to PATHSPECS."
+ (mapcar #'vc-git--literal-pathspec pathspecs))
+
(defun vc-git-registered (file)
"Check whether FILE is registered with git."
(let ((dir (vc-git-root file)))
@@ -255,12 +264,12 @@ included in the completions."
(name (file-relative-name file dir))
(str (with-demoted-errors "Error: %S"
(cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--"
(vc-git--literal-pathspec name))
;; If result is empty, use ls-tree to check for deleted
;; file.
(when (eq (point-min) (point-max))
(vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
+ "--" (vc-git--literal-pathspec name)))
(buffer-string))))
(and str
(> (length str) (length name))
@@ -342,7 +351,7 @@ in the order given by `git status'."
,@(when (version<= "1.7.6.3" (vc-git--program-version))
'("--ignored"))
"--"))
- (status (apply #'vc-git--run-command-string file args)))
+ (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec
file) args)))
(if (null status)
;; If status is nil, there was an error calling git, likely because
;; the file is not in a git repo.
@@ -620,28 +629,28 @@ or an empty string if none."
(pcase (vc-git-dir-status-state->stage git-state)
('update-index
(if files
- (vc-git-command (current-buffer) 'async files "add" "--refresh"
"--")
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files) "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
('ls-files-added
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-up-to-date
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-conflict
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-u" "--"))
('ls-files-unknown
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "--exclude-standard" "--"))
('ls-files-ignored
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
('diff-index
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs
files)
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed
(vc-git-after-dir-status-stage git-state))))
@@ -867,14 +876,14 @@ The car of the list is the current branch."
(push crt dlist)
(push crt flist)))
(when flist
- (vc-git-command nil 0 flist "update-index" "--add" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs flist) "update-index"
"--add" "--"))
(when dlist
- (vc-git-command nil 0 dlist "add"))))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add"))))
(defalias 'vc-git-responsible-p #'vc-git-root)
(defun vc-git-unregister (file)
- (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached"
"--"))
(declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-toggle-header "log-edit" (header value))
@@ -941,7 +950,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge.
- (apply #'vc-git-command nil 0 (if only files)
+ (apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files))
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
@@ -968,7 +977,7 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(coding-system-for-write 'binary)
(fullname
(let ((fn (vc-git--run-command-string
- file "ls-files" "-z" "--full-name" "--")))
+ (vc-git--literal-pathspec file) "ls-files" "-z"
"--full-name" "--")))
;; ls-files does not return anything when looking for a
;; revision of a file that has been renamed or removed.
(if (string= fn "")
@@ -985,14 +994,14 @@ It is based on `log-edit-mode', and has Git-specific
extensions.")
(vc-git-root file)))
(defun vc-git-checkout (file &optional rev)
- (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev
"HEAD")))
(defun vc-git-revert (file &optional contents-done)
"Revert FILE to the version stored in the git repository."
(if contents-done
(vc-git-command nil 0 file "update-index" "--")
- (vc-git-command nil 0 file "reset" "-q" "--")
- (vc-git-command nil nil file "checkout" "-q" "--")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--")
+ (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q"
"--")))
(defvar vc-git-error-regexp-alist
'(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@@ -1076,7 +1085,7 @@ This prompts for a branch to merge from."
(defun vc-git-conflicted-files (directory)
"Return the list of files with conflicts in DIRECTORY."
(let* ((status
- (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (vc-git--run-command-string (vc-git--literal-pathspec directory)
"status" "--porcelain" "--"))
(lines (when status (split-string status "\n" 'omit-nulls)))
files)
(dolist (line lines files)
@@ -1157,7 +1166,7 @@ If LIMIT is a revision string, use it as an end-revision."
(let ((inhibit-read-only t))
(with-current-buffer buffer
(apply #'vc-git-command buffer
- 'async files
+ 'async (vc-git--literal-pathspecs files)
(append
'("log" "--no-color")
(when (and vc-git-print-log-follow
@@ -1408,7 +1417,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(if vc-git-diff-switches
(apply #'vc-git-command (or buffer "*vc-diff*")
1 ; bug#21969
- files
+ (vc-git--literal-pathspecs files)
command
"--exit-code"
(append (vc-switches 'git 'diff)
@@ -1493,7 +1502,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(let* ((fname (file-relative-name file))
(prev-rev (with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-2" rev "--" fname)
+ (vc-git--out-ok "rev-list" "-2" rev "--"
(vc-git--literal-pathspec fname))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1521,7 +1530,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-1" rev "--" file)
+ (vc-git--out-ok "rev-list" "-1" rev "--"
(vc-git--literal-pathspec file))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1533,7 +1542,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(and current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "HEAD" "--" file)
+ (vc-git--out-ok "rev-list" "HEAD" "--"
(vc-git--literal-pathspec file))
(goto-char (point-min))
(search-forward current-rev nil t)
(zerop (forward-line -1))
@@ -1543,13 +1552,13 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(or (vc-git-symbolic-commit next-rev) next-rev)))
(defun vc-git-delete-file (file)
- (vc-git-command nil 0 file "rm" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs file) "rm" "-f" "--"))
(defun vc-git-rename-file (old new)
- (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs (list old new)) "mv" "-f"
"--"))
(defun vc-git-mark-resolved (files)
- (vc-git-command nil 0 files "add"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs files) "add"))
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
@@ -1772,7 +1781,6 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
- "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
@@ -1807,7 +1815,6 @@ The difference to vc-do-command is that this function
always invokes
(process-environment
(append
`("GIT_DIR"
- "GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
diff --git a/src/alloc.c b/src/alloc.c
index 8edcd06..4ea337d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7318,7 +7318,7 @@ Frames, windows, buffers, and subprocesses count as
vectors
make_int (strings_consed));
}
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "",
doc: /* Report malloc information to stderr.
This function outputs to stderr an XML-formatted
@@ -7678,7 +7678,7 @@ N should be nonnegative. */);
defsubr (&Sgarbage_collect_maybe);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
defsubr (&Smalloc_info);
#endif
defsubr (&Ssuspicious_object);
diff --git a/src/w32.c b/src/w32.c
index 968b4bb..0eb69d4 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2389,8 +2389,13 @@ rand_as183 (void)
int
random (void)
{
- /* rand_as183 () gives us 15 random bits...hack together 30 bits. */
+ /* rand_as183 () gives us 15 random bits...hack together 30 bits for
+ Emacs with 32-bit EMACS_INT, and at least 31 bit for wider EMACS_INT. */
+#if EMACS_INT_MAX > INT_MAX
+ return ((rand_as183 () << 30) | (rand_as183 () << 15) | rand_as183 ());
+#else
return ((rand_as183 () << 15) | rand_as183 ());
+#endif
}
void
@@ -8753,7 +8758,7 @@ int
_sys_read_ahead (int fd)
{
child_process * cp;
- int rc;
+ int rc = 0;
if (fd < 0 || fd >= MAXDESC)
return STATUS_READ_ERROR;
diff --git a/src/xdisp.c b/src/xdisp.c
index e62f7e3..972b901 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -17275,8 +17275,11 @@ run_window_scroll_functions (Lisp_Object window,
struct text_pos startp)
if (!NILP (Vwindow_scroll_functions))
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
run_hook_with_args_2 (Qwindow_scroll_functions, window,
make_fixnum (CHARPOS (startp)));
+ unbind_to (count, Qnil);
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
set_buffer_internal (XBUFFER (w->contents));
@@ -19269,7 +19272,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
w->start_at_line_beg = (CHARPOS (startp) == BEGV
|| FETCH_BYTE (BYTEPOS (startp) - 1) == '\n');
- /* Display the mode line, if we must. */
+ /* Display the mode line, header line, and tab-line, if we must. */
if ((update_mode_line
/* If window not full width, must redo its mode line
if (a) the window to its side is being redone and
@@ -19288,8 +19291,11 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
|| window_wants_header_line (w)
|| window_wants_tab_line (w)))
{
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
display_mode_lines (w);
+ unbind_to (count1, Qnil);
/* If mode line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
@@ -19337,7 +19343,7 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
finish_menu_bars:
/* When we reach a frame's selected window, redo the frame's menu
- bar and the frame's title. */
+ bar, tool bar, tab-bar, and the frame's title. */
if (update_mode_line
&& EQ (FRAME_SELECTED_WINDOW (f), window))
{
@@ -25428,8 +25434,9 @@ redisplay_mode_lines (Lisp_Object window, bool force)
}
-/* Display the mode and/or header line of window W. Value is the
- sum number of mode lines and header lines displayed. */
+/* Display the mode line, the header line, and the tab-line of window
+ W. Value is the sum number of mode lines, header lines, and tab
+ lines actually displayed. */
static int
display_mode_lines (struct window *w)
@@ -27009,7 +27016,7 @@ decode_mode_spec (struct window *w, register int c, int
field_width,
Lisp_Object val = Qnil;
if (STRINGP (curdir))
- val = call1 (intern ("file-remote-p"), curdir);
+ val = safe_call1 (intern ("file-remote-p"), curdir);
val = unbind_to (count, val);
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 449dabf..96169c7 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -286,7 +286,7 @@ This expects `auto-revert--messages' to be bound by
;; Repeated unpredictable failures, bug#32645.
;; Unlikely to be hydra-specific?
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
-
+ :tags '(:unstable)
(with-auto-revert-test
(let ((tmpfile (make-temp-file "auto-revert-test"))
;; Try to catch bug#32645.
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index a04c6be..658ed2e 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -446,16 +446,24 @@ Evaluate BODY for each created map."
(ert-deftest test-map-merge ()
"Test `map-merge'."
- (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3))
- #s(hash-table data (c 4)))
- '((c . 4) (b . 2) (a . 1)))))
+ (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
+ #s(hash-table data (c 4)))
+ (lambda (x y) (string< (car x) (car y))))
+ '((a . 1) (b . 2) (c . 4))))
+ (should (equal (map-merge 'list () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'plist () '(:a 1)) '(:a 1))))
(ert-deftest test-map-merge-with ()
- (should (equal (map-merge-with 'list #'+
- '((1 . 2))
- '((1 . 3) (2 . 4))
- '((1 . 1) (2 . 5) (3 . 0)))
- '((3 . 0) (2 . 9) (1 . 6)))))
+ (should (equal (sort (map-merge-with 'list #'+
+ '((1 . 2))
+ '((1 . 3) (2 . 4))
+ '((1 . 1) (2 . 5) (3 . 0)))
+ #'car-less-than-car)
+ '((1 . 6) (2 . 9) (3 . 0))))
+ (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1))))
(ert-deftest test-map-merge-empty ()
"Test merging of empty maps."
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el
b/test/lisp/emacs-lisp/memory-report-tests.el
index da5f4f5..0c0297b 100644
--- a/test/lisp/emacs-lisp/memory-report-tests.el
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -45,6 +45,7 @@
(should (equal (memory-report-object-size (list 'foo)) 16))
+ (should (equal (memory-report-object-size (vector 1 2 3)) 64))
(should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
(should (equal (memory-report-object-size "") 32))
@@ -52,6 +53,21 @@
(should (equal (memory-report-object-size (propertize "a" 'face 'foo))
81)))
+(ert-deftest memory-report-sizes-vectors ()
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ ["long string that should be at least 40 bytes"])
+ 108))
+ (let ((string "long string that should be at least 40 bytes"))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string))
+ 108))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string string))
+ 124))))
+
(provide 'memory-report-tests)
;;; memory-report-tests.el ends here
diff --git a/test/lisp/emacs-lisp/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 05c7fbe..44e855e 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -383,6 +383,30 @@ Evaluate BODY for each created sequence.
(should (null b))
(should (null c)))))
+(ert-deftest test-seq-setq ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (let (a b c d e)
+ (seq-setq (a b c d e) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (= c 3))
+ (should (= d 4))
+ (should (null e)))
+ (let (a b others)
+ (seq-setq (a b &rest others) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (same-contents-p others (seq-drop seq 2)))))
+ (let ((a)
+ (seq '(1 (2 (3 (4))))))
+ (seq-setq (_ (_ (_ (a)))) seq)
+ (should (= a 4)))
+ (let (seq a b c)
+ (seq-setq (a b c) seq)
+ (should (null a))
+ (should (null b))
+ (should (null c))))
+
(ert-deftest test-seq-min-max ()
(with-test-sequences (seq '(4 5 3 2 0 4))
(should (= (seq-min seq) 0))
diff --git a/test/lisp/mail/mail-parse-tests.el
b/test/lisp/mail/mail-parse-tests.el
new file mode 100644
index 0000000..70de92d
--- /dev/null
+++ b/test/lisp/mail/mail-parse-tests.el
@@ -0,0 +1,54 @@
+;;; mail-parse-tests.el --- tests for mail-parse.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; 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:
+
+;;; Code:
+
+(require 'ert)
+(require 'mail-parse)
+(require 'subr-x)
+
+(ert-deftest test-mail-header-parse-address-lax ()
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen <larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "larsi@gnus.org (Lars Ingebrigtsen)")
+ '("larsi@gnus.org " . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax "larsi@gnus.org")
+ '("larsi@gnus.org")))
+ (should (equal (mail-header-parse-address-lax "foo")
+ nil)))
+
+(ert-deftest test-mail-header-parse-addresses-lax ()
+ (should (equal (mail-header-parse-addresses-lax
+ "Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>")
+ '(("rsw@gnu.org" . "Bob Weiner")
+ ("matsl@gnu.org" . "Mats Lidell")))))
+
+(provide 'mail-parse-tests)
+
+;;; mail-parse-tests.el ends here
diff --git a/test/lisp/net/netrc-resources/netrc-folding
b/test/lisp/net/netrc-resources/netrc-folding
new file mode 100644
index 0000000..85e5e32
--- /dev/null
+++ b/test/lisp/net/netrc-resources/netrc-folding
@@ -0,0 +1,6 @@
+# Foo
+machine XM login XL password XP
+
+machine YM
+ login YL
+ password YP
diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el
index 1328b19..f75328a 100644
--- a/test/lisp/net/netrc-tests.el
+++ b/test/lisp/net/netrc-tests.el
@@ -48,6 +48,13 @@
(should (equal (netrc-credentials "ftp.example.org")
'("jrh" "*baz*")))))
+(ert-deftest test-netrc-credentials ()
+ (let ((netrc-file (ert-resource-file "netrc-folding")))
+ (should
+ (equal (netrc-parse netrc-file)
+ '((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
+ (("machine" . "YM")) (("login" . "YL")) (("password" .
"YP")))))))
+
(provide 'netrc-tests)
;;; netrc-tests.el ends here
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 5bc4ad6..5218659 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -468,4 +468,16 @@ baz"))))
(114 131 (diff-mode syntax face font-lock-string-face))
(134 140 (diff-mode syntax face
font-lock-keyword-face))))))))
+(ert-deftest test-hunk-file-names ()
+ (with-temp-buffer
+ (insert "diff -c /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))
+ (with-temp-buffer
+ (insert "diff -c -L /ftp\:slbhao\:/home/albinus/src/tramp/lisp/tramp.el -L
/ftp\:slbhao\:/home/albinus/src/emacs/lisp/net/tramp.el
/tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))))
+
(provide 'diff-mode-tests)