From: Daiki Ueno Date: Sun, 17 Jan 2016 02:13:55 +0000 (+0900) Subject: align: Add option to control max columns X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/b6e010da415a3441c866f4cd19533a78990e5d13 align: Add option to control max columns --- diff --git a/gnome-align.el b/gnome-align.el new file mode 100644 index 000000000..d84d0dbb5 --- /dev/null +++ b/gnome-align.el @@ -0,0 +1,492 @@ +;; gnome-align.el --- GNOME-style code alignment -*- lexical-binding: t; -*- +;; Copyright (C) 2016 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: GNOME, 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 +;; . + +;;; Code: + +(require 'cc-mode) +(require 'cl-lib) + +(defcustom gnome-align-max-column 80 + "Maximum number of columns per line." + :type '(choice (integer :tag "Columns") + (const :tag "No wrap")) + :group 'c) + +(defvar gnome-align-identifier-start-column nil) +(make-variable-buffer-local 'gnome-align-identifier-start-column) + +(defvar gnome-align-arglist-start-column nil) +(make-variable-buffer-local 'gnome-align-arglist-start-column) + +(defvar gnome-align-arglist-identifier-start-column nil) +(make-variable-buffer-local 'gnome-align-arglist-identifier-start-column) + +(cl-defstruct (gnome-align--argument + (:constructor nil) + (:constructor gnome-align--make-argument (type-start + type-end + identifier-start + identifier-end)) + (:copier nil) + (:predicate nil)) + (type-start nil :read-only t) + (type-end nil :read-only t) + (identifier-start nil :read-only t) + (identifier-end nil :read-only t)) + +(defun gnome-align--marker-column (marker) + (save-excursion + (goto-char marker) + (current-column))) + +(defun gnome-align--indent-to-column (column) + ;; Prefer 'char **foo' than 'char ** foo' + (when (looking-back "\*+" nil t) + (setq column (- column (- (match-end 0) (match-beginning 0)))) + (goto-char (match-beginning 0))) + ;; FIXME: should respect indent-tabs-mode? + (let (indent-tabs-mode) + (indent-to-column column))) + +(defun gnome-align--argument-type-width (arg) + (- (gnome-align--marker-column (gnome-align--argument-type-end arg)) + (gnome-align--marker-column (gnome-align--argument-type-start arg)))) + +(defun gnome-align--arglist-identifier-start-column (arglist start-column) + (let ((column start-column) + argument-column) + (dolist (argument arglist) + (setq argument-column (+ start-column + (gnome-align--argument-type-width argument))) + (when (gnome-align--argument-identifier-start argument) + (save-excursion + (goto-char (gnome-align--argument-identifier-start argument)) + (when (eq (preceding-char) ? ) + (setq argument-column (1+ argument-column))))) + (when (> argument-column column) + (setq column argument-column))) + column)) + +(defun gnome-align--argument-identifier-width (argument) + (if (gnome-align--argument-identifier-start argument) + (- (gnome-align--marker-column + (gnome-align--argument-identifier-end argument)) + (gnome-align--marker-column + (gnome-align--argument-identifier-start argument))) + 0)) + +(defun gnome-align--arglist-identifier-width (arglist) + (let ((width 0) + argument-width) + (dolist (argument arglist) + (setq argument-width (gnome-align--argument-identifier-width argument)) + (when (> argument-width width) + (setq width argument-width))) + width)) + +(defun gnome-align--normalize-arglist-region (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "\\s-+" nil t) + (replace-match " ")) + (goto-char (point-min)) + (while (re-search-forward "\\s-*," nil t) + (replace-match ",\n")) + (goto-char (point-min)) + (delete-trailing-whitespace) + ;; Remove whitespace at the beginning of line + (goto-char (point-min)) + (while (re-search-forward "^\\s-+" nil t) + (replace-match "")) + ;; Remove empty lines + (goto-char (point-min)) + (delete-matching-lines "^$")))) + +(defun gnome-align--parse-arglist (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let (type-start + type-end + identifier-start + identifier-end + arglist + last-token-start) + (goto-char (point-max)) + (while (not (bobp)) + (c-backward-syntactic-ws) + (setq identifier-end (point-marker)) + ;; Array argument, such as 'int a[]' + (if (eq (preceding-char) ?\]) + (c-backward-sexp)) + (c-backward-token-2) + (setq identifier-start (point-marker)) + (c-backward-syntactic-ws) + (if (or (bobp) (eq (preceding-char) ?,)) + ;; Identifier is omitted, or '...'. + (setq type-start identifier-start + type-end identifier-end + identifier-start nil + identifier-end nil) + (setq type-end (point-marker) + last-token-start type-end) + (while (and (not (bobp)) + (progn + (c-backward-token-2) + (unless (eq (char-after) ?,) + (setq last-token-start (point-marker))))) + (c-backward-syntactic-ws)) + (setq type-start last-token-start)) + (push (gnome-align--make-argument type-start type-end + identifier-start identifier-end) + arglist)) + arglist)))) + +;;;###autoload +(defun gnome-align-at-point (&optional identifier-start-column) + "Reformat argument list at point, aligning argument to the right end." + (interactive) + (save-excursion + (let* (start-column arglist) + (cl-destructuring-bind (beg end) + (gnome-align--arglist-region-at-point (point)) + (goto-char beg) + (setq start-column (current-column)) + (save-restriction + (narrow-to-region beg end) + (setq arglist (gnome-align--parse-arglist (point-min) (point-max))) + (gnome-align--normalize-arglist-region (point-min) (point-max)) + (unless identifier-start-column + (setq identifier-start-column + (gnome-align--arglist-identifier-start-column arglist 0))) + (dolist (argument arglist) + (goto-char (gnome-align--argument-type-start argument)) + (let ((column (if (bobp) 0 start-column))) + (when (not (bobp)) + (gnome-align--indent-to-column start-column)) + (when (gnome-align--argument-identifier-start argument) + (setq column (+ column identifier-start-column)) + (goto-char (gnome-align--argument-identifier-start argument)) + (gnome-align--indent-to-column column))))))))) + +(cl-defstruct (gnome-align--decl + (:constructor nil) + (:constructor gnome-align--make-decl (start + end + identifier-start + identifier-end + arglist-start + arglist-end + arglist)) + (:copier nil) + (:predicate nil)) + (start nil :read-only t) + (end nil :read-only t) + (identifier-start nil :read-only t) + (identifier-end nil :read-only t) + (arglist-start nil :read-only t) + (arglist-end nil :read-only t) + (arglist nil :read-only t)) + +(defun gnome-align--decls-identifier-start-column (decls start-column) + (let ((column start-column) + decl-column) + (dolist (decl decls) + (setq decl-column (+ start-column + (gnome-align--marker-column + (gnome-align--decl-identifier-start decl)))) + (when (and (or (null gnome-align-max-column) + (<= decl-column gnome-align-max-column)) + (> decl-column column)) + (setq column decl-column))) + column)) + +(defun gnome-align--decl-identifier-width (decl) + (- (gnome-align--marker-column + (gnome-align--decl-identifier-end decl)) + (gnome-align--marker-column + (gnome-align--decl-identifier-start decl)))) + +(defun gnome-align--decls-arglist-start-column (decls start-column) + (let ((column start-column) + decl-column + (arglist-width + (+ (gnome-align--decls-arglist-identifier-start-column decls 0) + (gnome-align--decls-arglist-identifier-width decls) + (length ");")))) + (dolist (decl decls) + (setq decl-column (+ start-column + (gnome-align--decl-identifier-width decl))) + (when (and (or (null gnome-align-max-column) + (<= (+ decl-column arglist-width) + gnome-align-max-column)) + (> decl-column column)) + (setq column decl-column))) + (1+ column))) + +(defun gnome-align--decls-arglist-identifier-width (decls) + (let ((width 0) + decl-width) + (dolist (decl decls) + (setq decl-width (gnome-align--arglist-identifier-width + (gnome-align--decl-arglist decl))) + (when (> decl-width width) + (setq width decl-width))) + width)) + +(defun gnome-align--decls-arglist-identifier-start-column (decls start-column) + (let ((column start-column) + decl-column) + (dolist (decl decls) + (setq decl-column (gnome-align--arglist-identifier-start-column + (gnome-align--decl-arglist decl) + start-column)) + ;; FIXME: should wrap lines inside argument list? + (when (> decl-column column) + (setq column decl-column))) + column)) + +(defun gnome-align--parse-decl (beg end) + ;; Parse at most one func declaration found in BEG END. + (save-excursion + (save-restriction + (narrow-to-region beg end) + (let (arglist-start + arglist-end + identifier-start + identifier-end + vfunc-p) + (goto-char (point-min)) + (c-forward-syntactic-ws) + (unless (looking-at + "typedef\\|#\\|G_\\(?:DECLARE\\|DEFINE\\)") + (while (and (not (eobp)) + (not (eq (char-after) ?\())) + (c-forward-token-2) + (c-forward-syntactic-ws)) + ;; Identifier is vfunc. + (when (looking-at "(\\s-*\\*") + (c-forward-sexp) + (c-forward-syntactic-ws) + (setq vfunc-p t)) + (when (eq (char-after) ?\() + (setq arglist-start (point-marker)) + (c-backward-syntactic-ws) + (setq identifier-end (point-marker)) + (if vfunc-p + (c-backward-sexp) + (c-backward-token-2)) + (setq identifier-start (point-marker)) + (goto-char arglist-start) + (c-forward-sexp) + (setq arglist-end (point-marker)) + (gnome-align--make-decl beg end + identifier-start identifier-end + arglist-start arglist-end + (gnome-align--parse-arglist + (1+ arglist-start) + (1- arglist-end))))))))) + +(defun gnome-align--normalize-decl (decl) + (save-excursion + (save-restriction + (narrow-to-region (gnome-align--decl-identifier-start decl) + (gnome-align--decl-arglist-end decl)) + (goto-char (point-min)) + (while (re-search-forward "\n" nil t) + (replace-match " "))) + (save-restriction + (narrow-to-region (gnome-align--decl-start decl) + (gnome-align--decl-end decl)) + (goto-char (point-min)) + (while (re-search-forward "\\s-+" nil t) + (replace-match " "))))) + +(defun gnome-align--arglist-region-at-point (point) + (save-excursion + (let (start) + (goto-char point) + (c-beginning-of-statement-1) + (c-backward-syntactic-ws) + (unless (eq ?\( (preceding-char)) + (error "No containing argument list")) + (setq start (point)) + (backward-char) + (condition-case nil + (c-forward-sexp) + (error + (error "No closing parenthesis"))) + (backward-char) + (list start (point))))) + +;;;###autoload +(defun gnome-align-set-column (symbol) + "Set alignment column of SYMBOL." + (interactive + (let ((symbol-name (completing-read "Symbol to change: " + '("identifier-start" + "arglist-start" + "arglist-identifier-start") + nil t))) + (list (intern (format "gnome-align-%s-column" symbol-name))))) + (set symbol (current-column))) + +(defun gnome-align--scan-decls (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (decls) + (while (not (eobp)) + (let (decl-start decl-end decl) + (c-forward-syntactic-ws) + (setq decl-start (point-marker)) + (c-end-of-statement) + (setq decl-end (point-marker)) + (setq decl (gnome-align--parse-decl decl-start decl-end)) + (when decl + (push decl decls)))) + decls)))) + +(defun gnome-align--compute-optimal-columns (beg end) + (let ((buffer (current-buffer)) + decls) + (with-temp-buffer + (insert-buffer-substring-no-properties buffer beg end) + (c-mode) + (setq decls (gnome-align--scan-decls (point-min) (point-max))) + (mapc #'gnome-align--normalize-decl decls) + (let* ((identifier-start-column + (gnome-align--decls-identifier-start-column + decls 0)) + (arglist-start-column + (gnome-align--decls-arglist-start-column + decls identifier-start-column)) + (arglist-identifier-start-column + (gnome-align--decls-arglist-identifier-start-column + decls (+ (length "(") arglist-start-column)))) + (list (cons 'identifier-start-column + identifier-start-column) + (cons 'arglist-start-column + arglist-start-column) + (cons 'arglist-identifier-start-column + arglist-identifier-start-column)))))) + +;;;###autoload +(defun gnome-align-compute-optimal-columns (beg end) + "Compute the optimal alignment rule from the declarations in BEG and END. + +This sets `gnome-align-identifier-start-column', +`gnome-align-arglist-start-column', and +`gnome-align-arglist-identifier-start-column'." + (interactive "r") + (let ((columns (gnome-align--compute-optimal-columns beg end))) + (setq gnome-align-identifier-start-column + (cdr (assq 'identifier-start-column columns)) + gnome-align-arglist-start-column + (cdr (assq 'arglist-start-column columns)) + gnome-align-arglist-identifier-start-column + (cdr (assq 'arglist-identifier-start-column columns))) + (message + "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d" + gnome-align-identifier-start-column + gnome-align-arglist-start-column + gnome-align-arglist-identifier-start-column))) + +;;;###autoload +(defun gnome-align-guess-columns (beg end) + "Guess the existing alignment rule from the declarations in BEG and END. + +This sets `gnome-align-identifier-start-column', +`gnome-align-arglist-start-column', and +`gnome-align-arglist-identifier-start-column'." + (interactive "r") + (let ((decls (gnome-align--scan-decls beg end)) + arglist) + (unless decls + (error "No function declaration in the region")) + (setq arglist (gnome-align--parse-arglist + (1+ (gnome-align--decl-arglist-start (car decls))) + (1- (gnome-align--decl-arglist-end (car decls))))) + (unless arglist + (error "Empty argument list")) + (unless (gnome-align--argument-identifier-start (car arglist)) + (error "No identifier in the argument list")) + (setq gnome-align-identifier-start-column + (gnome-align--marker-column + (gnome-align--decl-identifier-start (car decls))) + gnome-align-arglist-start-column + (gnome-align--marker-column + (gnome-align--decl-arglist-start (car decls))) + gnome-align-arglist-identifier-start-column + (gnome-align--marker-column + (gnome-align--argument-identifier-start (car arglist)))) + (message + "identifier-start: %d, arglist-start: %d, arglist-identifier-start: %d" + gnome-align-identifier-start-column + gnome-align-arglist-start-column + gnome-align-arglist-identifier-start-column))) + +;;;###autoload +(defun gnome-align-region (beg end) + "Reformat function declarations in the region between BEG and END." + (interactive "r") + (save-excursion + (let (decls) + (save-restriction + (narrow-to-region beg end) + (unless (and gnome-align-identifier-start-column + gnome-align-arglist-start-column + gnome-align-arglist-identifier-start-column) + (let ((columns (gnome-align--compute-optimal-columns beg end))) + (unless gnome-align-identifier-start-column + (setq gnome-align-identifier-start-column + (cdr (assq 'identifier-start-column columns)))) + (unless gnome-align-arglist-start-column + (setq gnome-align-arglist-start-column + (cdr (assq 'arglist-start-column columns)))) + (unless gnome-align-arglist-identifier-start-column + (setq gnome-align-arglist-identifier-start-column + (cdr (assq 'arglist-identifier-start-column columns)))))) + (setq decls (gnome-align--scan-decls beg end)) + (mapc #'gnome-align--normalize-decl decls) + (dolist (decl decls) + (goto-char (gnome-align--decl-identifier-start decl)) + (gnome-align--indent-to-column + gnome-align-identifier-start-column) + (goto-char (gnome-align--decl-identifier-end decl)) + (when (>= (current-column) gnome-align-arglist-start-column) + (insert "\n")) + (goto-char (gnome-align--decl-arglist-start decl)) + (gnome-align--indent-to-column + gnome-align-arglist-start-column) + (forward-char) + (gnome-align-at-point + (- (- gnome-align-arglist-identifier-start-column + (length "(")) + gnome-align-arglist-start-column))))))) + +(provide 'gnome-align) + +;;; gnome-align.el ends here diff --git a/gnome-minor-mode.el b/gnome-minor-mode.el new file mode 100644 index 000000000..b2930bed1 --- /dev/null +++ b/gnome-minor-mode.el @@ -0,0 +1,65 @@ +;;; gnome-minor-mode.el --- minor mode for editing GNOME-style C source code -*- lexical-binding: t; -*- +;; Copyright (C) 2016 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: GNOME, C, coding style +;; Version: 0.1 +;; Maintainer: Daiki Ueno + +;; 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 +;; . + +;;; Code: + +(autoload 'gnome-align-at-point "gnome-align") +(autoload 'gnome-align-region "gnome-align") +(autoload 'gnome-align-set-column "gnome-align") +(autoload 'gnome-align-guess-columns "gnome-align") +(autoload 'gnome-align-compute-optimal-columns "gnome-align") +(autoload 'gnome-snippet-insert-package_class "gnome-snippet") +(autoload 'gnome-snippet-insert-PACKAGE_CLASS "gnome-snippet") +(autoload 'gnome-snippet-insert-PackageClass "gnome-snippet") +(autoload 'gnome-snippet-insert-interface-declation "gnome-snippet") +(autoload 'gnome-snippet-insert-class-declation "gnome-snippet") +(autoload 'gnome-snippet-insert-set_property "gnome-snippet") +(autoload 'gnome-snippet-insert-get_property "gnome-snippet") +(autoload 'gnome-snippet-insert-dispose "gnome-snippet") +(autoload 'gnome-snippet-insert-finalize "gnome-snippet") +(autoload 'gnome-snippet-insert-notify "gnome-snippet") +(autoload 'gnome-snippet-insert-constructed "gnome-snippet") +(autoload 'gnome-snippet-insert "gnome-snippet") + +(defvar gnome-minor-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap "\C-c\C-ga" 'gnome-align-at-point) + (define-key keymap "\C-c\C-gr" 'gnome-align-region) + (define-key keymap "\C-c\C-gf" 'gnome-align-set-column) + (define-key keymap "\C-c\C-gg" 'gnome-align-guess-columns) + (define-key keymap "\C-c\C-g\C-g" 'gnome-align-compute-optimal-columns) + (define-key keymap "\C-c\C-gc" 'gnome-snippet-insert-package_class) + (define-key keymap "\C-c\C-gC" 'gnome-snippet-insert-PACKAGE_CLASS) + (define-key keymap "\C-c\C-g\C-c" 'gnome-snippet-insert-PackageClass) + (define-key keymap "\C-c\C-gs" 'gnome-snippet-insert) + keymap)) + +;;;###autoload +(define-minor-mode gnome-minor-mode + "A minor-mode for editing GNOME-style C source code." + nil " GNOME" gnome-minor-mode-map) + +(provide 'gnome-c-mode) + +;;; gnome-c-mode.el ends here diff --git a/gnome-snippet.el b/gnome-snippet.el new file mode 100644 index 000000000..f8aad95be --- /dev/null +++ b/gnome-snippet.el @@ -0,0 +1,513 @@ +;;; gnome-snippet.el --- GNOME-style code generation -*- lexical-binding: t; -*- +;; Copyright (C) 2016 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: GNOME, 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 +;; . + +;;; Code: + +(require 'gnome-align) + +(eval-when-compile + (require 'subword)) + +(declare-function subword-forward "subword.el" (&optional arg)) + +(defvar gnome-snippet-package nil) +(make-variable-buffer-local 'gnome-snippet-package) + +(defvar gnome-snippet-class nil) +(make-variable-buffer-local 'gnome-snippet-class) + +(defvar gnome-snippet-parent-package nil) +(make-variable-buffer-local 'gnome-snippet-parent-package) + +(defvar gnome-snippet-parent-class nil) +(make-variable-buffer-local 'gnome-snippet-parent-class) + +(defvar gnome-snippet-align-arglist nil) +(make-variable-buffer-local 'gnome-snippet-align-arglist) + +(defun gnome-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 gnome-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 + (gnome-snippet--parse-name + (read-string (or package-prompt + "Package (CamelCase): ") + (if (symbol-value package-symbol) + (gnome-snippet--format-Package + (symbol-value package-symbol)))))) + (set class-symbol + (gnome-snippet--parse-name + (read-string (or class-prompt + "Class (CamelCase): ") + (if (symbol-value class-symbol) + (gnome-snippet--format-Class + (symbol-value class-symbol))))))) + (list (symbol-value package-symbol) (symbol-value class-symbol))) + +(defun gnome-snippet--format-PACKAGE (package) + (mapconcat #'upcase package "_")) +(defalias 'gnome-snippet--format-CLASS 'gnome-snippet--format-PACKAGE) + +(defun gnome-snippet--format-PACKAGE_CLASS (package class) + (concat (gnome-snippet--format-PACKAGE package) + "_" + (gnome-snippet--format-CLASS class))) + +(defun gnome-snippet--format-package (package) + (mapconcat #'downcase package "_")) +(defalias 'gnome-snippet--format-class 'gnome-snippet--format-package) + +(defun gnome-snippet--format-package_class (package class) + (concat (gnome-snippet--format-package package) + "_" + (gnome-snippet--format-class class))) + +(defun gnome-snippet--format-Package (package) + (mapconcat #'identity package "")) +(defalias 'gnome-snippet--format-Class 'gnome-snippet--format-Package) + +(defun gnome-snippet--format-PackageClass (package class) + (concat (gnome-snippet--format-Package package) + (gnome-snippet--format-Class class))) + +;;;###autoload +(defun gnome-snippet-insert-package_class (package class) + "Insert the class name before the current point." + (interactive (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (insert (gnome-snippet--format-package_class package class))) + +;;;###autoload +(defun gnome-snippet-insert-PACKAGE_CLASS (package class) + "Insert the class name before the current point." + (interactive (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (insert (gnome-snippet--format-PACKAGE_CLASS package class))) + +;;;###autoload +(defun gnome-snippet-insert-PackageClass (package class) + "Insert the class name (in CamelCase) before the current point." + (interactive (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (insert (gnome-snippet--format-PackageClass package class))) + +(defun gnome-snippet-insert-interface-declaration (package iface + parent-package parent-class) + "Insert interface declaration for PACKAGE and IFACE" + (interactive + (append (gnome-snippet--read-package-and-class + nil + "Interface (CamelCase): " + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (insert "\ +#define " (gnome-snippet--format-PACKAGE package) "_TYPE_" (gnome-snippet--format-CLASS iface) " (" (gnome-snippet--format-package package) "_" (gnome-snippet--format-class iface) "_get_type ()) +G_DECLARE_INTERFACE (" (gnome-snippet--format-PackageClass package iface) ", " +(gnome-snippet--format-package_class package iface) ", " (gnome-snippet--format-PACKAGE package) ", " (gnome-snippet--format-CLASS iface) ", " (gnome-snippet--format-PackageClass parent-package parent-class) ") +")) + +(defun gnome-snippet--insert-class-declaration (package + class + parent-package + parent-class + derivable) + (insert "\ +#define " (gnome-snippet--format-PACKAGE package) "_TYPE_" (gnome-snippet--format-CLASS class) " (" (gnome-snippet--format-package_class package class) "_get_type ()) +G_DECLARE_" (if derivable "DERIVABLE" "FINAL") "_TYPE (" (gnome-snippet--format-PackageClass package class) ", " +(gnome-snippet--format-package_class package class) ", " (gnome-snippet--format-PACKAGE package) ", " (gnome-snippet--format-CLASS class) ", " (gnome-snippet--format-PackageClass parent-package parent-class) ") +")) + +(defun gnome-snippet-insert-final-class-declaration (package + class + parent-package + parent-class) + "Insert final class declaration for PACKAGE and CLASS." + (interactive + (append (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (gnome-snippet--insert-class-declaration package + class + parent-package + parent-class + nil)) + +(defun gnome-snippet-insert-derivable-class-declaration (package + class + parent-package + parent-class) + "Insert derivable class declaration for PACKAGE and CLASS." + (interactive + (append (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (gnome-snippet--insert-class-declaration package + class + parent-package + parent-class + t)) + +(defun gnome-snippet-insert-interface-definition (package + iface + parent-package + parent-class) + "Insert class definition for PACKAGE and CLASS." + (interactive + (append (gnome-snippet--read-package-and-class + nil + "Interface (CamelCase): " + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (insert "\ +static void +" (gnome-snippet--format-package_class package iface) "_default_init (" (gnome-snippet--format-PackageClass package iface) "Interface *iface) { +} + +G_DEFINE_INTERFACE (" (gnome-snippet--format-PackageClass package iface) ", " +(gnome-snippet--format-package_class package iface) ", " (gnome-snippet--format-PACKAGE parent-package) "_TYPE_" (gnome-snippet--format-CLASS parent-class) ") +")) + +(defun gnome-snippet--insert-class-definition (package + class + parent-package + parent-class + abstract) + (insert "\ +G_DEFINE_" (if abstract "ABSTRACT_" "") "TYPE (" (gnome-snippet--format-PackageClass package class) ", " +(gnome-snippet--format-package_class package class) ", " (gnome-snippet--format-PACKAGE parent-package) "_TYPE_" (gnome-snippet--format-CLASS parent-class) ") + +static void +" (gnome-snippet--format-package_class package class) "_class_init (" (gnome-snippet--format-PackageClass package class) "Class *klass) +{ +} + +static void +" (gnome-snippet--format-package_class package class) "_init (" (gnome-snippet--format-PackageClass package class) " *self) +{ +} +")) + +(defun gnome-snippet-insert-class-definition (package + class + parent-package + parent-class) + "Insert class definition for PACKAGE and CLASS." + (interactive + (append (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (gnome-snippet--insert-class-definition package + class + parent-package + parent-class + nil)) + +(defun gnome-snippet-insert-abstract-class-definition (package + class + parent-package + parent-class) + "Insert abstract class definition for PACKAGE and CLASS." + (interactive + (append (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class) + (gnome-snippet--read-package-and-class + "Parent package (CamelCase): " + "Parent class (CamelCase): " + 'gnome-snippet-parent-package + 'gnome-snippet-parent-class))) + (gnome-snippet--insert-class-definition package + class + parent-package + parent-class + t)) + +(defun gnome-snippet-insert-constructor (package class) + "Insert 'constructor' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (arglist-start body-start) + (insert "\ +static GObject * +" (gnome-snippet--format-package_class package class) "_constructor (") + (setq arglist-start (point-marker)) + (insert "GType *object, +guint n_construct_properties, +GObjectConstructParam *construct_properties") + (funcall (if gnome-snippet-align-arglist + #'gnome-align-region + #'indent-region) + arglist-start (point)) + (insert ")\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-snippet--format-PACKAGE_CLASS package class) " (object); + + G_OBJECT_CLASS (" (gnome-snippet--format-package_class package class) "_parent_class)->constructed (object); +} +") + (indent-region body-start (point)))) + +(defun gnome-snippet-insert-set_property (package class) + "Insert 'set_property' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (arglist-start body-start) + (insert "\ +static void +" (gnome-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 gnome-snippet-align-arglist + #'gnome-align-region + #'indent-region) + arglist-start (point)) + (insert ")\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-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 gnome-snippet-insert-get_property (package class) + "Insert 'get_property' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (arglist-start body-start) + (insert "\ +static void +" (gnome-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 gnome-snippet-align-arglist + #'gnome-align-region + #'indent-region) + arglist-start (point)) + (insert ")\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " +(gnome-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 gnome-snippet-insert-dispose (package class) + "Insert 'dispose' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (body-start) + (insert "\ +static void +" (gnome-snippet--format-package_class package class) "_dispose (GObject *object)\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-snippet--format-PACKAGE_CLASS package class) " (object); + + G_OBJECT_CLASS (" (gnome-snippet--format-package_class package class) "_parent_class)->dispose (object); +} +") + (indent-region body-start (point)))) + +(defun gnome-snippet-insert-finalize (package class) + "Insert 'finalize' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (body-start) + (insert "\ +static void +" (gnome-snippet--format-package_class package class) "_finalize (GObject *object)\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-snippet--format-PACKAGE_CLASS package class) " (object); + + G_OBJECT_CLASS (" (gnome-snippet--format-package_class package class) "_parent_class)->finalize (object); +} +") + (indent-region body-start (point)))) + +(defun gnome-snippet-insert-notify (package class) + "Insert 'notify' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (body-start) + (insert "\ +static void +" (gnome-snippet--format-package_class package class) "_notify (GObject *object)\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-snippet--format-PACKAGE_CLASS package class) " (object); + + G_OBJECT_CLASS (" (gnome-snippet--format-package_class package class) "_parent_class)->finalize (object); +} +") + (indent-region body-start (point)))) + +(defun gnome-snippet-insert-constructed (package class) + "Insert 'constructed' vfunc of GObjectClass for PACKAGE and CLASS." + (interactive + (gnome-snippet--read-package-and-class + nil nil + 'gnome-snippet-package + 'gnome-snippet-class)) + (let (body-start) + (insert "\ +static void +" (gnome-snippet--format-package_class package class) "_constructed (GObject *object)\n") + (setq body-start (point-marker)) + (insert "{ + " (gnome-snippet--format-PackageClass package class) " *self = " + (gnome-snippet--format-PACKAGE_CLASS package class) " (object); + + G_OBJECT_CLASS (" (gnome-snippet--format-package_class package class) "_parent_class)->constructed (object); +} +") + (indent-region body-start (point)))) + +(defvar gnome-snippet-snippet-commands + '(("G_DECLARE_INTERFACE" . gnome-snippet-insert-interface-declaration) + ("G_DECLARE_FINAL_TYPE" . gnome-snippet-insert-final-class-declaration) + ("G_DECLARE_DERIVABLE_TYPE" . + gnome-snippet-insert-derivable-class-declaration) + ("G_DEFINE_INTERFACE" . gnome-snippet-insert-interface-definition) + ("G_DEFINE_TYPE" . gnome-snippet-insert-class-definition) + ("G_DEFINE_ABSTRACT_TYPE" . + gnome-snippet-insert-abstract-class-definition) + ("GObjectClass.constructor" . gnome-snippet-insert-constructor) + ("GObjectClass.set_property" . gnome-snippet-insert-set_property) + ("GObjectClass.get_property" . gnome-snippet-insert-get_property) + ("GObjectClass.dispose" . gnome-snippet-insert-dispose) + ("GObjectClass.finalize" . gnome-snippet-insert-finalize) + ;; GObjectClass.dispatch_properties_changed + ("GObjectClass.notify" . gnome-snippet-insert-notify) + ("GObjectClass.contructed" . gnome-snippet-insert-constructed))) + +;;;###autoload +(defun gnome-snippet-insert (snippet) + (interactive + (list (completing-read "Snippet: " gnome-snippet-snippet-commands nil t))) + (let ((entry (assoc snippet gnome-snippet-snippet-commands))) + (unless entry + (error "Unknown snippet: %s" snippet)) + (call-interactively (cdr entry)))) + +(provide 'gnome-snippet) + +;;; gnome-snippet.el ends here diff --git a/gnome-tests.el b/gnome-tests.el new file mode 100644 index 000000000..d4e311369 --- /dev/null +++ b/gnome-tests.el @@ -0,0 +1,97 @@ +(require 'gnome-align) + +(defconst gnome-test-program-1 "\ +GGpgCtx *g_gpg_ctx_new (GError **error); + +typedef void (*GGpgProgressCallback) (gpointer user_data, + const gchar *what, + gint type, + gint current, + gint total); + +void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx, + GGpgProgressCallback callback, + gpointer user_data, + GDestroyNotify destroy_data); +void g_gpg_ctx_add_signer (GGpgCtx *ctx, GGpgKey *key); +guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx); +GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx, guint index); +void g_gpg_ctx_clear_signers (GGpgCtx *ctx); +") + +(defconst gnome-test-program-1-aligned "\ +GGpgCtx *g_gpg_ctx_new (GError **error); + +typedef void (*GGpgProgressCallback) (gpointer user_data, + const gchar *what, + gint type, + gint current, + gint total); + +void g_gpg_ctx_set_progress_callback (GGpgCtx *ctx, + GGpgProgressCallback callback, + gpointer user_data, + GDestroyNotify destroy_data); +void g_gpg_ctx_add_signer (GGpgCtx *ctx, + GGpgKey *key); +guint g_gpg_ctx_get_n_signers (GGpgCtx *ctx); +GGpgKey *g_gpg_ctx_get_signer (GGpgCtx *ctx, + guint index); +void g_gpg_ctx_clear_signers (GGpgCtx *ctx); +") + +(defconst gnome-test-program-2 "\ +GDK_AVAILABLE_IN_3_16 +const gchar ** gtk_widget_list_action_prefixes (GtkWidget *widget); +") + +(defconst gnome-test-program-3 "\ + /* overridable methods */ + void (*set_property) (GObject *object, + guint property_id, + const GValue *value, + GParamSpec *pspec); + void (*get_property) (GObject *object, + guint property_id, + GValue *value, + GParamSpec *pspec); +") + +(ert-deftest gnome-test-align--compute-optimal-columns () + "Tests the `gnome-align--compute-optimal-columns'." + (with-temp-buffer + (insert gnome-test-program-1) + (c-mode) + (let ((columns (gnome-align--compute-optimal-columns (point-min) (point-max)))) + (should (= (cdr (assq 'identifier-start-column columns)) 9)) + (should (= (cdr (assq 'arglist-start-column columns)) 41)) + (should (= (cdr (assq 'arglist-identifier-start-column columns)) 63))))) + +(ert-deftest gnome-test-align-region () + "Tests the `gnome-align-region'." + (with-temp-buffer + (insert gnome-test-program-1) + (c-mode) + (gnome-align-compute-optimal-columns (point-min) (point-max)) + (gnome-align-region (point-min) (point-max)) + (should (equal (buffer-string) gnome-test-program-1-aligned)))) + +(ert-deftest gnome-test-align-guess-columns-1 () + "Tests the `gnome-align-guess-columns'." + (with-temp-buffer + (insert gnome-test-program-2) + (c-mode) + (gnome-align-guess-columns (point-min) (point-max)) + (should (= gnome-align-identifier-start-column 24)) + (should (= gnome-align-arglist-start-column 56)) + (should (= gnome-align-arglist-identifier-start-column 80)))) + +(ert-deftest gnome-test-align-guess-columns-2 () + "Tests the `gnome-align-guess-columns'." + (with-temp-buffer + (insert gnome-test-program-3) + (c-mode) + (gnome-align-guess-columns (point-min) (point-max)) + (should (= gnome-align-identifier-start-column 13)) + (should (= gnome-align-arglist-start-column 40)) + (should (= gnome-align-arglist-identifier-start-column 57))))