* Editor variables can now define a procedure that will "normalize"

  their values.  The DEFINE-VARIABLE has been extended to allow the
  specification of this normalization procedure to follow the
  specification of a validity test.

* New procedure VARIABLE-LOCAL-VALUE? is true iff the given variable
  is locally bound in the given buffer.

* Procedure VARIABLE-VALUE-VALID? has been eliminated.

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 7b83193b3c950e12b4922c3a91fe63d2bd03d16f..b5ce5aeca2b5f1195eed528b5383a68cdf7a17be 100644 (file)
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: buffer.scm,v 1.163 1993/08/13 23:20:09 cph Exp $
+;;;    $Id: buffer.scm,v 1.164 1993/10/14 22:43:09 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -87,10 +87,10 @@ The buffer is guaranteed to be deselected at that time."
       (add-group-clip-daemon! group (buffer-clip-daemon buffer))
       (%buffer-reset! buffer)
       (vector-set! buffer buffer-index:windows '())
-      (vector-set! buffer buffer-index:display-start false)
+      (vector-set! buffer buffer-index:display-start #f)
       (vector-set! buffer buffer-index:default-directory directory)
       (vector-set! buffer buffer-index:local-bindings '())
-      (vector-set! buffer buffer-index:local-bindings-installed? false)
+      (vector-set! buffer buffer-index:local-bindings-installed? #f)
       (%set-buffer-major-mode! buffer mode)
       (event-distributor/invoke!
        (variable-default-value (ref-variable-object buffer-creation-hook))
@@ -108,13 +108,13 @@ The buffer is guaranteed to be deselected at that time."
    (make-ring
     (variable-default-value (ref-variable-object mark-ring-maximum))))
   (ring-push! (buffer-mark-ring buffer) (buffer-start buffer))
-  (vector-set! buffer buffer-index:pathname false)
-  (vector-set! buffer buffer-index:truename false)
-  (vector-set! buffer buffer-index:auto-save-pathname false)
-  (vector-set! buffer buffer-index:auto-saved? false)
+  (vector-set! buffer buffer-index:pathname #f)
+  (vector-set! buffer buffer-index:truename #f)
+  (vector-set! buffer buffer-index:auto-save-pathname #f)
+  (vector-set! buffer buffer-index:auto-saved? #f)
   (vector-set! buffer buffer-index:save-length 0)
-  (vector-set! buffer buffer-index:backed-up? false)
-  (vector-set! buffer buffer-index:modification-time false)
+  (vector-set! buffer buffer-index:backed-up? #f)
+  (vector-set! buffer buffer-index:modification-time #f)
   (vector-set! buffer buffer-index:alist '()))
 \f
 (define (buffer-modeline-event! buffer type)
@@ -261,9 +261,9 @@ The buffer is guaranteed to be deselected at that time."
      (let ((group (buffer-group buffer)))
        (if (group-modified? group)
           (begin
-            (set-group-modified?! group false)
+            (set-group-modified?! group #f)
             (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
-            (vector-set! buffer buffer-index:auto-saved? false)))))))
+            (vector-set! buffer buffer-index:auto-saved? #f)))))))
 
 (define (buffer-modified! buffer)
   (without-interrupts
@@ -271,15 +271,15 @@ The buffer is guaranteed to be deselected at that time."
      (let ((group (buffer-group buffer)))
        (if (not (group-modified? group))
           (begin
-            (set-group-modified?! group true)
+            (set-group-modified?! group #t)
             (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))))))
 
 (define (set-buffer-auto-saved! buffer)
-  (vector-set! buffer buffer-index:auto-saved? true)
+  (vector-set! buffer buffer-index:auto-saved? #t)
   (set-group-modified?! (buffer-group buffer) 'AUTO-SAVED))
 
 (define-integrable (buffer-auto-save-modified? buffer)
-  (eq? true (group-modified? (buffer-group buffer))))
+  (eq? #t (group-modified? (buffer-group buffer))))
 
 (define (buffer-clip-daemon buffer)
   (lambda (group start end)
@@ -315,19 +315,19 @@ The buffer is guaranteed to be deselected at that time."
 ;;;; Local Bindings
 
 (define (define-variable-local-value! buffer variable value)
-  (check-variable-value-validity! variable value)
-  (without-interrupts
-   (lambda ()
-     (let ((binding (search-local-bindings buffer variable)))
-       (if binding
-          (set-cdr! binding value)
-          (vector-set! buffer
-                       buffer-index:local-bindings
-                       (cons (cons variable value)
-                             (buffer-local-bindings buffer)))))
-     (if (buffer-local-bindings-installed? buffer)
-        (set-variable-%value! variable value))
-     (invoke-variable-assignment-daemons! buffer variable))))
+  (let ((value (normalize-variable-value variable value)))
+    (without-interrupts
+     (lambda ()
+       (let ((binding (search-local-bindings buffer variable)))
+        (if binding
+            (set-cdr! binding value)
+            (vector-set! buffer
+                         buffer-index:local-bindings
+                         (cons (cons variable value)
+                               (buffer-local-bindings buffer)))))
+       (if (buffer-local-bindings-installed? buffer)
+          (set-variable-%value! variable value))
+       (invoke-variable-assignment-daemons! buffer variable)))))
 
 (define (undefine-variable-local-value! buffer variable)
   (without-interrupts
@@ -349,30 +349,33 @@ The buffer is guaranteed to be deselected at that time."
        (cdr binding)
        (variable-default-value variable))))
 
+(define (variable-local-value? buffer variable)
+  (search-local-bindings buffer variable))
+
 (define (set-variable-local-value! buffer variable value)
   (cond ((variable-buffer-local? variable)
         (define-variable-local-value! buffer variable value))
        ((search-local-bindings buffer variable)
         =>
         (lambda (binding)
-          (check-variable-value-validity! variable value)
-          (without-interrupts
-           (lambda ()
-             (set-cdr! binding value)
-             (if (buffer-local-bindings-installed? buffer)
-                 (set-variable-%value! variable value))
-             (invoke-variable-assignment-daemons! buffer variable)))))
+          (let ((value (normalize-variable-value variable value)))
+            (without-interrupts
+             (lambda ()
+               (set-cdr! binding value)
+               (if (buffer-local-bindings-installed? buffer)
+                   (set-variable-%value! variable value))
+               (invoke-variable-assignment-daemons! buffer variable))))))
        (else
         (set-variable-default-value! variable value))))
 
 (define (set-variable-default-value! variable value)
-  (check-variable-value-validity! variable value)
-  (without-interrupts
-   (lambda ()
-     (set-variable-%default-value! variable value)
-     (if (not (search-local-bindings (current-buffer) variable))
-        (set-variable-%value! variable value))
-     (invoke-variable-assignment-daemons! false variable))))
+  (let ((value (normalize-variable-value variable value)))
+    (without-interrupts
+     (lambda ()
+       (set-variable-%default-value! variable value)
+       (if (not (search-local-bindings (current-buffer) variable))
+          (set-variable-%value! variable value))
+       (invoke-variable-assignment-daemons! #f variable)))))
 
 (define-integrable (search-local-bindings buffer variable)
   (let loop ((bindings (buffer-local-bindings buffer)))
@@ -411,25 +414,25 @@ The buffer is guaranteed to be deselected at that time."
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings) (cdar bindings)))
-  (vector-set! buffer buffer-index:local-bindings-installed? true))
+  (vector-set! buffer buffer-index:local-bindings-installed? #t))
 
 (define (uninstall-buffer-local-bindings! buffer)
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings)
                          (variable-default-value (caar bindings))))
-  (vector-set! buffer buffer-index:local-bindings-installed? false))
+  (vector-set! buffer buffer-index:local-bindings-installed? #f))
 
 (define (set-variable-value! variable value)
   (if within-editor?
       (set-variable-local-value! (current-buffer) variable value)
       (begin
-       (check-variable-value-validity! variable value)
-       (without-interrupts
-        (lambda ()
-          (set-variable-%default-value! variable value)
-          (set-variable-%value! variable value)
-          (invoke-variable-assignment-daemons! false variable))))))
+       (let ((value (normalize-variable-value variable value)))
+         (without-interrupts
+          (lambda ()
+            (set-variable-%default-value! variable value)
+            (set-variable-%value! variable value)
+            (invoke-variable-assignment-daemons! #f variable)))))))
 
 (define (with-variable-value! variable new-value thunk)
   (let ((old-value))

diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index b44a51892fbe04830a2e7053ddfd299ba3be2ba3..d0d14bf7ffe1b9566e966dde6edc73f0aabf742e 100644 (file)
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: comman.scm,v 1.74 1993/09/03 04:41:14 cph Exp $
+$Id: comman.scm,v 1.75 1993/10/14 22:43:17 cph Exp $
 
 Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology
 
@@ -122,7 +122,8 @@ of that license should have been included along with this file.
   initial-value
   %default-value
   assignment-daemons
-  value-validity-test)
+  value-validity-test
+  value-normalization)
 
 (define (variable-description variable)
   (let ((desc (variable-%description variable)))
@@ -156,20 +157,21 @@ of that license should have been included along with this file.
     (set-variable-initial-value! variable value)
     (set-variable-%default-value! variable value)
     (set-variable-assignment-daemons! variable '())
-    (set-variable-value-validity-test! variable false)
+    (set-variable-value-validity-test! variable #f)
+    (set-variable-value-normalization! variable #f)
     variable))
 
 (define-integrable (make-variable-buffer-local! variable)
   (set-variable-buffer-local?! variable #t))
 \f
-(define (check-variable-value-validity! variable value)
-  (if (not (variable-value-valid? variable value))
+(define (normalize-variable-value variable value)
+  (if (or (not (variable-value-validity-test variable))
+         ((variable-value-validity-test variable) value))
       (editor-error "Invalid value for " (variable-name-string variable)
-                   ": " value)))
-
-(define (variable-value-valid? variable value)
-  (or (not (variable-value-validity-test variable))
-      ((variable-value-validity-test variable) value)))
+                   ": " value))
+  (if (variable-value-normalization variable)
+      ((variable-value-normalization variable) value)
+      value))
 
 (define (add-variable-assignment-daemon! variable daemon)
   (let ((daemons (variable-assignment-daemons variable)))
@@ -187,7 +189,7 @@ of that license should have been included along with this file.
 (define (name->variable name)
   (let ((name (canonicalize-name name)))
     (or (string-table-get editor-variables (symbol->string name))
-       (make-variable name "" false false))))
+       (make-variable name "" #f #f))))
 
 (define (->variable object)
   (if (variable? object)

diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index e9bf384121b5cc1730fdc75541e1162bb513d13f..a4cbba53ac4d91505c8a570dbf30acc0951e37ac 100644 (file)
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: hlpcom.scm,v 1.106 1993/08/10 06:35:52 cph Exp $
+;;;    $Id: hlpcom.scm,v 1.107 1993/10/14 22:43:35 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -235,10 +235,7 @@ If you want VALUE to be a string, you must surround it with doublequotes."
             (string-append "Set " (variable-name-string variable) " to value")
             (variable-value variable)))))
   (lambda (variable value)
-    (let ((variable (name->variable variable)))
-      (if (not (variable-value-valid? variable value))
-         (editor-error "illegal value for variable:" value))
-      (set-variable-value! variable value))))
+    (set-variable-value! (name->variable variable) value)))
 
 (define-command make-local-variable
   "Make a variable have a local value in the current buffer."
@@ -249,10 +246,8 @@ If you want VALUE to be a string, you must surround it with doublequotes."
             (string-append "Set " (variable-name-string variable) " to value")
             (variable-value variable)))))
   (lambda (variable value)
-    (let ((variable (name->variable variable)))
-      (if (not (variable-value-valid? variable value))
-         (editor-error "illegal value for variable:" value))
-      (define-variable-local-value! (current-buffer) variable value))))
+    (define-variable-local-value! (current-buffer) (name->variable variable)
+      value)))
 
 (define-command kill-local-variable
   "Make a variable use its global value in the current buffer."

diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index bf2b91da19765723aa8115526325a494d1179f20..920599feb702da7a21b6b8d50f585f2b452b91c2 100644 (file)
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: macros.scm,v 1.60 1993/08/10 06:47:41 cph Exp $
+;;;    $Id: macros.scm,v 1.61 1993/10/14 22:43:23 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -128,7 +128,7 @@
 \f
 (let ((variable-definition
        (lambda (buffer-local?)
-        (lambda (name description #!optional value test)
+        (lambda (name description #!optional value test normalization)
           (let ((name (canonicalize-name name)))
             (let ((scheme-name (variable-name->scheme-name name)))
               `(BEGIN
@@ -139,8 +139,13 @@
                                   ',buffer-local?))
                  ,@(if (default-object? test)
                        '()
-                       `((DEFINE-VARIABLE-VALUE-VALIDITY-TEST ,scheme-name
-                           ,test))))))))))
+                       `((SET-VARIABLE-VALUE-VALIDITY-TEST! ,scheme-name
+                                                            ,test)))
+                 ,@(if (default-object? normalization)
+                       '()
+                       `((SET-VARIABLE-VALUE-NORMALIZATION!
+                          ,scheme-name
+                          ,normalization))))))))))
   (syntax-table-define edwin-syntax-table 'DEFINE-VARIABLE
     (variable-definition false))
   (syntax-table-define edwin-syntax-table 'DEFINE-VARIABLE-PER-BUFFER