1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
package UR::Object::View::Default::Gtk;
use strict;
use warnings;
require UR;
our $VERSION = "0.47"; # UR $VERSION;
UR::Object::Type->define(
class_name => __PACKAGE__,
is => 'UR::Object::View',
has_constant => [
perspective => { value => 'default' },
toolkit => { value => 'gtk' },
]
);
sub _create_widget {
my $self = shift;
my $label = Gtk::Label->new("<new>");
return $label;
}
sub _update_view_from_subject {
my $self = shift;
my @changes = @_; # this is not currently resolved and passed-in
my $subject = $self->subject();
my @aspects = $self->aspects;
my $widget = $self->widget();
my $text = $self->subject_class_name;
$text .= " with id " . $subject->id if $subject;
# Don't recurse back into something we're already in the process of showing
if ($self->_subject_is_used_in_an_encompassing_view()) {
$text .= " (REUSED ADDR)\n";
} else {
$text .= "\n";
my @sorted_aspects = map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->position, $_ ] }
@aspects;
for my $aspect (@sorted_aspects) {
my $label = $aspect->label;
$text .= "\n" . $label . ": ";
if ($subject) {
my @value = $subject->$label;
$text .= join(", ", @value);
}
else {
$text .= "-";
}
}
}
$widget->set_text($text);
return 1;
}
sub _update_subject_from_view {
Carp::confess("This widget shouldn't be able to write to the object, it's a label? How did I get called?");
}
sub _add_aspect {
shift->_update_view_from_subject;
}
sub _remove_aspect {
shift->_update_view_from_subject;
}
1;
=pod
=head1 NAME
UR::Object::View::Default::Gtk - Gtk adaptor for object views
=head1 DESCRIPTION
This class provides code that implements a basic Gtk renderer for UR objects.
=head1 SEE ALSO
UR::Object::View, UR::Object
=cut
|
