Mercurial > hg > xemacs-beta

view lisp/gtk-marshal.el @ 4435:1e2fc51563a5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix auto-formatting of comments in auto-fill-mode This patch makes auto-fill-mode properly format comments (when lines are automatically broken). It looks strangely similar to that of: | 1999-06-24 Bob Weiner <weiner@beopen.com> | | * simple.el (indent-new-comment-line): Locally bound | `block-comment-start' to `comstart' or else when this is called | from do-auto-fill, e.g. in Lisp mode, it will insert any non-nil | `block-comment-start' value, ignoring any existing spacing after a | comment prefix in the previous line and producing ugly comments.
author Didier Verna <didier@xemacs.org>
date Wed, 05 Mar 2008 18:01:37 +0100
parents f981d2fdd880
children db7068430402
line wrap: on
line source

;;
;; To regenerate ../src/emacs-marshals.c just load this file.
;;
(defconst name-to-return-type
  '(("INT" . "gint")
    ("CALLBACK" . "GtkCallback")
    ("OBJECT" . "GtkObject *")
    ("POINTER" . "void *")
    ("STRING" . "gchar *")
    ("BOOL" . "gboolean")
    ("DOUBLE" . "gdouble")
    ("FLOAT" . "gfloat")
    ("LIST"  . "void *")
    ("NONE" . nil)))

(defvar defined-marshallers nil)

(defun get-marshaller-name (rval args)
  (concat "emacs_gtk_marshal_" rval "__"
	  (mapconcat 'identity (or args '("NONE")) "_")))

