From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 10 Jun 2005 01:42:52 +0000 (+0000)
Subject: Implement buffer-local indentation support.
X-Git-Tag: 20090517-FFI~1277
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d8d61e17d0b00ea8afb1ea26f8a4b0c5fc50c957;p=mit-scheme.git

Implement buffer-local indentation support.
---

diff --git a/v7/src/edwin/linden.scm b/v7/src/edwin/linden.scm
index 460c2d12d..407e655ba 100644
--- a/v7/src/edwin/linden.scm
+++ b/v7/src/edwin/linden.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: linden.scm,v 1.129 2003/02/14 18:28:12 cph Exp $
+$Id: linden.scm,v 1.130 2005/06/10 01:42:43 cph Exp $
 
-Copyright 1986, 1989-1999 Massachusetts Institute of Technology
+Copyright 1987,1989,1991,1995,1996,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -169,20 +169,24 @@ is used to calculate the indentation for that form."
 		   ((exact-integer? method)
 		    (lisp-indent-special-form method state indent-point
 					      normal-indent))
-		   ((procedure? method)
+		   ((procedure-of-arity? method 3)
 		    (method state indent-point normal-indent))
 		   (else #f)))))))
 
 (define (find-indent-method start end)
-  (or (let ((methods (ref-variable lisp-indent-methods start)))
-	(and methods
-	     (string-table-get methods (extract-string start end))))
-      (let loop ((alist (cdr (ref-variable lisp-indent-regexps start))))
-	(and (not (null? alist))
-	     (if (re-match-forward (caar alist) start end #t)
-		 (cdar alist)
-		 (loop (cdr alist)))))))
-
+  (let ((name (extract-string start end)))
+    (or (let ((v (name->variable (symbol 'LISP-INDENT: name) #f)))
+	  (and v
+	       (variable-local-value start v)))
+	(let ((methods (ref-variable lisp-indent-methods start)))
+	  (and methods
+	       (string-table-get methods name)))
+	(let loop ((alist (cdr (ref-variable lisp-indent-regexps start))))
+	  (and (pair? alist)
+	       (if (re-match-forward (caar alist) start end #t)
+		   (cdar alist)
+		   (loop (cdr alist))))))))
+
 ;;; Indent the first subform in a definition at the body indent.
 ;;; Indent subsequent subforms normally.
 
@@ -323,7 +327,7 @@ is used to calculate the indentation for that form."
 				   comment-start))))))
 
 (define (compute-indentation start stack)
-  (cond ((null? stack)
+  (cond ((not (pair? stack))
 	 (let ((indent (calculate-lisp-indentation start)))
 	   (if (pair? indent)
 	       (car indent)
diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index d34cb8a63..221d08201 100644
--- a/v7/src/edwin/schmod.scm
+++ b/v7/src/edwin/schmod.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: schmod.scm,v 1.70 2005/04/28 04:36:22 cph Exp $
+$Id: schmod.scm,v 1.71 2005/06/10 01:42:52 cph Exp $
 
 Copyright 1986,1989,1990,1991,1992,1998 Massachusetts Institute of Technology
 Copyright 2000,2001,2002,2003,2004,2005 Massachusetts Institute of Technology
@@ -157,13 +157,16 @@ The following commands evaluate Scheme expressions:
 (define scheme-mode:indent-methods
   (make-string-table))
 
-(define (scheme-indent-method symbol method)
-  (string-table-put! scheme-mode:indent-methods
-		     (symbol->string symbol)
-		     method))
+(define (scheme-indent-method name method)
+  (define-variable-local-value! (selected-buffer)
+      (name->variable (symbol 'LISP-INDENT: name) 'INTERN)
+    method))
 
 (for-each (lambda (entry)
-	    (for-each (lambda (name) (scheme-indent-method name (car entry)))
+	    (for-each (lambda (name)
+			(string-table-put! scheme-mode:indent-methods
+					   (symbol->string name)
+					   (car entry)))
 		      (cdr entry)))
 	  `(;; R4RS keywords:
 	    (0 BEGIN DELAY)