From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 20 May 2018 23:59:02 +0000 (-0700)
Subject: Move magit-diff-arguments from custom.el to init.el.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~20
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1d1ac6930a2d1029c445b78c0709e8ca80075659;p=mit-scheme.git

Move magit-diff-arguments from custom.el to init.el.
---

diff --git a/src/runtime/dynamic.scm b/src/runtime/dynamic.scm
index 1b60a436d..5db74c2f2 100644
--- a/src/runtime/dynamic.scm
+++ b/src/runtime/dynamic.scm
@@ -64,11 +64,10 @@ USA.
   (make-general-parameter initial-value
 			  (if (default-object? converter)
 			      default-parameter-converter
-			      converter)
+			      (guarantee unary-procedure? converter))
 			  default-parameter-merger
 			  default-parameter-getter
-			  (and settable?
-			       default-parameter-setter)))
+			  (and settable? default-parameter-setter)))
 
 (define (default-parameter-converter value) value)
 (define (default-parameter-merger old-value new-value) old-value new-value)
@@ -85,14 +84,6 @@ USA.
 			    getter
 			    setter))
 
-(define (copy-parameter parameter)
-  (let ((metadata (parameter-metadata parameter)))
-    (make-general-parameter-1 (metadata-value metadata)
-			      (metadata-converter metadata)
-			      (metadata-merger metadata)
-			      (metadata-getter metadata)
-			      (metadata-setter metadata))))
-
 (define (make-general-parameter-1 initial-value converter merger getter setter)
   (let* ((metadata (make-metadata initial-value converter merger getter setter))
 	 (parameter
@@ -107,15 +98,12 @@ USA.
 		(getter (get-value metadata))))))
     (set-parameter-metadata! parameter metadata)
     parameter))
-
+
 (define (parameterize* new-bindings thunk)
   (guarantee alist? new-bindings 'parameterize*)
   (let ((temp
 	 (map* bindings
-	       (lambda (p)
-		 (let ((metadata (parameter-metadata (car p))))
-		   (cons metadata
-			 (convert metadata (cdr p)))))
+	       (lambda (p) (create-binding (car p) (cdr p)))
 	       new-bindings)))
     (let ((swap!
 	   (lambda ()
@@ -123,8 +111,21 @@ USA.
 	     unspecific)))
       (shallow-fluid-bind swap! thunk swap!))))
 
+(define (create-binding parameter value)
+  (let ((metadata (parameter-metadata parameter)))
+    (if (forwarder? metadata)
+	(create-binding (forwarder-parameter metadata)
+			((forwarder-convert-to metadata) value))
+	(cons metadata (convert metadata value)))))
+
 (define (parameter-converter parameter)
-  (metadata-converter (parameter-metadata parameter)))
+  (let ((metadata (parameter-metadata parameter)))
+    (if (forwarder? metadata)
+	(let ((converter1 (forwarder-convert-to metadata))
+	      (converter2 (parameter-converter parameter)))
+	  (lambda (value)
+	    (converter2 (converter1 value))))
+	(metadata-converter metadata))))
 
 (define-record-type <metadata>
     (make-metadata value converter merger getter setter)
@@ -150,4 +151,49 @@ USA.
 (define (convert metadata value)
   ((metadata-merger metadata)
    (get-value metadata)
-   ((metadata-converter metadata) value)))
\ No newline at end of file
+   ((metadata-converter metadata) value)))
+
+(define (make-forwarding-parameter parameter convert-to convert-from)
+  (guarantee parameter? parameter 'make-forwarding-parameter)
+  (guarantee unary-procedure? convert-to 'make-forwarding-parameter)
+  (guarantee unary-procedure? convert-from 'make-forwarding-parameter)
+  (make-forwarding-parameter-1 parameter convert-to convert-from))
+
+(define (make-forwarding-parameter-1 parameter convert-to convert-from)
+  (let ((parameter*
+	 (if (metadata-setter (skip-forwarders parameter))
+	     (lambda (#!optional new-value)
+	       (if (default-object? new-value)
+		   (convert-from (parameter))
+		   (parameter (convert-to new-value))))
+	     (lambda ()
+	       (convert-from (parameter))))))
+    (set-parameter-metadata! parameter*
+			     (make-forwarder parameter convert-to convert-from))
+    parameter*))
+
+(define-record-type <forwarder>
+    (make-forwarder parameter convert-to convert-from)
+    forwarder?
+  (parameter forwarder-parameter)
+  (convert-to forwarder-convert-to)
+  (convert-from forwarder-convert-from))
+
+(define (skip-forwarders parameter)
+  (let ((metadata (parameter-metadata parameter)))
+    (if (forwarder? metadata)
+	(skip-forwarders (forwarder-parameter metadata))
+	metadata)))
+
+(define (copy-parameter parameter)
+  (let ((metadata (parameter-metadata parameter)))
+    (if (forwarder? metadata)
+	(make-forwarding-parameter-1 (copy-parameter
+				      (forwarder-parameter metadata))
+				     (forwarder-convert-to metadata)
+				     (forwarder-convert-from metadata))
+	(make-general-parameter-1 (metadata-value metadata)
+				  (metadata-converter metadata)
+				  (metadata-merger metadata)
+				  (metadata-getter metadata)
+				  (metadata-setter metadata)))))
\ No newline at end of file
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9d0b23e70..655a69e37 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4396,6 +4396,7 @@ USA.
 	  default-parameter-setter
 	  parameter-converter
 	  parameter?
+	  make-forwarding-parameter
 	  make-general-parameter
 	  make-settable-parameter
 	  make-unsettable-parameter