108 lines
3.3 KiB
Plaintext
108 lines
3.3 KiB
Plaintext
;; Function To Be Tested: SEE* (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 16, 1987
|
|
;;
|
|
;; Last Update: Feb 27, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>integration>exec>see-without-comment.u
|
|
;;
|
|
;;
|
|
;; Syntax: SEE* &rest FILES
|
|
;;
|
|
;; Function Description: Print the contents of FILES in the exec window, showing
|
|
;; comments
|
|
;;
|
|
;; Argument(s): None
|
|
;;
|
|
;; 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 "SEE*-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
|
|
|
|
(DO-TEST 'SEE*-TEST-SETUP
|
|
(PROGN
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: SEE ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
(SETQ MESS1 "Creating a file with comments in ({core}<SEE*>)...")
|
|
(SETQ MESS2 "Displaying the Contents of a file with comments...")
|
|
(SETQ MESS3 "Now do-test will determine if the file {core}TEST contain the contents as displayed by SEE* command")
|
|
(DEFUN MESSAGE (MESS) (PROGN
|
|
(PRINC MESS)
|
|
(SLEEP 1)
|
|
(VALUES)
|
|
)
|
|
)
|
|
|
|
(MESSAGE MESS1)
|
|
(SETQ SEE*-WINDOW (IL:CREATEW '(100 100 400 200)
|
|
"SEE* WINDOW FOR TESTING"))
|
|
(SETQ SEE*-STREAM
|
|
(IL:OPENTEXTSTREAM ";;;; Lisp Init File
|
|
;;; Set up the USER package.
|
|
(require 'calculus) ;I use CALCULUS a lot. Loat it.
|
|
(use-package 'calculus) ;Get easy access to its exported symbols.
|
|
(require 'newtonian-mechanics) ;Ditto for NEWTONIAN-MECHANICS.
|
|
(use-package 'newtonia-mechanics)" SEE*-WINDOW))
|
|
(IL:TEDIT.PUT SEE*-WINDOW '{CORE}SEE)
|
|
(CLOSE SEE*-STREAM)
|
|
(IL:CLOSEW SEE*-WINDOW)
|
|
(SETQ DO-LIST-CONTENTS '(";;;; Lisp Init File"
|
|
";;; Set up the USER package."
|
|
"(require 'calculus) ;I use CALCULUS a lot. Loat it."
|
|
"(use-package 'calculus) ;Get easy access to its exported symbols."
|
|
"(require 'newtonian-mechanics) ;Ditto for NEWTONIAN-MECHANICS."
|
|
"(use-package 'newtonia-mechanics)"))
|
|
|
|
(SETQ SEE*-COMMAND-STRING
|
|
"(MESSAGE MESS2)
|
|
(DRIBBLE '{CORE}SEE-TEST)
|
|
SEE* {CORE}SEE
|
|
(DRIBBLE)
|
|
(MESSAGE MESS3)
|
|
(SETQ CONTENTS-EXIST-FLG NIL)
|
|
(SETQ X (OPEN '{CORE}SEE-TEST))
|
|
(DO ((CNT 0 (1+ CNT))) ; moves the pointer to 4th line
|
|
((= CNT 3) T)
|
|
(READ-LINE X))
|
|
(DOLIST (Y DO-LIST-CONTENTS)
|
|
(IF (STRING-EQUAL Y (READ-LINE X))
|
|
(PUSH T CONTENTS-EXIST-FLG)
|
|
(PUSH NIL CONTENTS-EXIST-FLG))
|
|
)
|
|
(CLOSE X)
|
|
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
|
|
(DO-TEST 'FIND-EVENT-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (NOTANY #'NULL CONTENTS-EXIST-FLG)
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
|
|
")
|
|
(IL:BKSYSBUF SEE*-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|