Formatting.
authorChris Hanson <org/chris-hanson/cph>
Fri, 11 Aug 1989 10:54:26 +0000 (10:54 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 11 Aug 1989 10:54:26 +0000 (10:54 +0000)
v7/src/edwin/basic.scm
v7/src/edwin/comred.scm
v7/src/edwin/filcom.scm
v7/src/edwin/utils.scm

index 56e3ad7423ecf7728810260c1ed6810b29d62c60..c43334cde85de0936100f796fbeeb732990c136d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.102 1989/08/08 10:05:18 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.103 1989/08/11 10:51:43 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -88,66 +88,38 @@ With an argument, inserts several newlines."
     (let ((m* (mark-right-inserting (current-point))))
       (insert-newlines (or argument 1))
       (set-current-point! m*))))
-\f
-(define-command keyboard-quit
-  "Signals a quit condition."
+
+(define-command narrow-to-region
+  "Restrict editing in current buffer to text between point and mark.
+Use \\[widen] to undo the effects of this command."
   ()
   (lambda ()
-    (editor-beep)
-    (temporary-message "Quit")
-    (^G-signal)))
+    (region-clip! (current-region))))
 
-(define-command ^r-bad-command
-  "This command is used to capture undefined keys.
-It is usually called directly by the command lookup
-procedure when it fails to find a command."
+(define-command widen
+  "Remove restrictions from current buffer.
+Allows full text to be seen and edited."
   ()
   (lambda ()
-    (editor-error "Undefined command: " (xchar->name (current-command-char)))))
-
-(define (barf-if-read-only)
-  (editor-error "Trying to modify read only text."))
-
-(define-variable debug-on-editor-error
-  "True means signal Scheme error when an editor error occurs."
-  false)
-
-(define condition-type:editor-error
-  (make-error-type '()
-    (lambda (condition port)
-      (write-string "Editor error: " port)
-      (write-string (message-args->string (condition/irritants condition))
-                   port))))
-
-(define (editor-error . strings)
-  (if (ref-variable debug-on-editor-error)
-      (call-with-current-continuation
-       (lambda (continuation)
-        (debug-scheme-error
-         (make-condition condition-type:editor-error
-                         strings
-                         continuation))
-        (%editor-error)))
-      (begin
-       (if (not (null? strings)) (apply temporary-message strings))
-       (%editor-error))))
-
-(define (%editor-error)
-  (editor-beep)
-  (abort-current-command))
-
-(define (editor-failure . strings)
-  (cond ((not (null? strings)) (apply temporary-message strings))
-       (*defining-keyboard-macro?* (clear-message)))
-  (editor-beep)
-  (keyboard-macro-disable))
-
-(define-integrable (editor-beep)
-  (screen-beep (current-screen)))
+    (buffer-widen! (current-buffer))))
 
