aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/ChangeLog11
-rw-r--r--src/interp/i-syscmd.boot.pamphlet23
-rw-r--r--src/interp/patches.lisp.pamphlet23
3 files changed, 34 insertions, 23 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 46e7e879..97bd4bdb 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,14 @@
+2007-09-06 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * patches.lisp.pamphlet (reset-highlight): Move to i-syscmd.boot.
+ (clear-highlight): Likewise.
+ (|spool|): Likewise.
+ * i-syscmd.boot.pamphlet (clearHighlight): Move from
+ patches.lisp.pamphlet. Rename from clear-highlight. Implement as
+ Boot code.
+ (resetHighlight): Move from patches.lisp.pamphlet. Rename from
+ clear-highlight. Implement as Boot code.
+
2007-09-05 Gabriel Dos Reis <gdr@cs.tamu.edu>
* Makefile.pamphlet (boot-pkg.lisp): Remove rule.
diff --git a/src/interp/i-syscmd.boot.pamphlet b/src/interp/i-syscmd.boot.pamphlet
index 6bd8b099..30762926 100644
--- a/src/interp/i-syscmd.boot.pamphlet
+++ b/src/interp/i-syscmd.boot.pamphlet
@@ -2425,6 +2425,29 @@ displayOperationsFromLisplib form ==
say2PerLine ops
nil
+--% )spool
+
+clearHighlight() ==
+ $saveHighlight := $highlightAllowed
+ $highlightAllowed := false
+ $saveSpecialchars := $specialCharacters
+ setOutputCharacters ["plain"]
+
+resetHighlight() ==
+ $highlightAllowed := $saveHighlight
+ $specialCharacters := $saveSpecialchars
+
+spool filename ==
+ null filename =>
+ DRIBBLE()
+ TERPRI()
+ resetHighlight()
+ PROBE_-FILE car filename =>
+ systemError CONCAT('"file ", STRING car filename, '" already exists")
+ DRIBBLE car filename
+ TERPRI()
+ clearHighlight
+
--% )synonym
synonym(:l) == synonymSpad2Cmd() -- always passed a null list
diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet
index 0ca525ee..82977f1f 100644
--- a/src/interp/patches.lisp.pamphlet
+++ b/src/interp/patches.lisp.pamphlet
@@ -92,29 +92,6 @@ previous definition.
`(if (is-console ,streamvar)
(setq ,streamvar *terminal-io*)))
-(defun clear-highlight ()
- (let ((|$displaySetValue| nil))
- (declare (special |$displaySetValue| |$saveHighlight| |$saveSpecialchars|))
- (setq |$saveHighlight| |$highlightAllowed|
- |$highlightAllowed| nil)
- (setq |$saveSpecialchars| |$specialCharacters|)
- (|setOutputCharacters| '(|plain|))))
-
-(defun reset-highlight ()
- (setq |$highlightAllowed| |$saveHighlight|)
- (setq |$specialCharacters| |$saveSpecialchars|))
-
-(defun |spool| (filename)
- (cond ((null filename)
- (dribble) (TERPRI)
- (reset-highlight))
- ((probe-file (car filename))
- (error (format nil "file ~a already exists" (car filename))))
- (t (dribble (car filename))
- (TERPRI)
- (clear-highlight))
- ))
-
(defun |cd| (args)
(cond ((null args)
#+(and :lucid :ibm/370)