From b3a7956e13a4a98c771c538514e33f913093ce43 Mon Sep 17 00:00:00 2001 From: ueno Date: Fri, 18 Nov 2005 05:57:56 +0000 Subject: [PATCH] * riece-develop.el: New file. --- lisp/ChangeLog | 4 +++ lisp/riece-develop.el | 77 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 81 insertions(+) create mode 100644 lisp/riece-develop.el 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 + + * riece-develop.el: New file. + 2005-10-27 Masatake YAMATO * 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")))) -- 1.7.10.4