emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 1ad58dc 01/40: Initial import


From: Daiki Ueno
Subject: [elpa] master 1ad58dc 01/40: Initial import
Date: Fri, 22 Jan 2016 22:48:33 +0000

branch: master
commit 1ad58dc1db1bd6e956ad2e3e3ebf8ce28849f639
Author: Daiki Ueno <address@hidden>
Commit: Daiki Ueno <address@hidden>

    Initial import
---
 .gitignore            |    2 +
 Makefile              |   12 ++
 README.md             |   34 ++++
 gobject-align.el      |  422 ++++++++++++++++++++++++++++++++++++++++
 gobject-minor-mode.el |   57 ++++++
 gobject-snippet.el    |  513 +++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 1040 insertions(+), 0 deletions(-)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..7c5214c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+*.elc
+
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..9dc59b1
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,12 @@
+EMACS ?= emacs
+RM ?= rm
+ELC = gobject-align.elc gobject-snippet.elc gobject-minor-mode.elc
+
+all: $(ELC)
+
+%.elc: %.el
+       $(EMACS) -Q -batch --eval "(setq load-path (cons nil load-path))" \
+               -f batch-byte-compile $<
+
+clean:
+       $(RM) -rf $(ELC)
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..3da5fb6
--- /dev/null
+++ b/README.md
@@ -0,0 +1,34 @@
+gobject-minor-mode --- Emacs minor mode for editing GObject C source code
+======
+
+In the C coding style widely used in GNOME, identifiers are written in
+camel case and function arguments are aligned to the right end.  That
+makes it a bit cumbersome to keep your code consistent with the style
+with ordinary editor commands.
+
+gobject-minor-mode is an Emacs minor mode intended to help editing C
+source code in that style.  It mainly provides two features: text
+alignment and snippet insersion.
+
+Install
+------
+
+* Type "make"
+* Copy .elc files somewhere in your load-path
+* Add the following lines to ~/.emacs/init.el:
+
+```
+(autoload 'gobject-minor-mode "gobject-minor-mode" "GObject minor mode" t)
+(add-hook 'c-mode-hook 'gobject-minor-mode)
+```
+
+Usage
+------
+
+* To align argument list at point: C-c C-g a
+* To align function declarations in the current region: C-c C-g f
+
+* To insert "module_object": C-c C-g c
+* To insert "MODULE_OBJECT": C-c C-g C
+* To insert "ModuleObject": C-c C-g C-c
+* To insert custom snippets: C-c C-g s
diff --git a/gobject-align.el b/gobject-align.el
new file mode 100644
index 0000000..4ab82c0
--- /dev/null
+++ b/gobject-align.el
@@ -0,0 +1,422 @@
+;;; gobject-align.el --- GObject C code alignment
+;; Copyright (C) 2010,2011 Daiki Ueno <address@hidden>
+
+;; Author: Daiki Ueno <address@hidden>
+;; Keywords: GObject, C, coding style
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'cc-mode)
+(require 'regexp-opt)
+
+(defvar gobject-align-whitespace
+  " \f\t\n\r\v")
+
+(defvar gobject-align-max-line-width 80)
+
+(defun gobject-align--make-arg (type-start type-end arg-name-start 
arg-name-end)
+  (vector type-start type-end arg-name-start arg-name-end))
+
+(defun gobject-align--arg-type-start (arg)
+  (aref arg 0))
+
+(defun gobject-align--arg-arg-name-start (arg)
+  (aref arg 2))
+
+(defun gobject-align--arg-type-width (arg)
+  (- (gobject-align--arg-arg-name-start arg)
+     (gobject-align--arg-type-start arg)))
+
+(defun gobject-align--arglist-type-column-width (arglist)
+  (let ((width 0)
+       length)
+    (while arglist
+      (setq length (gobject-align--arg-type-width (car arglist)))
+      (if (> length width)
+         (setq width length))
+      (setq arglist (cdr arglist)))
+    width))
+
+(defun gobject-align--arglist-arg-name-column-width (arglist)
+  (let ((width 0)
+       length)
+    (while arglist
+      (setq length (- (aref (car arglist) 3) ;arg-name-end
+                     (gobject-align--arg-arg-name-start (car arglist))))
+      (if (> length width)
+         (setq width length))
+      (setq arglist (cdr arglist)))
+    width))
+
+(defun gobject-align--parse-arglist (beg end)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (let (type-start
+           type-end
+           arg-name-start
+           arg-name-end
+           arg
+           arglist
+           point)
+       (goto-char (point-min))
+       (while (and (not (eobp))
+                   (setq type-start (point-marker))
+                   (if (prog1 (re-search-forward
+                               (concat
+                                "["
+                                (regexp-quote gobject-align-whitespace)
+                                "]*,["
+                                (regexp-quote gobject-align-whitespace)
+                                "]*")
+                               nil 'noerror)
+                         (setq point (point)))
+                       (goto-char (match-beginning 0))
+                     (goto-char (point-max))))
+         (setq arg-name-end (point-marker))
+         (c-backward-token-1)
+         (setq arg-name-start (point-marker))
+         (skip-chars-backward (concat gobject-align-whitespace "*"))
+         (setq type-end (point-marker))
+         (setq arg (gobject-align--make-arg type-start type-end
+                                            arg-name-start arg-name-end)
+               arglist (cons arg arglist))
+         (goto-char point))
+       arglist))))
+
+(defun gobject-align--make-func-decl (type-start type-end
+                                                func-name-start func-name-end
+                                                arglist-start arglist-end
+                                                func-decl-end
+                                                arglist)
+  (vector type-start type-end func-name-start func-name-end
+         arglist-start arglist-end func-decl-end arglist))
+
+(defun gobject-align--func-decl-start (func-decl)
+  (aref func-decl 0))
+
+(defun gobject-align--func-decl-func-name-start (func-decl)
+  (aref func-decl 2))
+
+(defun gobject-align--func-decl-func-name-end (func-decl)
+  (aref func-decl 3))
+
+(defun gobject-align--func-decl-arglist-start (func-decl)
+  (aref func-decl 4))
+
+(defun gobject-align--func-decl-arglist-end (func-decl)
+  (aref func-decl 5))
+
+(defun gobject-align--func-decl-end (func-decl)
+  (aref func-decl 6))
+
+(defun gobject-align--func-decl-arglist (func-decl)
+  (aref func-decl 7))
+
+(defun gobject-align--func-decl-type-width (func-decl)
+  (- (gobject-align--func-decl-func-name-start func-decl)
+     (gobject-align--func-decl-start func-decl)))
+
+(defun gobject-align--func-decl-func-name-width (func-decl)
+  (- (gobject-align--func-decl-arglist-start func-decl)
+     (gobject-align--func-decl-func-name-start func-decl)))
+
+(defun gobject-align--func-decls-type-column-width (func-decls)
+  (let ((width 0)
+       length)
+    (while func-decls
+      (setq length (gobject-align--func-decl-type-width (car func-decls)))
+      (if (> length width)
+         (setq width length))
+      (setq func-decls (cdr func-decls)))
+    width))
+
+(defun gobject-align--func-decls-func-name-column-width (func-decls
+                                                        start-column
+                                                        arglist-column-width)
+  (let ((width 0)
+       length)
+    (while func-decls
+      (setq length (gobject-align--func-decl-func-name-width (car func-decls)))
+
+      (if (and (<= (+ start-column
+                     length
+                     arglist-column-width)
+                  gobject-align-max-line-width)
+              (> length width))
+         (setq width length))
+      (setq func-decls (cdr func-decls)))
+    width))
+
+(defun gobject-align--func-decls-arglist-type-column-width (func-decls)
+  (let ((width 0)
+       arglist-type-column-width)
+    (while func-decls
+      (setq arglist-type-column-width
+           (gobject-align--arglist-type-column-width
+            (gobject-align--func-decl-arglist (car func-decls))))
+      (if (> arglist-type-column-width width)
+         (setq width arglist-type-column-width))
+      (setq func-decls (cdr func-decls)))
+    width))
+
+(defun gobject-align--func-decls-arglist-arg-name-column-width (func-decls)
+  (let ((width 0)
+       arglist-arg-name-column-width)
+    (while func-decls
+      (setq arglist-arg-name-column-width
+           (gobject-align--arglist-arg-name-column-width
+            (gobject-align--func-decl-arglist (car func-decls))))
+      (if (> arglist-arg-name-column-width width)
+         (setq width arglist-arg-name-column-width))
+      (setq func-decls (cdr func-decls)))
+    width))
+
+(defun gobject-align--parse-func-decl (beg end)
+  ;; Parse one func-decl in BEG END.  BEG and END must point to the
+  ;; beginning/end of the func-decl.
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (goto-char (point-max))
+      (let (arglist-start
+           arglist-end
+           func-name-start
+           func-name-end)
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;                              ^
+       (unless (looking-back (concat "["
+                                     (regexp-quote gobject-align-whitespace)
+                                     "]*\\(?:[A-Z_]*\\>["
+                                     (regexp-quote gobject-align-whitespace)
+                                     "]*\\)*["
+                                     (regexp-quote gobject-align-whitespace)
+                                     "]*;["
+                                     (regexp-quote gobject-align-whitespace)
+                                     "]*")
+                             nil
+                             t)
+         (error "No func-decl at point"))
+       (goto-char (match-beginning 0))
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;                ^
+       (unless (eq (char-before) ?\))
+         (error "No arglist at point"))
+       (setq arglist-end (point-marker))
+       (c-backward-sexp)               ;skip arglist
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;          ^
+       (setq arglist-start (point-marker))
+       (skip-chars-backward gobject-align-whitespace)
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;        ^
+       (setq func-name-end (point-marker))
+       ;;(c-backward-token-2)
+       (c-backward-sexp)               ;may be either an identifier
+                                       ;or a pointer
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;      ^
+       (setq func-name-start (point-marker))
+       (skip-chars-backward (concat gobject-align-whitespace "*"))
+       ;; foo *bar (baz a) G_GNUC_CONST;
+       ;;   ^
+       (gobject-align--make-func-decl (point-min-marker) (point-marker)
+                                      func-name-start func-name-end
+                                      arglist-start arglist-end
+                                      (point-max-marker)
+                                      (gobject-align--parse-arglist
+                                       (1+ arglist-start)
+                                       (1- arglist-end)))))))
+
+(defun gobject-align--normalize-arglist (beg end)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (goto-char (point-min))
+      (while (re-search-forward (concat "["
+                                       (regexp-quote gobject-align-whitespace)
+                                       "]+")
+                               nil t)
+       (replace-match " "))
+      (goto-char (point-min))
+      (while (re-search-forward " *, *" nil t)
+       (replace-match ",\n")))))
+
+(defun gobject-align--normalize-func-decl (beg end)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (goto-char (point-min))
+      (while (re-search-forward (concat "["
+                                       (regexp-quote gobject-align-whitespace)
+                                       "]+")
+                               nil t)
+       (replace-match " ")))))
+
+(defun gobject-align--indent-identifier-to-column (column)
+  (when (looking-back "\*+" nil t)
+    (setq column (- column (- (match-end 0) (match-beginning 0))))
+    (goto-char (match-beginning 0)))
+  (let (indent-tabs-mode)
+    (indent-to-column column)))
+
+(defun gobject-align--expand-region-to-arglist-extent (beg end)
+  (setq beg (save-excursion
+             (goto-char beg)
+             (c-beginning-of-decl-1)
+             (point))
+       end (save-excursion
+             (goto-char end)
+             (c-end-of-decl-1)
+             (point)))
+  (unless (and (eq (char-before beg) ?\()
+              (eq (char-after end) ?\)))
+    (error "No arglist around point"))
+  (list beg end))
+
+(defun gobject-align-arglist-region (beg end &optional type-column-width)
+  "Reformat argument list in the region between BEG and END.
+It applies proper alignment rule."
+  (interactive (apply #'gobject-align--expand-region-to-arglist-extent
+                     (if (region-active-p)
+                         (list (region-beginning) (region-end))
+                       (list (point) (point)))))
+  (save-excursion
+    (let ((indent-level (progn (goto-char beg) (current-column)))
+         arg
+         arglist
+         column)
+      (save-restriction
+       (narrow-to-region beg end)
+       (setq arglist (gobject-align--parse-arglist (point-min) (point-max)))
+       ;; This may move markers in arglist.
+       (gobject-align--normalize-arglist (point-min) (point-max))
+       (unless type-column-width
+         (setq type-column-width (gobject-align--arglist-type-column-width
+                                  arglist)))
+       (while arglist
+         (setq arg (car arglist))
+         (goto-char (gobject-align--arg-type-start arg))
+         (if (bobp)
+             (setq column 0)
+           (setq column indent-level))
+         (gobject-align--indent-identifier-to-column column)
+         ;; Don't indent for no-arg-name arg.
+         (unless (= (gobject-align--arg-type-start arg)
+                    (gobject-align--arg-arg-name-start arg))
+           (setq column (+ column type-column-width))
+           (goto-char (gobject-align--arg-arg-name-start arg))
+           (gobject-align--indent-identifier-to-column column))
+         (setq arglist (cdr arglist)))))))
+
+(defun gobject-align-func-decls-region (beg end)
+  "Reformat function declarations in the region between BEG and END.
+It applies proper alignment rule."
+  (interactive "r")
+  (save-excursion
+    (let ((indent-level (save-excursion
+                         (goto-char beg)
+                         (skip-chars-forward gobject-align-whitespace)
+                         (current-column)))
+         func-decl-end
+         func-decl
+         func-decls
+         pointer
+         func-name-width
+         type-column-width
+         func-name-column-width
+         arglist-type-column-width
+         arglist-arg-name-column-width
+         arglist-column-width
+         column)
+      (save-restriction
+       (narrow-to-region beg end)
+       (goto-char (point-min))
+       (while (search-forward ";" nil t)
+         ;; XXX: Should skip non-func-decl statements.
+         (setq func-decl-end (point-marker))
+         (c-beginning-of-statement-1)
+         (setq func-decl (gobject-align--parse-func-decl (point-marker)
+                                                         func-decl-end)
+               func-decls (cons func-decl func-decls))
+         (goto-char func-decl-end))
+       ;; This may move markers in func-decls.
+       (setq pointer func-decls)
+       (while pointer
+         (setq func-decl (car pointer))
+         (gobject-align--normalize-func-decl
+          (gobject-align--func-decl-start func-decl)
+          (gobject-align--func-decl-end func-decl))
+         (setq pointer (cdr pointer)))
+       (setq type-column-width
+             (gobject-align--func-decls-type-column-width func-decls)
+             arglist-type-column-width
+             (gobject-align--func-decls-arglist-type-column-width func-decls)
+             arglist-arg-name-column-width
+             (gobject-align--func-decls-arglist-arg-name-column-width
+              func-decls)
+             arglist-column-width
+             (+ arglist-type-column-width
+                arglist-arg-name-column-width
+                3)                     ;(length "();")
+             func-name-column-width
+             (gobject-align--func-decls-func-name-column-width
+              func-decls
+              (+ indent-level
+                 type-column-width)
+              arglist-column-width))
+       (setq pointer func-decls)
+       (while pointer
+         (setq func-decl (car pointer))
+         (goto-char (gobject-align--func-decl-start func-decl))
+         (setq column indent-level)
+         (gobject-align--indent-identifier-to-column column)
+         ;; Align type column.
+         (setq func-name-width
+               (- (gobject-align--func-decl-func-name-end func-decl)
+                  (gobject-align--func-decl-func-name-start func-decl)))
+         (if (> (+ column type-column-width func-name-width)
+                gobject-align-max-line-width)
+             (setq column
+                   (+ column
+                      (gobject-align--func-decl-type-width func-decl)))
+           (setq column (+ column type-column-width)))
+         (goto-char (gobject-align--func-decl-func-name-start func-decl))
+         (gobject-align--indent-identifier-to-column column)
+         ;; Align func-name column.
+         (when (> (- (gobject-align--func-decl-func-name-end func-decl)
+                     (point))
+                  func-name-column-width)
+           (goto-char (gobject-align--func-decl-func-name-end func-decl))
+           (insert "\n")
+           (setq column (+ indent-level type-column-width)))
+         (setq column (+ column func-name-column-width))
+         (goto-char (gobject-align--func-decl-arglist-start func-decl))
+         (gobject-align--indent-identifier-to-column column)
+         ;; Align arglist.
+         (gobject-align-arglist-region
+          (1+ (point-marker))
+          (1- (gobject-align--func-decl-arglist-end
+               func-decl))
+          arglist-type-column-width)
+         (setq pointer (cdr pointer)))))))
+
+(provide 'gobject-align)
+
+;;; gobject-align.el ends here
diff --git a/gobject-minor-mode.el b/gobject-minor-mode.el
new file mode 100644
index 0000000..f61bfc6
--- /dev/null
+++ b/gobject-minor-mode.el
@@ -0,0 +1,57 @@
+;;; gobject-minor-mode.el --- minor mode for editing GObject-based C source 
code
+;; Copyright (C) 2010,2011,2016 Daiki Ueno <address@hidden>
+
+;; Author: Daiki Ueno <address@hidden>
+;; Keywords: GObject, C, coding style
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(autoload 'gobject-align-arglist-region "gobject-align")
+(autoload 'gobject-align-func-decls-region "gobject-align")
+(autoload 'gobject-snippet-insert-package_class "gobject-snippet")
+(autoload 'gobject-snippet-insert-PACKAGE_CLASS "gobject-snippet")
+(autoload 'gobject-snippet-insert-PackageClass "gobject-snippet")
+(autoload 'gobject-snippet-insert-interface-declation "gobject-snippet")
+(autoload 'gobject-snippet-insert-class-declation "gobject-snippet")
+(autoload 'gobject-snippet-insert-set_property "gobject-snippet")
+(autoload 'gobject-snippet-insert-get_property "gobject-snippet")
+(autoload 'gobject-snippet-insert-dispose "gobject-snippet")
+(autoload 'gobject-snippet-insert-finalize "gobject-snippet")
+(autoload 'gobject-snippet-insert-notify "gobject-snippet")
+(autoload 'gobject-snippet-insert-constructed "gobject-snippet")
+(autoload 'gobject-snippet-insert "gobject-snippet")
+
+(defvar gobject-minor-mode-map
+  (let ((keymap (make-sparse-keymap)))
+    (define-key keymap "\C-c\C-ga" 'gobject-align-arglist-region)
+    (define-key keymap "\C-c\C-gf" 'gobject-align-func-decls-region)
+    (define-key keymap "\C-c\C-gc" 'gobject-snippet-insert-package_class)
+    (define-key keymap "\C-c\C-gC" 'gobject-snippet-insert-PACKAGE_CLASS)
+    (define-key keymap "\C-c\C-g\C-c" 'gobject-snippet-insert-PackageClass)
+    (define-key keymap "\C-c\C-gs" 'gobject-snippet-insert)
+    keymap))
+
+;;;###autoload
+(define-minor-mode gobject-minor-mode
+  "A minor-mode for editing GObject-based C source code."
+  nil " GObject" gobject-minor-mode-map)
+
+(provide 'gobject-c-mode)
+
+;;; gobject-c-mode.el ends here
diff --git a/gobject-snippet.el b/gobject-snippet.el
new file mode 100644
index 0000000..cbf4fa6
--- /dev/null
+++ b/gobject-snippet.el
@@ -0,0 +1,513 @@
+;;; gobject-snippet.el --- GObject C code generation
+;; Copyright (C) 2016 Daiki Ueno <address@hidden>
+
+;; Author: Daiki Ueno <address@hidden>
+;; Keywords: GObject, C, coding style
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'gobject-align)
+
+(eval-when-compile
+  (require 'subword))
+
+(declare-function subword-forward "subword.el" (&optional arg))
+
+(defvar gobject-snippet-package nil)
+(make-variable-buffer-local 'gobject-snippet-package)
+
+(defvar gobject-snippet-class nil)
+(make-variable-buffer-local 'gobject-snippet-class)
+
+(defvar gobject-snippet-parent-package nil)
+(make-variable-buffer-local 'gobject-snippet-parent-package)
+
+(defvar gobject-snippet-parent-class nil)
+(make-variable-buffer-local 'gobject-snippet-parent-class)
+
+(defvar gobject-snippet-align-arglist nil)
+(make-variable-buffer-local 'gobject-snippet-align-arglist)
+
+(defun gobject-snippet--parse-name (name)
+  (require 'subword)
+  (with-temp-buffer
+    (let (words)
+      (insert name)
+      (goto-char (point-min))
+      (while (not (eobp))
+       ;; Skip characters not recognized by subword-mode.
+       (if (looking-at "[^[:lower:][:upper:][:digit:]]+")
+           (goto-char (match-end 0)))
+       (push (buffer-substring (point) (progn (subword-forward 1)
+                                              (point)))
+             words))
+      (nreverse words))))
+
+(defun gobject-snippet--read-package-and-class (package-prompt
+                                               class-prompt
+                                               package-symbol
+                                               class-symbol)
+  (when (or current-prefix-arg
+           (not (and (symbol-value package-symbol)
+                     (symbol-value class-symbol))))
+    (set package-symbol
+        (gobject-snippet--parse-name
+         (read-string (or package-prompt
+                          "Package (CamelCase): ")
+                      (if (symbol-value package-symbol)
+                          (gobject-snippet--format-Package
+                           (symbol-value package-symbol))))))
+    (set class-symbol
+        (gobject-snippet--parse-name
+         (read-string (or class-prompt
+                          "Class (CamelCase): ")
+                      (if (symbol-value class-symbol)
+                          (gobject-snippet--format-Class
+                           (symbol-value class-symbol)))))))
+  (list (symbol-value package-symbol) (symbol-value class-symbol)))
+
+(defun gobject-snippet--format-PACKAGE (package)
+  (mapconcat #'upcase package "_"))
+(defalias 'gobject-snippet--format-CLASS 'gobject-snippet--format-PACKAGE)
+
+(defun gobject-snippet--format-PACKAGE_CLASS (package class)
+  (concat (gobject-snippet--format-PACKAGE package)
+         "_"
+         (gobject-snippet--format-CLASS class)))
+
+(defun gobject-snippet--format-package (package)
+  (mapconcat #'downcase package "_"))
+(defalias 'gobject-snippet--format-class 'gobject-snippet--format-package)
+
+(defun gobject-snippet--format-package_class (package class)
+  (concat (gobject-snippet--format-package package)
+         "_"
+         (gobject-snippet--format-class class)))
+
+(defun gobject-snippet--format-Package (package)
+  (mapconcat #'identity package ""))
+(defalias 'gobject-snippet--format-Class 'gobject-snippet--format-Package)
+
+(defun gobject-snippet--format-PackageClass (package class)
+  (concat (gobject-snippet--format-Package package)
+         (gobject-snippet--format-Class class)))
+
+;;;###autoload
+(defun gobject-snippet-insert-package_class (package class)
+  "Insert the class name before the current point."
+  (interactive (gobject-snippet--read-package-and-class
+               nil nil
+               'gobject-snippet-package
+               'gobject-snippet-class))
+  (insert (gobject-snippet--format-package_class package class)))
+
+;;;###autoload
+(defun gobject-snippet-insert-PACKAGE_CLASS (package class)
+  "Insert the class name before the current point."
+  (interactive (gobject-snippet--read-package-and-class
+               nil nil
+               'gobject-snippet-package
+               'gobject-snippet-class))
+  (insert (gobject-snippet--format-PACKAGE_CLASS package class)))
+
+;;;###autoload
+(defun gobject-snippet-insert-PackageClass (package class)
+  "Insert the class name (in CamelCase) before the current point."
+  (interactive (gobject-snippet--read-package-and-class
+               nil nil
+               'gobject-snippet-package
+               'gobject-snippet-class))
+  (insert (gobject-snippet--format-PackageClass package class)))
+
+(defun gobject-snippet-insert-interface-declaration (package iface
+                                                            parent-package 
parent-class)
+  "Insert interface declaration for PACKAGE and IFACE"
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil
+           "Interface (CamelCase): "
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (insert "\
+#define " (gobject-snippet--format-PACKAGE package) "_TYPE_" 
(gobject-snippet--format-CLASS iface) " (" (gobject-snippet--format-package 
package) "_" (gobject-snippet--format-class iface) "_get_type ())
+G_DECLARE_INTERFACE (" (gobject-snippet--format-PackageClass package iface) ", 
"
+(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) 
")
+"))
+
+(defun gobject-snippet--insert-class-declaration (package
+                                                 class
+                                                 parent-package
+                                                 parent-class
+                                                 derivable)
+  (insert "\
+#define " (gobject-snippet--format-PACKAGE package) "_TYPE_" 
(gobject-snippet--format-CLASS class) " (" 
(gobject-snippet--format-package_class package class) "_get_type ())
+G_DECLARE_" (if derivable "DERIVABLE" "FINAL") "_TYPE (" 
(gobject-snippet--format-PackageClass package class) ", "
+(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) 
")
+"))
+
+(defun gobject-snippet-insert-final-class-declaration (package
+                                                    class
+                                                    parent-package
+                                                    parent-class)
+  "Insert final class declaration for PACKAGE and CLASS."
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil nil
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (gobject-snippet--insert-class-declaration package
+                                            class
+                                            parent-package
+                                            parent-class
+                                            nil))
+
+(defun gobject-snippet-insert-derivable-class-declaration (package
+                                                        class
+                                                        parent-package
+                                                        parent-class)
+  "Insert derivable class declaration for PACKAGE and CLASS."
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil nil
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (gobject-snippet--insert-class-declaration package
+                                            class
+                                            parent-package
+                                            parent-class
+                                            t))
+
+(defun gobject-snippet-insert-interface-definition (package
+                                                 iface
+                                                 parent-package
+                                                 parent-class)
+  "Insert class definition for PACKAGE and CLASS."
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil
+           "Interface (CamelCase): "
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (insert "\
+static void
+" (gobject-snippet--format-package_class package iface) "_default_init (" 
(gobject-snippet--format-PackageClass package iface) "Interface *iface) {
+}
+
+G_DEFINE_INTERFACE (" (gobject-snippet--format-PackageClass package iface) ", "
+(gobject-snippet--format-package_class package iface) ", " 
(gobject-snippet--format-PACKAGE parent-package) "_TYPE_" 
(gobject-snippet--format-CLASS parent-class) ")
+"))
+
+(defun gobject-snippet--insert-class-definition (package
+                                              class
+                                              parent-package
+                                              parent-class
+                                              abstract)
+  (insert "\
+G_DEFINE_" (if abstract "ABSTRACT_" "") "TYPE (" 
(gobject-snippet--format-PackageClass package class) ", "
+(gobject-snippet--format-package_class package class) ", " 
(gobject-snippet--format-PACKAGE parent-package) "_TYPE_" 
(gobject-snippet--format-CLASS parent-class) ")
+
+static void
+" (gobject-snippet--format-package_class package class) "_class_init (" 
(gobject-snippet--format-PackageClass package class) "Class *klass)
+{
+}
+
+static void
+" (gobject-snippet--format-package_class package class) "_init (" 
(gobject-snippet--format-PackageClass package class) " *self)
+{
+}
+"))
+
+(defun gobject-snippet-insert-class-definition (package
+                                             class
+                                             parent-package
+                                             parent-class)
+  "Insert class definition for PACKAGE and CLASS."
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil nil
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (gobject-snippet--insert-class-definition package
+                                         class
+                                         parent-package
+                                         parent-class
+                                         nil))
+
+(defun gobject-snippet-insert-abstract-class-definition (package
+                                                      class
+                                                      parent-package
+                                                      parent-class)
+  "Insert abstract class definition for PACKAGE and CLASS."
+  (interactive
+   (append (gobject-snippet--read-package-and-class
+           nil nil
+           'gobject-snippet-package
+           'gobject-snippet-class)
+          (gobject-snippet--read-package-and-class
+           "Parent package (CamelCase): "
+           "Parent class (CamelCase): "
+           'gobject-snippet-parent-package
+           'gobject-snippet-parent-class)))
+  (gobject-snippet--insert-class-definition package
+                                         class
+                                         parent-package
+                                         parent-class
+                                         t))
+
+(defun gobject-snippet-insert-constructor (package class)
+  "Insert 'constructor' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (arglist-start body-start)
+    (insert "\
+static GObject *
+" (gobject-snippet--format-package_class package class) "_constructor (")
+    (setq arglist-start (point-marker))
+    (insert "GType *object,
+guint n_construct_properties,
+GObjectConstructParam *construct_properties")
+    (funcall (if gobject-snippet-align-arglist
+                #'gobject-align-arglist-region
+              #'indent-region)
+            arglist-start (point))
+    (insert ")\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) 
"_parent_class)->constructed (object);
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-set_property (package class)
+  "Insert 'set_property' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (arglist-start body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_set_property (")
+    (setq arglist-start (point-marker))
+    (insert "GObject *object,
+guint prop_id,
+const GValue *value,
+GParamSpec *pspec")
+    (funcall (if gobject-snippet-align-arglist
+                #'gobject-align-arglist-region
+              #'indent-region)
+            arglist-start (point))
+    (insert ")\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  switch (prop_id)
+    {
+    default:
+      G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
+      break;
+    }
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-get_property (package class)
+  "Insert 'get_property' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (arglist-start body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_get_property (")
+    (setq arglist-start (point-marker))
+    (insert "GObject *object,
+guint prop_id,
+GValue *value,
+GParamSpec *pspec")
+    (funcall (if gobject-snippet-align-arglist
+                #'gobject-align-arglist-region
+              #'indent-region)
+            arglist-start (point))
+    (insert ")\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+(gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  switch (prop_id)
+    {
+    default:
+      G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec);
+      break;
+    }
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-dispose (package class)
+  "Insert 'dispose' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_dispose (GObject 
*object)\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) 
"_parent_class)->dispose (object);
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-finalize (package class)
+  "Insert 'finalize' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_finalize (GObject 
*object)\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) 
"_parent_class)->finalize (object);
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-notify (package class)
+  "Insert 'notify' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_notify (GObject 
*object)\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) 
"_parent_class)->finalize (object);
+}
+")
+    (indent-region body-start (point))))
+
+(defun gobject-snippet-insert-constructed (package class)
+  "Insert 'constructed' vfunc of GObjectClass for PACKAGE and CLASS."
+  (interactive
+   (gobject-snippet--read-package-and-class
+    nil nil
+    'gobject-snippet-package
+    'gobject-snippet-class))
+  (let (body-start)
+    (insert "\
+static void
+" (gobject-snippet--format-package_class package class) "_constructed (GObject 
*object)\n")
+    (setq body-start (point-marker))
+    (insert "{
+  " (gobject-snippet--format-PackageClass package class) " *self = "
+  (gobject-snippet--format-PACKAGE_CLASS package class) " (object);
+
+  G_OBJECT_CLASS (" (gobject-snippet--format-package_class package class) 
"_parent_class)->constructed (object);
+}
+")
+    (indent-region body-start (point))))
+
+(defvar gobject-snippet-snippet-commands
+  '(("G_DECLARE_INTERFACE" . gobject-snippet-insert-interface-declaration)
+    ("G_DECLARE_FINAL_TYPE" . gobject-snippet-insert-final-class-declaration)
+    ("G_DECLARE_DERIVABLE_TYPE" .
+     gobject-snippet-insert-derivable-class-declaration)
+    ("G_DEFINE_INTERFACE" . gobject-snippet-insert-interface-definition)
+    ("G_DEFINE_TYPE" . gobject-snippet-insert-class-definition)
+    ("G_DEFINE_ABSTRACT_TYPE" .
+     gobject-snippet-insert-abstract-class-definition)
+    ("GObjectClass.constructor" . gobject-snippet-insert-constructor)
+    ("GObjectClass.set_property" . gobject-snippet-insert-set_property)
+    ("GObjectClass.get_property" . gobject-snippet-insert-get_property)
+    ("GObjectClass.dispose" . gobject-snippet-insert-dispose)
+    ("GObjectClass.finalize" . gobject-snippet-insert-finalize)
+    ;; GObjectClass.dispatch_properties_changed
+    ("GObjectClass.notify" . gobject-snippet-insert-notify)
+    ("GObjectClass.contructed" . gobject-snippet-insert-constructed)))
+
+;;;###autoload
+(defun gobject-snippet-insert (snippet)
+  (interactive
+   (list (completing-read "Snippet: " gobject-snippet-snippet-commands nil t)))
+  (let ((entry (assoc snippet gobject-snippet-snippet-commands)))
+    (unless entry
+      (error "Unknown snippet: %s" snippet))
+    (call-interactively (cdr entry))))
+
+(provide 'gobject-snippet)
+
+;;; gobject-snippet.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]