package frama-c

You can search for identifiers within the package.

in-package search v0.2.0

Platform dedicated to the analysis of source code written in C

Install

dune-project

Dependency

frama-c.com Readme Edit opam file Versions (26)

Authors

Maintainers

F

frama-ci-bot@frama-c.com

Sources

frama-c-32.0-beta-Germanium.tar.gz

sha256=868d57ef8007fe6c0836cd151d8c294003af34aa678285eff9547662cad36aa3

doc/src/frama-c.gui/wpalette.ml.html

Source file `wpalette.ml`

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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
(**************************************************************************)
(*                                                                        *)
(*  SPDX-License-Identifier LGPL-2.1                                      *)
(*  Copyright (C)                                                         *)
(*  CEA (Commissariat à l'énergie atomique et aux énergies alternatives)  *)
(*                                                                        *)
(**************************************************************************)

open Widget

class tool ?label ?tooltip ?content () =
  let status = new Widget.image `None in
  let toggle = new Widget.toggle ~align:`Left ?label ?tooltip ~border:false () in
  let action = new Widget.button ~icon:`MEDIA_PLAY ?tooltip () in
  object(self)

    initializer
      begin
        let color = `NAME "orange" in
        toggle#coerce#misc#modify_bg [ `PRELIGHT , color ; `ACTIVE , color ] ;
        toggle#connect self#toggle ;
        action#connect self#action ;
        self#toggle false ;
        action#set_border false ;
        Wutil.on content self#set_content ;
      end

    val mutable details = None
    val mutable tooltip = None
    val mutable callback = None
    val mutable view = None

    method private toggle a =
      match details with
      | None -> ()
      | Some w -> Wutil.set_visible w a

    method private action () =
      match callback with
      | None -> ()
      | Some f -> f ()

    method private render =
      let hbox = GPack.hbox ~show:true () in
      hbox#pack ~expand:false status#coerce ;
      hbox#pack ~expand:true ~fill:true ~padding:1 toggle#coerce ;
      hbox#pack ~expand:false action#coerce ;
      match details with
      | None -> hbox#coerce
      | Some w ->
        let vbox = GPack.vbox ~show:true () in
        vbox#pack ~expand:false hbox#coerce ;
        vbox#pack ~expand:true ~fill:false w#coerce ;
        vbox#coerce

    method tool = (self :> tool)

    method widget =
      match view with Some w -> w | None ->
        let w = new Wutil.gobj_widget self#render in
        view <- Some w ; w

    method coerce = self#widget#coerce
    method on_active = toggle#connect
    method is_active = toggle#get
    method set_active = toggle#set
    method has_action = callback != None
    method set_enabled e = self#widget#set_enabled e
    method set_visible v = self#widget#set_visible v

    method set_label = toggle#set_label
    method set_tooltip txt = toggle#set_tooltip txt
    method set_status = status#set_icon

    method clear_action =
      callback <- None ;
      action#set_visible false

    method set_action ?icon ?tooltip ?callback:cb () =
      begin
        callback <- cb ;
        action#set_visible true ;
        action#set_enabled (cb != None) ;
        Wutil.on icon action#set_icon ;
        Wutil.on tooltip action#set_tooltip ;
      end

    method set_content (w : widget) =
      assert ( details == None ) ;
      let frame = GBin.frame ~show:false () in
      let padds = GBin.alignment ~padding:(4,4,4,4) () in
      padds#add w#coerce ;
      frame#add padds#coerce ;
      details <- Some frame

  end

(* -------------------------------------------------------------------------- *)
(* --- Panel                                                              --- *)
(* -------------------------------------------------------------------------- *)

class panel () =
  let box = GPack.vbox ~show:true () in
  object(self)
    inherit Wutil.gobj_widget box

    val mutable lock = false
    val mutable tools = []

    method add_widget (w : GObj.widget) =
      box#pack ~expand:false w

    method add_tool (w : tool) =
      begin
        self#add_widget w#coerce ;
        w#on_active (self#active w) ;
        tools <- w :: tools ;
      end

    method private active w a =
      if a && not lock then
        try
          lock <- true ;
          List.iter (fun w0 -> if w0 <> w then w0#set_active false) tools ;
          lock <- false ;
        with e ->
          lock <- false ; raise e

  end