90 lines
3.1 KiB
Plaintext
90 lines
3.1 KiB
Plaintext
;; Function To Be Tested: UNDO (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; Section 20.2 (The Evaluator), Page 27
|
|
;; Section: The Evaluator
|
|
;; Page: 28
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 24, 1987
|
|
;;
|
|
;; Last Update:
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>exec>undo.u
|
|
;;
|
|
;;
|
|
;; Syntax: UNDO &rest EVENT-SPEC
|
|
;;
|
|
;; Function Description: Undo the side effects of the specified event. The UNDO
|
|
;; command is implemented by "watching" the evaluation of forms and requiring
|
|
;; undoable operations in that evaluation to save enough information on the history
|
|
;; list to reverse their side effects. The Exec simply executes operations, and
|
|
;; any undoable changes that occur are automatically saved on the history list by
|
|
;; the responsible functions. The UNDO command works on itself the same way:
|
|
;; it recovers the saved information and performs the corresponding inverses.
|
|
;; thus, UNDO is effective on itself, so that the user can UNDO an UNDO, and UNDO
|
|
;; that, etc.
|
|
;;
|
|
;; Argument(s): EVENT-SPEC
|
|
;;
|
|
;; Returns: See function description
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will not be totally automatic. Comments are incorporated within
|
|
;; each command file, which will be run by using the function bksysbuf.
|
|
;; Each test setup is titled "COMMAND-TEST-SETUP", which executes the command
|
|
;; string. The do-test form within the command file will return T or "test
|
|
;; failed" This test file requires TEDIT package.
|
|
;;
|
|
;;
|
|
;; Messages will be printed before each command in the command files is executed
|
|
;; for user monitoring. Test result is logged on
|
|
;; {eris}<lispcore>test>exec>test.report.
|
|
|
|
(DO-TEST "UNDO-TEST-SETUP"
|
|
(PROGN
|
|
(SETQ MESS1 "Now do-test will determine if correct results have been produced when UNDOs were entered...")
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~2%COMMAND: UNDO~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
|
|
(SETQ UNDO-COMMAND-STRING
|
|
"; Unbound all undo variables
|
|
(MAPCAR #'MAKUNBOUND '(UNDO-VAR UNDO-VAR-1 UNDO-VAR-2))
|
|
(SETQ UNDO-VAR 'YES)
|
|
(SETQ UNDO-VAR-1 'YES-NO)
|
|
; this undoes undo-var
|
|
UNDO -2
|
|
(IF (NOT (BOUNDP 'UNDO-VAR)) (SETQ UNDO-VAR 'UNBOUND) (SETQ UNDO-VAR 'BOUND))
|
|
(SETQ UNDO-VAR-2 'YES-NO)
|
|
(SETQ UNDO-VAR-2 'NO)
|
|
; This undoes the last event and undo-var-2 is still bound
|
|
UNDO
|
|
(IF (EQ UNDO-VAR-2 'YES-NO) (SETQ UNDO-VAR-2F 'STILL-BOUND) (SETQ UNDO-VAR-2F 'GONE))
|
|
; this will restore the value of undo-var-2 to its first value
|
|
UNDO UNDO
|
|
(IF (EQ UNDO-VAR-2 'NO) (SETQ UNDO-VAR-2R 'RESTORED) (SETQ UNDO-VAR-2R 'SAME))
|
|
(FORMAT NIL MESS1)
|
|
(DO-TEST 'UNDO-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (EQ UNDO-VAR 'UNBOUND)
|
|
(EQ UNDO-VAR-2F 'STILL-BOUND)
|
|
(EQ UNDO-VAR-2R 'RESTORED))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
")
|
|
(IL:BKSYSBUF UNDO-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|