ui.commands: adding update-command-map

diff --git a/basis/ui/commands/commands-docs.factor b/basis/ui/commands/commands-docs.factor
index f306b05a003f703dce4d5047f436196adfc669cf..e6d5abbf41fad549a184bd634710d7a4b0802f10 100644 (file)
--- a/basis/ui/commands/commands-docs.factor
+++ b/basis/ui/commands/commands-docs.factor
@@ -59,6 +59,11 @@ HELP: define-command-map
 }
 { $notes "Only one of " { $link define-command-map } " and " { $link set-gestures } " can be used on a given gadget class, since each word will overwrite the other word's definitions." } ;
 
+HELP: update-command-map
+{ $values { "class" "a class word" } { "group" string } { "pairs" "a sequence of gesture/word pairs" } }
+{ $description
+    "Updates a command map on the specified gadget class. The gestures specified in " { $snippet "pairs" } " are added. If any of the gestures are already defined in that " { $snippet "group" } ", they are replaced." } ;
+
 HELP: $command-map
 { $values { "element" "a pair " { $snippet "{ class map }" } } }
 { $description "Prints a command map, where the first element of the pair is a class word and the second is a command map name." } ;

diff --git a/basis/ui/commands/commands.factor b/basis/ui/commands/commands.factor
index 0f9c672ec688e190fcd3e20391ecff0615d12746..a95d0790a720ed099524ac9dcab86e4852493380 100644 (file)
--- a/basis/ui/commands/commands.factor
+++ b/basis/ui/commands/commands.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See https://factorcode.org/license.txt for BSD license.
-USING: accessors assocs help.markup kernel make quotations
-sequences splitting tr ui.gestures unicode words ;
+USING: accessors assocs combinators help.markup kernel make
+quotations sequences splitting tr ui.gestures unicode words ;
 IN: ui.commands
 
 SYMBOL: +nullary+
@@ -82,6 +82,14 @@ TR: convert-command-name "-" " " ;
     swap pick commands set-at
     update-gestures ;
 
+: update-command-map ( class group pairs -- )
+    pick {
+        [ commands ]
+        [ of ]
+        [ '[ _ assoc-union ] change-commands drop ]
+        [ update-gestures ]
+    } spread ;
+
 M: word command-name
     name>>
     "com-" ?head drop "." ?tail drop