cgit.sxemacs.org Git - packages/blob - xemacs-packages/tooltalk/tooltalk-macros.el

   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)))