[plt-scheme] How to store extra data in text% editor

Hi everyone
I'm very new to DrScheme and to scheme as well!

I'm trying to use MrEd to develop a little tool to store text, including the Hyperlinks facilities. As documented, I'd like to store text information (with the text% editore class), including some hyperlinks.
I tried to derive new classes from editor-data% and editor-data-class%, then I wrote a new class from the text% class, and tried to override the set-region-data and get-region-data methods.
Well, I'm puzzled, I don't know what is really the classes hierachy and thefore I struggle in understanding when and where to store the hyperlink (in the write method from the editor-class? Elsewhere?)

I join my code here below.
Any help very much appreciated.
Pascal

(I'm 44 and not a programmer, that may explain my weakness! I discovered DrScheme - and Scheme - on a France site).

;;the code
(define MyIcon .) 

; Type de données pour mes Tags
(define AmjP-editor-data-class%
  (class editor-data-class%
      (define/override get-classname (lambda () "AmjP-editor-data-class%"))
      (define/override set-classname (lambda (n) ()))
      (define/override read          (lambda (f)
          ((bytes/utf-8->string (send f get (send f get-exact))))))
      (super-instantiate())))

(define My-AmjP-editor-data-class (instantiate AmjP-editor-data-class% ()))
(send (get-the-editor-data-class-list) add My-AmjP-editor-data-class) 

;(define AmjP-editor-data-class (instantiate editor-data-class% ()))
;(send AmjP-editor-data-class set-classname "AmjP-editor-data-class")
;(send (get-the-editor-data-class-list) add AmjP-editor-data-class) 

; Dérivation de la Class Données (editor-data
(define AmjP-editor-data%
  (class editor-data%
      (init-field (MyTag "Toto"))
      (define/public get-tag (lambda () MyTag))
      (define/public set-tag (lambda (n) (set! MyTag n)))
      (define/override get-dataclass (lambda () AmjP-editor-data-class%))
      (define/override set-dataclass (lambda (c) ()))
      (define/override write         (lambda (f) 
           (send f put-exact (string-length MyTag))
           (send f put (string-length MyTag) (string->bytes/utf-8 MyTag))
           ())) 
    (super-instantiate())))

;        (define tedo (instantiate AmjP-editor-data% ("tedo")))
;        (display (send tedo get-tag))
;        (define teda (instantiate AmjP-editor-data% ("teda")))
;        (display (send teda get-tag))
;        (send teda set-tag "plouplou")
;        (display (send teda get-tag))

; Nouvelle Class text% pour gérer les Données Tag
(define AmjP-text%
  (class text%
    
;  (define/override write-headers-to-file
;   (lambda (stream)
;      
;      (send this begin-write-header-footer-to-file stream "AmjP:HyperLiens" (box 100))
;      (send stream put 9 (string->bytes/utf-8 "123456789"))
;      (send this end-write-header-footer-to-file stream 100)
;      (super write-headers-to-file stream)))

;  (define/override read-header-from-file
;    (lambda (stream name)
;      (equal? name "AmjP:HyperLiens")
;      (send stream read 9 (string->bytes/utf-8 "123456789"))
;       (super read-header-from-file stream)))

  (define MonClick  
        (lambda (MyText debut fin)
          ;(send t insert (ListeClasseData) debut)
          (display ">>") (display debut) (display "-") (display fin) (display "<<")
          (display (ListeClasseData))
         ;(display (send (send MyText get-snip-data (send MyText find-snip debut 'after #f)) get-tag))
         ;(display (send (send MyText get-snip-data (send MyText find-snip (+ debut 1) 'after #f)) get-tag))
         (display (send (send MyText get-region-data debut fin) get-tag))
        ; (display (send (send MyText get-snip-data (send MyText find-snip (+ debut 3)'after #f)) get-tag))
        ; (display (send (send MyText get-snip-data (send MyText find-snip (+ debut 4) 'after #f)) get-tag))
        ; (display (send (send MyText get-snip-data (send MyText find-snip (+ debut 5) 'after #f)) get-tag))
        ; (display (send (send MyText get-snip-data (send MyText find-snip (+ debut 6)'after #f)) get-tag))
          )) 
    
  (define/public set-snip-tag-data
        (lambda (begin end text tag)
          (define tedor (instantiate AmjP-editor-data% ()))
          (send tedor set-tag tag)
         ; (define MySnip (instantiate string-snip% ()))
         ; (send MySnip set-style MonStyle) 
;          (send MySnip insert text (string-length text) 0)
          (send this insert text begin)
;          (send this set-snip-data MySnip tedor)
;          (send this insert MySnip begin end #t)
          (send this set-position begin (+ begin (string-length text)))
          (send this change-style MonStyle)
          ;(send (send this get-snip-data MySnip) get-tag)
          (send this set-clickback begin (+ begin (string-length text)) MonClick #f #f)
          (send this set-region-data begin (+ begin (string-length text)) tedor)
          (display "***")
          (display (send this get-region-data begin (+ begin (string-length text))))
          (display "***")
         ))
    
 ; (define/override get-snip-data
 ;       (lambda (snip)
 ;         (display "coucou")
 ;         (super get-snip-data snip)));;

 ; (define/override set-snip-data
 ;       (lambda (snip data)
 ;         (display "copie")
 ;         (super set-snip-data snip data)));;
;
   (super-instantiate())))

; Class pour prise en compte des Drop File
(define AmjP-DropFrame%
     (class frame%
     (define/override on-drop-file
         (lambda (FileName)
         (send t insert (path->string  FileName))
         (super on-drop-file FileName))) 
     (super-instantiate ())))       

; Defines pour listers les classes Snip et Data
(define (ListeClasseSnip)
  (begin (define temp "")  
  (do ((i 1 (+ i 1))) 
      ((= i (send (get-the-snip-class-list) number))()) 
      (set! temp  (string-append  temp  " >> " (send (send (get-the-snip-class-list) nth i) get-classname))))
  (string-append " >>>>>> " temp " <<<<<<")))
(define (ListeClasseData)
  (begin (define temp "")  
  (do ((i 1 (+ i 1))) 
      ((= i (send (get-the-editor-data-class-list) number))()) 
      (set! temp  (string-append  temp  " >> " (send (send (get-the-editor-data-class-list) nth i) get-classname))))
  (string-append " >>>>>> " temp " <<<<<<")))

(define f (instantiate AmjP-DropFrame% ("Simple Editor" #f 800 600 100 100)))
(send f set-icon (send MyIcon get-bitmap))
(send f accept-drop-files #t)
(define t (instantiate AmjP-text%()))
;(define t (instantiate pasteboard%()))
(define c (instantiate editor-canvas% (f)))
(send c set-editor t)


; Style
(define MyStyleDelta (instantiate style-delta% ()))
(send MyStyleDelta set-underlined-on #t)
(define MonStyle (send (send t get-style-list) find-or-create-style (send (send t get-style-list) basic-style) MyStyleDelta))
(send (send t get-style-list) new-named-style "AmjP-style" MonStyle)
;(display MonStyle)


(define mb (instantiate menu-bar% (f)))
(define m-file (instantiate menu% ("File" mb)))
(define m-edit (instantiate menu% ("Edit" mb)))
(define m-font (instantiate menu% ("Font" mb)))
(define m-help (instantiate menu% ("?" mb)))
(append-editor-operation-menu-items m-edit)
(append-editor-font-menu-items m-font)
(define m-file-Open   
  (instantiate menu-item%() 
    (label "Open") 
    (parent m-file)
    (callback 
     (lambda(menu event)(send t load-file "")))))
(define m-file-Save   (instantiate menu-item%() (label "Save") (parent m-file)
                      (callback (lambda(menu event)(send t save-file #f)))))
(define m-file-SaveAs (instantiate menu-item%() (label "Save as...") (parent m-file)
                      (callback (lambda(menu event)(send t save-file ""))))) 
(define m-edit-dummy  (instantiate separator-menu-item%() (parent m-edit)))
(define m-edit-InsImg (instantiate menu-item%() (label "Insert Picture...") (parent m-edit)
                      (callback (lambda(menu event)(send t insert-image #f)))))
(define m-edit-InsHT 
  (instantiate menu-item%() 
    (label "Insert HyperLink...") 
    (parent m-edit)
    (callback (lambda (menu event)
        (define deb (send t get-start-position))
        (define fin (send t get-end-position)   )    
        (send t set-snip-tag-data deb fin (send t get-text deb fin)  "turlututu")    
                ))))
(define m-help-AboutB (instantiate menu-item%() (label "About...")(parent m-help)
                      (callback (lambda(menu event)(message-box "Simple editor" "Test editor
Copyright (c) 2006-2010, AmjP Inc.

Developed with DrScheme, base on MrEd version 301, Copyright (c) 2004-2005 PLT Scheme Inc.http://www.plt-scheme.org/" f '(ok  caution)))))) 

(send t insert "Bonjour, c'est un test." 24 0 )
(send t set-snip-tag-data  5 15 "Tag" "hello")

(send t auto-wrap #t)
(send f show #t)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20060520/a58988b8/attachment.html>