home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tooltalk / tooltalk-macros.el.z / tooltalk-macros.el
Encoding:
Text File  |  1998-05-21  |  2.5 KB  |  93 lines
  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)))
  93.