From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 13 Mar 1992 09:47:46 +0000 (+0000)
Subject: Define new command no-toggle-read-only and bind it to C-x C-q in the
X-Git-Tag: 20090517-FFI~9608
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ee2056a7e3fc198e7424b81455bd48254383aa15;p=mit-scheme.git

Define new command no-toggle-read-only and bind it to C-x C-q in the
read-only and read-only-noarg modes.
---

diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index 5927661a4..22ef5605f 100644
--- a/v7/src/edwin/bufcom.scm
+++ b/v7/src/edwin/bufcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.91 1992/02/04 04:01:20 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.92 1992/03/13 09:47:34 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -57,10 +57,15 @@
   ()
   (lambda ()
     (let ((buffer (current-buffer)))
-      ((if (buffer-writeable? buffer)
-	   set-buffer-read-only!
-	   set-buffer-writeable!)
-       buffer))))
+      (if (buffer-writeable? buffer)
+	  (set-buffer-read-only! buffer)
+	  (set-buffer-writeable! buffer)))))
+
+(define-command no-toggle-read-only
+  "Display warning indicating that this buffer may not be modified."
+  ()
+  (lambda ()
+    (editor-failure "This buffer may not be modified.")))
 
 (define-variable select-buffer-create
   "If true, buffer selection commands may create new buffers."
@@ -70,11 +75,10 @@
   (lambda ()
     (list
      (buffer-name
-      ((if (ref-variable select-buffer-create)
-	   prompt-for-buffer
-	   prompt-for-existing-buffer)
-       prompt
-       (previous-buffer))))))
+      (let ((buffer (previous-buffer)))
+	(if (ref-variable select-buffer-create)
+	    (prompt-for-buffer prompt buffer)
+	    (prompt-for-existing-buffer prompt buffer)))))))
 
 (define-command switch-to-buffer
   "Select buffer with specified name.
diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index c8e777873..6b616933e 100644
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.137 1992/01/09 17:53:59 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.138 1992/03/13 09:47:46 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -62,7 +62,7 @@ Most other major modes are defined by comparison to this one.")
   (ref-mode-object fundamental))
 
 (define initial-buffer-name
-  "*repl*")
+  "*scheme*")
 
 (define-variable file-type-to-major-mode
   "Specifies the major mode for new buffers based on file type.
@@ -83,12 +83,14 @@ Digits and - are bound to prefix argument commands.")
 (define-key 'read-only char-set:graphic 'undefined)
 (define-key 'read-only char-set:numeric 'digit-argument)
 (define-key 'read-only #\- 'negative-argument)
+(define-key 'read-only '(#\c-x #\c-q) 'no-toggle-read-only)
 
 (define-major-mode read-only-noarg fundamental "Read-only-noarg"
   "Major mode for read-only buffers.
 Like Fundamental mode, but no self-inserting characters.")
 
 (define-key 'read-only-noarg char-set:graphic 'undefined)
+(define-key 'read-only-noarg '(#\c-x #\c-q) 'no-toggle-read-only)
 
 (define-key 'fundamental #\c-% 'replace-string)
 (define-key 'fundamental #\c-- 'negative-argument)