-(define (not-implemented)
-  (editor-error "Not yet implemented"))
+(define-command set-key
+  "Define a key binding from the keyboard.
+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")))
+      (list command
+           (prompt-for-key (string-append "Put \""
+                                          (command-name-string command)
+                                          "\" on key")
+                           (mode-comtabs (ref-mode-object fundamental))))))
+  (lambda (command key)
+    (if (prompt-for-confirmation? "Go ahead")
+       (define-key 'fundamental key (command-name command)))))
 \f
+;;;; Prefixes
+
 (define-command control-prefix
   "Sets Control-bit of following character.
 This command followed by an = is equivalent to a Control-=."
@@ -221,6 +193,83 @@ For more information type the HELP key while entering the name."
   (lambda ()
     (dispatch-on-command (prompt-for-command "Extended Command") true)))
 \f
+;;;; Errors
+
+(define-command keyboard-quit
+  "Signals a quit condition."
+  ()
+  (lambda ()
+    (editor-beep)
+    (temporary-message "Quit")
+    (^G-signal)))
+
+(define-command ^r-bad-command
+  "This command is used to capture undefined keys.
+It is usually called directly by the command lookup
+procedure when it fails to find a command."
+  ()
+  (lambda ()
+    (editor-error "Undefined command: " (xchar->name (current-command-char)))))
+
+(define (barf-if-read-only)
+  (editor-error "Trying to modify read only text."))
+
+(define-variable debug-on-editor-error
+  "True means signal Scheme error when an editor error occurs."
+  false)
+
+(define condition-type:editor-error
+  (make-error-type '()
+    (lambda (condition port)
+      (write-string "Editor error: " port)
+      (write-string (message-args->string (condition/irritants condition))
+                   port))))
+
+(define (editor-error . strings)
+  (if (ref-variable debug-on-editor-error)
+      (call-with-current-continuation
+       (lambda (continuation)
+        (debug-scheme-error
+         (make-condition condition-type:editor-error
+                         strings
+                         continuation))
+        (%editor-error)))
+      (begin
+       (if (not (null? strings)) (apply temporary-message strings))
+       (%editor-error))))
+
+(define (%editor-error)
+  (editor-beep)
+  (abort-current-command))
+
+(define (editor-failure . strings)
+  (cond ((not (null? strings)) (apply temporary-message strings))
+       (*defining-keyboard-macro?* (clear-message)))
+  (editor-beep)
+  (keyboard-macro-disable))
+
+(define-integrable (editor-beep)
+  (screen-beep (current-screen)))
+
+(define (not-implemented)
+  (editor-error "Not yet implemented"))
+\f
+;;;; Level Control
+
+(define-command exit-recursive-edit
+  "Exit normally from a subsystem of a level of editing."
+  ()
+  (lambda ()
+    (exit-recursive-edit 'EXIT)))
+
+(define-command abort-recursive-edit
+  "Abnormal exit from recursive editing command.
+The recursive edit is exited and the command that invoked it is aborted.
+For a normal exit, you should use \\[exit-recursive-edit], NOT this command."
+  ()
+  (lambda ()
+    (exit-recursive-edit 'ABORT)))
+
 (define-command suspend-scheme
   "Go back to Scheme's superior job.
 With argument, saves visited file first."
@@ -263,49 +312,7 @@ With prefix arg, silently save all file-visiting buffers, then kill."
            (set! edwin-finalization false)
            (reset-editor)))
     ((ref-command suspend-edwin))))
-
-(define-command exit-recursive-edit
-  "Exit normally from a subsystem of a level of editing."
-  ()
-  (lambda ()
-    (exit-recursive-edit 'EXIT)))
-
-(define-command abort-recursive-edit
-  "Abnormal exit from recursive editing command.
-The recursive edit is exited and the command that invoked it is aborted.
-For a normal exit, you should use \\[exit-recursive-edit], NOT this command."
-  ()
-  (lambda ()
-    (exit-recursive-edit 'ABORT)))
-
-(define-command narrow-to-region
-  "Restrict editing in current buffer to text between point and mark.
-Use \\[widen] to undo the effects of this command."
-  ()
-  (lambda ()
-    (region-clip! (current-region))))
-
-(define-command widen
-  "Remove restrictions from current buffer.
-Allows full text to be seen and edited."
-  ()
-  (lambda ()
-    (buffer-widen! (current-buffer))))
-
-(define-command set-key
-  "Define a key binding from the keyboard.
-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")))
-      (list command
-           (prompt-for-key (string-append "Put \""
-                                          (command-name-string command)
-                                          "\" on key")
-                           (mode-comtabs (ref-mode-object fundamental))))))
-  (lambda (command key)
-    (if (prompt-for-confirmation? "Go ahead")
-       (define-key 'fundamental key (command-name command)))))\f
+\f
 ;;;; Comment Commands
 
 (define-variable comment-column
index a5cb408e61a33844fc16d98b037754db863a3910..79f138b1129f972507661fe5f757d551859ea7d9 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.78 1989/08/09 13:16:59 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.79 1989/08/11 10:51:02 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
                   (record-command-arguments expressions))
               arguments)))
          ((null? specification)
-          (if record?
-              (record-command-arguments '()))
+          (if record? (record-command-arguments '()))
           '())
          (else
           (let ((old-chars-read keyboard-chars-read))
             (let ((arguments (specification)))
-              (if (or record?
-                      (not (= keyboard-chars-read old-chars-read)))               (record-command-arguments (map quotify-sexp arguments)))
+              (if (or record? (not (= keyboard-chars-read old-chars-read)))
+                  (record-command-arguments (map quotify-sexp arguments)))
               arguments))))))
 
 (define (execute-command-history-entry entry)
index 15709e6c5f068beabc95199a98a7d2545d66fed4..47f7d09ffea21d42af1dc36660afb53d09e204ad 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.137 1989/08/07 08:44:52 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.138 1989/08/11 10:54:26 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
                            (let ((truename* (buffer-truename buffer)))
                              (and truename*
                                   (pathname=? truename truename*))))))))))))
-
-(define (pathname=? x y)
-  (string=? (pathname->string x)
-           (pathname->string y)))\f
+\f
 (define-command find-file
   "Visit a file in its own buffer.
 If the file is already in some buffer, select that buffer.
index 6da9dbebcfb6ebdb359dd61c24f5c00b45ca98e4..74e385f001322e4789eff964d5352af4da960501 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.16 1989/08/09 13:18:15 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.17 1989/08/11 10:54:14 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
 
 (define char-set:not-graphic
   (char-set-invert char-set:graphic))
-\f
+
 (define (read-line #!optional port)
   (read-string char-set:return
               (if (default-object? port)
                   (guarantee-input-port port))))
 
 (define (read-from-string string)
-  (with-input-from-string string read))
+  (with-input-from-string string read))\f
 (define (y-or-n? . strings)
   (define (loop)
     (let ((char (char-upcase (read-char))))
            (fluid-let ((*unparser-list-depth-limit* 5)
                        (*unparser-list-breadth-limit* 10))
              (write value))
-           (write value)))))
\ No newline at end of file
+           (write value)))))
+
+(define (pathname=? x y)
+  (string=? (pathname->string x)
+           (pathname->string y)))
\ No newline at end of file