From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 28 Jan 1999 06:03:23 +0000 (+0000)
Subject: Use new prompt-history mechanism.
X-Git-Tag: 20090517-FFI~4674
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f13db4447db8bd4a064f56bd877b52f6bdaa724;p=mit-scheme.git

Use new prompt-history mechanism.
---

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 1b40fad91..47b0b3356 100644
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: basic.scm,v 1.131 1999/01/02 06:11:34 cph Exp $
+;;; $Id: basic.scm,v 1.132 1999/01/28 06:03:18 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -92,7 +92,7 @@ Allows full text to be seen and edited."
 Prompts for a command and a key, and sets the key's binding.
 The key is bound in fundamental mode."
   (lambda ()
-    (let ((command (prompt-for-command "Command")))
+    (let ((command (prompt-for-command "Command" 'HISTORY 'SET-KEY)))
       (list command
 	    (prompt-for-key (string-append "Put \""
 					   (command-name-string command)
@@ -149,7 +149,7 @@ Turns a following A (or C-A) into a Control-Meta-A."
     (read-extension-key char-control-metafy)))
 
 (define execute-extended-keys?
-  true)
+  #t)
 
 (define extension-commands
   (list (name->command 'control-prefix)
@@ -195,8 +195,9 @@ For more information type the HELP key while entering the name."
     (dispatch-on-command
      (prompt-for-command
       ;; Prompt with the name of the command char.
-      (list (string-append (xkey->name (current-command-key)) " ")))
-     true)))
+      (list (string-append (xkey->name (current-command-key)) " "))
+      'HISTORY 'EXECUTE-EXTENDED-COMMAND)
+     #t)))
 
 ;;;; Errors
 
@@ -235,7 +236,7 @@ For more information type the HELP key while entering the name."
 		    (->namestring (buffer-pathname buffer))))
   (message
    "File on disk now will become a backup file if you save these changes.")
-  (set-buffer-backed-up?! buffer false))
+  (set-buffer-backed-up?! buffer #f))
 
 (define (editor-failure . strings)
   (cond ((not (null? strings)) (apply message strings))
@@ -245,7 +246,7 @@ For more information type the HELP key while entering the name."
 
 (define-variable beeping-allowed?
   "False if Edwin must never beep."
-  true)
+  #t)
 
 (define-integrable (editor-beep)
   (if (ref-variable beeping-allowed?)
@@ -272,23 +273,23 @@ For a normal exit, you should use \\[exit-recursive-edit], NOT this command."
 ;; Set this to #F to indicate that returning from the editor has the
 ;; same effect as calling %EXIT, or to prevent the editor from
 ;; returning to scheme.
-(define editor-can-exit? true)
+(define editor-can-exit? #t)
 
 ;; Set this to #F to indicate that calling QUIT has the same effect
 ;; as calling %EXIT, or to prevent the editor from suspending to the OS.
 (define scheme-can-quit?
-  true)
+  #t)
 
 ;; Set this to #T to force the exit commands to always prompt for
 ;; confirmation before killing Edwin.
-(define paranoid-exit? false)
+(define paranoid-exit? #f)
 
 (define-command suspend-scheme
   "Go back to Scheme's superior job.
 With argument, saves visited file first."
   "P"
   (lambda (argument)
-    (if argument (save-buffer (current-buffer) false))
+    (if argument (save-buffer (current-buffer) #f))
     (if (and scheme-can-quit? (os/scheme-can-quit?))
 	(quit-scheme)
 	(editor-error "Scheme cannot be suspended"))))
@@ -302,7 +303,7 @@ With argument, saves visited file first."
     (quit-editor)))
 
 (define (save-buffers-and-exit no-confirmation? noun exit)
-  (save-some-buffers no-confirmation? true)
+  (save-some-buffers no-confirmation? #t)
   (if (and (or (not (there-exists? (buffer-list)
 		      (lambda (buffer)
 			(and (buffer-modified? buffer)
@@ -316,7 +317,7 @@ With argument, saves visited file first."
 		     "Active processes exist; kill them and exit anyway")
 		    (begin
 		      (for-each delete-process (process-list))
-		      true))
+		      #t))
 	       (or (not paranoid-exit?)
 		   (prompt-for-yes-or-no? (string-append "Kill " noun)))))
       (exit)))
@@ -354,13 +355,13 @@ Setting this variable automatically makes it local to the current buffer."
 The procedure is passed a mark, and should return false if it cannot
 find a comment, or a pair of marks.  The car should be the start of
 the comment, and the cdr should be the end of the comment's starter."
-  false)
+  #f)
 
 (define-variable comment-indent-hook
   "Procedure to compute desired indentation for a comment.
 The procedure is passed the start mark of the comment
 and should return the column to indent the comment to."
-  false)
+  #f)
 
 (define-variable comment-start
   "String to insert to start a new comment, or #f if no comment syntax defined."
@@ -411,7 +412,7 @@ Otherwise, set the comment column to the argument."
 (define-variable comment-multi-line
   "True means \\[indent-new-comment-line] should continue same comment
 on new line, with no new terminator or starter."
-  false
+  #f
   boolean?)
 
 (define-command indent-new-comment-line
diff --git a/v7/src/edwin/compile.scm b/v7/src/edwin/compile.scm
index 4b1eee638..61b7113c5 100644
--- a/v7/src/edwin/compile.scm
+++ b/v7/src/edwin/compile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: compile.scm,v 1.6 1999/01/28 03:59:45 cph Exp $
+;;; $Id: compile.scm,v 1.7 1999/01/28 06:03:23 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-1999 Massachusetts Institute of Technology
 ;;;
@@ -24,7 +24,8 @@
 
 (define-variable compile-command
   "Last shell command used to do a compilation; default for next compilation."
-  "make -k")
+  "make -k"
+  string?)
 
 (define-command compile
   "Compile the program including the current buffer.  Default: run `make'.
@@ -33,7 +34,8 @@ with output going to the buffer *compilation*."
   (lambda ()
     (list (prompt-for-string "Compile command"
 			     (ref-variable compile-command)
-			     'DEFAULT-TYPE 'INSERTED-DEFAULT)))
+			     'DEFAULT-TYPE 'INSERTED-DEFAULT
+			     'HISTORY 'COMPILE)))
   (lambda (command)
     (set-variable! compile-command command)
     (run-compilation command)))
@@ -41,31 +43,31 @@ with output going to the buffer *compilation*."
 (define-command grep
   "Run grep, with user-specified args, and collect output in a buffer."
   (lambda ()
-    (list (prompt-for-string "Run grep (with args): "
-			     previous-grep-arguments
-			     'DEFAULT-TYPE 'INSERTED-DEFAULT)))
+    (list (prompt-for-string "Run grep (with args): " #f
+			     'DEFAULT-TYPE 'INSERTED-DEFAULT
+			     'HISTORY 'GREP)))
   (lambda (command)
-    (set! previous-grep-arguments command)
     (run-compilation (string-append "grep -n " command " /dev/null"))))
 
-(define-command kill-compilation
-  "Kill the process made by the \\[compile] command."
-  ()
+(define-command fgrep
+  "Run fgrep, with user-specified args, and collect output in a buffer."
   (lambda ()
-    (let ((process compilation-process))
-      (if (and process (eq? (process-status process) 'RUN))
-	  (interrupt-process process true)))))
+    (list (prompt-for-string "Run fgrep (with args): " #f
+			     'DEFAULT-TYPE 'INSERTED-DEFAULT
+			     'HISTORY 'FGREP)))
+  (lambda (command)
+    (run-compilation (string-append "grep -n " command " /dev/null"))))
 
-(define-command kill-grep
-  "Kill the process made by the \\[grep] command."
+(define-command kill-compilation
+  "Kill the process made by the \\[compile] command."
   ()
   (lambda ()
     (let ((process compilation-process))
       (if (and process (eq? (process-status process) 'RUN))
-	  (interrupt-process process true)))))
+	  (interrupt-process process #t)))))
 
 (define (run-compilation command)
-  ((ref-command save-some-buffers) false)
+  ((ref-command save-some-buffers) #f)
   (let ((process compilation-process))
     (if process
 	(begin
@@ -74,7 +76,7 @@ with output going to the buffer *compilation*."
 		(if (not (prompt-for-yes-or-no?
 			  "A compilation process is running; kill it"))
 		    (editor-error "Cannot have two compilation processes"))
-		(interrupt-process process true)
+		(interrupt-process process #t)
 		(sit-for 1000)))
 	  (delete-process process))))
   (let ((buffer (temporary-buffer "*compilation*"))
@@ -88,7 +90,7 @@ with output going to the buffer *compilation*."
     (let ((mark (mark-left-inserting-copy (buffer-start buffer))))
       (let ((window (get-buffer-window buffer)))
 	(if window
-	    (set-window-start-mark! window mark true)))
+	    (set-window-start-mark! window mark #t)))
       (insert-string "cd " mark)
       (insert-string (->namestring directory) mark)
       (insert-newline mark)
@@ -104,7 +106,7 @@ with output going to the buffer *compilation*."
 		  (os/form-shell-command command))))
       (set-process-sentinel! process compilation-process-sentinel)
       (set! compilation-process process))
-    (pop-up-buffer buffer false)))
+    (pop-up-buffer buffer #f)))
 
 (define (compilation-process-sentinel process status reason)
   (let ((buffer (process-buffer process)))
@@ -121,11 +123,9 @@ with output going to the buffer *compilation*."
   (without-interrupts
    (lambda ()
      (if (eq? process compilation-process)
-	 (set! compilation-process false))))
-  unspecific)
+	 (begin
+	   (set! compilation-process #f)
+	   unspecific)))))
 
 (define compilation-process
-  false)
-
-(define previous-grep-arguments
-  "")
\ No newline at end of file
+  #f)
\ No newline at end of file