OberonCore

 (* буфер обмена      *)

   PROCEDURE InitCLIP (                               );
      VAR repl : XCB.xcb_intern_atom_iterator_t;
   BEGIN
      (* окно буфера объмена ------ *)
      IF cwindow >  0  THEN RETURN END;
      NEW(tmpbord, 1024 * 1024       );
      cwindow := XCB.xcb_generate_id(connect           );
      vl_mask := 0;  vl_list[0] := 0 ;
      XCB.xcb_create_window(connect, 24, cwindow,xcbroot,
          0,0, 1,1, 1, XCB.XCB_WINDOW_CLASS_INPUT_OUTPUT,
                              rvisual, vl_mask, vl_list);

      (* запрашиваем атомы -------- *)
      CLIP := XCB.xcb_intern_atom(
                            connect, 0, 9, @'CLIPBOARD');
      TARG := XCB.xcb_intern_atom(
                            connect, 0, 7, @'TARGETS'  );
      UNIC := XCB.xcb_intern_atom(
                            connect, 0, 7, @'UNICODE'  );
      TEXT := XCB.xcb_intern_atom(
                            connect, 0, 4, @'TEXT'     );
      UTF8 := XCB.xcb_intern_atom(
                         connect, 1, 11, @'UTF8_STRING');
      utf8 := XCB.xcb_intern_atom(
              connect, 0,24,@'text/plain;charset=utf-8');

      UTF8 := UTF8 + XCB.XCB_ATOM_STRING * ORD(UTF8 = 0);
      UNIC := UNIC + XCB.XCB_ATOM_STRING * ORD(UNIC = 0);
      TEXT := TEXT + XCB.XCB_ATOM_STRING * ORD(TEXT = 0);
      utf8 := utf8 + XCB.XCB_ATOM_STRING * ORD(utf8 = 0);

      repl := XCB.xcb_intern_atom_reply(connect, CLIP,0);
      IF repl # NIL THEN CLIP := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;
      repl := XCB.xcb_intern_atom_reply(connect, TARG,0);
      IF repl # NIL THEN TARG := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;

      repl := XCB.xcb_intern_atom_reply(connect, UTF8,0);
      IF repl # NIL THEN UTF8 := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;
      repl := XCB.xcb_intern_atom_reply(connect, UNIC,0);
      IF repl # NIL THEN UNIC := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;
      repl := XCB.xcb_intern_atom_reply(connect, TEXT,0);
      IF repl # NIL THEN TEXT := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;
      repl := XCB.xcb_intern_atom_reply(connect, utf8,0);
      IF repl # NIL THEN utf8 := repl.atom;
                        Lib.free(VAL(ADDRESS, repl)) END;
   END InitCLIP;


   PROCEDURE sendtext (temp : ptrTEXT;
                 r_event : XCB.xcb_req_event_iterator_t);
      (* отправка запрошенных данных                  *)
      VAR n_event : XCB.xcb_selection_notify_event_t;
   BEGIN
      IF temp = NIL THEN RETURN                      END;

      n_event.response_type := XCB.XCB_SELECTION_NOTIFY ;
      n_event.detail        := r_event.detail   ;
      n_event.sequence      := r_event.sequence ;
      n_event.time          := r_event.time     ;
      n_event.target        := r_event.target   ;
      n_event.property      := r_event.property ;
      n_event.requestor     := r_event.requestor;
      n_event.selection     := r_event.selection;

      IF (n_event.target = TARG) THEN
         XCB.xcb_change_property(connect,
                    XCB.XCB_PROP_MODE_REPLACE,
                    n_event.requestor, n_event.property ,
                    XCB.XCB_ATOM_ATOM, 32, 4, ADR(UTF8));

      EI (n_event.target = UTF8) !
         (n_event.target = utf8) !
         (n_event.target = UNIC) !
         (n_event.target = TEXT) !
         (n_event.target = XCB.XCB_ATOM_STRING) THEN
         XCB.xcb_change_property(connect,
                    XCB.XCB_PROP_MODE_REPLACE ,
                    n_event.requestor, n_event.property ,
                    n_event.target, 8,
                      LEN(temp)-16, VAL(ADDRESS, temp) );

      ELSE n_event.property := 0                     END;

      XCB.xcb_send_event( connect, 0, n_event.requestor ,
                  XCB.XCB_EVENT_MASK_NO_EVENT, @n_event);
      XCB.xcb_flush(connect);
   END sendtext;


   PROCEDURE setboard (bord : ptrTEXT       );
      (* запись текста в буфер обмена      *)
   BEGIN
      IF bord = NIL THEN RETURN           END;

      InitCLIP(    );

      IF WinToUtf(bord^,tmpbord^) >0 THEN END;
      (* становимся владельцем clipboard   *)
      XCB.xcb_set_selection_owner(
                  connect, cwindow, CLIP, 0 );

      clpbord := NIL;
   END setboard;


   PROCEDURE getboard (           ) : ptrTEXT;
      (* чтение текста из буфера обмена    *)
      VAR g_event :
                 XCB.xcb_not_event_iterator_t;
      VAR repl :
              XCB.xcb_get_property_iterator_t;
      VAR size, prop, xsel, time : INTEGER;
          data : ADDRESS;
   BEGIN
      IF clpbord #NIL THEN RETURN clpbord END;

      InitCLIP(    );

      xsel := XCB.xcb_intern_atom(connect, 0 ,
                             9, @'XSEL_DATA');

      XCB.xcb_convert_selection(
          connect, cwindow, CLIP, UTF8, xsel ,
                   XCB.XCB_TIME_CURRENT_TIME);

      XCB.xcb_flush(connect);

      (* ожидаем не больше 100 миллисекунд *)
      g_event :=
             VAL(XCB.xcb_not_event_iterator_t,
             XCB.xcb_wait_for_event(connect));
      time := g_event.time + 0100;
      WHILE (ORD(BIT(g_event.response_type)
               * BIT(7FH) )
                  # XCB.XCB_SELECTION_NOTIFY)
                  & (g_event.time < time) DO
      g_event :=
             VAL(XCB.xcb_not_event_iterator_t,
             XCB.xcb_wait_for_event(connect));
      END;

      IF (ORD(BIT(g_event.response_type)
            * BIT(7FH) )
                  # XCB.XCB_SELECTION_NOTIFY)
                    THEN RETURN NIL       END;

      prop := XCB.xcb_get_property(connect, 0,
                    cwindow, g_event.property,
                XCB.XCB_GET_PROPERTY_TYPE_ANY,
                (*  max 1Mb  *) 0, 1024*1024);
      repl := XCB.xcb_get_property_reply(
                            connect, prop, 0);
      IF repl = NIL THEN RETURN NIL       END;

      data := 0;
      size :=
      XCB.xcb_get_property_value_length(repl);
      IF size > 0 THEN
         data :=
             XCB.xcb_get_property_value(repl);

         NEW(clpbord, size + 16);
         MOV(data, ADR(clpbord[0]),  size   );
      END;

      Lib.free(VAL(ADDRESS, repl));

      RETURN clpbord
   END getboard;


PROCEDURE clipproc*(bord : ptrTEXT) : ptrTEXT;
BEGIN
   IF bord = NIL THEN clpbord := getboard(  );
   EI bord # NIL THEN clpbord := bord     END;
   RETURN clpbord
END clipproc;


// пример обработки событий

      XCB.XCB_SELECTION_REQUEST : (* отправка данных  *)
                       sendtext(tmpbord, VAL(
                              XCB.xcb_req_event_iterator_t, a_event)) |

      XCB.XCB_SELECTION_NOTIFY  : (* получение данных   *)            |

      XCB.XCB_SELECTION_CLEAR   : (* смена владельца    *)            |