If you're not a gung-ho Emacs user, you need read no further.

Even if you are a gung-ho Emacs user, if you're not using Xemacs 19.10 or later
(Xemacs is the new name for what used to be called Lucid Emacs) this won't
apply.

The enclosed bit of Xemacs elisp will make Xemacs respond to the standard Media
Exchange ToolTalk messages; this makes Xemacs substitute for dtpad when
displaying and editing objects like files and mail attachments.

To use it, save this attachment somewhere, load the attachment into your Xemacs
(you might want to edit your ~/.emacs to do this all the time) and make sure
you
don't have a dtpad server running (ps -elf > grep dtpad and kill any "dtpad
-server" processes.)

Then try double-clicking on text files in dtfile, or on text attachments in
dtmail.  The file/attachment should be loaded into your running Xemacs.

;;; @(#)cde-media-exchange.el	1.1 95/08/24

;;; Make Xemacs a CDE/Media Exchange ToolTalk client.
;;;
;;; Bugs:
;;;   - For buffer editing, need to do Deposits on saving.
;;;     does write-file-hooks help?
;;;     I bet ange-ftp has example of what to do
;;;   - does not yet send the dt housekeeping notices like
;;;     Started and Stopped, or Saved notices when saving files.

(defvar ttmx-use-new-screen t "t if media exchange opens should create a new
screen if one isn't showing the
file. nil if the current screen should be re-used.")

;; ToolTalk will always prefer a running process to one that would
;; have to be started.  We also have Xemacs, like dtpad, register
;; for ANY media type.  This ends up meaning that if dtmail isn't running
;; but Xemacs is, Display requests for mail folders get sent to Xemacs
;; instead of starting dtmail.  We work around this by having a Xemacs
;; reject anything that doesn't have a handler-ptype of DTPAD.
;; dtpad gets that behavior by default because it registers its patterns
;; via tt_ptype_declare, and the patterns so generated have handler-ptype
;; set.  If Xemacs's ToolTalk support had tt_ptype_declare we could
;; do the same thing.

(defun ttmx-reject-invalid-types (msg) "
If the message is not for the generic editor (ptype DTPAD) reject it
and return t else return nil"
  (cond
   ((string= (get-tooltalk-message-attribute msg 'handler_ptype) "DTPAD")
    nil)
   (t
    (return-tooltalk-message msg 'reject)
    t)
   )
  )
    
  

(defun ttmx-switch-to-buffer (buf) "Switch to a buffer either in current screen
or a new screen, under control
of ttmx-use-new-screen"
  (if ttmx-use-new-screen
      (switch-to-buffer-other-screen buf)
    (switch-to-buffer buf)
    )
  )
  
;; register a session-scoped handle pattern

(defun ttmx-register-handle-pat(op args callback) "Register a session-scoped
ToolTalk pattern to handle a Media Exchange message."
  (let ((pat (create-tooltalk-pattern)))
    (add-tooltalk-pattern-attribute 'TT_HANDLE pat 'category)
    (add-tooltalk-pattern-attribute 'TT_SESSION pat 'scope)
    (add-tooltalk-pattern-attribute op pat 'op)
    (add-tooltalk-pattern-attribute callback pat 'callback)
    (while args
      (let* ((arg (car args))
	     (mode (car arg))
	     (vtype (car (cdr arg))))
	(add-tooltalk-pattern-arg pat mode vtype nil)
	)
      (setq args (cdr args))
      )
    (register-tooltalk-pattern pat)
    )
  )

;; Helper function to tag current buffer so request will be responded to
;; when buffer is deleted

(defun ttmx-tag-buffer (msg)
  (make-local-variable 'ttmx-messages)
  (if (not (boundp 'ttmx-messages)) (setq ttmx-messages nil))
  (setq ttmx-messages (cons msg ttmx-messages))
  (add-hook 'kill-buffer-hook 'ttmx-respond-to-buffer-messages)
  )

;; Helper functions to respond to and remove all messages associated with
;; current buffer

(defun ttmx-respond-to-buffer-messages()
  (if (boundp 'ttmx-messages)
      (mapcar
       (function (lambda (x) (return-tooltalk-message x 'reply)))
       ttmx-messages)
    )
  (setq ttmx-messages nil)
  )

;; Ensure all messages are responded to when killing emacs

(add-hook
 'kill-emacs-hook
 (function
  (lambda ()
    (save-excursion
      (mapcar
       (function
	(lambda (buf)
	  (set-buffer buf)
	  (ttmx-respond-to-buffer-messages)
	  )
	)
       (buffer-list t)
       )
      )
    )
  )
 )

;; Display (read-only) a buffer

(defun ttmx-display-buffer (contents title counterfoil msg)
  (let ((buf (generate-new-buffer title)))
    (ttmx-switch-to-buffer buf)
    (insert contents)
    (set-buffer-modified-p nil)
    (setq buffer-read-only t)
  )
)

;; Edit a buffer

(defun ttmx-edit-buffer (contents title counterfoil msg)
  (let ((buf (generate-new-buffer title)))
    (ttmx-switch-to-buffer buf)
    (insert contents)
    (ttmx-tag-buffer msg)
    )
  )

;; Edit or display a file -- let permissions of file control read/write
;; versus read-only.  This is consistent with the behavior of dtpad,
;; although not very consistent with the defined meanings of
;; the Edit and Display messages. 

(defun ttmx-edit-file (filename title counterfoil msg)
  (let* ((buf (find-file-noselect filename))
	 (window (get-buffer-window buf t t))
	 )
    (if window
	(let ((screen (window-screen window)))
	  (deiconify-screen screen)
	  (raise-screen screen)
	  (set-buffer buf)
	  )
      (ttmx-switch-to-buffer buf)
      )
    (if title (rename-buffer title t))
    (ttmx-tag-buffer msg)
    )
  )

;; session Display(in ALL contents)

(defun ttmx-disp-1 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0)))
      (if (not (string-equal "" contents))
	  (ttmx-display-buffer contents "Unnamed" nil msg)
	(ttmx-edit-file (get-tooltalk-message-attribute msg 'file)
			"Unnamed" nil msg)
	)
      )
    )
  )

(ttmx-register-handle-pat
 "Display"
 '((TT_IN "ALL" contents))
 'ttmx-disp-1)

;; session Display(in ALL contents, in messageID counterfoil)
      
(defun ttmx-disp-2 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0)))
      (if (not (string-equal "" contents))
	  (ttmx-display-buffer contents "Unnamed" nil msg)
	(ttmx-edit-file (get-tooltalk-message-attribute msg 'file)
			nil nil msg)
	)
      )
    )
  )
    

(ttmx-register-handle-pat
 "Display"
 '((TT_IN "ALL" contents) (TT_IN "messageID" counterfoil)) 
 'ttmx-disp-2)

;; session Display(in ALL contents, in title docName)

(defun ttmx-disp-3 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0))
	  (title (get-tooltalk-message-attribute msg 'arg_val 1))
	  )
      (if (not (string-equal "" contents))
	  (ttmx-display-buffer contents title nil msg)
	(ttmx-edit-file
	 (get-tooltalk-message-attribute msg 'file) title nil msg)
	)
      )
    )
  )
    

(ttmx-register-handle-pat
 "Display"
 '((TT_IN "ALL" contents) (TT_IN "title" docName)) 
 'ttmx-disp-3)

;; session Display(in ALL contents, in messageID counterfoil, in title docName)

(defun ttmx-disp-4 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0))
	  (title (get-tooltalk-message-attribute msg 'arg_val 2))
	  )
      (if (not (string-equal "" contents))
	  (ttmx-display-buffer contents title nil msg)
	(ttmx-edit-file
	 (get-tooltalk-message-attribute msg 'file) title nil msg)
	)
      )
    )
  )

(ttmx-register-handle-pat
 "Display"
 '((TT_IN "ALL" contents) (TT_IN "messageID" counterfoil)
   (TT_IN "title" docName)) 
 'ttmx-disp-4)

;; session Edit(inout ALL contents) 

(defun ttmx-edit-1 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0)))
      (if (not (string-equal "" contents))
	  (ttmx-edit-buffer contents "Unnamed" nil msg)
	(ttmx-edit-file (get-tooltalk-message-attribute msg 'file)
			nil nil msg)
	)
      )
    )
  )

(ttmx-register-handle-pat
 "Edit"
 '((TT_INOUT "ALL" contents))
 'ttmx-edit-1)

;; session Edit(inout ALL contents, in messageID counterfoil) 
      
(defun ttmx-edit-2 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0)))
      (if (not (string-equal "" contents))
	  (ttmx-edit-buffer contents "Unnamed" nil msg)
	(ttmx-edit-file (get-tooltalk-message-attribute msg 'file)
			nil nil msg)
	)
      )
    )
  )
    

(ttmx-register-handle-pat
 "Edit"
 '((TT_INOUT "ALL" contents) (TT_IN "messageID" counterfoil)) 
 'ttmx-edit-2)

;; session Edit(inout ALL contents, in title docName) 

(defun ttmx-edit-3 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0))
	  (title (get-tooltalk-message-attribute msg 'arg_val 1))
	  )
      (if (not (string-equal "" contents))
	  (ttmx-edit-buffer contents title nil msg)
	(ttmx-edit-file
	 (get-tooltalk-message-attribute msg 'file) title nil msg)
	)
      )
    )
  )
    

(ttmx-register-handle-pat
 "Edit"
 '((TT_INOUT "ALL" contents) (TT_IN "title" docName)) 
 'ttmx-edit-3)

;; session Edit(inout ALL contents, in messageID counterfoil, in title docName)

(defun ttmx-edit-4 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (let ((contents (get-tooltalk-message-attribute msg 'arg_val 0))
	  (title (get-tooltalk-message-attribute msg 'arg_val 2))
	  )
      (if (not (string-equal "" contents))
	  (ttmx-edit-buffer contents title nil msg)
	(ttmx-edit-file
	 (get-tooltalk-message-attribute msg 'file) title nil msg)
	)
      )
    )
  )

(ttmx-register-handle-pat
 "Edit"
 '((TT_INOUT "ALL" contents) (TT_IN "messageID" counterfoil)
   (TT_IN "title" docName)) 
 'ttmx-edit-4)

;; session Edit(out ALL contents) 

(defun ttmx-edit-5 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg)
      nil
    (ttmx-edit-buffer "" "Unnamed" nil msg)
    )
  )
    

(ttmx-register-handle-pat
 "Edit"
 '((TT_OUT "ALL" contents))
 'ttmx-edit-5)

;; session Edit(out ALL contents, in messageID counterfoil) 

(ttmx-register-handle-pat
 "Edit"
 '((TT_OUT "ALL" contents) (TT_IN "messageID" counterfoil))
 'ttmx-edit-5)

;; session Edit(out ALL contents, in title docName) 

(defun ttmx-edit-7 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg) (return nil))
  (let ((title (get-tooltalk-message-attribute msg 'arg_val 1))
	)
    (ttmx-edit-buffer "" title nil msg)
    )
  )
    
(ttmx-register-handle-pat
 "Edit"
 '((TT_OUT "ALL" contents) (TT_IN "title" docName)) 
 'ttmx-edit-7)


;; session Edit(out ALL contents, in messageID counterfoil, in title docName) 

(defun ttmx-edit-8 (msg pat) "Pattern callback"
  (if (ttmx-reject-invalid-types msg) (return nil))
  (let ((title (get-tooltalk-message-attribute msg 'arg_val 2))
	)
    (ttmx-edit-buffer "" title nil msg)
    )
  )

(ttmx-register-handle-pat
 "Edit"
 '((TT_OUT "ALL" contents) (TT_IN "messageID" counterfoil)
   (TT_IN "title" docName)) 
 'ttmx-edit-8)

SOLUTION SUMMARY: