;; Function To Be Tested: PP  (Programmer's Assistant Command)
;;
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
;;		CLtL, Section 20.2
;; Section: The Evaluator
;; Page: 29
;;
;; Created By:   John Park
;;
;; Creation Date: Feb 17, 1987
;;
;; Last Update:  Mar 23, 1987 
;;
;; Filed As:      {ERIS}<lispcore>integration>exec>pp.u
;;
;;
;; Syntax:        PP &optional NAME &rest TYPES
;;
;; Function Description: Show (prettyprinted) the definitions for NAME specified by
;; TYPES
;; 
;; Argument(s):  NAME (object) & TYPES (function, macro, vars, etc)
;;			  
;; Returns:     See function description
;;
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
;; testing them will be accomplished by using the interlisp function bksysbuf 
;; in do-test form.  Comments are incorporated within  each command file. 
;; The do-test test setup is titled "TY-TEST-SETUP", which executes the command 
;; string. The do-test form within the command file will return T or "test "quote" 
;; failed in file "unknown". " This test file requires TEDIT package.  
;; The test result will be logged automatically in the following file:
;; {ERIS}<lispcore>test>exec>test.report
;; Messages will be printed before each command in the command files is executed for
;; user monitoring. This test will pp an object to a stream, which is opened for 
;; user review.  Keyword (object name) should be in bold and pretty printed
;; definitions should be formatted for readability.  This test determines whether
;; Keyword(s) are in bold and function/macro definitions are structured.

(DO-TEST 'PP-TEST-SETUP
	(PROGN
		(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
		(DEFUN R-FORMAT (STATUS) 
			(FORMAT *OUTPUT* "~%COMMAND: PP ~%STATUS:  ~A  DATE:  ~A  TESTER:  ~A~%" STATUS (IL:DATE) IL:USERNAME))
 		(SETQ MESS0 "Defining a function called message .....")
		(SETQ MESS1 "Pretty printing the function definition for message...") 
		(SETQ MESS2 "Creating a stream to output a pretty printed function defintion...")
		(SETQ MESS2.5 "The keyword message should be in bold and the function should be printed with indentation...")

		(SETQ MESS3 "Saving the pretty-printed function definition in a file...")
		(SETQ MESS4 "Setting message to some value.....")
		(SETQ MESS5 "Pretty printing the variable definition for message...") 
		(SETQ MESS6 "Creating a stream to output a pretty printed variable defintion...")
		(SETQ MESS6.5 "The keyword message should be in bold...")
		(SETQ MESS7 "Saving the pretty-printed varible definition in a file...")
		(SETQ DO-LIST-CONTENTS-F
			'("(defun message (mess) (progn (princ mess)"
			"(sleep 1)"
			"(values)))"))
		(SETQ VARIABLE-STRING "(il:rpaqq message this-is-a-variable)")
		(SETQ PP-COMMAND-STRING 
";; Test to see if the function message is pretty-printed
(MESSAGE MESS0)
(DEFUN MESSAGE (MESS) (PROGN (PRINC MESS)(SLEEP 1)(VALUES)))
(MESSAGE MESS1)
PP MESSAGE FUNCTION
(MESSAGE MESS2)
(SETQ PP-WINDOW-F (IL:CREATEW '(100 100 400 200)
		  		'PP-WINDOW-FOR-TESTING))
(SETQ *STANDARD-OUTPUT1* *STANDARD-OUTPUT*) ; Save the original pointer
(SETQ PP-STREAM-F (IL:OPENTEXTSTREAM NIL PP-WINDOW-F))
(SETQ *STANDARD-OUTPUT* PP-STREAM-F)
PP MESSAGE FUNCTION
(SETQ *STANDARD-OUTPUT* *STANDARD-OUTPUT1*) ; Change it back to original pointer
(MESSAGE MESS2.5)
(SETQ SELECTION-F (IL:TEDIT.SETSEL PP-STREAM-F 8 7))
(SETQ PLIST-F (IL:TEDIT.GET.LOOKS   PP-STREAM-F SELECTION-F))
(SETQ KEYWORD-F
 	(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-F '(IL:WEIGHT)))))
;; Should return IL:BOLD
(SETQ SELECTION-F1 (IL:TEDIT.SETSEL PP-STREAM-F 16 27))
(SETQ PLIST-F1 (IL:TEDIT.GET.LOOKS PP-STREAM-F SELECTION-F1))
(SETQ NONKEYWORD-F
 	(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-F1 '(IL:WEIGHT)))))
;; Should return IL:MEDIUM
(MESSAGE MESS3)
(IL:TEDIT.PUT PP-WINDOW-F '{CORE}PPF)
(CLOSE PP-STREAM-F)
(IL:CLOSEW PP-WINDOW-F)

;; Test to see if the variable message is pretty-printed
(MESSAGE MESS4)
(SETQ MESSAGE 'THIS-IS-A-VARIABLE)
(MESSAGE MESS5)
PP MESSAGE VARS
(MESSAGE MESS6)
(SETQ PP-WINDOW-V (IL:CREATEW '(100 100 400 200)
		  		'PP-WINDOW-FOR-TESTING))
(SETQ *STANDARD-OUTPUT1* *STANDARD-OUTPUT*) 
(SETQ PP-STREAM-V (IL:OPENTEXTSTREAM NIL PP-WINDOW-V))
(SETQ *STANDARD-OUTPUT* PP-STREAM-V)
PP MESSAGE VARS
(SETQ *STANDARD-OUTPUT* *STANDARD-OUTPUT1*)
(SETQ SELECTION-V (IL:TEDIT.SETSEL PP-STREAM-V 12 7))
(SETQ PLIST-V (IL:TEDIT.GET.LOOKS   PP-STREAM-V SELECTION-V))
(MESSAGE MESS6.5)
(SETQ KEYWORD-V
 	(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-V '(IL:WEIGHT)))))
;; Should return IL:BOLD

(SETQ SELECTION-V1 (IL:TEDIT.SETSEL PP-STREAM-V 20 4))
(SETQ PLIST-V1 (IL:TEDIT.GET.LOOKS PP-STREAM-V SELECTION-V1))
(SETQ NONKEYWORD-V
 	(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-V1 '(IL:WEIGHT)))))
;; Should return IL:MEDIUM
(MESSAGE MESS7)
(IL:TEDIT.PUT PP-WINDOW-V '{CORE}PPV)
(CLOSE PP-STREAM-V)
(IL:CLOSEW PP-WINDOW-V)
(SETQ PPF-FLG NIL)
(SETQ STREAM-F (OPEN '{CORE}PPF))
(SETQ STREAM-V (OPEN '{CORE}PPV))
(DOLIST  (Y DO-LIST-CONTENTS-F)
	(IF (STRING-EQUAL Y (READ-LINE STREAM-F)) 
		(PUSH T PPF-FLG)
		(PUSH NIL PPF-FLG)
	)
)
(READ-LINE STREAM-V)
(IF (STRING-EQUAL (READ-LINE STREAM-V) VARIABLE-STRING ) 
	(SETQ PPV-FLG T)
	(SETQ PPV-FLG NIL)
)
(MAPCAR #'CLOSE (IL:OPENP))
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
(DO-TEST 'SEE-WITHOUT-COMMENT-TEST-RESULT
   	(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
		 		:IF-EXISTS  :APPEND))
            (IF (AND (NOT (EQ KEYWORD-F NONKEYWORD-F))
				(NOT (EQ KEYWORD-V NONKEYWORD-V))
				(NOTANY #'NULL PPF-FLG)
				(EQ PPV-FLG T))
				(PROGN (R-FORMAT 'SUCCESS) T)
				(PROGN (R-FORMAT 'FAIL) NIL))
             (CLOSE *OUTPUT*)
	)
)

")
		(IL:BKSYSBUF PP-COMMAND-STRING)
	)
)

STOP