Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[ALLY] Re: No email from this list

From: allenk:powerup:au at: 15-Dec-2000 8:29

Since there hasn't been anything for a while here is a demo that create hyperlinks in txt styles. I hope line the emailer line wrapping doesn't ruin this too much. Unfortuanately I can't get in touch with my ISP at the moment and I can't upload. Cheers, Allen K REBOL [ Title: "HyperLink Demo" Author: "Allen Kamp" Email: [allen--rebolforces--com] Date: 15-Dec-2000 History: { Modified and adapted for demo. Hyperlink code by Allen Kamp and Gabriele Santilli. } ] msg: trim/auto { This is a demo creates hyperlinks for the contents of the above txt style. Enter your text here and press the "show links" button to see it in action. Links in the format of http://www.rebol.com will be found and linked, as will this www.rebolforces.com You can also launch web scripts with it in the format of do http://www.rebol.com/feedback.r or local files like so do %localfile.r It also allows code to be evaluated like so do [request/ok "Hello World"] Many thanks to Gabriele (pictured) do [inform layout [image http://web.tiscalinet.it/rebol/photo.jpg]] who cleaned/improved up my initial parse code. Note: For best results, text wrapping is turned off. Enjoy, Allen K} ; Hyperlinks web: stylize [ link: txt leaf 400x20 font-size 11 with [ para: [wrap?: false] action: [ either url? self/data [ error? try [browse self/data] ] [ error? try [do self/data] ] ] ] ] make-link: func [ offset {Offset to place link} url {url to perform action on} txt {display text} col {set a color for this link} /local f ] [ f: make-face web/link f/data: url f/text: txt f/offset: offset - 4x2 f/size/x: 2 + first size-text f if col [set-font f 'color col set-font f 'colors reduce [col f/font/colors/2]] f/saved-area: true f ] add-hyperlinks: none parser: context [ non-white-space: complement white-space: charset reduce [#" " newline tab cr #"<" #">"] to-space: [some non-white-space | end] skip-to-next-word: [some non-white-space some white-space] msg-face: none match-pattern: func [pattern url color] [ compose [ mark: (pattern) (either string? pattern [[to-space end-mark:]] []) (to-paren compose [ text: copy/part mark end-mark offset: caret-to-offset msg-face mark insert tail msg-face/pane make-link offset (either url [url] [[load text]]) text (color) ]) any white-space ] ] link-rule: clear [] foreach [pattern url color] reduce [ "http://" none none "www." [join http:// text] none "ftp://" none none "ftp." [join ftp:// text] none "do http://" none crimson "do %" none crimson ["do [" (end-mark: second load/next skip mark 3) :end-mark] [first reduce [load text text: copy/part text 2]] crimson ] [ insert insert tail link-rule match-pattern pattern url color '| ] insert tail link-rule 'skip-to-next-word ; GC bug fixed now! use [mark end-mark text offset] [bind link-rule 'mark] set 'add-hyperlinks func [face] [ msg-face: face error? try [parse/all face/text [any link-rule]] ] ] clear-all: does [ tx/text: copy "" tx/line-list: none clear tx/pane ta/text: copy "" ta/line-list: none ] view layout [ tx: txt 420x200 black ivory font-size 11 with [pane: copy [] para: [wrap?: false]] ta: area copy msg 420x200 font-size 11 with [pane: copy [] para: [wrap?: false]] across button "Show Links" [clear tx/pane tx/text: ta/text add-hyperlinks tx show tx] button "Clear Links" [clear tx/pane show tx] button "Clear All" [clear-all show [tx ta]] button "Reset Text" [clear-all ta/text: copy msg show [tx ta]] ] ; script end