libdbusada-0.2/0000755000175000017500000000000011672337633012140 5ustar reetreetlibdbusada-0.2/TODO0000644000175000017500000000140611672337633012631 0ustar reetreetD_Bus/Ada TODOs =============== * Add support for empty containers * Simplify container To_String function. * Add Get (Index) to list. * Use Get () in dict entry getters, raise own exceptions. * Raise own exception in variant's Get_Argument function. * Howto: work with variants? * Add test for complex argument marshaling/unmarshaling. * Make message type controlled and free thin msg? * Msg: Add Image() function and print message details on exceptions. * Provide thin binding for 32,64 LONG_BIT - Currently, functions in the thin binding which rely on stddef_h.size_t do not work correctly. - This only concerns developers using the thin binding directly, the thick binding does not use them. - Affected functions: dbus_malloc, dbus_malloc0, dbus_realloc. libdbusada-0.2/doc/0000755000175000017500000000000011672337633012705 5ustar reetreetlibdbusada-0.2/doc/asciidoc.css0000644000175000017500000002051511672337633015200 0ustar reetreetbody { font-family: Georgia,serif; } h1, h2, h3, h4, h5, h6, div.title, caption.title, thead, p.table.header, #toctitle, #author, #revnumber, #revdate, #revremark, #footer { font-family: Arial,Helvetica,sans-serif; } body { background-color: #f1f1f1; } table.main { width: 80%; margin: 1em 10% 1em 10%; background-color: white; -webkit-border-radius: 10px; -webkit-box-shadow: 1px 1px 6px rgba(0, 0, 0, 0.6); -moz-border-radius: 10px; -moz-box-shadow: 1px 1px 6px rgba(0, 0, 0, 0.6); border-radius: 10px; box-shadow: 1px 1px 6px rgba(0, 0, 0, 0.6); } td.header { background-color: #666262; padding: 1px 15px 1px; border-bottom: 5px solid #4183c4; -webkit-border-top-left-radius: 10px; -webkit-border-top-right-radius: 10px; -moz-border-radius-topleft: 10px; -moz-border-radius-topright: 10px; border-top-left-radius: 10px; border-top-right-radius: 10px; } td.content { padding: 1px 15px 40px; } td.footer { background-color: #666262; border-top: 8px solid #4183c4; -webkit-border-bottom-right-radius: 10px; -webkit-border-bottom-left-radius: 10px; -moz-border-radius-bottomright: 10px; -moz-border-radius-bottomleft: 10px; border-bottom-right-radius: 10px; border-bottom-left-radius: 10px; } a { outline: none; } a:link, a:visited { color: #4183c4; text-decoration: none; } a:hover { text-decoration: underline; } em { font-style: italic; color: gray; } strong { font-weight: bold; color: gray; } h2, h3, h4, h5, h6 { color: #4183c4; margin-top: 1.2em; margin-bottom: 0.5em; line-height: 1.3; } h1 { background-color: #666262; color: white; } h2, h3 { border-bottom: 1px solid silver; } h2 { padding-top: 0.5em; } h3 { float: left; } h3 + * { clear: left; } h5 { font-size: 1.0em; } div.sectionbody { margin-left: 0; } hr { border: 1px solid silver; } p { margin-top: 0.5em; margin-bottom: 0.5em; } ul, ol, li > p { margin-top: 0; } ul > li { color: #aaa; } ul > li > * { color: black; } pre { padding: 0; margin: 0; } #author { color: #527bbd; font-weight: bold; font-size: 1.1em; } #email { } #revnumber, #revdate, #revremark { } #footer { font-size: x-small; margin-bottom: 4.0em; } #footer-text { background-color: #666262; color: #f1f1f1; float: right; padding-bottom: 0.5em; margin-right: 4px; } #footer-badges { float: right; padding-bottom: 0.5em; } #preamble { margin-top: 1.5em; margin-bottom: 1.5em; } div.imageblock, div.exampleblock, div.verseblock, div.quoteblock, div.literalblock, div.listingblock, div.sidebarblock, div.admonitionblock { margin-top: 1.0em; margin-bottom: 1.5em; } div.admonitionblock { margin-top: 2.0em; margin-bottom: 2.0em; margin-right: 10%; color: #606060; } div.content { /* Block element content. */ padding: 0; } /* Block element titles. */ div.title, caption.title { color: #527bbd; font-weight: bold; text-align: left; margin-top: 1.0em; margin-bottom: 0.5em; } div.title + * { margin-top: 0; } td div.title:first-child { margin-top: 0.0em; } div.content div.title:first-child { margin-top: 0.0em; } div.content + div.title { margin-top: 0.0em; } div.sidebarblock > div.content { background: #ffffee; border: 1px solid #dddddd; border-left: 4px solid #f0f0f0; padding: 0.5em; } div.listingblock > div.content { border: 1px solid #dddddd; border-left: 5px solid #f0f0f0; background: #f8f8f8; padding: 0.5em; } div.quoteblock, div.verseblock { padding-left: 1.0em; margin-left: 1.0em; margin-right: 10%; border-left: 5px solid #f0f0f0; color: #888; } div.quoteblock > div.attribution { padding-top: 0.5em; text-align: right; } div.verseblock > pre.content { font-family: inherit; font-size: inherit; } div.verseblock > div.attribution { padding-top: 0.75em; text-align: left; } div.admonitionblock .icon { vertical-align: top; font-size: 1.1em; font-weight: bold; text-decoration: underline; color: #527bbd; padding-right: 0.5em; } div.admonitionblock td.content { padding-left: 0.5em; border-left: 3px solid #dddddd; } div.exampleblock > div.content { border-left: 3px solid #dddddd; padding-left: 0.5em; } div.imageblock div.content { padding-left: 0; } span.image img { border-style: none; } dl { margin-top: 0.8em; margin-bottom: 0.8em; } dt { margin-top: 0.5em; margin-bottom: 0; font-style: normal; color: gray; } dd > *:first-child { margin-top: 0.1em; } ul, ol { list-style-position: outside; } ol.arabic { list-style-type: decimal; } ol.loweralpha { list-style-type: lower-alpha; } ol.upperalpha { list-style-type: upper-alpha; } ol.lowerroman { list-style-type: lower-roman; } ol.upperroman { list-style-type: upper-roman; } div.compact ul, div.compact ol, div.compact p, div.compact p, div.compact div, div.compact div { margin-top: 0.1em; margin-bottom: 0.1em; } tfoot { font-weight: bold; } td > div.verse { white-space: pre; } div.hdlist { margin-top: 0.8em; margin-bottom: 0.8em; } div.hdlist tr { padding-bottom: 15px; } dt.hdlist1.strong, td.hdlist1.strong { font-weight: bold; } td.hdlist1 { vertical-align: top; font-style: normal; padding-right: 0.8em; color: gray; } td.hdlist2 { vertical-align: top; } div.hdlist.compact tr { margin: 0; padding-bottom: 0; } .comment { background: yellow; } .footnote, .footnoteref { font-size: 0.8em; } span.footnote, span.footnoteref { vertical-align: super; } #footnotes { margin: 20px 0 20px 0; padding: 7px 0 0 0; } #footnotes div.footnote { margin: 0 0 5px 0; } #footnotes hr { border: none; border-top: 1px solid silver; height: 1px; text-align: left; margin-left: 0; width: 20%; min-width: 100px; } div.colist td { padding-right: 0.5em; padding-bottom: 0.3em; vertical-align: top; } div.colist td img { margin-top: 0.3em; } @media print { #footer-badges { display: none; } } #toc { margin-bottom: 2.5em; } #toctitle { color: #527bbd; font-size: 1.1em; font-weight: bold; margin-top: 1.0em; margin-bottom: 0.1em; } div.toclevel1, div.toclevel2, div.toclevel3, div.toclevel4 { margin-top: 0; margin-bottom: 0; } div.toclevel2 { margin-left: 2em; font-size: 0.9em; } div.toclevel3 { margin-left: 4em; font-size: 0.9em; } div.toclevel4 { margin-left: 6em; font-size: 0.9em; } span.big { font-size: 2em; } span.small { font-size: 0.6em; } span.underline { text-decoration: underline; } span.overline { text-decoration: overline; } span.line-through { text-decoration: line-through; } /* * xhtml11 specific * * */ tt { font-family: monospace; font-size: inherit; color: gray; } div.tableblock { margin-top: 1.0em; margin-bottom: 1.5em; } div.tableblock > table { border: 3px solid #527bbd; } thead, p.table.header { font-weight: bold; color: #527bbd; } p.table { margin-top: 0; } /* Because the table frame attribute is overriden by CSS in most browsers. */ div.tableblock > table[frame="void"] { border-style: none; } div.tableblock > table[frame="hsides"] { border-left-style: none; border-right-style: none; } div.tableblock > table[frame="vsides"] { border-top-style: none; border-bottom-style: none; } /* * html5 specific * * */ .monospaced { font-family: monospace; font-size: inherit; color: gray; } table.tableblock { margin-top: 1.0em; margin-bottom: 1.5em; } thead, p.tableblock.header { font-weight: bold; color: #527bbd; } p.tableblock { margin-top: 0; } table.tableblock { border-width: 3px; border-spacing: 0px; border-style: solid; border-color: #527bbd; border-collapse: collapse; } th.tableblock, td.tableblock { border-width: 1px; padding: 4px; border-style: solid; border-color: #527bbd; } table.tableblock.frame-topbot { border-left-style: hidden; border-right-style: hidden; } table.tableblock.frame-sides { border-top-style: hidden; border-bottom-style: hidden; } table.tableblock.frame-none { border-style: hidden; } th.tableblock.halign-left, td.tableblock.halign-left { text-align: left; } th.tableblock.halign-center, td.tableblock.halign-center { text-align: center; } th.tableblock.halign-right, td.tableblock.halign-right { text-align: right; } th.tableblock.valign-top, td.tableblock.valign-top { vertical-align: top; } th.tableblock.valign-middle, td.tableblock.valign-middle { vertical-align: middle; } th.tableblock.valign-bottom, td.tableblock.valign-bottom { vertical-align: bottom; } libdbusada-0.2/doc/page.conf0000644000175000017500000004655111672337633014503 0ustar reetreet[miscellaneous] outfilesuffix=.html [attributes] basebackend=html basebackend-html= basebackend-xhtml11= [replacements2] # Line break. (?m)^(.*)\s\+$=\1
[replacements] ifdef::asciidoc7compatible[] # Superscripts. \^(.+?)\^=\1 # Subscripts. ~(.+?)~=\1 endif::asciidoc7compatible[] [ruler-blockmacro]
[pagebreak-blockmacro]
[blockdef-pass] asciimath-style=template="asciimathblock",subs=[] latexmath-style=template="latexmathblock",subs=[] [macros] # math macros. # Special characters are escaped in HTML math markup. (?su)[\\]?(?Pasciimath|latexmath):(?P\S*?)\[(?P.*?)(?asciimath|latexmath)::(?P\S*?)(\[(?P.*?)\])$=#[specialcharacters] [asciimath-inlinemacro] `{passtext}` [asciimath-blockmacro]
{title}
`{passtext}`
[asciimathblock]
{title}
`|`
[latexmath-inlinemacro] {passtext} [latexmath-blockmacro]
{title}
{passtext}
[latexmathblock]
{title}
|
[image-inlinemacro] {data-uri%}{alt={target}} {data-uri#}{alt={target}} {link#} [image-blockmacro]
{caption={figure-caption} {counter:figure-number}. }{title}
[unfloat-blockmacro]
[indexterm-inlinemacro] # Index term. {empty} [indexterm2-inlinemacro] # Index term. # Single entry index term that is visible in the primary text flow. {1} [footnote-inlinemacro] # footnote:[].
[{0}]
[footnoteref-inlinemacro] # footnoteref:[], create reference to footnote. {2%}
[{1}]
# footnoteref:[,], create footnote with ID. {2#}
[{2}]
[callout-inlinemacro] ifndef::icons[] <{index}> endif::icons[] ifdef::icons[] ifndef::data-uri[] {index} endif::data-uri[] ifdef::data-uri[] {index} endif::data-uri[] endif::icons[] # Comment line macros. [comment-inlinemacro] {showcomments#}
{passtext}
[comment-blockmacro] {showcomments#}

{passtext}

[literal-inlinemacro] # Inline literal. {passtext} # List tags. [listtags-bulleted] list=
{title?
{title}
}
    |
item=
  • |
  • text=

    |

    [listtags-numbered] # The start attribute is not valid XHTML 1.1 but all browsers support it. list=
    {title?
    {title}
    }
      |
    item=
  • |
  • text=

    |

    [listtags-labeled] list=
    {title?
    {title}
    }
    |
    entry= label= term=
    |
    item=
    |
    text=

    |

    [listtags-horizontal] list=
    {title?
    {title}
    }{labelwidth?}{itemwidth?}|
    label=| term=|
    entry=| item=| text=

    |

    [listtags-qanda] list=
    {title?
    {title}
    }
      |
    entry=
  • |
  • label= term=

    |

    item= text=

    |

    [listtags-callout] ifndef::icons[] list=
    {title?
    {title}
    }
      |
    item=
  • |
  • text=

    |

    endif::icons[] ifdef::icons[] list=
    {title?
    {title}
    }|
    ifndef::data-uri[] item={listindex}| endif::data-uri[] ifdef::data-uri[] item={listindex}| endif::data-uri[] text=| endif::icons[] [listtags-glossary] list=
    {title?
    {title}
    }
    |
    label= entry= term=
    |
    item=
    |
    text=

    |

    [listtags-bibliography] list=
    {title?
    {title}
    }
      |
    item=
  • |
  • text=

    |

    [tags] # Quoted text. emphasis={1?}|{1?} strong={1?}|{1?} monospaced={1?}|{1?} singlequoted={lsquo}{1?}|{1?}{rsquo} doublequoted={ldquo}{1?}|{1?}{rdquo} unquoted={1?}|{1?} superscript={1?}|{1?} subscript={1?}|{1?} ifdef::deprecated-quotes[] # Override with deprecated quote attributes. emphasis={role?}|{role?} strong={role?}|{role?} monospaced={role?}|{role?} singlequoted={role?}{1,2,3?}{amp}#8216;|{amp}#8217;{1,2,3?}{role?} doublequoted={role?}{1,2,3?}{amp}#8220;|{amp}#8221;{1,2,3?}{role?} unquoted={role?}{1,2,3?}|{1,2,3?}{role?} superscript={role?}|{role?} subscript={role?}|{role?} endif::deprecated-quotes[] # Inline macros [http-inlinemacro] {0={name}:{target}} [https-inlinemacro] {0={name}:{target}} [ftp-inlinemacro] {0={name}:{target}} [file-inlinemacro] {0={name}:{target}} [irc-inlinemacro] {0={name}:{target}} [mailto-inlinemacro] {0={target}} [link-inlinemacro] {0={target}} [callto-inlinemacro] {0={target}} # anchor:id[text] [anchor-inlinemacro] # [[id,text]] [anchor2-inlinemacro] # [[[id]]] [anchor3-inlinemacro] [{1}] # xref:id[text] [xref-inlinemacro] {0=[{target}]} # <> [xref2-inlinemacro] {2=[{1}]} # Special word substitution. [emphasizedwords] {words} [monospacedwords] {words} [strongwords] {words} # Paragraph substitution. [paragraph]
    {title?
    {title}
    }

    |

    [admonitionparagraph] template::[admonitionblock] # Delimited blocks. [listingblock]
    {caption=}{title}
    
    |
    
    [literalblock]
    {title}
    
    |
    
    [sidebarblock]
    {title}
    |
    [openblock]
    {title}
    |
    [partintroblock] template::[openblock] [abstractblock] template::[quoteblock] [quoteblock]
    {title}
    |
    {citetitle}{attribution?
    } — {attribution}
    [verseblock]
    {title}
    |
    
    {citetitle}{attribution?
    } — {attribution}
    [exampleblock]
    {caption={example-caption} {counter:example-number}. }{title}
    |
    [admonitionblock]
    {data-uri%}{icons#}{caption} {data-uri#}{icons#}{caption} {icons%}
    {caption}
    {title}
    |
    # Tables. [tabletags-default] colspec= bodyrow=| headdata=| bodydata=| paragraph=

    |

    [tabletags-header] paragraph=

    |

    [tabletags-emphasis] paragraph=

    |

    [tabletags-strong] paragraph=

    |

    [tabletags-monospaced] paragraph=

    |

    [tabletags-verse] bodydata=
    |
    paragraph= [tabletags-literal] bodydata=
    |
    paragraph= [tabletags-asciidoc] bodydata=
    |
    paragraph= [table]
    {colspecs} {headrows#} {headrows} {headrows#} {footrows#} {footrows} {footrows#} {bodyrows}
    {caption={table-caption} {counter:table-number}. }{title}
    #-------------------------------------------------------------------- [floatingtitle] {title} [preamble] # Untitled elements between header and first section title.
    |
    # Document sections. [sect0] {title} | [sect1]
    {numbered?{sectnum} }{title}
    |
    [sect2]
    {numbered?{sectnum} }{title} |
    [sect3]
    {numbered?{sectnum} }{title} |
    [sect4]
    {title} |
    [appendix]
    {numbered?{sectnum} }{appendix-caption} {counter:appendix-number:A}: {title}
    |
    [toc]
    {toc-title}
    [header] {title} {title%}{doctitle=} ifdef::linkcss[] ifdef::quirks[] endif::quirks[] ifdef::pygments[] ifdef::toc2[] endif::linkcss[] ifndef::linkcss[] endif::linkcss[] ifndef::disable-javascript[] ifdef::linkcss[] endif::linkcss[] ifndef::linkcss[] endif::linkcss[] endif::disable-javascript[] ifdef::asciimath[] ifdef::linkcss[] endif::linkcss[] ifndef::linkcss[] endif::linkcss[] endif::asciimath[] ifdef::latexmath[] ifdef::linkcss[] endif::linkcss[] ifndef::linkcss[] endif::linkcss[] endif::latexmath[] {docinfo1,docinfo2#}{include:{docdir}/docinfo.html} {docinfo,docinfo2#}{include:{docdir}/{docname}-docinfo.html} template::[docinfo]
    # Article, book header. ifndef::doctype-manpage[]
    endif::doctype-manpage[] # Man page header. ifdef::doctype-manpage[] endif::doctype-manpage[] [footer]
    ifdef::doctype-manpage[] [synopsis] template::[sect1] endif::doctype-manpage[] ifdef::quirks[] include::xhtml11-quirks.conf[] endif::quirks[] libdbusada-0.2/doc/index0000644000175000017500000000055011672337633013737 0ustar reetreetinclude::../README[] The following code connects to the D-Bus session bus, calls the remote `org.freedesktop.DBus.ListNames` method and prints all the results: [source,ada] --------------------------------------------------------------------- include::../examples/caller/list_names.adb[] --------------------------------------------------------------------- libdbusada-0.2/doc/Makefile0000644000175000017500000000065411672337633014352 0ustar reetreetDESTDIR ?= html STYLEPATH ?= . PREPARE := $(shell mkdir -p $(DESTDIR)) ASCIIDOC_OPTS = \ --backend=xhtml11 \ --conf-file=page.conf \ -a stylesdir=$(STYLEPATH) \ -a linkcss \ -a disable-javascript \ -o - all: $(DESTDIR)/asciidoc.css $(DESTDIR)/index.html $(DESTDIR)/asciidoc.css: asciidoc.css cp $< $@ $(DESTDIR)/index.html: index page.conf ../README asciidoc $(ASCIIDOC_OPTS) $< > $@ clean: rm -f $(DESTDIR)/* libdbusada-0.2/d_bus_ada_lib_thin.gpr0000644000175000017500000000366411672337633016434 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with "d_bus_ada_common"; project D_Bus_Ada_Lib_Thin is for Source_Dirs use ("thin"); for Object_Dir use "obj/thin"; for Library_Name use "dbusada-thin"; for Library_Dir use "lib/thin"; for Library_Kind use external ("LIBRARY_KIND", "dynamic"); for Library_Version use "libdbusada-thin.so." & D_Bus_Ada_Common.Version; Compiler_Switches := ("-gnat05", "-fstack-check", "-gnato", "-g"); package Compiler is for Default_Switches ("ada") use Compiler_Switches; end Compiler; package Binder is for Default_Switches ("ada") use ("-E"); end Binder; end D_Bus_Ada_Lib_Thin; libdbusada-0.2/src/0000755000175000017500000000000011672337633012727 5ustar reetreetlibdbusada-0.2/src/d_bus-g_main.adb0000644000175000017500000000467711672337633015741 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with System; with Interfaces.C; package body D_Bus.G_Main is use type System.Address; Main_Loop : System.Address := System.Null_Address; function g_main_loop_new (context : System.Address; is_running : Interfaces.C.int) return System.Address; pragma Import (C, g_main_loop_new, "g_main_loop_new"); procedure g_main_loop_run (the_loop : System.Address); pragma Import (C, g_main_loop_run, "g_main_loop_run"); ------------------------------------------------------------------------- procedure Init is begin if Main_Loop /= System.Null_Address then raise D_Bus_Error with "GLib main loop already initialized"; end if; Main_Loop := g_main_loop_new (context => System.Null_Address, is_running => 0); if Main_Loop = System.Null_Address then raise D_Bus_Error with "Could not initialize GLib main loop"; end if; end Init; ------------------------------------------------------------------------- procedure Start is begin if Main_Loop = System.Null_Address then Init; end if; g_main_loop_run (the_loop => Main_Loop); end Start; end D_Bus.G_Main; libdbusada-0.2/src/d_bus-arguments.adb0000644000175000017500000001431411672337633016501 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Tags; with Interfaces.C; with dbus_types_h; package body D_Bus.Arguments is package C renames Interfaces.C; ------------------------------------------------------------------------- procedure Append (List : in out Argument_List_Type; New_Item : Argument_Type'Class) is begin List.Data.Append (New_Item => New_Item); end Append; ------------------------------------------------------------------------- function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Argument_List_Type is use type C.int; use type dbus_types_h.dbus_bool_t; Result : Arguments.Argument_List_Type; begin loop declare Type_Code : C.int; Type_Char : String (1 .. 1); Type_Tag : Ada.Tags.Tag; begin Type_Code := dbus_message_h.dbus_message_iter_get_arg_type (arg1 => D_Args); if Type_Code /= 0 then Type_Char (1) := Character'Val (Type_Code); begin Type_Tag := Ada.Tags.Internal_Tag (Type_Char); exception when Ada.Tags.Tag_Error => raise D_Bus_Error with "Unknown type code '" & Type_Char & "' in message"; end; Arguments.Append (List => Result, New_Item => Argument_Type'Class (Marshaling.Make_Object (The_Tag => Type_Tag, Params => D_Args))); end if; exit when dbus_message_h.dbus_message_iter_next (arg1 => D_Args) = 0; end; end loop; return Result; end Deserialize; ------------------------------------------------------------------------- function First_Element (List : Argument_List_Type) return Argument_Type'Class is begin return List.Data.First_Element; exception when Constraint_Error => raise No_Arguments with "Argument list is empty"; end First_Element; ------------------------------------------------------------------------- function Get_Code (Arg : Argument_Type'Class) return Integer is Tag : constant String := Get_Tag (Arg); Code : ASCII_Code; begin begin Code := ASCII_Code'Value (Tag); exception when Constraint_Error => raise D_Bus_Error with "Argument tag '" & Tag & "' not found in type code table"; end; return Code_Table (Code); end Get_Code; ------------------------------------------------------------------------- function Get_Count (List : Argument_List_Type) return Natural is begin return Natural (List.Data.Length); end Get_Count; ------------------------------------------------------------------------- function Get_Signature (Arg : Basic_Type) return String is begin return Get_Tag (Arg => Argument_Type'Class (Arg)); end Get_Signature; ------------------------------------------------------------------------- function Get_Tag (Arg : Argument_Type'Class) return String is begin return Ada.Tags.External_Tag (T => Arg'Tag); end Get_Tag; ------------------------------------------------------------------------- function Is_Empty (List : Argument_List_Type) return Boolean is begin return List.Data.Is_Empty; end Is_Empty; ------------------------------------------------------------------------- procedure Iterate (List : Argument_List_Type; Process : not null access procedure (Arg : Argument_Type'Class)) is procedure Process_Arg (Position : ALP.Cursor); -- Call the process procedure for an arg in the list. procedure Process_Arg (Position : ALP.Cursor) is Arg : constant Argument_Type'Class := ALP.Element (Position); begin Process (Arg); end Process_Arg; begin List.Data.Iterate (Process_Arg'Access); end Iterate; ------------------------------------------------------------------------- function Last_Element (List : Argument_List_Type) return Argument_Type'Class is begin return List.Data.Last_Element; exception when Constraint_Error => raise No_Arguments with "Argument list is empty"; end Last_Element; ------------------------------------------------------------------------- procedure Serialize (Args : Argument_List_Type; D_Args : not null access dbus_message_h.DBusMessageIter) is procedure To_D_Bus (Arg : Argument_Type'Class); -- Append given argument to D-Bus message arguments. procedure To_D_Bus (Arg : Argument_Type'Class) is begin Arg.Serialize (D_Msg => D_Args); end To_D_Bus; begin Arguments.Iterate (List => Args, Process => To_D_Bus'Access); end Serialize; end D_Bus.Arguments; libdbusada-0.2/src/d_bus-connection.adb0000644000175000017500000003056111672337633016635 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Interfaces.C.Strings; with dbus_bus_h; with dbus_shared_h; with dbus_errors_h; with dbus_connection_h; with dbus_message_h; with dbus_types_h; with dbus_arch_deps_h; package body D_Bus.Connection is package C renames Interfaces.C; Bus_Types : constant array (Bus_Type) of dbus_shared_h.DBusBusType := (Bus_Session => dbus_shared_h.DBUS_BUS_SESSION, Bus_System => dbus_shared_h.DBUS_BUS_SYSTEM, Bus_Starter => dbus_shared_h.DBUS_BUS_STARTER); -- Mapping of Ada bus type enum to low-level D-Bus bus types. procedure Check (Result : access dbus_errors_h.DBusError); -- Check D-Bus error object and raise an exception if error is set. The -- D-Bus error object is freed before the exception is raised. procedure Add_Args (D_Message : System.Address; Args : Arguments.Argument_List_Type); -- Add arguments to low-level D-Bus message. ------------------------------------------------------------------------- procedure Add_Args (D_Message : System.Address; Args : Arguments.Argument_List_Type) is D_Args : aliased dbus_message_h.DBusMessageIter; begin dbus_message_h.dbus_message_iter_init_append (arg1 => D_Message, arg2 => D_Args'Access); Arguments.Serialize (Args => Args, D_Args => D_Args'Access); end Add_Args; ------------------------------------------------------------------------- procedure Add_Match (Connection : Connection_Type; Rule : String) is D_Err : aliased dbus_errors_h.DBusError; C_Str : C.Strings.chars_ptr := C.Strings.New_String (Str => Rule); begin dbus_bus_h.dbus_bus_add_match (arg1 => Connection.Thin_Connection, arg2 => C_Str, arg3 => D_Err'Access); C.Strings.Free (Item => C_Str); Check (Result => D_Err'Access); end Add_Match; ------------------------------------------------------------------------- function Call_Blocking (Connection : Connection_Type; Destination : String; Path : String; Iface : String; Method : String; Args : Arguments.Argument_List_Type := Arguments.Empty_Argument_List) return Arguments.Argument_List_Type is use type System.Address; use type C.int; D_Msg : System.Address := System.Null_Address; D_Reply : System.Address := System.Null_Address; D_Err : aliased dbus_errors_h.DBusError; C_Dest : C.Strings.chars_ptr; C_Path : C.Strings.chars_ptr; C_Iface : C.Strings.chars_ptr; C_Method : C.Strings.chars_ptr; ---------------------------------------------------------------------- procedure Free_Strings; -- Free allocated memory. procedure Free_Strings is begin C.Strings.Free (Item => C_Dest); C.Strings.Free (Item => C_Path); C.Strings.Free (Item => C_Iface); C.Strings.Free (Item => C_Method); end Free_Strings; begin C_Dest := C.Strings.New_String (Str => Destination); C_Path := C.Strings.New_String (Str => Path); C_Iface := C.Strings.New_String (Str => Iface); C_Method := C.Strings.New_String (Str => Method); D_Msg := dbus_message_h.dbus_message_new_method_call (arg1 => C_Dest, arg2 => C_Path, arg3 => C_Iface, arg4 => C_Method); Free_Strings; if D_Msg = System.Null_Address then raise D_Bus_Error with "Could not allocate message"; end if; Add_Args (D_Message => D_Msg, Args => Args); D_Reply := dbus_connection_h.dbus_connection_send_with_reply_and_block (arg1 => Connection.Thin_Connection, arg2 => D_Msg, arg3 => -1, arg4 => D_Err'Access); dbus_message_h.dbus_message_unref (arg1 => D_Msg); D_Msg := System.Null_Address; if D_Reply = System.Null_Address then Check (Result => D_Err'Access); end if; declare use type dbus_types_h.dbus_bool_t; D_Args : aliased dbus_message_h.DBusMessageIter; begin if dbus_message_h.dbus_message_iter_init (arg1 => D_Reply, arg2 => D_Args'Access) = 0 then dbus_message_h.dbus_message_unref (arg1 => D_Reply); return Arguments.Empty_Argument_List; end if; return A : Arguments.Argument_List_Type do A := Arguments.Deserialize (D_Args => D_Args'Access); dbus_message_h.dbus_message_unref (arg1 => D_Reply); end return; end; end Call_Blocking; ------------------------------------------------------------------------- procedure Check (Result : access dbus_errors_h.DBusError) is use type dbus_types_h.dbus_bool_t; begin if dbus_errors_h.dbus_error_is_set (arg1 => Result) = 1 then declare Error_String : constant String := C.Strings.Value (Result.message); begin dbus_errors_h.dbus_error_free (arg1 => Result); raise D_Bus_Error with Error_String; end; end if; end Check; ------------------------------------------------------------------------- function Connect (Bus : Bus_Type := Bus_Session) return Connection_Type is D_Conn : System.Address := System.Null_Address; D_Err : aliased dbus_errors_h.DBusError; begin D_Conn := dbus_bus_h.dbus_bus_get (arg1 => Bus_Types (Bus), arg2 => D_Err'Access); Check (Result => D_Err'Access); return Connection_Type'(Thin_Connection => D_Conn); end Connect; ------------------------------------------------------------------------- function Connect (Address : String) return Connection_Type is C_Addr : C.Strings.chars_ptr := C.Strings.New_String (Str => Address); D_Conn : System.Address := System.Null_Address; D_Err : aliased dbus_errors_h.DBusError; begin D_Conn := dbus_connection_h.dbus_connection_open (arg1 => C_Addr, arg2 => D_Err'Access); C.Strings.Free (Item => C_Addr); Check (Result => D_Err'Access); return Connection_Type'(Thin_Connection => D_Conn); end Connect; ------------------------------------------------------------------------- procedure Dispatch (Connection : Connection_Type; Callback : Callbacks.Message_Callback) is use type C.int; use type dbus_types_h.dbus_bool_t; function Call_Back (D_Conn : System.Address; Msg : System.Address; Usr_Data : System.Address) return dbus_shared_h.DBusHandlerResult; -- Dispatch deserialized message to given callback procedure. function Call_Back (D_Conn : System.Address; Msg : System.Address; Usr_Data : System.Address) return dbus_shared_h.DBusHandlerResult is pragma Unreferenced (D_Conn, Usr_Data); begin Callback (Msg => Messages.Create (D_Msg => Msg)); return dbus_shared_h.DBUS_HANDLER_RESULT_HANDLED; end Call_Back; procedure Free_Usr_Data (arg1 : System.Address) is null; D_Res : dbus_types_h.dbus_bool_t; begin D_Res := dbus_connection_h.dbus_connection_add_filter (arg1 => Connection.Thin_Connection, arg2 => Call_Back'Access, arg3 => System.Null_Address, arg4 => Free_Usr_Data'Access); if D_Res = 0 then raise D_Bus_Error with "Could not add connection filter"; end if; while dbus_connection_h.dbus_connection_read_write_dispatch (arg1 => Connection.Thin_Connection, arg2 => -1) = 1 loop null; end loop; end Dispatch; ------------------------------------------------------------------------- procedure Request_Name (Connection : Connection_Type; Name : String) is use type C.int; use type C.unsigned; C_Res : C.int; C_Name : C.Strings.chars_ptr := C.Strings.New_String (Str => Name); D_Err : aliased dbus_errors_h.DBusError; begin C_Res := dbus_bus_h.dbus_bus_request_name (arg1 => Connection.Thin_Connection, arg2 => C_Name, arg3 => dbus_shared_h.DBUS_NAME_FLAG_REPLACE_EXISTING, arg4 => D_Err'Access); C.Strings.Free (Item => C_Name); Check (Result => D_Err'Access); if C_Res /= dbus_shared_h.DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER then raise D_Bus_Error with "Not primary owner for '" & Name & "' (" & C_Res'Img & ")"; end if; end Request_Name; ------------------------------------------------------------------------- procedure Send (Connection : Connection_Type; Message : Messages.Message_Type) is use type dbus_types_h.dbus_bool_t; D_Serial : aliased dbus_arch_deps_h.dbus_uint32_t := 0; begin if dbus_connection_h.dbus_connection_send (arg1 => Connection.Thin_Connection, arg2 => Messages.To_Thin (Msg => Message), arg3 => D_Serial'Access) = 0 then raise D_Bus_Error with "Could not send message: out of memory"; end if; end Send; ------------------------------------------------------------------------- procedure Send_Signal (Connection : Connection_Type; Object_Name : String; Iface : String; Name : String; Args : Arguments.Argument_List_Type := Arguments.Empty_Argument_List) is use type System.Address; D_Msg : System.Address := System.Null_Address; C_Object : C.Strings.chars_ptr; C_Iface : C.Strings.chars_ptr; C_Name : C.Strings.chars_ptr; ---------------------------------------------------------------------- procedure Free_Strings; -- Free allocated memory. procedure Free_Strings is begin C.Strings.Free (Item => C_Object); C.Strings.Free (Item => C_Iface); C.Strings.Free (Item => C_Name); end Free_Strings; begin C_Object := C.Strings.New_String (Str => Object_Name); C_Iface := C.Strings.New_String (Str => Iface); C_Name := C.Strings.New_String (Str => Name); D_Msg := dbus_message_h.dbus_message_new_signal (arg1 => C_Object, arg2 => C_Iface, arg3 => C_Name); if D_Msg = System.Null_Address then Free_Strings; raise D_Bus_Error with "Could not allocate message"; end if; begin Add_Args (D_Message => D_Msg, Args => Args); exception when D_Bus_Error => Free_Strings; raise; end; declare use type C.unsigned; D_Serial : aliased dbus_arch_deps_h.dbus_uint32_t := 0; begin if dbus_connection_h.dbus_connection_send (arg1 => Connection.Thin_Connection, arg2 => D_Msg, arg3 => D_Serial'Access) = 0 then Free_Strings; raise D_Bus_Error with "Could not send signal"; end if; end; Free_Strings; dbus_message_h.dbus_message_unref (arg1 => D_Msg); end Send_Signal; end D_Bus.Connection; libdbusada-0.2/src/d_bus-service.ads0000644000175000017500000000473611672337633016164 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Unbounded; with Ada.Containers.Ordered_Maps; with D_Bus.Messages; package D_Bus.Service is type Method_Handle is access procedure (Request : Messages.Message_Type; Reply : out Messages.Message_Type); -- Method handler. type Object is abstract tagged private; -- D-Bus service object. Extend this type to provide your own services on -- the bus. procedure Initialize (Obj : in out Object) is abstract; -- Initialize a service object. procedure Register (Obj : in out Object; Name : String; Method : Method_Handle); -- Register a service method with given name. procedure Call (Obj : Object; Name : String; Request : Messages.Message_Type; Reply : out Messages.Message_Type); -- Call method with given name. Duplicate_Method : exception; Unknown_Method : exception; private use Ada.Strings.Unbounded; package Methods_Map is new Ada.Containers.Ordered_Maps (Key_Type => Unbounded_String, Element_Type => Method_Handle); package MM renames Methods_Map; type Object is abstract tagged record Methods : MM.Map; end record; end D_Bus.Service; libdbusada-0.2/src/d_bus-connection.ads0000644000175000017500000000614211672337633016654 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with System; with D_Bus.Arguments; with D_Bus.Callbacks; with D_Bus.Messages; package D_Bus.Connection is type Connection_Type (<>) is limited private; -- D-Bus connection. function Connect (Bus : Bus_Type := Bus_Session) return Connection_Type; -- Connect to the given message bus type. function Connect (Address : String) return Connection_Type; -- Connect to the given remote address. function Call_Blocking (Connection : Connection_Type; Destination : String; Path : String; Iface : String; Method : String; Args : Arguments.Argument_List_Type := Arguments.Empty_Argument_List) return Arguments.Argument_List_Type; -- Synchronously call the given method. procedure Send_Signal (Connection : Connection_Type; Object_Name : String; Iface : String; Name : String; Args : Arguments.Argument_List_Type := Arguments.Empty_Argument_List); -- Send a signal over the given connection. procedure Send (Connection : Connection_Type; Message : Messages.Message_Type); -- Add given message to the outgoing message queue. procedure Request_Name (Connection : Connection_Type; Name : String); -- Request name on the bus for given connection. procedure Add_Match (Connection : Connection_Type; Rule : String); -- Add given match rule to match messages going through the message bus. procedure Dispatch (Connection : Connection_Type; Callback : Callbacks.Message_Callback); -- Dispatch messages to the given callback procedure. Use the Add_Match -- procedure to add match rules. private type Connection_Type is limited record Thin_Connection : System.Address := System.Null_Address; end record; end D_Bus.Connection; libdbusada-0.2/src/d_bus-connection-g_main.adb0000644000175000017500000001223311672337633020061 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Interfaces.C.Strings; with dbus_types_h; with dbus_connection_h; with dbus_shared_h; with D_Bus.Messages; package body D_Bus.Connection.G_Main is package C renames Interfaces.C; procedure dbus_connection_setup_with_g_main (connection : System.Address; context : System.Address); pragma Import (C, dbus_connection_setup_with_g_main, "dbus_connection_setup_with_g_main"); function Object_Path_Message (conn : System.Address; msg : System.Address; data : System.Address) return dbus_shared_h.DBusHandlerResult; -- Handler for path messages. procedure Object_Path_Unregister (conn : System.Address; data : System.Address) is null; procedure Nul_Pad (arg1 : System.Address) is null; Obj_Path_Table : aliased constant dbus_connection_h.DBusObjectPathVTable := (unregister_function => Object_Path_Unregister'Access, message_function => Object_Path_Message'Access, dbus_internal_pad1 => Nul_Pad'Access, dbus_internal_pad2 => Nul_Pad'Access, dbus_internal_pad3 => Nul_Pad'Access, dbus_internal_pad4 => Nul_Pad'Access); -- Object V path table. ------------------------------------------------------------------------- function Object_Path_Message (conn : System.Address; msg : System.Address; data : System.Address) return dbus_shared_h.DBusHandlerResult is pragma Unreferenced (data); use D_Bus.Messages; use type SOMP.Cursor; Reply : Message_Type; Message : constant Message_Type := Create (D_Msg => msg); Path : constant String := Get_Path (Msg => Message); Method : constant String := Get_Member (Msg => Message); Obj : constant Object'Class := Services.Element (Key => To_Unbounded_String (Path)); begin Obj.Call (Name => Method, Request => Message, Reply => Reply); Send (Connection => (Thin_Connection => conn), Message => Reply); return dbus_shared_h.DBUS_HANDLER_RESULT_HANDLED; exception when Unknown_Method => declare Error : constant Message_Type := New_Error (Reply_To => Message, Error_Name => "org.freedesktop.DBus.Error.UnknownMethod", Error_Message => "Received unknown method call: " & Method); begin Send (Connection => (Thin_Connection => conn), Message => Error); return dbus_shared_h.DBUS_HANDLER_RESULT_NOT_YET_HANDLED; end; end Object_Path_Message; ------------------------------------------------------------------------- procedure Register_Object (Connection : Connection_Type; Path : String := "/"; Object : in out Service.Object'Class) is use type dbus_types_h.dbus_bool_t; C_Path : C.Strings.chars_ptr := C.Strings.New_String (Str => Path); D_Res : dbus_types_h.dbus_bool_t; begin D_Res := dbus_connection_h.dbus_connection_register_object_path (arg1 => Connection.Thin_Connection, arg2 => C_Path, arg3 => Obj_Path_Table'Access, arg4 => System.Null_Address); C.Strings.Free (Item => C_Path); if D_Res /= 1 then raise D_Bus_Error with "Could not register object on path '" & Path & "'"; end if; Object.Initialize; Services.Insert (Key => To_Unbounded_String (Source => Path), New_Item => Object); end Register_Object; ------------------------------------------------------------------------- procedure Setup_With_G_Main (Connection : in out Connection_Type) is begin dbus_connection_setup_with_g_main (connection => Connection.Thin_Connection, context => System.Null_Address); end Setup_With_G_Main; end D_Bus.Connection.G_Main; libdbusada-0.2/src/d_bus-g_main.ads0000644000175000017500000000263611672337633015753 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- package D_Bus.G_Main is procedure Init; -- Initialize GLib main event loop. procedure Start; -- Start GLib main event loop. end D_Bus.G_Main; libdbusada-0.2/src/d_bus-arguments.ads0000644000175000017500000001153511672337633016524 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Containers.Indefinite_Doubly_Linked_Lists; with dbus_message_h; with D_Bus.Marshaling; package D_Bus.Arguments is type Argument_Type is interface and Marshaling.Object; -- D-Bus argument type. function To_String (Arg : Argument_Type) return String is abstract; -- Return string representation of an argument. function Get_Signature (Arg : Argument_Type) return String is abstract; -- Return the argument's signature. function Get_Code (Arg : Argument_Type'Class) return Integer; -- Return D-Bus code of argument type implementation. See the chapter -- 'Type Signatures' in the D-Bus specification for more information. type Argument_List_Type is new Marshaling.Object with private; -- List of D-Bus arguments. Empty_Argument_List : constant Argument_List_Type; overriding procedure Serialize (Args : Argument_List_Type; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialize list of argument types to D-Bus arguments. overriding function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Argument_List_Type; -- Deserialize argument types from low-level D-Bus message starting at -- given message iterator position. procedure Append (List : in out Argument_List_Type; New_Item : Argument_Type'Class); -- Append argument to list. procedure Iterate (List : Argument_List_Type; Process : not null access procedure (Arg : Argument_Type'Class)); -- Iterate over arguments in the argument list. function First_Element (List : Argument_List_Type) return Argument_Type'Class; -- Return the first element in the argument list. function Last_Element (List : Argument_List_Type) return Argument_Type'Class; -- Return the last element in the argument list. function Get_Count (List : Argument_List_Type) return Natural; -- Return argument count. function Is_Empty (List : Argument_List_Type) return Boolean; -- Return True if argument list is empty. type Basic_Type is abstract new Argument_Type with private; -- Parent of all basic types. overriding function Get_Signature (Arg : Basic_Type) return String; -- Return the argument's signature. No_Arguments : exception; private type Basic_Type is abstract new Argument_Type with null record; package Argument_List_Package is new Ada.Containers.Indefinite_Doubly_Linked_Lists (Element_Type => Argument_Type'Class); package ALP renames Argument_List_Package; type Argument_List_Type is new Marshaling.Object with record Data : ALP.List; end record; Empty_Argument_List : constant Argument_List_Type := Argument_List_Type'(others => <>); type ASCII_Code is (a, b, e, i, n, q, r, s, t, u, v, x, y); -- ASCII type codes of D-Bus types (see 'Type Signatures' in the D-Bus -- specification). Code_Table : constant array (ASCII_Code) of Integer := (a => Character'Pos ('a'), b => Character'Pos ('b'), e => Character'Pos ('e'), i => Character'Pos ('i'), n => Character'Pos ('n'), q => Character'Pos ('q'), r => Character'Pos ('r'), s => Character'Pos ('s'), t => Character'Pos ('t'), u => Character'Pos ('u'), v => Character'Pos ('v'), y => Character'Pos ('y'), x => Character'Pos ('x')); -- Mapping of ASCII codes to their integer representation. function Get_Tag (Arg : Argument_Type'Class) return String; -- Return the external tag of the given argument. end D_Bus.Arguments; libdbusada-0.2/src/d_bus-messages.ads0000644000175000017500000000714111672337633016324 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with System; with D_Bus.Arguments; package D_Bus.Messages is type Message_Variant is (Invalid, Method_Call, Method_Return, Error, Signal); -- D-Bus message types. type Message_Type is private; -- A D-Bus message, see the section 'Message Format' in the D-Bus -- specification. function New_Method_Return (Method_Call : Message_Type) return Message_Type; -- Constructs a message that is a reply to a method call. function New_Error (Reply_To : Message_Type; Error_Name : String; Error_Message : String) return Message_Type; -- Creates a new message that is an error reply to another message. function Create (D_Msg : System.Address) return Message_Type; -- Create message object from low-level D-Bus message. function Get_Type (Msg : Message_Type) return Message_Variant; -- Return the message's type. function Get_Serial (Msg : Message_Type) return Positive; -- Return the message's serial number. function Get_Sender (Msg : Message_Type) return String; -- Return the message's sender. function Get_Destination (Msg : Message_Type) return String; -- Return the message's destination. function Get_Path (Msg : Message_Type) return String; -- Return the path. function Get_Interface (Msg : Message_Type) return String; -- Return the called interface. function Get_Member (Msg : Message_Type) return String; -- Return the member; either the method name or signal name. function Get_Arguments (Msg : Message_Type) return Arguments.Argument_List_Type; -- Return the message's arguments (if any). procedure Add_Arguments (Msg : in out Message_Type; Args : Arguments.Argument_List_Type); -- Add given arguments to message. function Is_Method_Call (Msg : Message_Type; Iface : String; Method : String) return Boolean; -- Checks whether the given message is a method call with the given -- interface and member fields. function To_Thin (Msg : Message_Type) return System.Address; -- Helper function to convert the Ada D-Bus message to a thin binding -- memory address. TODO: remove me. Invalid_Message : exception; private type Message_Type is record Thin_Msg : System.Address := System.Null_Address; end record; end D_Bus.Messages; libdbusada-0.2/src/d_bus-arguments-containers.adb0000644000175000017500000003457211672337633020654 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Unbounded; with Interfaces.C.Strings; with dbus_types_h; package body D_Bus.Arguments.Containers is package C renames Interfaces.C; procedure Serialize_Container (Args : Argument_List_Type; Code : ASCII_Code; Signature : String := ""; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialization helper for container types. Code is the container code, -- Signature is the required signature as described in the D-Bus low-level -- public API, function dbus_message_iter_open_container. ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Array_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Struct_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Variant_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "+" (Left : Array_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Struct_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Variant_Type) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- procedure Append (List : in out Array_Type; New_Item : Argument_Type'Class) is Arg_Code : constant Natural := New_Item.Get_Code; begin if List.Code /= 0 and then Arg_Code /= List.Code then raise D_Bus_Error with "Array can only hold one single complete type"; end if; List.Code := Arg_Code; Argument_List_Type (List).Append (New_Item => New_Item); end Append; ------------------------------------------------------------------------- function Create (Key : Basic_Type'Class; Value : Argument_Type'Class) return Dict_Entry_Type is D : Dict_Entry_Type; begin D.Append (New_Item => Key); D.Append (New_Item => Value); return D; end Create; ------------------------------------------------------------------------- function Create (Source : Argument_Type'Class) return Variant_Type is V : Variant_Type; begin V.Append (New_Item => Source); return V; end Create; ------------------------------------------------------------------------- function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Array_Type is D_Sub_Args : aliased dbus_message_h.DBusMessageIter; begin dbus_message_h.dbus_message_iter_recurse (arg1 => D_Args, arg2 => D_Sub_Args'Access); return Result : Array_Type do Argument_List_Type (Result) := Deserialize (D_Args => D_Sub_Args'Access); end return; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Struct_Type is D_Sub_Args : aliased dbus_message_h.DBusMessageIter; begin dbus_message_h.dbus_message_iter_recurse (arg1 => D_Args, arg2 => D_Sub_Args'Access); return Result : Struct_Type do Argument_List_Type (Result) := Deserialize (D_Args => D_Sub_Args'Access); end return; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Dict_Entry_Type is D_Sub_Args : aliased dbus_message_h.DBusMessageIter; begin dbus_message_h.dbus_message_iter_recurse (arg1 => D_Args, arg2 => D_Sub_Args'Access); return Result : Dict_Entry_Type do Argument_List_Type (Result) := Deserialize (D_Args => D_Sub_Args'Access); end return; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Variant_Type is D_Sub_Args : aliased dbus_message_h.DBusMessageIter; begin dbus_message_h.dbus_message_iter_recurse (arg1 => D_Args, arg2 => D_Sub_Args'Access); return Result : Variant_Type do Argument_List_Type (Result) := Deserialize (D_Args => D_Sub_Args'Access); end return; end Deserialize; ------------------------------------------------------------------------- function Get_Argument (Item : Variant_Type) return Argument_Type'Class is begin return Item.First_Element; end Get_Argument; ------------------------------------------------------------------------- function Get_Key (Item : Dict_Entry_Type) return Basic_Type'Class is begin return Basic_Type'Class (Item.First_Element); end Get_Key; ------------------------------------------------------------------------- function Get_Signature (Arg : Array_Type) return String is begin return Get_Tag (Arg => Argument_Type'Class (Arg)) & Arg.First_Element.Get_Signature; end Get_Signature; ------------------------------------------------------------------------- function Get_Signature (Arg : Struct_Type) return String is use Ada.Strings.Unbounded; Result : Unbounded_String; procedure Append_Sig (Arg : Argument_Type'Class); -- Append argument's signature to struct signature. procedure Append_Sig (Arg : Argument_Type'Class) is begin Result := Result & Arg.Get_Signature; end Append_Sig; begin Result := Result & "("; Arg.Iterate (Process => Append_Sig'Access); Result := Result & ")"; return To_String (Result); end Get_Signature; ------------------------------------------------------------------------- function Get_Signature (Arg : Dict_Entry_Type) return String is begin return "{" & Arg.First_Element.Get_Signature & Arg.Last_Element.Get_Signature & "}"; end Get_Signature; ------------------------------------------------------------------------- function Get_Signature (Arg : Variant_Type) return String is pragma Unreferenced (Arg); begin return "v"; end Get_Signature; ------------------------------------------------------------------------- function Get_Value (Item : Dict_Entry_Type) return Argument_Type'Class is begin return Item.Last_Element; end Get_Value; ------------------------------------------------------------------------- procedure Serialize (Args : Array_Type; D_Args : not null access dbus_message_h.DBusMessageIter) is begin if Args.Is_Empty then raise D_Bus_Error with "Serialization error: Array is empty"; end if; Serialize_Container (Args => Argument_List_Type (Args), Code => a, Signature => Args.First_Element.Get_Signature, D_Args => D_Args); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Args : Struct_Type; D_Args : not null access dbus_message_h.DBusMessageIter) is begin if Args.Is_Empty then raise D_Bus_Error with "Serialization error: Struct is empty"; end if; Serialize_Container (Args => Argument_List_Type (Args), Code => r, Signature => "", D_Args => D_Args); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Args : Dict_Entry_Type; D_Args : not null access dbus_message_h.DBusMessageIter) is begin if Args.Get_Count /= 2 then raise D_Bus_Error with "Serialization error: dict entry needs exactly two elements"; end if; Serialize_Container (Args => Argument_List_Type (Args), Code => e, Signature => "", D_Args => D_Args); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Args : Variant_Type; D_Args : not null access dbus_message_h.DBusMessageIter) is begin if Args.Get_Count /= 1 then raise D_Bus_Error with "Serialization error: variant contains no argument"; end if; Serialize_Container (Args => Argument_List_Type (Args), Code => v, Signature => Args.First_Element.Get_Signature, D_Args => D_Args); end Serialize; ------------------------------------------------------------------------- procedure Serialize_Container (Args : Argument_List_Type; Code : ASCII_Code; Signature : String := ""; D_Args : not null access dbus_message_h.DBusMessageIter) is use type dbus_types_h.dbus_bool_t; use type C.Strings.chars_ptr; C_Sig : C.Strings.chars_ptr := C.Strings.Null_Ptr; D_Sub_Args : aliased dbus_message_h.DBusMessageIter; D_Res : dbus_types_h.dbus_bool_t; begin if Signature'Length /= 0 then C_Sig := C.Strings.New_String (Str => Signature); end if; D_Res := dbus_message_h.dbus_message_iter_open_container (arg1 => D_Args, arg2 => C.int (Code_Table (Code)), arg3 => C_Sig, arg4 => D_Sub_Args'Access); if C_Sig /= C.Strings.Null_Ptr then C.Strings.Free (Item => C_Sig); end if; if D_Res = 0 then raise D_Bus_Error with "Unable to create D-Bus container"; end if; Args.Serialize (D_Args => D_Sub_Args'Access); D_Res := dbus_message_h.dbus_message_iter_close_container (arg1 => D_Args, arg2 => D_Sub_Args'Access); if D_Res = 0 then raise D_Bus_Error with "Unable to close D-Bus container"; end if; end Serialize_Container; ------------------------------------------------------------------------- function To_String (Arg : Array_Type) return String is use Ada.Strings.Unbounded; Result : Unbounded_String; procedure Append_String (Arg : Argument_Type'Class); -- Append argument's string representation to result string procedure Append_String (Arg : Argument_Type'Class) is begin Result := Result & " " & Arg.To_String; end Append_String; begin Result := Result & "["; Arg.Iterate (Process => Append_String'Access); Result := Result & " ]"; return To_String (Result); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Struct_Type) return String is use Ada.Strings.Unbounded; Result : Unbounded_String; procedure Append_String (Arg : Argument_Type'Class); -- Append argument's string representation to result string procedure Append_String (Arg : Argument_Type'Class) is begin Result := Result & " " & Arg.To_String; end Append_String; begin Result := Result & "("; Arg.Iterate (Process => Append_String'Access); Result := Result & " )"; return To_String (Result); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Dict_Entry_Type) return String is begin return "{ key:" & Arg.First_Element.To_String & ", value:" & Arg.Last_Element.To_String & " }"; end To_String; ------------------------------------------------------------------------- function To_String (Arg : Variant_Type) return String is Contained : Argument_Type'Class := Arg.Get_Argument; begin return Contained.Get_Tag & ", " & Contained.To_String; end To_String; end D_Bus.Arguments.Containers; libdbusada-0.2/src/d_bus-callbacks.ads0000644000175000017500000000303411672337633016431 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.Messages; package D_Bus.Callbacks is type Message_Callback is not null access procedure (Msg : Messages.Message_Type); -- Callback procedure. procedure Print (Msg : Messages.Message_Type); -- Print given D-Bus message to console. end D_Bus.Callbacks; libdbusada-0.2/src/d_bus-arguments-basic.ads0000644000175000017500000003105311672337633017600 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Unbounded; package D_Bus.Arguments.Basic is ------------ -- STRING -- ------------ type String_Type is new Basic_Type with private; -- D-Bus basic string argument. for String_Type'External_Tag use "s"; overriding procedure Serialize (Arg : String_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given string argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return String_Type; -- Create new string argument from low-level D-Bus message argument. overriding function To_String (Arg : String_Type) return String; -- Return string representation of argument. function "+" (Left : String) return String_Type; -- Create new string argument. function "+" (Left : String) return Argument_List_Type; -- Create new argument list and add given string to it. function "&" (Left : Argument_List_Type; Right : String) return Argument_List_Type; -- Add string to argument list. ------------- -- BOOLEAN -- ------------- type Boolean_Type is new Basic_Type with private; -- D-Bus basic boolean argument. for Boolean_Type'External_Tag use "b"; overriding procedure Serialize (Arg : Boolean_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given boolean argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Boolean_Type; -- Create new boolean argument from low-level D-Bus message argument. overriding function To_String (Arg : Boolean_Type) return String; -- Return string representation of boolean argument. function "+" (Left : Boolean) return Boolean_Type; -- Create new boolean argument. function "+" (Left : Boolean) return Argument_List_Type; -- Create new argument list and add given boolean argument to it. function "&" (Left : Argument_List_Type; Right : Boolean) return Argument_List_Type; -- Add boolean argument to argument list. function To_Ada (Arg : Boolean_Type) return Boolean; -- Convert D-Bus boolean argument to Ada type. ------------ -- UINT64 -- ------------ type U_Int64_Type is new Basic_Type with private; -- D-Bus 64-bit unsigned integer type. for U_Int64_Type'External_Tag use "t"; overriding procedure Serialize (Arg : U_Int64_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given uint64 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int64_Type; -- Create new uint64 argument from low-level D-Bus message argument. overriding function To_String (Arg : U_Int64_Type) return String; -- Return string representation of uint64 argument. function "+" (Left : Unsigned_64) return U_Int64_Type; -- Create new uint64 argument. function "+" (Left : Unsigned_64) return Argument_List_Type; -- Create new argument list and add given 64 bit unsigned number to it. function "&" (Left : Argument_List_Type; Right : Unsigned_64) return Argument_List_Type; -- Add 64 bit unsigned number argument to argument list. function To_Ada (Arg : U_Int64_Type) return Unsigned_64; -- Convert D-Bus UINT64 argument to Ada type. ----------- -- INT64 -- ----------- type Int64_Type is new Basic_Type with private; -- D-Bus 64-bit signed integer type. for Int64_Type'External_Tag use "x"; overriding procedure Serialize (Arg : Int64_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given int64 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int64_Type; -- Create new int64 argument from low-level D-Bus message argument. overriding function To_String (Arg : Int64_Type) return String; -- Return string representation of int64 argument. function "+" (Left : Signed_64) return Int64_Type; -- Create new int64 argument. function "+" (Left : Signed_64) return Argument_List_Type; -- Create new argument list and add given 64 bit signed number to it. function "&" (Left : Argument_List_Type; Right : Signed_64) return Argument_List_Type; -- Add 64 bit signed number argument to argument list. function To_Ada (Arg : Int64_Type) return Signed_64; -- Convert D-Bus INT64 argument to Ada type. ------------ -- UINT32 -- ------------ type U_Int32_Type is new Basic_Type with private; -- D-Bus 32-bit unsigned integer type. for U_Int32_Type'External_Tag use "u"; overriding procedure Serialize (Arg : U_Int32_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given uint32 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int32_Type; -- Create new uint32 argument from low-level D-Bus message argument. overriding function To_String (Arg : U_Int32_Type) return String; -- Return string representation of uint32 argument. function "+" (Left : Unsigned_32) return U_Int32_Type; -- Create new uint32 argument. function "+" (Left : Unsigned_32) return Argument_List_Type; -- Create new argument list and add given 32 bit unsigned number to it. function "&" (Left : Argument_List_Type; Right : Unsigned_32) return Argument_List_Type; -- Add 32 bit unsigned number argument to argument list. function To_Ada (Arg : U_Int32_Type) return Unsigned_32; -- Convert D-Bus UINT32 argument to Ada type. ----------- -- INT32 -- ----------- type Int32_Type is new Basic_Type with private; -- D-Bus 32-bit signed integer type. for Int32_Type'External_Tag use "i"; overriding procedure Serialize (Arg : Int32_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given int32 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int32_Type; -- Create new int32 argument from low-level D-Bus message argument. overriding function To_String (Arg : Int32_Type) return String; -- Return string representation of int32 argument. function "+" (Left : Signed_32) return Int32_Type; -- Create new int32 argument. function "+" (Left : Signed_32) return Argument_List_Type; -- Create new argument list and add given 32 bit signed number to it. function "&" (Left : Argument_List_Type; Right : Signed_32) return Argument_List_Type; -- Add 32 bit signed number argument to argument list. function To_Ada (Arg : Int32_Type) return Signed_32; -- Convert D-Bus INT32 argument to Ada type. ------------ -- UINT16 -- ------------ type U_Int16_Type is new Basic_Type with private; -- D-Bus 16-bit unsigned integer type. for U_Int16_Type'External_Tag use "q"; overriding procedure Serialize (Arg : U_Int16_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given uint16 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int16_Type; -- Create new uint16 argument from low-level D-Bus message argument. overriding function To_String (Arg : U_Int16_Type) return String; -- Return string representation of uint16 argument. function "+" (Left : Unsigned_16) return U_Int16_Type; -- Create new uint16 argument. function "+" (Left : Unsigned_16) return Argument_List_Type; -- Create new argument list and add given 16 bit unsigned number to it. function "&" (Left : Argument_List_Type; Right : Unsigned_16) return Argument_List_Type; -- Add 16 bit unsigned number argument to argument list. function To_Ada (Arg : U_Int16_Type) return Unsigned_16; -- Convert D-Bus UINT16 argument to Ada type. ----------- -- INT16 -- ----------- type Int16_Type is new Basic_Type with private; -- D-Bus 16-bit signed integer type. for Int16_Type'External_Tag use "n"; overriding procedure Serialize (Arg : Int16_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given int16 argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int16_Type; -- Create new int16 argument from low-level D-Bus message argument. overriding function To_String (Arg : Int16_Type) return String; -- Return string representation of int16 argument. function "+" (Left : Signed_16) return Int16_Type; -- Create new int16 argument. function "+" (Left : Signed_16) return Argument_List_Type; -- Create new argument list and add given 16 bit signed number to it. function "&" (Left : Argument_List_Type; Right : Signed_16) return Argument_List_Type; -- Add 16 bit signed number argument to argument list. function To_Ada (Arg : Int16_Type) return Signed_16; -- Convert D-Bus INT16 argument to Ada type. ---------- -- BYTE -- ---------- type Byte_Type is new Basic_Type with private; -- D-Bus 8-bit unsigned integer type. for Byte_Type'External_Tag use "y"; overriding procedure Serialize (Arg : Byte_Type; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize given byte argument to D-Bus argument. overriding function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Byte_Type; -- Create new byte argument from low-level D-Bus message argument. overriding function To_String (Arg : Byte_Type) return String; -- Return string representation of byte argument. function "+" (Left : Byte) return Byte_Type; -- Create new byte argument. function "+" (Left : Byte) return Argument_List_Type; -- Create new argument list and add given byte to it. function "&" (Left : Argument_List_Type; Right : Byte) return Argument_List_Type; -- Add byte to argument list. function To_Ada (Arg : Byte_Type) return Byte; -- Convert D-Bus byte argument to Ada type. private type String_Type is new Basic_Type with record Value : Ada.Strings.Unbounded.Unbounded_String; end record; type Boolean_Type is new Basic_Type with record Value : Boolean := False; end record; type U_Int64_Type is new Basic_Type with record Value : Unsigned_64 := 0; end record; type Int64_Type is new Basic_Type with record Value : Signed_64 := 0; end record; type U_Int32_Type is new Basic_Type with record Value : Unsigned_32 := 0; end record; type Int32_Type is new Basic_Type with record Value : Signed_32 := 0; end record; type U_Int16_Type is new Basic_Type with record Value : Unsigned_16 := 0; end record; type Int16_Type is new Basic_Type with record Value : Signed_16 := 0; end record; type Byte_Type is new Basic_Type with record Value : Byte := 0; end record; end D_Bus.Arguments.Basic; libdbusada-0.2/src/d_bus-arguments-basic.adb0000644000175000017500000005300511672337633017560 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Fixed; with System; with Interfaces.C.Strings; with dbus_types_h; with dbus_arch_deps_h; package body D_Bus.Arguments.Basic is package C renames Interfaces.C; procedure Serialize (Code : Integer; Arg_Name : String; Address : System.Address; D_Arg : not null access dbus_message_h.DBusMessageIter); -- Serialize argument at address with given code to low-level D-Bus message -- position. procedure Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter; Address : System.Address); -- Deserialize argument from low-level D-Bus message to given address. function Trim (Source : String; Side : Ada.Strings.Trim_End := Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim; -- Convenience function to trim a basic argument string representation. ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : String) return Argument_List_Type is use Ada.Strings.Unbounded; Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Boolean) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Unsigned_64) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Signed_64) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Unsigned_32) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Signed_32) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Unsigned_16) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Signed_16) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "&" (Left : Argument_List_Type; Right : Byte) return Argument_List_Type is Arg_List : Argument_List_Type; begin Arg_List := Left; Arg_List.Data.Append (New_Item => +Right); return Arg_List; end "&"; ------------------------------------------------------------------------- function "+" (Left : String) return String_Type is use Ada.Strings.Unbounded; begin return String_Type' (Value => To_Unbounded_String (Source => Left)); end "+"; ------------------------------------------------------------------------- function "+" (Left : Boolean) return Boolean_Type is begin return Boolean_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_64) return U_Int64_Type is begin return U_Int64_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_64) return Int64_Type is begin return Int64_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_32) return U_Int32_Type is begin return U_Int32_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_32) return Int32_Type is begin return Int32_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_16) return U_Int16_Type is begin return U_Int16_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_16) return Int16_Type is begin return Int16_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Byte) return Byte_Type is begin return Byte_Type'(Value => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : String) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Boolean) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_64) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_64) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_32) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_32) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Unsigned_16) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Signed_16) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function "+" (Left : Byte) return Argument_List_Type is Arg_List : Argument_List_Type; begin return "&" (Left => Arg_List, Right => Left); end "+"; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return String_Type is use Ada.Strings.Unbounded; New_String : String_Type; D_String : C.Strings.chars_ptr; begin Deserialize (D_Arg => D_Arg, Address => D_String'Address); New_String.Value := To_Unbounded_String (Source => C.Strings.Value (Item => D_String)); return New_String; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Boolean_Type is use type dbus_types_h.dbus_bool_t; New_Bool : Boolean_Type; D_Bool : dbus_types_h.dbus_bool_t; begin Deserialize (D_Arg => D_Arg, Address => D_Bool'Address); New_Bool.Value := not (D_Bool = 0); return New_Bool; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int64_Type is New_U_Int64 : U_Int64_Type; D_U_Int64 : dbus_arch_deps_h.dbus_uint64_t; begin Deserialize (D_Arg => D_Arg, Address => D_U_Int64'Address); New_U_Int64.Value := Unsigned_64 (D_U_Int64); return New_U_Int64; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int64_Type is New_Int64 : Int64_Type; D_Int64 : dbus_arch_deps_h.dbus_int64_t; begin Deserialize (D_Arg => D_Arg, Address => D_Int64'Address); New_Int64.Value := Signed_64 (D_Int64); return New_Int64; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int32_Type is New_U_Int32 : U_Int32_Type; D_U_Int32 : dbus_arch_deps_h.dbus_uint32_t; begin Deserialize (D_Arg => D_Arg, Address => D_U_Int32'Address); New_U_Int32.Value := Unsigned_32 (D_U_Int32); return New_U_Int32; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int32_Type is New_Int32 : Int32_Type; D_Int32 : dbus_arch_deps_h.dbus_int32_t; begin Deserialize (D_Arg => D_Arg, Address => D_Int32'Address); New_Int32.Value := Signed_32 (D_Int32); return New_Int32; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return U_Int16_Type is New_U_Int16 : U_Int16_Type; D_U_Int16 : dbus_arch_deps_h.dbus_uint16_t; begin Deserialize (D_Arg => D_Arg, Address => D_U_Int16'Address); New_U_Int16.Value := Unsigned_16 (D_U_Int16); return New_U_Int16; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Int16_Type is New_Int16 : Int16_Type; D_Int16 : dbus_arch_deps_h.dbus_int16_t; begin Deserialize (D_Arg => D_Arg, Address => D_Int16'Address); New_Int16.Value := Signed_16 (D_Int16); return New_Int16; end Deserialize; ------------------------------------------------------------------------- function Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter) return Byte_Type is New_Byte : Byte_Type; begin Deserialize (D_Arg => D_Arg, Address => New_Byte.Value'Address); return New_Byte; end Deserialize; ------------------------------------------------------------------------- procedure Deserialize (D_Arg : not null access dbus_message_h.DBusMessageIter; Address : System.Address) is begin dbus_message_h.dbus_message_iter_get_basic (arg1 => D_Arg, arg2 => Address); end Deserialize; ------------------------------------------------------------------------- procedure Serialize (Code : Integer; Arg_Name : String; Address : System.Address; D_Arg : not null access dbus_message_h.DBusMessageIter) is use type dbus_types_h.dbus_bool_t; D_Res : dbus_types_h.dbus_bool_t; begin D_Res := dbus_message_h.dbus_message_iter_append_basic (arg1 => D_Arg, arg2 => C.int (Code), arg3 => Address); if D_Res = 0 then raise D_Bus_Error with "Unable to append basic " & Arg_Name & " argument"; end if; end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : String_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is D_Value : C.Strings.chars_ptr := C.Strings.New_String (Str => Arg.To_String); begin Serialize (Code => Arg.Get_Code, Arg_Name => "string", Address => D_Value'Address, D_Arg => D_Arg); C.Strings.Free (Item => D_Value); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : Boolean_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is D_Value : dbus_types_h.dbus_bool_t := Boolean'Pos (Arg.Value); begin Serialize (Code => Arg.Get_Code, Arg_Name => "boolean", Address => D_Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : U_Int64_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "uint64", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : Int64_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "int64", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : U_Int32_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "uint32", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : Int32_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "int32", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : U_Int16_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "uint16", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : Int16_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "int16", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- procedure Serialize (Arg : Byte_Type; D_Arg : not null access dbus_message_h.DBusMessageIter) is begin Serialize (Code => Arg.Get_Code, Arg_Name => "byte", Address => Arg.Value'Address, D_Arg => D_Arg); end Serialize; ------------------------------------------------------------------------- function To_Ada (Arg : Boolean_Type) return Boolean is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : U_Int64_Type) return Unsigned_64 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : U_Int32_Type) return Unsigned_32 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : Int64_Type) return Signed_64 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : Int32_Type) return Signed_32 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : U_Int16_Type) return Unsigned_16 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : Int16_Type) return Signed_16 is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_Ada (Arg : Byte_Type) return Byte is begin return Arg.Value; end To_Ada; ------------------------------------------------------------------------- function To_String (Arg : String_Type) return String is begin return Ada.Strings.Unbounded.To_String (Source => Arg.Value); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Boolean_Type) return String is begin return Arg.Value'Img; end To_String; ------------------------------------------------------------------------- function To_String (Arg : U_Int64_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Int64_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : U_Int32_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Int32_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : U_Int16_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Int16_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; ------------------------------------------------------------------------- function To_String (Arg : Byte_Type) return String is begin return Trim (Source => Arg.Value'Img); end To_String; end D_Bus.Arguments.Basic; libdbusada-0.2/src/d_bus-connection-g_main.ads0000644000175000017500000000423311672337633020103 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Unbounded; with Ada.Containers.Indefinite_Ordered_Maps; with D_Bus.Service; package D_Bus.Connection.G_Main is procedure Setup_With_G_Main (Connection : in out Connection_Type); -- Integrate the given connection with the GLib main loop. procedure Register_Object (Connection : Connection_Type; Path : String := "/"; Object : in out Service.Object'Class); -- Register given service object on specified path. This procedure also -- takes care about object initialization. private use Ada.Strings.Unbounded; use D_Bus.Service; package Service_Obj_Map_Package is new Ada.Containers.Indefinite_Ordered_Maps (Key_Type => Unbounded_String, Element_Type => Object'Class); package SOMP renames Service_Obj_Map_Package; Services : SOMP.Map; -- All registered service objects. end D_Bus.Connection.G_Main; libdbusada-0.2/src/d_bus-messages.adb0000644000175000017500000001662311672337633016310 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Interfaces.C.Strings; with dbus_types_h; with dbus_message_h; package body D_Bus.Messages is use dbus_message_h; use type Interfaces.C.Strings.chars_ptr; package C renames Interfaces.C; function Value_Or_Empty (Ptr : C.Strings.chars_ptr) return String; -- Returns empty string if the given pointer is a null pointer, if not the -- function returns the corresponding string value. ------------------------------------------------------------------------- procedure Add_Arguments (Msg : in out Message_Type; Args : Arguments.Argument_List_Type) is D_Args : aliased DBusMessageIter; begin dbus_message_iter_init_append (arg1 => Msg.Thin_Msg, arg2 => D_Args'Access); Arguments.Serialize (Args => Args, D_Args => D_Args'Access); end Add_Arguments; ------------------------------------------------------------------------- function Create (D_Msg : System.Address) return Message_Type is begin return M : Message_Type do M.Thin_Msg := D_Msg; end return; end Create; ------------------------------------------------------------------------- function Get_Arguments (Msg : Message_Type) return Arguments.Argument_List_Type is use type dbus_types_h.dbus_bool_t; D_Args : aliased dbus_message_h.DBusMessageIter; Args : Arguments.Argument_List_Type; begin if dbus_message_h.dbus_message_iter_init (arg1 => Msg.Thin_Msg, arg2 => D_Args'Access) = 1 then Args := Arguments.Deserialize (D_Args'Access); end if; return Args; end Get_Arguments; ------------------------------------------------------------------------- function Get_Destination (Msg : Message_Type) return String is C_Dest : constant C.Strings.chars_ptr := dbus_message_get_destination (arg1 => Msg.Thin_Msg); begin return Value_Or_Empty (Ptr => C_Dest); end Get_Destination; ------------------------------------------------------------------------- function Get_Interface (Msg : Message_Type) return String is C_Iface : constant C.Strings.chars_ptr := dbus_message_get_interface (arg1 => Msg.Thin_Msg); begin return Value_Or_Empty (Ptr => C_Iface); end Get_Interface; ------------------------------------------------------------------------- function Get_Member (Msg : Message_Type) return String is C_Member : constant C.Strings.chars_ptr := dbus_message_get_member (arg1 => Msg.Thin_Msg); begin return Value_Or_Empty (Ptr => C_Member); end Get_Member; ------------------------------------------------------------------------- function Get_Path (Msg : Message_Type) return String is C_Path : constant C.Strings.chars_ptr := dbus_message_get_path (arg1 => Msg.Thin_Msg); begin return Value_Or_Empty (Ptr => C_Path); end Get_Path; ------------------------------------------------------------------------- function Get_Sender (Msg : Message_Type) return String is C_Sender : constant C.Strings.chars_ptr := dbus_message_get_sender (arg1 => Msg.Thin_Msg); begin return Value_Or_Empty (Ptr => C_Sender); end Get_Sender; ------------------------------------------------------------------------ function Get_Serial (Msg : Message_Type) return Positive is begin return Positive (dbus_message_get_serial (arg1 => Msg.Thin_Msg)); exception when Constraint_Error => raise D_Bus_Error with "Message has an invalid serial number"; end Get_Serial; ------------------------------------------------------------------------- function Get_Type (Msg : Message_Type) return Message_Variant is begin return Message_Variant'Val (dbus_message_get_type (arg1 => Msg.Thin_Msg)); exception when Constraint_Error => raise D_Bus_Error with "Message has an invalid type"; end Get_Type; ------------------------------------------------------------------------- function Is_Method_Call (Msg : Message_Type; Iface : String; Method : String) return Boolean is begin return Get_Interface (Msg) = Iface and then Get_Member (Msg) = Method; end Is_Method_Call; ------------------------------------------------------------------------- function New_Error (Reply_To : Message_Type; Error_Name : String; Error_Message : String) return Message_Type is use type System.Address; Error : Message_Type; C_Name : C.Strings.chars_ptr := C.Strings.New_String (Str => Error_Name); C_Msg : C.Strings.chars_ptr := C.Strings.New_String (Str => Error_Message); begin Error.Thin_Msg := dbus_message_new_error (arg1 => Reply_To.Thin_Msg, arg2 => C_Name, arg3 => C_Msg); C.Strings.Free (Item => C_Name); C.Strings.Free (Item => C_Msg); if Error.Thin_Msg = System.Null_Address then raise D_Bus_Error with "Could not create error reply"; end if; return Error; end New_Error; ------------------------------------------------------------------------- function New_Method_Return (Method_Call : Message_Type) return Message_Type is use type System.Address; Reply : Message_Type; begin Reply.Thin_Msg := dbus_message_new_method_return (arg1 => Method_Call.Thin_Msg); if Reply.Thin_Msg = System.Null_Address then raise D_Bus_Error with "Could not create method reply message"; end if; return Reply; end New_Method_Return; ------------------------------------------------------------------------- function To_Thin (Msg : Message_Type) return System.Address is begin return Msg.Thin_Msg; end To_Thin; ------------------------------------------------------------------------- function Value_Or_Empty (Ptr : C.Strings.chars_ptr) return String is begin if Ptr = C.Strings.Null_Ptr then return ""; end if; return C.Strings.Value (Item => Ptr); end Value_Or_Empty; end D_Bus.Messages; libdbusada-0.2/src/d_bus.ads0000644000175000017500000000414111672337633014514 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- package D_Bus is type Bus_Type is (Bus_Session, Bus_System, Bus_Starter); -- D-Bus bus types. type Byte is mod 2 ** 8; for Byte'Size use 8; -- One byte. type Unsigned_16 is mod 2 ** 16; for Unsigned_16'Size use 16; -- 16 bit unsigned number. type Signed_16 is range -2 ** 15 .. 2 ** 15 - 1; for Signed_16'Size use 16; -- 16 bit signed number. type Unsigned_32 is mod 2 ** 32; for Unsigned_32'Size use 32; -- 32 bit unsigned number. type Signed_32 is range -2 ** 31 .. 2 ** 31 - 1; for Signed_32'Size use 32; -- 32 bit signed number. type Unsigned_64 is mod 2 ** 64; for Unsigned_64'Size use 64; -- 64 bit unsigned number. type Signed_64 is range -2 ** 63 .. 2 ** 63 - 1; for Signed_64'Size use 64; -- 64 bit signed number. D_Bus_Error : exception; end D_Bus; libdbusada-0.2/src/d_bus-service.adb0000644000175000017500000000451211672337633016133 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- package body D_Bus.Service is ------------------------------------------------------------------------- procedure Call (Obj : Object; Name : String; Request : Messages.Message_Type; Reply : out Messages.Message_Type) is Method : Method_Handle; begin Method := Obj.Methods.Element (Key => To_Unbounded_String (Name)); Method (Request => Request, Reply => Reply); exception when Constraint_Error => raise Unknown_Method with "Method '" & Name & "' is not registered"; end Call; ------------------------------------------------------------------------- procedure Register (Obj : in out Object; Name : String; Method : Method_Handle) is begin Obj.Methods.Insert (Key => To_Unbounded_String (Name), New_Item => Method); exception when Constraint_Error => raise Duplicate_Method with "Method '" & Name & "' is already" & " registered"; end Register; end D_Bus.Service; libdbusada-0.2/src/d_bus-marshaling.ads0000644000175000017500000000421211672337633016636 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Tags.Generic_Dispatching_Constructor; with dbus_message_h; package D_Bus.Marshaling is type Object is interface; -- Serializable object interface. Objects which are serialized to or -- deserialized from D-Bus messages must implement this interface. procedure Serialize (Obj : Object; D_Msg : not null access dbus_message_h.DBusMessageIter) is abstract; -- Serialize given Ada object to low-level D-Bus message iterator. function Deserialize (D_Msg : not null access dbus_message_h.DBusMessageIter) return Object is abstract; -- Create new Ada object from low-level D-Bus message iterator. function Make_Object is new Ada.Tags.Generic_Dispatching_Constructor (T => Object, Parameters => dbus_message_h.DBusMessageIter, Constructor => Deserialize); -- Object dispatching function. end D_Bus.Marshaling; libdbusada-0.2/src/d_bus-callbacks.adb0000644000175000017500000000517111672337633016414 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Text_IO; with D_Bus.Arguments; package body D_Bus.Callbacks is ------------------------------------------------------------------------- procedure Print (Msg : Messages.Message_Type) is use D_Bus.Messages; begin Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line ("--"); Ada.Text_IO.Put_Line ("Type : " & Get_Type (Msg)'Img); Ada.Text_IO.Put_Line ("Serial :" & Get_Serial (Msg)'Img); Ada.Text_IO.Put_Line ("Sender : " & Get_Sender (Msg)); Ada.Text_IO.Put_Line ("Dest : " & Get_Destination (Msg)); Ada.Text_IO.Put_Line ("Path : " & Get_Path (Msg)); Ada.Text_IO.Put_Line ("Iface : " & Get_Interface (Msg)); Ada.Text_IO.Put_Line ("Member : " & Get_Member (Msg)); Ada.Text_IO.Put_Line ("Args : "); declare procedure Print (Argument : Arguments.Argument_Type'Class); -- Print out argument code and string representation. procedure Print (Argument : Arguments.Argument_Type'Class) is begin Ada.Text_IO.Set_Col (To => 1); Ada.Text_IO.Put ("(" & Argument.Get_Code'Img & " )"); Ada.Text_IO.Set_Col (To => 10); Ada.Text_IO.Put_Line (Argument.To_String); end Print; begin Messages.Get_Arguments (Msg).Iterate (Process => Print'Access); end; end Print; end D_Bus.Callbacks; libdbusada-0.2/src/d_bus-arguments-containers.ads0000644000175000017500000001471211672337633020667 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- package D_Bus.Arguments.Containers is ----------- -- ARRAY -- ----------- type Array_Type is new Argument_List_Type and Argument_Type with private; -- D-Bus array container. for Array_Type'External_Tag use "a"; overriding procedure Serialize (Args : Array_Type; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialize array to D-Bus arguments. overriding function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Array_Type; -- Create new array from low-level D-Bus message argument. overriding function Get_Signature (Arg : Array_Type) return String; -- Return the array argument's signature. overriding function To_String (Arg : Array_Type) return String; -- Return string representation of array elements. overriding procedure Append (List : in out Array_Type; New_Item : Argument_Type'Class); -- Append argument to array. function "+" (Left : Array_Type) return Argument_List_Type; -- Create new argument list and add given array to it. function "&" (Left : Argument_List_Type; Right : Array_Type) return Argument_List_Type; -- Add array to argument list. ------------ -- STRUCT -- ------------ type Struct_Type is new Argument_List_Type and Argument_Type with private; -- D-Bus struct. for Struct_Type'External_Tag use "r"; overriding procedure Serialize (Args : Struct_Type; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialize struct to D-Bus arguments. overriding function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Struct_Type; -- Create new struct from low-level D-Bus message argument. overriding function Get_Signature (Arg : Struct_Type) return String; -- Return the struct argument's signature. overriding function To_String (Arg : Struct_Type) return String; -- Return string representation of struct. function "+" (Left : Struct_Type) return Argument_List_Type; -- Create new argument list and add given struct to it. function "&" (Left : Argument_List_Type; Right : Struct_Type) return Argument_List_Type; -- Add struct to argument list. ---------------- -- DICT_ENTRY -- ---------------- type Dict_Entry_Type is new Argument_Type with private; -- Dict entry. for Dict_Entry_Type'External_Tag use "e"; overriding procedure Serialize (Args : Dict_Entry_Type; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialize dict entry to D-Bus arguments. overriding function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Dict_Entry_Type; -- Create new dict entry from low-level D-Bus message argument. overriding function Get_Signature (Arg : Dict_Entry_Type) return String; -- Return the dict entry argument's signature. overriding function To_String (Arg : Dict_Entry_Type) return String; -- Return string representation of dict entry. function Create (Key : Basic_Type'Class; Value : Argument_Type'Class) return Dict_Entry_Type; -- Create a new dict entry with given key/value. function Get_Key (Item : Dict_Entry_Type) return Basic_Type'Class; -- Return key element of the dict entry. function Get_Value (Item : Dict_Entry_Type) return Argument_Type'Class; -- Return value argument of the dict entry. ------------- -- VARIANT -- ------------- type Variant_Type is new Argument_Type with private; -- D-Bus variant. for Variant_Type'External_Tag use "v"; overriding procedure Serialize (Args : Variant_Type; D_Args : not null access dbus_message_h.DBusMessageIter); -- Serialize variant to D-Bus arguments. overriding function Deserialize (D_Args : not null access dbus_message_h.DBusMessageIter) return Variant_Type; -- Create new variant from low-level D-Bus message argument. overriding function Get_Signature (Arg : Variant_Type) return String; -- Return the variant's signature. overriding function To_String (Arg : Variant_Type) return String; -- Return the string representation of variant. function "+" (Left : Variant_Type) return Argument_List_Type; -- Create a new argument list and add given variant to it. function "&" (Left : Argument_List_Type; Right : Variant_Type) return Argument_List_Type; -- Add variant to argument list. function Create (Source : Argument_Type'Class) return Variant_Type; -- Create a new variant using the given argument as source. function Get_Argument (Item : Variant_Type) return Argument_Type'Class; -- Return the argument inside the variant. private type Array_Type is new Argument_List_Type and Argument_Type with record Code : Natural := 0; end record; type Struct_Type is new Argument_List_Type and Argument_Type with null record; type Dict_Entry_Type is new Argument_List_Type and Argument_Type with null record; type Variant_Type is new Argument_List_Type and Argument_Type with null record; end D_Bus.Arguments.Containers; libdbusada-0.2/thin/0000755000175000017500000000000011672337633013102 5ustar reetreetlibdbusada-0.2/thin/dbus_memory_h.ads0000644000175000017500000000242611672337633016433 0ustar reetreetwith Interfaces.C; use Interfaces.C; with stddef_h; with System; package dbus_memory_h is -- unsupported macro: dbus_new(type,count) ((type*)dbus_malloc (sizeof (type) * (count))); -- unsupported macro: dbus_new0(type,count) ((type*)dbus_malloc0 (sizeof (type) * (count))); function dbus_malloc (arg1 : stddef_h.size_t) return System.Address; -- ../dbus/dbus-memory.h:40:7 pragma Import (C, dbus_malloc, "dbus_malloc"); function dbus_malloc0 (arg1 : stddef_h.size_t) return System.Address; -- ../dbus/dbus-memory.h:41:7 pragma Import (C, dbus_malloc0, "dbus_malloc0"); function dbus_realloc (arg1 : System.Address; arg2 : stddef_h.size_t) return System.Address; -- ../dbus/dbus-memory.h:42:7 pragma Import (C, dbus_realloc, "dbus_realloc"); procedure dbus_free (arg1 : System.Address); -- ../dbus/dbus-memory.h:44:7 pragma Import (C, dbus_free, "dbus_free"); procedure dbus_free_string_array (arg1 : System.Address); -- ../dbus/dbus-memory.h:49:6 pragma Import (C, dbus_free_string_array, "dbus_free_string_array"); type DBusFreeFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-memory.h:51:17 procedure dbus_shutdown; -- ../dbus/dbus-memory.h:53:6 pragma Import (C, dbus_shutdown, "dbus_shutdown"); end dbus_memory_h; libdbusada-0.2/thin/dbus_signature_h.ads0000644000175000017500000000615711672337633017131 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with dbus_arch_deps_h; with Interfaces.C.Strings; with dbus_types_h; limited with dbus_errors_h; package dbus_signature_h is type DBusSignatureIter is record dummy1 : System.Address; -- ../dbus/dbus-signature.h:46:9 dummy2 : System.Address; -- ../dbus/dbus-signature.h:47:9 dummy8 : aliased dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-signature.h:48:17 dummy12 : aliased int; -- ../dbus/dbus-signature.h:49:7 dummy17 : aliased int; -- ../dbus/dbus-signature.h:50:7 end record; pragma Convention (C_Pass_By_Copy, DBusSignatureIter); -- ../dbus/dbus-signature.h:51:3 procedure dbus_signature_iter_init (arg1 : access DBusSignatureIter; arg2 : Interfaces.C.Strings.chars_ptr); -- ../dbus/dbus-signature.h:53:17 pragma Import (C, dbus_signature_iter_init, "dbus_signature_iter_init"); function dbus_signature_iter_get_current_type (arg1 : access constant DBusSignatureIter) return int; -- ../dbus/dbus-signature.h:56:17 pragma Import (C, dbus_signature_iter_get_current_type, "dbus_signature_iter_get_current_type"); function dbus_signature_iter_get_signature (arg1 : access constant DBusSignatureIter) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-signature.h:58:17 pragma Import (C, dbus_signature_iter_get_signature, "dbus_signature_iter_get_signature"); function dbus_signature_iter_get_element_type (arg1 : access constant DBusSignatureIter) return int; -- ../dbus/dbus-signature.h:60:17 pragma Import (C, dbus_signature_iter_get_element_type, "dbus_signature_iter_get_element_type"); function dbus_signature_iter_next (arg1 : access DBusSignatureIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:62:17 pragma Import (C, dbus_signature_iter_next, "dbus_signature_iter_next"); procedure dbus_signature_iter_recurse (arg1 : access constant DBusSignatureIter; arg2 : access DBusSignatureIter); -- ../dbus/dbus-signature.h:64:17 pragma Import (C, dbus_signature_iter_recurse, "dbus_signature_iter_recurse"); function dbus_signature_validate (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:67:17 pragma Import (C, dbus_signature_validate, "dbus_signature_validate"); function dbus_signature_validate_single (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:70:17 pragma Import (C, dbus_signature_validate_single, "dbus_signature_validate_single"); function dbus_type_is_basic (arg1 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:73:17 pragma Import (C, dbus_type_is_basic, "dbus_type_is_basic"); function dbus_type_is_container (arg1 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:74:17 pragma Import (C, dbus_type_is_container, "dbus_type_is_container"); function dbus_type_is_fixed (arg1 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-signature.h:75:17 pragma Import (C, dbus_type_is_fixed, "dbus_type_is_fixed"); end dbus_signature_h; libdbusada-0.2/thin/dbus_arch_deps_h.ads0000644000175000017500000000242711672337633017054 0ustar reetreetwith Interfaces.C; use Interfaces.C; with Interfaces.C.Extensions; package dbus_arch_deps_h is DBUS_HAVE_INT64 : constant := 1; -- ../dbus/dbus-arch-deps.h:35 -- unsupported macro: DBUS_INT64_CONSTANT(val) (_DBUS_GNUC_EXTENSION (val ##LL)) -- unsupported macro: DBUS_UINT64_CONSTANT(val) (_DBUS_GNUC_EXTENSION (val ##ULL)) DBUS_MAJOR_VERSION : constant := 1; -- ../dbus/dbus-arch-deps.h:57 DBUS_MINOR_VERSION : constant := 2; -- ../dbus/dbus-arch-deps.h:58 DBUS_MICRO_VERSION : constant := 16; -- ../dbus/dbus-arch-deps.h:59 DBUS_VERSION_STRING : aliased constant String := "1.2.16" & ASCII.NUL; -- ../dbus/dbus-arch-deps.h:61 type Version_Mod is mod 2 ** 16; DBUS_VERSION : constant Version_Mod := ((2 ** 16) or (2 ** 8) or (16)); -- ../dbus/dbus-arch-deps.h:63 subtype dbus_int64_t is Long_Long_Integer; -- ../dbus/dbus-arch-deps.h:36:40 subtype dbus_uint64_t is Extensions.unsigned_long_long; -- ../dbus/dbus-arch-deps.h:37:49 subtype dbus_int32_t is int; -- ../dbus/dbus-arch-deps.h:48:13 subtype dbus_uint32_t is unsigned; -- ../dbus/dbus-arch-deps.h:49:22 subtype dbus_int16_t is short; -- ../dbus/dbus-arch-deps.h:51:15 subtype dbus_uint16_t is unsigned_short; -- ../dbus/dbus-arch-deps.h:52:24 end dbus_arch_deps_h; libdbusada-0.2/thin/dbus_bus_h.ads0000644000175000017500000000674211672337633015721 0ustar reetreetwith Interfaces.C; use Interfaces.C; with dbus_shared_h; limited with dbus_errors_h; with System; with dbus_types_h; with Interfaces.C.Strings; with dbus_arch_deps_h; package dbus_bus_h is function dbus_bus_get (arg1 : dbus_shared_h.DBusBusType; arg2 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-bus.h:39:17 pragma Import (C, dbus_bus_get, "dbus_bus_get"); function dbus_bus_get_private (arg1 : dbus_shared_h.DBusBusType; arg2 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-bus.h:41:17 pragma Import (C, dbus_bus_get_private, "dbus_bus_get_private"); function dbus_bus_register (arg1 : System.Address; arg2 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-bus.h:44:17 pragma Import (C, dbus_bus_register, "dbus_bus_register"); function dbus_bus_set_unique_name (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-bus.h:46:17 pragma Import (C, dbus_bus_set_unique_name, "dbus_bus_set_unique_name"); function dbus_bus_get_unique_name (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-bus.h:48:17 pragma Import (C, dbus_bus_get_unique_name, "dbus_bus_get_unique_name"); function dbus_bus_get_unix_user (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access dbus_errors_h.DBusError) return unsigned_long; -- ../dbus/dbus-bus.h:49:17 pragma Import (C, dbus_bus_get_unix_user, "dbus_bus_get_unix_user"); function dbus_bus_get_id (arg1 : System.Address; arg2 : access dbus_errors_h.DBusError) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-bus.h:52:17 pragma Import (C, dbus_bus_get_id, "dbus_bus_get_id"); function dbus_bus_request_name (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : unsigned; arg4 : access dbus_errors_h.DBusError) return int; -- ../dbus/dbus-bus.h:54:17 pragma Import (C, dbus_bus_request_name, "dbus_bus_request_name"); function dbus_bus_release_name (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access dbus_errors_h.DBusError) return int; -- ../dbus/dbus-bus.h:58:17 pragma Import (C, dbus_bus_release_name, "dbus_bus_release_name"); function dbus_bus_name_has_owner (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-bus.h:61:17 pragma Import (C, dbus_bus_name_has_owner, "dbus_bus_name_has_owner"); function dbus_bus_start_service_by_name (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : dbus_arch_deps_h.dbus_uint32_t; arg4 : access dbus_arch_deps_h.dbus_uint32_t; arg5 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-bus.h:65:17 pragma Import (C, dbus_bus_start_service_by_name, "dbus_bus_start_service_by_name"); procedure dbus_bus_add_match (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access dbus_errors_h.DBusError); -- ../dbus/dbus-bus.h:71:17 pragma Import (C, dbus_bus_add_match, "dbus_bus_add_match"); procedure dbus_bus_remove_match (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access dbus_errors_h.DBusError); -- ../dbus/dbus-bus.h:74:17 pragma Import (C, dbus_bus_remove_match, "dbus_bus_remove_match"); end dbus_bus_h; libdbusada-0.2/thin/dbus_misc_h.ads0000644000175000017500000000075111672337633016055 0ustar reetreetwith Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; package dbus_misc_h is function dbus_get_local_machine_id return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-misc.h:40:13 pragma Import (C, dbus_get_local_machine_id, "dbus_get_local_machine_id"); procedure dbus_get_version (arg1 : access int; arg2 : access int; arg3 : access int); -- ../dbus/dbus-misc.h:42:13 pragma Import (C, dbus_get_version, "dbus_get_version"); end dbus_misc_h; libdbusada-0.2/thin/dbus_connection_h.ads0000644000175000017500000005652311672337633017271 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with dbus_types_h; with Interfaces.C.Strings; with dbus_shared_h; limited with dbus_errors_h; with dbus_arch_deps_h; package dbus_connection_h is -- skipped empty struct DBusWatch -- skipped empty struct DBusTimeout -- skipped empty struct DBusPreallocatedSend -- skipped empty struct DBusPendingCall -- skipped empty struct DBusConnection subtype DBusWatchFlags is unsigned; DBUS_WATCH_READABLE : constant DBusWatchFlags := 1; DBUS_WATCH_WRITABLE : constant DBusWatchFlags := 2; DBUS_WATCH_ERROR : constant DBusWatchFlags := 4; DBUS_WATCH_HANGUP : constant DBusWatchFlags := 8; -- ../dbus/dbus-connection.h:72:3 subtype DBusDispatchStatus is unsigned; DBUS_DISPATCH_DATA_REMAINS : constant DBusDispatchStatus := 0; DBUS_DISPATCH_COMPLETE : constant DBusDispatchStatus := 1; DBUS_DISPATCH_NEED_MEMORY : constant DBusDispatchStatus := 2; -- ../dbus/dbus-connection.h:83:3 type DBusAddWatchFunction is access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:90:24 type DBusWatchToggledFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:96:24 type DBusRemoveWatchFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:102:24 type DBusAddTimeoutFunction is access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:109:24 type DBusTimeoutToggledFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:116:24 type DBusRemoveTimeoutFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:122:24 type DBusDispatchStatusFunction is access procedure (arg1 : System.Address; arg2 : DBusDispatchStatus; arg3 : System.Address); -- ../dbus/dbus-connection.h:127:24 type DBusWakeupMainFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-connection.h:134:24 type DBusAllowUnixUserFunction is access function (arg1 : System.Address; arg2 : unsigned_long; arg3 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:142:24 type DBusAllowWindowsUserFunction is access function (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:152:24 type DBusPendingCallNotifyFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:161:17 type DBusHandleMessageFunction is access function (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address) return dbus_shared_h.DBusHandlerResult; -- ../dbus/dbus-connection.h:168:30 function dbus_connection_open (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-connection.h:172:20 pragma Import (C, dbus_connection_open, "dbus_connection_open"); function dbus_connection_open_private (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-connection.h:174:20 pragma Import (C, dbus_connection_open_private, "dbus_connection_open_private"); function dbus_connection_ref (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:176:20 pragma Import (C, dbus_connection_ref, "dbus_connection_ref"); procedure dbus_connection_unref (arg1 : System.Address); -- ../dbus/dbus-connection.h:177:20 pragma Import (C, dbus_connection_unref, "dbus_connection_unref"); procedure dbus_connection_close (arg1 : System.Address); -- ../dbus/dbus-connection.h:178:20 pragma Import (C, dbus_connection_close, "dbus_connection_close"); function dbus_connection_get_is_connected (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:179:20 pragma Import (C, dbus_connection_get_is_connected, "dbus_connection_get_is_connected"); function dbus_connection_get_is_authenticated (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:180:20 pragma Import (C, dbus_connection_get_is_authenticated, "dbus_connection_get_is_authenticated"); function dbus_connection_get_is_anonymous (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:181:20 pragma Import (C, dbus_connection_get_is_anonymous, "dbus_connection_get_is_anonymous"); function dbus_connection_get_server_id (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-connection.h:182:20 pragma Import (C, dbus_connection_get_server_id, "dbus_connection_get_server_id"); procedure dbus_connection_set_exit_on_disconnect (arg1 : System.Address; arg2 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-connection.h:183:20 pragma Import (C, dbus_connection_set_exit_on_disconnect, "dbus_connection_set_exit_on_disconnect"); procedure dbus_connection_flush (arg1 : System.Address); -- ../dbus/dbus-connection.h:185:20 pragma Import (C, dbus_connection_flush, "dbus_connection_flush"); function dbus_connection_read_write_dispatch (arg1 : System.Address; arg2 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:186:20 pragma Import (C, dbus_connection_read_write_dispatch, "dbus_connection_read_write_dispatch"); function dbus_connection_read_write (arg1 : System.Address; arg2 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:188:20 pragma Import (C, dbus_connection_read_write, "dbus_connection_read_write"); function dbus_connection_borrow_message (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:190:20 pragma Import (C, dbus_connection_borrow_message, "dbus_connection_borrow_message"); procedure dbus_connection_return_message (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:191:20 pragma Import (C, dbus_connection_return_message, "dbus_connection_return_message"); procedure dbus_connection_steal_borrowed_message (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:193:20 pragma Import (C, dbus_connection_steal_borrowed_message, "dbus_connection_steal_borrowed_message"); function dbus_connection_pop_message (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:195:20 pragma Import (C, dbus_connection_pop_message, "dbus_connection_pop_message"); function dbus_connection_get_dispatch_status (arg1 : System.Address) return DBusDispatchStatus; -- ../dbus/dbus-connection.h:196:20 pragma Import (C, dbus_connection_get_dispatch_status, "dbus_connection_get_dispatch_status"); function dbus_connection_dispatch (arg1 : System.Address) return DBusDispatchStatus; -- ../dbus/dbus-connection.h:197:20 pragma Import (C, dbus_connection_dispatch, "dbus_connection_dispatch"); function dbus_connection_has_messages_to_send (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:198:20 pragma Import (C, dbus_connection_has_messages_to_send, "dbus_connection_has_messages_to_send"); function dbus_connection_send (arg1 : System.Address; arg2 : System.Address; arg3 : access dbus_arch_deps_h.dbus_uint32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:199:20 pragma Import (C, dbus_connection_send, "dbus_connection_send"); function dbus_connection_send_with_reply (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address; arg4 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:202:20 pragma Import (C, dbus_connection_send_with_reply, "dbus_connection_send_with_reply"); function dbus_connection_send_with_reply_and_block (arg1 : System.Address; arg2 : System.Address; arg3 : int; arg4 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-connection.h:206:20 pragma Import (C, dbus_connection_send_with_reply_and_block, "dbus_connection_send_with_reply_and_block"); function dbus_connection_set_watch_functions (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : access procedure (arg1 : System.Address; arg2 : System.Address); arg4 : access procedure (arg1 : System.Address; arg2 : System.Address); arg5 : System.Address; arg6 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:210:20 pragma Import (C, dbus_connection_set_watch_functions, "dbus_connection_set_watch_functions"); function dbus_connection_set_timeout_functions (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : access procedure (arg1 : System.Address; arg2 : System.Address); arg4 : access procedure (arg1 : System.Address; arg2 : System.Address); arg5 : System.Address; arg6 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:216:20 pragma Import (C, dbus_connection_set_timeout_functions, "dbus_connection_set_timeout_functions"); procedure dbus_connection_set_wakeup_main_function (arg1 : System.Address; arg2 : access procedure (arg1 : System.Address); arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:222:20 pragma Import (C, dbus_connection_set_wakeup_main_function, "dbus_connection_set_wakeup_main_function"); procedure dbus_connection_set_dispatch_status_function (arg1 : System.Address; arg2 : access procedure (arg1 : System.Address; arg2 : DBusDispatchStatus; arg3 : System.Address); arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:226:20 pragma Import (C, dbus_connection_set_dispatch_status_function, "dbus_connection_set_dispatch_status_function"); function dbus_connection_get_unix_user (arg1 : System.Address; arg2 : access unsigned_long) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:230:20 pragma Import (C, dbus_connection_get_unix_user, "dbus_connection_get_unix_user"); function dbus_connection_get_unix_process_id (arg1 : System.Address; arg2 : access unsigned_long) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:232:20 pragma Import (C, dbus_connection_get_unix_process_id, "dbus_connection_get_unix_process_id"); function dbus_connection_get_adt_audit_session_data (arg1 : System.Address; arg2 : System.Address; arg3 : access dbus_arch_deps_h.dbus_int32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:234:20 pragma Import (C, dbus_connection_get_adt_audit_session_data, "dbus_connection_get_adt_audit_session_data"); procedure dbus_connection_set_unix_user_function (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : unsigned_long; arg3 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:237:20 pragma Import (C, dbus_connection_set_unix_user_function, "dbus_connection_set_unix_user_function"); function dbus_connection_get_windows_user (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:241:20 pragma Import (C, dbus_connection_get_windows_user, "dbus_connection_get_windows_user"); procedure dbus_connection_set_windows_user_function (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:243:20 pragma Import (C, dbus_connection_set_windows_user_function, "dbus_connection_set_windows_user_function"); procedure dbus_connection_set_allow_anonymous (arg1 : System.Address; arg2 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-connection.h:247:20 pragma Import (C, dbus_connection_set_allow_anonymous, "dbus_connection_set_allow_anonymous"); procedure dbus_connection_set_route_peer_messages (arg1 : System.Address; arg2 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-connection.h:249:20 pragma Import (C, dbus_connection_set_route_peer_messages, "dbus_connection_set_route_peer_messages"); function dbus_connection_add_filter (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address) return dbus_shared_h.DBusHandlerResult; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:255:13 pragma Import (C, dbus_connection_add_filter, "dbus_connection_add_filter"); procedure dbus_connection_remove_filter (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address) return dbus_shared_h.DBusHandlerResult; arg3 : System.Address); -- ../dbus/dbus-connection.h:259:13 pragma Import (C, dbus_connection_remove_filter, "dbus_connection_remove_filter"); function dbus_connection_allocate_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:265:13 pragma Import (C, dbus_connection_allocate_data_slot, "dbus_connection_allocate_data_slot"); procedure dbus_connection_free_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t); -- ../dbus/dbus-connection.h:266:13 pragma Import (C, dbus_connection_free_data_slot, "dbus_connection_free_data_slot"); function dbus_connection_set_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:267:13 pragma Import (C, dbus_connection_set_data, "dbus_connection_set_data"); function dbus_connection_get_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t) return System.Address; -- ../dbus/dbus-connection.h:271:13 pragma Import (C, dbus_connection_get_data, "dbus_connection_get_data"); procedure dbus_connection_set_change_sigpipe (arg1 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-connection.h:274:13 pragma Import (C, dbus_connection_set_change_sigpipe, "dbus_connection_set_change_sigpipe"); procedure dbus_connection_set_max_message_size (arg1 : System.Address; arg2 : long); -- ../dbus/dbus-connection.h:276:6 pragma Import (C, dbus_connection_set_max_message_size, "dbus_connection_set_max_message_size"); function dbus_connection_get_max_message_size (arg1 : System.Address) return long; -- ../dbus/dbus-connection.h:278:6 pragma Import (C, dbus_connection_get_max_message_size, "dbus_connection_get_max_message_size"); procedure dbus_connection_set_max_received_size (arg1 : System.Address; arg2 : long); -- ../dbus/dbus-connection.h:279:6 pragma Import (C, dbus_connection_set_max_received_size, "dbus_connection_set_max_received_size"); function dbus_connection_get_max_received_size (arg1 : System.Address) return long; -- ../dbus/dbus-connection.h:281:6 pragma Import (C, dbus_connection_get_max_received_size, "dbus_connection_get_max_received_size"); function dbus_connection_get_outgoing_size (arg1 : System.Address) return long; -- ../dbus/dbus-connection.h:282:6 pragma Import (C, dbus_connection_get_outgoing_size, "dbus_connection_get_outgoing_size"); function dbus_connection_preallocate_send (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:284:23 pragma Import (C, dbus_connection_preallocate_send, "dbus_connection_preallocate_send"); procedure dbus_connection_free_preallocated_send (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:285:23 pragma Import (C, dbus_connection_free_preallocated_send, "dbus_connection_free_preallocated_send"); procedure dbus_connection_send_preallocated (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address; arg4 : access dbus_arch_deps_h.dbus_uint32_t); -- ../dbus/dbus-connection.h:287:23 pragma Import (C, dbus_connection_send_preallocated, "dbus_connection_send_preallocated"); type DBusObjectPathUnregisterFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:299:30 type DBusObjectPathMessageFunction is access function (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address) return dbus_shared_h.DBusHandlerResult; -- ../dbus/dbus-connection.h:306:30 type DBusObjectPathVTable is record unregister_function : access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-connection.h:318:38 message_function : access function (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address) return dbus_shared_h.DBusHandlerResult; -- ../dbus/dbus-connection.h:319:38 dbus_internal_pad1 : access procedure (arg1 : System.Address); -- ../dbus/dbus-connection.h:321:11 dbus_internal_pad2 : access procedure (arg1 : System.Address); -- ../dbus/dbus-connection.h:322:11 dbus_internal_pad3 : access procedure (arg1 : System.Address); -- ../dbus/dbus-connection.h:323:11 dbus_internal_pad4 : access procedure (arg1 : System.Address); -- ../dbus/dbus-connection.h:324:11 end record; pragma Convention (C_Pass_By_Copy, DBusObjectPathVTable); -- ../dbus/dbus-connection.h:53:16 function dbus_connection_try_register_object_path (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access constant DBusObjectPathVTable; arg4 : System.Address; arg5 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:327:13 pragma Import (C, dbus_connection_try_register_object_path, "dbus_connection_try_register_object_path"); function dbus_connection_register_object_path (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access constant DBusObjectPathVTable; arg4 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:333:13 pragma Import (C, dbus_connection_register_object_path, "dbus_connection_register_object_path"); function dbus_connection_try_register_fallback (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access constant DBusObjectPathVTable; arg4 : System.Address; arg5 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:338:13 pragma Import (C, dbus_connection_try_register_fallback, "dbus_connection_try_register_fallback"); function dbus_connection_register_fallback (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : access constant DBusObjectPathVTable; arg4 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:344:13 pragma Import (C, dbus_connection_register_fallback, "dbus_connection_register_fallback"); function dbus_connection_unregister_object_path (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:348:13 pragma Import (C, dbus_connection_unregister_object_path, "dbus_connection_unregister_object_path"); function dbus_connection_get_object_path_data (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:351:13 pragma Import (C, dbus_connection_get_object_path_data, "dbus_connection_get_object_path_data"); function dbus_connection_list_registered (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:355:13 pragma Import (C, dbus_connection_list_registered, "dbus_connection_list_registered"); function dbus_connection_get_unix_fd (arg1 : System.Address; arg2 : access int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:359:13 pragma Import (C, dbus_connection_get_unix_fd, "dbus_connection_get_unix_fd"); function dbus_connection_get_socket (arg1 : System.Address; arg2 : access int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:361:13 pragma Import (C, dbus_connection_get_socket, "dbus_connection_get_socket"); function dbus_watch_get_fd (arg1 : System.Address) return int; -- ../dbus/dbus-connection.h:373:21 pragma Import (C, dbus_watch_get_fd, "dbus_watch_get_fd"); function dbus_watch_get_unix_fd (arg1 : System.Address) return int; -- ../dbus/dbus-connection.h:376:14 pragma Import (C, dbus_watch_get_unix_fd, "dbus_watch_get_unix_fd"); function dbus_watch_get_socket (arg1 : System.Address) return int; -- ../dbus/dbus-connection.h:377:14 pragma Import (C, dbus_watch_get_socket, "dbus_watch_get_socket"); function dbus_watch_get_flags (arg1 : System.Address) return unsigned; -- ../dbus/dbus-connection.h:378:14 pragma Import (C, dbus_watch_get_flags, "dbus_watch_get_flags"); function dbus_watch_get_data (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:379:14 pragma Import (C, dbus_watch_get_data, "dbus_watch_get_data"); procedure dbus_watch_set_data (arg1 : System.Address; arg2 : System.Address; arg3 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:380:14 pragma Import (C, dbus_watch_set_data, "dbus_watch_set_data"); function dbus_watch_handle (arg1 : System.Address; arg2 : unsigned) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:383:14 pragma Import (C, dbus_watch_handle, "dbus_watch_handle"); function dbus_watch_get_enabled (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:385:14 pragma Import (C, dbus_watch_get_enabled, "dbus_watch_get_enabled"); function dbus_timeout_get_interval (arg1 : System.Address) return int; -- ../dbus/dbus-connection.h:394:13 pragma Import (C, dbus_timeout_get_interval, "dbus_timeout_get_interval"); function dbus_timeout_get_data (arg1 : System.Address) return System.Address; -- ../dbus/dbus-connection.h:395:13 pragma Import (C, dbus_timeout_get_data, "dbus_timeout_get_data"); procedure dbus_timeout_set_data (arg1 : System.Address; arg2 : System.Address; arg3 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-connection.h:396:13 pragma Import (C, dbus_timeout_set_data, "dbus_timeout_set_data"); function dbus_timeout_handle (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:399:13 pragma Import (C, dbus_timeout_handle, "dbus_timeout_handle"); function dbus_timeout_get_enabled (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-connection.h:400:13 pragma Import (C, dbus_timeout_get_enabled, "dbus_timeout_get_enabled"); end dbus_connection_h; libdbusada-0.2/thin/dbus_pending_call_h.ads0000644000175000017500000000533611672337633017545 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with dbus_types_h; with dbus_arch_deps_h; package dbus_pending_call_h is function dbus_pending_call_ref (arg1 : System.Address) return System.Address; -- ../dbus/dbus-pending-call.h:41:18 pragma Import (C, dbus_pending_call_ref, "dbus_pending_call_ref"); procedure dbus_pending_call_unref (arg1 : System.Address); -- ../dbus/dbus-pending-call.h:42:14 pragma Import (C, dbus_pending_call_unref, "dbus_pending_call_unref"); function dbus_pending_call_set_notify (arg1 : System.Address; arg2 : access procedure (arg1 : System.Address; arg2 : System.Address); arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-pending-call.h:43:14 pragma Import (C, dbus_pending_call_set_notify, "dbus_pending_call_set_notify"); procedure dbus_pending_call_cancel (arg1 : System.Address); -- ../dbus/dbus-pending-call.h:47:14 pragma Import (C, dbus_pending_call_cancel, "dbus_pending_call_cancel"); function dbus_pending_call_get_completed (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-pending-call.h:48:14 pragma Import (C, dbus_pending_call_get_completed, "dbus_pending_call_get_completed"); function dbus_pending_call_steal_reply (arg1 : System.Address) return System.Address; -- ../dbus/dbus-pending-call.h:49:14 pragma Import (C, dbus_pending_call_steal_reply, "dbus_pending_call_steal_reply"); procedure dbus_pending_call_block (arg1 : System.Address); -- ../dbus/dbus-pending-call.h:50:14 pragma Import (C, dbus_pending_call_block, "dbus_pending_call_block"); function dbus_pending_call_allocate_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-pending-call.h:52:13 pragma Import (C, dbus_pending_call_allocate_data_slot, "dbus_pending_call_allocate_data_slot"); procedure dbus_pending_call_free_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t); -- ../dbus/dbus-pending-call.h:53:13 pragma Import (C, dbus_pending_call_free_data_slot, "dbus_pending_call_free_data_slot"); function dbus_pending_call_set_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-pending-call.h:54:13 pragma Import (C, dbus_pending_call_set_data, "dbus_pending_call_set_data"); function dbus_pending_call_get_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t) return System.Address; -- ../dbus/dbus-pending-call.h:58:13 pragma Import (C, dbus_pending_call_get_data, "dbus_pending_call_get_data"); end dbus_pending_call_h; libdbusada-0.2/thin/dbus_message_h.ads0000644000175000017500000004407111672337633016551 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with dbus_arch_deps_h; with Interfaces.C.Strings; with dbus_types_h; with stdarg_h; limited with dbus_errors_h; package dbus_message_h is -- skipped empty struct DBusMessage type DBusMessageIter is record dummy1 : System.Address; -- ../dbus/dbus-message.h:53:9 dummy2 : System.Address; -- ../dbus/dbus-message.h:54:9 dummy3 : aliased dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-message.h:55:17 dummy4 : aliased int; -- ../dbus/dbus-message.h:56:7 dummy5 : aliased int; -- ../dbus/dbus-message.h:57:7 dummy6 : aliased int; -- ../dbus/dbus-message.h:58:7 dummy7 : aliased int; -- ../dbus/dbus-message.h:59:7 dummy8 : aliased int; -- ../dbus/dbus-message.h:60:7 dummy9 : aliased int; -- ../dbus/dbus-message.h:61:7 dummy10 : aliased int; -- ../dbus/dbus-message.h:62:7 dummy11 : aliased int; -- ../dbus/dbus-message.h:63:7 pad1 : aliased int; -- ../dbus/dbus-message.h:64:7 pad2 : aliased int; -- ../dbus/dbus-message.h:65:7 pad3 : System.Address; -- ../dbus/dbus-message.h:66:9 end record; pragma Convention (C_Pass_By_Copy, DBusMessageIter); -- ../dbus/dbus-message.h:46:16 function dbus_message_new (arg1 : int) return System.Address; -- ../dbus/dbus-message.h:69:14 pragma Import (C, dbus_message_new, "dbus_message_new"); function dbus_message_new_method_call (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr; arg4 : Interfaces.C.Strings.chars_ptr) return System.Address; -- ../dbus/dbus-message.h:70:14 pragma Import (C, dbus_message_new_method_call, "dbus_message_new_method_call"); function dbus_message_new_method_return (arg1 : System.Address) return System.Address; -- ../dbus/dbus-message.h:74:14 pragma Import (C, dbus_message_new_method_return, "dbus_message_new_method_return"); function dbus_message_new_signal (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr) return System.Address; -- ../dbus/dbus-message.h:75:14 pragma Import (C, dbus_message_new_signal, "dbus_message_new_signal"); function dbus_message_new_error (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr) return System.Address; -- ../dbus/dbus-message.h:78:14 pragma Import (C, dbus_message_new_error, "dbus_message_new_error"); function dbus_message_new_error_printf (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr -- , ... ) return System.Address; -- ../dbus/dbus-message.h:81:14 pragma Import (C, dbus_message_new_error_printf, "dbus_message_new_error_printf"); function dbus_message_copy (arg1 : System.Address) return System.Address; -- ../dbus/dbus-message.h:86:14 pragma Import (C, dbus_message_copy, "dbus_message_copy"); function dbus_message_ref (arg1 : System.Address) return System.Address; -- ../dbus/dbus-message.h:88:15 pragma Import (C, dbus_message_ref, "dbus_message_ref"); procedure dbus_message_unref (arg1 : System.Address); -- ../dbus/dbus-message.h:89:15 pragma Import (C, dbus_message_unref, "dbus_message_unref"); function dbus_message_get_type (arg1 : System.Address) return int; -- ../dbus/dbus-message.h:90:15 pragma Import (C, dbus_message_get_type, "dbus_message_get_type"); function dbus_message_set_path (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:91:15 pragma Import (C, dbus_message_set_path, "dbus_message_set_path"); function dbus_message_get_path (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:93:15 pragma Import (C, dbus_message_get_path, "dbus_message_get_path"); function dbus_message_has_path (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:94:15 pragma Import (C, dbus_message_has_path, "dbus_message_has_path"); function dbus_message_set_interface (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:96:15 pragma Import (C, dbus_message_set_interface, "dbus_message_set_interface"); function dbus_message_get_interface (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:98:15 pragma Import (C, dbus_message_get_interface, "dbus_message_get_interface"); function dbus_message_has_interface (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:99:15 pragma Import (C, dbus_message_has_interface, "dbus_message_has_interface"); function dbus_message_set_member (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:101:15 pragma Import (C, dbus_message_set_member, "dbus_message_set_member"); function dbus_message_get_member (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:103:15 pragma Import (C, dbus_message_get_member, "dbus_message_get_member"); function dbus_message_has_member (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:104:15 pragma Import (C, dbus_message_has_member, "dbus_message_has_member"); function dbus_message_set_error_name (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:106:15 pragma Import (C, dbus_message_set_error_name, "dbus_message_set_error_name"); function dbus_message_get_error_name (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:108:15 pragma Import (C, dbus_message_get_error_name, "dbus_message_get_error_name"); function dbus_message_set_destination (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:109:15 pragma Import (C, dbus_message_set_destination, "dbus_message_set_destination"); function dbus_message_get_destination (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:111:15 pragma Import (C, dbus_message_get_destination, "dbus_message_get_destination"); function dbus_message_set_sender (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:112:15 pragma Import (C, dbus_message_set_sender, "dbus_message_set_sender"); function dbus_message_get_sender (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:114:15 pragma Import (C, dbus_message_get_sender, "dbus_message_get_sender"); function dbus_message_get_signature (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:115:15 pragma Import (C, dbus_message_get_signature, "dbus_message_get_signature"); procedure dbus_message_set_no_reply (arg1 : System.Address; arg2 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-message.h:116:15 pragma Import (C, dbus_message_set_no_reply, "dbus_message_set_no_reply"); function dbus_message_get_no_reply (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:118:15 pragma Import (C, dbus_message_get_no_reply, "dbus_message_get_no_reply"); function dbus_message_is_method_call (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:119:15 pragma Import (C, dbus_message_is_method_call, "dbus_message_is_method_call"); function dbus_message_is_signal (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:122:15 pragma Import (C, dbus_message_is_signal, "dbus_message_is_signal"); function dbus_message_is_error (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:125:15 pragma Import (C, dbus_message_is_error, "dbus_message_is_error"); function dbus_message_has_destination (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:127:15 pragma Import (C, dbus_message_has_destination, "dbus_message_has_destination"); function dbus_message_has_sender (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:129:15 pragma Import (C, dbus_message_has_sender, "dbus_message_has_sender"); function dbus_message_has_signature (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:131:15 pragma Import (C, dbus_message_has_signature, "dbus_message_has_signature"); function dbus_message_get_serial (arg1 : System.Address) return dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-message.h:133:15 pragma Import (C, dbus_message_get_serial, "dbus_message_get_serial"); procedure dbus_message_set_serial (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_uint32_t); -- ../dbus/dbus-message.h:134:15 pragma Import (C, dbus_message_set_serial, "dbus_message_set_serial"); function dbus_message_set_reply_serial (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_uint32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:136:15 pragma Import (C, dbus_message_set_reply_serial, "dbus_message_set_reply_serial"); function dbus_message_get_reply_serial (arg1 : System.Address) return dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-message.h:138:15 pragma Import (C, dbus_message_get_reply_serial, "dbus_message_get_reply_serial"); procedure dbus_message_set_auto_start (arg1 : System.Address; arg2 : dbus_types_h.dbus_bool_t); -- ../dbus/dbus-message.h:140:15 pragma Import (C, dbus_message_set_auto_start, "dbus_message_set_auto_start"); function dbus_message_get_auto_start (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:142:15 pragma Import (C, dbus_message_get_auto_start, "dbus_message_get_auto_start"); function dbus_message_get_path_decomposed (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:144:15 pragma Import (C, dbus_message_get_path_decomposed, "dbus_message_get_path_decomposed"); function dbus_message_append_args (arg1 : System.Address; arg2 : int -- , ... ) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:147:13 pragma Import (C, dbus_message_append_args, "dbus_message_append_args"); function dbus_message_append_args_valist (arg1 : System.Address; arg2 : int; arg3 : stdarg_h.va_list) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:150:13 pragma Import (C, dbus_message_append_args_valist, "dbus_message_append_args_valist"); function dbus_message_get_args (arg1 : System.Address; arg2 : access dbus_errors_h.DBusError; arg3 : int -- , ... ) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:153:13 pragma Import (C, dbus_message_get_args, "dbus_message_get_args"); function dbus_message_get_args_valist (arg1 : System.Address; arg2 : access dbus_errors_h.DBusError; arg3 : int; arg4 : stdarg_h.va_list) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:157:13 pragma Import (C, dbus_message_get_args_valist, "dbus_message_get_args_valist"); function dbus_message_iter_init (arg1 : System.Address; arg2 : access DBusMessageIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:163:13 pragma Import (C, dbus_message_iter_init, "dbus_message_iter_init"); function dbus_message_iter_has_next (arg1 : access DBusMessageIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:165:13 pragma Import (C, dbus_message_iter_has_next, "dbus_message_iter_has_next"); function dbus_message_iter_next (arg1 : access DBusMessageIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:166:13 pragma Import (C, dbus_message_iter_next, "dbus_message_iter_next"); function dbus_message_iter_get_signature (arg1 : access DBusMessageIter) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:167:13 pragma Import (C, dbus_message_iter_get_signature, "dbus_message_iter_get_signature"); function dbus_message_iter_get_arg_type (arg1 : access DBusMessageIter) return int; -- ../dbus/dbus-message.h:168:13 pragma Import (C, dbus_message_iter_get_arg_type, "dbus_message_iter_get_arg_type"); function dbus_message_iter_get_element_type (arg1 : access DBusMessageIter) return int; -- ../dbus/dbus-message.h:169:13 pragma Import (C, dbus_message_iter_get_element_type, "dbus_message_iter_get_element_type"); procedure dbus_message_iter_recurse (arg1 : access DBusMessageIter; arg2 : access DBusMessageIter); -- ../dbus/dbus-message.h:170:13 pragma Import (C, dbus_message_iter_recurse, "dbus_message_iter_recurse"); procedure dbus_message_iter_get_basic (arg1 : access DBusMessageIter; arg2 : System.Address); -- ../dbus/dbus-message.h:172:13 pragma Import (C, dbus_message_iter_get_basic, "dbus_message_iter_get_basic"); function dbus_message_iter_get_array_len (arg1 : access DBusMessageIter) return int; -- ../dbus/dbus-message.h:178:29 pragma Import (C, dbus_message_iter_get_array_len, "dbus_message_iter_get_array_len"); procedure dbus_message_iter_get_fixed_array (arg1 : access DBusMessageIter; arg2 : System.Address; arg3 : access int); -- ../dbus/dbus-message.h:180:13 pragma Import (C, dbus_message_iter_get_fixed_array, "dbus_message_iter_get_fixed_array"); procedure dbus_message_iter_init_append (arg1 : System.Address; arg2 : access DBusMessageIter); -- ../dbus/dbus-message.h:185:13 pragma Import (C, dbus_message_iter_init_append, "dbus_message_iter_init_append"); function dbus_message_iter_append_basic (arg1 : access DBusMessageIter; arg2 : int; arg3 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:187:13 pragma Import (C, dbus_message_iter_append_basic, "dbus_message_iter_append_basic"); function dbus_message_iter_append_fixed_array (arg1 : access DBusMessageIter; arg2 : int; arg3 : System.Address; arg4 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:190:13 pragma Import (C, dbus_message_iter_append_fixed_array, "dbus_message_iter_append_fixed_array"); function dbus_message_iter_open_container (arg1 : access DBusMessageIter; arg2 : int; arg3 : Interfaces.C.Strings.chars_ptr; arg4 : access DBusMessageIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:194:13 pragma Import (C, dbus_message_iter_open_container, "dbus_message_iter_open_container"); function dbus_message_iter_close_container (arg1 : access DBusMessageIter; arg2 : access DBusMessageIter) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:198:13 pragma Import (C, dbus_message_iter_close_container, "dbus_message_iter_close_container"); procedure dbus_message_iter_abandon_container (arg1 : access DBusMessageIter; arg2 : access DBusMessageIter); -- ../dbus/dbus-message.h:200:13 pragma Import (C, dbus_message_iter_abandon_container, "dbus_message_iter_abandon_container"); procedure dbus_message_lock (arg1 : System.Address); -- ../dbus/dbus-message.h:203:6 pragma Import (C, dbus_message_lock, "dbus_message_lock"); function dbus_set_error_from_message (arg1 : access dbus_errors_h.DBusError; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:205:14 pragma Import (C, dbus_set_error_from_message, "dbus_set_error_from_message"); function dbus_message_allocate_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:209:13 pragma Import (C, dbus_message_allocate_data_slot, "dbus_message_allocate_data_slot"); procedure dbus_message_free_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t); -- ../dbus/dbus-message.h:210:13 pragma Import (C, dbus_message_free_data_slot, "dbus_message_free_data_slot"); function dbus_message_set_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:211:13 pragma Import (C, dbus_message_set_data, "dbus_message_set_data"); function dbus_message_get_data (arg1 : System.Address; arg2 : dbus_arch_deps_h.dbus_int32_t) return System.Address; -- ../dbus/dbus-message.h:215:13 pragma Import (C, dbus_message_get_data, "dbus_message_get_data"); function dbus_message_type_from_string (arg1 : Interfaces.C.Strings.chars_ptr) return int; -- ../dbus/dbus-message.h:218:13 pragma Import (C, dbus_message_type_from_string, "dbus_message_type_from_string"); function dbus_message_type_to_string (arg1 : int) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-message.h:219:13 pragma Import (C, dbus_message_type_to_string, "dbus_message_type_to_string"); function dbus_message_marshal (arg1 : System.Address; arg2 : System.Address; arg3 : access int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-message.h:221:14 pragma Import (C, dbus_message_marshal, "dbus_message_marshal"); function dbus_message_demarshal (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : int; arg3 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-message.h:224:14 pragma Import (C, dbus_message_demarshal, "dbus_message_demarshal"); function dbus_message_demarshal_bytes_needed (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : int) return int; -- ../dbus/dbus-message.h:228:14 pragma Import (C, dbus_message_demarshal_bytes_needed, "dbus_message_demarshal_bytes_needed"); end dbus_message_h; libdbusada-0.2/thin/dbus_threads_h.ads0000644000175000017500000001326011672337633016553 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with dbus_types_h; package dbus_threads_h is -- skipped empty struct DBusMutex -- skipped empty struct DBusCondVar type DBusMutexNewFunction is access function return System.Address; -- ../dbus/dbus-threads.h:46:24 type DBusMutexFreeFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:48:24 type DBusMutexLockFunction is access function (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:50:24 type DBusMutexUnlockFunction is access function (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:52:24 type DBusRecursiveMutexNewFunction is access function return System.Address; -- ../dbus/dbus-threads.h:61:24 type DBusRecursiveMutexFreeFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:64:24 type DBusRecursiveMutexLockFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:68:24 type DBusRecursiveMutexUnlockFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:72:24 type DBusCondVarNewFunction is access function return System.Address; -- ../dbus/dbus-threads.h:77:26 type DBusCondVarFreeFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:80:26 type DBusCondVarWaitFunction is access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-threads.h:92:26 type DBusCondVarWaitTimeoutFunction is access function (arg1 : System.Address; arg2 : System.Address; arg3 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:101:26 type DBusCondVarWakeOneFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:108:26 type DBusCondVarWakeAllFunction is access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:114:26 subtype DBusThreadFunctionsMask is unsigned; DBUS_THREAD_FUNCTIONS_MUTEX_NEW_MASK : constant DBusThreadFunctionsMask := 1; DBUS_THREAD_FUNCTIONS_MUTEX_FREE_MASK : constant DBusThreadFunctionsMask := 2; DBUS_THREAD_FUNCTIONS_MUTEX_LOCK_MASK : constant DBusThreadFunctionsMask := 4; DBUS_THREAD_FUNCTIONS_MUTEX_UNLOCK_MASK : constant DBusThreadFunctionsMask := 8; DBUS_THREAD_FUNCTIONS_CONDVAR_NEW_MASK : constant DBusThreadFunctionsMask := 16; DBUS_THREAD_FUNCTIONS_CONDVAR_FREE_MASK : constant DBusThreadFunctionsMask := 32; DBUS_THREAD_FUNCTIONS_CONDVAR_WAIT_MASK : constant DBusThreadFunctionsMask := 64; DBUS_THREAD_FUNCTIONS_CONDVAR_WAIT_TIMEOUT_MASK : constant DBusThreadFunctionsMask := 128; DBUS_THREAD_FUNCTIONS_CONDVAR_WAKE_ONE_MASK : constant DBusThreadFunctionsMask := 256; DBUS_THREAD_FUNCTIONS_CONDVAR_WAKE_ALL_MASK : constant DBusThreadFunctionsMask := 512; DBUS_THREAD_FUNCTIONS_RECURSIVE_MUTEX_NEW_MASK : constant DBusThreadFunctionsMask := 1024; DBUS_THREAD_FUNCTIONS_RECURSIVE_MUTEX_FREE_MASK : constant DBusThreadFunctionsMask := 2048; DBUS_THREAD_FUNCTIONS_RECURSIVE_MUTEX_LOCK_MASK : constant DBusThreadFunctionsMask := 4096; DBUS_THREAD_FUNCTIONS_RECURSIVE_MUTEX_UNLOCK_MASK : constant DBusThreadFunctionsMask := 8192; DBUS_THREAD_FUNCTIONS_ALL_MASK : constant DBusThreadFunctionsMask := 16383; -- ../dbus/dbus-threads.h:138:3 type DBusThreadFunctions is record mask : aliased unsigned; -- ../dbus/dbus-threads.h:163:16 mutex_new : access function return System.Address; -- ../dbus/dbus-threads.h:165:24 mutex_free : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:166:25 mutex_lock : access function (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:167:25 mutex_unlock : access function (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:168:27 condvar_new : access function return System.Address; -- ../dbus/dbus-threads.h:170:26 condvar_free : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:171:27 condvar_wait : access procedure (arg1 : System.Address; arg2 : System.Address); -- ../dbus/dbus-threads.h:172:27 condvar_wait_timeout : access function (arg1 : System.Address; arg2 : System.Address; arg3 : int) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:173:34 condvar_wake_one : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:174:30 condvar_wake_all : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:175:30 recursive_mutex_new : access function return System.Address; -- ../dbus/dbus-threads.h:177:33 recursive_mutex_free : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:178:34 recursive_mutex_lock : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:179:34 recursive_mutex_unlock : access procedure (arg1 : System.Address); -- ../dbus/dbus-threads.h:180:36 padding1 : access procedure; -- ../dbus/dbus-threads.h:182:11 padding2 : access procedure; -- ../dbus/dbus-threads.h:183:11 padding3 : access procedure; -- ../dbus/dbus-threads.h:184:11 padding4 : access procedure; -- ../dbus/dbus-threads.h:185:11 end record; pragma Convention (C_Pass_By_Copy, DBusThreadFunctions); -- ../dbus/dbus-threads.h:187:3 function dbus_threads_init (arg1 : access constant DBusThreadFunctions) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:189:14 pragma Import (C, dbus_threads_init, "dbus_threads_init"); function dbus_threads_init_default return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-threads.h:190:14 pragma Import (C, dbus_threads_init_default, "dbus_threads_init_default"); end dbus_threads_h; libdbusada-0.2/thin/dbus_address_h.ads0000644000175000017500000000322711672337633016550 0ustar reetreetwith Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; with System; limited with dbus_errors_h; with dbus_types_h; package dbus_address_h is -- skipped empty struct DBusAddressEntry function dbus_parse_address (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : System.Address; arg3 : access int; arg4 : access dbus_errors_h.DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-address.h:43:13 pragma Import (C, dbus_parse_address, "dbus_parse_address"); function dbus_address_entry_get_value (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-address.h:47:13 pragma Import (C, dbus_address_entry_get_value, "dbus_address_entry_get_value"); function dbus_address_entry_get_method (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-address.h:49:13 pragma Import (C, dbus_address_entry_get_method, "dbus_address_entry_get_method"); procedure dbus_address_entries_free (arg1 : System.Address); -- ../dbus/dbus-address.h:50:13 pragma Import (C, dbus_address_entries_free, "dbus_address_entries_free"); function dbus_address_escape_value (arg1 : Interfaces.C.Strings.chars_ptr) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-address.h:52:7 pragma Import (C, dbus_address_escape_value, "dbus_address_escape_value"); function dbus_address_unescape_value (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-address.h:53:7 pragma Import (C, dbus_address_unescape_value, "dbus_address_unescape_value"); end dbus_address_h; libdbusada-0.2/thin/dbus_errors_h.ads0000644000175000017500000000452411672337633016440 0ustar reetreetwith Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; with Interfaces.C.Extensions; with System; with dbus_types_h; package dbus_errors_h is -- unsupported macro: DBUS_ERROR_INIT { NULL, NULL, TRUE, 0, 0, 0, 0, NULL } type DBusError is record name : Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-errors.h:49:15 message : Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-errors.h:50:15 dummy1 : Extensions.Unsigned_1; -- ../dbus/dbus-errors.h:52:16 dummy2 : Extensions.Unsigned_1; -- ../dbus/dbus-errors.h:53:16 dummy3 : Extensions.Unsigned_1; -- ../dbus/dbus-errors.h:54:16 dummy4 : Extensions.Unsigned_1; -- ../dbus/dbus-errors.h:55:16 dummy5 : Extensions.Unsigned_1; -- ../dbus/dbus-errors.h:56:16 padding1 : System.Address; -- ../dbus/dbus-errors.h:58:9 end record; pragma Convention (C_Pass_By_Copy, DBusError); pragma Pack (DBusError); -- ../dbus/dbus-errors.h:42:16 procedure dbus_error_init (arg1 : access DBusError); -- ../dbus/dbus-errors.h:63:13 pragma Import (C, dbus_error_init, "dbus_error_init"); procedure dbus_error_free (arg1 : access DBusError); -- ../dbus/dbus-errors.h:64:13 pragma Import (C, dbus_error_free, "dbus_error_free"); procedure dbus_set_error (arg1 : access DBusError; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr -- , ... ); -- ../dbus/dbus-errors.h:65:13 pragma Import (C, dbus_set_error, "dbus_set_error"); procedure dbus_set_error_const (arg1 : access DBusError; arg2 : Interfaces.C.Strings.chars_ptr; arg3 : Interfaces.C.Strings.chars_ptr); -- ../dbus/dbus-errors.h:69:13 pragma Import (C, dbus_set_error_const, "dbus_set_error_const"); procedure dbus_move_error (arg1 : access DBusError; arg2 : access DBusError); -- ../dbus/dbus-errors.h:72:13 pragma Import (C, dbus_move_error, "dbus_move_error"); function dbus_error_has_name (arg1 : access constant DBusError; arg2 : Interfaces.C.Strings.chars_ptr) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-errors.h:74:13 pragma Import (C, dbus_error_has_name, "dbus_error_has_name"); function dbus_error_is_set (arg1 : access constant DBusError) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-errors.h:76:13 pragma Import (C, dbus_error_is_set, "dbus_error_is_set"); end dbus_errors_h; libdbusada-0.2/thin/stddef_h.ads0000644000175000017500000000104311672337633015351 0ustar reetreetwith Interfaces.C; use Interfaces.C; package stddef_h is -- unsupported macro: NULL ((void *)0) -- unsupported macro: offsetof(TYPE,MEMBER) __builtin_offsetof (TYPE, MEMBER) subtype ptrdiff_t is int; -- /opt/gnat-gpl-2010/bin/../lib/gcc/i686-pc-linux-gnu/4.3.6/include/stddef.h:152:26 subtype size_t is unsigned; -- /opt/gnat-gpl-2010/bin/../lib/gcc/i686-pc-linux-gnu/4.3.6/include/stddef.h:214:23 subtype wchar_t is long; -- /opt/gnat-gpl-2010/bin/../lib/gcc/i686-pc-linux-gnu/4.3.6/include/stddef.h:326:24 end stddef_h; libdbusada-0.2/thin/dbus_server_h.ads0000644000175000017500000001064611672337633016434 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; with Interfaces.C.Strings; limited with dbus_errors_h; with dbus_types_h; with dbus_arch_deps_h; package dbus_server_h is -- skipped empty struct DBusServer type DBusNewConnectionFunction is access procedure (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address); -- ../dbus/dbus-server.h:47:17 function dbus_server_listen (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : access dbus_errors_h.DBusError) return System.Address; -- ../dbus/dbus-server.h:51:13 pragma Import (C, dbus_server_listen, "dbus_server_listen"); function dbus_server_ref (arg1 : System.Address) return System.Address; -- ../dbus/dbus-server.h:53:13 pragma Import (C, dbus_server_ref, "dbus_server_ref"); procedure dbus_server_unref (arg1 : System.Address); -- ../dbus/dbus-server.h:54:13 pragma Import (C, dbus_server_unref, "dbus_server_unref"); procedure dbus_server_disconnect (arg1 : System.Address); -- ../dbus/dbus-server.h:55:13 pragma Import (C, dbus_server_disconnect, "dbus_server_disconnect"); function dbus_server_get_is_connected (arg1 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:56:13 pragma Import (C, dbus_server_get_is_connected, "dbus_server_get_is_connected"); function dbus_server_get_address (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-server.h:57:13 pragma Import (C, dbus_server_get_address, "dbus_server_get_address"); function dbus_server_get_id (arg1 : System.Address) return Interfaces.C.Strings.chars_ptr; -- ../dbus/dbus-server.h:58:13 pragma Import (C, dbus_server_get_id, "dbus_server_get_id"); procedure dbus_server_set_new_connection_function (arg1 : System.Address; arg2 : access procedure (arg1 : System.Address; arg2 : System.Address; arg3 : System.Address); arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)); -- ../dbus/dbus-server.h:59:13 pragma Import (C, dbus_server_set_new_connection_function, "dbus_server_set_new_connection_function"); function dbus_server_set_watch_functions (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : access procedure (arg1 : System.Address; arg2 : System.Address); arg4 : access procedure (arg1 : System.Address; arg2 : System.Address); arg5 : System.Address; arg6 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:63:13 pragma Import (C, dbus_server_set_watch_functions, "dbus_server_set_watch_functions"); function dbus_server_set_timeout_functions (arg1 : System.Address; arg2 : access function (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; arg3 : access procedure (arg1 : System.Address; arg2 : System.Address); arg4 : access procedure (arg1 : System.Address; arg2 : System.Address); arg5 : System.Address; arg6 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:69:13 pragma Import (C, dbus_server_set_timeout_functions, "dbus_server_set_timeout_functions"); function dbus_server_set_auth_mechanisms (arg1 : System.Address; arg2 : System.Address) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:75:13 pragma Import (C, dbus_server_set_auth_mechanisms, "dbus_server_set_auth_mechanisms"); function dbus_server_allocate_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:78:13 pragma Import (C, dbus_server_allocate_data_slot, "dbus_server_allocate_data_slot"); procedure dbus_server_free_data_slot (arg1 : access dbus_arch_deps_h.dbus_int32_t); -- ../dbus/dbus-server.h:79:13 pragma Import (C, dbus_server_free_data_slot, "dbus_server_free_data_slot"); function dbus_server_set_data (arg1 : System.Address; arg2 : int; arg3 : System.Address; arg4 : access procedure (arg1 : System.Address)) return dbus_types_h.dbus_bool_t; -- ../dbus/dbus-server.h:80:13 pragma Import (C, dbus_server_set_data, "dbus_server_set_data"); function dbus_server_get_data (arg1 : System.Address; arg2 : int) return System.Address; -- ../dbus/dbus-server.h:84:13 pragma Import (C, dbus_server_get_data, "dbus_server_get_data"); end dbus_server_h; libdbusada-0.2/thin/dbus_types_h.ads0000644000175000017500000000043711672337633016267 0ustar reetreetwith Interfaces.C; use Interfaces.C; with dbus_arch_deps_h; package dbus_types_h is subtype dbus_unichar_t is dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-types.h:33:24 subtype dbus_bool_t is dbus_arch_deps_h.dbus_uint32_t; -- ../dbus/dbus-types.h:35:24 end dbus_types_h; libdbusada-0.2/thin/dbus_shared_h.ads0000644000175000017500000000506111672337633016367 0ustar reetreetwith Interfaces.C; use Interfaces.C; package dbus_shared_h is DBUS_SERVICE_DBUS : aliased constant String := "org.freedesktop.DBus" & ASCII.NUL; -- ../dbus/dbus-shared.h:76 DBUS_PATH_DBUS : aliased constant String := "/org/freedesktop/DBus" & ASCII.NUL; -- ../dbus/dbus-shared.h:80 DBUS_PATH_LOCAL : aliased constant String := "/org/freedesktop/DBus/Local" & ASCII.NUL; -- ../dbus/dbus-shared.h:82 DBUS_INTERFACE_DBUS : aliased constant String := "org.freedesktop.DBus" & ASCII.NUL; -- ../dbus/dbus-shared.h:88 DBUS_INTERFACE_INTROSPECTABLE : aliased constant String := "org.freedesktop.DBus.Introspectable" & ASCII.NUL; -- ../dbus/dbus-shared.h:90 DBUS_INTERFACE_PROPERTIES : aliased constant String := "org.freedesktop.DBus.Properties" & ASCII.NUL; -- ../dbus/dbus-shared.h:92 DBUS_INTERFACE_PEER : aliased constant String := "org.freedesktop.DBus.Peer" & ASCII.NUL; -- ../dbus/dbus-shared.h:94 DBUS_INTERFACE_LOCAL : aliased constant String := "org.freedesktop.DBus.Local" & ASCII.NUL; -- ../dbus/dbus-shared.h:100 DBUS_NAME_FLAG_ALLOW_REPLACEMENT : constant := 16#1#; -- ../dbus/dbus-shared.h:103 DBUS_NAME_FLAG_REPLACE_EXISTING : constant := 16#2#; -- ../dbus/dbus-shared.h:104 DBUS_NAME_FLAG_DO_NOT_QUEUE : constant := 16#4#; -- ../dbus/dbus-shared.h:105 DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER : constant := 1; -- ../dbus/dbus-shared.h:108 DBUS_REQUEST_NAME_REPLY_IN_QUEUE : constant := 2; -- ../dbus/dbus-shared.h:109 DBUS_REQUEST_NAME_REPLY_EXISTS : constant := 3; -- ../dbus/dbus-shared.h:110 DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER : constant := 4; -- ../dbus/dbus-shared.h:111 DBUS_RELEASE_NAME_REPLY_RELEASED : constant := 1; -- ../dbus/dbus-shared.h:114 DBUS_RELEASE_NAME_REPLY_NON_EXISTENT : constant := 2; -- ../dbus/dbus-shared.h:115 DBUS_RELEASE_NAME_REPLY_NOT_OWNER : constant := 3; -- ../dbus/dbus-shared.h:116 DBUS_START_REPLY_SUCCESS : constant := 1; -- ../dbus/dbus-shared.h:119 DBUS_START_REPLY_ALREADY_RUNNING : constant := 2; -- ../dbus/dbus-shared.h:120 subtype DBusBusType is unsigned; DBUS_BUS_SESSION : constant DBusBusType := 0; DBUS_BUS_SYSTEM : constant DBusBusType := 1; DBUS_BUS_STARTER : constant DBusBusType := 2; -- ../dbus/dbus-shared.h:61:3 subtype DBusHandlerResult is unsigned; DBUS_HANDLER_RESULT_HANDLED : constant DBusHandlerResult := 0; DBUS_HANDLER_RESULT_NOT_YET_HANDLED : constant DBusHandlerResult := 1; DBUS_HANDLER_RESULT_NEED_MEMORY : constant DBusHandlerResult := 2; -- ../dbus/dbus-shared.h:71:3 end dbus_shared_h; libdbusada-0.2/thin/stdarg_h.ads0000644000175000017500000000111211672337633015361 0ustar reetreetwith Interfaces.C; use Interfaces.C; with System; package stdarg_h is -- unsupported macro: va_start(v,l) __builtin_va_start(v,l) -- unsupported macro: va_end(v) __builtin_va_end(v) -- unsupported macro: va_arg(v,l) __builtin_va_arg(v,l) -- unsupported macro: va_copy(d,s) __builtin_va_copy(d,s) subtype uu_gnuc_va_list is System.Address; -- /opt/gnat-gpl-2010/bin/../lib/gcc/i686-pc-linux-gnu/4.3.6/include/stdarg.h:43:27 subtype va_list is uu_gnuc_va_list; -- /opt/gnat-gpl-2010/bin/../lib/gcc/i686-pc-linux-gnu/4.3.6/include/stdarg.h:105:24 end stdarg_h; libdbusada-0.2/thin/build.gpr0000644000175000017500000000057111672337633014716 0ustar reetreetproject Build is for Source_Dirs use ("."); for Object_Dir use "../obj/thin"; Compiler_Switches := ("-gnat05", "-fPIC", "-fstack-check", "-gnato", "-g"); package Compiler is for Default_Switches ("ada") use Compiler_Switches; end Compiler; end Build; libdbusada-0.2/COPYING0000644000175000017500000004325411672337633013203 0ustar reetreet GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. libdbusada-0.2/d_bus_ada_lib.gpr0000644000175000017500000000356011672337633015405 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with "d_bus_ada_common"; with "d_bus_ada_lib_thin"; project D_Bus_Ada_Lib is for Source_Dirs use ("src"); for Object_Dir use "obj/lib"; for Library_Name use "dbusada"; for Library_Dir use "lib"; for Library_Kind use external ("LIBRARY_KIND", "dynamic"); for Library_Version use "libdbusada.so." & D_Bus_Ada_Common.Version; for Library_Options use D_Bus_Ada_Common.Linker_Switches; package Compiler is for Default_Switches ("ada") use D_Bus_Ada_Common.Compiler_Switches; end Compiler; package Binder is for Default_Switches ("ada") use ("-E"); end Binder; end D_Bus_Ada_Lib; libdbusada-0.2/d_bus_ada_examples.gpr0000644000175000017500000000411211672337633016447 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with "d_bus_ada_lib"; with "d_bus_ada_common"; project D_Bus_Ada_Examples is for Source_Dirs use ("examples/caller", "examples/clientstub", "examples/monitor", "examples/nm-dhcp-action", "examples/notify", "examples/service"); for Object_Dir use "obj/examples"; for Main use ("clientstub", "d_bus_monitor", "list_names", "nm_dhcp_client_action", "notify", "test_service"); package Compiler is for Default_Switches ("ada") use D_Bus_Ada_Common.Compiler_Switches; end Compiler; package Linker is for Default_Switches ("ada") use D_Bus_Ada_Common.Linker_Switches; end Linker; end D_Bus_Ada_Examples; libdbusada-0.2/README0000644000175000017500000000442411672337633013024 0ustar reetreetD_Bus/Ada ========= The D_Bus/Ada library provides an Ada binding to the D-Bus message bus used for inter-process communication on most modern Linux desktop systems. Licence ------- -------------------------------------------------------------------------------- Copyright (C) 2011 Reto Buerki . Free use of this software is granted under the terms of the GNAT Modified General Public License (GMGPL). -------------------------------------------------------------------------------- Download -------- Release version ~~~~~~~~~~~~~~~ The current release version of D_Bus/Ada is available at http://www.codelabs.ch/download. Verify a Release ~~~~~~~~~~~~~~~~ To verify the integrity and authenticity of the distribution tarball, import the key http://www.codelabs.ch/keys/0x3DC359DEpub.asc and type the following command: $ gpg --verify libdbusada-{version}.tar.bz2.sig The key fingerprint of the public key ('0x3DC359DE') is: Key fingerprint = 752C 4EBC 115D 5EAD 75F7 0F34 A0AE 8AD7 3DC3 59DE Development version ~~~~~~~~~~~~~~~~~~~ The current development version of D_Bus/Ada is available through its git repository: $ git clone http://git.codelabs.ch/git/dbus-ada.git A browsable version of the repository is also available here: http://git.codelabs.ch/?p=dbus-ada.git. Build ----- To compile D_Bus/Ada on your system, you need to have the following software installed: * GNAT compiler: http://www.gnu.org/software/gnat/gnat.html * Ahven (Test-Framework): http://ahven.stronglytyped.org/ * D-Bus development files and libraries: http://dbus.freedesktop.org/ * Glib with D-Bus support Testing ------- Before you install D_Bus/Ada on your system, you might want to test the library and verify that everything works as expected. D_Bus/Ada contains an unit test suite which can be run by entering the following command: $ make tests Installation ------------ To install D_Bus/Ada on your system, type the following: $ make PREFIX=/usr/local install If no `PREFIX` is specified, `$(HOME)/libraries` is used as install destination. Examples -------- D_Bus/Ada provides example code to demonstrate the usage of the D_Bus/Ada API. To build all examples type the following: $ make examples You can start an example application like so: `obj/examples/list_names`. libdbusada-0.2/examples/0000755000175000017500000000000011672337633013756 5ustar reetreetlibdbusada-0.2/examples/nm-dhcp-action/0000755000175000017500000000000011672337633016557 5ustar reetreetlibdbusada-0.2/examples/nm-dhcp-action/nm_dhcp_client_action.adb0000644000175000017500000001016311672337633023533 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Strings.Unbounded; with Ada.Environment_Variables; with Ada.Containers.Ordered_Maps; with D_Bus.Connection; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; procedure NM_DHCP_Client_Action is use Ada.Strings.Unbounded; use D_Bus; use type D_Bus.Arguments.Containers.Array_Type; Ignored_Args : constant array (1 .. 5) of Unbounded_String := (To_Unbounded_String ("PATH"), To_Unbounded_String ("SHLVL"), To_Unbounded_String ("_"), To_Unbounded_String ("PWD"), To_Unbounded_String ("dhc_dbus")); -- Env args to ignore. package Name_Value_Map_Package is new Ada.Containers.Ordered_Maps (Key_Type => Unbounded_String, Element_Type => Unbounded_String); package NVMP renames Name_Value_Map_Package; DHCP_Args : NVMP.Map; Conn : constant Connection.Connection_Type := Connection.Connect (Bus => Bus_System); Args : Arguments.Containers.Array_Type; ------------------------------------------------------------------------- procedure Append_Arg (Position : NVMP.Cursor); -- Append dhcp env arg as D-Bus dict entry to array. procedure Append_Arg (Position : NVMP.Cursor) is use D_Bus.Arguments.Containers; use D_Bus.Arguments.Basic; Value : constant String := To_String (NVMP.Element (Position)); Dict : Dict_Entry_Type; Variant : Variant_Type; Byte_Array : Array_Type; begin for B in Value'Range loop Byte_Array.Append (New_Item => +Byte'(Character'Pos (Value (B)))); end loop; Variant := Create (Source => Byte_Array); Dict := Create (Key => +To_String (NVMP.Key (Position)), Value => Variant); Args.Append (New_Item => Dict); end Append_Arg; ------------------------------------------------------------------------- procedure Filter_Arg (Name, Value : String); -- Check if given env arg should be ignored. procedure Filter_Arg (Name, Value : String) is begin if Value'Length = 0 then return; end if; for A in Ignored_Args'Range loop if Name = To_String (Ignored_Args (A)) then return; end if; end loop; DHCP_Args.Insert (Key => To_Unbounded_String (Name), New_Item => To_Unbounded_String (Value)); end Filter_Arg; begin Ada.Environment_Variables.Iterate (Process => Filter_Arg'Access); DHCP_Args.Iterate (Process => Append_Arg'Access); Connection.Request_Name (Connection => Conn, Name => "org.freedesktop.nm_dhcp_client"); Connection.Send_Signal (Connection => Conn, Object_Name => "/", Iface => "org.freedesktop.nm_dhcp_client", Name => "Event", Args => +Args); end NM_DHCP_Client_Action; libdbusada-0.2/examples/notify/0000755000175000017500000000000011672337633015266 5ustar reetreetlibdbusada-0.2/examples/notify/notify.adb0000644000175000017500000000503611672337633017252 0ustar reetreet-- -- D_Bus/Ada - Example program which does desktop notification on Linux -- -- Copyright (C) 2011 Reto Buerki -- Copyright (C) 2011 Tero Koskinen -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Text_IO; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; with D_Bus.Connection; procedure Notify is use D_Bus; use D_Bus.Arguments.Basic; use D_Bus.Arguments.Containers; -- Connect to the D-Bus session bus Conn : constant Connection.Connection_Type := Connection.Connect; Result : Arguments.Argument_List_Type; Nil_Array : Arguments.Containers.Array_Type; begin -- Workaround for 'cannot serialize empty array' problem Nil_Array.Append (+""); -- Request a name on the bus Connection.Request_Name (Connection => Conn, Name => "notify.example"); -- Call a method on a remote object Result := Connection.Call_Blocking (Connection => Conn, Destination => "org.freedesktop.Notifications", Path => "/org/freedesktop/Notifications", Iface => "org.freedesktop.Notifications", Method => "Notify", Args => +"ada.notify" & Unsigned_32'(0) & "" & "Hello" & "Hello, World from Ada!" & Nil_Array & Nil_Array & Signed_32'(-1)); Ada.Text_IO.Put ("Notify successful with ID "); Ada.Text_IO.Put_Line (U_Int32_Type (Result.First_Element).To_String); end Notify; libdbusada-0.2/examples/caller/0000755000175000017500000000000011672337633015220 5ustar reetreetlibdbusada-0.2/examples/caller/list_names.adb0000644000175000017500000000250511672337633020030 0ustar reetreetwith Ada.Text_IO; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; with D_Bus.Connection; pragma Unreferenced (D_Bus.Arguments.Basic); pragma Unreferenced (D_Bus.Arguments.Containers); procedure List_Names is use D_Bus; use D_Bus.Arguments.Basic; -- Connect to the D-Bus session bus Conn : constant Connection.Connection_Type := Connection.Connect; Result : Arguments.Argument_List_Type; procedure Print (Argument : Arguments.Argument_Type'Class); -- Print out an argument. procedure Print (Argument : Arguments.Argument_Type'Class) is begin Ada.Text_IO.Set_Col (To => 1); Ada.Text_IO.Put ("(" & Argument.Get_Code'Img & " )"); Ada.Text_IO.Set_Col (To => 10); Ada.Text_IO.Put_Line (Argument.To_String); end Print; begin -- Request a name on the bus Connection.Request_Name (Connection => Conn, Name => "dbus.ada.caller"); -- Call a method on a remote object Result := Connection.Call_Blocking (Connection => Conn, Destination => "org.freedesktop.DBus", Path => "/", Iface => "org.freedesktop.DBus", Method => "ListNames"); Ada.Text_IO.Put_Line ("Method called successfully:"); Arguments.Iterate (List => Result, Process => Print'Access); end List_Names; libdbusada-0.2/examples/monitor/0000755000175000017500000000000011672337633015445 5ustar reetreetlibdbusada-0.2/examples/monitor/d_bus_monitor.adb0000644000175000017500000000377311672337633020772 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.Connection; with D_Bus.Callbacks; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; pragma Unreferenced (D_Bus.Arguments.Basic); pragma Unreferenced (D_Bus.Arguments.Containers); procedure D_Bus_Monitor is use D_Bus; Conn : constant Connection.Connection_Type := Connection.Connect; begin Connection.Add_Match (Connection => Conn, Rule => "type='signal'"); Connection.Add_Match (Connection => Conn, Rule => "type='method_call'"); Connection.Add_Match (Connection => Conn, Rule => "type='method_return'"); Connection.Dispatch (Connection => Conn, Callback => Callbacks.Print'Access); end D_Bus_Monitor; libdbusada-0.2/examples/clientstub/0000755000175000017500000000000011672337633016132 5ustar reetreetlibdbusada-0.2/examples/clientstub/org_gnome_gconf.ads0000644000175000017500000000275011672337633021757 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- package org_gnome_GConf is function GetIOR return String; private Service : constant String := "org.gnome.GConf"; Iface : constant String := "org.gnome.GConf"; Path : constant String := "/"; end org_gnome_GConf; libdbusada-0.2/examples/clientstub/org_gnome_gconf.adb0000644000175000017500000000402611672337633021734 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.Connection; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; pragma Unreferenced (D_Bus.Arguments.Basic); pragma Unreferenced (D_Bus.Arguments.Containers); package body org_gnome_GConf is use D_Bus; use D_Bus.Arguments; ------------------------------------------------------------------------- function GetIOR return String is Conn : constant Connection.Connection_Type := Connection.Connect; Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => Service, Path => Path, Iface => Iface, Method => "GetIOR"); return Basic.String_Type (Result.First_Element).To_String; end GetIOR; end org_gnome_GConf; libdbusada-0.2/examples/clientstub/clientstub.adb0000644000175000017500000000261111672337633020756 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ada.Text_IO; with org_gnome_GConf; procedure Clientstub is begin Ada.Text_IO.Put_Line (org_gnome_GConf.GetIOR); end Clientstub; libdbusada-0.2/examples/service/0000755000175000017500000000000011672337633015416 5ustar reetreetlibdbusada-0.2/examples/service/server.adb0000644000175000017500000001011111672337633017366 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.Messages; with D_Bus.Arguments.Basic; package body Server is use D_Bus; procedure Get_Name (Request : Messages.Message_Type; Reply : out Messages.Message_Type); -- Get server name. procedure Introspect (Request : Messages.Message_Type; Reply : out Messages.Message_Type); -- Return introspection data of this service. Intro_Spect : constant String := "" & ASCII.LF & "" & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & " " & ASCII.LF & ""; -- Introspection data. ------------------------------------------------------------------------- procedure Get_Name (Request : Messages.Message_Type; Reply : out Messages.Message_Type) is use D_Bus.Arguments.Basic; begin Reply := Messages.New_Method_Return (Method_Call => Request); Messages.Add_Arguments (Msg => Reply, Args => +"Lovelace"); end Get_Name; ------------------------------------------------------------------------- procedure Initialize (Server : in out Server_Type) is begin Server.Register (Name => "Introspect", Method => Introspect'Access); Server.Register (Name => "GetName", Method => Get_Name'Access); end Initialize; ------------------------------------------------------------------------- procedure Introspect (Request : Messages.Message_Type; Reply : out Messages.Message_Type) is use D_Bus.Arguments.Basic; begin Reply := Messages.New_Method_Return (Method_Call => Request); Messages.Add_Arguments (Msg => Reply, Args => +Intro_Spect); end Introspect; end Server; libdbusada-0.2/examples/service/test_service.adb0000644000175000017500000000347011672337633020571 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.G_Main; with D_Bus.Connection.G_Main; with Server; procedure Test_Service is use D_Bus; Srv : Server.Server_Type; Conn : Connection.Connection_Type := Connection.Connect; begin Connection.Request_Name (Connection => Conn, Name => "dbus.ada.service"); Connection.G_Main.Register_Object (Connection => Conn, Path => "/org/test/object", Object => Srv); D_Bus.G_Main.Init; Connection.G_Main.Setup_With_G_Main (Connection => Conn); D_Bus.G_Main.Start; end Test_Service; libdbusada-0.2/examples/service/server.ads0000644000175000017500000000307311672337633017420 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with D_Bus.Service; package Server is type Server_Type is new D_Bus.Service.Object with private; -- Example D-Bus service. overriding procedure Initialize (Server : in out Server_Type); -- Init test server. private type Server_Type is new D_Bus.Service.Object with null record; end Server; libdbusada-0.2/gnat/0000755000175000017500000000000011672337633013071 5ustar reetreetlibdbusada-0.2/gnat/dbus_ada.gpr0000644000175000017500000000040311672337633015342 0ustar reetreetwith "dbus_ada_thin"; project DBus_Ada is for Source_Dirs use ("../../include/dbus-ada"); for Library_Name use "dbusada"; for Library_Dir use "../../lib/dbus-ada"; for Library_Kind use "dynamic"; for Externally_Built use "true"; end DBus_Ada; libdbusada-0.2/gnat/dbus_ada_thin.gpr0000644000175000017500000000040511672337633016366 0ustar reetreetproject DBus_Ada_Thin is for Source_Dirs use ("../../include/dbus-ada/thin"); for Library_Name use "dbusada-thin"; for Library_Dir use "../../lib/dbus-ada/thin"; for Library_Kind use "dynamic"; for Externally_Built use "true"; end DBus_Ada_Thin; libdbusada-0.2/AUTHORS0000644000175000017500000000003711672337633013210 0ustar reetreetReto Buerki libdbusada-0.2/d_bus_ada_tests.gpr0000644000175000017500000000327411672337633016003 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with "ahven"; with "d_bus_ada_common"; with "thin/build"; project D_Bus_Ada_Tests is for Source_Dirs use ("src", "tests"); for Object_Dir use "obj/tests"; for Main use ("runner.adb"); package Compiler is for Default_Switches ("ada") use D_Bus_Ada_Common.Compiler_Switches; end Compiler; package Linker is for Default_Switches ("ada") use D_Bus_Ada_Common.Linker_Switches; end Linker; end D_Bus_Ada_Tests; libdbusada-0.2/d_bus_ada_common.gpr0000644000175000017500000000344011672337633016124 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- project D_Bus_Ada_Common is for Source_Dirs use (); Version := external ("VERSION", "unknown"); Compiler_Switches := ("-gnatygAdISuxo", "-gnatVa", "-gnat05", "-gnatwal", "-gnatf", "-fstack-check", "-gnato", "-g"); Linker_Switches := ("-ldbus-1", "-ldbus-glib-1", "-lglib-2.0"); end D_Bus_Ada_Common; libdbusada-0.2/tests/0000755000175000017500000000000011672337633013302 5ustar reetreetlibdbusada-0.2/tests/config.ads0000644000175000017500000000036611672337633015245 0ustar reetreetpackage Config is procedure Init; -- Wait for D-Bus test server and read remote address from file. function Service_Addr return String; -- Return remote D-Bus address of the test server. Config_Error : exception; end Config; libdbusada-0.2/tests/utils.adb0000644000175000017500000000230511672337633015112 0ustar reetreetwith Ada.Text_IO; with Ada.IO_Exceptions; package body Utils is ------------------------------------------------------------------------- function Read_Line_From_File (Filename : String) return String is File : Ada.Text_IO.File_Type; begin begin Ada.Text_IO.Open (File => File, Mode => Ada.Text_IO.In_File, Name => Filename, Form => "shared=no"); exception when others => raise Open_File_Error with "Unable to open file '" & Filename & "'"; end; Read_Line : begin declare Line : constant String := Ada.Text_IO.Get_Line (File => File); begin Ada.Text_IO.Close (File); return Line; end; exception when Ada.IO_Exceptions.End_Error => Ada.Text_IO.Close (File); raise IO_Error with "Unable to read line from empty " & "file '" & Filename & "'"; when others => Ada.Text_IO.Close (File); raise IO_Error with "Error reading data from file '" & Filename & "'"; end Read_Line; end Read_Line_From_File; end Utils; libdbusada-0.2/tests/utils.ads0000644000175000017500000000032011672337633015126 0ustar reetreetpackage Utils is function Read_Line_From_File (Filename : String) return String; -- Return first text line read from the file given by Filename. Open_File_Error, IO_Error : exception; end Utils; libdbusada-0.2/tests/arguments_basic_tests.adb0000644000175000017500000003250111672337633020343 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven; with Config; with D_Bus.Connection; with D_Bus.Arguments.Basic; package body Arguments_Basic_Tests is use Ahven; use D_Bus; use D_Bus.Arguments; use D_Bus.Arguments.Basic; ------------------------------------------------------------------------- procedure Initialize (T : in out Testcase) is begin T.Set_Name (Name => "Basic arguments handling"); T.Add_Test_Routine (Routine => Marshal_String_Type'Access, Name => "Marshal/unmarshal string type"); T.Add_Test_Routine (Routine => Marshal_Boolean_Type'Access, Name => "Marshal/unmarshal boolean type"); T.Add_Test_Routine (Routine => Marshal_U_Int64_Type'Access, Name => "Marshal/unmarshal uint64 type"); T.Add_Test_Routine (Routine => Marshal_Int64_Type'Access, Name => "Marshal/unmarshal int64 type"); T.Add_Test_Routine (Routine => Marshal_U_Int32_Type'Access, Name => "Marshal/unmarshal uint32 type"); T.Add_Test_Routine (Routine => Marshal_Int32_Type'Access, Name => "Marshal/unmarshal int32 type"); T.Add_Test_Routine (Routine => Marshal_U_Int16_Type'Access, Name => "Marshal/unmarshal uint16 type"); T.Add_Test_Routine (Routine => Marshal_Int16_Type'Access, Name => "Marshal/unmarshal int16 type"); T.Add_Test_Routine (Routine => Marshal_Byte_Type'Access, Name => "Marshal/unmarshal byte type"); end Initialize; ------------------------------------------------------------------------- procedure Marshal_Boolean_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +True); declare Bool : constant Boolean_Type := Boolean_Type (Result.First_Element); begin Assert (Condition => Bool.To_Ada, Message => "Result not True"); end; end Marshal_Boolean_Type; ------------------------------------------------------------------------- procedure Marshal_Byte_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Byte'Last); declare B : constant Byte_Type := Byte_Type (Result.First_Element); begin Assert (Condition => B.To_Ada = Byte'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Byte'First); declare B : constant Byte_Type := Byte_Type (Result.First_Element); begin Assert (Condition => B.To_Ada = Byte'First, Message => "Incorrect lower bound"); end; end Marshal_Byte_Type; ------------------------------------------------------------------------- procedure Marshal_Int16_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_16'Last); declare Int16 : constant Int16_Type := Int16_Type (Result.First_Element); begin Assert (Condition => Int16.To_Ada = Signed_16'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_16'First); declare Int16 : constant Int16_Type := Int16_Type (Result.First_Element); begin Assert (Condition => Int16.To_Ada = Signed_16'First, Message => "Incorrect lower bound"); end; end Marshal_Int16_Type; ------------------------------------------------------------------------- procedure Marshal_Int32_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_32'Last); declare Int32 : constant Int32_Type := Int32_Type (Result.First_Element); begin Assert (Condition => Int32.To_Ada = Signed_32'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_32'First); declare Int32 : constant Int32_Type := Int32_Type (Result.First_Element); begin Assert (Condition => Int32.To_Ada = Signed_32'First, Message => "Incorrect lower bound"); end; end Marshal_Int32_Type; ------------------------------------------------------------------------- procedure Marshal_Int64_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_64'Last); declare Int64 : constant Int64_Type := Int64_Type (Result.First_Element); begin Assert (Condition => Int64.To_Ada = Signed_64'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Signed_64'First); declare Int64 : constant Int64_Type := Int64_Type (Result.First_Element); begin Assert (Condition => Int64.To_Ada = Signed_64'First, Message => "Incorrect lower bound"); end; end Marshal_Int64_Type; ------------------------------------------------------------------------- procedure Marshal_String_Type is Ref_Str : constant String := "this is a teststring"; Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Ref_Str); Assert (Condition => Ref_Str = Result.First_Element.To_String, Message => "String type mismatch"); end Marshal_String_Type; ------------------------------------------------------------------------- procedure Marshal_U_Int16_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_16'Last); declare U_Int16 : constant U_Int16_Type := U_Int16_Type (Result.First_Element); begin Assert (Condition => U_Int16.To_Ada = Unsigned_16'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_16'First); declare U_Int16 : constant U_Int16_Type := U_Int16_Type (Result.First_Element); begin Assert (Condition => U_Int16.To_Ada = Unsigned_16'First, Message => "Incorrect lower bound"); end; end Marshal_U_Int16_Type; ------------------------------------------------------------------------- procedure Marshal_U_Int32_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_32'Last); declare U_Int32 : constant U_Int32_Type := U_Int32_Type (Result.First_Element); begin Assert (Condition => U_Int32.To_Ada = Unsigned_32'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_32'First); declare U_Int32 : constant U_Int32_Type := U_Int32_Type (Result.First_Element); begin Assert (Condition => U_Int32.To_Ada = Unsigned_32'First, Message => "Incorrect lower bound"); end; end Marshal_U_Int32_Type; ------------------------------------------------------------------------- procedure Marshal_U_Int64_Type is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Argument_List_Type; begin Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_64'Last); declare U_Int64 : constant U_Int64_Type := U_Int64_Type (Result.First_Element); begin Assert (Condition => U_Int64.To_Ada = Unsigned_64'Last, Message => "Incorrect upper bound"); end; Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +Unsigned_64'First); declare U_Int64 : constant U_Int64_Type := U_Int64_Type (Result.First_Element); begin Assert (Condition => U_Int64.To_Ada = Unsigned_64'First, Message => "Incorrect lower bound"); end; end Marshal_U_Int64_Type; end Arguments_Basic_Tests; libdbusada-0.2/tests/arguments_container_tests.ads0000644000175000017500000000426611672337633021274 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven.Framework; package Arguments_Container_Tests is type Testcase is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Testcase); -- Initialize testcase. procedure Append_To_Array; -- Verify array append operation. procedure Marshal_Array_Of_Strings; -- Verify serialization/deserialization of array of strings. procedure Marshal_Array_Of_Arrays_Of_Strings; -- Verify serialization/deserialization of an array of arrays of strings. procedure Marshal_Struct; -- Verify serialization/deserialization of struct. procedure Marshal_Dict_Entries; -- Verify serialization/deserialization of dict entries. procedure Marshal_Dict_Entries_With_Variant_Value; -- Verify serialization/deserialization of dict entries with variant -- values. procedure Marshal_Variant; -- Verify serialization/deserialization of variant. end Arguments_Container_Tests; libdbusada-0.2/tests/service_tests.adb0000644000175000017500000001035511672337633016640 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven; with D_Bus.Service; with D_Bus.Messages; package body Service_Tests is use Ahven; use D_Bus; use D_Bus.Service; type Test_Object is new Object with null record; procedure Initialize (Obj : in out Test_Object); -- Initialize test object. procedure Test_Method (Request : Messages.Message_Type; Reply : out Messages.Message_Type); -- Method used for testing the service object. Called_Counter : Natural := 0; ------------------------------------------------------------------------- procedure Duplicate_Methods is Obj : Test_Object; begin Obj.Register (Name => "TestMethod", Method => Test_Method'Access); begin Obj.Register (Name => "TestMethod", Method => Test_Method'Access); Fail (Message => "Exception expected"); exception when Duplicate_Method => null; end; end Duplicate_Methods; ------------------------------------------------------------------------- procedure Initialize (Obj : in out Test_Object) is begin Obj.Register (Name => "TestMethod", Method => Test_Method'Access); end Initialize; ------------------------------------------------------------------------- procedure Initialize (T : in out Testcase) is begin T.Set_Name (Name => "Service objects"); T.Add_Test_Routine (Routine => Register_Method'Access, Name => "Register service method"); T.Add_Test_Routine (Routine => Unknown_Method'Access, Name => "Call unknown method"); T.Add_Test_Routine (Routine => Duplicate_Methods'Access, Name => "Register same method twice"); end Initialize; ------------------------------------------------------------------------- procedure Register_Method is Obj : Test_Object; Req : Messages.Message_Type; Rep : Messages.Message_Type; pragma Unreferenced (Rep); begin Obj.Initialize; Obj.Call (Name => "TestMethod", Request => Req, Reply => Rep); Assert (Condition => Called_Counter = 1, Message => "Method not called"); end Register_Method; ------------------------------------------------------------------------- procedure Test_Method (Request : Messages.Message_Type; Reply : out Messages.Message_Type) is pragma Unreferenced (Request, Reply); begin Called_Counter := Called_Counter + 1; end Test_Method; ------------------------------------------------------------------------- procedure Unknown_Method is Obj : Test_Object; Req : Messages.Message_Type; Rep : Messages.Message_Type; pragma Unreferenced (Rep); begin Obj.Call (Name => "Unknown", Request => Req, Reply => Rep); exception when Service.Unknown_Method => null; end Unknown_Method; end Service_Tests; libdbusada-0.2/tests/service_tests.ads0000644000175000017500000000327511672337633016664 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven.Framework; package Service_Tests is type Testcase is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Testcase); -- Initialize testcase. procedure Register_Method; -- Register a service method. procedure Unknown_Method; -- Verify handling of unknown method calls. procedure Duplicate_Methods; -- Verify handling of duplicate method registration. end Service_Tests; libdbusada-0.2/tests/config.adb0000644000175000017500000000203711672337633015221 0ustar reetreetwith Ada.Text_IO; with Ada.Directories; with Ada.Strings.Unbounded; with Utils; pragma Elaborate_All (Utils); package body Config is use Ada.Strings.Unbounded; Addr_File : constant String := "./dbusada.addr"; Remote_Addr : Unbounded_String; ------------------------------------------------------------------------- procedure Init is Counter : Natural := 0; begin loop exit when Ada.Directories.Exists (Name => Addr_File); if Counter > 400 then raise Config_Error with "D-Bus test server not available"; end if; delay 0.01; Counter := Counter + 1; end loop; Remote_Addr := To_Unbounded_String (Utils.Read_Line_From_File (Filename => Addr_File)); Ada.Text_IO.Put_Line ("* Using test server at " & Service_Addr); end Init; ------------------------------------------------------------------------- function Service_Addr return String is begin return To_String (Remote_Addr); end Service_Addr; end Config; libdbusada-0.2/tests/arguments_tests.ads0000644000175000017500000000302411672337633017221 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven.Framework; package Arguments_Tests is type Testcase is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Testcase); -- Initialize testcase. procedure List_Append; -- Append arguments to list. end Arguments_Tests; libdbusada-0.2/tests/runner.adb0000644000175000017500000000406411672337633015267 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven.Text_Runner; with Ahven.Framework; with Config; with Arguments_Tests; with Arguments_Basic_Tests; with Arguments_Container_Tests; with Service_Tests; procedure Runner is S : constant Ahven.Framework.Test_Suite_Access := Ahven.Framework.Create_Suite (Suite_Name => "dbus-ada tests"); begin Config.Init; Ahven.Framework.Add_Test (Suite => S.all, T => new Arguments_Tests.Testcase); Ahven.Framework.Add_Test (Suite => S.all, T => new Arguments_Basic_Tests.Testcase); Ahven.Framework.Add_Test (Suite => S.all, T => new Arguments_Container_Tests.Testcase); Ahven.Framework.Add_Test (Suite => S.all, T => new Service_Tests.Testcase); Ahven.Text_Runner.Run (Suite => S); Ahven.Framework.Release_Suite (T => S); end Runner; libdbusada-0.2/tests/c/0000755000175000017500000000000011672337633013524 5ustar reetreetlibdbusada-0.2/tests/c/dbus-rebound.c0000644000175000017500000000633711672337633016272 0ustar reetreet/* * D_Bus/Ada - An Ada binding to D-Bus * * Copyright (C) 2011 Reto Buerki * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, * USA. */ #include #include #include #define NAME "dbus.ada.server" #define ADDR "./dbusada.addr" static DBusServer *server = NULL; static GMainLoop *loop = NULL; static void assert_no_error (const DBusError *e) { if (G_UNLIKELY (dbus_error_is_set (e))) { g_error ("Got error: %s: %s", e->name, e->message); } } static DBusHandlerResult message_handler (DBusConnection *conn, DBusMessage *msg, void *data) { DBusMessage* reply; dbus_uint32_t serial, r_serial = 0; const dbus_uint32_t s_serial = dbus_message_get_serial (msg); const char *dest = dbus_message_get_sender (msg); reply = dbus_message_copy (msg); if (!dbus_message_set_reply_serial (reply, s_serial)) { g_error ("Could not set reply serial"); } if (!dbus_message_set_sender (reply, NAME)) { g_error ("Could not set sender name"); } if (!dbus_message_set_destination (reply, dest)) { g_error ("Could not set destination"); } /* send the reply && flush the connection */ if (!dbus_connection_send (conn, reply, &serial)) { g_error ("Out of memory"); } dbus_connection_flush (conn); dbus_message_unref (reply); return DBUS_HANDLER_RESULT_HANDLED; } static void handle_connection (DBusServer *server, DBusConnection *conn, void *data) { DBusObjectPathVTable vtable = { NULL, &message_handler, NULL, NULL, NULL, NULL }; if (!dbus_connection_register_object_path (conn, "/", &vtable, NULL)) { g_error ("Can't register local test object"); return; } dbus_connection_ref(conn); dbus_connection_setup_with_g_main(conn, NULL); } static void setup () { char *address; DBusError err; int fd, len; dbus_error_init (&err); server = dbus_server_listen ("unix:tmpdir=/tmp", &err); assert_no_error (&err); g_assert (server != NULL); address = dbus_server_get_address (server); if (!g_file_set_contents (ADDR, address, -1, NULL)) { g_error ("Can't create server address file"); } dbus_free (address); dbus_server_setup_with_g_main (server, NULL); dbus_server_set_new_connection_function (server, handle_connection, NULL, NULL); } static void teardown () { if (server != NULL) { dbus_server_disconnect (server); dbus_server_unref (server); server = NULL; } g_unlink (ADDR); } void sigterm () { g_main_loop_quit (loop); } int main (int argc, char **argv) { signal(SIGTERM, sigterm); loop = g_main_loop_new (NULL, FALSE); setup (); g_main_loop_run (loop); teardown(); } libdbusada-0.2/tests/arguments_container_tests.adb0000644000175000017500000002567511672337633021262 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven; with Config; with D_Bus.Connection; with D_Bus.Arguments.Basic; with D_Bus.Arguments.Containers; package body Arguments_Container_Tests is use Ahven; use D_Bus; use D_Bus.Arguments.Basic; use D_Bus.Arguments.Containers; ------------------------------------------------------------------------- procedure Append_To_Array is A : Array_Type; begin A.Append (New_Item => +Unsigned_32'(1232)); begin A.Append (New_Item => +"testmessage"); Fail (Message => "Expected D-Bus error"); exception when D_Bus_Error => null; end; end Append_To_Array; ------------------------------------------------------------------------- procedure Initialize (T : in out Testcase) is begin T.Set_Name (Name => "Container arguments handling"); T.Add_Test_Routine (Routine => Append_To_Array'Access, Name => "Append to array"); T.Add_Test_Routine (Routine => Marshal_Array_Of_Strings'Access, Name => "Marshal/unmarshal array of strings"); T.Add_Test_Routine (Routine => Marshal_Array_Of_Arrays_Of_Strings'Access, Name => "Marshal/unmarshal array of arrays of strings"); T.Add_Test_Routine (Routine => Marshal_Struct'Access, Name => "Marshal/unmarshal struct"); T.Add_Test_Routine (Routine => Marshal_Dict_Entries'Access, Name => "Marshal/unmarshal dict entries"); T.Add_Test_Routine (Routine => Marshal_Dict_Entries_With_Variant_Value'Access, Name => "Marshal/unmarshal dict entries with variants"); T.Add_Test_Routine (Routine => Marshal_Variant'Access, Name => "Marshal/unmarshal variant"); end Initialize; ------------------------------------------------------------------------- procedure Marshal_Array_Of_Arrays_Of_Strings is -- Marshal/unmarshal an array of arrays of strings. Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; A1 : Array_Type; A2 : Array_Type; begin A2.Append (New_Item => +"string1"); A2.Append (New_Item => +"string2"); A2.Append (New_Item => +"string3"); A1.Append (New_Item => A2); A1.Append (New_Item => A2); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +A1); declare R_A : constant Array_Type := Array_Type (Result.First_Element); begin Assert (Condition => R_A.Get_Count = 2, Message => "Count not 2"); Assert (Condition => Array_Type (R_A.First_Element).Get_Count = 3, Message => "String count not 3 (1)"); Assert (Condition => Array_Type (R_A.Last_Element).Get_Count = 3, Message => "String count not 3 (2)"); end; end Marshal_Array_Of_Arrays_Of_Strings; ------------------------------------------------------------------------- procedure Marshal_Array_Of_Strings is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; A : Array_Type; begin A.Append (New_Item => +"string1"); A.Append (New_Item => +"string2"); A.Append (New_Item => +"string3"); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +A); declare R_A : constant Array_Type := Array_Type (Result.First_Element); begin Assert (Condition => R_A.Get_Count = 3, Message => "Count not 3"); Assert (Condition => String_Type (R_A.First_Element).To_String = "string1", Message => "First element not string1"); Assert (Condition => String_Type (R_A.Last_Element).To_String = "string3", Message => "Last element not string3"); end; end Marshal_Array_Of_Strings; ------------------------------------------------------------------------- procedure Marshal_Dict_Entries is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; A : Array_Type; D : Dict_Entry_Type; begin D := Create (Key => +Signed_16'(1234), Value => +"value"); A.Append (New_Item => D); A.Append (New_Item => D); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +A); declare R_A : constant Array_Type := Array_Type (Result.First_Element); D1, D2 : Dict_Entry_Type; begin Assert (Condition => R_A.Get_Count = 2, Message => "Count not 2"); D1 := Dict_Entry_Type (R_A.First_Element); D2 := Dict_Entry_Type (R_A.Last_Element); Assert (Condition => Int16_Type (D1.Get_Key).To_Ada = 1234, Message => "D1 key not 1234"); Assert (Condition => Int16_Type (D2.Get_Key).To_Ada = 1234, Message => "D2 key not 1234"); Assert (Condition => String_Type (D1.Get_Value).To_String = "value", Message => "D1 value mismatch"); Assert (Condition => String_Type (D2.Get_Value).To_String = "value", Message => "D2 value mismatch"); end; end Marshal_Dict_Entries; ------------------------------------------------------------------------- procedure Marshal_Dict_Entries_With_Variant_Value is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; A : Array_Type; D : Dict_Entry_Type; V : Variant_Type; begin V := Create (Source => +Unsigned_32'(12)); D := Create (Key => +Signed_16'(1234), Value => V); A.Append (New_Item => D); A.Append (New_Item => D); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +A); declare R_A : constant Array_Type := Array_Type (Result.First_Element); D1, D2 : Dict_Entry_Type; begin Assert (Condition => R_A.Get_Count = 2, Message => "Count not 2"); D1 := Dict_Entry_Type (R_A.First_Element); D2 := Dict_Entry_Type (R_A.Last_Element); Assert (Condition => Int16_Type (D1.Get_Key).To_Ada = 1234, Message => "D1 key not 1234"); Assert (Condition => Int16_Type (D2.Get_Key).To_Ada = 1234, Message => "D2 key not 1234"); Assert (Condition => Variant_Type (D1.Get_Value).To_String = "u, 12", Message => "D1 value mismatch"); Assert (Condition => Variant_Type (D2.Get_Value).To_String = "u, 12", Message => "D2 value mismatch"); end; end Marshal_Dict_Entries_With_Variant_Value; ------------------------------------------------------------------------- procedure Marshal_Struct is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; R : Struct_Type; begin R.Append (New_Item => +Signed_32'(-45653)); R.Append (New_Item => +Boolean'(False)); R.Append (New_Item => +Byte'(254)); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +R); declare R_R : constant Struct_Type := Struct_Type (Result.First_Element); begin Assert (Condition => R_R.Get_Count = 3, Message => "Count not 3"); Assert (Condition => Int32_Type (R_R.First_Element).To_Ada = -45653, Message => "First element mismatch"); Assert (Condition => Byte_Type (R_R.Last_Element).To_Ada = 254, Message => "Last element mismatch"); end; end Marshal_Struct; ------------------------------------------------------------------------- procedure Marshal_Variant is Conn : constant Connection.Connection_Type := Connection.Connect (Address => Config.Service_Addr); Result : Arguments.Argument_List_Type; V : Variant_Type; begin V := Create (Source => +Unsigned_32'(123456)); Result := Connection.Call_Blocking (Connection => Conn, Destination => "dbus.ada.server", Path => "/", Iface => "dbus.ada.server.type", Method => "rebound", Args => +V); declare R_V : constant Variant_Type := Variant_Type (Result.First_Element); begin Assert (Condition => U_Int32_Type (R_V.Get_Argument).To_Ada = 123456, Message => "Arg mismatch"); end; end Marshal_Variant; end Arguments_Container_Tests; libdbusada-0.2/tests/arguments_basic_tests.ads0000644000175000017500000000447111672337633020371 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven.Framework; package Arguments_Basic_Tests is type Testcase is new Ahven.Framework.Test_Case with null record; procedure Initialize (T : in out Testcase); -- Initialize testcase. procedure Marshal_String_Type; -- Verify serialization/deserialization of string type. procedure Marshal_Boolean_Type; -- Verify serialization/deserialization of boolean type. procedure Marshal_U_Int64_Type; -- Verify serialization/deserialization of U_Int64 type. procedure Marshal_Int64_Type; -- Verify serialization/deserialization of Int64 type. procedure Marshal_U_Int32_Type; -- Verify serialization/deserialization of U_Int32 type. procedure Marshal_Int32_Type; -- Verify serialization/deserialization of Int32 type. procedure Marshal_U_Int16_Type; -- Verify serialization/deserialization of U_Int16 type. procedure Marshal_Int16_Type; -- Verify serialization/deserialization of Int16 type. procedure Marshal_Byte_Type; -- Verify serialization/deserialization of byte type. end Arguments_Basic_Tests; libdbusada-0.2/tests/arguments_tests.adb0000644000175000017500000000450211672337633017202 0ustar reetreet-- -- D_Bus/Ada - An Ada binding to D-Bus -- -- Copyright (C) 2011 Reto Buerki -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License -- as published by the Free Software Foundation; either version 2 -- of the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -- USA. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an -- executable this unit does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU Public License. -- with Ahven; with D_Bus.Arguments.Basic; package body Arguments_Tests is use Ahven; use D_Bus; use D_Bus.Arguments; ------------------------------------------------------------------------- procedure Initialize (T : in out Testcase) is begin T.Set_Name (Name => "Arguments handling"); T.Add_Test_Routine (Routine => List_Append'Access, Name => "Append arguments to list"); end Initialize; ------------------------------------------------------------------------- procedure List_Append is L : Argument_List_Type; B : Basic.String_Type; begin Assert (Condition => L.Is_Empty, Message => "New list not empty1"); Assert (Condition => L.Get_Count = 0, Message => "New list not empty2"); L.Append (New_Item => B); L.Append (New_Item => B); Assert (Condition => L.Get_Count = 2, Message => "Count not 2"); Assert (Condition => not L.Is_Empty, Message => "List is empty"); end List_Append; end Arguments_Tests; libdbusada-0.2/Makefile0000644000175000017500000000454311672337633013606 0ustar reetreetPREFIX ?= $(HOME)/libraries TESTDIR = tests OBJDIR = obj LIBDIR = lib SRCDIR = src THINDIR = thin DOCDIR = doc/html GPR_FILES = gnat/*.gpr PKGCONF = `pkg-config --cflags --libs dbus-glib-1` TESTBIN = $(OBJDIR)/tests/rebounder TESTPID = `pidof rebounder` MAJOR = 0 MINOR = 2 VERSION = $(MAJOR).$(MINOR) DBUSADA = libdbusada-$(VERSION) TARBALL = $(DBUSADA).tar.bz2 SO_LIBRARY = libdbusada.so.$(VERSION) SO_LIBRARY_THIN = libdbusada-thin.so.$(VERSION) LIBRARY_KIND = dynamic PREPARE := $(shell mkdir -p $(OBJDIR)) all: build_lib build_lib: @gnatmake -p -Pd_bus_ada_lib -XVERSION="$(VERSION)" \ -XLIBRARY_KIND="$(LIBRARY_KIND)" build_tests: @gnatmake -p -Pd_bus_ada_tests build_examples: @gnatmake -p -Pd_bus_ada_examples -XVERSION="$(VERSION)" \ -XLIBRARY_KIND="$(LIBRARY_KIND)" install: install_lib install_$(LIBRARY_KIND) install_lib: build_lib install -d $(PREFIX)/include/dbus-ada/thin install -d $(PREFIX)/lib/dbus-ada/thin install -d $(PREFIX)/lib/gnat install -m 644 $(SRCDIR)/*.ad[bs] $(PREFIX)/include/dbus-ada install -m 644 $(THINDIR)/*.ad[bs] $(PREFIX)/include/dbus-ada/thin install -m 444 $(LIBDIR)/*.ali $(PREFIX)/lib/dbus-ada install -m 444 $(LIBDIR)/thin/*.ali $(PREFIX)/lib/dbus-ada/thin install -m 644 $(GPR_FILES) $(PREFIX)/lib/gnat install_static: install -m 444 $(LIBDIR)/libdbusada.a $(PREFIX)/lib/dbus-ada install -m 444 $(LIBDIR)/thin/libdbusada-thin.a $(PREFIX)/lib/dbus-ada/thin install_dynamic: install -m 444 $(LIBDIR)/$(SO_LIBRARY) $(PREFIX)/lib/dbus-ada install -m 444 $(LIBDIR)/thin/$(SO_LIBRARY_THIN) $(PREFIX)/lib/dbus-ada/thin cd $(PREFIX)/lib/dbus-ada && \ ln -sf $(SO_LIBRARY) libdbusada.so && \ ln -sf $(SO_LIBRARY) libdbusada.so.$(MAJOR) cd $(PREFIX)/lib/dbus-ada/thin && \ ln -sf $(SO_LIBRARY_THIN) libdbusada-thin.so && \ ln -sf $(SO_LIBRARY_THIN) libdbusada-thin.so.$(MAJOR) tests: build_tests $(TESTBIN) @$(TESTBIN) & @$(OBJDIR)/tests/runner || true @kill $(TESTPID) examples: build_examples $(TESTBIN): $(TESTDIR)/c/dbus-rebound.c gcc $? $(PKGCONF) -o $@ doc: @$(MAKE) -C doc clean: @rm -rf $(OBJDIR) @rm -rf $(LIBDIR) @rm -rf $(DOCDIR) dist: @echo "Creating release tarball $(TARBALL) ... " @git archive --format=tar HEAD --prefix $(DBUSADA)/ | bzip2 > $(TARBALL) .PHONY: build_examples build_lib build_tests dist doc install install_dynamic \ install_lib install_static tests