;;; -*- Mode:Common-Lisp; Package:TV; Base:10 -*-

;;; **********************************************************************
;;; Copyright (c) 1990 Stanford University.
;;; This code was written by James Rice.
;;; Copyright is held by Stanford University except where code has been
;;; modified from TI source code.  In these cases TI code is marked with
;;; a suitable comment.

;;; All Stanford Copyright code is in the public domain.  This code may be
;;; distributed and used without restriction as long as this copyright
;;; notice is included and no fee is charged.  This can be thought of as
;;; being equivalent to the Free Software Foundation's Copyleft policy.

;;; TI source code may only be distributed to users who hold valid TI
;;; software licenses.

;;; The development of this software was assisted by the following grants:
;;; Biomedical Research Technology Program of the National Institutes
;;; of Health under grant RR-00785
;;; Information Systems Technologies office of the Defense Advanced
;;; Research Projects Agency under contract N00039-86-C0033.

;;; **********************************************************************


(defmethod describe :Around ((rhb array))
"Shows rubout handlers in simple way, otherwise just does the default thing
for arrays.
"
  (if (rhb-p rhb)
      (multiple-value-bind (fill-string typein-string scan-string full-string)
	  (Rhb-String rhb t)
	(format t "~&~S is a rubout handler buffer" rhb)
	(format t "~&Fill Pointer:~16T~D" (rhb-fill-pointer rhb))
	(format t "~&Fill Text:~16T~S" fill-string)
	(format t "~&Scan Pointer:~16T~D" (rhb-scan-pointer rhb))
	(format t "~&Scan Text:~16T~S" scan-string)
	(format t "~&Typein Pointer:~16T~D" (rhb-typein-pointer rhb))
	(format t "~&Typein Text:~16T~S" typein-string)
	(format t "~&Full Text:~16T~S" full-string)
      )
      (clos:call-next-method)
  )
)

;-------------------------------------------------------------------------------

(defun watch-rh (fspec &optional (leave-p nil) (stream self))
"Prints out interesting things about rubout handlers."
  (declare (special yw:*edit-server*))
  (with-standard-io-environment
    (let ((*standard-output* yw:*edit-server*))
	 (if leave-p
	     (format t "~&----------------< Exit  ~S" fspec)
	     (format t "~&----------------> Enter ~S" fspec)
	 )
	 (describe (symeval-in-instance
		     (send (yw:find-mail-window stream) :Prompt-Window)
		     'rubout-handler-buffer
		   )
	 )
    )
  )
)