(defun define-marshaller (rval &rest args)
  (let ((name nil)
	(internal-rval (assoc rval  name-to-return-type))
	(ctr 0)
	(func-proto (format "__%s_fn" rval)))
    (if (not internal-rval)
	(error "Do not know return type of `%s'" rval))
    (setq name (get-marshaller-name rval args))

    (if (member name defined-marshallers)
	(error "Attempt to define the same marshaller more than once! %s" name))

    (set-buffer (get-buffer-create "emacs-marshals.c"))
    (goto-char (point-max))

    (if (or (member "FLOAT" args) (member "DOUBLE" args))
	;; We need to special case anything with FLOAT in the argument
	;; list or the parameters get screwed up royally.
	(progn
	  (setq func-proto (concat (format "__%s__" rval)
				   (mapconcat 'identity args "_")
				   "_fn"))
	  (insert "typedef "
		  (or (cdr internal-rval) "void")
		  " (*"
		  func-proto ")("
		  (mapconcat (lambda (x)
			       (cdr (assoc x name-to-return-type))) args ", ")
		  ");\n")))

    (insert "\n"
	    "static void\n"
	    name " (ffi_actual_function func, GtkArg *args)\n"
	    "{\n"
	    (format "  %s rfunc = (%s) func;\n" func-proto func-proto))

    (if (string= "LIST" rval) (setq rval "POINTER"))

    (if (cdr internal-rval)
	;; It has a return type to worry about
	(insert "  " (cdr internal-rval) " *return_val;\n\n"
		(format "  return_val = GTK_RETLOC_%s (args[%d]);\n" rval (length args))
		"  *return_val = ")
      (insert "  "))
    (insert "(*rfunc) (")
    (while args
      (if (/= ctr 0)
	  (insert ", "))
      (insert (format "GTK_VALUE_%s (args[%d])" (car args) ctr))
      (setq args (cdr args)
	    ctr (1+ ctr)))
    (insert ");\n")
    (insert "}\n")))

(save-excursion
  (find-file "../src/emacs-marshals.c")
  (erase-buffer)
  (setq defined-marshallers nil)

  (insert "/* This file was automatically generated by ../lisp/gtk-marshal.el */\n"
	  "/* DO NOT EDIT BY HAND!!! */\n")
  (insert "#define GTK_VALUE_ARRAY(x) GTK_VALUE_POINTER(x)\n\n")
  (insert "#define GTK_VALUE_LIST(x) GTK_VALUE_POINTER(x)\n\n")

  (let ((todo '(
		("BOOL" "OBJECT" "INT")
		("BOOL" "OBJECT" "OBJECT" "OBJECT")
		("BOOL" "OBJECT" "OBJECT")
		("BOOL" "OBJECT" "POINTER")
		("BOOL" "OBJECT" "STRING")
		("BOOL" "OBJECT")
		("BOOL" "POINTER" "BOOL")
		("BOOL" "POINTER")
		("BOOL")
		("FLOAT" "OBJECT" "FLOAT")
		("FLOAT" "OBJECT")
		("INT" "BOOL")
		("INT" "OBJECT" "ARRAY")
		("INT" "OBJECT" "INT" "ARRAY")
		("INT" "OBJECT" "INT" "INT")
		("INT" "OBJECT" "INT" "STRING")
		("INT" "OBJECT" "INT")
		("INT" "OBJECT" "OBJECT")
		("INT" "OBJECT" "POINTER" "INT" "INT")
		("INT" "OBJECT" "POINTER" "INT")
		("INT" "OBJECT" "POINTER")
		("INT" "OBJECT" "STRING")
		("INT" "OBJECT")
		("INT" "POINTER" "INT")
		("INT" "POINTER" "STRING" "INT")
		("INT" "POINTER" "STRING" "STRING")
		("INT" "POINTER" "STRING")
		("INT" "POINTER")
		("INT" "STRING" "STRING" "INT" "ARRAY")
		("INT" "STRING")
		("INT")
		("LIST" "OBJECT")
		("LIST")
		("NONE" "BOOL")
		("NONE" "INT" "INT" "INT" "INT")
		("NONE" "INT" "INT")
		("NONE" "INT")
		("NONE" "OBJECT" "BOOL" "INT")
		("NONE" "OBJECT" "BOOL")
		("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "BOOL")
		("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
		("NONE" "OBJECT" "FLOAT" "FLOAT" "FLOAT")
		("NONE" "OBJECT" "FLOAT" "FLOAT")
		("NONE" "OBJECT" "FLOAT")
		("NONE" "OBJECT" "INT" "BOOL")
		("NONE" "OBJECT" "INT" "FLOAT" "BOOL")
		("NONE" "OBJECT" "INT" "FLOAT")
		("NONE" "OBJECT" "INT" "INT" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY" "ARRAY")
		("NONE" "OBJECT" "INT" "INT" "ARRAY")
		("NONE" "OBJECT" "INT" "INT" "FLOAT" "FLOAT")
		("NONE" "OBJECT" "INT" "INT" "INT" "INT")
		("NONE" "OBJECT" "INT" "INT" "INT")
		("NONE" "OBJECT" "INT" "INT" "POINTER" "POINTER")
		("NONE" "OBJECT" "INT" "INT" "POINTER")
		("NONE" "OBJECT" "INT" "INT" "STRING" "INT" "POINTER" "POINTER")
		("NONE" "OBJECT" "INT" "INT" "STRING")
		("NONE" "OBJECT" "INT" "INT")
		("NONE" "OBJECT" "INT" "OBJECT")
		("NONE" "OBJECT" "INT" "POINTER")
		("NONE" "OBJECT" "INT" "STRING")
		("NONE" "OBJECT" "INT")
		("NONE" "OBJECT" "LIST" "INT")
		("NONE" "OBJECT" "LIST")
		("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL" "INT")
		("NONE" "OBJECT" "OBJECT" "BOOL" "BOOL")
		("NONE" "OBJECT" "OBJECT" "FLOAT" "INT")
		("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT" "INT" "INT" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "INT" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "INT")
		("NONE" "OBJECT" "OBJECT" "OBJECT" "INT")
		("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT" "INT")
		("NONE" "OBJECT" "OBJECT" "OBJECT" "OBJECT")
		("NONE" "OBJECT" "OBJECT" "OBJECT" "POINTER" "POINTER" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "OBJECT")
		("NONE" "OBJECT" "OBJECT" "POINTER")
		("NONE" "OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
		("NONE" "OBJECT" "OBJECT" "STRING" "STRING" "INT")
		("NONE" "OBJECT" "OBJECT" "STRING" "STRING")
		("NONE" "OBJECT" "OBJECT" "STRING")
		("NONE" "OBJECT" "OBJECT")
		("NONE" "OBJECT" "POINTER" "BOOL")
		("NONE" "OBJECT" "POINTER" "INT" "FLOAT" "FLOAT")
		("NONE" "OBJECT" "POINTER" "INT" "INT" "INT")
		("NONE" "OBJECT" "POINTER" "INT" "INT")
		("NONE" "OBJECT" "POINTER" "INT" "POINTER" "POINTER")
		("NONE" "OBJECT" "POINTER" "INT" "POINTER")
		("NONE" "OBJECT" "POINTER" "INT" "STRING" "INT" "POINTER" "POINTER")
		("NONE" "OBJECT" "POINTER" "INT" "STRING")
		("NONE" "OBJECT" "POINTER" "INT")
		("NONE" "OBJECT" "POINTER" "POINTER" "INT" "INT" "INT" "INT" "INT" "INT")
		("NONE" "OBJECT" "POINTER" "POINTER" "POINTER" "STRING" "INT")
		("NONE" "OBJECT" "POINTER" "POINTER" "POINTER")
		("NONE" "OBJECT" "POINTER" "POINTER")
		("NONE" "OBJECT" "POINTER" "STRING" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
		("NONE" "OBJECT" "POINTER")
		("NONE" "OBJECT" "STRING" "BOOL")
		("NONE" "OBJECT" "STRING" "INT" "INT" "INT")
		("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT" "INT")
		("NONE" "OBJECT" "STRING" "POINTER" "INT" "INT")
		("NONE" "OBJECT" "STRING" "STRING")
		("NONE" "OBJECT" "STRING")
		("NONE" "OBJECT")
		("NONE" "POINTER" "INT" "INT")
		("NONE" "POINTER" "INT")
		("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT" "INT" "INT")
		("NONE" "POINTER" "POINTER" "BOOL" "INT" "INT" "INT" "INT")
		("NONE" "POINTER" "POINTER" "INT" "INT" "INT" "INT")
		("NONE" "POINTER" "POINTER" "INT" "INT")
		("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING" "INT")
		("NONE" "POINTER" "POINTER" "POINTER" "INT" "INT" "STRING")
		("NONE" "POINTER" "POINTER" "POINTER" "POINTER")
		("NONE" "POINTER" "POINTER")
		("NONE" "POINTER" "STRING" "STRING")
		("NONE" "POINTER" "STRING")
		("NONE" "POINTER")
		("NONE")
		("OBJECT" "BOOL" "BOOL" "INT")
		("OBJECT" "BOOL" "INT")
		("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
		("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
		("OBJECT" "FLOAT" "FLOAT" "FLOAT" "FLOAT")
		("OBJECT" "INT" "ARRAY")
		("OBJECT" "INT" "BOOL" "BOOL")
		("OBJECT" "INT" "INT" "ARRAY")
		("OBJECT" "INT" "INT" "BOOL")
		("OBJECT" "INT" "INT" "STRING")
		("OBJECT" "INT" "INT")
		("OBJECT" "INT")
		("OBJECT" "OBJECT" "FLOAT" "INT")
		("OBJECT" "OBJECT" "INT")
		("OBJECT" "OBJECT" "OBJECT")
		("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT" "INT")
		("OBJECT" "OBJECT" "STRING" "INT" "INT" "INT" "INT")
		("OBJECT" "OBJECT" "STRING" "INT" "INT")
		("OBJECT" "OBJECT" "STRING")
		("OBJECT" "OBJECT")
		("OBJECT" "POINTER" "POINTER")
		("OBJECT" "POINTER" "STRING")
		("OBJECT" "POINTER")
		("OBJECT" "STRING" "FLOAT" "FLOAT" "FLOAT" "BOOL")
		("OBJECT" "STRING" "INT" "STRING" "STRING")
		("OBJECT" "STRING" "OBJECT")
		("OBJECT" "STRING" "STRING" "STRING" "ARRAY" "STRING" "STRING")
		("OBJECT" "STRING" "STRING")
		("OBJECT" "STRING")
		("OBJECT")
		("POINTER" "INT" "INT")
		("POINTER" "INT")
		("POINTER" "OBJECT" "INT" "INT")
		("POINTER" "OBJECT" "INT")
		("POINTER" "OBJECT" "POINTER" "INT")
		("POINTER" "OBJECT" "POINTER" "POINTER" "ARRAY" "INT" "POINTER" "POINTER" "POINTER" "POINTER" "BOOL" "BOOL")
		("POINTER" "OBJECT" "POINTER")
		("POINTER" "OBJECT")
		("POINTER" "POINTER")
		("POINTER" "STRING" "INT")
		("POINTER")
		("STRING" "INT" "INT" "INT")
		("STRING" "INT")
		("STRING" "OBJECT" "BOOL")
		("STRING" "OBJECT" "FLOAT")
		("STRING" "OBJECT" "INT" "INT")
		("STRING" "OBJECT" "INT")
		("STRING" "OBJECT")
		("STRING" "POINTER" "STRING")
		("STRING" "POINTER")
		("STRING")
		)
	      )
	)
    (mapc (lambda (x) (apply 'define-marshaller x)) todo)

    (insert "\n
#include \"hash.h\"

static struct hash_table *marshaller_hashtable;

static void initialize_marshaller_storage (void)
{
	if (!marshaller_hashtable)
	{
		marshaller_hashtable = make_string_hash_table (100);
")
    
    (mapc (lambda (x)
	    (let ((name (get-marshaller-name (car x) (cdr x))))
	      (insert (format "\t\tputhash (\"%s\", (void *) %s, marshaller_hashtable);\n" name name))))
	  todo)
    (insert "\t};\n"
	    "}\n"
	    "
static void *find_marshaller (const char *func_name)
{
	void *fn = NULL;
	initialize_marshaller_storage ();

	if (gethash (func_name, marshaller_hashtable, (const void **)&fn))
	{
		return (fn);
	}

	return (NULL);
}
"))

  (save-buffer)
  (kill-buffer "emacs-marshals.c"))