[ALLY] closing popups

-- do http://www.2b1.de/ _ . _ ingo@)|_ /| _| _ <We ARE all ONE www._|_o _ _ ._ _ www./_|_) |o(_|(/_ We ARE all FREE> ingo@| |(_|o(_)| (_| ._| ._| -- Attached file included as plaintext by Listar -- #!/bin/rv -s REBOL [ Title: "Addressbook" author: "Ingo Hohmann" email: [ingo--2b1--de] date: 31-Oct-2000 file: %addressbook.r history: [ 0.0.8 [ 3-Nov-2000 "some clean-ups, search" "iho" ] 0.0.7 [ 31-Oct-2000 "changed 'update to 'updated in data-file" "iho" ] 0.0.6 [ 31-Oct-2000 "added note display" "iho" ] 0.0.5 [ 31-Oct-2000 "added help" "iho" ] 0.0.4 [ 31-Oct-2000 "added add / delete" "iho" ] 0.0.3 [ 30-Oct-2000 "except for persons add works" "iho" ] 0.0.2 [ 29-Oct-2000 "cleaned up" "iho" ] 0.0.1 [ 28-Oct-2000 "first preview" "iho" ] ] version: first history addy: "experimental" comments: { This is a little address database system, with an NQA Interface (No Questions Asked) what you type in, will immediately be part of the database (once save is called on exit, BTW how can I catch the close event?). } known-bugs: [ {no testing if changed file-as already exists} {no testing if " is present in fields} ; " {in Communication, when there is not yet any data, you first have to click the list} ] todo: [ {a lot of cleanups} {update 'update} {sorting} ] ] ;yamm/import %xml-helper.r do %xml-helper.r addressbook: make object! [ doc: {This object encapsulates the address database} xml-data-block: block! ; parse-xml created block of blocks addressdb-block: block! ; addressdb block in xml-data-block current-data-block: block! ; is set to the block containing the current data current-data-pos: 0 ; position of current-data in addressdb-block current-address-pos: 1 ; position in addressdb-block list current-comm-pos: 1 ; position in communication list current-sub-pos: 1 ; set to either current-comm-pos or current-address-pos current-view-name: string! ; the tag name of the currently shown data ["person" "address" "comm"] add-new-data?: false ; true, if a lists last position is shown (don't change data) current-view: none ; function to show current view current-fields: ; fields shown in current view names: copy [] ; list of names for main list last-search: "" ; string that has last been searched for xml-data-file: %address.xml current-view: function! ; function to show the current view ; helper intercept: func ["intercept a block with values" blk [block!] val /local i][ blk: copy blk for i ((length? blk) + 1) 2 -1 [insert at blk i copy ""] blk ] ; todo: error handling ; xml-data-block: copy [document none [["addressdb" none [["data" ["file-as" "new-data"] [["person" ["name" none] none]]]]]]] ; copy an empty database load-xml: func [ "load xml data file and parse it" ] [ if error? try [xml-data-block: trim-xml parse-xml read xml-data-file] [ xml-data-block: trim-xml parse-xml { <addressdb comm-attr="voice;fax;cell;home;work;pref" address-attr="home;work;parents;pref"> <data file-as="Joe Joey User" updated="28-Oct-2000/18:42:55+2:00"> <person birthday="1970-01-01" name-suffix="md" name-prefix="dr. h.c." middle-name="X." first-name="Joe" last-name="User" nick-name="Joey" /> <comm type="url" attr="personal" value="http://www.web-page.de" /> <comm type="email" attr="Internet" value="[joe--user--com]" /> <comm type="tel" attr="PREF;WORK;HOME;VOICE;FAX;MSG;CELL;PAGER;BBS;MODEM;CAR;ISDN;VIDEO" value="0700/JOE-USER" /> <address country="User Land" postal-code="4711" region="All around here" city="Compcity" street="Pentium-Street" extended="at the seven dwarfs" post-office="just hand it to any passenger" /> <note> Here comes a note </note> </data> </addressdb> } ] addressdb-block: xml-data-block/3/1/3 ] save-xml: func ["save xml data"] [ write xml-data-file xdump xml-data-block ] ;layouts person-layout: [ backdrop blue effect [gradient -1x-1 0.100.0 border 2] across text bold "Personal" text "Address" #"^A" [leave show-address] text "Communication" #"^O" [leave show-comm] text "Notes" #"^N" [leave show-note] return tabs 110 text "Filed as" [create-names] tab file-as: field updated: text 200x20 return text "Name" tab first-name: field return text "Last" tab last-name: field return text "Nickname" tab nick-name: field return text "Middle" tab middle-name: field return text "Prefix" tab name-prefix: field return text "Suffix" tab name-suffix: field return text "Birthday" tab birthday: field return tab tab tab button "Delete" [delete-data] ] address-layout: [ across text "Personal" #"^P" [leave address-fields show-person] text bold "Address" text "Communication" #"^O" [leave address-fields show-comm] text "Notes" #"^N" [leave show-note] return tabs 110 text "extended" tab extended: field here: at return text "street" tab street: field return text "postal-code" tab postal-code: field return text "city" tab city: field return text "region" tab region: field return text "post-office" tab post-office: field return text "Country" tab country: field return text "Type" tab attr: field return at here address-list: text-list [ leave current-address-pos: index? find address-list/data value add-new-data?: either current-address-pos = length? address-list/data [true][false] show-address ] return tab tab tab button "Delete" [delete-data] ] comm-layout: [ across text "Personal" #"^P" [leave comm-fields show-person] text "Address" #"^A" [leave comm-fields show-address] text bold "Communication" text "Notes" #"^N" [leave show-note] return tabs 110 text "Value" tab value: field here: at return text "" return text "Type" tab type: field return text "Attributes" tab attr: field return at here comms-list: text-list [ leave current-comm-pos: index? find comms-list/data value add-new-data?: either current-comm-pos = length? comms-list/data [true][false] show-comm ] return tab tab tab button "Delete" [delete-data] ] note-layout: [ across text "Personal" #"^P" [leave comm-fields show-person] text "Address" #"^A" [leave show-address] text "Communication" #"^O" [leave show-comm] text bold "Notes" #"^N" return note: area 450x300 return tab tab tab button "Delete" [delete-data] ] note-fields: copy [ note ] help-layout: [ help-text: area 450x350 across button "View" [show-help/topic 'howto-view] button "Update" [show-help/topic 'howto-update] button "misc" [show-help/topic 'howto-misc] tab button "Close help" [current-view] ] ; lists of fields, to set/get them easily person-fields: copy [] forall person-layout [ if all [ set-word? person-layout/1 'field = person-layout/2 ] [ append person-fields to-word person-layout/1 ] ] person-layout: head person-layout person-fields: next person-fields ; assuming 'file-as is first field address-fields: copy [] forall address-layout [ if all [ set-word? address-layout/1 'field = address-layout/2 ] [ append address-fields to-word address-layout/1 ] ] address-layout: head address-layout comm-fields: copy [] forall comm-layout [ if all [ set-word? comm-layout/1 'field = comm-layout/2 ] [ append comm-fields to-word comm-layout/1 ] ] comm-layout: head comm-layout ; ; display functions ; show-person: func ["displays the name data"][ disp/pane: layout/offset person-layout 0x0 current-view: :show-person current-view-name: "person" current-fields: :person-fields foreach pos current-data-block/3 [ if pos/1 = "person" [ foreach [attr val] pos/2 [ set in get to-word attr 'text val ] break ] ] file-as/text: second find current-data-block/2 "file-as" updated/text: second find current-data-block/2 "updated" show disp ] current-view: :show-person current-fields: person-fields show-address: func [ "displays address data" /local addr-pos ][ current-view: :show-address current-view-name: "address" current-fields: :address-fields disp/pane: layout/offset address-layout 0x0 addr-pos: 0 clear address-list/data foreach pos current-data-block/3 [ if all [pos/1 = "address" block? pos/2] [ addr-pos: addr-pos + 1 append address-list/data rejoin [ select pos/2 "postal-code" "," select pos/2 "city" "," select pos/2 "street" ] if addr-pos = current-address-pos [ foreach [attr val] pos/2 [ set in get to-word attr 'text val ] ] ] ] append address-list/data "" append address-list/picked pick address-list/data current-address-pos show disp ] show-comm: func [ "displays communication data" /local comm-pos ][ current-view: :show-comm current-view-name: "comm" current-fields: :comm-fields disp/pane: layout/offset comm-layout 0x0 comm-pos: 0 clear comms-list/data foreach pos current-data-block/3 [ if all [pos/1 = "comm" block? pos/2] [ comm-pos: comm-pos + 1 append comms-list/data rejoin [ select pos/2 "value" either not none? select pos/2 "attr" [rejoin [", " select pos/2 "attr"]][""] ] if comm-pos = current-comm-pos [ foreach [attr val] pos/2 [ set in get to-word attr 'text val ] ] ] ] append comms-list/data "" append comms-list/picked pick comms-list/data current-comm-pos show disp ] show-note: func [ "displays the note" /local found? ][ disp/pane: layout/offset note-layout 0x0 current-view: :show-note current-view-name: "note" current-fields: :note-fields found?: false foreach pos current-data-block/3 [ if pos/1 = "note" [ if none? pos/3 [ change at pos 3 [""] ] note/text: pos/3/1 found?: true break ] ] if not found? [ append/only current-data-block/3 copy/deep compose [(current-view-name) none [""]] pos: back tail current-data-block/3 note/text: pos/1/3/1 ] file-as/text: second find current-data-block/2 "file-as" updated/text: second find current-data-block/2 "updated" show disp ] show-help: func [ "displays the help screen" /topic "show specific help-text" show-this [word!] "the topic string" ][ disp/pane: layout/offset help-layout 0x0 help-text/text: trim/auto any [ if 'howto-view = show-this [ { HOWTO -- View Data: - Change between views Click on Person / Address / Communication, respectively - Show different Persons data: Use up / down cursor keys, or click with the mouse - Show different Address / Communication: Click in the list } ] if 'howto-update = show-this [ { HOWTO -- Update data: - Update data: just change data in the fields as you like - Delete data: hit the delete key, if you are on the "Person" screen, the complete person will be deleted, in other screens, the data shown at the moment. - Add new data: click the last (empty) position in any list, a new data-set will be added - Update data on disk: Currently data on disk will only be updated once you click the "Save & Exit" Button } ] if 'howto-misc = show-this [ { HOWTO -- Miscallenous: - Send feedback: Click on my email address KNOWN-BUGS - can't handle " input ; " - search doesn't scroll correctly - can't handle if "file-as" is changed to a value already present - You have to click lists, when they are empty } ] { Addressbook help ---------------- This addressbook has an NQA/WYSIWYG User Interface, NQA: No Questions Asked -> You'll never get asked if you _really_ want to do that WYSIWYG: Data you see on the screen is in the database (except for an update timelag) Now click on a button to get specific help } ] show disp ] h: 0 set-current-data: func [ "sets position in data block, etc" pos /local new-name ][ current-data-pos: pos: max 1 min length? names pos append clear name-l/picked pick names pos show name-l if current-data-pos = length? names [ new-name: copy "Unnamed" either not find names new-name [ append/only addressdb-block compose/deep ; ["data" ["file-as" (new-name) "updated" (to-string now)] [["person" [] none]]] ["data" ["file-as" (new-name) "updated" (to-string now)] [["person" [(intercept person-fields "")] none]]] create-names show name-l focus file-as ][ request/ok {Please rename previously added data first} current-data-pos: current-data-pos - 1 ] ] current-data-block: pick addressdb-block (current-data-pos) current-address-pos: 1 current-comm-pos: 1 ] ; ; check changes ; leave: func [ { tests all fields and if one is dirty updates the database (iho) globals used: current-fields, current-view-name } /local dirty count-pos txt-path txt ] [ foreach fld current-fields [ dirty: to-path compose [(:fld) dirty?] if dirty [break] ] if dirty [ ; one of the fields is changed ... current-sub-pos: any [ all [current-view-name = "address" current-address-pos] all [current-view-name = "comm" current-comm-pos] 1 ] if add-new-data? [ append/only current-data-block/3 copy/deep compose [(current-view-name) [] none] ] count-pos: 0 foreach tag-block current-data-block/3 [ if all [tag-block/1 = current-view-name block? tag-block/2] [ count-pos: count-pos + 1 if count-pos = curr