From: ueno <ueno>
Date: Fri, 18 Nov 2005 05:57:56 +0000 (+0000)
Subject: * riece-develop.el: New file.
X-Git-Tag: riece-2_0_2~24
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b3a7956e13a4a98c771c538514e33f913093ce43;p=elisp%2Friece.git

* riece-develop.el: New file.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7085c0f..08ea3d9 100644
--- 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
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"))))