├── .ditz-config ├── .gitignore ├── bugs ├── issue-02f87f195173dcb71afb17b87a1cae1fe105f8c2.yaml ├── issue-0749e4c3cb64863c22480499d203fe68d4141885.yaml ├── issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml ├── issue-22aa16299e7c1ecd68d2ce7852a768929028e3f3.yaml ├── issue-23861ef1324f6316848582a5636055e9497cbd92.yaml ├── issue-24992d0ce785d18d70ee0aeb17c5a5fdecdc5354.yaml ├── issue-25a39c12de2cd7101903148ee7dafdc3e5d790ae.yaml ├── issue-27f069ca44609eacd23170c3ab5129a3912e76b8.yaml ├── issue-2a5b1345992e962cba5bee884428314fee1bf064.yaml ├── issue-2f4e005e8d303828a7607922edd996b9faf0c5d9.yaml ├── issue-39d60c033f5310200786db0a8c3974d754e051de.yaml ├── issue-41e0963df897d6800ef9b4c3abbc9c3ee46f14da.yaml ├── issue-5a278efa6750438ee40072f35e694cd312cf250c.yaml ├── issue-63c3a59fe7aee4e4fcae00d98e34ba5c720fa5ae.yaml ├── issue-648ddb6ff7319e4137b4eec870d1506d8a6883e7.yaml ├── issue-66999cce178a0179fddcb4e1b9d6ac6ba2473190.yaml ├── issue-6f97cba44fb67ffe961ebbef18c516d3b2441dd9.yaml ├── issue-81334381f6a1febaf00a4374413bb963a3338708.yaml ├── issue-8261541fb544c3072370c3e91a23a1a15487cc2b.yaml ├── issue-851f4edcff20a72b77b2ab9894724ffa3604711a.yaml ├── issue-88756a6cd1cd743ffaecede0345087107030e3a5.yaml ├── issue-88836c61db109ee78dec552d38cde9fc66deac35.yaml ├── issue-8984e8bd247c90393388d26ee7c34743399fe6c4.yaml ├── issue-9d580aeb583e4c619dc06c8318232242fe7d3438.yaml ├── issue-a2340a465d5e5475ce246455ca8a3254760d0154.yaml ├── issue-ac7fa2746fbaed907e43aa3a690a744062fc7392.yaml ├── issue-b04f8b7353dd92900dacb7c30562331c34561171.yaml ├── issue-bb8c71d21d73d1ad594c73f0ac5ac8a6db82729c.yaml ├── issue-cd59e8bd909376222bd16cf13c8558a3a024a309.yaml ├── issue-ceea6984eef15f2ae49e03107ece93c2b5bf665a.yaml ├── issue-cf07ca46a08df70101af93054bc68d4dd7b6fe5a.yaml ├── issue-cfea3701e083cb14b1103abaedf953298163c4a9.yaml ├── issue-d0e2cd10341f9ea26673090eba5698c19c01eaa2.yaml ├── issue-df143d2fb5d923fc265fff6b8cdba490af89633f.yaml ├── issue-ed99e9ad80242712fe92e0a6d8f3925ae30bd3ed.yaml ├── issue-f26913fe08284ee04e9d0a3f6acd36faa2341aae.yaml └── project.yaml ├── cairo ├── cairo.demo.lisp ├── cairo.lisp ├── cairo.package.lisp └── cl-gtk2-cairo.asd ├── doc ├── .gitignore ├── Makefile ├── colorize-lisp-examples.lisp ├── common.texi.inc ├── doc.html ├── doc.xml ├── fix-tex-references-1.sh ├── fix-tex-references.sh ├── gdk.enums.texi ├── gdk.flags.texi ├── gdk.objects.texi ├── gdk.ref.texi ├── gdk.structs.texi ├── glib.ref.texi ├── gobject.ref.texi ├── gobject.texi ├── gtk.enums.texi ├── gtk.flags.texi ├── gtk.interfaces.texi ├── gtk.main_loop.texi ├── gtk.objects.texi ├── gtk.ref.texi ├── gtk.structs.texi ├── gtk.texi ├── gtk.widgets.texi ├── hello.lisp ├── hello_world.png ├── introspection.lisp ├── let-ui-glext.png ├── let-ui.png ├── lisp_ide.png ├── references │ └── gobject.type-info │ │ ├── .atdoc.xml │ │ ├── header.gif │ │ ├── index.css │ │ └── index.html ├── schemas.xml ├── skeleton.lisp ├── style.css ├── tutorial.html ├── tutorial.xml └── widget-screenshot.lisp ├── gdk ├── cl-gtk2-gdk.asd ├── gdk.bitmaps.lisp ├── gdk.colors.lisp ├── gdk.cursor.lisp ├── gdk.display.lisp ├── gdk.drag-and-drop.lisp ├── gdk.drawing-primitives.lisp ├── gdk.events.lisp ├── gdk.functions.lisp ├── gdk.gc.lisp ├── gdk.general.lisp ├── gdk.images.lisp ├── gdk.input-devices.lisp ├── gdk.key-values.lisp ├── gdk.objects.lisp ├── gdk.package.lisp ├── gdk.pango.lisp ├── gdk.pixbufs.lisp ├── gdk.region.lisp ├── gdk.rgb.lisp ├── gdk.screen.lisp ├── gdk.selections.lisp ├── gdk.threads.lisp ├── gdk.visual.lisp └── gdk.windows.lisp ├── generating.lisp ├── glib ├── cl-gtk2-glib.asd ├── glib.gerror.lisp ├── glib.glist.lisp ├── glib.gstrv.lisp ├── glib.lisp ├── glib.quark.lisp ├── glib.rand.lisp ├── glib.string.lisp ├── glib.utils.lisp ├── gobject.boxed.lisp ├── gobject.cffi-callbacks.lisp ├── gobject.ffi.lisp ├── gobject.ffi.package.lisp ├── gobject.foreign-gobject-subclassing.lisp ├── gobject.foreign.lisp ├── gobject.generating.lisp ├── gobject.gvalue.lisp ├── gobject.init.lisp ├── gobject.meta.lisp ├── gobject.object-defs.lisp ├── gobject.object-function.lisp ├── gobject.object.high.lisp ├── gobject.object.low.lisp ├── gobject.package.lisp ├── gobject.signals.lisp ├── gobject.stable-pointer.lisp ├── gobject.type-designator.lisp ├── gobject.type-info.enum.lisp ├── gobject.type-info.lisp ├── gobject.type-info.object.lisp ├── gobject.type-info.signals.lisp ├── gobject.type-tests.lisp └── gobject.type-tests.sh ├── gtk-glext ├── cl-gtk2-gtkglext.asd ├── demo.lisp ├── gtkglext-drawing-area.lisp ├── gtkglext.lisp └── gtkglext.package.lisp ├── gtk ├── cl-gtk2-gtk.asd ├── demo │ ├── demo1.ui │ ├── presence_online.png │ └── text-editor.ui ├── gtk.about-dialog.lisp ├── gtk.assistant.lisp ├── gtk.base-classes.lisp ├── gtk.box.lisp ├── gtk.builder.lisp ├── gtk.calendar.lisp ├── gtk.cell-layout.lisp ├── gtk.cell-renderer.lisp ├── gtk.child-properties.lisp ├── gtk.clipboard.lisp ├── gtk.combo-box.lisp ├── gtk.container.lisp ├── gtk.demo.lisp ├── gtk.dialog.example.lisp ├── gtk.dialog.lisp ├── gtk.dnd.lisp ├── gtk.entry.lisp ├── gtk.finalize-classes.lisp ├── gtk.functions.lisp ├── gtk.generated-child-properties.lisp ├── gtk.generated-classes.lisp ├── gtk.high-level.lisp ├── gtk.icon-factory.lisp ├── gtk.icon-view.lisp ├── gtk.image.lisp ├── gtk.label.lisp ├── gtk.layout-containers.lisp ├── gtk.link-button.lisp ├── gtk.list-store.lisp ├── gtk.main-loop-events.lisp ├── gtk.main_loop_events.lisp ├── gtk.menu.lisp ├── gtk.misc.lisp ├── gtk.object.lisp ├── gtk.objects.lisp ├── gtk.package.lisp ├── gtk.paned.lisp ├── gtk.printing.lisp ├── gtk.progress-bar.lisp ├── gtk.scale-button.lisp ├── gtk.scrolling.lisp ├── gtk.selections.lisp ├── gtk.selectors.lisp ├── gtk.size-group.lisp ├── gtk.spin-button.lisp ├── gtk.status-bar.lisp ├── gtk.status-icon.lisp ├── gtk.text-entry.lisp ├── gtk.text.lisp ├── gtk.timer.lisp ├── gtk.tooltip.lisp ├── gtk.tree-model-filter.lisp ├── gtk.tree-model.lisp ├── gtk.tree-selection.lisp ├── gtk.tree-store.lisp ├── gtk.tree-view-column.lisp ├── gtk.tree-view-dnd.lisp ├── gtk.tree-view.lisp ├── gtk.ui-manager.lisp ├── gtk.widget.lisp ├── gtk.window-group.lisp ├── gtk.window.lisp └── ui-markup.lisp └── pango ├── cl-gtk2-pango.asd ├── pango.init.lisp ├── pango.lisp └── pango.package.lisp /.ditz-config: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/config 2 | name: Kalyanov Dmitry 3 | email: Kalyanov.Dmitry@gmail.com 4 | issue_dir: bugs 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # git-ls-files --others --exclude-from=.git/info/exclude 2 | # Lines that start with '#' are comments. 3 | # For a project mostly in C, the following would be a good set of 4 | # exclude patterns (uncomment them if you want to use them): 5 | # *.[oa] 6 | # *~ 7 | 8 | *~ 9 | *.fasl 10 | *.fas 11 | *.lib 12 | bugs/html/ 13 | *.lx64fsl 14 | tmp 15 | -------------------------------------------------------------------------------- /bugs/issue-02f87f195173dcb71afb17b87a1cae1fe105f8c2.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: "Implement signal control: stop/resume emission, block, find signal" 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.2" 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-01 19:37:58.189756 Z 11 | references: [] 12 | 13 | id: 02f87f195173dcb71afb17b87a1cae1fe105f8c2 14 | log_events: 15 | - - 2009-10-01 19:38:01.173340 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-01 19:39:37.888092 Z 20 | - Kalyanov Dmitry 21 | - assigned to release 0.1 from unassigned 22 | - "" 23 | - - 2009-10-10 21:03:35.125379 Z 24 | - Kalyanov Dmitry 25 | - unassigned from release 0.1 26 | - "" 27 | - - 2009-10-11 18:24:26.739631 Z 28 | - Kalyanov Dmitry 29 | - assigned to release 0.2 from unassigned 30 | - "" 31 | -------------------------------------------------------------------------------- /bugs/issue-0749e4c3cb64863c22480499d203fe68d4141885.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: fix running on clozure 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 19:33:27.068743 Z 11 | references: [] 12 | 13 | id: 0749e4c3cb64863c22480499d203fe68d4141885 14 | log_events: 15 | - - 2009-10-02 19:33:28.028531 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-05 18:32:17.460608 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-21b2b215170ebc35876fa3a350518b7f9700bd78.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkWidget binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-03 01:23:31.425523 Z 11 | references: [] 12 | 13 | id: 21b2b215170ebc35876fa3a350518b7f9700bd78 14 | log_events: 15 | - - 2009-10-03 01:23:32.209292 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-10 10:57:36.611088 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-22aa16299e7c1ecd68d2ce7852a768929028e3f3.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make GtkCellRenderer interface binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 21:04:21.830719 Z 11 | references: [] 12 | 13 | id: 22aa16299e7c1ecd68d2ce7852a768929028e3f3 14 | log_events: 15 | - - 2009-10-02 21:04:22.647103 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:18:36.994551 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make binding to GtkListStore 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 21:13:30.969849 Z 11 | references: [] 12 | 13 | id: 23861ef1324f6316848582a5636055e9497cbd92 14 | log_events: 15 | - - 2009-10-02 21:13:33.001426 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-23 22:22:59.660941 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-24992d0ce785d18d70ee0aeb17c5a5fdecdc5354.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make GtkCellLayout interface implementor binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 21:01:20.927960 Z 11 | references: [] 12 | 13 | id: 24992d0ce785d18d70ee0aeb17c5a5fdecdc5354 14 | log_events: 15 | - - 2009-10-02 21:01:21.663782 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:18:21.516610 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-25a39c12de2cd7101903148ee7dafdc3e5d790ae.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkContainer binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-03 00:58:04.994858 Z 11 | references: [] 12 | 13 | id: 25a39c12de2cd7101903148ee7dafdc3e5d790ae 14 | log_events: 15 | - - 2009-10-03 00:58:06.106586 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-10 11:44:29.875448 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-27f069ca44609eacd23170c3ab5129a3912e76b8.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: fix running on ecl 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 19:33:58.167071 Z 11 | references: [] 12 | 13 | id: 27f069ca44609eacd23170c3ab5129a3912e76b8 14 | log_events: 15 | - - 2009-10-02 19:33:59.062857 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-10 21:02:59.641472 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-2a5b1345992e962cba5bee884428314fee1bf064.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Add GError handling and using in bindings 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-11 19:13:30.094225 Z 11 | references: [] 12 | 13 | id: 2a5b1345992e962cba5bee884428314fee1bf064 14 | log_events: 15 | - - 2009-10-11 19:13:30.798090 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-2f4e005e8d303828a7607922edd996b9faf0c5d9.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: add GtkTreeView, GtkIconView drag-and-drop binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 20:29:13.250523 Z 11 | references: [] 12 | 13 | id: 2f4e005e8d303828a7607922edd996b9faf0c5d9 14 | log_events: 15 | - - 2009-10-02 20:29:14.586319 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:41:10.845450 Z 20 | - Kalyanov Dmitry 21 | - edited title 22 | - "" 23 | - - 2009-10-13 20:46:38.751427 Z 24 | - Kalyanov Dmitry 25 | - unassigned from release 0.1 26 | - "" 27 | -------------------------------------------------------------------------------- /bugs/issue-39d60c033f5310200786db0a8c3974d754e051de.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make GtkTreeModelSort binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 20:56:39.451716 Z 11 | references: [] 12 | 13 | id: 39d60c033f5310200786db0a8c3974d754e051de 14 | log_events: 15 | - - 2009-10-02 20:56:40.331508 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-17 14:12:00.634767 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-41e0963df897d6800ef9b4c3abbc9c3ee46f14da.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Add GError binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-11 19:13:11.816681 Z 11 | references: [] 12 | 13 | id: 41e0963df897d6800ef9b4c3abbc9c3ee46f14da 14 | log_events: 15 | - - 2009-10-11 19:13:12.792642 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-5a278efa6750438ee40072f35e694cd312cf250c.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish bindings for GtkTextView (easy) 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-01 19:48:56.995381 Z 11 | references: [] 12 | 13 | id: 5a278efa6750438ee40072f35e694cd312cf250c 14 | log_events: 15 | - - 2009-10-01 19:48:58.067368 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-08 19:34:06.712291 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-63c3a59fe7aee4e4fcae00d98e34ba5c720fa5ae.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: add GtkTreeRowReference binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-01 20:09:17.851799 Z 11 | references: [] 12 | 13 | id: 63c3a59fe7aee4e4fcae00d98e34ba5c720fa5ae 14 | log_events: 15 | - - 2009-10-01 20:09:18.939592 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-08 21:22:19.363096 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-648ddb6ff7319e4137b4eec870d1506d8a6883e7.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make bindings for GtkTextBuffer serialization/deserialization 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-01 19:42:13.954638 Z 11 | references: [] 12 | 13 | id: 648ddb6ff7319e4137b4eec870d1506d8a6883e7 14 | log_events: 15 | - - 2009-10-01 19:42:15.010731 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-12 20:31:04.894231 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-66999cce178a0179fddcb4e1b9d6ac6ba2473190.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: add public API for copying GBoxed to and from C structures 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.2" 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-03 19:04:44.190664 Z 11 | references: [] 12 | 13 | id: 66999cce178a0179fddcb4e1b9d6ac6ba2473190 14 | log_events: 15 | - - 2009-10-03 19:04:45.142658 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:25:10.261856 Z 20 | - Kalyanov Dmitry 21 | - assigned to release 0.2 from unassigned 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-6f97cba44fb67ffe961ebbef18c516d3b2441dd9.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Fix g-type-designator 3 | desc: Using g-type-designator requires passing and allocating strings and should be improved 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-24 07:50:15.488820 Z 11 | references: [] 12 | 13 | id: 6f97cba44fb67ffe961ebbef18c516d3b2441dd9 14 | log_events: 15 | - - 2009-10-24 07:50:16.136784 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-81334381f6a1febaf00a4374413bb963a3338708.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make bindings to GtkHSV 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 23:20:29.355658 Z 11 | references: [] 12 | 13 | id: 81334381f6a1febaf00a4374413bb963a3338708 14 | log_events: 15 | - - 2009-10-02 23:20:30.179437 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:02:21.852740 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-8261541fb544c3072370c3e91a23a1a15487cc2b.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Rename gobject:pointer to reduce conflicts (with e.g. cl-cairo2) 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-25 18:14:38.308592 Z 11 | references: [] 12 | 13 | id: 8261541fb544c3072370c3e91a23a1a15487cc2b 14 | log_events: 15 | - - 2009-10-25 18:14:38.780568 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-851f4edcff20a72b77b2ab9894724ffa3604711a.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkTreeView binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 20:28:42.648171 Z 11 | references: [] 12 | 13 | id: 851f4edcff20a72b77b2ab9894724ffa3604711a 14 | log_events: 15 | - - 2009-10-02 20:28:43.743906 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 08:47:47.346657 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-88756a6cd1cd743ffaecede0345087107030e3a5.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkTreePath bindings 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-01 20:07:26.739035 Z 11 | references: [] 12 | 13 | id: 88756a6cd1cd743ffaecede0345087107030e3a5 14 | log_events: 15 | - - 2009-10-01 20:07:27.762845 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-08 20:16:17.401738 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-88836c61db109ee78dec552d38cde9fc66deac35.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make bindings for GtkBuildable 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-03 19:01:23.359691 Z 11 | references: [] 12 | 13 | id: 88836c61db109ee78dec552d38cde9fc66deac35 14 | log_events: 15 | - - 2009-10-03 19:01:23.879643 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-8984e8bd247c90393388d26ee7c34743399fe6c4.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Add binding for drag-and-drop 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-13 20:47:00.622177 Z 11 | references: [] 12 | 13 | id: 8984e8bd247c90393388d26ee7c34743399fe6c4 14 | log_events: 15 | - - 2009-10-13 20:47:01.342079 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-9d580aeb583e4c619dc06c8318232242fe7d3438.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkFileChooser binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 23:26:28.059405 Z 11 | references: [] 12 | 13 | id: 9d580aeb583e4c619dc06c8318232242fe7d3438 14 | log_events: 15 | - - 2009-10-02 23:26:29.281302 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 08:21:39.989578 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-a2340a465d5e5475ce246455ca8a3254760d0154.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkMenu bindings (gtk_menu_attach_to_widget) 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :wontfix 10 | creation_time: 2009-10-02 21:47:03.781363 Z 11 | references: [] 12 | 13 | id: a2340a465d5e5475ce246455ca8a3254760d0154 14 | log_events: 15 | - - 2009-10-02 21:47:04.621156 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:30:59.295142 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition wontfix 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-ac7fa2746fbaed907e43aa3a690a744062fc7392.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make binding to Printing 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-03 00:20:51.439501 Z 11 | references: [] 12 | 13 | id: ac7fa2746fbaed907e43aa3a690a744062fc7392 14 | log_events: 15 | - - 2009-10-03 00:20:52.367292 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-b04f8b7353dd92900dacb7c30562331c34561171.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish bindings to GtkColorSelection 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 23:18:52.109533 Z 11 | references: [] 12 | 13 | id: b04f8b7353dd92900dacb7c30562331c34561171 14 | log_events: 15 | - - 2009-10-02 23:18:53.021324 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:11:22.060540 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-bb8c71d21d73d1ad594c73f0ac5ac8a6db82729c.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make binding to GtkTreeStore 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 21:13:54.989400 Z 11 | references: [] 12 | 13 | id: bb8c71d21d73d1ad594c73f0ac5ac8a6db82729c 14 | log_events: 15 | - - 2009-10-02 21:13:55.957193 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-24 16:20:58.305703 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-cd59e8bd909376222bd16cf13c8558a3a024a309.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: finish GtkIconView binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 20:54:04.688339 Z 11 | references: [] 12 | 13 | id: cd59e8bd909376222bd16cf13c8558a3a024a309 14 | log_events: 15 | - - 2009-10-02 20:54:06.039958 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:41:53.751689 Z 20 | - Kalyanov Dmitry 21 | - closed with disposition fixed 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-ceea6984eef15f2ae49e03107ece93c2b5bf665a.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make GtkTreeSortable binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 20:55:06.732780 Z 11 | references: [] 12 | 13 | id: ceea6984eef15f2ae49e03107ece93c2b5bf665a 14 | log_events: 15 | - - 2009-10-02 20:55:07.596600 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-23 21:09:13.436193 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-cf07ca46a08df70101af93054bc68d4dd7b6fe5a.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Make metaobject protocol for GBoxed instead of macros 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.2" 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-08 20:02:45.858289 Z 11 | references: [] 12 | 13 | id: cf07ca46a08df70101af93054bc68d4dd7b6fe5a 14 | log_events: 15 | - - 2009-10-08 20:02:46.506306 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:24:56.287946 Z 20 | - Kalyanov Dmitry 21 | - assigned to release 0.2 from unassigned 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-cfea3701e083cb14b1103abaedf953298163c4a9.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: Add slots to g-boxed-opaque 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-11-08 15:16:51.733154 Z 11 | references: [] 12 | 13 | id: cfea3701e083cb14b1103abaedf953298163c4a9 14 | log_events: 15 | - - 2009-11-08 15:16:53.328076 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-d0e2cd10341f9ea26673090eba5698c19c01eaa2.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make bindings of Recent Manager 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-03 18:58:38.399224 Z 11 | references: [] 12 | 13 | id: d0e2cd10341f9ea26673090eba5698c19c01eaa2 14 | log_events: 15 | - - 2009-10-03 18:58:39.079051 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | -------------------------------------------------------------------------------- /bugs/issue-df143d2fb5d923fc265fff6b8cdba490af89633f.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: fix running on clisp 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.2" 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 19:33:46.049295 Z 11 | references: [] 12 | 13 | id: df143d2fb5d923fc265fff6b8cdba490af89633f 14 | log_events: 15 | - - 2009-10-02 19:33:46.873122 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-10 21:02:56.505995 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | - - 2009-10-11 18:24:35.322557 Z 24 | - Kalyanov Dmitry 25 | - assigned to release 0.2 from unassigned 26 | - "" 27 | -------------------------------------------------------------------------------- /bugs/issue-ed99e9ad80242712fe92e0a6d8f3925ae30bd3ed.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: make GtkCellEditable interface binding 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: 7 | reporter: Kalyanov Dmitry 8 | status: :unstarted 9 | disposition: 10 | creation_time: 2009-10-02 21:04:55.400564 Z 11 | references: [] 12 | 13 | id: ed99e9ad80242712fe92e0a6d8f3925ae30bd3ed 14 | log_events: 15 | - - 2009-10-02 21:04:56.352332 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-11 18:18:40.850031 Z 20 | - Kalyanov Dmitry 21 | - unassigned from release 0.1 22 | - "" 23 | -------------------------------------------------------------------------------- /bugs/issue-f26913fe08284ee04e9d0a3f6acd36faa2341aae.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/issue 2 | title: fix running on win32 3 | desc: "" 4 | type: :task 5 | component: cl-gtk2 6 | release: "0.1" 7 | reporter: Kalyanov Dmitry 8 | status: :closed 9 | disposition: :fixed 10 | creation_time: 2009-10-02 19:33:09.967891 Z 11 | references: [] 12 | 13 | id: f26913fe08284ee04e9d0a3f6acd36faa2341aae 14 | log_events: 15 | - - 2009-10-02 19:33:11.063621 Z 16 | - Kalyanov Dmitry 17 | - created 18 | - "" 19 | - - 2009-10-04 10:42:50.725764 Z 20 | - Kalyanov Dmitry 21 | - commented 22 | - Now it runs on SBCL from cmd.exe but not from SLIME. 23 | - - 2009-10-05 18:38:54.128419 Z 24 | - Kalyanov Dmitry 25 | - closed with disposition fixed 26 | - "" 27 | -------------------------------------------------------------------------------- /bugs/project.yaml: -------------------------------------------------------------------------------- 1 | --- !ditz.rubyforge.org,2008-03-06/project 2 | name: cl-gtk2 3 | version: "0.5" 4 | components: 5 | - !ditz.rubyforge.org,2008-03-06/component 6 | name: cl-gtk2 7 | releases: 8 | - !ditz.rubyforge.org,2008-03-06/release 9 | name: "0.1" 10 | status: :released 11 | release_time: 2009-10-24 17:08:27.687511 Z 12 | log_events: 13 | - - 2009-10-01 19:39:12.427595 Z 14 | - Kalyanov Dmitry 15 | - created 16 | - "" 17 | - - 2009-10-24 17:08:27.687528 Z 18 | - Kalyanov Dmitry 19 | - released 20 | - "" 21 | - !ditz.rubyforge.org,2008-03-06/release 22 | name: "0.2" 23 | status: :unreleased 24 | release_time: 25 | log_events: 26 | - - 2009-10-11 18:24:12.694312 Z 27 | - Kalyanov Dmitry 28 | - created 29 | - "" 30 | -------------------------------------------------------------------------------- /cairo/cairo.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-gtk2-cairo) 2 | 3 | (defcfun gdk-cairo-create :pointer (drawable (g-object drawable))) 4 | 5 | (defclass gdk-context (cl-cairo2:context) 6 | ()) 7 | 8 | (defun create-gdk-context (gdk-drawable) 9 | "creates an context to draw on a GTK widget, more precisely on the 10 | associated gdk-window. This should only be called from within the 11 | expose event. In cells-gtk, use (gtk-adds-widget-window gtk-pointer) 12 | to obtain the gdk-window. 'gtk-pointer' is the pointer parameter 13 | passed to the expose event handler." 14 | (make-instance 'gdk-context 15 | :pointer (gdk-cairo-create gdk-drawable))) 16 | 17 | (defmethod cl-cairo2:destroy ((self gdk-context)) 18 | (cl-cairo2::cairo_destroy (slot-value self 'cl-cairo2:pointer))) 19 | 20 | (defmacro with-gdk-context ((context gdk-drawable) &body body) 21 | "Executes body while context is bound to a valid cairo context for 22 | gdk-window. This should only be called from within an expose event 23 | handler. In cells-gtk, use (gtk-adds-widget-window gtk-pointer) to 24 | obtain the gdk-window. 'gtk-pointer' is the pointer parameter passed 25 | to the expose event handler." 26 | (cl-utilities:with-gensyms (context-pointer) 27 | `(let ((,context (create-gdk-context ,gdk-drawable))) 28 | (cl-cairo2::with-context-pointer (,context ,context-pointer) 29 | ,@body) 30 | (cl-cairo2:destroy ,context)))) 31 | 32 | (defcfun gdk_cairo_set_source_pixbuf :void 33 | (cr :pointer) 34 | (pixbuf (g-object pixbuf)) 35 | (pixbuf-x :int) 36 | (pixbuf-y :int)) 37 | 38 | (defun gdk-cairo-set-source-pixbuf (pixbuf pixbuf-x pixbuf-y &optional (context cl-cairo2:*context*)) 39 | (gdk_cairo_set_source_pixbuf (slot-value context 'cl-cairo2:pointer) 40 | pixbuf pixbuf-x pixbuf-y)) 41 | 42 | (defcfun gdk_cairo_set_source_pixmap :void 43 | (cr :pointer) 44 | (pixmap (g-object pixmap)) 45 | (pixmap-x :double) 46 | (pixmap-y :double)) 47 | 48 | (defun gdk-cairo-set-source-pixmap (pixmap pixmap-x pixmap-y &optional (context cl-cairo2:*context*)) 49 | (gdk_cairo_set_source_pixmap (slot-value context 'cl-cairo2:pointer) 50 | pixmap pixmap-x pixmap-y)) 51 | 52 | (defcfun gdk_cairo_region :void 53 | (cr :pointer) 54 | (region (g-boxed-foreign region))) 55 | 56 | (defun gdk-cairo-region (region &optional (context cl-cairo2:*context*)) 57 | (gdk_cairo_region (slot-value context 'cl-cairo2:pointer) region)) 58 | 59 | (defcfun gdk_cairo_reset_clip :void 60 | (cr :pointer) 61 | (drawable (g-object drawable))) 62 | 63 | (defun gdk-cairo-reset-clip (drawable &optional (context cl-cairo2:*context*)) 64 | (gdk_cairo_reset_clip (slot-value context 'cl-cairo2:pointer) drawable)) -------------------------------------------------------------------------------- /cairo/cairo.package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-gtk2-cairo 2 | (:use #:cl #:gdk #:cffi #:gobject) 3 | (:export #:gdk-context 4 | #:create-gdk-context 5 | #:with-gdk-context 6 | #:gdk-cairo-set-source-pixbuf 7 | #:gdk-cairo-set-source-pixmap 8 | #:gdk-cairo-region 9 | #:gdk-cairo-reset-clip)) 10 | -------------------------------------------------------------------------------- /cairo/cl-gtk2-cairo.asd: -------------------------------------------------------------------------------- 1 | (defsystem :cl-gtk2-cairo 2 | :name :cl-gtk2-cairo 3 | :version "0.1.1" 4 | :author "Kalyanov Dmitry " 5 | :license "LLGPL" 6 | :serial t 7 | :components ((:file "cairo.package") 8 | (:file "cairo") 9 | (:file "cairo.demo")) 10 | :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-gdk :cl-gtk2-gtk :iterate :cl-cairo2)) -------------------------------------------------------------------------------- /doc/.gitignore: -------------------------------------------------------------------------------- 1 | *.aux 2 | *.cp 3 | *.fn 4 | *.ky 5 | *.log 6 | *.pdf 7 | *.pg 8 | *.toc 9 | *.tp 10 | *.vr 11 | gobject/ 12 | gtk/ 13 | manual.tar.bz2 14 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: doc.html tutorial.html gobject/index.html gtk/index.html gobject/style.css gtk/style.css gtk/let-ui.png gtk/let-ui-glext.png 2 | 3 | .PHONY: all archive publish 4 | 5 | publish: archive 6 | scp manual.tar.bz2 kdmitry@common-lisp.net:/project/cl-gtk2/manual.tar.bz2 7 | ssh kdmitry@common-lisp.net 'cd /project/cl-gtk2/public_html/doc/ && rm -rf gobject gtk && tar xf /project/cl-gtk2/manual.tar.bz2' 8 | 9 | archive: manual.tar.bz2 10 | 11 | manual.tar.bz2: gtk/index.html gtk/style.css gobject/index.html gobject/style.css 12 | tar cjf $@ gtk gobject 13 | 14 | doc.html: doc.xml 15 | xsltproc -o $@ /usr/share/sgml/docbook/xsl-stylesheets/html/docbook.xsl $< 16 | 17 | tutorial.html: tutorial.xml 18 | xsltproc -o $@ /usr/share/sgml/docbook/xsl-stylesheets/html/docbook.xsl $< 19 | 20 | index.html: doc.xml 21 | xsltproc /usr/share/sgml/docbook/xsl-stylesheets/html/chunk.xsl $< 22 | 23 | gobject/style.css: style.css 24 | ([ -x gobject ] || mkdir gobject) && cp $< $@ 25 | 26 | gobject/index.html: gobject.texi gobject.ref.texi 27 | makeinfo --html --css-ref=style.css $< 28 | sbcl --noinform --no-sysinit --no-userinit --disable-debugger --load colorize-lisp-examples.lisp $@ 29 | ./fix-tex-references.sh gobject 30 | 31 | gtk/style.css: style.css 32 | ([ -x gtk ] || mkdir gtk) && cp $< $@ 33 | 34 | gtk/let-ui.png: let-ui.png 35 | cp $< $@ 36 | 37 | gtk/let-ui-glext.png: let-ui-glext.png 38 | cp $< $@ 39 | 40 | gtk/index.html: gtk.texi gtk.ref.texi gdk.ref.texi gobject.ref.texi glib.ref.texi gdk.enums.texi \ 41 | gtk.flags.texi gtk.objects.texi gdk.flags.texi gdk.structs.texi gtk.interfaces.texi gtk.widgets.texi gdk.objects.texi \ 42 | gtk.enums.texi gtk.main_loop.texi gtk.structs.texi 43 | makeinfo --html --css-ref=style.css $< 44 | #sbcl --noinform --no-sysinit --no-userinit --disable-debugger --load colorize-lisp-examples.lisp $@ 45 | ./fix-tex-references.sh gtk 46 | 47 | #gtk.ref.texi gdk.ref.texi gobject.ref.texi: introspection.lisp 48 | # sbcl --noinfo --no-sysinit --no-user-init --disable-debugger --eval "(asdf:oos 'asdf:load-op :cl-gtk2-gtk)" --load "introspection.lisp" --eval '(gtk-doc-introspection:generate-texinfo-for-packages *default-pathname-defaults* (list :gdk :gobject :gtk))' 49 | 50 | gobject.pdf: gobject.texi 51 | pdftex $< 52 | pdftex $< 53 | 54 | gtk.pdf: gtk.texi 55 | pdftex $< 56 | pdftex $< 57 | -------------------------------------------------------------------------------- /doc/common.texi.inc: -------------------------------------------------------------------------------- 1 | @c @documentencoding utf-8 2 | 3 | @macro Function {args} 4 | @defun \args\ 5 | @end defun 6 | @end macro 7 | 8 | @macro Macro {args} 9 | @defmac \args\ 10 | @end defmac 11 | @end macro 12 | 13 | @macro Accessor {args} 14 | @deffn {Accessor} \args\ 15 | @end deffn 16 | @end macro 17 | 18 | @macro GenericFunction {args} 19 | @deffn {Generic Function} \args\ 20 | @end deffn 21 | @end macro 22 | 23 | @macro ForeignType {args} 24 | @deftp {Foreign Type} \args\ 25 | @end deftp 26 | @end macro 27 | 28 | @macro Variable {args} 29 | @defvr {Special Variable} \args\ 30 | @end defvr 31 | @end macro 32 | 33 | @macro Condition {args} 34 | @deftp {Condition Type} \args\ 35 | @end deftp 36 | @end macro 37 | 38 | @macro cffi 39 | @acronym{CFFI} 40 | @end macro 41 | 42 | @macro impnote {text} 43 | @quotation 44 | @strong{Implementor's note:} @emph{\text\} 45 | @end quotation 46 | @end macro 47 | 48 | @c Info "requires" that x-refs end in a period or comma, or ) in the 49 | @c case of @pxref. So the following implements that requirement for 50 | @c the "See also" subheadings that permeate this manual, but only in 51 | @c Info mode. 52 | @ifinfo 53 | @macro seealso {name} 54 | @ref{\name\}. 55 | @end macro 56 | @end ifinfo 57 | 58 | @ifnotinfo 59 | @alias seealso = ref 60 | @end ifnotinfo 61 | 62 | @c Typeset comments in roman font for the TeX output. 63 | @iftex 64 | @alias lispcmt = r 65 | @end iftex 66 | @ifnottex 67 | @alias lispcmt = asis 68 | @end ifnottex 69 | 70 | @c My copy of makeinfo is not generating any HTML for @result{} for 71 | @c some odd reason. (It certainly used to...) 72 | @ifhtml 73 | @macro result 74 | => 75 | @end macro 76 | @end ifhtml 77 | 78 | @c Similar macro to @result. Its purpose is to work around the fact 79 | @c that ⇒ does not work properly inside @lisp. 80 | @ifhtml 81 | @macro res 82 | @html 83 | ⇒ 84 | @end html 85 | @end macro 86 | @end ifhtml 87 | 88 | @ifnothtml 89 | @alias res = result 90 | @end ifnothtml 91 | 92 | @c ============================= Macros ============================= 93 | 94 | 95 | @c Show types, functions, and concepts in the same index. 96 | @syncodeindex tp cp 97 | @syncodeindex fn cp 98 | -------------------------------------------------------------------------------- /doc/doc.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/doc.html -------------------------------------------------------------------------------- /doc/fix-tex-references-1.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | file="$1" 3 | (egrep ' 101 | @end macro 102 | @end ifhtml 103 | 104 | @c Similar macro to @result. Its purpose is to work around the fact 105 | @c that ⇒ does not work properly inside @lisp. 106 | @ifhtml 107 | @macro res 108 | @html 109 | ⇒ 110 | @end html 111 | @end macro 112 | @end ifhtml 113 | 114 | @ifnothtml 115 | @alias res = result 116 | @end ifnothtml 117 | 118 | @c ============================= Macros ============================= 119 | 120 | 121 | @c Show types, functions, and concepts in the same index. 122 | @syncodeindex tp cp 123 | @syncodeindex fn cp 124 | 125 | @titlepage 126 | @title CL-GTK2 127 | @subtitle A Common Lisp binding for Gtk+ 128 | @subtitle GObject 129 | @author Dmitry Kalyanov 130 | @end titlepage 131 | 132 | @contents 133 | 134 | @ifnottex 135 | @node Top 136 | @top cl-gtk2-gobject 137 | @end ifnottex 138 | 139 | @include gobject.ref.texi 140 | 141 | @bye 142 | 143 | -------------------------------------------------------------------------------- /doc/gtk.structs.texi: -------------------------------------------------------------------------------- 1 | @menu 2 | * border:: 3 | * progress-display:: 4 | * progress-window:: 5 | * tree-iter:: 6 | * tree-node:: 7 | @end menu 8 | 9 | @node border 10 | @section border 11 | @Struct border 12 | Superclass: @code{structure-object} 13 | 14 | Slots: 15 | @itemize 16 | @item @anchor{slot.border.bottom}bottom. Accessor: border-bottom. 17 | @item @anchor{slot.border.left}left. Accessor: border-left. 18 | @item @anchor{slot.border.right}right. Accessor: border-right. 19 | @item @anchor{slot.border.top}top. Accessor: border-top. 20 | @end itemize 21 | 22 | 23 | @node progress-display 24 | @section progress-display 25 | @Struct progress-display 26 | Superclass: @code{structure-object} 27 | 28 | Subclasses: @ref{progress-window} 29 | 30 | Slots: 31 | @itemize 32 | @item @anchor{slot.progress-display.bar}bar. Accessor: progress-display-bar. 33 | @item @anchor{slot.progress-display.count}count. Accessor: progress-display-count. 34 | @item @anchor{slot.progress-display.current}current. Accessor: progress-display-current. 35 | @item @anchor{slot.progress-display.name}name. Accessor: progress-display-name. 36 | @item @anchor{slot.progress-display.parent}parent. Accessor: progress-display-parent. 37 | @item @anchor{slot.progress-display.time-started}time-started. Accessor: progress-display-time-started. 38 | @end itemize 39 | 40 | 41 | @node progress-window 42 | @section progress-window 43 | @Struct progress-window 44 | Superclass: @ref{progress-display} 45 | 46 | Slots: 47 | @itemize 48 | @item @anchor{slot.progress-window.box}box. Accessor: progress-window-box. 49 | @item @anchor{slot.progress-window.window}window. Accessor: progress-window-window. 50 | @end itemize 51 | 52 | 53 | @node tree-iter 54 | @section tree-iter 55 | @Struct tree-iter 56 | Superclass: @code{structure-object} 57 | 58 | Slots: 59 | @itemize 60 | @item @anchor{slot.tree-iter.stamp}stamp. Accessor: tree-iter-stamp. 61 | @item @anchor{slot.tree-iter.user-data}user-data. Accessor: tree-iter-user-data. 62 | @item @anchor{slot.tree-iter.user-data-2}user-data-2. Accessor: tree-iter-user-data-2. 63 | @item @anchor{slot.tree-iter.user-data-3}user-data-3. Accessor: tree-iter-user-data-3. 64 | @end itemize 65 | 66 | 67 | @node tree-node 68 | @section tree-node 69 | @Struct tree-node 70 | Superclass: @code{structure-object} 71 | 72 | Slots: 73 | @itemize 74 | @item @anchor{slot.tree-node.children}children. Accessor: tree-node-children. 75 | @item @anchor{slot.tree-node.id}id. Accessor: tree-node-id. 76 | @item @anchor{slot.tree-node.item}item. Accessor: tree-node-item. 77 | @item @anchor{slot.tree-node.parent}parent. Accessor: tree-node-parent. 78 | @item @anchor{slot.tree-node.tree}tree. Accessor: tree-node-tree. 79 | @end itemize 80 | 81 | 82 | -------------------------------------------------------------------------------- /doc/hello.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :gtk-hello 2 | (:use :cl :gtk :gobject :glib) 3 | (:export :run)) 4 | 5 | (in-package :gtk-hello) 6 | 7 | (defun run () 8 | (let ((output *standard-output*)) 9 | (with-main-loop 10 | (let ((window (make-instance 'gtk-window 11 | :type :toplevel 12 | :window-position :center 13 | :title "Hello world!" 14 | :default-width 300 15 | :default-height 100)) 16 | (button (make-instance 'button :label "Hello, world!")) 17 | (counter 0)) 18 | (g-signal-connect button "clicked" 19 | (lambda (b) 20 | (declare (ignore b)) 21 | (format output "Hello, world!~%") 22 | (setf (button-label button) 23 | (format nil 24 | "Hello, world! (clicked ~D times)" 25 | (incf counter))))) 26 | (container-add window button) 27 | (widget-show window :all t))))) -------------------------------------------------------------------------------- /doc/hello_world.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/hello_world.png -------------------------------------------------------------------------------- /doc/let-ui-glext.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/let-ui-glext.png -------------------------------------------------------------------------------- /doc/let-ui.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/let-ui.png -------------------------------------------------------------------------------- /doc/lisp_ide.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/lisp_ide.png -------------------------------------------------------------------------------- /doc/references/gobject.type-info/header.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/doc/references/gobject.type-info/header.gif -------------------------------------------------------------------------------- /doc/references/gobject.type-info/index.css: -------------------------------------------------------------------------------- 1 | div.sidebar { 2 | float: right; 3 | min-width: 15%; 4 | padding: 0pt 5pt 5pt 5pt; 5 | font-family: verdana, arial; 6 | } 7 | 8 | a { 9 | text-decoration: none; 10 | color: black; 11 | border-bottom: 1px solid #0070a0; 12 | } 13 | 14 | .nonlink { 15 | border-bottom: 1px solid white; 16 | border-top: 1px solid white; 17 | border-left: 1px solid white; 18 | border-right: 1px solid white; 19 | padding-top: 1px; 20 | padding-bottom: 1px; 21 | } 22 | 23 | .sidebar a { 24 | border-top: 1px solid #eeeeee; 25 | border-left: 1px solid #eeeeee; 26 | border-right: 1px solid #eeeeee; 27 | } 28 | 29 | #headerlink { 30 | border: none; 31 | } 32 | 33 | #headerlink:hover { 34 | border: none; 35 | } 36 | 37 | body { 38 | color: #000000; 39 | background-color: #ffffff; 40 | margin: 0 0 0 0; 41 | /* 42 | margin-top: 2em; 43 | margin-right: 20pt; 44 | margin-bottom: 10%; 45 | */ 46 | font-family: verdana, arial; 47 | font-size: 8pt; 48 | } 49 | 50 | .main { 51 | margin-top: 20px; 52 | margin-left: 40px; 53 | } 54 | 55 | .padded { 56 | padding-left: 30px; 57 | } 58 | 59 | .padded h1,h2 { 60 | margin-left: -30px; 61 | } 62 | 63 | h2 { 64 | color: #0070a0; 65 | } 66 | 67 | .page-title { 68 | color: black; 69 | } 70 | 71 | h3 { 72 | background-color: #f4f4f4; 73 | padding-top: 4px; 74 | padding-bottom: 4px; 75 | border-bottom: 1px solid #80d8fd; 76 | color: #000000; 77 | width: 90%; 78 | margin-top: 2em; 79 | margin-left: -3px; 80 | padding-left: 3px; 81 | font-weight: bold; 82 | } 83 | 84 | h4 { 85 | } 86 | 87 | .grau { 88 | padding-top: 1em; 89 | } 90 | 91 | pre { 92 | background-color: #eeeeee; 93 | border: solid 1px #d0d0d0; 94 | padding: 1em; 95 | margin-right: 10%; 96 | } 97 | 98 | .code { 99 | border: solid 1px #d0d0d0; 100 | padding: 1em; 101 | margin-right: 10%; 102 | } 103 | 104 | .indent { 105 | margin-left: 20px; 106 | padding-bottom: 1em; 107 | } 108 | 109 | .def { 110 | padding: 1px 1px 1px 1px; 111 | margin-bottom: 1px; 112 | font-weight: bold; 113 | margin-right: 40px; 114 | } 115 | 116 | .nomargin { 117 | margin-bottom: 0; 118 | margin-top: 0; 119 | } 120 | 121 | .noindent { 122 | margin-left: -30px; 123 | padding-bottom: 1em; 124 | } 125 | 126 | #header table { 127 | width: 95%; 128 | position: absolute; 129 | bottom: 10px; 130 | margin-right: 1em; 131 | } 132 | 133 | #header { 134 | background: url(header.gif); 135 | position: relative; /* so that the table is relativ to this */ 136 | width: 100%; 137 | height: 70px; 138 | font-family: verdana, arial; 139 | font-size: 12pt; 140 | padding-bottom: 1px; 141 | } 142 | 143 | #sp-package-list { 144 | /* ... */ 145 | } 146 | 147 | #sp-about-packages { 148 | /* ... */ 149 | } 150 | 151 | .sp-lambda-list { 152 | width: 90%; 153 | background-color: #f4f4f4; 154 | padding: 3px 3px 3px 3px; 155 | } 156 | 157 | .sp-definition { 158 | width: 90%; 159 | border: 1px solid #cccccc; 160 | padding: 3px 3px 3px 3px; 161 | } 162 | 163 | .sp-definition-body { 164 | padding-left: 10%; 165 | padding-bottom: 2em; 166 | } 167 | 168 | .sp-definition-body ul { 169 | margin-top: 0; 170 | margin-bottom: 0; 171 | } 172 | 173 | .sp-return { 174 | } 175 | 176 | .sph3 { 177 | padding-top: 1em; 178 | font-weight: bold; 179 | } 180 | -------------------------------------------------------------------------------- /doc/schemas.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | body {font-family: century schoolbook, serif; 2 | line-height: 1.3; 3 | padding-left: 5em; padding-right: 1em; 4 | padding-bottom: 1em; /*max-width: 60em;*/} 5 | table {border-collapse: collapse} 6 | span.roman { font-family: century schoolbook, serif; font-weight: normal; } 7 | h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif} 8 | h4 { margin-top: 2.5em; } 9 | dfn {font-family: inherit; font-variant: italic; font-weight: bolder } 10 | kbd {font-family: monospace; text-decoration: underline} 11 | /*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/ 12 | var {font-variant: slanted;} 13 | td {padding-right: 1em; padding-left: 1em} 14 | sub {font-size: smaller} 15 | .node {padding: 0; margin: 0} 16 | 17 | .lisp { font-family: monospace; 18 | background-color: #F4F4F4; border: 1px solid #AAA; 19 | padding-top: 0.5em; padding-bottom: 0.5em; } 20 | 21 | /* coloring */ 22 | 23 | .lisp-bg { background-color: #F4F4F4 ; color: black; } 24 | .lisp-bg:hover { background-color: #F4F4F4 ; color: black; } 25 | 26 | .symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;} 27 | a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 28 | a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 29 | a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 30 | a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 31 | .special { font-weight: bold; color: #FF5000; background-color: inherit; } 32 | .keyword { font-weight: bold; color: #770000; background-color: inherit; } 33 | .comment { font-weight: normal; color: #007777; background-color: inherit; } 34 | .string { font-weight: bold; color: #777777; background-color: inherit; } 35 | .character { font-weight: bold; color: #0055AA; background-color: inherit; } 36 | .syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; } 37 | span.paren1 { font-weight: bold; color: #777777; } 38 | span.paren1:hover { color: #777777; background-color: #BAFFFF; } 39 | span.paren2 { color: #777777; } 40 | span.paren2:hover { color: #777777; background-color: #FFCACA; } 41 | span.paren3 { color: #777777; } 42 | span.paren3:hover { color: #777777; background-color: #FFFFBA; } 43 | span.paren4 { color: #777777; } 44 | span.paren4:hover { color: #777777; background-color: #CACAFF; } 45 | span.paren5 { color: #777777; } 46 | span.paren5:hover { color: #777777; background-color: #CAFFCA; } 47 | span.paren6 { color: #777777; } 48 | span.paren6:hover { color: #777777; background-color: #FFBAFF; } 49 | 50 | li p { margin-top: 0px; margin-bottom: 0px; } 51 | li { margin-top: 3px; margin-bottom: 3px; } 52 | li dl { margin-top: 1em; } -------------------------------------------------------------------------------- /doc/widget-screenshot.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :widget-screenshot 2 | (:use :cl :gtk :gdk :gobject) 3 | (:export :make-widget-screenshot)) 4 | 5 | (in-package :widget-screenshot) 6 | 7 | (defun make-widget-screenshot (filename widget-creator-fn) 8 | (within-main-loop 9 | (let ((window (make-instance 'gtk-window)) 10 | (widget (funcall widget-creator-fn))) 11 | (container-add window widget) 12 | (pushnew :structure-mask (gdk-window-events (widget-window window))) 13 | (connect-signal window "map-event" 14 | (lambda (&rest args) 15 | (declare (ignore args)) 16 | (let* ((pm (widget-snapshot widget)) 17 | (pb (pixbuf-get-from-drawable nil pm))) 18 | (pixbuf-save pb filename "png")) 19 | (object-destroy window))) 20 | (widget-show window)))) 21 | -------------------------------------------------------------------------------- /gdk/cl-gtk2-gdk.asd: -------------------------------------------------------------------------------- 1 | (defsystem :cl-gtk2-gdk 2 | :name :cl-gtk2-gdk 3 | :version "0.1.1" 4 | :author "Kalyanov Dmitry " 5 | :license "LLGPL" 6 | :serial t 7 | :components ((:file "gdk.package") 8 | (:file "gdk.threads") 9 | (:file "gdk.objects") 10 | (:file "gdk.functions") 11 | (:file "gdk.general") 12 | (:file "gdk.display") 13 | (:file "gdk.screen") 14 | (:file "gdk.region") 15 | (:file "gdk.gc") 16 | (:file "gdk.drawing-primitives") 17 | (:file "gdk.bitmaps") 18 | (:file "gdk.rgb") 19 | (:file "gdk.images") 20 | (:file "gdk.pixbufs") 21 | (:file "gdk.colors") 22 | (:file "gdk.visual") 23 | (:file "gdk.cursor") 24 | (:file "gdk.windows") 25 | (:file "gdk.events") 26 | (:file "gdk.key-values") 27 | (:file "gdk.selections") 28 | (:file "gdk.drag-and-drop") 29 | (:file "gdk.input-devices") 30 | (:file "gdk.pango")) 31 | :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango)) 32 | -------------------------------------------------------------------------------- /gdk/gdk.bitmaps.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (pixmap-new "gdk_pixmap_new") (g-object pixmap :already-referenced) 4 | (drawable (g-object drawable)) 5 | (width :int) 6 | (height :int) 7 | (depth :int)) 8 | 9 | (export 'pixmap-new) 10 | 11 | (defcfun (bitmap-create-from-data "gdk_bitmap_create_from_data") (g-object pixmap :already-referenced) 12 | (drawable (g-object drawable)) 13 | (data :pointer) 14 | (width :int) 15 | (height :int)) 16 | 17 | (export 'bitmap-create-from-data) 18 | 19 | (defcfun (pixmap-create-from-data "gdk_pixmap_create_from_data") (g-object pixmap :already-referenced) 20 | (drawable (g-object drawable)) 21 | (data :pointer) 22 | (width :int) 23 | (height :int) 24 | (depth :int) 25 | (fg-color (g-boxed-foreign color)) 26 | (bg-color (g-boxed-foreign color))) 27 | 28 | (export 'pixmap-create-from-data) 29 | 30 | (defcfun gdk-pixmap-create-from-xpm (g-object pixmap :already-referenced) 31 | (drawable (g-object drawable)) 32 | (mask :pointer) 33 | (transparent-color (g-boxed-foreign color)) 34 | (filename :string)) 35 | 36 | (defcfun gdk-pixmap-colormap-create-from-xpm (g-object pixmap :already-referenced) 37 | (drawable (g-object drawable)) 38 | (colormap (g-object colormap)) 39 | (mask :pointer) 40 | (transparent-color (g-boxed-foreign color)) 41 | (filename :string)) 42 | 43 | (defcfun gdk-pixmap-create-from-xpm-d (g-object pixmap :already-referenced) 44 | (drawable (g-object drawable)) 45 | (mask :pointer) 46 | (transparent-color (g-boxed-foreign color)) 47 | (data (:pointer :pointer))) 48 | 49 | (defun gdk-pixmap-create-from-xpm-d-1 (drawable mask transparent-color data) 50 | (let ((n (length data))) 51 | (with-foreign-object (data-ptr :pointer n) 52 | (let ((i 0)) 53 | (map nil 54 | (lambda (str) 55 | (setf (mem-aref data-ptr :pointer i) (cffi:foreign-string-alloc str)) 56 | (incf i)) 57 | data)) 58 | (gdk-pixmap-create-from-xpm-d drawable mask transparent-color data-ptr)))) 59 | 60 | (defcfun gdk-pixmap-colormap-create-from-xpm-d (g-object pixmap :already-referenced) 61 | (drawable (g-object drawable)) 62 | (colormap (g-object colormap)) 63 | (mask :pointer) 64 | (transparent-color (g-boxed-foreign color)) 65 | (data (:pointer :pointer))) 66 | 67 | (defun gdk-pixmap-colormap-create-from-xpm-d-1 (drawable colormap mask transparent-color data) 68 | (let ((n (length data))) 69 | (with-foreign-object (data-ptr :pointer n) 70 | (let ((i 0)) 71 | (map nil 72 | (lambda (str) 73 | (setf (mem-aref data-ptr :pointer i) (cffi:foreign-string-alloc str)) 74 | (incf i)) 75 | data)) 76 | (gdk-pixmap-colormap-create-from-xpm-d drawable colormap mask transparent-color data-ptr)))) 77 | 78 | (defun pixmap-create-from-xpm (drawable transparent-color &key (colormap nil colormap-p) (filename nil filename-p) (xpm-data nil xpm-p)) 79 | (unless (or filename-p xpm-p) 80 | (error "FILENAME or XPM-DATA must be specified")) 81 | (when (and filename-p xpm-p) 82 | (error "FILENAME and XPM-DATA may not be specified at the same time")) 83 | (with-foreign-object (mask-ptr :pointer) 84 | (let ((pixmap (if filename-p 85 | (if colormap-p 86 | (gdk-pixmap-colormap-create-from-xpm drawable colormap mask-ptr transparent-color filename) 87 | (gdk-pixmap-create-from-xpm drawable mask-ptr transparent-color filename)) 88 | (if colormap-p 89 | (gdk-pixmap-colormap-create-from-xpm-d-1 drawable colormap mask-ptr transparent-color xpm-data) 90 | (gdk-pixmap-create-from-xpm-d-1 drawable mask-ptr transparent-color xpm-data))))) 91 | (values pixmap (convert-from-foreign mask-ptr '(g-object pixmap :already-referenced)))))) 92 | 93 | (export 'pixmap-create-from-xpm) 94 | -------------------------------------------------------------------------------- /gdk/gdk.colors.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (colormap-new "gdk_colormap_new") (g-object colormap :already-referenced) 4 | (visual (g-object visual)) 5 | (allocate :boolean)) 6 | 7 | (export 'colormap-new) 8 | 9 | ;; deprecated 10 | ;; GdkColormap* gdk_colormap_ref (GdkColormap *cmap); 11 | ;; void gdk_colormap_unref (GdkColormap *cmap); 12 | 13 | (defcfun (colormap-get-system "gdk_colormap_get_system") (g-object colormap)) 14 | 15 | (export 'colormap-get-system) 16 | 17 | ;; deprecated 18 | ;; gint gdk_colormap_get_system_size (void); 19 | ;; void gdk_colormap_change (GdkColormap *colormap, 20 | ;; gint ncolors); 21 | 22 | (defcfun gdk-colormap-alloc-colors :int 23 | (colormap (g-object colormap)) 24 | (colors :pointer) 25 | (n-colors :int) 26 | (writeable :boolean) 27 | (best-match :boolean) 28 | (success (:pointer :boolean))) 29 | 30 | (defun colormap-alloc-colors (colormap colors writeable best-match) 31 | (with-foreign-boxed-array (n colors-ar color colors) 32 | (with-foreign-object (success :boolean) 33 | (gdk-colormap-alloc-colors colormap colors-ar n writeable best-match success) 34 | (mem-ref success :boolean)))) 35 | 36 | (export 'colormap-alloc-colors) 37 | 38 | (defcfun (colormap-alloc-color "gdk_colormap_alloc_color") :boolean 39 | (colormap (g-object colormap)) 40 | (color (g-boxed-foreign color)) 41 | (writeable :boolean) 42 | (best-match :boolean)) 43 | 44 | (export 'colormap-alloc-color) 45 | 46 | (defcfun gdk-colormap-free-colors :void 47 | (colormap (g-object colormap)) 48 | (colors :pointer) 49 | (n-colors :int)) 50 | 51 | (defun colormap-free-colors (colormap colors) 52 | (with-foreign-boxed-array (n colors-ptr color colors) 53 | (gdk-colormap-free-colors colormap colors-ptr n))) 54 | 55 | (export 'colormap-free-colors) 56 | 57 | (defcfun gdk-colormap-query-color :void 58 | (colormap (g-object colormap)) 59 | (pixel :ulong) 60 | (result (g-boxed-foreign color))) 61 | 62 | (defun colormap-query-color (colormap pixel) 63 | (let ((color (make-color))) 64 | (gdk-colormap-query-color colormap pixel color) 65 | color)) 66 | 67 | (export 'colormap-query-color) 68 | 69 | ;; ignored: 70 | ;; void gdk_colors_store (GdkColormap *colormap, 71 | ;; GdkColor *colors, 72 | ;; gint ncolors); 73 | ;; gint gdk_colors_alloc (GdkColormap *colormap, 74 | ;; gboolean contiguous, 75 | ;; gulong *planes, 76 | ;; gint nplanes, 77 | ;; gulong *pixels, 78 | ;; gint npixels); 79 | ;; void gdk_colors_free (GdkColormap *colormap, 80 | ;; gulong *pixels, 81 | ;; gint npixels, 82 | ;; gulong planes); 83 | ;; gint gdk_color_white (GdkColormap *colormap, 84 | ;; GdkColor *color); 85 | ;; gint gdk_color_black (GdkColormap *colormap, 86 | ;; GdkColor *color); 87 | 88 | (defcfun gdk-color-parse :boolean 89 | (spec :string) 90 | (color (g-boxed-foreign color))) 91 | 92 | (defun color-parse (color-spec) 93 | (let ((color (make-color))) 94 | (when (gdk-color-parse color-spec color) 95 | color))) 96 | 97 | (export 'color-parse) 98 | 99 | ;; ignored: 100 | ;; gint gdk_color_alloc (GdkColormap *colormap, 101 | ;; GdkColor *color); 102 | ;; gint gdk_color_change (GdkColormap *colormap, 103 | ;; GdkColor *color); 104 | 105 | (defcfun (color= "gdk_color_equal") :boolean 106 | (color-a (g-boxed-foreign color)) 107 | (color-b (g-boxed-foreign color))) 108 | 109 | (export 'color=) 110 | 111 | (defcfun (gdk-color-hash "gdk_color_hash") :uint 112 | (color (g-boxed-foreign color))) 113 | 114 | (export 'gdk-color-hash) 115 | 116 | (defcfun (color-to-string "gdk_color_to_string") (glib:g-string :free-from-foreign t) 117 | (color (g-boxed-foreign color))) 118 | 119 | (export 'color-to-string) -------------------------------------------------------------------------------- /gdk/gdk.cursor.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcstruct %gdk-cursor 4 | (cursor-type cursor-type)) 5 | 6 | (defun cursor-cursor-type (cursor) 7 | (foreign-slot-value (pointer cursor) '%gdk-cursor 'cursor-type)) 8 | 9 | (export 'cursor-cursor-type) 10 | 11 | (defcfun (cursor-new "gdk_cursor_new") (g-boxed-foreign cursor :return) 12 | (cursor-type cursor-type)) 13 | 14 | (export 'cursor-new) 15 | 16 | (defcfun (cursor-new-from-pixmap "gdk_cursor_new_from_pixmap") (g-boxed-foreign cursor :return) 17 | (source (g-object pixmap)) 18 | (make (g-object pixmap)) 19 | (fg-color (g-boxed-foreign color)) 20 | (bg-color (g-boxed-foreign color)) 21 | (x :int) 22 | (y :int)) 23 | 24 | (export 'cursor-new-from-pixmap) 25 | 26 | (defcfun (cursor-new-from-pixbuf "gdk_cursor_new_from_pixbuf") (g-boxed-foreign cursor :return) 27 | (display (g-object display)) 28 | (pixbuf (g-object pixbuf)) 29 | (x :int) 30 | (y :int)) 31 | 32 | (export 'cursor-new-from-pixbuf) 33 | 34 | (defcfun (cursor-new-from-name "gdk_cursor_new_from_name") (g-boxed-foreign cursor :return) 35 | (display (g-object display)) 36 | (name :string)) 37 | 38 | (export 'cursor-new-from-name) 39 | 40 | (defcfun (cursor-new-for-display "gdk_cursor_new_for_display") (g-boxed-foreign cursor :return) 41 | (display (g-object display)) 42 | (cursor-type cursor-type)) 43 | 44 | (export 'cursor-new-for-display) 45 | 46 | (define-boxed-opaque-accessor cursor cursor-display :type (g-object display) :reader "gdk_cursor_get_display") 47 | (define-boxed-opaque-accessor cursor cursor-image :type (g-object pixbuf) :reader "gdk_cursor_get_image") 48 | 49 | (export '(cursor-display cursor-image)) 50 | -------------------------------------------------------------------------------- /gdk/gdk.functions.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (default-screen "gdk_screen_get_default") (g-object gdk-screen)) 4 | (export 'default-screen) 5 | 6 | (defcfun gdk-atom-name (glib:g-string :free-from-foreign t) 7 | (atom gdk-atom)) 8 | 9 | (defcfun gdk-atom-intern gdk-atom 10 | (name :string) 11 | (only-if-exists :boolean)) 12 | 13 | (defcfun gdk-pixbuf-savev :boolean 14 | (pixbuf (g-object pixbuf)) 15 | (filename :string) 16 | (type :string) 17 | (option-keys (:pointer (:pointer :char))) 18 | (option-values (:pointer (:pointer :char))) 19 | (error :pointer)) 20 | 21 | (defun pixbuf-save (pixbuf filename type) 22 | (gdk-pixbuf-savev pixbuf 23 | (etypecase filename 24 | (string filename) 25 | (pathname (namestring filename))) 26 | type 27 | (null-pointer) 28 | (null-pointer) 29 | (null-pointer))) 30 | 31 | (export 'pixbuf-save) 32 | 33 | (defcfun gdk-pixbuf-new-from-file (g-object pixbuf :already-referenced) 34 | (filename :string) 35 | (error :pointer)) 36 | 37 | (defun pixbuf-new-from-file (filename) 38 | (glib:with-g-error (err) 39 | (gdk-pixbuf-new-from-file filename err))) 40 | 41 | (export 'pixbuf-new-from-file) 42 | -------------------------------------------------------------------------------- /gdk/gdk.gc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (define-g-boxed-cstruct gc-values nil 4 | (foregound color :initform (make-color) :inline t) 5 | (background color :initform (make-color) :inline t) 6 | (font (g-boxed-foreign font) :initform nil) 7 | (function gdk-function :initform :copy) 8 | (fill gdk-fill :initform :solid) 9 | (tile (g-object pixmap) :initform nil) 10 | (stipple (g-object pixmap) :initform nil) 11 | (clip-mask (g-object pixmap) :initform nil) 12 | (subwindow-mode subwindow-mode :initform :clip-by-children) 13 | (ts-x-origin :int :initform 0) 14 | (ts-y-origin :int :initform 0) 15 | (clip-x-origin :int :initform 0) 16 | (clip-y-origin :int :initform 0) 17 | (graphics-exposures :boolean :initform t) 18 | (line-width :int :initform 0) 19 | (line-style line-style :initform :solid) 20 | (cap-style cap-style :initform :butt) 21 | (join-style join-style :initform :miter)) 22 | 23 | (export (boxed-related-symbols 'gc-values)) 24 | 25 | (defcfun (graphics-context-new "gdk_gc_new") (g-object graphics-context :already-referenced) 26 | (drawable (g-object drawable))) 27 | 28 | (export 'graphics-context-new) 29 | 30 | (defcfun (graphics-context-new-with-values "gdk_gc_new_with_values") (g-object graphics-context :already-referenced) 31 | (drawable (g-object drawable)) 32 | (values (g-boxed-foreign gc-values)) 33 | (values-mask gc-values-mask)) 34 | 35 | (export 'graphics-context-new-with-values) 36 | 37 | (defcfun (graphics-context-set-values "gdk_gc_set_values") :void 38 | (graphics-context (g-object graphics-context)) 39 | (values (g-boxed-foreign gc-values)) 40 | (values-mask gc-values-mask)) 41 | 42 | (export 'graphics-context-set-values) 43 | 44 | (defcfun gdk-gc-get-values :void 45 | (gc (g-object graphics-context)) 46 | (values (g-boxed-foreign gc-values))) 47 | 48 | (defun graphics-context-get-values (graphics-context) 49 | (let ((values (make-gc-values))) 50 | (gdk-gc-get-values graphics-context values) 51 | values)) 52 | 53 | (export 'graphics-context-get-values) 54 | 55 | (defcfun (graphics-context-set-ts-origin "gdk_gc_set_ts_origin") :void 56 | (graphics-context (g-object graphics-context)) 57 | (x :int) 58 | (y :int)) 59 | 60 | (export 'graphics-context-set-ts-origin) 61 | 62 | (defcfun (graphics-context-set-clip-origin "gdk_gc_set_clip_origin") :void 63 | (graphics-context (g-object graphics-context)) 64 | (x :int) 65 | (y :int)) 66 | 67 | (export 'graphics-context-set-clip-origin) 68 | 69 | (defcfun (graphics-context-set-line-attributes "gdk_gc_set_line_attributes") :void 70 | (graphics-context (g-object graphics-context)) 71 | (line-width :int) 72 | (line-style line-style) 73 | (cap-style cap-style) 74 | (join-style join-style)) 75 | 76 | (export 'graphics-context-set-line-attributes) 77 | 78 | (defcfun gdk-gc-set-dashes :void 79 | (graphics-context (g-object graphics-context)) 80 | (dash-offset :int) 81 | (dash-list :pointer) 82 | (n :int)) 83 | 84 | (defun graphics-context-set-dashes (graphics-context dash-offset dash-list) 85 | (let ((n (length dash-list))) 86 | (with-foreign-object (dash-list-ptr :int8 n) 87 | (let ((i 0)) 88 | (map nil 89 | (lambda (dash) 90 | (setf (mem-aref dash-list-ptr :int8 i) dash) 91 | (incf i)) 92 | dash-list)) 93 | (gdk-gc-set-dashes graphics-context dash-offset dash-list n)))) 94 | 95 | (export 'graphics-context-set-dashes) 96 | 97 | (defcfun (graphics-context-copy "gdk_gc_copy") :void 98 | (dst-gc (g-object graphics-context)) 99 | (src-gc (g-object graphics-context))) 100 | 101 | (export 'graphics-context-copy) 102 | 103 | (defcfun (graphics-context-offset "gdk_gc_offset") :void 104 | (graphics-context (g-object graphics-context)) 105 | (x-offset :int) 106 | (y-offset :int)) 107 | 108 | (export 'graphic-context-offset) 109 | -------------------------------------------------------------------------------- /gdk/gdk.general.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun gdk-set-locale (:string :free-from-foreign nil)) 4 | (export 'gdk-set-locale) 5 | 6 | (defcfun (set-sm-client-id "gdk_set_sm_client_id") :void 7 | (sm-client-id :string)) 8 | (export 'set-sm-client-id) 9 | 10 | (defcfun gdk-notify-startup-complete :void) 11 | (defcfun gdk-notify-startup-complete-with-id :void 12 | (startup-id :string)) 13 | 14 | (defun notify-startup-complete (&optional startup-id) 15 | (if startup-id 16 | (gdk-notify-startup-complete-with-id startup-id) 17 | (gdk-notify-startup-complete))) 18 | 19 | (export 'notify-startup-complete) 20 | 21 | (defcfun gdk-get-program-class (:string :free-from-foreign nil)) 22 | (defcfun gdk-set-program-class :void 23 | (program-class (:string :free-to-foreign t))) 24 | (defun program-class () (gdk-get-program-class)) 25 | (defun (setf program-class) (new-value) (gdk-set-program-class new-value)) 26 | (export 'program-class) 27 | 28 | (defcfun (get-display "gdk_get_display") (:string :free-from-foreign nil)) 29 | (export 'get-display) 30 | 31 | (defcfun gdk-flush :void) 32 | (export 'gdk-flush) 33 | 34 | (defcfun (pointer-grab "gdk_pointer_grab") grab-status 35 | (window (g-object gdk-window)) 36 | (owner-events :boolean) 37 | (event-mask event-mask) 38 | (confine-to (g-object gdk-window)) 39 | (cursor (g-boxed-foreign cursor)) 40 | (time :uint32)) 41 | 42 | (export 'pointer-grab) 43 | 44 | (defcfun (pointer-ungrab "gdk_pointer_ungrab") :void 45 | (time :uint32)) 46 | 47 | (export 'pointer-ungrab) 48 | 49 | (defcfun (pointer-grabbed-p "gdk_pointer_is_grabbed") :boolean) 50 | 51 | (export 'pointer-grabbed-p) 52 | 53 | (defcfun (keyboard-grab "gdk_keyboard_grab") grab-status 54 | (window (g-object gdk-window)) 55 | (owner-events :boolean) 56 | (time :uint32)) 57 | 58 | (export 'keyboard-grab) 59 | 60 | (defcfun (keyboard-ungrab "gdk_keyboard_ungrab") :void 61 | (time :uint32)) 62 | 63 | (export 'keyboard-ungrab) 64 | 65 | (defcfun gdk-beep :void) 66 | 67 | (export 'gdk-beep) 68 | 69 | (defcfun gdk-error-trap-push :void) 70 | (defcfun gdk-error-trap-pop :int) 71 | (export '(gdk-error-trap-push gdk-error-trap-pop)) 72 | -------------------------------------------------------------------------------- /gdk/gdk.images.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (gdk-image-new "gdk_image_new") (g-object gdk-image :already-referenced) 4 | (type gdk-image-type) 5 | (visual (g-object visual)) 6 | (width :int) 7 | (height :int)) 8 | 9 | (export 'gdk-image-new) 10 | 11 | ;; deprecated: 12 | ;; GdkImage* gdk_image_new_bitmap (GdkVisual *visual, 13 | ;; gpointer data, 14 | ;; gint width, 15 | ;; gint height); 16 | ;; GdkImage* gdk_image_get (GdkDrawable *drawable, 17 | ;; gint x, 18 | ;; gint y, 19 | ;; gint width, 20 | ;; gint height); 21 | ;; GdkImage * gdk_image_ref (GdkImage *image); 22 | ;; void gdk_image_unref (GdkImage *image); 23 | ;; #define gdk_image_destroy 24 | 25 | 26 | (defcfun (gdk-image-put-pixel "gdk_image_put_pixel") :void 27 | (image (g-object gdk-image)) 28 | (x :int) 29 | (y :int) 30 | (pixel :uint32)) 31 | 32 | (export 'gdk-image-put-pixel) 33 | 34 | (defcfun (gdk-image-get-pixel "gdk_image_get_pixel") :uint32 35 | (image (g-object gdk-image)) 36 | (x :int) 37 | (y :int)) 38 | 39 | (export 'gdk-image-get-pixel) 40 | -------------------------------------------------------------------------------- /gdk/gdk.package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :gdk 2 | (:use :cl :gobject :cffi :pango :iter) 3 | (:export #:gdk-window-events 4 | #:gdk-atom-as-string)) 5 | 6 | (in-package :gdk) 7 | 8 | (glib:at-init () 9 | (eval-when (:compile-toplevel :load-toplevel :execute) 10 | (define-foreign-library gdk 11 | ((:and :unix (:not :darwin)) (:or "libgdk-x11-2.0.so.0" "libgdk-x11-2.0.so")) 12 | (:darwin (:or "libgdk-x11-2.0.0.dylib" "libgdk-x11-2.0.dylib")) 13 | (:windows "libgdk-win32-2.0-0.dll") 14 | (t "libgdk-2.0")) 15 | (define-foreign-library gdk-pixbuf 16 | ((:and :unix (:not :darwin)) (:or "libgdk_pixbuf-2.0.so.0" "libgdk_pixbuf-2.0.so")) 17 | (:darwin (:or "libgdk_pixbuf-2.0.0.dylib" "libgdk_pixbuf-2.0.dylib")) 18 | (:windows (:or "libgdk_pixbuf-win32-2.0-0" "libgdk_pixbuf-2.0-0.dll")) 19 | (t "libgdk_pixbuf-2.0")) 20 | 21 | (define-foreign-library gtk 22 | ((:and :unix (:not :darwin)) (:or "libgtk-x11-2.0.so.0" "libgtk-x11-2.0.so")) 23 | (:darwin (:or "libgtk-x11-2.0.0.dylib" "libgtk-x11-2.0.dylib")) 24 | (:windows (:or "libgtk-2.0-0.dll" "libgtk-win32-2.0-0.dll")) 25 | (t "libgtk-2.0"))) 26 | 27 | (use-foreign-library gdk) 28 | (use-foreign-library gdk-pixbuf) 29 | (use-foreign-library gtk)) 30 | 31 | (defcvar (*gtk-major-version* "gtk_major_version" :read-only t :library gtk) :uint) 32 | (defcvar (*gtk-minor-version* "gtk_minor_version" :read-only t :library gtk) :uint) 33 | (defcvar (*gtk-micro-version* "gtk_micro_version" :read-only t :library gtk) :uint) 34 | (defcvar (*gtk-binary-age* "gtk_binary_age" :read-only t :library gtk) :uint) 35 | (defcvar (*gtk-interface-age* "gtk_interface_age" :read-only t :library gtk) :uint) 36 | 37 | (glib:push-library-version-features gtk *gtk-major-version* *gtk-minor-version* 38 | 2 2 39 | 2 4 40 | 2 6 41 | 2 8 42 | 2 10 43 | 2 12 44 | 2 14 45 | 2 16 46 | 2 18) 47 | 48 | (glib:require-library-version "Gtk+" 2 16 *gtk-major-version* *gtk-minor-version*) 49 | -------------------------------------------------------------------------------- /gdk/gdk.pango.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (define-g-object-class "GdkPangoRenderer" gdk-pango-renderer 4 | (:superclass pango-renderer :export t 5 | :interfaces nil :type-initializer 6 | "gdk_pango_renderer_get_type") 7 | ((screen gdk-pango-renderer-screen "screen" 8 | "GdkScreen" t nil))) 9 | 10 | (defcfun gdk-pango-renderer-new (g-object gdk-pango-renderer :already-referenced) 11 | (screen (g-object screen))) 12 | 13 | (export 'gdk-pango-renderer-new) 14 | 15 | (defcfun gdk-pango-renderer-get-default (g-object gdk-pango-renderer) 16 | (screen (g-object screen))) 17 | 18 | (export 'gdk-pango-renderer-get-default) 19 | 20 | (defcfun gdk-pango-renderer-set-drawable :void 21 | (renderer (g-object gdk-pango-renderer)) 22 | (drawable (g-object drawable))) 23 | 24 | (export 'gdk-pango-renderer-set-drawable) 25 | 26 | (defcfun gdk-pango-renderer-set-gc :void 27 | (renderer (g-object gdk-pango-renderer)) 28 | (gc (g-object graphics-context))) 29 | 30 | (export 'gdk-pango-renderer-set-gc) 31 | 32 | (defcfun gdk-pango-renderer-set-stipple :void 33 | (renderer (g-object gdk-pango-renderer)) 34 | (part pango-render-part) 35 | (stipple (g-object pixmap))) 36 | 37 | (export 'gdk-pango-renderer-set-stipple) 38 | 39 | (defcfun gdk-pango-renderer-set-override-color :void 40 | (renderer (g-object gdk-pango-renderer)) 41 | (part pango-render-part) 42 | (color (g-boxed-foreign color))) 43 | 44 | (export 'gdk-pango-renderer-set-override-color) 45 | 46 | (defcfun gdk-pango-context-get (g-object pango-context :already-referenced)) 47 | 48 | (export 'gdk-pango-context-get) 49 | 50 | (defcfun gdk-pango-context-get-for-screen (g-object pango-context :already-referenced) 51 | (screen (g-object screen))) 52 | 53 | (export 'gdk-pango-context-get-for-screen) 54 | 55 | ;; ignored: 56 | ;; void gdk_pango_context_set_colormap (PangoContext *context, 57 | ;; GdkColormap *colormap); 58 | 59 | ;; TODO: 60 | ;; GdkPangoAttrEmbossed; 61 | ;; GdkPangoAttrEmbossColor; 62 | ;; GdkPangoAttrStipple; 63 | ;; PangoAttribute * gdk_pango_attr_emboss_color_new (const GdkColor *color); 64 | ;; PangoAttribute * gdk_pango_attr_embossed_new (gboolean embossed); 65 | ;; PangoAttribute * gdk_pango_attr_stipple_new (GdkBitmap *stipple); 66 | 67 | (defcfun gdk_pango_layout_get_clip_region (g-boxed-foreign region :return) 68 | (layout (g-object pango-layout)) 69 | (x-origin :int) 70 | (y-origin :int) 71 | (index-ranges (:pointer :int)) 72 | (n-ranges :int)) 73 | 74 | (defun gdk-pango-layout-get-clip-region (layout x-origin y-origin index-ranges) 75 | (let ((n (length index-ranges))) 76 | (assert (zerop (mod n 2))) 77 | (let ((n-ranges (/ n 2))) 78 | (with-foreign-object (ranges :int n) 79 | (let ((i 0)) 80 | (map nil 81 | (lambda (x) 82 | (setf (mem-aref ranges :int i) x) 83 | (incf i)) 84 | index-ranges)) 85 | (gdk_pango_layout_get_clip_region layout x-origin y-origin index-ranges n-ranges))))) 86 | 87 | (export 'gdk-pango-layout-get-clip-region) 88 | 89 | (defcfun gdk_pango_layout_line_get_clip_region (g-boxed-foreign region :return) 90 | (layout-line (g-boxed-foreign pango-layout-line)) 91 | (x-origin :int) 92 | (y-origin :int) 93 | (index-ranges (:pointer :int)) 94 | (n-ranges :int)) 95 | 96 | (defun gdk-pango-layout-line-get-clip-region (layout-line x-origin y-origin index-ranges) 97 | (let ((n (length index-ranges))) 98 | (assert (zerop (mod n 2))) 99 | (let ((n-ranges (/ n 2))) 100 | (with-foreign-object (ranges :int n) 101 | (let ((i 0)) 102 | (map nil 103 | (lambda (x) 104 | (setf (mem-aref ranges :int i) x) 105 | (incf i)) 106 | index-ranges)) 107 | (gdk_pango_layout_line_get_clip_region layout-line x-origin y-origin index-ranges n-ranges))))) 108 | 109 | (export 'gdk-pango-layout-line-get-clip-region) 110 | -------------------------------------------------------------------------------- /gdk/gdk.pixbufs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (pixbuf-render-threshold-alpha "gdk_pixbuf_render_threshold_alpha") :void 4 | (pixbuf (g-object pixbuf)) 5 | (bitmap (g-object bitmap)) 6 | (src-x :int) 7 | (src-y :int) 8 | (dest-x :int) 9 | (dest-y :int) 10 | (width :int) 11 | (height :int) 12 | (alpha-threshold :int)) 13 | 14 | (export 'pixbuf-render-threshold-alpha) 15 | 16 | (defcfun (pixbuf-render-to-drawable "gdk_pixbuf_render_to_drawable") :void 17 | (pixbuf (g-object pixbuf)) 18 | (drawable (g-object drawable)) 19 | (gc (g-object graphics-context)) 20 | (src-x :int) 21 | (src-y :int) 22 | (dest-x :int) 23 | (dest-y :int) 24 | (width :int) 25 | (height :int) 26 | (dither rgb-dither) 27 | (x-dither :int) 28 | (y-dither :int)) 29 | 30 | (export 'pixbuf-render-to-drawable) 31 | 32 | (defcfun (pixbuf-render-to-drawable-alpha "gdk_pixbuf_render_to_drawable_alpha") :void 33 | (pixbuf (g-object pixbuf)) 34 | (drawable (g-object drawable)) 35 | (src-x :int) 36 | (src-y :int) 37 | (dest-x :int) 38 | (dest-y :int) 39 | (width :int) 40 | (height :int) 41 | (alpha-mode pixbuf-alpha-mode) 42 | (alpha-threshold :int) 43 | (dither rgb-dither) 44 | (x-dither :int) 45 | (y-dither :int)) 46 | 47 | (export 'pixbuf-render-to-drawable-alpha) 48 | 49 | (defcfun gdk-pixbuf-render-pixmap-and-mask :void 50 | (pixbuf (g-object pixbuf)) 51 | (pixmap-return :pointer) 52 | (mask-return :pointer) 53 | (alpha-threshold :int)) 54 | 55 | (defun pixbuf-render-pixmap-and-mask (pixbuf alpha-threshold) 56 | (with-foreign-objects ((pixmap-return :pointer) (mask-return :pointer)) 57 | (gdk-pixbuf-render-pixmap-and-mask pixbuf pixmap-return mask-return alpha-threshold) 58 | (values (convert-from-foreign (mem-ref pixmap-return :pointer) '(g-object pixmap :already-referenced)) 59 | (convert-from-foreign (mem-ref mask-return :pointer) '(g-object pixmap :already-referenced))))) 60 | 61 | (export 'pixbuf-render-pixmap-and-mask) 62 | 63 | (defcfun gdk-pixbuf-render-pixmap-and-mask-for-colormap :void 64 | (pixbuf (g-object pixbuf)) 65 | (colormap (g-object colormap)) 66 | (pixmap-return :pointer) 67 | (mask-return :pointer) 68 | (alpha-threshold :int)) 69 | 70 | (defun pixbuf-render-pixmap-and-mask-for-colormap (pixbuf colormap alpha-threshold) 71 | (with-foreign-objects ((pixmap-return :pointer) (mask-return :pointer)) 72 | (gdk-pixbuf-render-pixmap-and-mask-for-colormap pixbuf colormap pixmap-return mask-return alpha-threshold) 73 | (values (convert-from-foreign (mem-ref pixmap-return :pointer) '(g-object pixmap :already-referenced)) 74 | (convert-from-foreign (mem-ref mask-return :pointer) '(g-object pixmap :already-referenced))))) 75 | 76 | (export 'pixbuf-render-pixmap-and-mask-for-colormap) 77 | 78 | (defcfun gdk-pixbuf-get-from-drawable (g-object pixbuf :already-referenced) 79 | (dest (g-object pixbuf)) 80 | (src (g-object drawable)) 81 | (colormap :pointer) 82 | (src-x :int) 83 | (src-y :int) 84 | (dest-x :int) 85 | (dest-y :int) 86 | (width :int) 87 | (height :int)) 88 | 89 | (defun pixbuf-get-from-drawable (pixbuf drawable &key (src-x 0) (src-y 0) (dest-x 0) (dest-y 0) (width -1) (height -1)) 90 | (gdk-pixbuf-get-from-drawable pixbuf drawable (null-pointer) src-x src-y dest-x dest-y width height)) 91 | 92 | (export 'pixbuf-get-from-drawable) 93 | 94 | (defcfun gdk-pixbuf-get-from-image (g-object pixbuf :already-referenced) 95 | (dest (g-object pixbuf)) 96 | (src (g-object gdk-image)) 97 | (colormap :pointer) 98 | (src-x :int) 99 | (src-y :int) 100 | (dest-x :int) 101 | (dest-y :int) 102 | (width :int) 103 | (height :int)) 104 | 105 | (defun pixbuf-get-from-image (pixbuf image &key (src-x 0) (src-y 0) (dest-x 0) (dest-y 0) (width -1) (height -1)) 106 | (gdk-pixbuf-get-from-image pixbuf image (null-pointer) src-x src-y dest-x dest-y width height)) 107 | 108 | (export 'pixbuf-get-from-image) 109 | -------------------------------------------------------------------------------- /gdk/gdk.rgb.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (draw-rgb-image "gdk_draw_rgb_image") :void 4 | (drawable (g-object drawable)) 5 | (gc (g-object graphics-context)) 6 | (x :int) 7 | (y :int) 8 | (width :int) 9 | (height :int) 10 | (dither rgb-dither) 11 | (rgb-buf :pointer) 12 | (rowstride :int)) 13 | 14 | (export 'draw-rgb-image) 15 | 16 | (defcfun (draw-rgb-image-dithalign "gdk_draw_rgb_image_dithalign") :void 17 | (drawable (g-object drawable)) 18 | (gc (g-object graphics-context)) 19 | (x :int) 20 | (y :int) 21 | (width :int) 22 | (height :int) 23 | (dither rgb-dither) 24 | (rgb-buf :pointer) 25 | (rowstride :int) 26 | (x-dith :int) 27 | (y-dith :int)) 28 | 29 | (export 'draw-rgb-image-dithalign) 30 | 31 | (define-g-boxed-cstruct rgb-cmap nil 32 | (colors :uint32 :count 256 :initform (make-array 256 :element-type '(unsigned-byte 32) :initial-element 0)) 33 | (n-colors :int :initform 0)) 34 | 35 | (defcfun (draw-indexed-image "gdk_draw_indexed_image") :void 36 | (drawable (g-object drawable)) 37 | (gc (g-object graphics-context)) 38 | (x :int) 39 | (y :int) 40 | (width :int) 41 | (height :int) 42 | (dither rgb-dither) 43 | (buf :pointer) 44 | (rowstring :int) 45 | (cmap (g-boxed-foreign rgb-cmap))) 46 | 47 | (export 'draw-indexed-image) 48 | 49 | (defcfun (draw-gray-image "gdk_draw_gray_image") :void 50 | (drawable (g-object drawable)) 51 | (gc (g-object graphics-context)) 52 | (x :int) 53 | (y :int) 54 | (width :int) 55 | (height :int) 56 | (dith rgb-dither) 57 | (buf :pointer) 58 | (rowstride :int)) 59 | 60 | (export 'draw-gray-image) 61 | 62 | (defcfun (draw-rgb-32-image "gdk_draw_rgb_32_image") :void 63 | (drawable (g-object drawable)) 64 | (gc (g-object graphics-context)) 65 | (x :int) 66 | (y :int) 67 | (width :int) 68 | (height :int) 69 | (dither rgb-dither) 70 | (buf :pointer) 71 | (rowstride :int)) 72 | 73 | (export 'draw-rgb-32-image) 74 | 75 | (defcfun (draw-rgb-32-image-dithalign "gdk_draw_rgb_32_image_dithalign") :void 76 | (drawable (g-object drawable)) 77 | (gc (g-object graphics-context)) 78 | (x :int) 79 | (y :int) 80 | (width :int) 81 | (height :int) 82 | (dither rgb-dither) 83 | (buf :pointer) 84 | (rowstride :int) 85 | (xdith :int) 86 | (ydith :int)) 87 | 88 | (export 'draw-rgb-32-image-dithalign) 89 | 90 | (defcfun (rgb-find-color "gdk_rgb_find_color") :void 91 | (colormap (g-object colormap)) 92 | (color (g-boxed-foreign color))) 93 | 94 | (export 'rgb-find-color) 95 | 96 | (defcfun (rgb-set-install "gdk_rgb_set_install") :void 97 | (install :boolean)) 98 | 99 | (export 'rgb-set-install) 100 | 101 | (defcfun (rgb-set-min-colors "gdk_rgb_set_min_colors") :void 102 | (min-colors :int)) 103 | 104 | (export 'rgb-set-min-colors) 105 | 106 | (defcfun (rgb-get-visual "gdk_rgb_get_visual") (g-object visual)) 107 | 108 | (export 'rgb-get-visual) 109 | 110 | (defcfun (rgb-get-colormap "gdk_rgb_get_colormap") (g-object colormap)) 111 | 112 | (export 'rgb-get-colormap) 113 | 114 | (defcfun (rgb-ditherable "gdk_rgb_ditherable") :boolean) 115 | 116 | (export 'rgb-ditherable) 117 | 118 | (defcfun (rgb-colormap-ditherable "gdk_rgb_colormap_ditherable") :boolean 119 | (colormap (g-object colormap))) 120 | 121 | (export 'rgb-colormap-ditherable) 122 | 123 | (defcfun (rgb-set-verbose "gdk_rgb_set_verbose") :void 124 | (verbose :boolean)) 125 | 126 | (export 'rgb-set-verbose) 127 | -------------------------------------------------------------------------------- /gdk/gdk.selections.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defparameter *selection-primary* "PRIMARY") 4 | (export '*selection-primary*) 5 | (defparameter *selection-secondary* "SECONDARY") 6 | (export '*selection-secondary*) 7 | (defparameter *selection-clipboard* "CLIPBOARD") 8 | (export '*selection-clipboard*) 9 | (defparameter *target-bitmap* "BITMAP") 10 | (export '*target-bitmap*) 11 | (defparameter *target-colormap* "COLORMAP") 12 | (export '*target-colormap*) 13 | (defparameter *target-drawable* "DRAWABLE") 14 | (export '*target-drawable*) 15 | (defparameter *target-pixmap* "PIXMAP") 16 | (export '*target-pixmap*) 17 | (defparameter *target-string* "STRING") 18 | (export '*target-string*) 19 | (defparameter *selection-type-atom* "ATOM") 20 | (export '*selection-type-atom*) 21 | (defparameter *selection-type-bitmap* "BITMAP") 22 | (export '*selection-type-bitmap*) 23 | (defparameter *selection-type-colormap* "COLORMAP") 24 | (export '*selection-type-colormap*) 25 | (defparameter *selection-type-drawable* "DRAWABLE") 26 | (export '*selection-type-drawable*) 27 | (defparameter *selection-type-integer* "INTEGER") 28 | (export '*selection-type-integer*) 29 | (defparameter *selection-type-pixmap* "PIXMAP") 30 | (export '*selection-type-pixmap*) 31 | (defparameter *selection-type-window* "WINDOW") 32 | (export '*selection-type-window*) 33 | (defparameter *selection-type-string* "STRING") 34 | (export '*selection-type-string*) 35 | 36 | (defcfun gdk-selection-owner-set :boolean 37 | (owner (g-object gdk-window)) 38 | (selection gdk-atom-as-string) 39 | (time :uint32) 40 | (send-event :boolean)) 41 | 42 | (export 'gdk-selection-owner-set) 43 | 44 | (defcfun gdk-selection-owner-set-for-display :boolean 45 | (display (g-object display)) 46 | (owner (g-object gdk-window)) 47 | (selection gdk-atom-as-string) 48 | (time :uint32) 49 | (send-event :boolean)) 50 | 51 | (export 'gdk-selection-owner-set-for-display) 52 | 53 | (defcfun gdk-selection-owner-get (g-object gdk-window) 54 | (selection gdk-atom-as-string)) 55 | 56 | (export 'gdk-selection-owner-get) 57 | 58 | (defcfun gdk-selection-owner-get-for-display (g-object gdk-window) 59 | (display (g-object display)) 60 | (selection gdk-atom-as-string)) 61 | 62 | (export 'gdk-selection-owner-get-for-display) 63 | 64 | (defcfun gdk-selection-convert :void 65 | (requestor (g-object gdk-window)) 66 | (selection gdk-atom-as-string) 67 | (target gdk-atom-as-string) 68 | (time :uint32)) 69 | 70 | (export 'gdk-selection-convert) 71 | 72 | (defcfun gdk-selection-property-get :int 73 | (requestor (g-object gdk-window)) 74 | (selection gdk-atom-as-string) 75 | (target gdk-atom-as-string) 76 | (time :uint32)) 77 | 78 | (export 'gdk-selection-property-get) 79 | 80 | (defcfun gdk-selection-send-notify :void 81 | (requestor native-window) 82 | (selection gdk-atom-as-string) 83 | (target gdk-atom-as-string) 84 | (property gdk-atom-as-string) 85 | (time :uint32)) 86 | 87 | (export 'gdk-selection-send-notify) 88 | 89 | (defcfun gdk-selection-send-notify-for-display :void 90 | (display (g-object display)) 91 | (requestor native-window) 92 | (selection gdk-atom-as-string) 93 | (target gdk-atom-as-string) 94 | (property gdk-atom-as-string) 95 | (time :uint32)) 96 | 97 | (export 'gdk-selection-send-notify-for-display) 98 | -------------------------------------------------------------------------------- /gdk/gdk.threads.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun gdk-threads-init :void) 4 | (glib:at-init () (gdk-threads-init)) 5 | 6 | (defcfun gdk-threads-enter :void) 7 | (export 'gdk-threads-enter) 8 | 9 | (defcfun gdk-threads-leave :void) 10 | (export 'gdk-threads-leave) 11 | 12 | (defmacro with-gdk-threads-lock (&body body) 13 | `(progn 14 | (gdk-threads-enter) 15 | (unwind-protect 16 | (progn ,@body) 17 | (gdk-threads-leave)))) 18 | (export 'with-gdk-threads-lock) 19 | 20 | ;; ignored: 21 | ;; void gdk_threads_set_lock_functions (GCallback enter_fn, 22 | ;; GCallback leave_fn); 23 | 24 | (defcallback source-func-callback :boolean 25 | ((data :pointer)) 26 | (funcall (stable-pointer-value data))) 27 | 28 | (defcallback stable-pointer-free-destroy-notify-callback :void ((data :pointer)) 29 | (free-stable-pointer data)) 30 | 31 | (defcfun gdk_threads_add_idle_full :uint 32 | (priority :int) 33 | (function :pointer) 34 | (data :pointer) 35 | (destroy-notify :pointer)) 36 | 37 | (defun gdk-threads-add-idle-full (priority function) 38 | (gdk_threads_add_idle_full priority 39 | (callback source-func-callback) 40 | (allocate-stable-pointer function) 41 | (callback stable-pointer-free-destroy-notify-callback))) 42 | 43 | (export 'gdk-threads-add-idle-full) 44 | 45 | (defcfun gdk_threads_add_timeout_full :uint 46 | (priority :int) 47 | (interval :uint) 48 | (function :pointer) 49 | (data :pointer) 50 | (destroy-notify :pointer)) 51 | 52 | (defun gdk-threads-add-timeout-full (priority interval-msec function) 53 | (gdk_threads_add_timeout_full priority interval-msec 54 | (callback source-func-callback) 55 | (allocate-stable-pointer function) 56 | (callback stable-pointer-free-destroy-notify-callback))) 57 | 58 | (export 'gdk-threads-add-timeout-full) 59 | 60 | (defcfun gdk_threads_add_timeout_seconds_full :uint 61 | (priority :int) 62 | (interval :uint) 63 | (function :pointer) 64 | (data :pointer) 65 | (destroy-notify :pointer)) 66 | 67 | (defun gdk-threads-add-timeout-seconds-full (priority interval-sec function) 68 | (gdk_threads_add_timeout_seconds_full priority interval-sec 69 | (callback source-func-callback) 70 | (allocate-stable-pointer function) 71 | (callback stable-pointer-free-destroy-notify-callback))) 72 | 73 | (export 'gdk-threads-add-timeout-seconds-full) 74 | -------------------------------------------------------------------------------- /gdk/gdk.visual.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gdk) 2 | 3 | (defcfun (%gdk-query-depths "gdk_query_depths") :void 4 | (depths (:pointer (:pointer :int))) 5 | (count (:pointer :int))) 6 | 7 | (defun gdk-query-depths () 8 | (with-foreign-objects ((count-r :int) (depths-r :pointer)) 9 | (%gdk-query-depths depths-r count-r) 10 | (iter (with count = (mem-ref count-r :int)) 11 | (with depths = (mem-ref depths-r :pointer)) 12 | (for i from 0 below count) 13 | (collect (mem-aref depths :int i))))) 14 | 15 | (export 'gdk-query-depths) 16 | 17 | (defcfun (%gdk-query-visual-types "gdk_query_visual_types") :void 18 | (depths (:pointer (:pointer visual-type))) 19 | (count (:pointer :int))) 20 | 21 | (defun gdk-query-visual-types () 22 | (with-foreign-objects ((count-r :int) (types-r 'visual-type)) 23 | (%gdk-query-visual-types types-r count-r) 24 | (iter (with count = (mem-ref count-r :int)) 25 | (with types = (mem-ref types-r :pointer)) 26 | (for i from 0 below count) 27 | (collect (mem-aref types 'visual-type i))))) 28 | 29 | (export 'gdk-query-visual-types) 30 | 31 | (defcstruct gdk-visual-cstruct 32 | (parent-instance gobject.ffi::%g-object) 33 | (visual-type visual-type) 34 | (depth :int) 35 | (byte-order byte-order) 36 | (colormap-size :int) 37 | (bits-per-rgb :int) 38 | (red-mask :uint32) 39 | (red-shift :int) 40 | (red-prec :int) 41 | (green-mask :uint32) 42 | (green-shift :int) 43 | (green-prec :int) 44 | (blue-mask :uint32) 45 | (blue-shift :int) 46 | (blue-prec :int)) 47 | 48 | (defmacro def-visual-accessor (slot) 49 | `(defun ,(intern (format nil "~A-GET-~A" (symbol-name 'gdk-visual) (symbol-name slot))) (visual) 50 | (foreign-slot-value (pointer visual) 'gdk-visual-cstruct ',slot))) 51 | 52 | (def-visual-accessor visual-type) 53 | (def-visual-accessor depth) 54 | (def-visual-accessor byte-order) 55 | (def-visual-accessor colormap-size) 56 | (def-visual-accessor bits-per-rgb) 57 | (def-visual-accessor red-mask) 58 | (def-visual-accessor red-shift) 59 | (def-visual-accessor red-prec) 60 | (def-visual-accessor green-mask) 61 | (def-visual-accessor green-shift) 62 | (def-visual-accessor green-prec) 63 | (def-visual-accessor blue-mask) 64 | (def-visual-accessor blue-shift) 65 | (def-visual-accessor blue-prec) 66 | 67 | (defcfun (list-visuals "gdk_list_visuals") (glib:glist (g-object visual) :free-from-foreign t)) 68 | 69 | (export 'list-visuals) 70 | 71 | (defcfun (visual-get-best-depth "gdk_visual_get_best_depth") :int) 72 | (export 'visual-get-best-depth) 73 | 74 | (defcfun (visual-get-best-type "gdk_visual_get_best_type") visual-type) 75 | (export 'visual-get-best-type) 76 | 77 | (defcfun (visual-get-system "gdk_visual_get_system") (g-object visual)) 78 | (export 'visual-get-system) 79 | 80 | (defcfun (visual-get-best "gdk_visual_get_best") (g-object visual)) 81 | (export 'visual-get-best) 82 | 83 | (defcfun (visual-get-best-with-depth "gdk_visual_get_best_with_depth") (g-object visual) 84 | (depth :int)) 85 | (export 'visual-get-best-with-depth) 86 | 87 | (defcfun (visual-get-best-with-both "gdk_visual_get_best_with_both") (g-object visual) 88 | (depth :int) 89 | (visual-type visual-type)) 90 | (export 'visual-get-best-with-both) 91 | 92 | (defmethod print-object ((visual visual) stream) 93 | (print-unreadable-object (visual stream :type t :identity t) 94 | (format stream "~S at ~S bpp" (visual-visual-type visual) (visual-depth visual)))) 95 | -------------------------------------------------------------------------------- /glib/cl-gtk2-glib.asd: -------------------------------------------------------------------------------- 1 | (defsystem :cl-gtk2-glib 2 | :name :cl-gtk2-glib 3 | :version "0.1.1" 4 | :author "Kalyanov Dmitry " 5 | :license "LLGPL" 6 | :serial t 7 | :components ((:file "glib") 8 | (:file "glib.glist") 9 | (:file "glib.gstrv") 10 | (:file "glib.string") 11 | (:file "glib.quark") 12 | (:file "glib.gerror") 13 | (:file "glib.utils") 14 | (:file "glib.rand") 15 | 16 | (:file "gobject.init") 17 | (:file "gobject.ffi.package") 18 | (:file "gobject.type-designator") 19 | (:file "gobject.ffi") 20 | 21 | (:file "gobject.package") 22 | 23 | (:file "gobject.type-info") 24 | (:file "gobject.type-info.object") 25 | (:file "gobject.type-info.enum") 26 | (:file "gobject.type-info.signals") 27 | 28 | (:file "gobject.gvalue") 29 | (:file "gobject.foreign") 30 | (:file "gobject.stable-pointer") 31 | (:file "gobject.object.low") 32 | (:file "gobject.object.high") 33 | (:file "gobject.signals") 34 | 35 | (:file "gobject.meta") 36 | (:file "gobject.generating") 37 | (:file "gobject.object-defs") 38 | (:file "gobject.cffi-callbacks") 39 | (:file "gobject.foreign-gobject-subclassing") 40 | 41 | (:file "gobject.boxed") 42 | (:file "gobject.object-function")) 43 | :depends-on (:cffi :trivial-garbage :iterate :bordeaux-threads :iterate :closer-mop)) 44 | -------------------------------------------------------------------------------- /glib/glib.gerror.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (defcstruct g-error 4 | (:domain g-quark) 5 | (:code :int) 6 | (:message (:string :free-from-foreign nil))) 7 | 8 | (defcfun g-error-new-literal :pointer 9 | (domain g-quark) 10 | (code :int) 11 | (message :string)) 12 | 13 | (defcfun g-error-free :void 14 | (error :pointer)) 15 | 16 | (defcfun g-error-copy :pointer 17 | (error :pointer)) 18 | 19 | (defcfun g-error-matches :boolean 20 | (error :pointer) 21 | (domain g-quark) 22 | (code :int)) 23 | 24 | (defcfun g-set-error-literal :void 25 | (err-ptr :pointer) 26 | (domain g-quark) 27 | (code :int) 28 | (message :string)) 29 | 30 | (defcfun g-propagate-error :void 31 | (dest-ptr :pointer) 32 | (src-ptr :pointer)) 33 | 34 | (defcfun g-clear-error :void 35 | (err-ptr :pointer)) 36 | 37 | (define-condition g-error-condition (error) 38 | ((domain :initarg :domain :initform nil :reader g-error-condition-domain) 39 | (code :initarg :code :initform nil :reader g-error-condition-code) 40 | (message :initarg :message :initform nil :reader g-error-condition-message)) 41 | (:report (lambda (e stream) 42 | (format stream "GError was raised. Domain: ~S, code: ~S, message: ~A" 43 | (g-error-condition-domain e) 44 | (g-error-condition-code e) 45 | (g-error-condition-message e))))) 46 | 47 | (defun mayber-raise-g-error-condition (err) 48 | (unless (null-pointer-p err) 49 | (error 'g-error-condition 50 | :domain (foreign-slot-value err 'g-error :domain) 51 | :code (foreign-slot-value err 'g-error :code) 52 | :message (foreign-slot-value err 'g-error :message)))) 53 | 54 | (defmacro with-g-error ((err) &body body) 55 | `(with-foreign-object (,err :pointer) 56 | (setf (mem-ref ,err :pointer) (null-pointer)) 57 | (unwind-protect 58 | (progn ,@body) 59 | (mayber-raise-g-error-condition (mem-ref ,err :pointer)) 60 | (g-clear-error ,err)))) 61 | 62 | (defmacro with-catching-to-g-error ((err) &body body) 63 | `(handler-case 64 | (progn ,@body) 65 | (g-error-condition (e) 66 | (g-set-error-literal ,err 67 | (g-error-condition-domain e) 68 | (g-error-condition-code e) 69 | (g-error-condition-message e))))) 70 | 71 | ;; void g_prefix_error (GError **err, 72 | ;; const gchar *format, 73 | ;; ...); 74 | ;; void g_propagate_prefixed_error (GError **dest, 75 | ;; GError *src, 76 | ;; const gchar *format, 77 | ;; ...); -------------------------------------------------------------------------------- /glib/glib.glist.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (define-foreign-type glist-type () 4 | ((type :reader glist-type-type :initarg :type :initform :pointer) 5 | (free-from-foreign :reader glist-type-free-from-foreign :initarg :free-from-foreign :initform t) 6 | (free-to-foreign :reader glist-type-free-to-foreign :initarg :free-to-foreign :initform t)) 7 | (:actual-type :pointer)) 8 | 9 | (define-parse-method glist (type &key (free-from-foreign t) (free-to-foreign t)) 10 | (make-instance 'glist-type 11 | :type type 12 | :free-from-foreign free-from-foreign 13 | :free-to-foreign free-to-foreign)) 14 | 15 | (defcstruct g-list 16 | (data :pointer) 17 | (next :pointer) 18 | (prev :pointer)) 19 | 20 | (defcfun g-list-first (:pointer g-list) (list (:pointer g-list))) 21 | 22 | (defcfun g-list-free :void (list (:pointer g-list))) 23 | 24 | (defun g-list-next (list) 25 | (if (null-pointer-p list) 26 | (null-pointer) 27 | (foreign-slot-value list 'g-list 'next))) 28 | 29 | (defmethod translate-from-foreign (pointer (type glist-type)) 30 | (prog1 31 | (iter (for c initially pointer then (g-list-next c)) 32 | (until (null-pointer-p c)) 33 | (collect (convert-from-foreign (foreign-slot-value c 'g-list 'data) (glist-type-type type)))) 34 | (when (glist-type-free-from-foreign type) 35 | (g-list-free pointer)))) 36 | 37 | 38 | (define-foreign-type gslist-type () 39 | ((type :reader gslist-type-type :initarg :type :initform :pointer) 40 | (free-from-foreign :reader gslist-type-free-from-foreign :initarg :free-from-foreign :initform t) 41 | (free-to-foreign :reader gslist-type-free-to-foreign :initarg :free-to-foreign :initform t)) 42 | (:actual-type :pointer)) 43 | 44 | (define-parse-method gslist (type &key (free-from-foreign t) (free-to-foreign t)) 45 | (make-instance 'gslist-type 46 | :type type 47 | :free-from-foreign free-from-foreign 48 | :free-to-foreign free-to-foreign)) 49 | 50 | (defcstruct g-slist 51 | (data :pointer) 52 | (next :pointer)) 53 | 54 | (defcfun g-slist-alloc (:pointer g-slist)) 55 | 56 | (defcfun g-slist-free :void (list (:pointer g-slist))) 57 | 58 | (defun g-slist-next (list) 59 | (if (null-pointer-p list) 60 | (null-pointer) 61 | (foreign-slot-value list 'g-slist 'next))) 62 | 63 | (defmethod translate-from-foreign (pointer (type gslist-type)) 64 | (prog1 65 | (iter (for c initially pointer then (g-slist-next c)) 66 | (until (null-pointer-p c)) 67 | (collect (convert-from-foreign (foreign-slot-value c 'g-slist 'data) (gslist-type-type type)))) 68 | (when (gslist-type-free-from-foreign type) 69 | (g-slist-free pointer)))) 70 | 71 | (defmethod translate-to-foreign (list (type gslist-type)) 72 | (let ((result (null-pointer)) last) 73 | (iter (for item in list) 74 | (for n = (g-slist-alloc)) 75 | (for ptr = (convert-to-foreign item (gslist-type-type type))) 76 | (setf (foreign-slot-value n 'g-slist 'data) ptr) 77 | (setf (foreign-slot-value n 'g-slist 'next) (null-pointer)) 78 | (when last 79 | (setf (foreign-slot-value last 'g-slist 'next) n)) 80 | (setf last n) 81 | (when (first-iteration-p) 82 | (setf result n))) 83 | result)) 84 | 85 | -------------------------------------------------------------------------------- /glib/glib.gstrv.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (define-foreign-type gstrv-type () 4 | ((free-from-foreign :initarg :free-from-foreign :initform t :reader gstrv-type-fff) 5 | (free-to-foreign :initarg :free-to-foreign :initform t :reader gstrv-type-ftf)) 6 | (:actual-type :pointer)) 7 | 8 | (define-parse-method gstrv (&key (free-from-foreign t) (free-to-foreign t)) 9 | (make-instance 'gstrv-type :free-from-foreign free-from-foreign :free-to-foreign free-to-foreign)) 10 | 11 | (defmethod translate-from-foreign (value (type gstrv-type)) 12 | (unless (null-pointer-p value) 13 | (prog1 14 | (iter (for i from 0) 15 | (for str-ptr = (mem-aref value :pointer i)) 16 | (until (null-pointer-p str-ptr)) 17 | (collect (convert-from-foreign str-ptr '(:string :free-from-foreign nil))) 18 | (when (gstrv-type-fff type) 19 | (g-free str-ptr))) 20 | (when (gstrv-type-fff type) 21 | (g-free value))))) 22 | 23 | (defmethod translate-to-foreign (str-list (type gstrv-type)) 24 | (let* ((n (length str-list)) 25 | (result (g-malloc (* (1+ n) (foreign-type-size :pointer))))) 26 | (iter (for i from 0) 27 | (for str in str-list) 28 | (setf (mem-aref result :pointer i) (g-strdup str))) 29 | (setf (mem-aref result :pointer n) (null-pointer)) 30 | result)) -------------------------------------------------------------------------------- /glib/glib.quark.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (defctype quark-value-type :uint32) 4 | 5 | (defcfun g-quark-from-string quark-value-type 6 | (string :string)) 7 | 8 | (defcfun g-quark-to-string :string 9 | (quark quark-value-type)) 10 | 11 | (define-foreign-type quark-type () 12 | () 13 | (:actual-type quark-value-type) 14 | (:simple-parser g-quark)) 15 | 16 | (defmethod translate-to-foreign (value (type quark-type)) 17 | (g-quark-from-string value)) 18 | 19 | (defmethod translate-from-foreign (value (type quark-type)) 20 | (g-quark-to-string value)) -------------------------------------------------------------------------------- /glib/glib.rand.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (defcfun (random-set-seed "g_random_set_seed") :void 4 | (seed :uint32)) 5 | 6 | (export 'random-set-seed) 7 | 8 | (defcfun (random-int "g_random_int") :uint32) 9 | 10 | (export 'random-int) 11 | 12 | (defcfun (random-int-range "g_random_int_range") :int32 13 | (begin :int32) 14 | (end :int32)) 15 | 16 | (export 'random-int-range) 17 | 18 | (defun random-boolean () 19 | (logtest (random-int) #X8000)) 20 | 21 | (export 'random-boolean) 22 | 23 | (defcfun (random-double "g_random_double") :double) 24 | 25 | (export 'random-double) 26 | 27 | (defcfun (random-double-range "g_random_double_range") :double 28 | (begin :double) 29 | (end :double)) 30 | 31 | (export 'random-double-range) 32 | 33 | -------------------------------------------------------------------------------- /glib/glib.string.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | ;; A type that it almost like :string but uses g_malloc and g_free 4 | 5 | (define-foreign-type g-string-type () 6 | ((free-from-foreign :initarg :fff :reader g-string-type-fff :initform nil) 7 | (free-to-foreign :initarg :ftf :reader g-string-type-ftf :initform t)) 8 | (:actual-type :pointer)) 9 | 10 | (define-parse-method g-string (&key (free-from-foreign nil) (free-to-foreign t)) 11 | (make-instance 'g-string-type :fff free-from-foreign :ftf free-to-foreign)) 12 | 13 | (defmethod translate-to-foreign (value (type g-string-type)) 14 | (g-strdup value)) 15 | 16 | (defmethod translate-from-foreign (value (type g-string-type)) 17 | (prog1 18 | (convert-from-foreign value '(:string :free-from-foreign nil)) 19 | (when (g-string-type-fff type) 20 | (g-free value)))) -------------------------------------------------------------------------------- /glib/glib.utils.lisp: -------------------------------------------------------------------------------- 1 | (in-package :glib) 2 | 3 | (defcfun g-get-user-cache-dir :string) 4 | 5 | (defun get-user-cache-dir () 6 | (g-get-user-cache-dir)) 7 | 8 | (export 'get-user-cache-dir) 9 | 10 | (defcfun g-get-user-data-dir :string) 11 | 12 | (defun get-user-data-dir () 13 | (g-get-user-data-dir)) 14 | 15 | (export 'get-user-data-dir) 16 | 17 | (defcfun g-get-user-config-dir :string) 18 | 19 | (defun get-user-config-dir () 20 | (g-get-user-config-dir)) 21 | 22 | (export 'get-user-config-dir) 23 | 24 | (defcfun g-build-filenamev (:string :free-from-foreign t) 25 | (args :pointer)) 26 | 27 | (defun build-filename (&rest args) 28 | (let* ((n (length args)) 29 | (arr (g-malloc (* (1+ n) (foreign-type-size :pointer))))) 30 | 31 | (iter (for i from 0) 32 | (for arg in args) 33 | (setf (mem-aref arr :pointer i) (g-strdup arg))) 34 | (setf (mem-aref arr :pointer n) (null-pointer)) 35 | 36 | (prog1 37 | (g-build-filenamev arr) 38 | 39 | (iter (for i from 0) 40 | (for str-ptr = (mem-aref arr :pointer i)) 41 | (until (null-pointer-p str-ptr)) 42 | (g-free str-ptr)) 43 | (g-free arr)))) 44 | 45 | (export 'build-filename) 46 | 47 | -------------------------------------------------------------------------------- /glib/gobject.cffi-callbacks.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defun wrap-body-with-boxed-translations (args body) 4 | (if (null args) 5 | body 6 | (let ((arg (first args))) 7 | (destructuring-bind (arg-name arg-type) arg 8 | (if (and (listp arg-type) (eq 'g-boxed-foreign (first arg-type))) 9 | (let ((var (gensym)) 10 | (cffi-type (cffi::parse-type arg-type))) 11 | `((let ((,var ,arg-name) 12 | (,arg-name (translate-from-foreign ,arg-name ,cffi-type))) 13 | (unwind-protect 14 | (progn ,@(wrap-body-with-boxed-translations (rest args) body)) 15 | (cleanup-translated-object-for-callback ,cffi-type ,arg-name ,var))))) 16 | (wrap-body-with-boxed-translations (rest args) body)))))) 17 | 18 | (defmacro glib-defcallback (name-and-options return-type args &body body) 19 | (let* ((c-args (iter (for arg in args) 20 | (for (name type) = arg) 21 | (if (and (listp type) (eq 'g-boxed-foreign (first type))) 22 | (collect `(,name :pointer)) 23 | (collect arg)))) 24 | (c-body (wrap-body-with-boxed-translations args body))) 25 | `(defcallback ,name-and-options ,return-type ,c-args 26 | ,@c-body))) 27 | -------------------------------------------------------------------------------- /glib/gobject.foreign.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defgeneric release (object) 4 | (:documentation "Manually frees the Lisp reference to the @code{object}. Probably should not be called. 5 | 6 | @arg[object]{an instance of @class{g-object}}")) 7 | 8 | (defmethod release ((object null))) 9 | 10 | (defun release* (&rest objects) 11 | "Calls @fun{release} on all objects in @code{objects} 12 | 13 | @arg[objects]{a list of instances of @class{g-object}}" 14 | (declare (dynamic-extent objects)) 15 | (loop 16 | for object in objects 17 | do (release object))) 18 | 19 | (defmacro using ((var &optional (expr var)) &body body) 20 | `(let ((,var ,expr)) 21 | (unwind-protect 22 | (progn ,@body) 23 | (release ,var)))) 24 | 25 | (defun using-expand (bindings body) 26 | (if bindings 27 | (destructuring-bind (var &optional (expr var)) (ensure-list (first bindings)) 28 | `(let ((,var ,expr)) 29 | (unwind-protect 30 | ,(using-expand (rest bindings) body) 31 | (release ,var)))) 32 | `(progn ,@body))) 33 | 34 | (defmacro using* ((&rest bindings) &body body) 35 | (using-expand bindings body)) 36 | -------------------------------------------------------------------------------- /glib/gobject.init.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-gtk2-init 2 | (:use :cl :glib)) 3 | 4 | (in-package :cl-gtk2-init) 5 | 6 | (at-init () 7 | (eval-when (:compile-toplevel :load-toplevel :execute) 8 | (cffi:define-foreign-library gobject 9 | ((:and :unix (:not :darwin)) (:or "libgobject-2.0.so.0" "libgobject-2.0.so")) 10 | (:darwin (:or "libgobject-2.0.0.dylib" "libgobject-2.0.dylib")) 11 | (:windows "libgobject-2.0-0.dll") 12 | (t "libgobject-2.0"))) 13 | 14 | (cffi:use-foreign-library gobject)) 15 | 16 | -------------------------------------------------------------------------------- /glib/gobject.object-defs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defclass g-initially-unowned (g-object) 4 | () 5 | (:metaclass gobject-class) 6 | (:g-type-name . "GInitiallyUnowned") 7 | (:g-type-initializer . "g_initially_unowned_get_type") 8 | (:documentation "Base class that has initial \"floating\" reference.")) 9 | -------------------------------------------------------------------------------- /glib/gobject.object-function.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defcstruct object-func-ref 4 | (:object :pointer) 5 | (:fn-id :int)) 6 | 7 | (defmacro define-cb-methods (name return-type (&rest args)) 8 | (flet ((make-name (control-string) (intern (format nil control-string (symbol-name name)) (symbol-package name)))) 9 | (let ((call-cb (make-name "~A-CB")) 10 | (destroy-cb (make-name "~A-DESTROY-NOTIFY")) 11 | (object (gensym "OBJECT")) 12 | (fn-id (gensym "FN-ID")) 13 | (fn (gensym "FN")) 14 | (data (gensym "DATA")) 15 | (arg-names (mapcar #'first args))) 16 | `(progn 17 | (defcallback ,call-cb ,return-type (,@args (,data :pointer)) 18 | (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object)) 19 | (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id)) 20 | (,fn (retrieve-handler-from-object ,object ,fn-id))) 21 | (funcall ,fn ,@arg-names))) 22 | (defcallback ,destroy-cb :void ((,data :pointer)) 23 | (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object)) 24 | (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id))) 25 | (delete-handler-from-object ,object ,fn-id)) 26 | (foreign-free ,data)))))) 27 | 28 | (defun create-fn-ref (object function) 29 | (let ((ref (foreign-alloc 'object-func-ref)) 30 | (fn-id (save-handler-to-object object function))) 31 | (setf (foreign-slot-value ref 'object-func-ref :object) 32 | (pointer object) 33 | (foreign-slot-value ref 'object-func-ref :fn-id) 34 | fn-id) 35 | ref)) 36 | -------------------------------------------------------------------------------- /glib/gobject.stable-pointer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defvar *registered-stable-pointers* (make-array 0 :adjustable t :fill-pointer t)) 4 | 5 | (defun allocate-stable-pointer (thing) 6 | "Allocates the stable pointer for @code{thing}. Stable pointer is an integer that can be dereferenced with @fun{get-stable-pointer-value} and freed with @fun{free-stable-pointer}. Stable pointers are used to pass references to lisp objects to foreign code. 7 | @arg[thing]{any object} 8 | @return{integer}" 9 | (let ((id (find-fresh-id))) 10 | (setf (aref *registered-stable-pointers* id) thing) 11 | (make-pointer id))) 12 | 13 | (defun free-stable-pointer (stable-pointer) 14 | "Frees the stable pointer previously allocated by @fun{allocate-stable-pointer}" 15 | (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) nil)) 16 | 17 | (defun get-stable-pointer-value (stable-pointer) 18 | "Returns the objects that is referenced by stable pointer previously allocated by @fun{allocate-stable-pointer}. May be called any number of times." 19 | (when (<= 0 (pointer-address stable-pointer) (length *registered-stable-pointers*)) 20 | (aref *registered-stable-pointers* (pointer-address stable-pointer)))) 21 | 22 | (defun set-stable-pointer-value (stable-pointer value) 23 | "Returns the objects that is referenced by stable pointer previously allocated by @fun{allocate-stable-pointer}. May be called any number of times." 24 | (when (<= 0 (pointer-address stable-pointer) (length *registered-stable-pointers*)) 25 | (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) value))) 26 | 27 | (defun stable-pointer-value (stable-pointer) 28 | (get-stable-pointer-value stable-pointer)) 29 | 30 | (defun (setf stable-pointer-value) (new-value stable-pointer) 31 | (set-stable-pointer-value stable-pointer new-value)) 32 | 33 | (defun find-fresh-id () 34 | (or (position nil *registered-stable-pointers*) 35 | (progn (vector-push-extend nil *registered-stable-pointers*) 36 | (1- (length *registered-stable-pointers*))))) 37 | 38 | (defmacro with-stable-pointer ((ptr expr) &body body) 39 | "Executes @code{body} with @code{ptr} bound to the stable pointer to result of evaluating @code{expr}. 40 | 41 | @arg[ptr]{a symbol naming the variable which will hold the stable pointer value} 42 | @arg[expr]{an expression}" 43 | `(let ((,ptr (allocate-stable-pointer ,expr))) 44 | (unwind-protect 45 | (progn ,@body) 46 | (free-stable-pointer ,ptr)))) 47 | -------------------------------------------------------------------------------- /glib/gobject.type-designator.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject.ffi) 2 | 3 | (defctype g-type gsize) 4 | 5 | (defstruct gtype name %id) 6 | 7 | (defvar *name-to-gtype* (make-hash-table :test 'equal)) 8 | (defvar *id-to-gtype* (make-hash-table)) 9 | (defvar *gtype-lock* (bt:make-lock "gtype lock")) 10 | 11 | (defun invalidate-gtypes () 12 | (bt:with-lock-held (*gtype-lock*) 13 | (clrhash *id-to-gtype*) 14 | (iter (for (name gtype) in-hashtable *name-to-gtype*) 15 | (setf (gtype-%id gtype) nil)))) 16 | 17 | (at-finalize () (invalidate-gtypes)) 18 | 19 | (defcfun (%g-type-from-name "g_type_from_name") g-type 20 | (name :string)) 21 | 22 | (defcfun (%g-type-name "g_type_name") (:string :free-from-foreign nil) 23 | (type g-type)) 24 | 25 | (defun warn-unknown-gtype (name) 26 | (warn "GType ~A is not known to GObject" name)) 27 | 28 | (defun gtype-from-name (name) 29 | (declare (optimize (safety 0) (speed 3))) 30 | (when (null name) (return-from gtype-from-name nil)) 31 | (bt:with-lock-held (*gtype-lock*) 32 | (let ((type (gethash name *name-to-gtype*))) 33 | (when type 34 | (when (null (gtype-%id type)) 35 | (let ((n (%g-type-from-name name))) 36 | (if (zerop n) 37 | (warn-unknown-gtype name) 38 | (progn 39 | (setf (gtype-%id type) n 40 | (gethash n *id-to-gtype*) type))))) 41 | (return-from gtype-from-name type))) 42 | (let ((n (%g-type-from-name name))) 43 | (when (zerop n) 44 | (warn-unknown-gtype name) 45 | (setf n nil)) 46 | (let ((type (make-gtype :name (copy-seq name) :%id n))) 47 | (setf (gethash n *id-to-gtype*) type 48 | (gethash name *name-to-gtype*) type) 49 | (return-from gtype-from-name type))))) 50 | 51 | (defun gtype-from-id (id) 52 | (declare (optimize (safety 0) (speed 3))) 53 | (when (zerop id) (return-from gtype-from-id nil)) 54 | (bt:with-lock-held (*gtype-lock*) 55 | (let ((type (gethash id *id-to-gtype*))) 56 | (when type 57 | (return-from gtype-from-id type))) 58 | (let ((name (%g-type-name id))) 59 | (unless name 60 | (warn-unknown-gtype id)) 61 | (let ((type (gethash name *name-to-gtype*))) 62 | (when type 63 | (setf (gtype-%id type) id 64 | (gethash id *id-to-gtype*) type) 65 | (return-from gtype-from-id type)) 66 | (let ((type (make-gtype :name name :%id id))) 67 | (setf (gethash id *id-to-gtype*) type 68 | (gethash name *name-to-gtype*) type) 69 | (return-from gtype-from-id type)))))) 70 | 71 | (defun gtype-id (gtype) 72 | (when (null gtype) (return-from gtype-id 0)) 73 | (when (gtype-%id gtype) (return-from gtype-id (gtype-%id gtype))) 74 | (bt:with-lock-held (*gtype-lock*) 75 | (let ((n (%g-type-from-name (gtype-name gtype)))) 76 | (when (zerop n) 77 | (warn-unknown-gtype (gtype-name gtype)) 78 | (return-from gtype-id 0)) 79 | (setf (gtype-%id gtype) n 80 | (gethash n *id-to-gtype*) gtype) 81 | n))) 82 | 83 | (defun %gtype (thing) 84 | (etypecase thing 85 | (null nil) 86 | (gtype thing) 87 | (string (gtype-from-name thing)) 88 | (integer (gtype-from-id thing)))) 89 | 90 | (defun gtype (thing) 91 | (%gtype thing)) 92 | 93 | (define-compiler-macro gtype (&whole whole thing) 94 | (if (constantp thing) 95 | `(load-time-value (%gtype ,thing)) 96 | whole)) 97 | 98 | (define-foreign-type g-type-designator () 99 | ((mangled-p :initarg :mangled-p 100 | :reader g-type-designator-mangled-p 101 | :initform nil 102 | :documentation "Whether the type designator is mangled with G_SIGNAL_TYPE_STATIC_SCOPE flag")) 103 | (:documentation "Values of this CFFI foreign type identify the GType. GType is designated by a its name (a string) or a numeric identifier. Functions accept GType designators as a string or integer and return them as a string. Functions @fun{g-type-name} and @fun{g-type-from-name} are used to convert between name and numeric identifier. 104 | 105 | Numeric identifier of GType may be different between different program runs. But string identifier of GType does not change.") 106 | (:actual-type g-type) 107 | (:simple-parser g-type-designator)) 108 | 109 | (defun unmangle-g-type (g-type) 110 | (logxor g-type (ldb (byte 1 0) g-type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE 111 | 112 | (defmethod translate-from-foreign (value (type g-type-designator)) 113 | (gtype (if (g-type-designator-mangled-p type) 114 | (unmangle-g-type value) 115 | value))) 116 | 117 | (defmethod translate-to-foreign (value (type g-type-designator)) 118 | (gtype-id (gtype value))) 119 | 120 | (defun g-type= (type-1 type-2) 121 | (eq (gtype type-1) (gtype type-2))) 122 | 123 | (defun g-type/= (type-1 type-2) 124 | (not (eq (gtype type-1) (gtype type-2)))) 125 | -------------------------------------------------------------------------------- /glib/gobject.type-info.enum.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defstruct enum-item 4 | "A structure describing a single enumeration item. 5 | 6 | See accessor functions: 7 | @itemize{ 8 | @item{@fun{enum-item-name}} 9 | @item{@fun{enum-item-value}} 10 | @item{@fun{enum-item-nick}} 11 | }" 12 | name value nick) 13 | 14 | (setf (documentation 'enum-item-name 'function) 15 | "The C name of enum item, e.g. \"GTK_WINDOW_TOPLEVEL\". 16 | @return{a string}") 17 | 18 | (setf (documentation 'enum-item-value 'function) 19 | "The numeric value of enum item. 20 | @return{an integer}") 21 | 22 | (setf (documentation 'enum-item-nick 'function) 23 | "The \"nickname\" of enum item. Nickname is a short name of enum item. E.g., \"toplevel\". 24 | @return{a string}") 25 | 26 | (defun get-enum-items (type) 27 | "Gets the list of enum items that belong to GEnum type @code{type} 28 | @arg[type]{a string or an integer specifying GEnum type} 29 | @return{a list of @class{enum-item} objects}" 30 | (assert (g-type-is-a type +g-type-enum+)) 31 | (let ((g-class (g-type-class-ref type))) 32 | (unwind-protect 33 | (loop 34 | with n = (foreign-slot-value g-class 'g-enum-class :n-values) 35 | with values = (foreign-slot-value g-class 'g-enum-class :values) 36 | for i from 0 below n 37 | for enum-value = (mem-aref values 'g-enum-value i) 38 | collect (make-enum-item 39 | :name (foreign-slot-value enum-value 'g-enum-value 40 | :name) 41 | :value (foreign-slot-value enum-value 'g-enum-value 42 | :value) 43 | :nick (foreign-slot-value enum-value 'g-enum-value 44 | :nick))) 45 | (g-type-class-unref g-class)))) 46 | 47 | (defstruct flags-item 48 | "A structure describing a single flags item. 49 | 50 | See accessor functions: 51 | @itemize{ 52 | @item{@fun{flags-item-name}} 53 | @item{@fun{flags-item-value}} 54 | @item{@fun{flags-item-nick}} 55 | }" 56 | name value nick) 57 | 58 | (setf (documentation 'flags-item-name 'function) 59 | "The C name of flags item, e.g. \"GDK_PROPERTY_CHANGE_MASK\". 60 | @return{a string}") 61 | 62 | (setf (documentation 'flags-item-value 'function) 63 | "The numeric value of flags item. 64 | @return{an integer}") 65 | 66 | (setf (documentation 'flags-item-nick 'function) 67 | "The \"nickname\" of flags item. Nickname is a short name of flags item. E.g., \"property-change-mask\". 68 | @return{a string}") 69 | 70 | (defun get-flags-items (type) 71 | "Gets the list of flags items that belong to GFlags type @code{type} 72 | @arg[type]{a string or an integer specifying GFlags type} 73 | @return{a list of @class{flags-item} objects}" 74 | (assert (g-type-is-a type +g-type-flags+)) 75 | (let ((g-class (g-type-class-ref type))) 76 | (unwind-protect 77 | (loop 78 | with n = (foreign-slot-value g-class 'g-flags-class :n-values) 79 | with values = (foreign-slot-value g-class 'g-flags-class :values) 80 | for i from 0 below n 81 | for flags-value = (mem-aref values 'g-flags-value i) 82 | collect (make-flags-item 83 | :name (foreign-slot-value flags-value 'g-flags-value 84 | :name) 85 | :value (foreign-slot-value flags-value 'g-flags-value 86 | :value) 87 | :nick (foreign-slot-value flags-value 'g-flags-value 88 | :nick))) 89 | (g-type-class-unref g-class)))) 90 | -------------------------------------------------------------------------------- /glib/gobject.type-info.signals.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gobject) 2 | 3 | (defstruct signal-info 4 | id 5 | name 6 | owner-type 7 | flags 8 | return-type 9 | param-types 10 | detail) 11 | 12 | (defmethod print-object ((instance signal-info) stream) 13 | (if *print-readably* 14 | (call-next-method) 15 | (print-unreadable-object (instance stream) 16 | (format stream 17 | "Signal [#~A] ~A ~A.~A~@[::~A~](~{~A~^, ~})~@[ [~{~A~^, ~}]~]" 18 | (signal-info-id instance) 19 | (gtype-name (signal-info-return-type instance)) 20 | (gtype-name (signal-info-owner-type instance)) 21 | (signal-info-name instance) 22 | (signal-info-detail instance) 23 | (mapcar #'gtype-name (signal-info-param-types instance)) 24 | (signal-info-flags instance))))) 25 | 26 | (defun query-signal-info (signal-id) 27 | (with-foreign-object (q 'g-signal-query) 28 | (g-signal-query signal-id q) 29 | (assert (not (zerop (foreign-slot-value q 'g-signal-query :signal-id)))) 30 | (let ((param-types 31 | (iter (with param-types = (foreign-slot-value q 'g-signal-query :param-types)) 32 | (for i from 0 below (foreign-slot-value q 'g-signal-query :n-params)) 33 | (for param-type = (mem-aref param-types '(g-type-designator :mangled-p t) i)) 34 | (collect param-type)))) 35 | (make-signal-info :id signal-id 36 | :name (foreign-slot-value q 'g-signal-query :signal-name) 37 | :owner-type (foreign-slot-value q 'g-signal-query :owner-type) 38 | :flags (foreign-slot-value q 'g-signal-query :signal-flags) 39 | :return-type (foreign-slot-value q 'g-signal-query :return-type) 40 | :param-types param-types)))) 41 | 42 | (defun parse-signal-name (owner-type signal-name) 43 | (with-foreign-objects ((signal-id :uint) (detail 'glib:g-quark)) 44 | (when (g-signal-parse-name signal-name owner-type signal-id detail t) 45 | (let ((signal-info (query-signal-info (mem-ref signal-id :uint)))) 46 | (setf (signal-info-detail signal-info) (mem-ref detail 'g-quark)) 47 | signal-info)))) 48 | 49 | (defun type-signals (type &key include-inherited) 50 | (unless (g-type= type +g-type-invalid+) 51 | (let ((signals (with-foreign-object (n-ids :uint) 52 | (with-unwind (ids (g-signal-list-ids type n-ids) g-free) 53 | (iter (for i from 0 below (mem-ref n-ids :uint)) 54 | (collect (query-signal-info (mem-aref ids :uint i)))))))) 55 | (if include-inherited 56 | (nconc (type-signals (g-type-parent type) :include-inherited t) 57 | (iter (for interface in (g-type-interfaces type)) 58 | (nconcing (type-signals interface :include-inherited t))) 59 | signals) 60 | signals)))) 61 | -------------------------------------------------------------------------------- /glib/gobject.type-tests.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:gtype-tests 2 | (:use #:cl #:iter #:gobject #:gobject.ffi #:5am) 3 | (:export #:run-all-tests) 4 | (:import-from #:gobject.ffi #:%gtype #:gtype #:gtype-name #:gtype-%id #:gtype-id #:invalidate-gtypes)) 5 | 6 | (in-package #:gtype-tests) 7 | 8 | (def-suite gtype) 9 | 10 | (in-suite gtype) 11 | 12 | (defun run-all-tests () 13 | (run! 'gtype)) 14 | 15 | ;; Normal things 16 | 17 | (test normal.1 18 | (finishes (%gtype "gint")) 19 | (finishes (%gtype "glong")) 20 | (finishes (%gtype +g-type-pointer+))) 21 | 22 | (test normal.eq 23 | (is (eq (%gtype "gint") (%gtype "gint"))) 24 | (is (eq (%gtype "GObject") (%gtype "GObject"))) 25 | (is (not (eq (%gtype "gint") (%gtype "GObject")))) 26 | (is (eq (%gtype "gchararray") (%gtype +g-type-string+)))) 27 | 28 | (test normal.boundary 29 | (is (null (%gtype 0))) 30 | (is (null (%gtype nil))) 31 | (signals warning (%gtype "foobarbaz")) 32 | (signals error (%gtype 1))) 33 | 34 | (test normal.trans 35 | (is (string= (gtype-name (%gtype "gint")) "gint")) 36 | (is (eql (gtype-id (%gtype "gint")) +g-type-int+))) 37 | 38 | ;; Clear mappings 39 | 40 | (test clear.simple 41 | (let ((type (%gtype "gint"))) 42 | (is (eql (gtype-id type) +g-type-int+)) 43 | (invalidate-gtypes) 44 | (is (null (gtype-%id type))) 45 | (is (eql (gtype-id type) +g-type-int+)) 46 | (invalidate-gtypes) 47 | (is (eq type (%gtype "gint"))) 48 | (invalidate-gtypes) 49 | (is (eq type (%gtype +g-type-int+))))) 50 | 51 | (test clear.1 52 | (let ((type (%gtype "gint"))) 53 | (invalidate-gtypes) 54 | (is (null (gtype-%id type))) 55 | (%gtype +g-type-int+) 56 | (is (not (null (gethash +g-type-int+ gobject.ffi::*id-to-gtype*)))) 57 | (is (not (null (gtype-%id type)))))) 58 | 59 | ;; Core saving 60 | 61 | (defvar *gi* (%gtype +g-type-int+)) 62 | 63 | (test core.saving 64 | (is (eq *gi* (%gtype +g-type-int+))) 65 | (is (eq (gtype +g-type-int+) (%gtype +g-type-int+)))) 66 | -------------------------------------------------------------------------------- /glib/gobject.type-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | sbcl --eval "(asdf:oos 'asdf:load-op :cl-gtk2-gtk)" --eval "(asdf:oos 'asdf:load-op :fiveam)" --load gobject.type-tests.lisp --eval '(sb-ext:save-lisp-and-die "/tmp/sbcl-type-tests-core" :executable t)' 3 | /tmp/sbcl-type-tests-core --eval "(gtype-tests:run-all-tests)" --eval "(quit)" 4 | rm /tmp/sbcl-type-tests-core -------------------------------------------------------------------------------- /gtk-glext/cl-gtk2-gtkglext.asd: -------------------------------------------------------------------------------- 1 | (defsystem :cl-gtk2-gtkglext 2 | :name :cl-gtk2-gtkglext 3 | :version "0.1.1" 4 | :author "Vitaly Mayatskikh " 5 | :license "LLGPL" 6 | :serial t 7 | :components ((:file "gtkglext.package") 8 | (:file "gtkglext") 9 | (:file "gtkglext-drawing-area") 10 | (:file "demo")) 11 | :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-gtk :cl-gtk2-gdk :cl-opengl :cl-glu :cl-glut)) 12 | -------------------------------------------------------------------------------- /gtk-glext/gtkglext-drawing-area.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtkglext) 2 | 3 | (defclass gl-drawing-area (drawing-area) 4 | ((on-expose :initarg :on-expose :initform nil :accessor gl-drawing-area-on-expose) 5 | (on-init :initarg :on-init :initform nil :accessor gl-drawing-area-on-init) 6 | (on-resize :initarg :on-resize :initform nil :accessor gl-drawing-area-on-resize) 7 | (realized-p :initform nil :accessor gl-drawing-area-realized-p)) 8 | (:metaclass gobject-class) 9 | (:g-type-name . "GtkGLDrawingArea")) 10 | 11 | (defun resize (widget width height) 12 | (with-gl-context (widget) 13 | (if (gl-drawing-area-on-resize widget) 14 | (funcall (gl-drawing-area-on-resize widget) widget width height) 15 | (progn 16 | (gl:viewport 0 0 width height) 17 | 18 | ;; set projection to account for aspect 19 | (gl:matrix-mode :projection) 20 | (gl:load-identity) 21 | (glu:perspective 90 (/ width height) 0.5 20) ; 90 degrees field of view y, clip 0.5-20 z 22 | 23 | ;; set modelview to identity 24 | (gl:matrix-mode :modelview) 25 | (gl:load-identity))))) 26 | 27 | (defun gl-drawing-area-configure (widget event) 28 | (declare (ignore event)) 29 | (multiple-value-bind (width height) 30 | (gdk:drawable-get-size (widget-window widget)) 31 | #+nil(format t "configure ~Dx~D~%" width height) 32 | (when (gl-drawing-area-realized-p widget) 33 | (resize widget width height)))) 34 | 35 | (defun gl-drawing-area-realize (widget) 36 | #+nil(format t "realize~%") 37 | (bwhen (init-fn (gl-drawing-area-on-init widget)) 38 | (with-gl-context (widget) 39 | (funcall init-fn widget))) 40 | (setf (gl-drawing-area-realized-p widget) t) 41 | (multiple-value-bind (width height) 42 | (gdk:drawable-get-size (widget-window widget)) 43 | (resize widget width height)) 44 | nil) 45 | 46 | (defun gl-drawing-area-unrealize (widget) 47 | (setf (gl-drawing-area-realized-p widget) nil) 48 | nil) 49 | 50 | (defun gl-drawing-area-exposed (widget event) 51 | (bwhen (draw-fn (gl-drawing-area-on-expose widget)) 52 | (with-gl-context (widget) 53 | (funcall draw-fn widget event))) 54 | nil) 55 | 56 | (defun gl-drawing-area-parent-set (widget event) 57 | (declare (ignore event)) 58 | (unless (gtk-widget-set-gl-capability widget 59 | *gl-config* 60 | nil 61 | nil 62 | :rgba-type) 63 | (warn "set gl capability for ~A (with ~A) failed~%" widget *gl-config*))) 64 | 65 | (register-object-type-implementation "GtkGLDrawingArea" gl-drawing-area "GtkDrawingArea" nil nil) 66 | 67 | (defmethod initialize-instance :after ((widget gl-drawing-area) &key &allow-other-keys) 68 | (connect-signal widget "realize" #'gl-drawing-area-realize) 69 | (connect-signal widget "unrealize" #'gl-drawing-area-unrealize) 70 | (connect-signal widget "expose-event" #'gl-drawing-area-exposed) 71 | (connect-signal widget "configure-event" #'gl-drawing-area-configure) 72 | (connect-signal widget "parent-set" #'gl-drawing-area-parent-set)) 73 | -------------------------------------------------------------------------------- /gtk-glext/gtkglext.package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :gtkglext 2 | (:use :cl :cffi :gobject :gtk :gdk :glib :iter) 3 | (:export #:with-gl-context #:with-matrix-mode 4 | #:gl-drawing-area 5 | #:gl-drawing-area-on-expose 6 | #:gl-drawing-area-on-init 7 | #:gl-drawing-area-on-resize)) 8 | 9 | (in-package :gtkglext) 10 | 11 | (at-init () 12 | (eval-when (:compile-toplevel :load-toplevel :execute) 13 | (define-foreign-library gtkglext 14 | (:unix (:or "libgtkglext-x11-1.0.so.0" "libgtkglext-x11-1.0.so")) 15 | (:windows "libgtkglext-win32-1.0-0.dll") 16 | (t (:default "libgtkglext-1.0"))) 17 | (define-foreign-library gdkglext 18 | (:unix (:or "libgdkglext-x11-1.0.so.0" "libgdkglext-x11-1.0.so")) 19 | (:windows "libgdkglext-win32-1.0-0.dll") 20 | (t (:default "libgdkglext-1.0")))) 21 | 22 | (use-foreign-library gtkglext) 23 | (use-foreign-library gdkglext)) 24 | -------------------------------------------------------------------------------- /gtk/cl-gtk2-gtk.asd: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-gtk2-gtk-system 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package #:cl-gtk2-gtk-system) 5 | 6 | (defclass plain-file (static-file) 7 | ((type :initarg :type :reader plain-file-type :initform nil))) 8 | 9 | (defmethod source-file-type ((c plain-file) (s module)) 10 | (plain-file-type c)) 11 | 12 | (defsystem :cl-gtk2-gtk 13 | :name :cl-gtk2-gtk 14 | :version "0.1.1" 15 | :author "Kalyanov Dmitry " 16 | :license "LLGPL" 17 | :serial t 18 | :components ((:file "gtk.package") 19 | (:file "gtk.misc") 20 | (:file "gtk.main_loop_events") 21 | (:file "gtk.object") 22 | (:file "gtk.objects") 23 | (:file "gtk.generated-classes") 24 | (:file "gtk.functions") 25 | (:file "gtk.base-classes") 26 | (:file "gtk.dialog") 27 | (:file "gtk.about-dialog") 28 | (:file "gtk.window") 29 | (:file "gtk.window-group") 30 | (:file "gtk.icon-factory") 31 | (:file "gtk.image") 32 | (:file "gtk.label") 33 | (:file "gtk.progress-bar") 34 | (:file "gtk.status-bar") 35 | (:file "gtk.status-icon") 36 | (:file "gtk.scale-button") 37 | (:file "gtk.entry") 38 | (:file "gtk.spin-button") 39 | (:file "gtk.selections") 40 | (:file "gtk.dnd") 41 | (:file "gtk.text") 42 | (:file "gtk.tree-model") 43 | (:file "gtk.tree-view-column") 44 | (:file "gtk.tree-selection") 45 | (:file "gtk.tree-view") 46 | (:file "gtk.icon-view") 47 | (:file "gtk.cell-layout") 48 | (:file "gtk.cell-renderer") 49 | (:file "gtk.combo-box") 50 | (:file "gtk.menu") 51 | (:file "gtk.ui-manager") 52 | (:file "gtk.selectors") 53 | (:file "gtk.layout-containers") 54 | (:file "gtk.scrolling") 55 | (:file "gtk.calendar") 56 | (:file "gtk.size-group") 57 | (:file "gtk.tooltip") 58 | (:file "gtk.box") 59 | (:file "gtk.container") 60 | (:file "gtk.paned") 61 | (:file "gtk.child-properties") 62 | (:file "gtk.widget") 63 | (:file "gtk.tree-view-dnd") 64 | (:file "gtk.builder") 65 | (:file "gtk.assistant") 66 | (:file "gtk.link-button") 67 | (:file "gtk.list-store") 68 | (:file "gtk.tree-store") 69 | (:file "gtk.tree-model-filter") 70 | (:file "gtk.clipboard") 71 | 72 | (:file "gtk.main-loop-events") 73 | 74 | 75 | (:file "gtk.generated-child-properties") 76 | 77 | (:file "gtk.high-level") 78 | 79 | (:file "ui-markup") 80 | 81 | (:file "gtk.dialog.example") 82 | 83 | (:file "gtk.demo") 84 | (:file "gtk.timer") 85 | (:file "gtk.finalize-classes") 86 | (:module "demo-files" 87 | :pathname "demo/" 88 | :components ((:plain-file "demo1" :type "ui") 89 | (:plain-file "text-editor" :type "ui")))) 90 | :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-gdk :bordeaux-threads :iterate :cl-gtk2-pango)) 91 | -------------------------------------------------------------------------------- /gtk/demo/presence_online.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dmitryvk/cl-gtk2/a3108fbc701dbab93b899e04b9637ded2f813410/gtk/demo/presence_online.png -------------------------------------------------------------------------------- /gtk/gtk.about-dialog.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defvar *about-dialog-url-func* nil) 4 | 5 | (defcallback about-dialog-url-func-cb :void 6 | ((dialog (g-object about-dialog)) (link (:string :free-from-foreign nil)) (user-data :pointer)) 7 | (declare (ignore user-data)) 8 | (funcall *about-dialog-url-func* dialog link)) 9 | 10 | (defcallback about-dialog-url-func-destroy-cb :void 11 | ((data :pointer)) 12 | (declare (ignore data)) 13 | (setf *about-dialog-url-func* nil)) 14 | 15 | (defcfun gtk-about-dialog-set-url-hook :void 16 | (func :pointer) 17 | (data :pointer) 18 | (destroy-notify :pointer)) 19 | 20 | (defun (setf about-dialog-global-url-hook) (new-value) 21 | (if new-value 22 | (gtk-about-dialog-set-url-hook (callback about-dialog-url-func-cb) 23 | (null-pointer) 24 | (callback about-dialog-url-func-destroy-cb)) 25 | (gtk-about-dialog-set-url-hook (null-pointer) 26 | (null-pointer) 27 | (null-pointer))) 28 | (setf *about-dialog-url-func* new-value)) 29 | 30 | (export 'about-dialog-global-url-hook) 31 | 32 | (defvar *about-dialog-email-func* nil) 33 | 34 | (defcallback about-dialog-email-func-cb :void 35 | ((dialog (g-object about-dialog)) (link (:string :free-from-foreign nil)) (user-data :pointer)) 36 | (declare (ignore user-data)) 37 | (funcall *about-dialog-email-func* dialog link)) 38 | 39 | (defcallback about-dialog-email-func-destroy-cb :void 40 | ((data :pointer)) 41 | (declare (ignore data)) 42 | (setf *about-dialog-email-func* nil)) 43 | 44 | (defcfun gtk-about-dialog-set-email-hook :void 45 | (func :pointer) 46 | (data :pointer) 47 | (destroy-notify :pointer)) 48 | 49 | (defun (setf about-dialog-global-email-hook) (new-value) 50 | (if new-value 51 | (gtk-about-dialog-set-email-hook (callback about-dialog-email-func-cb) 52 | (null-pointer) 53 | (callback about-dialog-email-func-destroy-cb)) 54 | (gtk-about-dialog-set-email-hook (null-pointer) 55 | (null-pointer) 56 | (null-pointer))) 57 | (setf *about-dialog-email-func* new-value)) 58 | 59 | (export 'about-dialog-global-email-hook) 60 | 61 | -------------------------------------------------------------------------------- /gtk/gtk.assistant.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (assistant-nth-page "gtk_assistant_get_nth_page") (g-object widget) 4 | (assistant (g-object assistant)) 5 | (page-num :int)) 6 | 7 | (export 'assistant-nth-page) 8 | 9 | (defcfun (assistant-append-page "gtk_assistant_append_page") :int 10 | (assistant (g-object assistant)) 11 | (page (g-object widget))) 12 | 13 | (export 'assistant-append-page) 14 | 15 | (defcfun (assistant-prepend-page "gtk_assistant_prepend_page") :int 16 | (assistant (g-object assistant)) 17 | (page (g-object widget))) 18 | 19 | (export 'assistant-prepend-page) 20 | 21 | (defcfun (assistant-insert-page "gtk_assistant_insert_page") :int 22 | (assistant (g-object assistant)) 23 | (page (g-object widget)) 24 | (position :int)) 25 | 26 | (export 'assistant-insert-page) 27 | 28 | (defcfun gtk-assistant-set-forward-page-func :void 29 | (assistant (g-object assistant)) 30 | (page-func :pointer) 31 | (data :pointer) 32 | (destroy-notify :pointer)) 33 | 34 | (define-cb-methods assistant-page-func :int ((current-page :int))) 35 | 36 | (defun set-assistant-forward-page-function (assistant function) 37 | (if function 38 | (gtk-assistant-set-forward-page-func assistant 39 | (callback assistant-page-func-cb) 40 | (create-fn-ref assistant function) 41 | (callback assistant-page-func-destroy-notify)) 42 | (gtk-assistant-set-forward-page-func assistant (null-pointer) (null-pointer) (null-pointer)))) 43 | 44 | (defcfun (assistant-add-action-widget "gtk_assistant_add_action_widget") :void 45 | (assistant (g-object assistant)) 46 | (widget (g-object widget))) 47 | 48 | (export 'assistant-add-action-widget) 49 | 50 | (defcfun (assistant-remove-action-widget "gtk_assistant_remove_action_widget") :void 51 | (assistant (g-object assistant)) 52 | (widget (g-object widget))) 53 | 54 | (export 'assistant-remove-action-widget) 55 | 56 | (defcfun (assistant-update-buttons-state "gtk_assistant_update_buttons_state") :void 57 | (assistant (g-object assistant))) 58 | 59 | (export 'assistant-update-buttons-state) 60 | 61 | 62 | -------------------------------------------------------------------------------- /gtk/gtk.base-classes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (scale-get-layout "gtk_scale_get_layout") g-object 4 | (scale (g-object scale))) 5 | 6 | (export 'scale-get-layout) 7 | 8 | (defcfun gtk-scale-get-layout-offsets :void 9 | (scale (g-object scale)) 10 | (x (:pointer :int)) 11 | (y (:pointer :int))) 12 | 13 | (defun scale-get-layout-offsets (scale) 14 | (with-foreign-objects ((x :int) (y :int)) 15 | (gtk-scale-get-layout-offsets scale x y) 16 | (values (mem-ref x :int) (mem-ref y :int)))) 17 | 18 | (export 'scale-get-layout-offsets) 19 | 20 | (defcfun (scale-add-mark "gtk_scale_add_mark") :void 21 | (scale (g-object scale)) 22 | (value :double) 23 | (position position-type) 24 | (markup :string)) 25 | 26 | (export 'scale-add-mark) 27 | 28 | (defcfun (scale-clear-marks "gtk_scale_clear_marks") :void 29 | (scale (g-object scale))) 30 | 31 | (export 'scale-clear-marks) 32 | -------------------------------------------------------------------------------- /gtk/gtk.box.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-box-pack-start :void 4 | (box (g-object box)) 5 | (child (g-object widget)) 6 | (expand :boolean) 7 | (fill :boolean) 8 | (padding :uint)) 9 | 10 | (defun box-pack-start (box child &key (expand t) (fill t) (padding 0)) 11 | (gtk-box-pack-start box child expand fill padding)) 12 | 13 | (export 'box-pack-start) 14 | 15 | (defcfun gtk-box-pack-end :void 16 | (box (g-object box)) 17 | (child (g-object widget)) 18 | (expand :boolean) 19 | (fill :boolean) 20 | (padding :uint)) 21 | 22 | (defun box-pack-end (box child &key (expand t) (fill t) (padding 0)) 23 | (gtk-box-pack-end box child expand fill padding)) 24 | 25 | (export 'box-pack-end) 26 | 27 | (defcfun (box-reorder-child "gtk_box_reorder_child") :void 28 | (box g-object) 29 | (child g-object) 30 | (position :int)) 31 | 32 | (export 'box-reorder-child) -------------------------------------------------------------------------------- /gtk/gtk.builder.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-builder-add-from-file :uint 4 | (builder g-object) 5 | (filename :string) 6 | (error :pointer)) 7 | 8 | (defun builder-add-from-file (builder filename) 9 | (gtk-builder-add-from-file builder filename (null-pointer))) 10 | 11 | (export 'builder-add-from-file) 12 | 13 | (defcfun gtk-builder-add-from-string :uint 14 | (builder g-object) 15 | (string :string) 16 | (length :int) 17 | (error :pointer)) 18 | 19 | (defun builder-add-from-string (builder string) 20 | (gtk-builder-add-from-string builder string -1 (null-pointer))) 21 | 22 | (export 'builder-add-from-string) 23 | 24 | (defcfun gtk-builder-add-objects-from-file :uint 25 | (builder g-object) 26 | (filename :string) 27 | (object-ids :pointer) 28 | (error :pointer)) 29 | 30 | (defun builder-add-objects-from-file (builder filename object-ids) 31 | (let ((l (foreign-alloc :pointer :count (1+ (length object-ids))))) 32 | (loop 33 | for i from 0 34 | for object-id in object-ids 35 | do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id))) 36 | (unwind-protect 37 | (gtk-builder-add-objects-from-file builder filename l (null-pointer)) 38 | (loop 39 | for i from 0 40 | repeat (1- (length object-ids)) 41 | do (foreign-string-free (mem-aref l :pointer i))) 42 | (foreign-free l)))) 43 | 44 | (export 'builder-add-objects-from-file) 45 | 46 | (defcfun gtk-builder-add-objects-from-string :uint 47 | (builder g-object) 48 | (string :string) 49 | (length :int) 50 | (object-ids :pointer) 51 | (error :pointer)) 52 | 53 | (defun builder-add-objects-from-string (builder string object-ids) 54 | (let ((l (foreign-alloc :pointer :count (1+ (length object-ids))))) 55 | (loop 56 | for i from 0 57 | for object-id in object-ids 58 | do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id))) 59 | (unwind-protect 60 | (gtk-builder-add-objects-from-string builder string -1 l (null-pointer)) 61 | (loop 62 | for i from 0 63 | repeat (1- (length object-ids)) 64 | do (foreign-string-free (mem-aref l :pointer i))) 65 | (foreign-free l)))) 66 | 67 | (export 'builder-add-objects-from-string) 68 | 69 | (defcfun (builder-get-object "gtk_builder_get_object") g-object 70 | (builder g-object) 71 | (name :string)) 72 | 73 | (export 'builder-get-object) 74 | 75 | ; TODO: gtk_builder_get_objects 76 | 77 | ; TOOD: move connect-flags to gobject 78 | 79 | (defbitfield connect-flags :after :swapped) 80 | 81 | (defcallback builder-connect-func-callback :void 82 | ((builder g-object) (object g-object) (signal-name (:string :free-from-foreign nil)) 83 | (handler-name (:string :free-from-foreign nil)) (connect-object g-object) 84 | (flags connect-flags) (data :pointer)) 85 | (restart-case 86 | (funcall (get-stable-pointer-value data) 87 | builder object signal-name handler-name connect-object flags) 88 | (return () nil))) 89 | 90 | (defcfun gtk-builder-connect-signals-full :void 91 | (builder g-object) 92 | (func :pointer) 93 | (data :pointer)) 94 | 95 | (defun builder-connect-signals-full (builder func) 96 | (with-stable-pointer (ptr func) 97 | (gtk-builder-connect-signals-full builder (callback builder-connect-func-callback) ptr))) 98 | 99 | (export 'builder-connect-signals-full) 100 | 101 | (defun builder-connect-signals-simple (builder handlers-list) 102 | (flet ((connect-func (builder object signal-name handler-name connect-object flags) 103 | (declare (ignore builder connect-object)) 104 | (let ((handler (find handler-name handlers-list :key 'first :test 'string=))) 105 | (when handler 106 | (g-signal-connect object signal-name (second handler) :after (member :after flags)))))) 107 | (builder-connect-signals-full builder #'connect-func))) 108 | 109 | (export 'builder-connect-signals-simple) 110 | 111 | ; TODO: gtk_builder_get_type_from_name 112 | 113 | ; TODO: gtk_builder_value_from_string 114 | 115 | ; TODO: gtk_builder_value_from_string_type 116 | 117 | (defmethod initialize-instance :after ((builder builder) &key from-file from-string) 118 | (when from-file 119 | (builder-add-from-file builder from-file)) 120 | (when from-string 121 | (builder-add-from-string builder from-string))) 122 | -------------------------------------------------------------------------------- /gtk/gtk.calendar.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (calendar-mark-day "gtk_calendar_mark_day") :boolean 4 | (calendar g-object) 5 | (day :uint)) 6 | 7 | (export 'calendar-mark-day) 8 | 9 | (defcfun (calendar-unmark-day "gtk_calendar_unmark_day") :boolean 10 | (calendar g-object) 11 | (day :uint)) 12 | 13 | (export 'calendar-unmark-day) 14 | 15 | (defcfun (calendar-clear-marks "gtk_calendar_clear_marks") :void 16 | (calendar g-object)) 17 | 18 | (export 'calendar-clear-marks) 19 | 20 | (defcallback gtk-calendar-detail-func-callback (g-string :free-to-foreign nil :free-from-foreign nil) 21 | ((calendar g-object) (year :uint) (month :uint) (day :uint) (data :pointer)) 22 | (restart-case 23 | (or (funcall (get-stable-pointer-value data) 24 | calendar year month day) 25 | (null-pointer)) 26 | (return-null () (null-pointer)))) 27 | 28 | (defcfun gtk-calendar-set-detail-func :void 29 | (calendar g-object) 30 | (func :pointer) 31 | (data :pointer) 32 | (destroy-notify :pointer)) 33 | 34 | (defun calendar-set-detail-function (calendar function) 35 | (gtk-calendar-set-detail-func calendar 36 | (callback gtk-calendar-detail-func-callback) 37 | (allocate-stable-pointer function) 38 | (callback stable-pointer-free-destroy-notify-callback))) 39 | -------------------------------------------------------------------------------- /gtk/gtk.cell-layout.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | ; TODO: GtkCellLayout vtable 4 | 5 | (defcfun gtk-cell-layout-pack-start :void 6 | (cell-layout g-object) 7 | (cell g-object) 8 | (expand :boolean)) 9 | 10 | (defun cell-layout-pack-start (cell-layout cell &key (expand t)) 11 | (gtk-cell-layout-pack-start cell-layout cell expand)) 12 | 13 | (export 'cell-layout-pack-start) 14 | 15 | (defcfun gtk-cell-layout-pack-end :void 16 | (cell-layout g-object) 17 | (cell g-object) 18 | (expand :boolean)) 19 | 20 | (defun cell-layout-pack-end (cell-layout cell &key (expand t)) 21 | (gtk-cell-layout-pack-end cell-layout cell expand)) 22 | 23 | (export 'cell-layout-pack-end) 24 | 25 | (defcfun (cell-layout-cells "gtk_cell_layout_get_cells") (glist g-object :free-from-foreign t) 26 | (cell-layout g-object)) 27 | 28 | (export 'cell-layout-cells) 29 | 30 | (defcfun (cell-layout-reorder "gtk_cell_layout_reorder") :void 31 | (cell-layout g-object) 32 | (cell g-object) 33 | (positin :int)) 34 | 35 | (export 'cell-layout-reorder) 36 | 37 | (defcfun (cell-layout-clear "gtk_cell_layout_clear") :void 38 | (cell-layout g-object)) 39 | 40 | (export 'cell-layout-clear) 41 | 42 | (defcfun (cell-layout-add-attribute "gtk_cell_layout_add_attribute") :void 43 | (cell-layout g-object) 44 | (cell g-object) 45 | (attribute (:string :free-to-foreign t)) 46 | (column :int)) 47 | 48 | (export 'cell-layout-add-attribute) 49 | 50 | (defcallback gtk-cell-layout-cell-data-func-callback :void 51 | ((cell-layout g-object) (cell g-object) (tree-model g-object) (iter (g-boxed-foreign tree-iter)) (data :pointer)) 52 | (restart-case 53 | (funcall (get-stable-pointer-value data) 54 | cell-layout cell tree-model iter) 55 | (return () nil))) 56 | 57 | (defcfun gtk-cell-layout-set-cell-data-func :void 58 | (cell-layout g-object) 59 | (cell g-object) 60 | (func :pointer) 61 | (data :pointer) 62 | (destroy-notify :pointer)) 63 | 64 | (defun cell-layout-set-cell-data-func (cell-layout cell func) 65 | (gtk-cell-layout-set-cell-data-func cell-layout 66 | cell 67 | (callback gtk-cell-layout-cell-data-func-callback) 68 | (allocate-stable-pointer func) 69 | (callback stable-pointer-free-destroy-notify-callback))) 70 | 71 | (export 'cell-layout-set-cell-data-func) 72 | 73 | (defcfun (cell-layout-clear-attributes "gtk_cell_layout_clear_attributes") :void 74 | (cell-layout g-object) 75 | (cell g-object)) 76 | 77 | (export 'cell-layout-clear-attributes) -------------------------------------------------------------------------------- /gtk/gtk.cell-renderer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | ; TODO: GtkCellEditable 4 | 5 | ; TODO: GtkCellRenderer vtable 6 | 7 | ; TODO: gtk_cell_renderer_get_size 8 | 9 | ; TODO: gtk_cell_renderer_render 10 | 11 | ; TODO: gtk_cell_renderer_activate 12 | 13 | ; TODO: gtk_cell_renderer_start_editing 14 | 15 | ; TODO: gtk_cell_renderer_stop_editing 16 | 17 | (defcfun gtk-cell-renderer-get-fixed-size :void 18 | (cell (g-object cell-renderer)) 19 | (width (:pointer :int)) 20 | (height (:pointer :int))) 21 | 22 | (defun cell-renderer-get-fixed-size (cell) 23 | (with-foreign-objects ((width :int) (height :int)) 24 | (gtk-cell-renderer-get-fixed-size cell width height) 25 | (values (mem-ref width :int) 26 | (mem-ref height :int)))) 27 | 28 | (export 'cell-renderer-get-fixed-size) 29 | 30 | (defcfun (cell-renderer-set-fixed-size "gtk_cell_renderer_set_fixed_size") :void 31 | (cell (g-object cell-renderer)) 32 | (width :int) 33 | (height :int)) 34 | 35 | (export 'cell-renderer-set-fixed-size) 36 | 37 | ; TODO: GtkCellRendererAccel 38 | 39 | ; TODO: GtkCellRendererCombo 40 | 41 | ; TODO: GtkCellRendererPixbuf 42 | 43 | ; TODO: GtkCellRendererProgress 44 | 45 | ; TODO: GtkCellRendererSpin 46 | 47 | ; TODO: GtkCellRendererText 48 | 49 | ; TODO: GtkCellRendererToggle 50 | 51 | (defcfun (cell-renderer-text-set-fixed-height-from-font "gtk_cell_renderer_text_set_fixed_height_from_font") :void 52 | (renderer (g-object cell-renderer-text)) 53 | (number-of-rows :int)) 54 | 55 | (export 'cell-renderer-text-set-fixed-height-from-font) 56 | -------------------------------------------------------------------------------- /gtk/gtk.child-properties.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-container-child-get-property :void 4 | (container g-object) 5 | (child g-object) 6 | (property-name :string) 7 | (value (:pointer g-value))) 8 | 9 | (defcfun gtk-container-child-set-property :void 10 | (container g-object) 11 | (child g-object) 12 | (property-name :string) 13 | (value (:pointer g-value))) 14 | 15 | (defcfun gtk-container-class-find-child-property :pointer 16 | (class :pointer) 17 | (property-name :string)) 18 | 19 | (defun container-child-property-info (type property-name) 20 | (let ((class (g-type-class-ref type))) 21 | (unwind-protect 22 | (let ((g-param-spec (gtk-container-class-find-child-property class property-name))) 23 | (parse-g-param-spec g-param-spec)) 24 | (g-type-class-unref class)))) 25 | 26 | (export 'container-child-property-info) 27 | 28 | (defun container-call-get-property (container child property-name type) 29 | (with-foreign-object (gvalue 'g-value) 30 | (g-value-zero gvalue) 31 | (g-value-init gvalue (gtype type)) 32 | (gtk-container-child-get-property container child property-name gvalue) 33 | (prog1 (parse-g-value gvalue) 34 | (g-value-unset gvalue)))) 35 | 36 | (defun container-call-set-property (container child property-name new-value type) 37 | (with-foreign-object (gvalue 'g-value) 38 | (set-g-value gvalue new-value (gtype type) :zero-g-value t) 39 | (gtk-container-child-set-property container child property-name gvalue) 40 | (g-value-unset gvalue) 41 | (values))) 42 | 43 | (export '(container-call-get-property container-call-set-property)) 44 | 45 | (defmacro define-child-property (container-type property-name property-gname property-type readable writable export) 46 | (when (stringp container-type) (setf container-type (registered-object-type-by-name container-type))) 47 | `(progn 48 | ,@(when readable 49 | (list `(defun ,property-name (container child) 50 | (assert (typep container ',container-type)) 51 | (container-call-get-property container child ,property-gname ,property-type)))) 52 | ,@(when writable 53 | (list `(defun (setf ,property-name) (new-value container child) 54 | (assert (typep container ',container-type)) 55 | (container-call-set-property container child ,property-gname new-value ,property-type)))) 56 | ,@(when export 57 | (list `(export ',property-name))))) 58 | 59 | (defcfun gtk-container-class-list-child-properties (:pointer (:pointer g-param-spec)) 60 | (class (:pointer g-object-class)) 61 | (n-properties (:pointer :int))) 62 | 63 | (defun container-class-child-properties (g-type) 64 | (setf g-type (gtype g-type)) 65 | (let ((g-class (g-type-class-ref g-type))) 66 | (unwind-protect 67 | (with-foreign-object (n-properties :uint) 68 | (let ((params (gtk-container-class-list-child-properties g-class n-properties))) 69 | (unwind-protect 70 | (loop 71 | for i from 0 below (mem-ref n-properties :uint) 72 | for param = (mem-aref params :pointer i) 73 | collect (parse-g-param-spec param)) 74 | (g-free params)))) 75 | (g-type-class-unref g-class)))) 76 | 77 | (defun child-property-name (type-name property-name package-name) 78 | (intern (format nil "~A-CHILD-~A" (symbol-name (registered-object-type-by-name type-name)) (string-upcase property-name)) (find-package package-name))) 79 | 80 | (defun generate-child-properties (&optional (type-root "GtkContainer") (package-name "GTK")) 81 | (setf type-root (gtype type-root)) 82 | (append (loop 83 | for property in (container-class-child-properties type-root) 84 | collect 85 | `(define-child-property 86 | ,(gtype-name type-root) 87 | ,(child-property-name (gtype-name type-root) (g-class-property-definition-name property) package-name) 88 | ,(g-class-property-definition-name property) 89 | ,(gtype-name (g-class-property-definition-type property)) 90 | ,(g-class-property-definition-readable property) 91 | ,(g-class-property-definition-writable property) 92 | t)) 93 | (loop 94 | for subclass in (g-type-children type-root) 95 | appending (generate-child-properties subclass package-name)))) -------------------------------------------------------------------------------- /gtk/gtk.clipboard.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-clipboard-set-text :void 4 | (clipboard (g-object clipboard)) 5 | (text :string) 6 | (len :int)) 7 | 8 | (defun clipboard-set-text (clipboard text) 9 | (gtk-clipboard-set-text clipboard text -1)) 10 | 11 | (export 'clipboard-set-text) 12 | 13 | (defcfun (clipboard-clear "gtk_clipboard_clear") :void 14 | (clipboard (g-object clipboard))) 15 | 16 | (export 'clipboard-clear) 17 | 18 | -------------------------------------------------------------------------------- /gtk/gtk.combo-box.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-combo-box-get-active-iter :boolean 4 | (combo-box g-object) 5 | (iter (g-boxed-foreign tree-iter))) 6 | 7 | (defun combo-box-get-active-iter (combo-box) 8 | (let ((i (make-instance 'tree-iter))) 9 | (when (gtk-combo-box-get-active-iter combo-box i) 10 | i))) 11 | 12 | (defcfun (combo-box-active-text "gtk_combo_box_get_active_text") (:string :free-from-foreign t) 13 | (combo-box g-object)) 14 | 15 | (export 'combo-box-active-text) 16 | 17 | (defcfun (combo-box-popup "gtk_combo_box_popup") :void 18 | (combo-box g-object)) 19 | 20 | (export 'combo-box-popup) 21 | 22 | (defcfun (combo-box-popdown "gtk_combo_box_popdown") :void 23 | (combo-box g-object)) 24 | 25 | (export 'combo-box-popdown) 26 | 27 | (defcfun (combo-box-get-popup-accessible "gtk_combo_box_get_popup_accessible") g-object 28 | (combo-box g-object)) 29 | 30 | (export 'combo-box-get-popup-accessible) 31 | 32 | (defcfun gtk-combo-box-set-row-separator-func :void 33 | (combo-box g-object) 34 | (func :pointer) 35 | (data :pointer) 36 | (destroy-notify :pointer)) 37 | 38 | (defun combo-box-set-row-separator-func (combo-box func) 39 | (gtk-combo-box-set-row-separator-func combo-box 40 | (callback gtk-tree-view-row-separator-func-callback) 41 | (allocate-stable-pointer func) 42 | (callback stable-pointer-free-destroy-notify-callback))) 43 | 44 | 45 | -------------------------------------------------------------------------------- /gtk/gtk.container.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (container-add "gtk_container_add") :void 4 | (container (g-object container)) 5 | (widget (g-object widget))) 6 | 7 | (export 'container-add) 8 | 9 | (defcfun (container-remove "gtk_container_remove") :void 10 | (container (g-object container)) 11 | (widget (g-object widget))) 12 | 13 | (export 'container-remove) 14 | 15 | (defcfun (container-check-resize "gtk_container_check_resize") :void 16 | (container g-object)) 17 | 18 | (export 'container-check-resize) 19 | 20 | (defcallback gtk-container-foreach-callback :void 21 | ((widget g-object) (data :pointer)) 22 | (restart-case 23 | (funcall (get-stable-pointer-value data) 24 | widget) 25 | (return () nil))) 26 | 27 | (defcfun gtk-container-foreach :void 28 | (container g-object) 29 | (callback :pointer) 30 | (data :pointer)) 31 | 32 | (defun map-container-children (container function) 33 | (with-stable-pointer (ptr function) 34 | (gtk-container-foreach container (callback gtk-container-foreach-callback) ptr))) 35 | 36 | (export 'map-container-children) 37 | 38 | (defcfun gtk-container-forall :void 39 | (container g-object) 40 | (callback :pointer) 41 | (data :pointer)) 42 | 43 | (defun map-container-internal-children (container function) 44 | (with-stable-pointer (ptr function) 45 | (gtk-container-forall container (callback gtk-container-foreach-callback) ptr))) 46 | 47 | (export 'map-container-internal-children) 48 | 49 | (defcfun (container-children "gtk_container_get_children") (glist g-object :free-from-foreign t) 50 | (container g-object)) 51 | 52 | (export 'container-children) 53 | 54 | (defcfun (container-resize-children "gtk_container_resize_children") :void 55 | (container g-object)) 56 | 57 | (export 'container-resize-children) 58 | 59 | (defcfun (container-child-type "gtk_container_child_type") g-type-designator 60 | (container g-object)) 61 | 62 | (export 'container-child-type) 63 | 64 | (defcfun (container-propagate-expose "gtk_container_propagate_expose") :void 65 | (container (g-object container)) 66 | (child (g-object widget)) 67 | (event (g-boxed-foreign event))) 68 | 69 | (export 'container-propagate-expose) 70 | -------------------------------------------------------------------------------- /gtk/gtk.dialog.example.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk-examples) 2 | 3 | (defun test-dialog () 4 | (let ((window (make-instance 'gtk-window :type :toplevel :title "Testing dialogs")) 5 | (v-box (make-instance 'v-box))) 6 | (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (leave-gtk-main))) 7 | (container-add window v-box) 8 | (let ((button (make-instance 'button :label "Dialog 1"))) 9 | (box-pack-start v-box button) 10 | (g-signal-connect button "clicked" (lambda (b) (declare (ignore b)) 11 | (let ((dialog (make-instance 'dialog))) 12 | (dialog-add-button dialog "OK" :ok) 13 | (dialog-add-button dialog "Yes" :yes) 14 | (dialog-add-button dialog "Cancel" :cancel) 15 | (setf (dialog-default-response dialog) :cancel) 16 | (set-dialog-alternative-button-order dialog (list :yes :cancel :ok)) 17 | (format t "Response was: ~S~%" (dialog-run dialog)) 18 | (object-destroy dialog))))) 19 | (let ((button (make-instance 'button :label "About"))) 20 | (box-pack-start v-box button) 21 | (g-signal-connect button "clicked" (lambda (b) (declare (ignore b)) 22 | (let ((dialog (make-instance 'about-dialog :program-name "Dialogs examples" :version "0.01" :copyright "(c) Kalyanov Dmitry" 23 | :website "http://common-lisp.net/project/cl-gtk+" :website-label "Project web site" 24 | :license "LLGPL" :authors '("Kalyanov Dmitry") :documenters '("Kalyanov Dmitry") 25 | :artists '("None") 26 | :logo-icon-name "applications-development" :wrap-license t))) 27 | (format t "Response was: ~S~%" (dialog-run dialog)) 28 | (object-destroy dialog))))) 29 | 30 | (widget-show window) 31 | (ensure-gtk-main))) -------------------------------------------------------------------------------- /gtk/gtk.dialog.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (dialog-run "gtk_dialog_run") response-type 4 | (dialog (g-object dialog))) 5 | 6 | (export 'dialog-run) 7 | 8 | (defcfun (dialog-response "gtk_dialog_response") :void 9 | (dialog (g-object dialog)) 10 | (response response-type)) 11 | 12 | (export 'dialog-response) 13 | 14 | (defcfun (dialog-add-button "gtk_dialog_add_button") (g-object widget) 15 | (dialog (g-object dialog)) 16 | (button-text :string) 17 | (response response-type)) 18 | 19 | (export 'dialog-add-button) 20 | 21 | (defcfun (dialog-add-action-widget "gtk_dialog_add_action_widget") :void 22 | (dialog (g-object dialog)) 23 | (child (g-object widget)) 24 | (response response-type)) 25 | 26 | (export 'dialog-add-action-widget) 27 | 28 | (defcfun (dialog-set-response-sensitive "gtk_dialog_set_response_sensitive") :void 29 | (dialog (g-object dialog)) 30 | (response response-type) 31 | (setting :boolean)) 32 | 33 | (export 'dialog-set-response-sensitive) 34 | 35 | (defcfun (dialog-response-for-widget "gtk_dialog_get_response_for_widget") :int 36 | (dialog (g-object dialog)) 37 | (widget (g-object widget))) 38 | 39 | (export 'dialog-response-for-widget) 40 | 41 | (defcfun (dialog-alternative-button-order-on-screen "gtk_alternative_dialog_button_order") :boolean 42 | (screen (g-object screen))) 43 | 44 | (export 'dialog-alternative-button-order-on-screen) 45 | 46 | (defcfun (dialog-set-alternative-button-order-from-array "gtk_dialog_set_alternative_button_order_from_array") :void 47 | (dialog (g-object dialog)) 48 | (n-params :int) 49 | (new-order (:pointer response-type))) 50 | 51 | (defun set-dialog-alternative-button-order (dialog response-list) 52 | (with-foreign-object (new-order 'response-type (length response-list)) 53 | (loop 54 | for i from 0 55 | for response in response-list 56 | do (setf (mem-aref new-order 'response-type i) response)) 57 | (dialog-set-alternative-button-order-from-array dialog (length response-list) new-order)) 58 | response-list) 59 | 60 | (export 'set-dialog-alternative-button-order) 61 | 62 | (defmacro with-gtk-message-error-handler (&body body) 63 | (let ((dialog (gensym)) 64 | (e (gensym))) 65 | `(handler-case 66 | (progn ,@body) 67 | (error (,e) (using* ((,dialog (make-instance 'message-dialog 68 | :message-type :error :buttons :ok 69 | :text (format nil "Error~%~A~%during execution of~%~A" ,e '(progn ,@body))))) 70 | (dialog-run ,dialog) 71 | (object-destroy ,dialog) 72 | nil))))) 73 | 74 | (export 'with-gtk-message-error-handler) 75 | -------------------------------------------------------------------------------- /gtk/gtk.dnd.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (drag-finish "gtk_drag_finish") :void 4 | (context (g-object drag-context)) 5 | (success :boolean) 6 | (del :boolean) 7 | (time :uint32)) 8 | 9 | (export 'drag-finish) 10 | 11 | -------------------------------------------------------------------------------- /gtk/gtk.finalize-classes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defun finalize-subclasses (class) 4 | ;(format t "Finalizing ~A~%" class) 5 | (c2mop:ensure-finalized class) 6 | (iter (for subclass in (c2mop:class-direct-subclasses class)) 7 | (finalize-subclasses subclass))) 8 | 9 | (defun finalize-gtk-classes () 10 | (finalize-subclasses (find-class 'gobject:g-object))) 11 | 12 | (finalize-gtk-classes) 13 | -------------------------------------------------------------------------------- /gtk/gtk.functions.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (object-destroy "gtk_object_destroy") :void 4 | (object (g-object gtk-object))) 5 | -------------------------------------------------------------------------------- /gtk/gtk.image.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-image-get-animation (g-object pixbuf-animation) 4 | (image (g-object image))) 5 | 6 | (defcfun gtk-image-set-from-animation :void 7 | (image (g-object image)) 8 | (animation (g-object pixbuf-animation))) 9 | 10 | (defun image-animation (image) 11 | (gtk-image-get-animation image)) 12 | 13 | (defun (setf image-animation) (animation image) 14 | (gtk-image-set-from-animation image animation)) 15 | 16 | (export 'image-animation) -------------------------------------------------------------------------------- /gtk/gtk.label.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (%gtk-label-get-layout-offsets "gtk_label_get_layout_offsets") :void 4 | (label (g-object label)) 5 | (x (:pointer :int)) 6 | (y (:pointer :int))) 7 | 8 | (defun gtk-label-get-layout-offsets (label) 9 | (with-foreign-objects ((x :int) (y :int)) 10 | (%gtk-label-get-layout-offsets label x y) 11 | (list (mem-ref x :int) (mem-ref y :int)))) 12 | 13 | (defcfun (label-select-region "gtk_label_select_region") :void 14 | (label (g-object label)) 15 | (start-offset :int) 16 | (end-offset :int)) 17 | 18 | (export 'label-select-region) 19 | 20 | (defcfun (%gtk-label-get-selection-bounds "gtk_label_get_selection_bounds") :boolean 21 | (label (g-object label)) 22 | (start (:pointer :int)) 23 | (end (:pointer :int))) 24 | 25 | (defun gtk-label-get-selection-bounds (label) 26 | (with-foreign-objects ((start :int) (end :int)) 27 | (when (%gtk-label-get-selection-bounds label start end) 28 | (list (mem-ref start :int) (mem-ref end :int))))) 29 | -------------------------------------------------------------------------------- /gtk/gtk.link-button.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defvar *link-button-uri-func* nil) 4 | 5 | (defcallback link-button-uri-func-cb :void 6 | ((button (g-object link-button)) (link (:string :free-from-foreign nil)) (user-data :pointer)) 7 | (declare (ignore user-data)) 8 | (funcall *link-button-uri-func* button link)) 9 | 10 | (defcallback link-button-uri-func-destroy-cb :void 11 | ((data :pointer)) 12 | (declare (ignore data)) 13 | (setf *link-button-uri-func* nil)) 14 | 15 | (defcfun gtk-link-button-set-uri-hook :void 16 | (func :pointer) 17 | (data :pointer) 18 | (destroy-notify :pointer)) 19 | 20 | (defun (setf link-button-global-uri-hook) (new-value) 21 | (if new-value 22 | (gtk-link-button-set-uri-hook (callback link-button-uri-func-cb) 23 | (null-pointer) 24 | (callback link-button-uri-func-destroy-cb)) 25 | (gtk-link-button-set-uri-hook (null-pointer) 26 | (null-pointer) 27 | (null-pointer))) 28 | (setf *link-button-uri-func* new-value)) 29 | 30 | (export 'link-button-global-uri-hook) 31 | -------------------------------------------------------------------------------- /gtk/gtk.main-loop-events.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | ; TODO: gtk_get_default_language 4 | 5 | (defcfun gtk-events-pending :boolean) 6 | 7 | (export 'gtk-events-pending) 8 | 9 | (defcfun gtk-main-iteration :boolean) 10 | 11 | (export 'gtk-main-iteration) 12 | 13 | (defcfun gtk-main-iteration-do :boolean 14 | (blocking :boolean)) 15 | 16 | (export 'gtk-main-iteration-do) 17 | 18 | ; TODO: gtk_main_do_event 19 | 20 | (defcfun (grab-add "gtk_grab_add") :void 21 | (widget g-object)) 22 | 23 | (export 'grab-add) 24 | 25 | (defcfun (grab-current "gtk_grab_get_current") g-object) 26 | 27 | (export 'grab-current) 28 | 29 | (defcfun (grab-remove "gtk_grab_remove") :void 30 | (widget g-object)) 31 | 32 | (export 'grab-remove) 33 | 34 | ; TODO: gtk_quit_add_destroy 35 | 36 | ; TODO: gtk_quit_add 37 | 38 | ; TODO: gtk_quit_add_full 39 | 40 | ; TODO: gtk_quit_remove 41 | 42 | ; TODO: gtk_quit_remove_by_data 43 | 44 | ; TODO: gtk_key_snooper_install 45 | 46 | ; TODO: gtk_key_snooper_remove 47 | 48 | (defcfun (current-event "gtk_get_current_event") (g-boxed-foreign event :return)) 49 | 50 | (export 'current-event) 51 | 52 | (defcfun (current-event-time "gtk_get_current_event_time") :uint32) 53 | 54 | (export 'current-event-time) 55 | 56 | (defcfun (event-widget "gtk_get_event_widget") g-object 57 | (event (g-boxed-foreign event))) 58 | 59 | (export 'event-widget) 60 | 61 | (defcfun (propagate-event "gtk_propagate_event") :void 62 | (widget g-object) 63 | (event (g-boxed-foreign event))) 64 | 65 | (export 'propagate-event) 66 | 67 | -------------------------------------------------------------------------------- /gtk/gtk.main_loop_events.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-init-check :boolean 4 | (argc (:pointer :int)) 5 | (argv (:pointer (:pointer :string)))) 6 | 7 | (defun gtk-init () 8 | (gtk-init-check (foreign-alloc :int :initial-element 0) 9 | (foreign-alloc :string :initial-contents '("/usr/bin/sbcl"))) 10 | #+ (and sbcl (not win32)) 11 | (sb-unix::enable-interrupt sb-unix:sigpipe #'sb-unix::sigpipe-handler) 12 | #+nil(with-foreign-objects ((argc :int) 13 | (argv '(:pointer :string) 1)) 14 | (setf (mem-ref argc :int) 0 15 | (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1 16 | :initial-element "/usr/bin/sbcl")) 17 | (unwind-protect 18 | (unless (gtk-init-check argc argv) 19 | (error "Cannot initialize Gtk+")) 20 | (foreign-free (mem-ref argv '(:pointer :string)))))) 21 | 22 | (at-init () (gtk-init)) 23 | 24 | (defcfun (%gtk-main "gtk_main") :void) 25 | 26 | (defun gtk-main () 27 | (with-gdk-threads-lock (%gtk-main))) 28 | 29 | #+thread-support 30 | (progn 31 | (defvar *main-thread* nil) 32 | (defvar *main-thread-level* nil) 33 | (defvar *main-thread-lock* (bt:make-lock "*main-thread* lock")) 34 | 35 | (at-finalize () 36 | (when (and *main-thread* (bt:thread-alive-p *main-thread*)) 37 | (bt:destroy-thread *main-thread*) 38 | (setf *main-thread* nil))) 39 | 40 | (defun ensure-gtk-main () 41 | (bt:with-lock-held (*main-thread-lock*) 42 | (when (and *main-thread* (not (bt:thread-alive-p *main-thread*))) 43 | (setf *main-thread* nil)) 44 | (unless *main-thread* 45 | (setf *main-thread* (bt:make-thread (lambda () (gtk-main)) :name "cl-gtk2 main thread") 46 | *main-thread-level* 0)) 47 | (incf *main-thread-level*)) 48 | (values)) 49 | 50 | (defun join-gtk-main () 51 | (when *main-thread* 52 | (bt:join-thread *main-thread*))) 53 | 54 | (defun leave-gtk-main () 55 | (bt:with-lock-held (*main-thread-lock*) 56 | (decf *main-thread-level*) 57 | (when (zerop *main-thread-level*) 58 | (gtk-main-quit))))) 59 | 60 | #-thread-support 61 | (progn 62 | (defun ensure-gtk-main () 63 | (gtk-main) 64 | (values)) 65 | 66 | (defun leave-gtk-main () 67 | (gtk-main-quit)) 68 | 69 | (defun join-gtk-main ())) 70 | 71 | (export 'ensure-gtk-main) 72 | 73 | (export 'leave-gtk-main) 74 | 75 | (export 'join-gtk-main) 76 | 77 | (defcfun gtk-main-level :uint) 78 | 79 | (defcfun gtk-main-quit :void) 80 | 81 | (defcfun gtk-grab-add :void 82 | (widget g-object)) 83 | 84 | (defcfun gtk-grab-get-current g-object) 85 | 86 | (defcfun gtk-grab-remove :void 87 | (widget g-object)) -------------------------------------------------------------------------------- /gtk/gtk.misc.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcallback stable-pointer-free-destroy-notify-callback :void ((data :pointer)) 4 | (free-stable-pointer data)) 5 | 6 | (defcfun (get-clipboard "gtk_clipboard_get") g-object 7 | (selection gdk-atom-as-string)) 8 | 9 | (export 'get-clipboard) 10 | 11 | (defcallback call-from-main-loop-callback :boolean 12 | ((data :pointer)) 13 | (restart-case 14 | (progn (funcall (get-stable-pointer-value data)) 15 | nil) 16 | (return-from-callback () nil))) 17 | 18 | (defun call-from-gtk-main-loop (function &key (priority +g-priority-default-idle+)) 19 | (g-idle-add-full priority 20 | (callback call-from-main-loop-callback) 21 | (allocate-stable-pointer function) 22 | (callback stable-pointer-free-destroy-notify-callback)) 23 | (ensure-gtk-main)) 24 | 25 | (export 'call-from-gtk-main-loop) 26 | 27 | (defcallback call-timeout-from-main-loop-callback :boolean 28 | ((data :pointer)) 29 | (restart-case 30 | (progn (funcall (get-stable-pointer-value data))) 31 | (return-from-callback () nil))) 32 | 33 | (defun gtk-main-add-timeout (milliseconds function &key (priority +g-priority-default+)) 34 | (g-timeout-add-full priority milliseconds 35 | (callback call-timeout-from-main-loop-callback) 36 | (allocate-stable-pointer function) 37 | (callback stable-pointer-free-destroy-notify-callback))) 38 | 39 | (export 'gtk-main-add-timeout) 40 | 41 | (defmacro within-main-loop (&body body) 42 | `(call-from-gtk-main-loop (lambda () ,@body))) 43 | 44 | (export 'within-main-loop) 45 | 46 | #+thread-support 47 | (defmacro with-main-loop (&body body) 48 | `(progn 49 | (ensure-gtk-main) 50 | (within-main-loop ,@body))) 51 | 52 | #-thread-support 53 | (defmacro with-main-loop (&body body) 54 | `(progn 55 | ,@body 56 | (ensure-gtk-main))) 57 | 58 | (export 'with-main-loop) -------------------------------------------------------------------------------- /gtk/gtk.object.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcstruct %gtk-object 4 | (parent-instance gobject::%g-initially-unowned) 5 | (flags :uint32)) 6 | 7 | (defun gtk-object-flags-as-integer (object) 8 | (foreign-slot-value (pointer object) '%gtk-object 'flags)) 9 | 10 | (defun (setf gtk-object-flags-as-integer) (new-value object) 11 | (setf (foreign-slot-value (pointer object) '%gtk-object 'flags) new-value)) -------------------------------------------------------------------------------- /gtk/gtk.package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :gtk 2 | (:use :cl :cffi :gobject :gdk :glib :iter :pango) 3 | (:export #:gtk-main 4 | #:gtk-main-quit 5 | #:dialog-run 6 | #:object-destroy 7 | #:text-buffer-insert 8 | #:define-child-property 9 | #:container-class-child-properties 10 | #:generate-child-properties 11 | #:tree-lisp-store 12 | #:tree-lisp-store-root 13 | #:tree-node 14 | #:make-tree-node 15 | #:tree-node-tree 16 | #:tree-node-parent 17 | #:tree-node-id 18 | #:tree-node-item 19 | #:tree-node-children 20 | #:tree-node-insert-at 21 | #:tree-node-remove-at 22 | #:tree-node-child-at 23 | #:tree-lisp-store-add-column 24 | #:gtk-main-add-timeout 25 | #:gtk-call-aborted 26 | #:gtk-call-aborted-condition 27 | #:let-ui)) 28 | 29 | (defpackage :gtk-examples 30 | (:use :cl :gtk :gdk :gobject) 31 | (:export #:test-dialog)) 32 | 33 | (in-package :gtk) 34 | 35 | #+sbcl (when (and (find-package "SB-EXT") 36 | (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT"))) 37 | (funcall (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")) :traps nil)) 38 | -------------------------------------------------------------------------------- /gtk/gtk.paned.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-paned-pack1 :void 4 | (paned g-object) 5 | (child g-object) 6 | (resize :boolean) 7 | (shrink :boolean)) 8 | 9 | (defun paned-pack-1 (paned child &key (resize nil) (shrink t)) 10 | (gtk-paned-pack1 paned child resize shrink)) 11 | 12 | (export 'paned-pack-1) 13 | 14 | (defcfun gtk-paned-pack2 :void 15 | (paned g-object) 16 | (child g-object) 17 | (resize :boolean) 18 | (shrink :boolean)) 19 | 20 | (defun paned-pack-2 (paned child &key (resize t) (shrink t)) 21 | (gtk-paned-pack2 paned child resize shrink)) 22 | 23 | (export 'paned-pack-2) 24 | 25 | (defcfun (paned-child-1 "gtk_paned_get_child1") g-object 26 | (paned g-object)) 27 | 28 | (defcfun (paned-child-2 "gtk_paned_get_child2") g-object 29 | (paned g-object)) 30 | 31 | (export 'paned-child-1) 32 | 33 | (export 'paned-child-2) 34 | 35 | ; TODO: GtkScale, gtk_scale_get_layout_offsets -------------------------------------------------------------------------------- /gtk/gtk.printing.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | ; TODO: Printing -------------------------------------------------------------------------------- /gtk/gtk.progress-bar.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (progress-bar-pulse "gtk_progress_bar_pulse") :void 4 | (progress-bar (g-object progress-bar))) 5 | 6 | (export 'progress-bar-pulse) 7 | -------------------------------------------------------------------------------- /gtk/gtk.scale-button.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (scale-button-popup "gtk_scale_button_get_popup") (g-object widget) 4 | (scale-button (g-object scale-button))) 5 | 6 | (defcfun (scale-button-plus-button "gtk_scale_button_get_plus_button") (g-object widget) 7 | (scale-button (g-object scale-button))) 8 | 9 | (defcfun (scale-button-minus-button "gtk_scale_button_get_minus_button") (g-object widget) 10 | (scale-button (g-object scale-button))) 11 | 12 | (export 'scale-button-popup) 13 | (export 'scale-button-plus-button) 14 | (export 'scale-button-minus-button) -------------------------------------------------------------------------------- /gtk/gtk.scrolling.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (scrolled-window-add-with-viewport "gtk_scrolled_window_add_with_viewport") :void 4 | (scrolled-window g-object) 5 | (child g-object)) 6 | 7 | (export 'scrolled-window-add-with-viewport) -------------------------------------------------------------------------------- /gtk/gtk.selections.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (define-g-boxed-cstruct target-entry "GtkTargetEntry" 4 | (target :string :initform 0) 5 | (flags target-flags :initform 0) 6 | (info :uint :initform 0)) 7 | 8 | (export (boxed-related-symbols 'target-entry)) 9 | 10 | -------------------------------------------------------------------------------- /gtk/gtk.size-group.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (size-group-add-widget "gtk_size_group_add_widget") :void 4 | (size-group g-object) 5 | (widget g-object)) 6 | 7 | (export 'size-group-add-widget) 8 | 9 | (defcfun (size-group-remove-widget "gtk_size_group_remove_widget") :void 10 | (size-group g-object) 11 | (widget g-object)) 12 | 13 | (export 'size-group-remove-widget) 14 | 15 | (defcfun (size-group-widgets "gtk_size_group_get_widgets") (gslist g-object :free-from-foreign nil) 16 | (size-group g-object)) 17 | 18 | (export 'size-group-widgets) -------------------------------------------------------------------------------- /gtk/gtk.spin-button.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (define-g-enum "GtkSpinType" spin-type () 4 | (:step-forward 0) 5 | (:step-backward 1) (:page-forward 2) (:page-backward 3) 6 | (:home 4) (:end 5) (:user-defined 6)) 7 | 8 | (defcfun (spin-button-spin "gtk_spin_button_spin") :void 9 | (spin-button (g-object spin-button)) 10 | (direction spin-type) 11 | (increment :double)) 12 | 13 | (export 'spin-button-spin) 14 | 15 | (defcfun (spin-button-update "gtk_spin_button_update") :void 16 | (spin-button (g-object spin-button))) 17 | 18 | (export 'spin-button-update) 19 | -------------------------------------------------------------------------------- /gtk/gtk.status-bar.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (statusbar-get-context-id "gtk_statusbar_get_context_id") :uint 4 | (statusbar (g-object statusbar)) 5 | (context-description :string)) 6 | 7 | (defcfun gtk-statusbar-push :uint 8 | (statusbar (g-object statusbar)) 9 | (context-id :uint) 10 | (text :string)) 11 | 12 | (defcfun gtk-statusbar-pop :void 13 | (statusbar (g-object statusbar)) 14 | (context-id :uint)) 15 | 16 | (defcfun gtk-statusbar-remove :void 17 | (statusbar (g-object statusbar)) 18 | (context-id :uint) 19 | (message-id :uint)) 20 | 21 | (defun statusbar-context-id (statusbar context) 22 | (etypecase context 23 | (integer context) 24 | (string (statusbar-get-context-id statusbar context)))) 25 | 26 | (defun statusbar-push (statusbar context text) 27 | (gtk-statusbar-push statusbar (statusbar-context-id statusbar context) text)) 28 | 29 | (defun statusbar-pop (statusbar context) 30 | (gtk-statusbar-pop statusbar (statusbar-context-id statusbar context))) 31 | 32 | (defun statusbar-remove (statusbar context message-id) 33 | (gtk-statusbar-remove statusbar (statusbar-context-id statusbar context) message-id)) 34 | 35 | (export 'statusbar-push) 36 | (export 'statusbar-pop) 37 | (export 'statusbar-remove) 38 | (export 'statusbar-context-id) -------------------------------------------------------------------------------- /gtk/gtk.status-icon.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (set-status-icon-tooltip "gtk_status_icon_set_tooltip") :void 4 | (status-icon (g-object status-icon)) 5 | (tooltip-text :string)) 6 | 7 | (export 'set-status-icon-tooltip) -------------------------------------------------------------------------------- /gtk/gtk.text-entry.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | void gtk_entry_append_text (GtkEntry *entry, 4 | const gchar *text); 5 | void gtk_entry_prepend_text (GtkEntry *entry, 6 | const gchar *text); 7 | void gtk_entry_set_position (GtkEntry *entry, 8 | gint position); 9 | void gtk_entry_select_region (GtkEntry *entry, 10 | gint start, 11 | gint end); 12 | gint gtk_entry_layout_index_to_text_index 13 | (GtkEntry *entry, 14 | gint layout_index); 15 | gint gtk_entry_text_index_to_layout_index 16 | (GtkEntry *entry, 17 | gint text_index); 18 | void gtk_entry_set_completion (GtkEntry *entry, 19 | GtkEntryCompletion *completion); 20 | GtkEntryCompletion* gtk_entry_get_completion (GtkEntry *entry); 21 | void gtk_entry_set_cursor_hadjustment (GtkEntry *entry, 22 | GtkAdjustment *adjustment); 23 | GtkAdjustment* gtk_entry_get_cursor_hadjustment (GtkEntry *entry); 24 | -------------------------------------------------------------------------------- /gtk/gtk.timer.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defclass timer () 4 | ((fn :initform nil :initarg :fn :accessor timer-fn) 5 | (interval-msec :initform 100 :initarg :interval-msec :accessor timer-interval-msec) 6 | (source-id :initform nil))) 7 | 8 | (defun timer-enabled-p (timer) 9 | (not (null (slot-value timer 'source-id)))) 10 | 11 | (defun (setf timer-enabled-p) (new-value timer) 12 | (unless (eq new-value (timer-enabled-p timer)) 13 | (if new-value 14 | (start-timer timer) 15 | (stop-timer timer)))) 16 | 17 | (defmethod (setf timer-interval-msec) :after (new-value (timer timer)) 18 | (when (timer-enabled-p timer) 19 | (stop-timer timer) 20 | (start-timer timer))) 21 | 22 | (defun start-timer (timer) 23 | (unless (slot-value timer 'source-id) 24 | (setf (slot-value timer 'source-id) 25 | (gtk-main-add-timeout (timer-interval-msec timer) (lambda () (funcall (timer-fn timer)) t))))) 26 | 27 | (defun stop-timer (timer) 28 | (when (slot-value timer 'source-id) 29 | (glib:g-source-remove (slot-value timer 'source-id)) 30 | (setf (slot-value timer 'source-id) nil))) 31 | 32 | (export '(timer timer-fn timer-interval-msec timer-enabled-p timer-interval-msec start-timer stop-timer)) 33 | -------------------------------------------------------------------------------- /gtk/gtk.tooltip.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-tooltip-set-markup :void 4 | (tooltip g-object) 5 | (markup :string)) 6 | 7 | (defun (setf tooltip-markup) (new-value tooltip) 8 | (gtk-tooltip-set-markup tooltip new-value)) 9 | 10 | (export 'tooltip-markup) 11 | 12 | (defcfun gtk-tooltip-set-text :void 13 | (tooltip g-object) 14 | (text :string)) 15 | 16 | (defun (setf tooltip-text) (new-value tooltip) 17 | (gtk-tooltip-set-text tooltip new-value)) 18 | 19 | (export 'tooltip-text) 20 | 21 | (defcfun gtk-tooltip-set-icon :void 22 | (tooltip g-object) 23 | (pixbuf g-object)) 24 | 25 | (defun (setf tooltip-icon) (new-value tooltip) 26 | (gtk-tooltip-set-icon tooltip new-value)) 27 | 28 | (export 'tooltip-icon) 29 | 30 | (defcfun (tooltip-set-icon-from-stock "gtk_tooltip_set_icon_from_stock") :void 31 | (tooltip g-object) 32 | (stock-id :string) 33 | (icon-size icon-size)) 34 | 35 | (export 'tooltip-set-icon-from-stock) 36 | 37 | (defcfun (tooltip-set-icon-from-icon-name "gtk_tooltip_set_icon_from_icon_name") :void 38 | (tooltip g-object) 39 | (icon-name :string) 40 | (icon-size icon-size)) 41 | 42 | (export 'tooltip-set-icon-from-icon-name) 43 | 44 | (defcfun (tooltip-set-custom "gtk_tooltip_set_custom") :void 45 | (tooltip g-object) 46 | (custom-widget g-object)) 47 | 48 | (export 'tooltip-set-custom) 49 | 50 | (defcfun (tooltip-trigger-tooltip-query "gtk_tooltip_trigger_tooltip_query") :void 51 | (display g-object)) 52 | 53 | (export 'tooltip-trigger-tooltip-query) 54 | 55 | (defcfun (tooltip-set-tip-area "gtk_tooltip_set_tip_area") :void 56 | (tooltip g-object) 57 | (rectangle (g-boxed-foreign rectangle))) 58 | 59 | (export 'tooltip-set-tip-area) -------------------------------------------------------------------------------- /gtk/gtk.tree-model-filter.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcallback gtk-tree-model-filter-visible-func-callback :boolean 4 | ((tree-model g-object) (iter (g-boxed-foreign tree-iter)) (data :pointer)) 5 | (let ((fn (get-stable-pointer-value data))) 6 | (restart-case 7 | (funcall fn tree-model iter) 8 | (return-true () t) 9 | (return-false () nil)))) 10 | 11 | (defcfun gtk-tree-model-filter-set-visible-func :void 12 | (filter (g-object tree-model-filter)) 13 | (func :pointer) 14 | (data :pointer) 15 | (destroy-notify :pointer)) 16 | 17 | (defun tree-model-filter-set-visible-function (tree-model-filter function) 18 | (gtk-tree-model-filter-set-visible-func 19 | tree-model-filter 20 | (callback gtk-tree-model-filter-visible-func-callback) 21 | (allocate-stable-pointer function) 22 | (callback stable-pointer-free-destroy-notify-callback))) 23 | 24 | (export 'tree-model-filter-set-visible-function) 25 | 26 | #| 27 | 28 | typedef void (* GtkTreeModelFilterModifyFunc) (GtkTreeModel *model, 29 | GtkTreeIter *iter, 30 | GValue *value, 31 | gint column, 32 | gpointer data); 33 | 34 | void gtk_tree_model_filter_set_modify_func (GtkTreeModelFilter *filter, 35 | gint n_columns, 36 | GType *types, 37 | GtkTreeModelFilterModifyFunc func, 38 | gpointer data, 39 | GDestroyNotify destroy); 40 | |# 41 | 42 | (defcfun (tree-model-filter-set-visible-column "gtk_tree_model_filter_set_visible_column") :void 43 | (filter (g-object tree-model-filter)) 44 | (column :int)) 45 | 46 | (export 'tree-model-filter-set-visible-column) 47 | 48 | ;; conversion 49 | 50 | (defcfun gtk-tree-model-filter-convert-child-iter-to-iter :boolean 51 | (filter (g-object tree-model-filter)) 52 | (filter-iter (g-boxed-foreign tree-iter)) 53 | (child-iter (g-boxed-foreign tree-iter))) 54 | 55 | (defun tree-model-filter-convert-child-iter-to-iter (filter iter) 56 | (let ((filter-iter (make-instance 'tree-iter))) 57 | (when (gtk-tree-model-filter-convert-child-iter-to-iter filter filter-iter iter) 58 | filter-iter))) 59 | 60 | (export 'tree-model-filter-convert-child-iter-to-iter) 61 | 62 | (defcfun gtk-tree-model-filter-convert-iter-to-child-iter :void 63 | (filter (g-object tree-model-filter)) 64 | (child-iter (g-boxed-foreign tree-iter)) 65 | (filter-iter (g-boxed-foreign tree-iter))) 66 | 67 | (defun tree-model-filter-convert-iter-to-child-iter (filter iter) 68 | (let ((child-iter (make-instance 'tree-iter))) 69 | (gtk-tree-model-filter-convert-iter-to-child-iter filter child-iter iter) 70 | child-iter)) 71 | 72 | (export 'tree-model-filter-convert-iter-to-child-iter) 73 | 74 | (defcfun (tree-model-filter-convert-child-path-to-path "gtk_tree_model_filter_convert_child_path_to_path") (g-boxed-foreign tree-path :return) 75 | (filter (g-object tree-model-sort)) 76 | (child-path (g-boxed-foreign tree-path))) 77 | 78 | (export 'tree-model-filter-convert-child-path-to-path) 79 | 80 | (defcfun (tree-model-filter-convert-path-to-child-path "gtk_tree_model_filter_convert_path_to_child_path") (g-boxed-foreign tree-path :return) 81 | (filter (g-object tree-model-sort)) 82 | (filter-path (g-boxed-foreign tree-path))) 83 | 84 | (export 'tree-model-filter-convert-path-to-child-path) 85 | 86 | ;; extras 87 | 88 | (defcfun (tree-model-filter-refilter "gtk_tree_model_filter_refilter") :void 89 | (filter (g-object tree-model-filter))) 90 | 91 | (export 'tree-model-filter-refilter) 92 | 93 | (defcfun (tree-model-filter-clear-cache "gtk_tree_model_filter_clear_cache") :void 94 | (filter (g-object tree-model-filter))) 95 | 96 | (export 'tree-model-filter-clear-cache) 97 | -------------------------------------------------------------------------------- /gtk/gtk.tree-selection.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-tree-selection-set-select-function :void 4 | (selection g-object) 5 | (select-function :pointer) 6 | (data :pointer) 7 | (destroy-notify :pointer)) 8 | 9 | (defcallback gtk-tree-selection-select-function-callback :boolean 10 | ((selection g-object) (model g-object) (path (g-boxed-foreign tree-path)) (path-currently-selected :boolean) (data :pointer)) 11 | (let ((fn (get-stable-pointer-value data))) 12 | (restart-case 13 | (funcall fn selection model path path-currently-selected) 14 | (return-true () t) 15 | (return-false () nil)))) 16 | 17 | (defun tree-selection-set-select-function (tree-selection fn) 18 | (gtk-tree-selection-set-select-function tree-selection 19 | (callback gtk-tree-selection-select-function-callback) 20 | (allocate-stable-pointer fn) 21 | (callback stable-pointer-free-destroy-notify-callback))) 22 | 23 | (defcfun gtk-tree-selection-get-user-data :pointer (tree-selection g-object)) 24 | 25 | (defun tree-selection-get-select-function (tree-selection) 26 | (let ((ptr (gtk-tree-selection-get-user-data tree-selection))) 27 | (unless (null-pointer-p ptr) 28 | (get-stable-pointer-value ptr)))) 29 | 30 | (defcfun gtk-tree-selection-get-selected :boolean 31 | (selection g-object) 32 | (model :pointer) 33 | (iter (g-boxed-foreign tree-iter))) 34 | 35 | (defun tree-selection-selected (tree-selection) 36 | (let ((iter (make-instance 'tree-iter))) 37 | (when (gtk-tree-selection-get-selected tree-selection (null-pointer) iter) 38 | iter))) 39 | 40 | (export 'tree-selection-selected) 41 | 42 | (defcfun gtk-tree-selection-selected-foreach :void 43 | (selection g-object) 44 | (func :pointer) 45 | (data :pointer)) 46 | 47 | (defcallback gtk-tree-selection-foreach-callback :void 48 | ((model g-object) (path (g-boxed-foreign tree-path)) (iter (g-boxed-foreign tree-iter)) (data :pointer)) 49 | (let ((fn (get-stable-pointer-value data))) 50 | (funcall fn model path iter))) 51 | 52 | (defun map-tree-selection-rows (tree-selection fn) 53 | (with-stable-pointer (ptr fn) 54 | (gtk-tree-selection-selected-foreach tree-selection (callback gtk-tree-selection-foreach-callback) ptr))) 55 | 56 | (export 'map-tree-selection-rows) 57 | 58 | (defcfun gtk-tree-selection-get-selected-rows (glist (g-boxed-foreign tree-path) :free-from-foreign t) 59 | (selection g-object) 60 | (model :pointer)) 61 | 62 | (defun tree-selection-selected-rows (tree-selection) 63 | (gtk-tree-selection-get-selected-rows tree-selection (null-pointer))) 64 | 65 | (export 'tree-selection-selected-rows) 66 | 67 | (defcfun (tree-selection-count-selected-rows "gtk_tree_selection_count_selected_rows") :int 68 | (selection g-object)) 69 | 70 | (export 'tree-selection-count-selected-rows) 71 | 72 | (defcfun (tree-selection-select-path "gtk_tree_selection_select_path") :void 73 | (selection g-object) 74 | (path (g-boxed-foreign tree-path))) 75 | 76 | (export 'tree-selection-select-path) 77 | 78 | (defcfun (tree-selection-unselect-path "gtk_tree_selection_unselect_path") :void 79 | (selection g-object) 80 | (path (g-boxed-foreign tree-path))) 81 | 82 | (export 'tree-selection-unselect-path) 83 | 84 | (defcfun (tree-selection-path-selected-p "gtk_tree_selection_path_is_selected") :boolean 85 | (selection g-object) 86 | (path (g-boxed-foreign tree-path))) 87 | 88 | (export 'tree-selection-path-selected-p) 89 | 90 | (defcfun (tree-selection-select-iter "gtk_tree_selection_select_iter") :void 91 | (selection g-object) 92 | (iter (g-boxed-foreign tree-iter))) 93 | 94 | (export 'tree-selection-select-iter) 95 | 96 | (defcfun (tree-selection-unselect-iter "gtk_tree_selection_unselect_iter") :void 97 | (selection g-object) 98 | (iter (g-boxed-foreign tree-iter))) 99 | 100 | (export 'tree-selection-unselect-iter) 101 | 102 | (defcfun (tree-selection-iter-selected-p "gtk_tree_selection_iter_is_selected") :boolean 103 | (selection g-object) 104 | (iter (g-boxed-foreign tree-iter))) 105 | 106 | (export 'tree-selection-iter-selected-p) 107 | 108 | (defcfun (tree-selection-select-all "gtk_tree_selection_select_all") :void 109 | (selection g-object)) 110 | 111 | (export 'tree-selection-select-all) 112 | 113 | (defcfun (tree-selection-unselect-all "gtk_tree_selection_unselect_all") :void 114 | (selection g-object)) 115 | 116 | (export 'tree-selection-unselect-all) 117 | 118 | (defcfun (tree-selection-select-range "gtk_tree_selection_select_range") :void 119 | (selection g-object) 120 | (start-path (g-boxed-foreign tree-path)) 121 | (end-path (g-boxed-foreign tree-path))) 122 | 123 | (export 'tree-selection-select-range) 124 | 125 | (defcfun (tree-selection-unselect-range "gtk_tree_selection_unselect_range") :void 126 | (selection g-object) 127 | (start-path (g-boxed-foreign tree-path)) 128 | (end-path (g-boxed-foreign tree-path))) 129 | 130 | (export 'tree-selection-unselect-range) -------------------------------------------------------------------------------- /gtk/gtk.tree-view-column.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun gtk-tree-view-column-pack-start :void 4 | (tree-column (g-object tree-view-column)) 5 | (cell (g-object cell-renderer)) 6 | (expand :boolean)) 7 | 8 | (defun tree-view-column-pack-start (tree-column cell &key (expand t)) 9 | (gtk-tree-view-column-pack-start tree-column cell expand)) 10 | 11 | (export 'tree-view-column-pack-start) 12 | 13 | (defcfun gtk-tree-view-column-pack-end :void 14 | (tree-column (g-object tree-view-column)) 15 | (cell (g-object cell-renderer)) 16 | (expand :boolean)) 17 | 18 | (defun tree-view-column-pack-end (tree-column cell &key (expand t)) 19 | (gtk-tree-view-column-pack-end tree-column cell expand)) 20 | 21 | (export 'tree-view-column-pack-end) 22 | 23 | (defcfun (tree-view-column-clear "gtk_tree_view_column_clear") :void 24 | (tree-column (g-object tree-view-column))) 25 | 26 | (export 'tree-view-column-clear) 27 | 28 | (defcfun (tree-view-column-add-attribute "gtk_tree_view_column_add_attribute") :void 29 | (tree-column (g-object tree-view-column)) 30 | (cell-renderer (g-object cell-renderer)) 31 | (attribute :string) 32 | (column :int)) 33 | 34 | (export 'tree-view-column-add-attribute) 35 | 36 | (defcallback gtk-tree-cell-data-func-cb :void 37 | ((tree-column (g-object tree-column)) 38 | (cell (g-object cell-renderer)) 39 | (tree-model (g-object tree-model)) 40 | (iter (g-boxed-foreign tree-iter)) 41 | (data :pointer)) 42 | (let ((fn (get-stable-pointer-value data))) 43 | (restart-case 44 | (funcall fn tree-column cell tree-model iter) 45 | (return-from-tree-cell-data-function () nil)))) 46 | 47 | (defcallback gtk-tree-cell-data-func-destroy-cb :void ((data :pointer)) 48 | (free-stable-pointer data)) 49 | 50 | (defcfun gtk-tree-view-column-set-cell-data-func :void 51 | (tree-column (g-object tree-view-column)) 52 | (cell-renderer (g-object cell-renderer)) 53 | (func :pointer) 54 | (func-data :pointer) 55 | (destroy-notify :pointer)) 56 | 57 | (defun tree-view-column-set-cell-data-function (tree-column cell-renderer function) 58 | (gtk-tree-view-column-set-cell-data-func 59 | tree-column 60 | cell-renderer 61 | (callback gtk-tree-cell-data-func-cb) 62 | (allocate-stable-pointer function) 63 | (callback gtk-tree-cell-data-func-destroy-cb))) 64 | 65 | (export 'tree-view-column-set-cell-data-function) 66 | 67 | (defcfun (tree-view-column-clear-attributes "gtk_tree_view_column_clear_attributes") :void 68 | (tree-column (g-object tree-column)) 69 | (cell-renderer (g-object cell-renderer))) 70 | 71 | (export 'tree-view-column-clear-attributes) 72 | 73 | (defcfun (tree-view-column-cell-set-cell-data "gtk_tree_view_column_cell_set_cell_data") :void 74 | (tree-column (g-object tree-view-column)) 75 | (tree-model (g-object tree-model)) 76 | (iter (g-boxed-foreign tree-iter)) 77 | (is-expander :boolean) 78 | (is-expanded :boolean)) 79 | 80 | (export 'tree-view-column-cell-set-data) 81 | 82 | (defcfun gtk-tree-view-column-cell-get-size :void 83 | (tree-column (g-object tree-view-column)) 84 | (cell-area (g-boxed-foreign rectangle)) 85 | (x-offset (:pointer :int)) 86 | (y-offset (:pointer :int)) 87 | (width (:pointer :int)) 88 | (height (:pointer :int))) 89 | 90 | (defun tree-view-column-cell-size (tree-column cell-area) 91 | (with-foreign-objects ((x :int) (y :int) (width :int) (height :int)) 92 | (gtk-tree-view-column-cell-get-size tree-column cell-area x y width height) 93 | (values (mem-ref x :int) (mem-ref y :int) (mem-ref width :int) (mem-ref height :int)))) 94 | 95 | (export 'tree-view-column-cell-size) 96 | 97 | (defcfun gtk-tree-view-column-cell-get-position :boolean 98 | (tree-column (g-object tree-view-column)) 99 | (cell-renderer (g-object cell-renderer)) 100 | (start-pos (:pointer :int)) 101 | (width (:pointer :int))) 102 | 103 | (defun tree-view-column-cell-position (tree-column cell-renderer) 104 | (with-foreign-objects ((start :int) (width :int)) 105 | (when (gtk-tree-view-column-cell-get-position tree-column cell-renderer start width) 106 | (list (mem-ref start :int) (mem-ref width :int))))) 107 | 108 | 109 | (defcfun (tree-view-column-focus-cell "gtk_tree_view_column_focus_cell") :void 110 | (tree-column (g-object tree-view-column)) 111 | (cell-renderer (g-object cell-renderer))) 112 | 113 | (export 'tree-view-column-focus-cell) 114 | 115 | (defcfun (tree-view-column-queue-resize "gtk_tree_view_column_queue_resize") :void 116 | (tree-column (g-object tree-view-column))) 117 | 118 | (export 'tree-view-column-queue-resize) 119 | -------------------------------------------------------------------------------- /gtk/gtk.tree-view-dnd.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (define-vtable ("GtkTreeDragSource" tree-drag-source) 4 | (:skip parent-instance g-type-interface) 5 | ;;methods 6 | (row-draggable (:boolean 7 | (tree-drag-source g-object) 8 | (path (g-boxed-foreign tree-path)))) 9 | (drag-data-get (:boolean 10 | (tree-drag-source g-object) 11 | (path (g-boxed-foreign tree-path)) 12 | (selection-data (g-boxed-foreign selection-data)))) 13 | (drag-data-delete (:boolean 14 | (tree-drag-source g-object) 15 | (path (g-boxed-foreign tree-path))))) 16 | 17 | (define-vtable ("GtkTreeDragDest" tree-drag-dest) 18 | (:skip parent-instance g-type-interface) 19 | ;;methods 20 | (drag-data-received (:boolean 21 | (tree-drag-dest g-object) 22 | (path (g-boxed-foreign tree-path)) 23 | (selection-data (g-boxed-foreign selection-data)))) 24 | (row-drop-possible (:boolean 25 | (tree-drag-dest g-object) 26 | (path (g-boxed-foreign tree-path)) 27 | (selection-data (g-boxed-foreign selection-data))))) 28 | 29 | -------------------------------------------------------------------------------- /gtk/gtk.window-group.lisp: -------------------------------------------------------------------------------- 1 | (in-package :gtk) 2 | 3 | (defcfun (window-group-add-window "gtk_window_group_add_window") :void 4 | (window-group (g-object window-group)) 5 | (window (g-object gtk-window))) 6 | 7 | (export 'window-group-add-window) 8 | 9 | (defcfun (window-group-remove-window "gtk_window_group_remove_window") :void 10 | (window-group (g-object window-group)) 11 | (window (g-object gtk-window))) 12 | 13 | (export 'window-group-remove-window) 14 | -------------------------------------------------------------------------------- /pango/cl-gtk2-pango.asd: -------------------------------------------------------------------------------- 1 | (defsystem :cl-gtk2-pango 2 | :name :cl-gtk2-pango 3 | :version "0.1.1" 4 | :author "Kalyanov Dmitry " 5 | :license "LLGPL" 6 | :serial t 7 | :components ((:file "pango.package") 8 | (:file "pango.init") 9 | (:file "pango")) 10 | :depends-on (:cl-gtk2-glib :iterate)) -------------------------------------------------------------------------------- /pango/pango.init.lisp: -------------------------------------------------------------------------------- 1 | (in-package :pango) 2 | 3 | (glib:at-init () 4 | (eval-when (:compile-toplevel :load-toplevel :execute) 5 | (define-foreign-library pango 6 | ((:and :unix (:not :darwin)) "libpango-1.0.so.0") 7 | (:darwin (:or "libpango-1.0.0.dylib" "libpango-1.0.dylib")) 8 | (:windows "libpango-1.0-0.dll") 9 | (t (:default "libgpango-1.0")))) 10 | 11 | (use-foreign-library pango)) 12 | 13 | -------------------------------------------------------------------------------- /pango/pango.lisp: -------------------------------------------------------------------------------- 1 | (in-package :pango) 2 | 3 | (define-g-enum "PangoWrapMode" pango-wrap-mode 4 | (:export t :type-initializer 5 | "pango_wrap_mode_get_type") 6 | (:word 0) (:char 1) (:word-char 2)) 7 | 8 | (export 'pango-wrap-mode) 9 | 10 | (define-g-enum "PangoEllipsizeMode" pango-ellipsize-mode 11 | (:export t :type-initializer 12 | "pango_ellipsize_mode_get_type") 13 | (:none 0) (:start 1) (:middle 2) (:end 3)) 14 | 15 | (export 'pango-ellipsize-mode) 16 | 17 | (define-g-object-class "PangoLayout" pango-layout (:type-initializer "pango_layout_get_type") ()) 18 | 19 | (export 'pango-layout) 20 | 21 | (define-g-enum "PangoUnderline" pango-underline (:export t :type-initializer "pango_underline_get_type") 22 | (:none 0) 23 | (:single 1) 24 | (:double 2) 25 | (:low 3) 26 | (:error 4)) 27 | 28 | (export 'pango-underline) 29 | 30 | (define-g-enum "PangoDirection" 31 | pango-direction 32 | (:export t :type-initializer "pango_direction_get_type") 33 | (:ltr 0) 34 | (:rtl 1) 35 | (:ttb-ltr 2) 36 | (:ttb-rtl 3) 37 | (:weak-ltr 4) 38 | (:weak-rtl 5) 39 | (:neutral 6)) 40 | 41 | (define-g-object-class "PangoRenderer" pango-renderer 42 | (:superclass g-object :export t :interfaces 43 | nil :type-initializer 44 | "pango_renderer_get_type") 45 | nil) 46 | 47 | (define-g-object-class "PangoContext" pango-context 48 | (:superclass g-object :export t :interfaces 49 | nil :type-initializer 50 | "pango_context_get_type") 51 | nil) 52 | 53 | (define-g-enum "PangoRenderPart" 54 | pango-render-part 55 | (:export t :type-initializer "pango_render_part_get_type") 56 | (:foreground 0) 57 | (:background 1) 58 | (:underline 2) 59 | (:strikethrough 3)) 60 | 61 | (define-g-boxed-opaque pango-layout-line "PangoLayoutLine" 62 | :alloc (error "Use Pango to create PANGO-LAYOUT-LINEs")) 63 | 64 | (export (boxed-related-symbols 'pango-layout-line)) 65 | 66 | (define-g-enum "PangoRenderPart" 67 | pango-render-part 68 | (:export t :type-initializer "pango_render_part_get_type") 69 | (:foreground 0) 70 | (:background 1) 71 | (:underline 2) 72 | (:strikethrough 3)) 73 | 74 | (defcfun pango_glyph_string_new :pointer) 75 | 76 | (define-g-boxed-opaque pango-glyph-string "PangoGlyphString" 77 | :alloc (pango_glyph_string_new)) 78 | 79 | (export (boxed-related-symbols 'pango-glyph-string)) 80 | 81 | (define-g-object-class "PangoFont" pango-font 82 | (:superclass g-object :export t :interfaces 83 | nil :type-initializer 84 | "pango_font_get_type") 85 | nil) 86 | 87 | (define-g-boxed-cstruct pango-matrix "PangoMatrix" 88 | (xx :double :initform 0.0) 89 | (xy :double :initform 0.0) 90 | (yx :double :initform 0.0) 91 | (yy :double :initform 0.0) 92 | (x0 :double :initform 0.0) 93 | (y0 :double :initform 0.0)) 94 | 95 | (export (boxed-related-symbols 'pango-matrix)) 96 | 97 | (define-g-boxed-opaque pango-layout-line "PangoLayoutLine" 98 | :alloc (error "You do not create PangoLayoutLine yourself")) 99 | 100 | (export (boxed-related-symbols 'pango-layout-line)) 101 | -------------------------------------------------------------------------------- /pango/pango.package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :pango 2 | (:use :cl :iter :cffi :gobject :glib)) 3 | --------------------------------------------------------------------------------