* Change MAKE-MODE to accept parent mode rather than list of comtabs.

* Rename MODE-COMTAB to MINOR-MODE-COMTAB.

* New procedures MINOR-MODE? and MAJOR-MODE?.

* Eliminate NAME->MODE; use ->MODE instead.

diff --git a/v7/src/edwin/autold.scm b/v7/src/edwin/autold.scm
index 574351885dc28270ae608478f01a011222b89d11..a90fa59bdefe9809b13d99bdc83485f1c32fb58f 100644 (file)
--- a/v7/src/edwin/autold.scm
+++ b/v7/src/edwin/autold.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/autold.scm,v 1.50 1991/05/02 01:12:03 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/autold.scm,v 1.51 1992/01/09 17:46:01 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -82,9 +82,7 @@
     (make-mode name
               true
               display-name
-              (if super-mode-name
-                  (mode-comtabs (name->mode super-mode-name))
-                  '())
+              (and super-mode-name (->mode super-mode-name))
               description
               (make-autoloading-procedure library-name
                                           (lambda ()
@@ -99,7 +97,7 @@
     (make-mode name
               false
               display-name
-              '()
+              false
               description
               (make-autoloading-procedure library-name
                                           (lambda ()

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index f701b3bd523a7d5a1b50994874777686a69ffd41..7eb26d00372efe2189b4c91d4125b6b7a93f453f 100644 (file)
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.149 1991/11/06 21:55:55 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.150 1992/01/09 17:45:32 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -519,7 +519,7 @@ The buffer is guaranteed to be deselected at that time."
   (memq mode (buffer-minor-modes buffer)))
 
 (define (enable-buffer-minor-mode! buffer mode)
-  (if (not (and (mode? mode) (not (mode-major? mode))))
+  (if (not (minor-mode? mode))
       (error:wrong-type-argument mode "minor mode" 'ENABLE-BUFFER-MINOR-MODE!))
   (without-interrupts
    (lambda ()
@@ -528,13 +528,13 @@ The buffer is guaranteed to be deselected at that time."
           (begin
             (set-cdr! modes (append! (cdr modes) (list mode)))
             (set-buffer-comtabs! buffer
-                                 (cons (mode-comtab mode)
+                                 (cons (minor-mode-comtab mode)
                                        (buffer-comtabs buffer)))
             (%add-buffer-initialization! buffer (mode-initialization mode))
             (buffer-modeline-event! buffer 'BUFFER-MODES)))))))
 
 (define (disable-buffer-minor-mode! buffer mode)
-  (if (not (and (mode? mode) (not (mode-major? mode))))
+  (if (not (minor-mode? mode))
       (error:wrong-type-argument mode "minor mode"
                                 'DISABLE-BUFFER-MINOR-MODE!))
   (without-interrupts
@@ -544,6 +544,6 @@ The buffer is guaranteed to be deselected at that time."
           (begin
             (set-cdr! modes (delq! mode (cdr modes)))
             (set-buffer-comtabs! buffer
-                                 (delq! (mode-comtab mode)
+                                 (delq! (minor-mode-comtab mode)
                                         (buffer-comtabs buffer)))
             (buffer-modeline-event! buffer 'BUFFER-MODES)))))))
\ No newline at end of file

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index a221ba33a91efc95a3fd7dbc2d081ec5bc80a5d7..747557339c86f831e7d88f8857965201ee5bc065 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.103 1991/11/04 20:51:04 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.104 1992/01/09 17:46:59 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -157,7 +157,8 @@
                       (assoc-string-ci
                        type
                        (ref-variable file-type-to-major-mode))))))))
-    (and entry (name->mode (cdr entry)))))
+    (and entry
+        (->mode (cdr entry)))))
 
 (define assoc-string-ci
   (association-procedure string-ci=? car))

diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index 641c199753a7a1c493cc8003cc4913f4d06b55e6..0931fa96d242a94628f1abaede0dcf033ae824cc 100644 (file)
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/macros.scm,v 1.53 1991/08/13 20:59:40 newts Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/macros.scm,v 1.54 1992/01/09 17:47:27 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -186,11 +186,11 @@
           (and super-mode-name (canonicalize-name super-mode-name))))
       `(DEFINE ,(mode-name->scheme-name name)
         (MAKE-MODE ',name
-                   TRUE
+                   #T
                    ',(or display-name (symbol->string name))
                    ,(if super-mode-name
-                        `(MODE-COMTABS (NAME->MODE ',super-mode-name))
-                        ''())
+                        `(->MODE ',super-mode-name)
+                        `#F)
                    ',description
                    (LAMBDA ()
                      ,@(let ((initialization
@@ -209,9 +209,9 @@
     (let ((name (canonicalize-name name)))
       `(DEFINE ,(mode-name->scheme-name name)
         (MAKE-MODE ',name
-                   FALSE
+                   #F
                    ',(or display-name (symbol->string name))
-                   '()
+                   #F
                    ',description
                    (LAMBDA ()
                      ,@(if (null? initialization)

diff --git a/v7/src/edwin/modes.scm b/v7/src/edwin/modes.scm
index d201ecba502c49c35c30b82e4a139e65760b4d50..ae3cca313f4c11e1e614ee6528b26ba3206f3bf8 100644 (file)
--- a/v7/src/edwin/modes.scm
+++ b/v7/src/edwin/modes.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modes.scm,v 1.25 1989/08/10 04:42:21 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modes.scm,v 1.26 1992/01/09 17:45:16 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -46,55 +46,69 @@
 
 (declare (usual-integrations))
 \f
-(define-named-structure "Mode"
-  name
+(define-structure (mode
+                  (constructor %make-mode (name comtabs))
+                  (print-procedure
+                   (unparser/standard-method 'MODE
+                     (lambda (state mode)
+                       (unparse-object state (mode-name mode))
+                       (if (not (mode-major? mode))
+                           (unparse-string state " (minor)"))))))
+  (name false read-only true)
+  (comtabs false read-only true)
   display-name
   major?
-  comtabs
   description
   initialization
-  alist
-  )
+  alist)
 
-(unparser/set-tagged-vector-method!
- %mode-tag
- (unparser/standard-method 'MODE
-   (lambda (state mode)
-     (unparse-object state (mode-name mode))
-     (if (not (mode-major? mode))
-        (unparse-string state " (minor)")))))
-
-(define (make-mode name major? display-name comtabs description initialization)
+(define (make-mode name major? display-name super-mode description
+                  initialization)
   (let ((mode
-        (let ((name (symbol->string name)))
-          (or (string-table-get editor-modes name)
-              (let ((mode (%make-mode)))
-                (vector-set! mode mode-index:comtabs (list (make-comtab)))
-                (string-table-put! editor-modes name mode)
+        (let ((string (symbol->string name)))
+          (or (string-table-get editor-modes string)
+              (let ((mode (%make-mode name (list (make-comtab)))))
+                (string-table-put! editor-modes string mode)
                 mode)))))
-    (vector-set! mode mode-index:name name)
-    (vector-set! mode mode-index:display-name display-name)
-    (vector-set! mode mode-index:major? major?)
-    (set-cdr! (vector-ref mode mode-index:comtabs) comtabs)
-    (vector-set! mode mode-index:description description)
-    (vector-set! mode mode-index:initialization initialization)
-    (vector-set! mode mode-index:alist '())
+    (set-mode-display-name! mode display-name)
+    (set-mode-major?! mode major?)
+    (set-cdr! (mode-comtabs mode)
+             (cond ((not super-mode)
+                    '())
+                   ((mode? super-mode)
+                    (mode-comtabs super-mode))
+                   (else
+                    ;; Old code passes a comtabs list here, so accept
+                    ;; that as a valid argument.  Later, this can be
+                    ;; an error.
+                    super-mode)))
+    (set-mode-description! mode description)
+    (set-mode-initialization! mode initialization)
+    (set-mode-alist! mode '())
     mode))
 
-(define-integrable (mode-comtab mode)
-  (car (mode-comtabs mode)))
+(define editor-modes
+  (make-string-table))
+
+(define (->mode object)
+  (if (mode? object)
+      object
+      (let ((name (canonicalize-name object)))
+       (or (string-table-get editor-modes (symbol->string name))
+           (make-mode name
+                      true
+                      (symbol->string name)
+                      false
+                      ""
+                      (lambda () (error "Undefined mode" name)))))))
 
-(define editor-modes (make-string-table))
+(define (major-mode? object)
+  (and (mode? object)
+       (mode-major? object)))
 
-(define (name->mode name)
-  (let ((name (canonicalize-name name)))
-    (or (string-table-get editor-modes (symbol->string name))
-       (make-mode name
-                  true
-                  (symbol->string name)
-                  '()
-                  ""
-                  (lambda () (error "Undefined mode" name))))))
+(define (minor-mode? object)
+  (and (mode? object)
+       (not (mode-major? object))))
 
-(define (->mode object)
-  (if (mode? object) object (name->mode object)))
\ No newline at end of file
+(define-integrable (minor-mode-comtab mode)
+  (car (mode-comtabs mode)))
\ No newline at end of file