From 6f13db4447db8bd4a064f56bd877b52f6bdaa724 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 28 Jan 1999 06:03:23 +0000 Subject: [PATCH] Use new prompt-history mechanism. --- v7/src/edwin/basic.scm | 33 ++++++++++++------------- v7/src/edwin/compile.scm | 52 ++++++++++++++++++++-------------------- 2 files changed, 43 insertions(+), 42 deletions(-) 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 -- 2.25.1