<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=iso-8859-1">
<META content="MSHTML 6.00.2900.2873" name=GENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=#ffffff>
<DIV><FONT face=Arial size=2>Hi everyone</FONT></DIV>
<DIV><FONT face=Arial size=2>I'm very new to DrScheme and to scheme as
well!</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>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.</FONT></DIV>
<DIV><FONT face=Arial size=2>I tried to </FONT><FONT face=Arial
size=2>derive new classes from editor-data% and editor-data-class%, then I wrote
a </FONT><FONT face=Arial size=2>new class from the text% class, and tried to
override the set-region-data and get-region-data methods.</FONT></DIV>
<DIV><FONT face=Arial size=2>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?)</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>I join my code here below.</FONT></DIV>
<DIV><FONT face=Arial size=2>Any help very much appreciated.</FONT></DIV>
<DIV><FONT face=Arial size=2>Pascal</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>(I'm 44 and not a programmer, that may explain my
weakness! I discovered DrScheme - and Scheme - on a France
site).</FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial size=2>;;the code</FONT></DIV>
<DIV><FONT face=Arial size=2>(define MyIcon .) </FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; Type de données pour mes Tags<BR>(define
AmjP-editor-data-class%<BR> (class
editor-data-class%<BR> (define/override
get-classname (lambda ()
"AmjP-editor-data-class%"))<BR> (define/override
set-classname (lambda (n) ()))<BR>
(define/override read
(lambda (f)<BR>
((bytes/utf-8->string (send f get (send f
get-exact))))))<BR>
(super-instantiate())))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>(define My-AmjP-editor-data-class (instantiate
AmjP-editor-data-class% ()))<BR>(send (get-the-editor-data-class-list) add
My-AmjP-editor-data-class) </FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>;(define AmjP-editor-data-class (instantiate
editor-data-class% ()))<BR>;(send AmjP-editor-data-class set-classname
"AmjP-editor-data-class")<BR>;(send (get-the-editor-data-class-list) add
AmjP-editor-data-class) </FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; Dérivation de la Class Données
(editor-data<BR>(define AmjP-editor-data%<BR> (class
editor-data%<BR> (init-field (MyTag
"Toto"))<BR> (define/public get-tag (lambda ()
MyTag))<BR> (define/public set-tag (lambda (n)
(set! MyTag n)))<BR> (define/override
get-dataclass (lambda ()
AmjP-editor-data-class%))<BR> (define/override
set-dataclass (lambda (c) ()))<BR>
(define/override write (lambda
(f) <BR> (send f
put-exact (string-length
MyTag))<BR> (send f
put (string-length MyTag) (string->bytes/utf-8
MyTag))<BR> ()))
<BR> (super-instantiate())))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; (define
tedo (instantiate AmjP-editor-data%
("tedo")))<BR>; (display (send tedo
get-tag))<BR>; (define teda
(instantiate AmjP-editor-data%
("teda")))<BR>; (display (send teda
get-tag))<BR>; (send teda set-tag
"plouplou")<BR>; (display (send teda
get-tag))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; Nouvelle Class text% pour gérer les Données
Tag<BR>(define AmjP-text%<BR> (class text%<BR>
<BR>; (define/override write-headers-to-file<BR>; (lambda
(stream)<BR>; <BR>;
(send this begin-write-header-footer-to-file stream "AmjP:HyperLiens" (box
100))<BR>; (send stream put 9
(string->bytes/utf-8 "123456789"))<BR>; (send
this end-write-header-footer-to-file stream
100)<BR>; (super write-headers-to-file
stream)))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; (define/override
read-header-from-file<BR>; (lambda (stream
name)<BR>; (equal? name
"AmjP:HyperLiens")<BR>; (send stream read 9
(string->bytes/utf-8 "123456789"))<BR>;
(super read-header-from-file stream)))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2> (define MonClick
<BR> (lambda (MyText debut
fin)<BR> ;(send t insert
(ListeClasseData)
debut)<BR> (display
">>") (display debut) (display "-") (display fin) (display
"<<")<BR> (display
(ListeClasseData))<BR> ;(display
(send (send MyText get-snip-data (send MyText find-snip debut 'after #f))
get-tag))<BR> ;(display (send
(send MyText get-snip-data (send MyText find-snip (+ debut 1) 'after #f))
get-tag))<BR> (display (send
(send MyText get-region-data debut fin)
get-tag))<BR> ; (display (send (send
MyText get-snip-data (send MyText find-snip (+ debut 3)'after #f))
get-tag))<BR> ; (display (send (send
MyText get-snip-data (send MyText find-snip (+ debut 4) 'after #f))
get-tag))<BR> ; (display (send (send
MyText get-snip-data (send MyText find-snip (+ debut 5) 'after #f))
get-tag))<BR> ; (display (send (send
MyText get-snip-data (send MyText find-snip (+ debut 6)'after #f))
get-tag))<BR> ))
<BR> <BR> (define/public
set-snip-tag-data<BR> (lambda (begin
end text tag)<BR> (define
tedor (instantiate AmjP-editor-data%
()))<BR> (send tedor
set-tag tag)<BR> ; (define
MySnip (instantiate string-snip%
()))<BR> ; (send MySnip
set-style MonStyle) <BR>;
(send MySnip insert text (string-length text)
0)<BR> (send this insert
text begin)<BR>; (send
this set-snip-data MySnip
tedor)<BR>; (send this
insert MySnip begin end
#t)<BR> (send this
set-position begin (+ begin (string-length
text)))<BR> (send this
change-style MonStyle)<BR>
;(send (send this get-snip-data MySnip)
get-tag)<BR> (send this
set-clickback begin (+ begin (string-length text)) MonClick #f
#f)<BR> (send this
set-region-data begin (+ begin (string-length text))
tedor)<BR> (display
"***")<BR> (display (send
this get-region-data begin (+ begin (string-length
text))))<BR> (display
"***")<BR>
))<BR> <BR> ; (define/override
get-snip-data<BR> ; (lambda
(snip)<BR> ; (display
"coucou")<BR> ; (super
get-snip-data snip)));;</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2> ; (define/override
set-snip-data<BR> ; (lambda (snip
data)<BR> ; (display
"copie")<BR> ; (super
set-snip-data snip data)));;<BR>;<BR>
(super-instantiate())))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; Class pour prise en compte des Drop
File<BR>(define AmjP-DropFrame%<BR> (class
frame%<BR> (define/override
on-drop-file<BR> (lambda
(FileName)<BR> (send t insert
(path->string
FileName))<BR> (super
on-drop-file FileName))) <BR> (super-instantiate
()))) </FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>; Defines pour listers les classes Snip et
Data<BR>(define (ListeClasseSnip)<BR> (begin (define temp "")
<BR> (do ((i 1 (+ i 1))) <BR> ((= i (send
(get-the-snip-class-list) number))()) <BR> (set!
temp (string-append temp " >> " (send (send
(get-the-snip-class-list) nth i) get-classname))))<BR> (string-append "
>>>>>> " temp " <<<<<<")))<BR>(define
(ListeClasseData)<BR> (begin (define temp "") <BR> (do ((i 1
(+ i 1))) <BR> ((= i (send
(get-the-editor-data-class-list) number))()) <BR>
(set! temp (string-append temp " >> " (send (send
(get-the-editor-data-class-list) nth i) get-classname))))<BR>
(string-append " >>>>>> " temp "
<<<<<<")))</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>(define f (instantiate AmjP-DropFrame% ("Simple
Editor" #f 800 600 100 100)))<BR>(send f set-icon (send MyIcon
get-bitmap))<BR>(send f accept-drop-files #t)<BR>(define t (instantiate
AmjP-text%()))<BR>;(define t (instantiate pasteboard%()))<BR>(define c
(instantiate editor-canvas% (f)))<BR>(send c set-editor t)</FONT></DIV>
<DIV> </DIV><FONT face=Arial size=2>
<DIV><BR>; Style<BR>(define MyStyleDelta (instantiate style-delta% ()))<BR>(send
MyStyleDelta set-underlined-on #t)<BR>(define MonStyle (send (send t
get-style-list) find-or-create-style (send (send t get-style-list) basic-style)
MyStyleDelta))<BR>(send (send t get-style-list) new-named-style "AmjP-style"
MonStyle)<BR>;(display MonStyle)</DIV>
<DIV> </DIV>
<DIV><BR>(define mb (instantiate menu-bar% (f)))<BR>(define m-file (instantiate
menu% ("File" mb)))<BR>(define m-edit (instantiate menu% ("Edit"
mb)))<BR>(define m-font (instantiate menu% ("Font" mb)))<BR>(define m-help
(instantiate menu% ("?" mb)))<BR>(append-editor-operation-menu-items
m-edit)<BR>(append-editor-font-menu-items m-font)<BR>(define
m-file-Open <BR> (instantiate menu-item%()
<BR> (label "Open") <BR> (parent
m-file)<BR> (callback <BR>
(lambda(menu event)(send t load-file "")))))<BR>(define m-file-Save
(instantiate menu-item%() (label "Save") (parent
m-file)<BR>
(callback (lambda(menu event)(send t save-file #f)))))<BR>(define m-file-SaveAs
(instantiate menu-item%() (label "Save as...") (parent
m-file)<BR>
(callback (lambda(menu event)(send t save-file ""))))) <BR>(define
m-edit-dummy (instantiate separator-menu-item%() (parent
m-edit)))<BR>(define m-edit-InsImg (instantiate menu-item%() (label "Insert
Picture...") (parent
m-edit)<BR>
(callback (lambda(menu event)(send t insert-image #f)))))<BR>(define
m-edit-InsHT <BR> (instantiate menu-item%() <BR> (label
"Insert HyperLink...") <BR> (parent
m-edit)<BR> (callback (lambda (menu
event)<BR> (define deb (send t
get-start-position))<BR> (define fin
(send t get-end-position) )
<BR> (send t set-snip-tag-data deb fin
(send t get-text deb fin) "turlututu")
<BR>
))))<BR>(define m-help-AboutB (instantiate menu-item%() (label
"About...")(parent
m-help)<BR>
(callback (lambda(menu event)(message-box "Simple editor" "Test
editor<BR>Copyright (c) 2006-2010, AmjP Inc.</DIV>
<DIV> </DIV>
<DIV>Developed with DrScheme, base on MrEd version 301, Copyright (c) 2004-2005
PLT Scheme Inc.http://www.plt-scheme.org/" f '(ok caution)))))) </DIV>
<DIV> </DIV>
<DIV>(send t insert "Bonjour, c'est un test." 24 0 )<BR>(send t
set-snip-tag-data 5 15 "Tag" "hello")</DIV>
<DIV> </DIV>
<DIV>(send t auto-wrap #t)<BR>(send f show #t)</FONT></DIV></BODY></HTML>