REBOL [ Title: "HyperNotes" Date: 8-Jan-2006 File: %hypernotes.r Author: "Martin Johannesson" Version: 0.0.1 Tabs: 4 Home: http://hem.bredband.net/martinjohannesson/hypernotes/ License: {MIT License, see http://hem.bredband.net/martinjohannesson/hypernotes/} ] sv: system/view notes-context: context [ root-node: compose [ type text visible yes content (decompress #{789C9D585B6F1BB7127E167FC5202F411169653B4E2F4663C06D721AA3495BB4E9E943EB07EE2EA5E5F12EA9925C4B3AF08F3FDF0C77757112A3390664AC96C399E137DF5C28F5D7BFAF5FA9DAD39FA55DCE16DEA50BEAF4ADA185AECC9CBFD39FD1FED75CD0F909C5B46DF1F4B4F46D7D7323BBD4249A444F1B67BB25253FB39D5E1A6AF5D6F7699EECB2492C3329FD86BE3C39D9BC38A175639321B358982AAF4D9641D7D6C0D2C9E694CE9E9F17672FCEF07941A7DF7C559C9D7DC5CF2C5707BDCE3B26E2D8E8B1BC591947A7A7A7C5E9D75FCADE6436894E9F6F6667A45DB233DD5A1D4D4D4FDE6C5726FCE493894F761BB34F79CBD966F6FC1F6C39B025EFF884279BF3AFE598E7DFF0BB1B259F1B75A3322C82929A33E22F5FBEFCC3B495EF60D6D3DE8052B3D9ECE73B13EEAC592BB55F201B4953C3DF5BEB6E4D3DA5C69AA0ABC656BA6DB7E4436D02BC75902EBDBF9D52D7570DB516C1D4846DD13BDDD21FF6475BD0FBC620CCD6D1AA0F2B1F0DF9051DDB8257ABE0EF6C0D0759D8681769E1037445EB96ADA13E9AC0623E2CB50345C83AAC773A59EF00604D01FF7C87EDBE070FA015AFA9F2EECE380EF7948C8E169EEBAA3231DA123AB38282AE68D1A73E18021291F5754225EBAAB6AFF93CDF3629AD2EE6F3F57A5D049CB72D9C49733C45860EFAE6F7BFBEFEEEE7B7F3DF86EF97544A30AD4B2630B9E530C17438307B3BC7B7AE6F9395636597F8747C7886343268960F6193058EA363C7C0AD353EC1A60486B07EDEFD71576B588EF27F0648B037154DEADAEC35BDC27BFA3EBFBF14305973ECCBFF70D6C0ADD2A78692EDC477800A50384D19DE9802229B628E72AC825D258E2833016863331BE4E0BBBE33C1F791CA7E19A7A20972CB5E2372C900AC03D9C854ED9750C0C6A654F7668447E3A4A643448187A98F5DB8987D2194CEF0BCF255CF82F45B0A7DC501568A9D4CC1C0D3F11D0156D6DB9A45A2DAC615CA4994370748D7A32ADE5BD06BC4638B40D54C4391159DC1AC8289108B642CDE327D579C8A089B449584D10B1434AC0D6705BD65512481CBA090B939EEE350B0B12854CDBBB37164691B3D748A98BC635C3BBDDD41C975A650EAD9B3675799F9B03724FFFB26EF8116E0905908487B91F9FDD7B7B0F72F786C36BA5BB58842624ACA81D8F0B1F8B7724010EF7E7CB82CE89D8F09C5C063B798E8630E33EBCE0CE0A34A6509B9B400C3857512DF11090893AEEBC02912579C4B96C969931E72785C6537240E192BA5AEDAF6005A9CA33220E79829C1FB944F53694725BA448DBA5C5309EC5A5BDDB2BA811BAFB102DAA684EF63C0BD6F4B0DDBA5BFCB45EB0147AED28097B7527DA08235EABD1C168547D176B6D552DD76528EDEBC7FF756DC2BE8DA71834CD36C98FB46AE5C194FF04C20698CBEE30287C2D8F6C655F9288FD4045FC539775F3C1C5683777885D4B93CB49409F43A1361600EC7655775C6A08F22E3C3E9FDC2069060E0901CE892BDFDE48622E71DB79DCCCB2A183DC425530D3D61652A2E8B492F77F180B307C9D3B67ECDB29D76CE840BA5269FE7A29A284E126803CCCDDE21CE2CEF807239B0990B1B43D4EEE35AFA7A9BD38EDECA260476979FF94C8F3853227897536A3FB2539CA9E5156D0D7B6CE1F791BEDA4317BECC656D0EA97BB4E95CD49905877AC5EBB52987F4103D1F300543C3FD12847648E7377B056B8BDCF23C9A00008C5F816AB3D0E8685406BF46532BE807D4257012A3430A1FA654E55BCF03C41A9344CC7193E2123406B45503C2BDC15E18E3AAB94044D984C51C1718E2D6DC993647A33463A3AEC7F08F91E072D90C5A50F07548EC385A998618178AAA81BD0A2D9AA2F95B7266AA22CF31687F9899A63B7E371808D01CB35DB4231BD019C1824CB47DA6EDACE5F04BB7F98425F47F282CA576A8CCC09D50649434892671B86CB5BBA58C4669B8034A44F582351E1A2E48A95F4610636E2012E71D2973E80E51D307B8CB96BDF342F5008F6D3063CD1216EE9D1627795363F66A1EA0EDFC38F5E602BE3B28C23C101F0E6ECC07096F5DCD9D5E927EAF7C7411159E16663D666EE43447D8F2E42403EC188EC1BFA33022C527981546695E8F065DB3DE2FA3E61D2E83A2E160B5288AC355A6289F160AD0C200F94E70947AA4505C0F71E1AE6D5D6FD4C43F2C65125E5647F8DB9DD1EDEA16002CF2E243112FB388003164C8D11EA9E668A09CBD6BDFB7F5C0CABD6D00FB19B8AAC750558F60AAFE19A2EAFFC1F31370AAC7C0142C3F0F4AA5AE074372A3C0B58873157D2AEEF20ED38AA9F364E5FC1A6350282D2658D4485CD5F2703D0C24E3B8841D2AEB4123920C95213E8F487A182D655410ECAFF9D281F4B2184CF2F8FABBF44D56FF3DD4ABEFC64ECA8E7211E767BE9AE7F1BEF5B2C83747F1FC3117E530E2A3DB1E39229069063B5FE4EC8153598EEF1566BCBF3C9834F5386D49B1C15C58F5AD964DCCA75E26E353F1F64CF1FFA3B91D77C7B509199B3CC358D3D67B6A8F5726B9AC72DBE1BA21BF4C4C74157C8C6A5226474FAEEAFA89FC02008333D131677517B0FC0C76F1BEF16BDA2DF2DD7B2F7A31583D3F5113B983AB2B9767B5A7F18837EC66C5971978214E0C3E1CB9F0090F1E3870A33E663E5B7F0F206119E36A0FDAA4DCDAC03F50E6250775F845E144FD0F70C1072AA4110000}) ] clean-db: load decompress #{789CA58FBD0A83401084FB7B8A798213AF0C39BB90324D3AB1505954A2AEDC2D418979F798100D0484FCC016C3323BDF4EDCB290DF04C1AE4F9BAE268F58868E20D40BCE95AFB29A304CEB9C5BA15670B1D6CE5EA5F60C616CDF4366118E4F813002BB75A3598C26D24A1D1C0A4696E6A77BBC9404C72CAFF3B1E48622746941FA9A6015FF49996359794CB37CAA1FB5FE869B5FE0E63B78720307739B8FBF010000} db: sort/skip copy/deep clean-db 2 db-file: none dirty?: yes set-dirty: func [d] [ dirty?: d save-btn/effect/colorize: either d ['red]['green] show save-btn ] create-new: does [db: copy [] db-file: none set-dirty no] load-db: has [f pre-db] [ f: request-file/only/title/file "Open Notes File" "Open" %. if not none? f [ pre-db: load f either pre-db/1 = 'REBNOTES [ db: sort/skip copy/deep pre-db/2 2 db-file: f set-dirty no ][alert "File is not a valid HyperNotes file." f: none] ] not none? f ] save-db: has [f] [ if dirty? [ f: db-file if none? f [f: request-file/only/title/file/save "Save Notes File" "Save" %.] if not none? f [ db-file: f save db-file reduce ['REBNOTES db] set-dirty no ] ] ] make root-protocol [ port-flags: system/standard/port-flags/pass-thru init: func [port spec][port/url: to-notes-url spec] open: func [port][ port/state/tail: 1 port/state/index: 0 port/state/flags: port/state/flags or port-flags ] close: func [port][] copy: func [port /local data][ data: either port/url = notes:// [root-node][select db port/url] either series? data [system/words/copy/deep data][data] ] insert: func [port data /local pos][ either pos: find db port/url [ either data [change/only next pos reduce ['type 'text 'visible 'yes 'content data]][remove/part pos 2] ][if data [repend db [port/url reduce ['type 'text 'visible 'yes 'content data]]]] sort/skip db 2 set-dirty yes ] query: func [port /local result][port/status: any [port/url = notes:// find db port/url]] net-utils/net-install notes self 0 ] ] hypertext-context: context [ p1: p2: none href: none linked-text: none non-ws: complement charset " ^-^/" link-rule: [ to {<} p1: [{" p2: ">" p3: (remove/part p2 p3) :p2 (repend/only linked-text/links ['face none 'start index? p1 'end index? p2 'url load mold to-url href 'sensors none]) ] process-text: func [text][ linked-text: copy reduce ['text text 'links copy []] parse/all text [any link-rule to end] linked-text ] set 'hypertext-styles stylize [ hypertext: text with [ links: none init: append head insert copy init [ use [data] [ data: hypertext-context/process-text copy text links: data/links text: data/text ] ][ use [f l p1 p2 p-start p-end first-line-info line-info line-offset] [ f: self first-line-info: make sv/line-info [] line-info: make sv/line-info [] textinfo f first-line-info 0 pane: copy [] foreach l links [ l/face: f l/sensors: copy [] p-start: caret-to-offset f at text l/start p-end: caret-to-offset f at text l/end n-lines: 1 + ((p-end/y - p-start/y) / first-line-info/size/y) line-offset: (p-start/y - first-line-info/offset/y) / first-line-info/size/y for i 1 n-lines 1 [ textinfo f line-info (line-offset + i - 1) p1: either i = 1 [p-start][line-info/offset] p2: either i = n-lines [p-end][line-info/offset + line-info/size] sensor: make-face/spec 'sensor [ size: as-pair (p2/x - p1/x + 2) (line-info/size/y) link-color: 7.95.255 offset: p1 switch copy/part l/url skip find l/url "://" 3 [ notes:// [ action: reduce ['goto l/url] link-color: either exists? l/url [7.95.255][255.95.7] ] http:// [action: reduce ['browse l/url] link-color: 107.151.48] ] effect-color: link-color effect-block: [ merge colorize invert colorize (complement effect-color) invert draw [ pen (effect-color) line (as-pair 0 size/y - 1) (size - 0x1) ] key white ] primary-effect: compose/deep effect-block effect-color: link-color * 2 secondary-effect: compose/deep effect-block effect: primary-effect feel: make feel [over: func [face act pos] [face/effect: either act [secondary-effect][primary-effect] show face]] ] append pane sensor append l/sensors sensor ] ] ] ] ] ] ] tree-context: context [ expand-icon: draw make image! 9x9 [ pen 120.152.181 fill-pen linear 4x4 normal 0 200 70.0 0.04 0.04 255.255.255 195.186.170 195.186.170 box 0x0 8x8 pen black line 2x4 6x4 line 4x2 4x6 ] collapse-icon: draw make image! 9x9 [ pen 120.152.181 fill-pen linear 4x4 normal 0 200 70.0 0.04 0.04 255.255.255 195.186.170 195.186.170 box 0x0 8x8 pen black line 2x4 6x4 ] document-icon: draw make image! 9x9 [ pen white fill-pen white box 0x0 8x8 pen black fill-pen black circle 4x4 2 ] set 'tree-styles stylize [ tree: list 255.255.255 edge [color: none size: 0x0] [ panel 500 [ origin 0x0 space 0x0 pad 0x2 across pad 4x4 image 9x9 [] with [node: none] pad 1x-4 label 500 [] font [color: 0.0.0] with [ node: none count: none select-node: func [][if parent-face [parent-face/parent-face/parent-face/selected: node/url]] ] ] ] supply [ if index = 1 [ entry: either all [face/parent-face face/parent-face/parent-face/data] [ count: count + face/parent-face/parent-face/count-offset pick face/parent-face/parent-face/data count ][none] either all [entry face/parent-face] [ face/offset/x: entry/depth * 16 face/pane/1/node: entry face/pane/1/action: func [face action] [ if face/node/type = 'folder [ face/node/state: select [expanded collapsed expanded] face/node/state either face/node/state = 'collapsed [make-invisible face/node/itree 'no][make-visible face/node/itree 'yes] build-tree-data itree tree-data show face/parent-face/parent-face/parent-face ] ] face/pane/2/count: count face/pane/2/action: get in face/parent-face/parent-face 'on-select face/pane/2/node: entry face/pane/2/text: entry/text face/pane/2/size/x: 1000 face/pane/2/size/x: 4 + first size-text face/pane/2 either face/parent-face/parent-face/selected = entry/url [ face/pane/2/color: 49.106.197 face/pane/2/font/color: 255.255.255 ][face/pane/2/color: none face/pane/2/font/color: 0.0.0] switch entry/type [ folder [either entry/state = 'collapsed [face/pane/1/image: expand-icon][face/pane/1/image: collapse-icon]] document [face/pane/1/image: document-icon] ] ][face/pane/1/image: none face/pane/2/text: none face/pane/2/color: none] ] ] with [ lc: none count-offset: 0 selected: none on-select: func [face entry][] scroll: func [sb] [count-offset: max 0 ((length? tree-data) - lc) * sb/data] words: reduce [ 'supply func [new args][new/subfunc: func [face count index] second args next args] 'data func [new args][new/data: first next args next args] 'on-select func [new args][new/on-select: func [face] first next args next args] ] expand-to: func [url [url!] /local p f tokens token rebuild-needed item-url item-url2][ rebuild-needed: false p: itree tokens: parse/all skip find url "://" 3 "/" token: tokens while [not tail? token] [ item-url: to-notes-url compose ["notes" (copy/part tokens next token)] either f: find p token/1 [ either tail? next token [ if exists? item-url [ foreach [name params children] p [ item-url2: to-notes-url compose ["notes" (copy/part tokens token) (name)] if exists? item-url2 [params/data/visible: 'yes] ] ] ][ if f/2/state <> 'expanded [f/2/state: 'expanded rebuild-needed: true] ] p: third f ][if rebuild-needed [build-tree-data itree tree-data] return] token: next token ] if rebuild-needed [build-tree-data itree tree-data] ] update: does [lc: round/down (size/y / subface/size/y)] init: append copy init [update] ] label: label 0.0.0 font [colors: [black 201.199.186] size: 11 shadow: none style: none] ] ] itree: [] tree-data: [] refresh-tree-data: func [/local p f depth tokens token next-block p0 item-url][ clear itree foreach [url data] notes-context/db [ p0: none p: itree depth: 0 tokens: parse/all skip find url "://" 3 "/" token: tokens while [not tail? token] [ either f: find p token/1 [ if data/visible = 'yes [f/2/state: 'expanded] p0: p p: third f ][ while [not tail? token] [ item-url: to-notes-url compose ["notes" (copy/part tokens next token)] append p reduce [ token/1 reduce ['depth depth 'text token/1 'type 'folder 'state either exists? item-url ['collapsed][select [yes expanded no collapsed] data/visible] 'url item-url 'data data 'itree next-block: copy [] 'parent p0 ] next-block ] p0: p p: last p token: next token depth: depth + 1 ] ] token: next token depth: depth + 1 ] ] build-tree-data itree tree-data show doc-tree ] build-tree-data: func [itree tree-data /level depth][ if not level [depth: 0 clear tree-data] foreach [name params children] itree [ if empty? children [params/type: 'document] append/only tree-data params if params/state = 'expanded [build-tree-data/level children tree-data depth + 1] ] if not level [gui/tree-redrag] ] make-invisible: func [children [block!]][ if empty? children [return] foreach [name params sub-children] children [if exists? params/url [params/data/visible: 'no] make-invisible sub-children] ] make-visible: func [children [block!]][foreach [name params sub-children] children [if exists? params/url [params/data/visible: 'yes]]] delete-subtree: func [delete-url [url!] /local top-url f for-removal][ for-removal: [] clear for-removal write delete-url none top-url: join delete-url "/" foreach [url data] notes-context/db [reduce [url top-url] if all [f: find url top-url 1 = index? f] [append for-removal url]] foreach url for-removal [write url none] ] generator: context [ spec: [] current-body: {} content-width: 600 current-text: none current-image: none vid-block: none space: charset " ^-" chars: complement charset " ^-^/" indented: [some space thru newline] content-rule: [ opt [newline] some layout-rule ] layout-rule: [ empty-line-rule | header-rule | image-rule | vid-rule | code-rule | text-rule ] header-rule: [ "===" copy current-text to newline (append spec reduce ['pad 0x8 'h1 content-width current-text]) | "---" copy current-text to newline (append spec reduce ['pad 0x8 'h2 content-width current-text]) | "+++" copy current-text to newline (append spec reduce ['pad 0x8 'h3 content-width current-text]) | "..." copy current-text to newline (append spec reduce ['pad 0x8 'h4 content-width current-text]) ] image-rule: [ "=image" copy current-text to newline (current-image: load-image load current-text) (append spec reduce ['across 'pad ((content-width - current-image/size/x) / 2)]) (append spec reduce ['image current-image 'below]) ] vid-rule: [ [ "\VID" thru newline copy vid-block to "/VID" thru newline | "=VID" copy vid-block to newline newline ] (append spec load vid-block) (append spec [below]) ] code-rule: [ copy current-text some [indented | some newline indented] (append spec reduce [ 'pad 20x10 'codebox 'bold content-width - 40 'as-is trim/auto trim/tail copy current-text 'pad -20x10 ]) ] text-rule: [ copy current-text some [chars thru newline] (append spec reduce ['hypertext content-width trim/lines copy current-text]) ] empty-line-rule: [ newline ] layout-text: func [ content width ][ clear spec clear current-body content-width: width if not-equal? (back back tail content) "^/^/" [ append content "^/^/" ] parse/all content content-rule insert spec [ styles hypertext-styles styles notebook-styles style codebox tt black 230.230.230 bold as-is para [ origin: margin: 12x8 ] edge [ size: 1x1 color: 180.180.180 effect: none ] backdrop white ] layout/tight spec ] layout-content: func [ content width ][ switch content/type [ text [layout-text content/content width] ] ] ] gui: context [ sz: as-pair 600 round sv/screen-face/size/y * 0.65 szw: 600x0 szh: as-pair 0 sz/y p: vbar: hbar: vbar2: hbar2: vbar3: hbar3: none main-panel: none url-field: none scroll-panel: func [p data /x /y /local f] [ f: either block? p/pane [first p/pane][p/pane] either x [ f/offset/x: negate data * (max 0 f/size/x - p/size/x) ][ f/offset/y: negate data * (max 0 f/size/y - p/size/y) ] show p ] tree-redrag: does [ vbar3/redrag doc-tree/lc / max 1 (length? tree-data) vbar3/step: 1 / max 1 (- doc-tree/lc + length? tree-data) doc-tree/scroll vbar3 show vbar3 ] init-tree: has [p] [ p: doc-tree-panel p/pane/1/offset: 0x0 vbar3/data: hbar3/data: 0 tree-redrag hbar3/redrag p/size/x / max 1 p/pane/1/size/x show [p vbar3 hbar3] ] init-view: does [ p/pane/offset: 0x0 vbar/data: hbar/data: 0 vbar/redrag p/size/y / max 1 p/pane/size/y hbar/redrag p/size/x / max 1 p/pane/size/x show [p vbar hbar] ] init-edit: has [size] [ size: size-text edit-area vbar2/data: negate edit-area/para/scroll/y / (size/y - edit-area/size/y) hbar2/data: negate edit-area/para/scroll/x / (size/x - edit-area/size/x) if all [size/y > 0 size/x > 0] [ vbar2/redrag edit-area/size/y / max 1 size/y hbar2/redrag edit-area/size/x / max 1 size/x show [edit-area vbar2 hbar2] ] ] edit-page: does [ either exists? to-notes-url trim url-field/text [ edit-area/text: select read to-notes-url trim url-field/text 'content ][ edit-area/text: copy "" ] edit-area/line-list: none main-panel/pane: edit-panel wheel-recv: vbar2 init-edit show main-panel ] store-edited-page: does [ use [edited-url new?] [ edited-url: to-notes-url trim url-field/text either edited-url <> notes:// [ new?: not exists? edited-url write edited-url edit-area/text if new? [ refresh-tree-data ] goto edited-url ][ alert "The notes:// page can not be edited." goto notes:// ] ] ] set 'notebook-styles stylize [ field: field middle 255.255.255 255.255.255 edge [ color: 127.157.185 size: 1x1 effect: none ] toolbar: panel effect [ gradient 1x1 243.245.247 239.234.217 ] edge [ color: 255.252.239 size: 1x1 effect: 'bevel ] scrollbar: scroller 254.254.251 215.210.195 black with [ init: append copy init [ effect: either size/x < size/y [ [gradient 1x0 238.237.229 254.254.251] ][ [gradient 0x1 238.237.229 254.254.251] ] pane/1/edge/color: pane/2/edge/color: pane/3/edge/color: 255.252.239 ] ] toolbar-button: box 32x32 [] edge [ color: none size: 1x1 effect: none ] feel [ over: func [face action event /local pos] [ either action [ face/edge/color: 255.252.239 face/edge/size: 1x1 face/edge/effect: 'bevel insert face/effect [gradient 1x1 243.245.247 239.234.217] ][ face/edge/color: none face/edge/size: 1x1 face/edge/effect: none if pos: find face/effect 'gradient [remove/part pos 2] ] show face ] engage: func [face action event /local pos] [ switch action [ time [if not face/state [face/blinker: not face/blinker]] down [face/state: on face/edge/effect: 'ibevel append face/effect [luma -20]] alt-down [face/state: on] up [if face/state [ do-face face face/text] face/state: off face/edge/effect: 'bevel if pos: find face/effect 'luma [remove/part pos 2] ] alt-up [if face/state [do-face-alt face face/text] face/state: off] over [face/state: on] away [face/state: off] ] cue face action show face ] ] with [ init: append copy init [ edge: make edge [] ] ] back-arw: toolbar-button 32x32 effect [ draw [ translate 4x4 pen none fill-pen 0.144.0 polygon 0x8 9x0 13x0 13x5 22x5 22x16 13x16 13x21 9x21 0x13 fill-pen linear 4x4 normal 0 400 44.49 0.04 0.04 255.255.255 158.249.132 110.238.98 polygon 1x9 10x1 12x1 12x6 21x6 21x15 12x15 12x20 10x20 1x12 fill-pen linear 4x4 normal 0 400 44.49 0.04 0.04 158.249.132 110.238.98 72.196.65 polygon 2x10 11x2 11x7 20x7 20x14 11x14 11x19 2x11 ] ] fwd-arw: toolbar-button 32x32 effect [ draw [ translate 4x4 pen none fill-pen 0.144.0 polygon 22x8 13x0 9x0 9x5 0x5 0x16 9x16 9x21 13x21 22x13 fill-pen linear 4x4 normal 0 400 45 0.04 0.04 255.255.255 158.249.132 110.238.98 polygon 21x9 12x1 10x1 10x6 1x6 1x15 10x15 10x20 12x20 21x12 fill-pen linear 4x4 normal 0 400 45 0.04 0.04 158.249.132 110.238.98 72.196.65 polygon 20x10 11x2 11x7 2x7 2x14 11x14 11x19 20x11 ] ] ] picked-url: false pick-url-dlg: layout/tight [ styles tree-styles styles notebook-styles panel effect [ gradient 1x1 243.245.247 239.234.217 ][ origin 10x10 space 4x4 across panel [ origin 0x0 space 0x0 across pick-url-tree: tree 264x360 data tree-data on-select [ face/select-node pick-url-field/text: to-string face/node/url show [pick-url-tree pick-url-field] ] vbar3: scrollbar 16x360 return hbar3: scrollbar 264x16 ] edge [ color: 255.252.239 size: 1x1 effect: 'ibevel ] return pick-url-field: field 282 "notes://" [ pick-url-tree/selected: to-notes-url face/text show pick-url-tree ] return pad 0x2 pick-url-child-checkbox: check-line true "As child:" pad 0x-2 pick-url-child-field: field 80 "New Node" pad 22 btn 50 "Ok" [gui/picked-url: true hide-popup] btn 50 "Cancel" [hide-popup] ] ] rename-url-dlg: layout/tight [ styles tree-styles styles notebook-styles panel effect [ gradient 1x1 243.245.247 239.234.217 ][ origin 10x10 space 4x4 across pick-rename-url-field: field 382 "notes://" [ gui/picked-url: true hide-popup ] return pad 276 btn 50 "Ok" [gui/picked-url: true hide-popup] btn 50 "Cancel" [gui/picked-url: false hide-popup] ] ] edit-panel: layout/tight compose [ styles notebook-styles origin 0x0 space 0x0 backdrop 239.234.217 across toolbar (szw + 16x24) [ origin 2x2 space 4x0 across btn 80x18 "Apply Edit" [edit-tog/state: false show edit-tog store-edited-page] btn 80x18 "Cancel Edit" [cancel-edit/go-back] btn 80x18 "Link Selected" [link-selection] ] return edit-area: area (sz + 0x-24) white white edge none with [alter flags 'tabbed] vbar2: scrollbar (szh + 16x-24) [scroll-para edit-area vbar2] return hbar2: scrollbar (szw + 0x16) [scroll-para edit-area hbar2] ] edit-area/feel: make edit-area/feel [ engage: func [face act event][ switch act [ down [ either equal? face sv/focal-face [ctx-text/unlight-text] [focus/no-show face] sv/caret: offset-to-caret face event/offset show face init-edit ] over [ if not-equal? sv/caret offset-to-caret face event/offset [ if not sv/highlight-start [sv/highlight-start: sv/caret] sv/highlight-end: sv/caret: offset-to-caret face event/offset show face init-edit ] ] key [ ctx-text/edit-text face event get in face 'action init-edit ] ] ] ] not-exist: does [ layout/tight [ backdrop white image hnimg text "Does not exist yet! Click Edit to create page." ] ] view-panel: layout/tight compose [ styles notebook-styles origin 0x0 space 0x0 backdrop 239.234.217 across p: box sz white vbar: scrollbar (szh + 16x0) [scroll-panel/y p vbar/data] return hbar: scrollbar (szw + 0x16) [scroll-panel/x p hbar/data] ] main-window: center-face layout compose/deep [ styles hypertext-styles styles tree-styles styles notebook-styles origin 0x0 space 4x2 bg: backdrop 239.234.217 across toolbar 822x50 [ origin 4x6 across back-btn: back-arw [go-back] fwd-btn: fwd-arw [go-forward] pad 0x4 btn "Home" 50x24 [goto notes://] btn "New" yellow [ if any [not notes-context/dirty? confirm "Create new database? This will discard any unsaved changes."] [ notes-context/create-new refresh-tree-data goto notes:// ] ] btn "Open" cyan [ if any [not notes-context/dirty? confirm "Open new database? This will discard any unsaved changes."] [ if notes-context/load-db [ refresh-tree-data goto notes:// ] ] ] save-btn: btn "Save" red [notes-context/save-db] btn "Go To" 50x24 url-field: field 460 white white [goto to-notes-url copy face/text] ] return outer-panel: panel [ origin 0x0 space 0x0 toolbar 196x24 [ origin 2x2 space 4x0 across btn 44x18 "Delete" red [ if doc-tree/selected [ delete-subtree to-notes-url doc-tree/selected refresh-tree-data goto notes:// ] ] btn 40x18 "Add" [create-new-node] edit-tog: tog 40x18 "Edit" [ either face/state [gui/edit-page][gui/store-edited-page] show main-panel ] btn 50x18 "Rename" [ use [f new-url] [ pick-rename-url-field/text: to-string doc-tree/selected focus pick-rename-url-field if all [ f: find/last pick-rename-url-field/text "/" ][ sv/highlight-start: next f ] picked-url: false inform gui/rename-url-dlg if all [ picked-url not-equal? trim pick-rename-url-field/text to-string doc-tree/selected ][ new-url: to-notes-url trim pick-rename-url-field/text if exists? new-url [ alert rejoin ["The " new-url " already exists."] return ] write new-url select read doc-tree/selected 'content write doc-tree/selected none refresh-tree-data goto new-url ] ] ] ] across doc-tree-panel: panel 180 [ origin 0x0 space 0x0 doc-tree: tree (szh + 500x-24) data tree-data on-select [ face/select-node goto to-notes-url face/node/url show doc-tree ] ] vbar3: scrollbar (szh + 16x-24) [doc-tree/scroll face show doc-tree] return hbar3: scrollbar 180x16 [scroll-panel/x doc-tree-panel hbar3/data] ] edge [ color: 255.252.239 size: 1x1 effect: 'ibevel ] main-panel: box (sz + 20x18) edge [ color: 255.252.239 size: 1x1 effect: 'ibevel ] ] wheel-recv: none ] to-notes-url: func [url [url! string! block!]] [load mold either url? url [url][to-url url]] create-new-node: func [/local url][ gui/picked-url: false pick-url-tree/selected: doc-tree/selected pick-url-field/text: to-string doc-tree/selected pick-url-child-checkbox/data: true pick-url-child-checkbox/show?: true pick-url-child-field/text: copy "New Node" pick-url-child-field/show?: true inform/title gui/pick-url-dlg "Node Creation" either gui/picked-url [ url: to-notes-url either pick-url-child-checkbox/data [ trim rejoin [ trim pick-url-field/text either pick-url-field/text = "notes://" [""]["/"] trim pick-url-child-field/text ] ][trim pick-url-field/text] if any [url = notes://notes:/// = copy/part url length? notes:///][alert "The notes:// page can not be added." return] either all [not exists? url notes:// = copy/part url length? notes://][ write url copy "" refresh-tree-data show doc-tree goto url ][alert "Error: Node already exists."] ][refresh-tree-data show doc-tree] ] link-selection: func [/local url text s e c] [ if any [ all [s: sv/highlight-start e: sv/highlight-end] s: e: sv/caret ][ gui/picked-url: false pick-url-child-checkbox/show?: false pick-url-child-field/show?: false inform/title gui/pick-url-dlg "Node Selection" if gui/picked-url [ url: copy pick-url-field/text text: copy/part s e sv/highlight-end: change/part s rejoin ["<" url "|" text ">"] e sv/highlight-start: either lesser? index? s index? e [s][e] edit-area/line-list: none show edit-area ] ] ] cancel-edit: func [/go-back] [ edit-tog/state: false show edit-tog if go-back [ gui/main-panel/pane: gui/view-panel gui/init-view gui/wheel-recv: gui/vbar show gui/main-panel ] ] history: [] hist-mark: history add-to-history: func [url [url!]] [if not-equal? history/1 url [insert history url hist-mark: head history]] go-back: does [if not tail? next hist-mark [hist-mark: next hist-mark goto/no-history hist-mark/1]] go-forward: does [hist-mark: back hist-mark if not tail? hist-mark [goto/no-history hist-mark/1]] clear-forward: does [if more-forward? [remove/part history hist-mark hist-mark: head history]] more-back?: does [not tail? next hist-mark] more-forward?: does [not head? hist-mark] goto: func [url [url! none!] /no-show /no-history /local pos][ if none? url [return] cancel-edit gui/url-field/text: to-string url either exists? url [ if none? attempt [gui/p/pane: generator/layout-content read url 600][alert "Parse error!" return] ][gui/p/pane: gui/not-exist] if not no-history [clear-forward add-to-history url] either not more-back? [ if none? pos: find back-btn/effect 'grayscale [append back-btn/effect 'grayscale] ][ if pos: find back-btn/effect 'grayscale [remove pos] ] either not more-forward? [ if none? pos: find fwd-btn/effect 'grayscale [append fwd-btn/effect 'grayscale] ][ if pos: find fwd-btn/effect 'grayscale [remove pos] ] gui/main-panel/pane: gui/view-panel gui/init-view gui/wheel-recv: gui/vbar doc-tree/selected: url doc-tree/expand-to url gui/vbar/step: 40 / max 1 gui/p/pane/size/y if not no-show [ show fwd-btn show back-btn show gui/main-panel show gui/url-field show doc-tree ] ] refresh-tree-data goto/no-show notes:// gui/init-view gui/init-edit gui/init-tree code-size: get in info? system/options/script 'size byte-count: rejoin ["HyperNotes (" code-size " bytes of code, " (- code-size + (32 * 1024)) " bytes short of 32K)"] view/new/title/options gui/main-window byte-count [resize] gui/main-window/feel/detect: func [face event][ switch event/type [ key [if face: find-key-face face event/key [if get in face 'action [do-face face event/key] return none]] scroll-line [either event/3/y < 0 [scroll-drag/back gui/wheel-recv][scroll-drag gui/wheel-recv]] ] event ] wx: gui/main-window/size/x wy: gui/main-window/size/y dy+: func [a b][a/size/y: b + a/size/y] sbdy+: func [a b][a/resize (a/size + as-pair 0 b)] ody+: func [a b][a/offset/y: b + a/offset/y] resize-hnd: func [f e][ if e/type = 'resize [ e/face/size/x: wx dy: gui/main-window/size/y - wy dy+ edit-area dy sbdy+ gui/vbar2 dy ody+ gui/hbar2 dy dy+ gui/p dy sbdy+ gui/vbar dy ody+ gui/hbar dy dy+ doc-tree-panel dy dy+ doc-tree dy sbdy+ gui/vbar3 dy ody+ gui/hbar3 dy dy+ gui/main-panel dy dy+ outer-panel dy dy+ gui/view-panel dy dy+ gui/edit-panel dy dy+ bg dy gui/init-view gui/init-edit wy: gui/main-window/size/y show gui/main-window ] e ] insert-event-func :resize-hnd do-events