...

original commit: 48e4860ed97574ec5b6a36281446b674fad14461

collects/framework/main.ss

@@ -4,24 +4,57 @@
   
   ;; preferences
 
+  (preferences:set-default 'framework:highlight-parens #t boolean?)
+  (preferences:set-default 'framework:fixup-parens #t boolean?)
+  (preferences:set-default 'framework:paren-match #t boolean?)
+  (let ([hash-table (make-hash-table)])
+    (for-each (lambda (x) (hash-table-put! hash-table x 'define))
+	      '(define defmacro define-macro
+		 define-values
+		 define-signature define-syntax define-schema))
+    (for-each (lambda (x) (hash-table-put! hash-table x 'begin))
+	      '(cond 
+		 begin begin0 delay
+		 unit compound-unit compound-unit/sig
+		 public private
+		 inherit inherit-from
+		 rename rename-from
+		 share share-from
+		 sequence))
+    (for-each (lambda (x) (hash-table-put! hash-table x 'lambda))
+	      '(lambda let let* letrec letrec* recur
+		       let/cc let/ec letcc catch
+		       let-syntax letrec-syntax syntax-case
+		       let-signature fluid-let
+		       let-struct let-macro let-values let*-values
+		       case when unless match
+		       let-enumerate
+		       class class* class-asi class-asi*
+		       define-some do opt-lambda send*
+		       local catch shared
+		       unit/sig
+		       with-handlers with-parameterization
+		       interface
+		       parameterize
+		       call-with-input-file with-input-from-file
+		       with-input-from-port call-with-output-file
+		       with-output-to-file with-output-to-port))
+    (mred:preferences:set-preference-un/marshall
+     'mred:tabify 
+     (lambda (t) (hash-table-map t list))
+     (lambda (l) (let ([h (make-hash-table)])
+		   (for-each (lambda (x) (apply hash-table-put! h x)) l)
+		   h)))
+    (mred:preferences:set-preference-default 'mred:tabify hash-table hash-table?))
+
+
   (preferences:set-default 'framework:autosave-delay 300 number?)
-  (preferences:set-default 'framework:autosaving-on? #t 
-					   (lambda (x)
-					     (or (not x)
-						 (eq? x #t))))
-  (preferences:set-default 'framework:verify-exit #t
-			   (lambda (x)
-			     (or (not x)
-				 (eq? x #t))))
+  (preferences:set-default 'framework:autosaving-on? #t boolean?)
+  (preferences:set-default 'framework:verify-exit #t boolean?)
   (preferences:set-default 'framework:delete-forward? 
 			   (not (eq? (system-type) 'unix))
-			   (lambda (x)
-			     (or (not x)
-				 (eq? x #t))))
-  (preferences:set 'framework:show-periods-in-dirlist #f
-		   (lambda (x)
-		     (or (not x)
-			 (eq? x #t))))
+			   boolean?)
+  (preferences:set 'framework:show-periods-in-dirlist #f boolean?)
   (preferences:set 'framework:file-dialogs
 		   (if (eq? wx:platform 'unix)
 		       'common
@@ -30,8 +63,84 @@
 		     (or (eq? x 'common)
 			 (eq? x 'std))))
   
-  (preferences:read)
+  (preferences:add-panel
+   "Indenting"
+   (lambda (p)
+     (let*-values
+	 ([(get-keywords)
+	   (lambda (hash-table)
+	     (letrec* ([all-keywords (hash-table-map hash-table list)]
+		       [pick-out (lambda (wanted in out)
+				   (cond
+				     [(null? in) (mzlib:function:quicksort out string<=?)]
+				     [else (if (eq? wanted (cadr (car in))) 
+					       (pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
+					       (pick-out wanted (cdr in) out))]))])
+	       (values  (pick-out 'begin all-keywords null)
+			(pick-out 'define all-keywords null)
+			(pick-out 'lambda all-keywords null))))]
+	  [(begin-keywords define-keywords lambda-keywords)
+	   (get-keywords (mred:preferences:get-preference 'mred:tabify))])
+       (let* ([add-callback
+	       (lambda (keyword-type keyword-symbol list-box)
+		 (lambda (button command)
+		   (let ([new-one (mred:gui-utils:get-text-from-user 
+				   (string-append "Enter new " keyword-type "-like keyword:")
+				   (string-append keyword-type " Keyword"))])
+		     (when new-one
+		       (let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
+				       (read (open-input-string new-one)))])
+			 (cond
+			   [(and (symbol? parsed)
+				 (hash-table-get (mred:preferences:get-preference 'mred:tabify)
+						 parsed
+						 (lambda () #f)))
+			    (wx:message-box (format "\"~a\" is already a specially indented keyword" parsed)
+					    "Error")]
+			   [(symbol? parsed)
+			    (hash-table-put! (mred:preferences:get-preference 'mred:tabify)
+					     parsed keyword-symbol)
+			    (send list-box append (symbol->string parsed))]
+			   [else (wx:message-box (format "expected a symbol, found: ~a" new-one) "Error")]))))))]
+	      [delete-callback
+	       (lambda (list-box)
+		 (lambda (button command)
+		   (let* ([selections (send list-box get-selections)]
+			  [symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)])
+		     (for-each (lambda (x) (send list-box delete x)) (reverse selections))
+		     (let ([ht (mred:preferences:get-preference 'mred:tabify)])
+		       (for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))]
+	      [main-panel (make-object mred:horizontal-panel% p)]
+	      [make-column
+	       (lambda (string symbol keywords)
+		 (let* ([vert (make-object mred:vertical-panel% main-panel)]
+			[_ (make-object mred:message% vert (string-append string "-like Keywords"))]
+			[box (make-object mred:list-box% vert null "" wx:const-multiple -1 -1 -1 -1 keywords)]
+			[button-panel (make-object mred:horizontal-panel% vert)]
+			[add-button (make-object mred:button% button-panel (add-callback string symbol box) "Add")]
+			[delete-button (make-object mred:button% button-panel (delete-callback box) "Remove")])
+		   (send* button-panel 
+			  (major-align-center)
+			  (stretchable-in-y #f))
+		   (send add-button user-min-width (send delete-button get-width))
+		   box))]
+	      [begin-list-box (make-column "Begin" 'begin begin-keywords)]
+	      [define-list-box (make-column "Define" 'define define-keywords)]
+	      [lambda-list-box (make-column "Lambda" 'lambda lambda-keywords)]
+	      [update-list-boxes
+	       (lambda (hash-table)
+		 (let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
+			      [(reset) (lambda (list-box keywords)
+					 (send list-box clear)
+					 (for-each (lambda (x) (send list-box append x)) keywords))])
+		   (reset begin-list-box begin-keywords)
+		   (reset define-list-box define-keywords)
+		   (reset lambda-list-box lambda-keywords)
+		   #t))])
+	 (mred:preferences:add-preference-callback 'mred:tabify (lambda (p v) (update-list-boxes v)))
+	 main-panel))))
 
+  (preferences:read)
 
   ;; misc other stuff
 

collects/framework/sig.ss

@@ -208,20 +208,9 @@
    snip%
    media-snip%))
 
-(define-signature mred:canvas^
-  (make-wrapping-canvas%
-   wrapping-canvas%
-
-   make-one-line-canvas%
-   one-line-canvas%
-
-   make-frame-title-canvas%
-   frame-title-canvas%
-   
-   make-wide-snip-canvas%
-   wide-snip-canvas%
-
-   number-control%))
+(define-signature framework:canvas^
+  (make-wide-snip-canvas%
+   wide-snip-canvas%))
 
 (define-signature mred:frame^
   (frame-width
@@ -331,21 +320,15 @@
    balanced?
    backward-containing-sexp))
 
-(define-signature mred:scheme-mode^
-  (scheme-mode-allow-console-eval
-   scheme-mode-tabify-on-return?
-   scheme-mode-match-round-to-square?
-   scheme-media-wordbreak-map
-   scheme-init-wordbreak-map
-   setup-global-scheme-mode-keymap
-   setup-global-scheme-interaction-mode-keymap
-   global-scheme-mode-keymap
-   global-scheme-interaction-mode-keymap
-   make-scheme-mode%
-   make-scheme-interaction-mode%
-   scheme-mode%
-   scheme-interaction-mode%
-   scheme-mode-style-list))
+(define-signature framework:scheme-mode^
+  (wordbreak-map
+   init-wordbreak-map
+   style-list
+   keymap
+   setup-keymap
+   make-text%
+   text<%>
+   text%))
 
 (define-signature framework:paren^
   (balanced? 

notes/mred/MrEd 100 Framework

@@ -73,12 +73,24 @@ The eliminated classes are:
   mred:scheme-interaction-mode% 
   mred:scheme-mode% 
   
+  :: see the methods of scheme:text%
+
+  mred:scheme-mode-allow-console-eval
+  mred:scheme-mode-tabify-on-return?
+  mred:scheme-mode-match-round-to-square?
+
   :: just use drscheme instead of these
     
   mred:console-edit% 
   mred:console-frame%
   mred:editor-frame%
   mred:transparent-io-edit% 
+  mred:setup-global-scheme-interaction-mode-keymap
+  mred:global-scheme-interaction-mode-keymap
+  mred:make-scheme-interaction-mode%
+  mred:scheme-interaction-mode%
+
+  :: deemed unworthy
 
   mred:autoload
 
@@ -146,6 +158,14 @@ The remaining existant classes:
 
 Old to new name mapping:
 
+  mred:scheme-media-wordbreak-map -> scheme:wordbreak-map
+  mred:scheme-init-wordbreak-map ->  scheme:init-wordbreak-map
+  mred:setup-global-scheme-mode-keymap -> scheme:setup-keymap
+  mred:global-scheme-mode-keymap -> scheme:keymap
+  mred:make-scheme-mode% -> scheme:make-text%  ; the meaning is different; see the docs
+  mred:scheme-mode% -> mred:text%              ; the meaning is different; see the docs
+  mred:scheme-mode-style-list -> scheme:style-list
+
   mred:handler? -> handler:handler?
   mred:handler-name -> handler:handler-name
   mred:handler-extension -> handler:handler-extension
@@ -244,9 +264,9 @@ NOTE: some used but non-existant interfaces from mred engine:
   
   ; text:make-basic% adds ranges, wrapping, move/copy-to-edit
   text:make-basic% : (interface (editor:basic<%> text<%>)) -> text:basic<%>
-  text:make-return% : text<%> -> editor:basic<%>
+  text:make-return% : editor:basic<%> -> editor:basic<%>
   text:make-searching% : (interface (editor:basic<%> text<%>)) -> text:searching<%>
-  text:make-clever-file-format% : text<%> -> editor<%>
+  text:make-clever-file-format% : editor:basic<%> -> editor:basic<%>
   text:make-scheme% : (interface (editor:basic<%> text<%>)) -> editor:scheme<%>
   
   editor-canvas:make-frame-title% : editor-canvas<%> -> editor-canvas<%>