* riece-develop.el: New file.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7085c0f..08ea3d9 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2005-11-18  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-develop.el: New file.
+
 2005-10-27  Masatake YAMATO  <jet@gyve.org>
 
        * url-riece.el (url-irc-riece): Use `server-name'

diff --git a/lisp/riece-develop.el b/lisp/riece-develop.el
new file mode 100644 (file)
index 0000000..6bc766c
--- /dev/null
+++ b/lisp/riece-develop.el
@@ -0,0 +1,77 @@
+(defun riece-insert-struct-template (prefix struct)
+  (interactive "sPrefix: 
+sStruct: ")
+  (let (attributes
+       optional-attributes
+       name
+       pointer
+       arglist
+       strings
+       (index 0))
+    (catch 'finish
+      (while t
+       (setq name (read-from-minibuffer "Attribute: "))
+       (if (equal name "")
+           (throw 'finish nil))
+       (setq attributes
+             (cons (vector name
+                           (y-or-n-p "Optional? ")
+                           (y-or-n-p "Readable? ")
+                           (y-or-n-p "Writable? "))
+                   attributes))))
+    (setq attributes (nreverse attributes)
+         pointer (cons (vector "" nil nil nil)  attributes))
+    (while (cdr pointer)
+      (when (aref (car (cdr pointer)) 1)
+       (setq optional-attributes (cons (car (cdr pointer))
+                                       optional-attributes))
+       (setcdr pointer (nthcdr 2 pointer)))
+      (setq pointer (cdr pointer)))
+    (setq optional-attributes (nreverse optional-attributes)
+         arglist (mapconcat (lambda (attribute)
+                              (aref attribute 0))
+                            attributes " "))
+    (if optional-attributes
+       (setq arglist (concat arglist " &optional "
+                             (mapconcat (lambda (attribute)
+                                          (aref attribute 0))
+                                        optional-attributes " "))))
+    (setq strings (list (format "\
+\(defun %smake-%s (%s)
+  \"Make a %s%s object.\"
+  (vector %s))"
+                               prefix struct arglist
+                               prefix struct
+                               (mapconcat (lambda (attribute)
+                                            (aref attribute 0))
+                                          (append attributes
+                                                  optional-attributes)
+                                          " "))))
+    (setq pointer (append attributes optional-attributes))
+    (while pointer
+      (if (aref (car pointer) 2)
+         (setq strings (cons (format "\
+\(defun %s%s-%s (%s)
+  \"Return %s of %s.\"
+  (aref %s %d))"
+                                     prefix struct (aref (car pointer) 0)
+                                     struct
+                                     (aref (car pointer) 0)
+                                     (upcase struct)
+                                     struct index)
+                             strings)))
+      (if (aref (car pointer) 3)
+         (setq strings (cons (format "\
+\(defun %s%s-set-%s (%s %s)
+  \"Set %s of %s to %s.\"
+  (aset %s %d %s))"
+                                     prefix struct (aref (car pointer) 0)
+                                     struct (aref (car pointer) 0)
+                                     (aref (car pointer) 0)
+                                     (upcase struct)
+                                     (upcase (aref (car pointer) 0))
+                                     struct index (aref (car pointer) 0))
+                             strings)))
+      (setq pointer (cdr pointer)
+           index (1+ index)))
+    (insert (mapconcat #'identity (nreverse strings) "\n\n"))))