Add a key macro to change deprel, document it

The enanced dep is changed if it contains the old deprel to the parent, too.
choroba · May 16, 2024 · 20707d0 · 20707d0
1 parent 73adafa
commit 20707d0
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 10 deletions.
diff --git a/README.pod b/README.pod
@@ -6,8 +6,9 @@ ud - TrEd extension to display and edit Universal Dependencies
 
 =head1 DESCRIPTION
 
-Use mouse to change the tree structure. Drop a node with Ctrl to add
-or remove an enhanced dependency.
+Use mouse to change the tree structure. Drop a node with C<Ctrl> to add or
+remove an enhanced dependency. Press C<d> to edit the current node's
+C<deprel>.
 
 =head1 INSTALLATION
 

diff --git a/ud/contrib/ud/contrib.mac b/ud/contrib/ud/contrib.mac
@@ -2,6 +2,8 @@
 #ifndef ud
 #define ud
 #binding-context UD
+# bind edit_this_deprel to d menu Edit DepRel
+
 #include "ud.inc"
 #endif ud
 
diff --git a/ud/contrib/ud/ud.inc b/ud/contrib/ud/ud.inc
@@ -72,27 +72,46 @@
     }
 
 
+    sub do_edit_attr_hook {
+        my ($attr, $node) = @_;
+        return unless 'deprel' eq $attr;
+        edit_deprel($node);
+    }
+
+    sub edit_this_deprel {
+        edit_deprel($this);
+    }
+
+
     {   my @deprels = qw( acl advcl advmod amod appos aux case cc
                           ccomp clf compound conj cop csubj dep det
                           discourse dislocated expl fixed flat
                           goeswith iobj list mark nmod nsubj nummod
                           obj obl orphan parataxis punct reparandum
                           root vocative xcomp );
 
-        sub do_edit_attr_hook {
-            my ($attr, $node) = @_;
-            return unless 'deprel' eq $attr;
+        sub edit_deprel {
+            my ($node) = @_;
 
             my $dialog = $grp->toplevel->DialogBox(
                 -title   => 'Deprel',
                 -buttons => ['OK', 'Cancel']);
             my $list = $dialog->add(
                 BrowseEntry => -label    => 'deprel',
-                               -variable => \(my $choice = $node->{deprel}))->pack;
+                               -variable => \(my $choice = $node->{deprel})
+            )->pack;
             $list->insert(end => $_) for @deprels;
             my $reply = $dialog->Show;
             if ('OK' eq $reply) {
+                my $old_deprel = $node->{deprel};
                 $node->{deprel} = $choice;
+                $node->{deps} = List(map {
+                    ($_->content == $node->parent->{ord}
+                     && $_->{func} eq $old_deprel)
+                        ? _create_container($_->content, $choice)
+                        : $_
+                } ListV($node->{deps}));
+                ChangingFile(1);
                 Redraw();
             }
             return 'stop'
@@ -118,14 +137,13 @@
 
                 ChangingFile(1);
                 AddToList($node, 'deps',
-                          'Treex::PML::StandardFactory'->createContainer(
-                              $target->{ord}, {func => $func}));
+                          _create_container($target->{ord}, $func));
             }
         } else {
             return if $target == $parent;
 
-            my @deps = ('Treex::PML::StandardFactory'->createContainer(
-                              $target->{ord}, {func => $node->{deprel}}),
+            my @deps = (_create_container(
+                            $target->{ord}, $node->{deprel}),
                         grep $_->{func} ne $node->{deprel}
                              && $_->content != $parent->{ord},
                         ListV($node->{deps}));
@@ -153,4 +171,11 @@
             );
         }
     }
+
+
+    sub _create_container {
+        my ($ord, $func) = @_;
+        return 'Treex::PML::StandardFactory'->createContainer(
+            $ord, {func => $func})
+    }
 }