mirror of
https://github.com/PDP-10/its.git
synced 2026-01-24 11:22:36 +00:00
87 lines
3.6 KiB
Plaintext
Executable File
87 lines
3.6 KiB
Plaintext
Executable File
|
||
(declare (special dribblefile startdribblefn stopdribblefn
|
||
^r outfiles msgfiles echofiles defaultf)
|
||
(macros nil)
|
||
(*lexpr dribble))
|
||
|
||
(defun REMOVE-DRIBBLE macro (l)
|
||
(list '(lambda (dfile)
|
||
(or (setq outfiles (delq dfile outfiles))
|
||
(setq ^r nil))
|
||
(setq msgfiles (delq dfile msgfiles))
|
||
(setq echofiles (delq dfile echofiles))
|
||
dfile)
|
||
(cadr l)))
|
||
|
||
(defun ADD-DRIBBLE macro (l)
|
||
(list '(lambda (dfile)
|
||
(or (memq dfile outfiles)
|
||
(setq outfiles (cons dfile outfiles)))
|
||
(or (memq dfile msgfiles)
|
||
(setq msgfiles (cons dfile msgfiles)))
|
||
(or (memq dfile echofiles)
|
||
(setq echofiles (cons dfile echofiles)))
|
||
(setq ^r t)
|
||
dfile)
|
||
(cadr l)))
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(cond((not(status features newio))
|
||
(terpri)
|
||
(princ '|DRIBBLE in NEWIO only!|)
|
||
(^g)))
|
||
|
||
;; DRIBBLEFILE is the current open (or most recently closed) dribble file object.
|
||
(setq DRIBBLEFILE nil)
|
||
|
||
|
||
(defun DRIBBLE args
|
||
;; (DRIBBLE filename) starts dribbling into the file.
|
||
;; The filename can be a namestring or namelist.
|
||
;; (DRIBBLE NIL) stops dribbling.
|
||
;; (DRIBBLE) restarts dribbling into the old file in append mode,
|
||
;; if a dribblefile already exists, that is.
|
||
;; Otherwise, starts dribbling into the file DSK:udir;DRIBBL >.
|
||
;; Dribbling entails creating a file and adding it to MSGFILES, ECHOFILES
|
||
;; and OUTFILES. ^R is set to T. (NB In a breakpoint, for example, ^R
|
||
;; is bound to NIL, thus inhibiting the dribble.)
|
||
;; When a dribblefile is opened and closed, the functional values of
|
||
;; STARTDRIBBLEFN and STOPDRIBBLEFN respectively will be executed; they will
|
||
;; receive the dribble file object as argument.
|
||
(prog (dribbling? return)
|
||
(setq return
|
||
(and (setq dribbling? (and dribblefile (status filemode dribblefile)))
|
||
(truename dribblefile)))
|
||
(cond
|
||
((or (zerop args) (eq (arg 1) T))
|
||
;; Restart DRIBBLE.
|
||
(cond((not dribbling?)
|
||
(setq dribblefile
|
||
(add-dribble (cond(dribblefile
|
||
(open dribblefile (cond((probef dribblefile)
|
||
'append)
|
||
('out))))
|
||
((open (list (list 'DSK (STATUS UDIR))
|
||
'DRIBBL '>) 'out)))))))
|
||
(and (boundp 'startdribblefn) startdribblefn
|
||
(funcall startdribblefn dribblefile)))
|
||
((eq (arg 1) NIL)
|
||
;; UNDRIBBLE.
|
||
(cond(dribbling?
|
||
(and (boundp 'stopdribblefn) stopdribblefn
|
||
(funcall stopdribblefn dribblefile))
|
||
(close (remove-dribble dribblefile)))))
|
||
|
||
(t ;; DRIBBLE.
|
||
(dribble nil) ;close current dribble file.
|
||
(setq dribblefile
|
||
(add-dribble (open (defaultf
|
||
(mergef (namelist (arg 1))
|
||
defaultf))
|
||
'out)))
|
||
(and (boundp 'startdribblefn) startdribblefn
|
||
(funcall startdribblefn dribblefile))))
|
||
(return return)))
|
||
|
||
|