Don't close the identifier of a definition.

diff --git a/v7/src/6001/arith.scm b/v7/src/6001/arith.scm
index 7516535f1b6b81f9cae391e184853455fb2ab4d7..7acbf54f7edb1761bd126f890b840c2ba662c01a 100644 (file)
--- a/v7/src/6001/arith.scm
+++ b/v7/src/6001/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.9 2002/02/03 03:38:53 cph Exp $
+$Id: arith.scm,v 1.10 2002/02/09 05:56:43 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -48,7 +48,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-standard-unary
        (sc-macro-transformer
        (lambda (form environment)
-         `(DEFINE (,(close-syntax (list-ref form 1) environment) X)
+         `(DEFINE (,(list-ref form 1) X)
             (IF (FLONUM? X)
                 (,(close-syntax (list-ref form 2) environment) X)
                 (,(close-syntax (list-ref form 3) environment) X)))))))
@@ -82,7 +82,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
        (lambda (form environment)
          (let ((flo:op (close-syntax (list-ref form 2) environment))
                (int:op (close-syntax (list-ref form 3) environment)))
-           `(DEFINE (,(close-syntax (list-ref form 1) environment) X Y)
+           `(DEFINE (,(list-ref form 1) X Y)
               (IF (FLONUM? X)
                   (IF (FLONUM? Y)
                       (,flo:op X Y)
@@ -197,7 +197,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                       (FLO:->INTEGER ,n)
                       (ERROR:WRONG-TYPE-ARGUMENT ,n "integer"
                                                  ',(list-ref form 2))))))
-          `(DEFINE (,(close-syntax (list-ref form 1) environment) N M)
+          `(DEFINE (,(list-ref form 1) N M)
              (IF (FLONUM? N)
                  (INT:->FLONUM
                   (,operator ,(flo->int 'N)
@@ -229,7 +229,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
     ((define-transcendental-unary
        (sc-macro-transformer
        (lambda (form environment)
-         `(DEFINE (,(close-syntax (list-ref form 1) environment) X)
+         `(DEFINE (,(list-ref form 1) X)
             (IF (,(close-syntax (list-ref form 2) environment) X)
                 ,(close-syntax (list-ref form 3) environment)
                 (,(close-syntax (list-ref form 4) environment)

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 55efaeb5c6f7aa5cc8e96fbf226df755021e7ef2..efc143af6d52da252397dc13ce97195804ef6dd6 100644 (file)
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.185 2002/02/03 03:38:53 cph Exp $
+;;; $Id: buffer.scm,v 1.186 2002/02/09 05:55:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -49,8 +49,7 @@
       (sc-macro-transformer
        (lambda (form environment)
         (let ((slot-name (cadr form)))
-          `(DEFINE-INTEGRABLE
-             ,(close-syntax (symbol-append 'BUFFER- slot-name) environment)
+          `(DEFINE-INTEGRABLE ,(symbol-append 'BUFFER- slot-name)
              ,(close-syntax (symbol-append 'BUFFER-% slot-name)
                             environment)))))))
   (rename name)

diff --git a/v7/src/edwin/calias.scm b/v7/src/edwin/calias.scm
index 1d12c7159fa949156558396b2e89d32c3190796a..b30510802d19cc4497e16537cdfec9c6c74c0bf4 100644 (file)
--- a/v7/src/edwin/calias.scm
+++ b/v7/src/edwin/calias.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: calias.scm,v 1.24 2002/02/03 03:38:54 cph Exp $
+;;; $Id: calias.scm,v 1.25 2002/02/09 05:55:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -258,9 +258,9 @@
 (let-syntax ((make-key
              (sc-macro-transformer
               (lambda (form environment)
-                (let ((name (close-syntax (cadr form) environment)))
-                  `(DEFINE ,name
-                     (INTERN-SPECIAL-KEY ',name 0)))))))
+                environment
+                `(DEFINE ,(cadr form)
+                   (INTERN-SPECIAL-KEY ',(cadr form) 0))))))
   (make-key backspace)
   (make-key stop)
   (make-key f1)

diff --git a/v7/src/edwin/dosproc.scm b/v7/src/edwin/dosproc.scm
index 69dfff0f4e47e20dfa01b0bc5593564acd727505..e823f6fdd3120c10bb8063b826e0a7ff51fc9706 100644 (file)
--- a/v7/src/edwin/dosproc.scm
+++ b/v7/src/edwin/dosproc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: dosproc.scm,v 1.8 2002/02/03 03:38:54 cph Exp $
+;;; $Id: dosproc.scm,v 1.9 2002/02/09 05:55:12 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-2002 Massachusetts Institute of Technology
 ;;;
@@ -45,8 +45,8 @@
 (let-syntax ((define-process-operation
              (sc-macro-transformer
               (lambda (form environment)
-                (let ((name (close-syntax (cadr form) environment)))
-                  `(DEFINE ,name (PROCESS-OPERATION ',name)))))))
+                environment
+                `(DEFINE ,(cadr form) (PROCESS-OPERATION ',(cadr form)))))))
   (define-process-operation delete-process))
 
 (define (process-status-changes?)

diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index 0384697e2ff2b8d17f4bdf8733cf990bf925e2b1..94407483e29916b794d1a4539d9d4469e1390e7a 100644 (file)
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.71 2002/02/03 03:38:54 cph Exp $
+;;; $Id: macros.scm,v 1.72 2002/02/09 05:55:16 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 ;;;
@@ -27,38 +27,32 @@
 (define edwin-syntax-table (->environment '(EDWIN)))
 \f
 (define-syntax define-command
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (capture-syntactic-environment
-      (lambda (closing-environment)
+      (lambda (instance-environment)
        (if (syntax-match? '(SYMBOL EXPRESSION EXPRESSION EXPRESSION)
                           (cdr form))
            (let ((name (list-ref form 1))
-                 (description (close-syntax (list-ref form 2) environment))
+                 (description (list-ref form 2))
                  (interactive (list-ref form 3))
                  (procedure (list-ref form 4)))
-             (let ((scheme-name
-                    (close-syntax (command-name->scheme-name name)
-                                  environment)))
-               `(DEFINE ,scheme-name
-                  (MAKE-COMMAND ',name
-                                ,description
-                                ,(if (null? interactive)
-                                     `'()
-                                     (close-syntax interactive environment))
-                                ,(close-syntax
-                                  (if (and (pair? procedure)
-                                           (identifier=? environment
-                                                         (car procedure)
-                                                         closing-environment
-                                                         'LAMBDA)
-                                           (pair? (cdr procedure)))
-                                      `(,(close-syntax 'NAMED-LAMBDA
-                                                       closing-environment)
-                                        (,scheme-name ,@(cadr procedure))
-                                        ,@(cddr procedure))
-                                      procedure)
-                                  environment)))))
+             (let ((scheme-name (command-name->scheme-name name)))
+               `(,(close-syntax 'DEFINE environment)
+                 ,scheme-name
+                  (,(close-syntax 'MAKE-COMMAND environment)
+                   ',name
+                   ,description
+                   ,interactive
+                   ,(if (and (pair? procedure)
+                             (identifier=?
+                              instance-environment (car procedure)
+                              environment 'LAMBDA)
+                             (pair? (cdr procedure)))
+                        `(,(close-syntax 'NAMED-LAMBDA environment)
+                          (,scheme-name ,@(cadr procedure))
+                          ,@(cddr procedure))
+                        procedure)))))
            (ill-formed-syntax form)))))))
 
 (define-syntax ref-command-object
@@ -91,32 +85,27 @@
         (ill-formed-syntax form)))))
 \f
 (define-syntax define-variable
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (expand-variable-definition form environment `#F))))
 
 (define-syntax define-variable-per-buffer
-  (sc-macro-transformer
+  (rsc-macro-transformer
    (lambda (form environment)
      (expand-variable-definition form environment `#T))))
 
 (define (expand-variable-definition form environment buffer-local?)
   (if (and (syntax-match? '(SYMBOL + EXPRESSION) (cdr form))
           (<= (length form) 6))
-      `(DEFINE ,(close-syntax (variable-name->scheme-name (list-ref form 1))
-                             environment)
-        (MAKE-VARIABLE ',(list-ref form 1)
-                       ,(close-syntax (list-ref form 2) environment)
-                       ,(if (> (length form) 3)
-                            (close-syntax (list-ref form 3) environment)
-                            '#F)
-                       ,buffer-local?
-                       ,(if (> (length form) 4)
-                            (close-syntax (list-ref form 4) environment)
-                            '#F)
-                       ,(if (> (length form) 5)
-                            (close-syntax (list-ref form 5) environment)
-                            '#F)))
+      `(,(close-syntax 'DEFINE environment)
+       ,(variable-name->scheme-name (list-ref form 1))
+       (,(close-syntax 'MAKE-VARIABLE environment)
+        ',(list-ref form 1)
+        ,(list-ref form 2)
+        ,(if (> (length form) 3) (list-ref form 3) '#F)
+        ,buffer-local?
+        ,(if (> (length form) 4) (list-ref form 4) '#F)
+        ,(if (> (length form) 5) (list-ref form 5) '#F)))
       (ill-formed-syntax form)))
 
 (define-syntax ref-variable-object
@@ -180,8 +169,7 @@
        (if (syntax-match? pattern (cdr form))
           (let ((name (list-ref form 1))
                 (super-mode-name (list-ref form 2)))
-            (let ((scheme-name
-                   (close-syntax (mode-name->scheme-name name) environment)))
+            (let ((scheme-name (mode-name->scheme-name name)))
               `(DEFINE ,scheme-name
                  (MAKE-MODE ',name
                             #T
@@ -200,7 +188,9 @@
                                (if super-mode-name
                                    `(LAMBDA (BUFFER)
                                       ((MODE-INITIALIZATION
-                                        (MODE-SUPER-MODE ,scheme-name))
+                                        (MODE-SUPER-MODE
+                                         ,(close-syntax scheme-name
+                                                        environment)))
                                        BUFFER)
                                       ,@(if initialization
                                             `((,initialization BUFFER))
@@ -220,7 +210,7 @@
      (lambda (form environment)
        (if (syntax-match? pattern (cdr form))
           (let ((name (list-ref form 1)))
-            `(DEFINE ,(close-syntax (mode-name->scheme-name name) environment)
+            `(DEFINE ,(mode-name->scheme-name name)
                (MAKE-MODE ',name
                           #F
                           ',(or (list-ref form 2)

diff --git a/v7/src/edwin/search.scm b/v7/src/edwin/search.scm
index 314ddfb7c384e8cc1847a3bb59b74635558ffe9f..967afe09ffe687ff8c290d0d6b29f2f9915a88d4 100644 (file)
--- a/v7/src/edwin/search.scm
+++ b/v7/src/edwin/search.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: search.scm,v 1.154 2002/02/03 03:38:54 cph Exp $
+;;;$Id: search.scm,v 1.155 2002/02/09 05:55:20 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 ;;;
@@ -27,7 +27,7 @@
     ((define-search
        (sc-macro-transformer
        (lambda (form environment)
-         (let ((name (close-syntax (cadr form) environment))
+         (let ((name (cadr form))
                (find-next (close-syntax (caddr form) environment)))
            `(DEFINE (,name GROUP START END CHAR)
               ;; Assume (FIX:<= START END)
@@ -65,7 +65,7 @@
     ((define-search
        (sc-macro-transformer
        (lambda (form environment)
-         (let ((name (close-syntax (cadr form) environment))
+         (let ((name (cadr form))
                (find-previous (close-syntax (caddr form) environment)))
            `(DEFINE (,name GROUP START END CHAR)
               ;; Assume (FIX:<= START END)

diff --git a/v7/src/edwin/tterm.scm b/v7/src/edwin/tterm.scm
index 7136eca558d3266674870885457c89a7537c02c4..f7908f770c7c1608c4420ca24959ccdff36d4b31 100644 (file)
--- a/v7/src/edwin/tterm.scm
+++ b/v7/src/edwin/tterm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: tterm.scm,v 1.33 2002/02/03 03:38:54 cph Exp $
+$Id: tterm.scm,v 1.34 2002/02/09 05:55:25 cph Exp $
 
 Copyright (c) 1990-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -445,10 +445,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
              (sc-macro-transformer
               (lambda (form environment)
                 (let ((name (cadr form)))
-                  `(DEFINE-INTEGRABLE
-                     (,(close-syntax (symbol-append 'SCREEN- name)
-                                     environment)
-                      SCREEN)
+                  `(DEFINE-INTEGRABLE (,(symbol-append 'SCREEN- name) SCREEN)
                      (,(close-syntax (symbol-append 'TERMINAL-STATE/ name)
                                      environment)
                       (SCREEN-STATE SCREEN)))))))
@@ -458,10 +455,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
                 (let ((name (cadr form)))
                   (let ((param (make-synthetic-identifier name)))
                     `(DEFINE-INTEGRABLE
-                       (,(close-syntax (symbol-append 'SET-SCREEN- name '!)
-                                       environment)
-                        SCREEN
-                        ,param)
+                       (,(symbol-append 'SET-SCREEN- name '!) SCREEN ,param)
                        (,(close-syntax
                           (symbol-append 'SET-TERMINAL-STATE/ name '!)
                           environment)

diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index 0a5b31d126b9e1fa1b152e29c3d1ec59f3fa8665..32b891185e56b495522c550d497bcb0d9f6d779b 100644 (file)
--- a/v7/src/edwin/xcom.scm
+++ b/v7/src/edwin/xcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xcom.scm,v 1.20 2002/02/03 03:38:55 cph Exp $
+;;; $Id: xcom.scm,v 1.21 2002/02/09 05:55:29 cph Exp $
 ;;;
 ;;; Copyright (c) 1989-2002 Massachusetts Institute of Technology
 ;;;
@@ -313,9 +313,7 @@ When called interactively, completion is available on the input."
       (sc-macro-transformer
        (lambda (form environment)
         (let ((name (cadr form)))
-          `(DEFINE
-             ,(close-syntax (symbol-append 'EDWIN-COMMAND$X- name)
-                            environment)
+          `(DEFINE ,(symbol-append 'EDWIN-COMMAND$X- name)
              ,(close-syntax (symbol-append 'EDWIN-COMMAND$ name)
                             environment)))))))
   (copy set-foreground-color)
@@ -347,9 +345,7 @@ When called interactively, completion is available on the input."
       (sc-macro-transformer
        (lambda (form environment)
         (let ((name (cadr form)))
-          `(DEFINE
-             ,(close-syntax (symbol-append 'EDWIN-VARIABLE$X-SCREEN- name)
-                            environment)
+          `(DEFINE ,(symbol-append 'EDWIN-VARIABLE$X-SCREEN- name)
              ,(close-syntax (symbol-append 'EDWIN-VARIABLE$FRAME- name)
                             environment)))))))
   (copy icon-name-format)