|
462
|
1 ;;; gtk-ffi.el --- Foreign function interface for the GTK object system
|
|
|
2
|
|
|
3 ;; Copyright (C) 2000 Free Software Foundation
|
|
|
4
|
|
|
5 ;; Maintainer: William Perry <wmperry@gnu.org>
|
|
|
6 ;; Keywords: extensions, dumped
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; This file is dumped with XEmacs.
|
|
|
30
|
|
|
31 (defvar gtk-type-aliases '((GtkType . guint)
|
|
|
32 (GdkAtom . gulong)
|
|
|
33 (GdkBitmap . GdkWindow)
|
|
|
34 (time_t . guint)
|
|
|
35 (none . void)
|
|
|
36 (GdkDrawable . GdkWindow)
|
|
|
37 (GdkBitmap . GdkWindow)
|
|
|
38 (GdkPixmap . GdkWindow))
|
|
|
39 "An assoc list of aliases for commonly used GTK types that are not
|
|
|
40 really part of the object system.")
|
|
|
41
|
|
|
42 (defvar gtk-ffi-debug nil
|
|
|
43 "If non-nil, all functions defined wiht `gtk-import-function' will be checked
|
|
|
44 for missing marshallers.")
|
|
|
45
|
|
|
46 (defun gtk-ffi-check-function (func)
|
|
|
47 ;; We don't call gtk-main or gtk-main-quit because it thoroughly
|
|
|
48 ;; hoses us (locks up xemacs handling events, but no lisp).
|
|
|
49 (if (not (memq func '(gtk-main gtk-main-quit)))
|
|
|
50 (condition-case err
|
|
|
51 (funcall func)
|
|
|
52 (error
|
|
|
53 (case (car err)
|
|
|
54 (wrong-number-of-arguments nil)
|
|
|
55 (error
|
|
|
56 (if (string= "Could not locate marshaller function" (nth 1 err))
|
|
|
57 (progn
|
|
|
58 (set-buffer (get-buffer-create "needed marshallers"))
|
|
|
59 (display-buffer (current-buffer))
|
|
|
60 (goto-char (point-max))
|
|
|
61 (insert
|
|
|
62 (format "%S\n"
|
|
|
63 (split-string
|
|
|
64 (substring (nth 2 err) (length "emacs_gtk_marshal_")) "_+")))))))))))
|
|
|
65
|
|
|
66 (defmacro gtk-import-function (retval name &rest args)
|
|
|
67 (if (symbolp name)
|
|
|
68 (setq name (symbol-name name)))
|
|
|
69 (let ((lisp-name (intern (replace-in-string name "_" "-")))
|
|
|
70 (doc-string nil))
|
|
|
71 (setq retval (or (cdr-safe (assoc retval gtk-type-aliases)) retval)
|
|
|
72 doc-string (concat "The lisp version of " name ".\n"
|
|
|
73 (if args
|
|
|
74 (concat "Prototype: " (prin1-to-string args)))))
|
|
|
75
|
|
|
76 ;; Drop off any naming of arguments, etc.
|
|
|
77 (if (and args (consp (car args)))
|
|
|
78 (setq args (mapcar 'car args)))
|
|
|
79
|
|
|
80 ;; Get rid of any type aliases.
|
|
|
81 (setq args (mapcar (lambda (x)
|
|
|
82 (or (cdr-safe (assoc x gtk-type-aliases)) x)) args))
|
|
|
83
|
|
|
84 `(progn
|
|
|
85 (defun ,lisp-name (&rest args)
|
|
|
86 ,doc-string
|
|
|
87 (if (not (get (quote ,lisp-name) 'gtk-ffi nil))
|
|
|
88 (put (quote ,lisp-name) 'gtk-ffi
|
|
|
89 (gtk-import-function-internal (quote ,retval) ,name
|
|
|
90 (quote ,args))))
|
|
|
91 (gtk-call-function (get (quote ,lisp-name) 'gtk-ffi 'ignore) args))
|
|
|
92 (and gtk-ffi-debug (gtk-ffi-check-function (quote ,lisp-name))))))
|
|
|
93
|
|
|
94 (defmacro gtk-import-variable (type name)
|
|
|
95 (if (symbolp name) (setq name (symbol-name name)))
|
|
|
96 (let ((lisp-name (intern (replace-in-string name "_" "-")))
|
|
|
97 (doc-string nil))
|
|
|
98 (setq type (or (cdr-safe (assoc type gtk-type-aliases)) type)
|
|
|
99 doc-string (concat "Retrieve the variable " name " (type: " (symbol-name type) ").\n"))
|
|
|
100 `(defun ,lisp-name ()
|
|
|
101 ,doc-string
|
|
|
102 (gtk-import-variable-internal (quote ,type) ,name))))
|
|
|
103
|
|
|
104 (provide 'gtk-ffi)
|
