code.delx.au - gnu-emacs-elpa/blob - gobject-snippet.el

   1 ;;; gobject-snippet.el --- GObject C code generation
   2 ;; Copyright (C) 2016 Daiki Ueno <ueno@gnu.org>
   3
   4 ;; Author: Daiki Ueno <ueno@gnu.org>
   5 ;; Keywords: GObject, C, coding style
   6
   7 ;; This file is not part of GNU Emacs.
   8
   9 ;; This program is free software: you can redistribute it and/or
  10 ;; modify it under the terms of the GNU General Public License as
  11 ;; published by the Free Software Foundation, either version 3 of the
  12 ;; License, or (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see
  21 ;; <http://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'gobject-align)
  26
  27 (eval-when-compile
  28   (require 'subword))
  29
  30 (declare-function subword-forward "subword.el" (&optional arg))
  31
  32 (defvar gobject-snippet-package nil)
  33 (make-variable-buffer-local 'gobject-snippet-package)
  34
  35 (defvar gobject-snippet-class nil)
  36 (make-variable-buffer-local 'gobject-snippet-class)
  37
  38 (defvar gobject-snippet-parent-package nil)
  39 (make-variable-buffer-local 'gobject-snippet-parent-package)
  40
  41 (defvar gobject-snippet-parent-class nil)
  42 (make-variable-buffer-local 'gobject-snippet-parent-class)
  43
  44 (defvar gobject-snippet-align-arglist nil)
  45 (make-variable-buffer-local 'gobject-snippet-align-arglist)
  46
  47 (defun gobject-snippet--parse-name (name)
  48   (require 'subword)
  49   (with-temp-buffer
  50     (let (words)
  51       (insert name)
  52       (goto-char (point-min))
  53       (while (not (eobp))
  54         ;; Skip characters not recognized by subword-mode.
  55         (if (looking-at "[^[:lower:][:upper:][:digit:]]+")
  56             (goto-char (match-end 0)))
  57         (push (buffer-substring (point) (progn (subword-forward 1)
  58                                                (point)))
  59               words))
  60       (nreverse words))))
  61
  62 (defun gobject-snippet--read-package-and-class (package-prompt
  63                                                 class-prompt
  64                                                 package-symbol
  65                                                 class-symbol)
  66   (when (or current-prefix-arg
  67             (not (and (symbol-value package-symbol)
  68                       (symbol-value class-symbol))))
  69     (set package-symbol
  70          (gobject-snippet--parse-name
  71           (read-string (or package-prompt
  72                            "Package (CamelCase): ")
  73                        (if (symbol-value package-symbol)
  74                            (gobject-snippet--format-Package
  75                             (symbol-value package-symbol))))))
  76     (set class-symbol
  77          (gobject-snippet--parse-name
  78           (read-string (or class-prompt
  79                            "Class (CamelCase): ")
  80                        (if (symbol-value class-symbol)
  81                            (gobject-snippet--format-Class
  82                             (symbol-value class-symbol)))))))
  83   (list (symbol-value package-symbol) (symbol-value class-symbol)))
  84
  85 (defun gobject-snippet--format-PACKAGE (package)
  86   (mapconcat #'upcase package "_"))
  87 (defalias 'gobject-snippet--format-CLASS 'gobject-snippet--format-PACKAGE)
  88
  89 (defun gobject-snippet--format-PACKAGE_CLASS (package class)
  90   (concat (gobject-snippet--format-PACKAGE package)
  91           "_"
  92           (gobject-snippet--format-CLASS class)))
  93
  94 (defun gobject-snippet--format-package (package)
  95   (mapconcat #'downcase package "_"))
  96 (defalias 'gobject-snippet--format-class 'gobject-snippet--format-package)
  97
  98 (defun gobject-snippet--format-package_class (package class)
  99   (concat (gobject-snippet--format-package package)
 100           "_"
 101           (gobject-snippet--format-class class)))
 102
 103 (defun gobject-snippet--format-Package (package)
 104   (mapconcat #'identity package ""))
 105 (defalias 'gobject-snippet--format-Class 'gobject-snippet--format-Package)
 106
 107 (defun gobject-snippet--format-PackageClass (package class)
 108   (concat (gobject-snippet--format-Package package)
 109           (gobject-snippet--format-Class class)))
 110
 111 ;;;###autoload
 112 (defun gobject-snippet-insert-package_class (package class)
 113   "Insert the class name before the current point."
 114   (interactive (gobject-snippet--read-package-and-class
 115                 nil nil
 116                 'gobject-snippet-package
 117                 'gobject-snippet-class))
 118   (insert (gobject-snippet--format-package_class package class)))
 119
 120 ;;;###autoload
 121 (defun gobject-snippet-insert-PACKAGE_CLASS (package class)
 122   "Insert the class name before the current point."
 123   (interactive (gobject-snippet--read-package-and-class
 124                 nil nil
 125                 'gobject-snippet-package
 126                 'gobject-snippet-class))
 127   (insert (gobject-snippet--format-PACKAGE_CLASS package class)))
 128
 129 ;;;###autoload
 130 (defun gobject-snippet-insert-PackageClass (package class)
 131   "Insert the class name (in CamelCase) before the current point."
 132   (interactive (gobject-snippet--read-package-and-class
 133                 nil nil
 134                 'gobject-snippet-package
 135                 'gobject-snippet-class))
 136   (insert (gobject-snippet--format-PackageClass package class)))
 137
 138 (defun gobject-snippet-insert-interface-declaration (package iface
 139                                                              parent-package parent-class)
 140   "Insert interface declaration for PACKAGE and IFACE"
 141   (interactive
 142    (append (gobject-snippet--read-package-and-class
 143             nil
 144             "Interface (CamelCase): "
 145             'gobject-snippet-package
 146             'gobject-snippet-class)
 147            (gobject-snippet--read-package-and-class
 148             "Parent package (CamelCase): "
 149             "Parent class (CamelCase): "
 150             'gobject-snippet-parent-package
 151             'gobject-snippet-parent-class)))
 152   (insert "\
 153 #define " (gobject-snippet--format-PACKAGE package) "_TYPE_" (gobject-snippet--format-CLASS iface) " (" (gobject-snippet--format-package package) "_" (gobject-snippet--format-class iface) "_get_type ())
 154 G_DECLARE_INTERFACE (" (gobject-snippet--format-PackageClass package iface) ", "
 155 (gobject-snippet--format-package_class package iface) ", " (gobject-snippet--format-PACKAGE package) ", " (gobject-snippet--format-CLASS iface) ", " (gobject-snippet--format-PackageClass parent-package parent-class) ")
 156 "))
 157
 158 (defun gobject-snippet--insert-class-declaration (package
 159                                                   class
 160                                                   parent-package
 161                                                   parent-class
 162                                                   derivable)
 163   (insert "\
 164 #define " (gobject-snippet--format-PACKAGE package) "_TYPE_" (gobject-snippet--format-CLASS class) " (" (gobject-snippet--format-package_class package class) "_get_type ())
 165 G_DECLARE_" (if derivable "DERIVABLE" "FINAL") "_TYPE (" (gobject-snippet--format-PackageClass package class) ", "
 166 (gobject-snippet--format-package_class package class) ", " (gobject-snippet--format-PACKAGE package) ", " (gobject-snippet--format-CLASS class) ", " (gobject-snippet--format-PackageClass parent-package parent-class) ")
 167 "))
 168
 169 (defun gobject-snippet-insert-final-class-declaration (package
 170                                                      class
 171                                                      parent-package
 172                                                      parent-class)
 173   "Insert final class declaration for PACKAGE and CLASS."
 174   (interactive
 175    (append (gobject-snippet--read-package-and-class
 176             nil nil
 177             'gobject-snippet-package
 178             'gobject-snippet-class)
 179            (gobject-snippet--read-package-and-class
 180             "Parent package (CamelCase): "
 181             "Parent class (CamelCase): "
 182             'gobject-snippet-parent-package
 183             'gobject-snippet-parent-class)))
 184   (gobject-snippet--insert-class-declaration package
 185                                              class
 186                                              parent-package
 187                                              parent-class
 188                                              nil))
 189
 190 (defun gobject-snippet-insert-derivable-class-declaration (package
 191                                                          class
 192                                                          parent-package
 193                                                          parent-class)
 194   "Insert derivable class declaration for PACKAGE and CLASS."
 195   (interactive
 196    (append (gobject-snippet--read-package-and-class
 197             nil nil
 198             'gobject-snippet-package
 199             'gobject-snippet-class)
 200            (gobject-snippet--read-package-and-class
 201             "Parent package (CamelCase): "
 202             "Parent class (CamelCase): "
 203             'gobject-snippet-parent-package
 204             'gobject-snippet-parent-class)))
 205   (gobject-snippet--insert-class-declaration package
 206                                              class
 207                                              parent-package
 208                                              parent-class
 209                                              t))
 210
 211 (defun gobject-snippet-insert-interface-definition (package
 212                                                   iface
 213                                                   parent-package
 214                                                   parent-class)
 215   "Insert class definition for PACKAGE and CLASS."
 216   (interactive
 217    (append (gobject-snippet--read-package-and-class
 218             nil
 219             "Interface (CamelCase): "
 220             'gobject-snippet-package
 221             'gobject-snippet-class)
 222            (gobject-snippet--read-package-and-class
 223             "Parent package (CamelCase): "
 224             "Parent class (CamelCase): "
 225             'gobject-snippet-parent-package
 226             'gobject-snippet-parent-class)))
 227   (insert "\
 228 static void
 229 " (gobject-snippet--format-package_class package iface) "_default_init (" (gobject-snippet--format-PackageClass package iface) "Interface *iface) {
 230 }
 231
 232 G_DEFINE_INTERFACE (" (gobject-snippet--format-PackageClass package iface) ", "
 233 (gobject-snippet--format-package_class package iface) ", " (gobject-snippet--format-PACKAGE parent-package) "_TYPE_" (gobject-snippet--format-CLASS parent-class) ")
 234 "))
 235
 236 (defun gobject-snippet--insert-class-definition (package
 237                                                class
 238                                                parent-package
 239                                                parent-class
 240                                                abstract)
 241   (insert "\
 242 G_DEFINE_" (if abstract "ABSTRACT_" "") "TYPE (" (gobject-snippet--format-PackageClass package class) ", "
 243 (gobject-snippet--format-package_class package class) ", " (gobject-snippet--format-PACKAGE parent-package) "_TYPE_" (gobject-snippet--format-CLASS parent-class) ")
 244
 245 static void
 246 " (gobject-snippet--format-package_class package class) "_class_init (" (gobject-snippet--format-PackageClass package class) "Class *klass)
 247 {
 248 }
 249
 250 static void
 251 " (gobject-snippet--format-package_class package class) "_init (" (gobject-snippet--format-PackageClass package class) " *self)
 252 {
 253 }
 254 "))
 255
 256 (defun gobject-snippet-insert-class-definition (package
 257                                               class
 258                                               parent-package
 259                                               parent-class)
 260   "Insert class definition for PACKAGE and CLASS."
 261   (interactive
 262    (append (gobject-snippet--read-package-and-class
 263             nil nil
 264             'gobject-snippet-package
 265             'gobject-snippet-class)
 266            (gobject-snippet--read-package-and-class
 267             "Parent package (CamelCase): "
 268             "Parent class (CamelCase): "
 269             'gobject-snippet-parent-package
 270             'gobject-snippet-parent-class)))
 271   (gobject-snippet--insert-class-definition package
 272                                           class
 273                                           parent-package
 274                                           parent-class
 275                                           nil))
 276
 277 (defun gobject-snippet-insert-abstract-class-definition (package
 278                                                        class
 279                                                        parent-package
 280                                                        parent-class)
 281   "Insert abstract class definition for PACKAGE and CLASS."
 282   (interactive
 283    (append (gobject-snippet--read-package-and-class
 284             nil nil
 285             'gobject-snippet-package
 286             'gobject-snippet-class)
 287            (gobject-snippet--read-package-and-class
 288             "Parent package (CamelCase): "
 289             "Parent class (CamelCase): "
 290             'gobject-snippet-parent-package
 291             'gobject-snippet-parent-class)))
 292   (gobject-snippet--insert-class-definition package
 293                                           class
 294                                           parent-package
 295                                           parent-class
 296                                           t))
 297
 298 (defun gobject-snippet-insert-constructor (package class)
 299   "Insert 'constructor' vfunc of GObjectClass for PACKAGE and CLASS."
 300   (interactive
 301    (gobject-snippet--read-package-and-class
 302     nil nil
 303     'gobject-snippet-package
 304     'gobject-snippet-class))
 305   (let (arglist-start body-start)
 306     (insert "\
 307 static GObject *
 308 " (gobject-snippet--format-package_class package class) "_constructor (")
 309     (setq arglist-start (point-marker))
 310     (insert "GType *object,
 311 guint n_construct_properties,
 312 GObjectConstructParam *construct_properties")
 313     (funcall (if gobject-snippet-align-arglist
 314                  #'gobject-align-arglist-region
 315                #'indent-region)
 316              arglist-start (point))
 317     (insert ")\n")
 318     (setq body-start (point-marker))
 319     (insert "{
 320   " (gobject-snippet--format-PackageClass package class) " *self = "
 321   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 322
 323   G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) "_parent_class)->constructed (object);
 324 }
 325 ")
 326     (indent-region body-start (point))))
 327
 328 (defun gobject-snippet-insert-set_property (package class)
 329   "Insert 'set_property' vfunc of GObjectClass for PACKAGE and CLASS."
 330   (interactive
 331    (gobject-snippet--read-package-and-class
 332     nil nil
 333     'gobject-snippet-package
 334     'gobject-snippet-class))
 335   (let (arglist-start body-start)
 336     (insert "\
 337 static void
 338 " (gobject-snippet--format-package_class package class) "_set_property (")
 339     (setq arglist-start (point-marker))
 340     (insert "GObject *object,
 341 guint prop_id,
 342 const GValue *value,
 343 GParamSpec *pspec")
 344     (funcall (if gobject-snippet-align-arglist
 345                  #'gobject-align-arglist-region
 346                #'indent-region)
 347              arglist-start (point))
 348     (insert ")\n")
 349     (setq body-start (point-marker))
 350     (insert "{
 351   " (gobject-snippet--format-PackageClass package class) " *self = "
 352   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 353
 354   switch (prop_id)
 355     {
 356     default:
 357       G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
 358       break;
 359     }
 360 }
 361 ")
 362     (indent-region body-start (point))))
 363
 364 (defun gobject-snippet-insert-get_property (package class)
 365   "Insert 'get_property' vfunc of GObjectClass for PACKAGE and CLASS."
 366   (interactive
 367    (gobject-snippet--read-package-and-class
 368     nil nil
 369     'gobject-snippet-package
 370     'gobject-snippet-class))
 371   (let (arglist-start body-start)
 372     (insert "\
 373 static void
 374 " (gobject-snippet--format-package_class package class) "_get_property (")
 375     (setq arglist-start (point-marker))
 376     (insert "GObject *object,
 377 guint prop_id,
 378 GValue *value,
 379 GParamSpec *pspec")
 380     (funcall (if gobject-snippet-align-arglist
 381                  #'gobject-align-arglist-region
 382                #'indent-region)
 383              arglist-start (point))
 384     (insert ")\n")
 385     (setq body-start (point-marker))
 386     (insert "{
 387   " (gobject-snippet--format-PackageClass package class) " *self = "
 388 (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 389
 390   switch (prop_id)
 391     {
 392     default:
 393       G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
 394       break;
 395     }
 396 }
 397 ")
 398     (indent-region body-start (point))))
 399
 400 (defun gobject-snippet-insert-dispose (package class)
 401   "Insert 'dispose' vfunc of GObjectClass for PACKAGE and CLASS."
 402   (interactive
 403    (gobject-snippet--read-package-and-class
 404     nil nil
 405     'gobject-snippet-package
 406     'gobject-snippet-class))
 407   (let (body-start)
 408     (insert "\
 409 static void
 410 " (gobject-snippet--format-package_class package class) "_dispose (GObject *object)\n")
 411     (setq body-start (point-marker))
 412     (insert "{
 413   " (gobject-snippet--format-PackageClass package class) " *self = "
 414   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 415
 416   G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) "_parent_class)->dispose (object);
 417 }
 418 ")
 419     (indent-region body-start (point))))
 420
 421 (defun gobject-snippet-insert-finalize (package class)
 422   "Insert 'finalize' vfunc of GObjectClass for PACKAGE and CLASS."
 423   (interactive
 424    (gobject-snippet--read-package-and-class
 425     nil nil
 426     'gobject-snippet-package
 427     'gobject-snippet-class))
 428   (let (body-start)
 429     (insert "\
 430 static void
 431 " (gobject-snippet--format-package_class package class) "_finalize (GObject *object)\n")
 432     (setq body-start (point-marker))
 433     (insert "{
 434   " (gobject-snippet--format-PackageClass package class) " *self = "
 435   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 436
 437   G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) "_parent_class)->finalize (object);
 438 }
 439 ")
 440     (indent-region body-start (point))))
 441
 442 (defun gobject-snippet-insert-notify (package class)
 443   "Insert 'notify' vfunc of GObjectClass for PACKAGE and CLASS."
 444   (interactive
 445    (gobject-snippet--read-package-and-class
 446     nil nil
 447     'gobject-snippet-package
 448     'gobject-snippet-class))
 449   (let (body-start)
 450     (insert "\
 451 static void
 452 " (gobject-snippet--format-package_class package class) "_notify (GObject *object)\n")
 453     (setq body-start (point-marker))
 454     (insert "{
 455   " (gobject-snippet--format-PackageClass package class) " *self = "
 456   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 457
 458   G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) "_parent_class)->finalize (object);
 459 }
 460 ")
 461     (indent-region body-start (point))))
 462
 463 (defun gobject-snippet-insert-constructed (package class)
 464   "Insert 'constructed' vfunc of GObjectClass for PACKAGE and CLASS."
 465   (interactive
 466    (gobject-snippet--read-package-and-class
 467     nil nil
 468     'gobject-snippet-package
 469     'gobject-snippet-class))
 470   (let (body-start)
 471     (insert "\
 472 static void
 473 " (gobject-snippet--format-package_class package class) "_constructed (GObject *object)\n")
 474     (setq body-start (point-marker))
 475     (insert "{
 476   " (gobject-snippet--format-PackageClass package class) " *self = "
 477   (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
 478
 479   G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) "_parent_class)->constructed (object);
 480 }
 481 ")
 482     (indent-region body-start (point))))
 483
 484 (defvar gobject-snippet-snippet-commands
 485   '(("G_DECLARE_INTERFACE" . gobject-snippet-insert-interface-declaration)
 486     ("G_DECLARE_FINAL_TYPE" . gobject-snippet-insert-final-class-declaration)
 487     ("G_DECLARE_DERIVABLE_TYPE" .
 488      gobject-snippet-insert-derivable-class-declaration)
 489     ("G_DEFINE_INTERFACE" . gobject-snippet-insert-interface-definition)
 490     ("G_DEFINE_TYPE" . gobject-snippet-insert-class-definition)
 491     ("G_DEFINE_ABSTRACT_TYPE" .
 492      gobject-snippet-insert-abstract-class-definition)
 493     ("GObjectClass.constructor" . gobject-snippet-insert-constructor)
 494     ("GObjectClass.set_property" . gobject-snippet-insert-set_property)
 495     ("GObjectClass.get_property" . gobject-snippet-insert-get_property)
 496     ("GObjectClass.dispose" . gobject-snippet-insert-dispose)
 497     ("GObjectClass.finalize" . gobject-snippet-insert-finalize)
 498     ;; GObjectClass.dispatch_properties_changed
 499     ("GObjectClass.notify" . gobject-snippet-insert-notify)
 500     ("GObjectClass.contructed" . gobject-snippet-insert-constructed)))
 501
 502 ;;;###autoload
 503 (defun gobject-snippet-insert (snippet)
 504   (interactive
 505    (list (completing-read "Snippet: " gobject-snippet-snippet-commands nil t)))
 506   (let ((entry (assoc snippet gobject-snippet-snippet-commands)))
 507     (unless entry
 508       (error "Unknown snippet: %s" snippet))
 509     (call-interactively (cdr entry))))
 510
 511 (provide 'gobject-snippet)
 512
 513 ;;; gobject-snippet.el ends here