Remove old and crusty tooltalk pkg
authorSteve Youngs <steve@sxemacs.org>
Sun, 12 Jun 2016 10:21:28 +0000 (20:21 +1000)
committerSteve Youngs <steve@sxemacs.org>
Sun, 12 Jun 2016 10:21:28 +0000 (20:21 +1000)
Signed-off-by: Steve Youngs <steve@sxemacs.org>
package-compile.el
xemacs-packages/Makefile
xemacs-packages/tooltalk/ChangeLog [deleted file]
xemacs-packages/tooltalk/Makefile [deleted file]
xemacs-packages/tooltalk/Makefile.XEmacs [deleted file]
xemacs-packages/tooltalk/package-info.in [deleted file]
xemacs-packages/tooltalk/tooltalk-init.el [deleted file]
xemacs-packages/tooltalk/tooltalk-macros.el [deleted file]
xemacs-packages/tooltalk/tooltalk-util.el [deleted file]

index 3e3dce4..6bf83d1 100644 (file)
     ("textools" . "xemacs-packages")
     ("time" . "xemacs-packages")
     ("tm" . "xemacs-packages")
-    ("tooltalk" . "xemacs-packages")
     ("tpu" . "xemacs-packages")
     ("tramp" . "xemacs-packages")
     ("vc" . "xemacs-packages")
index 3fe5647..13b43e6 100644 (file)
@@ -55,7 +55,7 @@ PACKAGES := xemacs-base fsf-compat mail-lib \
        prog-modes ps-print psgml psgml-dtds python-modes re-builder \
        reftex riece rmail ruby-modes sasl scheme sgml \
        sieve slider sml-mode sounds-au sounds-wav strokes \
-       supercite textools time tm tooltalk tpu tramp \
+       supercite textools time tm tpu tramp \
        vc vc-cc vhdl view-process viper vm w3 x-symbol \
        xetla xslide xslt-process xwem zenirc
 else
