* lisp/emacs-lisp/map.el (map-merge-with): New function

* test/automated/map-tests.el (test-map-merge-with): New test

2 files changed, 27 insertions, 5 deletions

diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5ef51f12d96..7ff9031b08d 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -279,9 +279,9 @@ MAP can be a list, hash-table or array."
 MAP can be a list, hash-table or array."
   (catch 'map--break
     (map-apply (lambda (key value)
-                 (or (funcall pred key value)
-                     (throw 'map--break nil)))
-               map)
+              (or (funcall pred key value)
+                  (throw 'map--break nil)))
+            map)
     t))
 
 (defun map-merge (type &rest maps)
@@ -291,8 +291,23 @@ MAP can be a list, hash-table or array."
   (let (result)
     (while maps
       (map-apply (lambda (key value)
-                   (setf (map-elt result key) value))
-                 (pop maps)))
+                (setf (map-elt result key) value))
+              (pop maps)))
+    (map-into result type)))
+
+(defun map-merge-with (type function &rest maps)
+  "Merge into a map of type TYPE all the key/value pairs in MAPS.
+When two maps contain the same key, call FUNCTION on the two
+values and use the value returned by it.
+MAP can be a list, hash-table or array."
+  (let (result)
+    (while maps
+      (map-apply (lambda (key value)
+                (setf (map-elt result key)
+                      (if (map-contains-key result key)
+                          (funcall function (map-elt result key) value)
+                        value)))
+              (pop maps)))
     (map-into result type)))
 
 (defun map-into (map type)
diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el
index 8693415a784..1a759b523a5 100644
--- a/test/automated/map-tests.el
+++ b/test/automated/map-tests.el
@@ -320,5 +320,12 @@ Evaluate BODY for each created map.
     (should (= b 2))
     (should (null c))))
 
+(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)))))
+
 (provide 'map-tests)
 ;;; map-tests.el ends here