Mercurial > hg > xemacs-beta
comparison lisp/tooltalk/tooltalk-macros.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 2 ;;; Date: Wed Dec 16 17:40:58 1992 | |
| 3 ;;; File: tooltalk-macros.el | |
| 4 ;;; Title: Useful macros for ToolTalk/elisp interface | |
| 5 ;;; SCCS: @(#)tooltalk-macros.el 1.5 21 Jan 1993 19:09:24 | |
| 6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 7 | |
| 8 (defmacro destructuring-bind-tooltalk-message (variables | |
| 9 args-count | |
| 10 message | |
| 11 &rest body) | |
| 12 " | |
| 13 arglist: (variables args-count message &rest body) | |
| 14 | |
| 15 Binds VARIABLES to the ARG_VALs and ARG_IVALs of MESSAGE, | |
| 16 starting from N = 0, and executes BODY in that context. | |
| 17 Binds actual number of message args to ARGS-COUNT. | |
| 18 | |
| 19 VARIABLES is a list of local variables to bind. | |
| 20 Each item in VARIABLES is either nil, a symbol, or a list of the form: | |
| 21 | |
| 22 (symbol type) | |
| 23 | |
| 24 If the item is nil, the nth ARG_VAL or ARG_IVAL of MESSAGE is skipped. | |
| 25 If the item is a symbol, the nth ARG_VAL of MESSAGE is bound. | |
| 26 If the item is a list | |
| 27 If type = \"int\" the nth ARG_IVAL of MESSAGE is bound, | |
| 28 otherwise the nth ARG_VAL of MESSAGE is bound. | |
| 29 | |
| 30 If there are more items than actual arguments in MESSAGE, the extra | |
| 31 items are bound to nil. | |
| 32 | |
| 33 For example, | |
| 34 | |
| 35 (destructuring-bind-tooltalk-message (a (b \"int\") nil d) foo msg | |
| 36 x y z) | |
| 37 | |
| 38 expands to | |
| 39 | |
| 40 (let* ((foo (get-tooltalk-message-attribute msg 'args_count)) | |
| 41 (a (if (< 0 foo) | |
| 42 (get-tooltalk-message-attribute msg 'arg_val 0))) | |
| 43 (b (if (< 1 foo) | |
| 44 (get-tooltalk-message-attribute msg 'arg_val 1))) | |
| 45 (d (if (< 3 foo) | |
| 46 (get-tooltalk-message-attribute msg 'arg_val 3)))) | |
| 47 x y z) | |
| 48 | |
| 49 See GET-TOOLTALK-MESSAGE-ATTRIBUTE for more information. | |
| 50 " | |
| 51 (let* ((var-list variables) | |
| 52 (nargs args-count) | |
| 53 (msg message) | |
| 54 (n -1) | |
| 55 var-item | |
| 56 var | |
| 57 type | |
| 58 request | |
| 59 bindings) | |
| 60 (setq bindings (cons | |
| 61 (list nargs | |
| 62 (list | |
| 63 'get-tooltalk-message-attribute | |
| 64 msg | |
| 65 ''args_count)) | |
| 66 bindings)) | |
| 67 (while var-list | |
| 68 (setq var-item (car var-list) | |
| 69 var-list (cdr var-list)) | |
| 70 (if (eq 'nil var-item) | |
| 71 (setq n (1+ n)) | |
| 72 (progn | |
| 73 (if (listp var-item) | |
| 74 (setq var (car var-item) | |
| 75 type (car (cdr var-item))) | |
| 76 (setq var var-item | |
| 77 type "string")) | |
| 78 (setq n (1+ n)) | |
| 79 (setq request (list | |
| 80 'get-tooltalk-message-attribute | |
| 81 msg | |
| 82 (if (equal "int" type) | |
| 83 ''arg_ival | |
| 84 ''arg_val) | |
| 85 n)) | |
| 86 (setq bindings (cons | |
| 87 (list var | |
| 88 (list 'if | |
| 89 (list '< n nargs) | |
| 90 request)) | |
| 91 bindings))))) | |
| 92 (nconc (list 'let* (nreverse bindings)) body))) |