diff --git a/gobgen.el b/gobgen.el index 5e11561..f7f6d95 100644 --- a/gobgen.el +++ b/gobgen.el @@ -1,4 +1,4 @@ -;;; gobgen.el --- Generate GObject descendants using a detailed form -*- lexical-binding: t; -*- +;;; gobgen.el --- Generate GObject descendants using a detailed form -*- lexical-binding: nil; -*- ;; Copyright (C) 2015 Gergely Polonkai @@ -30,19 +30,26 @@ (eval-when-compile (require 'wid-edit)) -(defvar gobgen-widget-name) -(defvar gobgen-widget-prefix) -(defvar gobgen-widget-parent-name) -(defvar gobgen-widget-parent-prefix) -(defvar gobgen-widget-recent) -(defvar gobgen-widget-private) +(defvar-local gobgen-widget-name nil + "Widget for the class name.") +(defvar-local gobgen-widget-prefix nil + "Widget for the class prefix. It is auto-filled, but changeable.") +(defvar-local gobgen-widget-parent-name nil + "Widget for the name of the parent class.") +(defvar-local gobgen-widget-parent-prefix nil + "Widget for the prefix of the parent class. It is auto-filled, but changeable.") +(defvar-local gobgen-widget-recent nil + "Checkbox field for the recent GLib option.") +(defvar-local gobgen-widget-private nil + "Checkbox field for the private structure option.") (defun string-join (list separator) - "Takes a list of string and joins them using delimiter." + "Takes a list of strings and joins them using delimiter." + (mapconcat (lambda (x) x) list separator)) (defun string-has-prefix (full-str prefix-str) - "Check if full-str has the prefix prefix-str" + "Check if FULL-STR has the prefix PREFIX-STR" (let* ((prefix-length (length prefix-str))) (string-equal prefix-str (substring full-str 0 prefix-length)))) @@ -50,7 +57,18 @@ (defun get-gobject-prefix (class-name) (car (split-string class-name "_"))) -(defun gobgen-gen-header () +(defun gobgen-gen-header (CLASS_FULL_NAME + CLASS_PREFIX + CLASS_NAME + ClassFullName + func-prefix + parent_prefix + ParentPrefix + ParentName + parent-header + recent-glib + need-private) + "Generate the contents of a GObject header file." (concat "#ifndef __" @@ -58,90 +76,102 @@ "_H__\n" "#define __" - CLASS_FULL_NAME - "_H__\n" + CLASS_FULL_NAME + "_H__\n" - "\n" + "\n" - (if (string-equal "g" parent_prefix) - "#include " - (if (string-equal "gtk" parent_prefix) - "#include " - (concat "// You might want to revise this\n" - "#include <" - parent-header - ">"))) - "\n" + (if (string-equal "g" parent_prefix) + "#include " + (if (string-equal "gtk" parent_prefix) + "#include " + (concat "// You might want to revise this\n" + "#include <" + parent-header + ">"))) + "\n" - "\n" + "\n" - "G_BEGIN_DECLS\n" + "G_BEGIN_DECLS\n" - "\n" + "\n" - "#define " CLASS_PREFIX "_TYPE_" CLASS_NAME " (" func-prefix "_get_type())\n" + "#define " CLASS_PREFIX "_TYPE_" CLASS_NAME " (" func-prefix "_get_type())\n" - "#define " CLASS_FULL_NAME "(o) (G_TYPE_CHECK_INSTANCE_CAST((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "))\n" + "#define " CLASS_FULL_NAME "(o) (G_TYPE_CHECK_INSTANCE_CAST((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "))\n" - "#define " CLASS_FULL_NAME "_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "Class))\n" + "#define " CLASS_FULL_NAME "_CLASS(k) (G_TYPE_CHECK_CLASS_CAST((k), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "Class))\n" - "#define " CLASS_PREFIX "_IS_" CLASS_NAME "(o) (G_TYPE_CHECK_INSTANCE_TYPE((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME "))\n" + "#define " CLASS_PREFIX "_IS_" CLASS_NAME "(o) (G_TYPE_CHECK_INSTANCE_TYPE((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME "))\n" - "#define " CLASS_PREFIX "_IS_" CLASS_NAME "_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE((k), " CLASS_PREFIX "_TYPE_" CLASS_NAME "))\n" + "#define " CLASS_PREFIX "_IS_" CLASS_NAME "_CLASS(k) (G_TYPE_CHECK_CLASS_TYPE((k), " CLASS_PREFIX "_TYPE_" CLASS_NAME "))\n" - "#define " CLASS_FULL_NAME"_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "Class))\n" + "#define " CLASS_FULL_NAME"_GET_CLASS(o) (G_TYPE_INSTANCE_GET_CLASS((o), " CLASS_PREFIX "_TYPE_" CLASS_NAME ", " ClassFullName "Class))\n" - "\n" + "\n" - "typedef struct _" ClassFullName " " ClassFullName ";\n" + "typedef struct _" ClassFullName " " ClassFullName ";\n" - "typedef struct _" ClassFullName "Class " ClassFullName "Class;\n" + "typedef struct _" ClassFullName "Class " ClassFullName "Class;\n" - (if (and (not recent-glib) need-private) - (concat "typedef struct _" ClassFullName "Private " ClassFullName "Private;\n")) + (if (and (not recent-glib) need-private) + (concat "typedef struct _" ClassFullName "Private " ClassFullName "Private;\n")) - "\n" + "\n" - "struct _" ClassFullName " {\n" + "struct _" ClassFullName " {\n" - " /* Parent instance structure */\n" + " /* Parent instance structure */\n" - " " ParentPrefix ParentName " parent_instance;\n" + " " ParentPrefix ParentName " parent_instance;\n" - "\n" + "\n" - " /* Instance members */\n" + " /* Instance members */\n" - (if (and (not recent-glib) need-private) - (concat "\n" - " /*< private >*/\n" - " " ClassFullName "Private *priv;\n")) + (if (and (not recent-glib) need-private) + (concat "\n" + " /*< private >*/\n" + " " ClassFullName "Private *priv;\n")) - "};\n" + "};\n" - "\n" + "\n" - "struct _" ClassFullName "Class {\n" + "struct _" ClassFullName "Class {\n" - " " ParentPrefix ParentName "Class parent_class;\n" + " " ParentPrefix ParentName "Class parent_class;\n" - "};\n" + "};\n" - "\n" + "\n" - "GType " func-prefix "_get_type(void) G_GNUC_CONST;\n" + "GType " func-prefix "_get_type(void) G_GNUC_CONST;\n" - "\n" + "\n" - "G_END_DECLS\n" + "G_END_DECLS\n" - "\n" + "\n" - "#endif /* __" - CLASS_FULL_NAME - "_H__ */\n")) + "#endif /* __" + CLASS_FULL_NAME + "_H__ */\n")) + +(defun gobgen-gen-code (CLASS_FULL_NAME + CLASS_PREFIX + CLASS_NAME + class_name + ClassFullName + func-prefix + file-name-header + PARENT_PREFIX + PARENT_NAME + recent-glib + need-private) + "Generate the contents of a GObject source file." -(defun gobgen-gen-code () (concat "#include \"" file-name-header "\"\n" @@ -149,26 +179,26 @@ (if need-private (concat - (if (not recent-glib) - (concat - "#define " CLASS_FULL_NAME "_GET_PRIVATE(o) (G_TYPE_INSTANCE_GET_PRIVATE( \\\n" - " (o), \\\n" - " " CLASS_PREFIX "_TYPE_" CLASS_NAME ", \\\n" - " " ClassFullName "Private \\\n" - " ))\n" - "\n")) + (if (not recent-glib) + (concat + "#define " CLASS_FULL_NAME "_GET_PRIVATE(o) (G_TYPE_INSTANCE_GET_PRIVATE( \\\n" + " (o), \\\n" + " " CLASS_PREFIX "_TYPE_" CLASS_NAME ", \\\n" + " " ClassFullName "Private \\\n" + " ))\n" + "\n")) - (if recent-glib "typedef ") + (if recent-glib "typedef ") - "struct _" ClassFullName "Private {\n" - " /* TODO: You must add something here, or GLib will produce warnings! */\n" - "}" + "struct _" ClassFullName "Private {\n" + " /* TODO: You must add something here, or GLib will produce warnings! */\n" + "}" - (if recent-glib - (concat " " ClassFullName "Private")) + (if recent-glib + (concat " " ClassFullName "Private")) - ";\n" - "\n")) + ";\n" + "\n")) "G_DEFINE_TYPE" @@ -196,8 +226,8 @@ (if (and (not recent-glib) need-private) (concat - " g_type_class_add_private(klass, sizeof(" ClassFullName "Private));\n" - "\n")) + " g_type_class_add_private(klass, sizeof(" ClassFullName "Private));\n" + "\n")) " gobject_class->finalize = " func-prefix "_finalize;\n" @@ -211,15 +241,18 @@ (if (and (not recent-glib) need-private) (concat - " " class_name "->priv = " CLASS_FULL_NAME "_GET_PRIVATE(" class_name ");\n")) + " " class_name "->priv = " CLASS_FULL_NAME "_GET_PRIVATE(" class_name ");\n")) "}\n")) -(defun gobgen-generator () - "Generate the header definition for a GObject derived clas. +(defun gobgen-generator (class-prefix + class-name + parent-prefix + parent-name + recent-glib + need-private) + "Generate the header definition for a GObject derived clas." -Parameters: -" (let* ((parent-prefix (downcase parent-prefix)) (parent-name (downcase parent-name)) (class-prefix (downcase class-prefix)) @@ -233,46 +266,68 @@ Parameters: (if (not (string-has-prefix class-name (concat class-prefix "_"))) (message (concat "Class (" class-name ") and class prefix (" class-prefix ") don't match")) - (let* ((parent-name (substring parent-name (+ parent-prefix-length 1))) - (class-name (substring class-name (+ class-prefix-length 1))) - (parent-prefix-pcs (split-string parent-prefix "_")) - (parent-name-pcs (split-string parent-name "_")) - (class-prefix-pcs (split-string class-prefix "_")) - (class-name-pcs (split-string class-name "_")) - (parent_prefix (string-join parent-prefix-pcs "_")) - (ParentPrefix (mapconcat 'capitalize parent-prefix-pcs "")) - (PARENT_PREFIX (upcase parent_prefix)) - (parent_name (string-join parent-name-pcs "_")) - (ParentName (mapconcat 'capitalize parent-name-pcs "")) - (PARENT_NAME (upcase parent_name)) - (class_prefix (string-join class-prefix-pcs "_")) - (ClassPrefix (mapconcat 'capitalize class-prefix-pcs "")) - (CLASS_PREFIX (upcase class_prefix)) - (class_name (string-join class-name-pcs "_")) - (ClassName (mapconcat 'capitalize class-name-pcs "")) - (CLASS_NAME (upcase class_name)) - (func-prefix (concat class_prefix "_" class_name)) - (ClassFullName (concat ClassPrefix ClassName)) - (CLASS_FULL_NAME (concat CLASS_PREFIX "_" CLASS_NAME)) - (parent-header (concat (string-join (append parent-prefix-pcs parent-name-pcs) "-") ".h")) - (file-name-base (string-join (append class-prefix-pcs class-name-pcs) "-")) - (file-name-code (concat file-name-base ".c")) - (file-name-header (concat file-name-base ".h"))) + (let* ((parent-name (substring parent-name (+ parent-prefix-length 1))) + (class-name (substring class-name (+ class-prefix-length 1))) + (parent-prefix-pcs (split-string parent-prefix "_")) + (parent-name-pcs (split-string parent-name "_")) + (class-prefix-pcs (split-string class-prefix "_")) + (class-name-pcs (split-string class-name "_")) + (parent_prefix (string-join parent-prefix-pcs "_")) + (ParentPrefix (mapconcat 'capitalize parent-prefix-pcs "")) + (PARENT_PREFIX (upcase parent_prefix)) + (parent_name (string-join parent-name-pcs "_")) + (ParentName (mapconcat 'capitalize parent-name-pcs "")) + (PARENT_NAME (upcase parent_name)) + (class_prefix (string-join class-prefix-pcs "_")) + (ClassPrefix (mapconcat 'capitalize class-prefix-pcs "")) + (CLASS_PREFIX (upcase class_prefix)) + (class_name (string-join class-name-pcs "_")) + (ClassName (mapconcat 'capitalize class-name-pcs "")) + (CLASS_NAME (upcase class_name)) + (func-prefix (concat class_prefix "_" class_name)) + (ClassFullName (concat ClassPrefix ClassName)) + (CLASS_FULL_NAME (concat CLASS_PREFIX "_" CLASS_NAME)) + (parent-header (concat (string-join (append parent-prefix-pcs parent-name-pcs) "-") ".h")) + (file-name-base (string-join (append class-prefix-pcs class-name-pcs) "-")) + (file-name-code (concat file-name-base ".c")) + (file-name-header (concat file-name-base ".h"))) - (delete-other-windows) - (split-window-vertically) - (other-window 1) - (find-file file-name-header) - (insert (gobgen-gen-header)) + (delete-other-windows) + (split-window-vertically) + (other-window 1) + (find-file file-name-header) + (insert (gobgen-gen-header CLASS_FULL_NAME + CLASS_PREFIX + CLASS_NAME + ClassFullName + func-prefix + parent_prefix + ParentPrefix + ParentName + parent-header + recent-glib + need-private)) - (split-window-vertically) - (other-window 1) - (find-file file-name-code) - (insert (gobgen-gen-code))))))) + (split-window-vertically) + (other-window 1) + (find-file file-name-code) + (insert (gobgen-gen-code CLASS_FULL_NAME + CLASS_PREFIX + CLASS_NAME + class_name + ClassFullName + func-prefix + file-name-header + PARENT_PREFIX + PARENT_NAME + recent-glib + need-private))))))) (defun gobgen () "Create widgets window for GObject creation" + (interactive) + (switch-to-buffer "*GObject Creator*") (kill-all-local-variables) @@ -290,10 +345,11 @@ Parameters: (widget-create 'editable-field :size 25 :format "Name: %v" - :notify (lambda (widget &rest ignore) - (save-excursion - (widget-value-set gobgen-widget-prefix (get-gobject-prefix (widget-value widget))))) - :doc "The name of the new class, with its prefix included" + :notify (lambda (widget _child &optional event) + (save-excursion + (widget-value-set gobgen-widget-prefix + (get-gobject-prefix (widget-value widget))))) + :doc "The name of the new class, with its prefix included" "gtk_example_object")) (widget-insert " ") @@ -302,17 +358,18 @@ Parameters: (widget-create 'editable-field :size 10 :format "Prefix: %v\n" - :doc "Prefix of the new class. It updates automatically based on the name, so unless you need a namespace that consists of multiple parts (like my_ns), you should not touch this." + :doc "Prefix of the new class. It updates automatically based on the name, so unless you need a namespace that consists of multiple parts (like my_ns), you should not touch this." "gtk")) (setq gobgen-widget-parent-name (widget-create 'editable-field :size 25 :format "Parent: %v" - :notify (lambda (widget &rest ignore) - (save-excursion - (widget-value-set gobgen-widget-parent-prefix (get-gobject-prefix (widget-value widget))))) - :doc "Name of the parent class. Use g_object if you don't want to derive from something specific." + :notify (lambda (widget _child &optional event) + (save-excursion + (widget-value-set gobgen-widget-parent-prefix + (get-gobject-prefix (widget-value widget))))) + :doc "Name of the parent class. Use g_object if you don't want to derive from something specific." "g_object")) (widget-insert " ") @@ -321,21 +378,21 @@ Parameters: (widget-create 'editable-field :size 10 :format "Prefix: %v\n" - :doc "Prefix of the parent class. Its automatically set value should suffice most of the time" + :doc "Prefix of the parent class. Its automatically set value should suffice most of the time" "g")) (widget-insert "\n") (setq gobgen-widget-recent (widget-create 'checkbox - :doc "Use recent GLib's features, like defining a class with a private struct. Usually you would want this on." + :doc "Use recent GLib's features, like defining a class with a private struct. Usually you would want this on." t)) (widget-insert " GLib >= 2.38\n") (setq gobgen-widget-private (widget-create 'checkbox - :doc "Add a private struct for the object." + :doc "Add a private struct for the object." nil)) (widget-insert " Has private members\n") @@ -343,14 +400,19 @@ Parameters: (widget-insert "\n\n") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (widget _child &optional event) (let ((class-name (widget-value gobgen-widget-name)) (class-prefix (widget-value gobgen-widget-prefix)) (parent-name (widget-value gobgen-widget-parent-name)) (parent-prefix (widget-value gobgen-widget-parent-prefix)) - (recent-glib (widget-value gobgen-widget-recent)) - (need-private (widget-value gobgen-widget-private))) - (gobgen-generator))) + (recent-glib (widget-value gobgen-widget-recent)) + (need-private (widget-value gobgen-widget-private))) + (gobgen-generator class-prefix + class-name + parent-prefix + parent-name + recent-glib + need-private))) "Generate") (widget-insert " ") @@ -368,11 +430,11 @@ Parameters: (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (widget _child &optional event) (kill-buffer "*GObject Creator*")) "Close") - (beginning-of-buffer) + (goto-char (point-min)) (use-local-map widget-keymap) (widget-setup))