diff --git a/xemacs-packages/tooltalk/ChangeLog b/xemacs-packages/tooltalk/ChangeLog
deleted file mode 100644 (file)
index ad9fb55..0000000
+++ /dev/null
@@ -1,73 +0,0 @@
-2014-05-15  Norbert Koch  <viteno@xemacs.org>
-
-       * Makefile (VERSION): XEmacs package 1.17 released.
-
-2014-05-15  Norbert Koch  <viteno@xemacs.org>
-
-       * Makefile (VERSION): XEmacs package 1.16 released.
-
-2014-05-13  Jerry James  <james@xemacs.org>
-
-       * .cvsignore: Remove.
-       * .hgignore: New file.
-
-2003-10-31  Norbert Koch  <viteno@xemacs.org>
-
-       * Makefile (VERSION): XEmacs package 1.15 released.
-
-2003-09-15  Norbert Koch  <viteno@xemacs.org>
-
-       * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-03-30  Steve Youngs  <youngs@xemacs.org>
-
-       * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22  Steve Youngs  <youngs@xemacs.org>
-
-       * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try
-       to build custom-loads, this package doesn't have any.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-       * Makefile:
-       Delete explicit compile:: and binkit: rules.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-       * .cvsignore: Remove files now handled automatically by CVS.
-       * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skytt√§  <scop@xemacs.org>
-
-       * Makefile (srckit): Remove.
-
-2000-10-05  Martin Buchholz  <martin@xemacs.org>
-
-       * *: Mega typo fix.
-
-1998-07-25  SL Baur  <steve@altair.xemacs.org>
-
-       * dumped-lisp.el: removed.
-
-1998-07-18  SL Baur  <steve@altair.xemacs.org>
-
-       * dumped-lisp.el: Elimination of Lisp read-time macros.
-
-1998-01-24  SL Baur  <steve@altair.xemacs.org>
-
-       * Makefile (VERSION): Update to package standard 1.0.
-       * package-info.in: Ditto.
-
-1998-01-11  SL Baur  <steve@altair.xemacs.org>
-
-       * Makefile (VERSION): Update to newer package interface.
-
-1998-01-04  SL Baur  <steve@altair.xemacs.org>
-
-       * dumped-lisp.el: New file from standard dumped-lisp.el.
-
-1997-12-21  SL Baur  <steve@altair.xemacs.org>
-
-       * Makefile: Created.
-
diff --git a/xemacs-packages/tooltalk/Makefile b/xemacs-packages/tooltalk/Makefile
deleted file mode 100644 (file)
index 19d8fb6..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-# Makefile for tooltalk lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by the
-# Free Software Foundation; either version 2, or (at your option) any
-# later version.
-
-# XEmacs is distributed in the hope that it will be useful, but WITHOUT
-# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-# for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with XEmacs; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.17
-AUTHOR_VERSION =
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
-PACKAGE = tooltalk
-PKG_TYPE = regular
-REQUIRES =
-CATEGORY = standard
-
-ELCS = tooltalk-init.elc tooltalk-macros.elc tooltalk-util.elc
-
-include ../../XEmacs.rules
diff --git a/xemacs-packages/tooltalk/Makefile.XEmacs b/xemacs-packages/tooltalk/Makefile.XEmacs
deleted file mode 100644 (file)
index ef14a27..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-# @(#)Makefile 1.4 94/04/19
-
-EMACS=../../src/xemacs
-
-TOOLTALK.el  = tooltalk-macros.el tooltalk-init.el tooltalk-util.el
-TOOLTALK.elc = $(TOOLTALK.el:.el=.elc)
-
-all: $(TOOLTALK.elc)
-
-.INIT: tooltalk-load.el $(TOOLTALK.el) 
-
-.SUFFIXES: .elc .el
-
-.el.elc:
-       $(EMACS) -batch -q -f batch-byte-compile $(@:.elc=.el)
-
-clean: 
-       $(RM) $(TOOLTALK.elc)
diff --git a/xemacs-packages/tooltalk/package-info.in b/xemacs-packages/tooltalk/package-info.in
deleted file mode 100644 (file)
index 17ddcd9..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-(tooltalk
-  (standards-version 1.1
-   version VERSION
-   author-version AUTHOR_VERSION
-   date DATE
-   build-date BUILD_DATE
-   maintainer MAINTAINER
-   distribution xemacs
-   priority low
-   category CATEGORY
-   dump nil
-   description "Support for building with Tooltalk."
-   filename FILENAME
-   md5sum MD5SUM
-   size SIZE
-   provides ()
-   requires (REQUIRES)
-   type regular
-))
diff --git a/xemacs-packages/tooltalk/tooltalk-init.el b/xemacs-packages/tooltalk/tooltalk-init.el
deleted file mode 100644 (file)
index 6eb163b..0000000
+++ /dev/null
@@ -1,215 +0,0 @@
-;;; -*- Mode: Emacs-Lisp -*-
-;;;
-;;; Registration of the default Tooltalk patterns and handlers.
-;;;
-;;; @(#)tooltalk-init.el 1.8 94/02/22
-
-
-(defvar tooltalk-eval-pattern
-  '(category TT_HANDLE
-       scope TT_SESSION
-          op "emacs-eval"
-    callback tooltalk-eval-handler))
-
-(defvar tooltalk-load-file-pattern
-  '(category TT_HANDLE
-       scope TT_SESSION
-          op "emacs-load-file"
-       args ((TT_IN "file" "string"))
-    callback tooltalk-load-file-handler))
-
-(defvar tooltalk-make-client-frame-pattern 
-  '(category TT_HANDLE
-       scope TT_SESSION
-          op "emacs-make-client-screen"
-    callback tooltalk-make-client-frame-handler))
-
-(defvar tooltalk-status-pattern 
-  '(category TT_HANDLE
-       scope TT_SESSION
-          op "emacs-status"
-    callback tooltalk-status-handler))
-
-
-(defvar initial-tooltalk-patterns ())
-
-(defun dispatch-initial-tooltalk-message (m)
-  (let ((op (get-tooltalk-message-attribute m 'op))
-       (patterns initial-tooltalk-patterns))
-    (if (stringp op)
-        (while patterns
-          (let ((p (car patterns)))
-            (if (eq (intern op) (tooltalk-pattern-prop-get p 'opsym))
-                (let ((callback (tooltalk-pattern-prop-get p 'callback)))
-                  (if callback (funcall callback m p))
-                  (setq patterns '()))
-              (setq patterns (cdr patterns))))))))
-
-(defun make-initial-tooltalk-pattern (args)
-  (let ((opcdr (cdr (memq 'op args)))
-       (cbcdr (cdr (memq 'callback args))))
-    (if (and (consp opcdr) (consp cbcdr))
-       (let ((plist (list 'opsym (intern (car opcdr)) 'callback (car cbcdr))))
-         (make-tooltalk-pattern (append args (list 'plist plist))))
-      (make-tooltalk-pattern args))))
-
-(defun register-initial-tooltalk-patterns ()
-  (mapcar #'register-tooltalk-pattern 
-         (setq initial-tooltalk-patterns
-               (mapcar #'make-initial-tooltalk-pattern
-                       (list tooltalk-eval-pattern
-                             tooltalk-load-file-pattern
-                             tooltalk-make-client-frame-pattern
-                             tooltalk-status-pattern))))
-  (add-hook 'tooltalk-unprocessed-message-hook 'dispatch-initial-tooltalk-message))
-
-
-(defun unregister-initial-tooltalk-patterns ()
-  (mapcar 'destroy-tooltalk-pattern initial-tooltalk-patterns)
-  (setq initial-tooltalk-patterns ())
-  (remove-hook 'tooltalk-unprocessed-message-hook 'dispatch-initial-tooltalk-message))
-
-
-(defun tooltalk:prin1-to-string (form)
-  "Like prin1-to-string except: if the string contains embedded nulls (unlikely
-but possible) then replace each one with \"\\000\"."
-  (let ((string (prin1-to-string form)))
-    (let ((parts '())
-         index)
-      (while (setq index (string-match "\0" string))
-       (setq parts 
-             (apply 'list "\\000" (substring string 0 index) parts))
-       (setq string (substring string (1+ index))))
-      (if (not parts)
-         string
-       (setq parts (apply 'list string parts))
-       (apply 'concat (nreverse parts))))))
-
-;; Backwards compatibility
-(fset 'tooltalk::prin1-to-string-carefully 'tooltalk:prin1-to-string)
-
-
-(defun tooltalk:read-from-string (str)
-  "Like read-from-string except: an error is signalled if the entire 
-string can't be parsed."
-  (let ((res (read-from-string str)))
-    (if (< (cdr res) (length str))
-       (error "Parse of input string ended prematurely."
-              str))
-    (car res)))
-
-
-(defun tooltalk::eval-string (str)
-  (let ((result (eval (car (read-from-string str)))))
-    (tooltalk:prin1-to-string result)))
-
-
-(defun tooltalk-eval-handler (msg pat)
-  (let ((str (get-tooltalk-message-attribute msg 'arg_val 0))
-       (result-str nil)
-       (failp t))
-    (unwind-protect
-       (cond
-        ;; Assume That the emacs debugger will handle errors.
-        ;; If the user throws from the debugger to the cleanup
-        ;; form below, failp will remain t.
-        (debug-on-error   
-         (setq result-str (tooltalk::eval-string str)
-               failp nil))
-
-        ;; If an error occurs as a result of evaluating
-        ;; the string or printing the result, then we'll return 
-        ;; a string version of error-info.
-        (t
-         (condition-case error-info
-             (setq result-str (tooltalk::eval-string str)
-                   failp nil)
-           (error 
-            (let ((error-str (tooltalk:prin1-to-string error-info)))
-              (setq result-str error-str
-                    failp t))))))
-
-      ;; If we get to this point and result-str is still nil, the
-      ;; user must have thrown out of the debugger
-      (let ((reply-type (if failp 'fail 'reply))
-           (reply-value (or result-str "(debugger exit)")))
-       (set-tooltalk-message-attribute reply-value msg 'arg_val 0)
-       (return-tooltalk-message msg reply-type)))))
-
-
-(defun tooltalk-make-client-frame-handler (m p)
-  (let ((nargs (get-tooltalk-message-attribute m 'args_count)))
-    (if (not (= 3 nargs))
-       (progn
-         (set-tooltalk-message-attribute "wrong number of arguments" m 'status_string)
-         (return-tooltalk-message m 'fail))))
-
-  ;; Note: relying on the fact that arg_ival is returned as a string
-
-  (let* ((name   (get-tooltalk-message-attribute m 'arg_val 0))
-        (window (get-tooltalk-message-attribute m 'arg_ival 1))
-        (args (list (cons 'name name) (cons 'window-id window)))
-        (frame (make-frame args)))
-    (set-tooltalk-message-attribute (frame-name frame) m 'arg_val 2)
-    (return-tooltalk-message m 'reply)))
-
-
-
-(defun tooltalk-load-file-handler (m p)
-  (let ((path (get-tooltalk-message-attribute m 'file)))
-    (condition-case error-info 
-       (progn
-         (load-file path)
-         (return-tooltalk-message m 'reply))
-      (error 
-       (let ((error-string (tooltalk:prin1-to-string error-info)))
-       (set-tooltalk-message-attribute error-string m 'status_string)
-       (return-tooltalk-message m 'fail))))))
-
-
-(defun tooltalk-status-handler (m p)
-  (return-tooltalk-message m 'reply))
-
-\f
-;; Hack the command-line.
-
-(defun command-line-do-tooltalk (arg)
-  "Connect to the ToolTalk server."
-;  (setq command-line-args-left
-;      (cdr (tooltalk-open-connection (cons (car command-line-args)
-;                                           command-line-args-left))))
-  (if (tooltalk-open-connection)
-      (register-initial-tooltalk-patterns)
-    (display-warning 'tooltalk "Warning: unable to connect to a ToolTalk server.")))
-
-(setq command-switch-alist
-      (append command-switch-alist
-             '(("-tooltalk" . command-line-do-tooltalk))))
-
-;; Add some selection converters.
-
-(defun xselect-convert-to-ttprocid (selection type value)
-  (let* ((msg (create-tooltalk-message))
-        (ttprocid (get-tooltalk-message-attribute msg 'sender)))
-    (destroy-tooltalk-message msg)
-    ttprocid
-    ))
-
-(defun xselect-convert-to-ttsession (selection type value)
-  (let* ((msg (create-tooltalk-message))
-        (ttsession (get-tooltalk-message-attribute msg 'session)))
-    (destroy-tooltalk-message msg)
-    ttsession
-    ))
-
-(if (boundp 'selection-converter-alist)
-    (setq selection-converter-alist
-         (append
-          selection-converter-alist
-          '((SPRO_PROCID . xselect-convert-to-ttprocid)
-            (SPRO_SESSION . xselect-convert-to-ttsession)
-            )))
-  (setq selection-converter-alist
-       '((SPRO_PROCID . xselect-convert-to-ttprocid)
-         (SPRO_SESSION . xselect-convert-to-ttsession))))
-  
diff --git a/xemacs-packages/tooltalk/tooltalk-macros.el b/xemacs-packages/tooltalk/tooltalk-macros.el
deleted file mode 100644 (file)
index a50d0c5..0000000
+++ /dev/null
@@ -1,92 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Date:      Wed Dec 16 17:40:58 1992
-;;; File:      tooltalk-macros.el
-;;; Title:     Useful macros for ToolTalk/elisp interface
-;;; SCCS:      @(#)tooltalk-macros.el  1.5 21 Jan 1993 19:09:24
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro destructuring-bind-tooltalk-message (variables
-                                              args-count
-                                              message
-                                              &rest body)
-  "
-arglist: (variables args-count message &rest body)
-
-Binds VARIABLES to the ARG_VALs and ARG_IVALs of MESSAGE, 
-starting from N = 0, and executes BODY in that context.
-Binds actual number of message args to ARGS-COUNT.  
-
-VARIABLES is a list of local variables to bind.  
-Each item in VARIABLES is either nil, a symbol, or a list of the form:
-
-       (symbol type)
-
-If the item is nil, the nth ARG_VAL or ARG_IVAL of MESSAGE is skipped.
-If the item is a symbol, the nth ARG_VAL of MESSAGE is bound.
-If the item is a list
-       If type =  \"int\" the nth ARG_IVAL of MESSAGE is bound,
-       otherwise the nth ARG_VAL of MESSAGE is bound.
-
-If there are more items than actual arguments in MESSAGE, the extra
-items are bound to nil.
-
-For example,
-
-(destructuring-bind-tooltalk-message (a (b \"int\") nil d) foo msg
-  x y z)
-
-expands to
-
-(let* ((foo (get-tooltalk-message-attribute msg 'args_count))
-       (a (if (< 0 foo)
-             (get-tooltalk-message-attribute msg 'arg_val 0)))
-       (b (if (< 1 foo) 
-             (get-tooltalk-message-attribute msg 'arg_val 1)))
-       (d (if (< 3 foo)
-             (get-tooltalk-message-attribute msg 'arg_val 3))))
-  x y z)
-
-See GET-TOOLTALK-MESSAGE-ATTRIBUTE for more information.
-"
-  (let* ((var-list variables)
-        (nargs args-count)
-        (msg message)
-        (n -1)
-        var-item
-        var
-        type
-        request
-        bindings)
-    (setq bindings (cons
-                   (list nargs
-                         (list
-                          'get-tooltalk-message-attribute
-                          msg
-                          ''args_count))
-                   bindings))
-    (while var-list
-      (setq var-item (car var-list)
-           var-list (cdr var-list))
-      (if (eq 'nil var-item)
-         (setq n (1+ n))
-       (progn
-         (if (listp var-item)
-             (setq var (car var-item)
-                   type (car (cdr var-item)))
-           (setq var var-item
-                 type "string"))
-         (setq n (1+ n))
-         (setq request (list
-                        'get-tooltalk-message-attribute
-                        msg
-                        (if (equal "int" type)
-                            ''arg_ival
-                          ''arg_val)
-                        n))
-         (setq bindings (cons
-                         (list var
-                               (list 'if
-                                     (list '< n nargs)
-                                     request))
-                         bindings)))))
-    (nconc (list 'let* (nreverse bindings)) body)))
diff --git a/xemacs-packages/tooltalk/tooltalk-util.el b/xemacs-packages/tooltalk/tooltalk-util.el
deleted file mode 100644 (file)
index f8e4e48..0000000
+++ /dev/null
@@ -1,268 +0,0 @@
-;;; -*- Mode: Emacs-Lisp -*-
-;;;
-;;; Emacs Tooltalk Utility Functions
-;;;
-;;; @(#)tooltalk-util.el 1.7 93/12/07
-
-
-(defun initialize-tooltalk-message-arg (msg n mode value vtype)
-  "Initialize the Nth tooltalk message argument of MSG.
-A new argument is created if necessary.  No attempt to distinguish
-between strings that contain binary data and ordinary strings is made;
-all non integer argument values are converted to a string (if not a
-string already) and loaded with tt_message_arg_val_set().
-Applications that need to put binary data into a ToolTalk message
-argument should initialize the argument with:
-
-   (set-tooltalk-message-attribute bin-string msg 'arg_bval arg-n)"
-  (let ((n-args-needed
-        (- (1+ n) (get-tooltalk-message-attribute msg 'args_count))))
-    (while (> n-args-needed 0)
-      (add-tooltalk-message-arg msg mode vtype)
-      (setq n-args-needed (1- n-args-needed))))
-
-  (cond
-   ((integerp value) 
-    (set-tooltalk-message-attribute value msg 'arg_ival n))
-   ((stringp value)
-    (set-tooltalk-message-attribute value msg 'arg_val n))
-   (t
-    (error "The value specified for msg %s argument %d, %s, must be a string or an integer"
-          (prin1-to-string msg)
-          n
-          (prin1-to-string value)))))
-
-
-
-(defconst tooltalk-arg-mode-ids 
-  (list 'TT_IN 'TT_OUT 'TT_INOUT TT_IN TT_OUT TT_INOUT))
-
-(defun initialize-tooltalk-message/pattern-args (initfn msg args)
-  "Apply INITFN to each the position mode value and type of
-each argument in the list.  The value of INITFN should be either
-'initialize-tooltalk-message-arg or 'initialize-tooltalk-pattern-arg.
-See `make-tooltalk-message' for a description of how arguments are specified.
-We distinguish the short form for arguments, e.g. \"just-a-value\", 
-from the long form by checking to see if the argument is a list whose
-car is one of the ToolTalk mode values like TT_INOUT."
-  (let ((n 0))
-    (while args
-      (let* ((arg (car args))
-            (long-form 
-             (and (consp arg) 
-                  (member (car arg) tooltalk-arg-mode-ids)))
-            (mode 
-             (if long-form (car arg) TT_IN))
-            (value 
-             (cond
-              ((not long-form) arg)
-              ((cdr arg) (car (cdr arg)))
-              (t "")))
-            (type
-             (cond
-              ((and long-form
-                    (cdr (cdr arg)) 
-                    (stringp (car (cdr (cdr arg)))))
-               (car (cdr (cdr arg))))
-              ((integerp value) "int")
-              (t "string"))))
-       (funcall initfn msg n mode value type))
-      (setq args (cdr args))
-      (setq n (1+ n)))))
-
-
-(defun initialize-tooltalk-message-attributes (msg attributes)
-  "Initialize the tooltalk message attributes.  The value of 
-attributes must be a property list in the same form as for 
-make-tooltalk-message.  This function can be used to reset
-an existing message or to initialize a new one.  See 
-initialize-tooltalk-message-args for a description of how
-arguments are initialized."
-  (let ((args attributes)
-       (initfn 'initialize-tooltalk-message-arg))
-    (while (and args (cdr args))
-      (let ((indicator (car args))
-           (value (car (cdr args))))
-       (if (eq indicator 'args)
-           (initialize-tooltalk-message/pattern-args initfn msg value)
-         (set-tooltalk-message-attribute value msg indicator)))
-      (setq args (cdr (cdr args))))))
-
-
-(defun make-tooltalk-message (attributes &optional no-callback)
-  "Create a tooltalk message and initialize its attributes.
-The value of attributes must be a list of alternating keyword/values, 
-where keywords are symbols that name valid message attributes.  
-For example:
-
-  (make-tooltalk-message 
-    '(class TT_NOTICE
-      scope TT_SESSION
-      address TT_PROCEDURE
-      op \"do-something\"
-      args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
-
-Values must always be strings, integers, or symbols that
-represent Tooltalk constants.  Attribute names are the same as 
-those supported by set-tooltalk-message-attribute, plus 'args.
-
-The value of args should be a list of message arguments where
-each message argument has the following form:
-
-   (mode [value [type]]) or just value
-
-Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.  
-If type isn't specified then \"int\" is used if the value is a 
-number otherwise \"string\" is used.  If only a value is specified 
-then mode defaults to TT_IN.  If mode is TT_OUT then value and 
-type don't need to be specified.  You can find out more about the 
-semantics and uses of ToolTalk message arguments in chapter 4 of the 
-Tooltalk Programmer's Guide.
-
-The no-callback arg is a hack to prevent the registration of the
-C-level callback.  This hack is needed by the current SPARCworks
-tool startup mechanism.  Yucko."
-  (let ((msg (create-tooltalk-message no-callback)))
-    (initialize-tooltalk-message-attributes msg attributes)
-    msg))
-
-
-(defun describe-tooltalk-message (msg &optional stream)
-  "Print tooltalk message MSG's attributes and arguments to STREAM.
-This is often useful for debugging."
-  (let ((attrs
-        '(address
-          class
-          disposition
-          file
-          gid
-          handler
-          handler_ptype
-          object
-          op
-          opnum
-          otype
-          scope
-          sender
-          sender_ptype
-          session
-          state
-          status
-          status_string
-          uid 
-          callback)))
-    (terpri stream)
-    (while attrs
-      (princ (car attrs) stream)
-      (princ "  " stream)
-      (prin1 (get-tooltalk-message-attribute msg (car attrs)) stream)
-      (terpri stream)
-      (setq attrs (cdr attrs))))
-
-  (let ((n (get-tooltalk-message-attribute msg 'args_count))
-       (i 0))
-    (while (< i n)
-      (princ "Argument " stream)
-      (princ i stream)
-      (princ "  " stream)
-      (let ((type (get-tooltalk-message-attribute msg 'arg_type i)))
-       (princ
-        (prin1-to-string
-         (list 
-          (get-tooltalk-message-attribute msg 'arg_mode i)
-          (if (equal type "int")
-              (get-tooltalk-message-attribute msg 'arg_ival i)       
-              (get-tooltalk-message-attribute msg 'arg_val i))
-          type))
-        stream))
-      (terpri stream)
-      (setq i (1+ i)))))
-
-
-(defun initialize-tooltalk-pattern-arg (pat n mode value vtype)
-  "Add one argument to tooltalk pattern PAT.
-No support for specifying pattern arguments whose value is a vector
-of binary data is provided."
-  (let ((converted-value   
-        (if (or (integerp value) (stringp value))
-            value
-          (prin1-to-string value))))
-    (add-tooltalk-pattern-arg pat mode vtype converted-value)))
-
-
-(defun initialize-tooltalk-pattern-attributes (pat attributes)
-  "Initialize tooltalk pattern PAT's attributes.
-ATTRIBUTES must be a property list in the same form as for
-`make-tooltalk-pattern'.  The value of each attribute (except 'category)
-can either be a single value or a list of values.  If a list of
-values is provided then the pattern will match messages with
-a corresponding attribute that matches any member of the list.
-
-This function can be used to add attribute values to an existing
-pattern or to initialize a new one.  See
-`initialize-tooltalk-message/pattern-args' for a description of how
-arguments are initialized."
-  (let ((args attributes)
-       (initfn 'initialize-tooltalk-pattern-arg))
-    (while (and args (cdr args))
-      (let ((indicator (car args))
-           (value (car (cdr args))))
-       (cond
-        ((eq indicator 'args)
-         (initialize-tooltalk-message/pattern-args initfn pat value))
-        ((eq indicator 'plist)
-         (let ((values value))
-           (while values
-             (let ((prop (car values))
-                   (propval (car (cdr values))))
-               (tooltalk-pattern-prop-set pat prop propval))
-             (setq values (cdr (cdr values))))))
-        ((consp value)
-         (let ((values value))
-           (while values
-             (add-tooltalk-pattern-attribute (car values) pat indicator)
-             (setq values (cdr values)))))
-        (t
-         (add-tooltalk-pattern-attribute value pat indicator))))
-      (setq args (cdr (cdr args))))))
-
-
-
-(defun make-tooltalk-pattern (attributes)
-  "Create a tooltalk pattern and initialize its attributes.
-The value of attributes must be a list of alternating keyword/values, 
-where keywords are symbols that name valid pattern attributes
-or lists of valid attributes.  For example:
-
-  (make-tooltalk-pattern 
-    '(category TT_OBSERVE
-      scope TT_SESSION
-      op (\"operation1\" \"operation2\")
-      args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
-
-
-Values must always be strings, integers, or symbols that
-represent Tooltalk constants or lists of same.  When a list 
-of values is provided all of the list elements are added to 
-the attribute.  In the example above, messages whose op
-attribute is \"operation1\" or \"operation2\" would match the pattern.
-
-The value of args should be a list of pattern arguments where 
-each pattern argument has the following form:
-
-   (mode [value [type]]) or just value
-
-Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.  
-If type isn't specified then \"int\" is used if the value is a 
-number otherwise \"string\" is used.  If only a value is specified 
-then mode defaults to TT_IN.  If mode is TT_OUT then value and type 
-don't need to be specified.  You can find out more about the semantics 
-and uses of ToolTalk pattern arguments in chapter 3 of the Tooltalk
-Programmers Guide.
-"
-  (let ((pat (create-tooltalk-pattern)))
-    (initialize-tooltalk-pattern-attributes pat attributes)
-    pat))
-
-
-