Help update red scripts collection list

add-script.red

Red [
	title: "Update red scripts collection list"
	file: %add-script.red
	author: "Marco Antoniazzi"
	license: "Do with this code whatever you want, giving credit to me is NOT required"
	email: [luce80 AT alice DOT it]
	date: 01-07-2018
	version: 1.0.1
	Purpose: "Help update red scripts collection list"
	Needs: 'View
]

requesters: context [
	; ======
	; Author: Gregg Irwin. Taken from https://gist.github.com/greggirwin/9cd640ca42bdfd56c5ff4432c4765d2c
	; ======
	; Window flags: modal resize no-title no-border no-min no-max no-buttons popup
	
	; Native OS:   Dir, File, Font
	; In this lib: Notify, Alert, Confirm, Prompt, Color, Date(TBD)
	
	;---------------------------------------------------------------------------

	; General warning:  Yellow in black triangle with exclamation	239.202.64
	; Information: i												
	; Prohibition: Red stop/slash-circle (ul to lr)					177.34.54
	; Mandatory Action: Exclamation in blue circle					30.81.133

	iso-yellow: 239.202.64
	iso-red: 	177.34.54
	iso-blue: 	30.81.133

	;iso-font-40: make font! [style: 'bold size: 40 name: "Times New Roman"]
	iso-font-40: make font! [style: 'bold size: 40 name: "Symbol"]
	iso-font-40i: make font! [style: [bold italic] size: 40 name: "Times New Roman"]
	;iso-font-32: make font! [style: 'bold size: 32 name: "Symbol"]
	iso-font-26: make font! [style: 'bold size: 26 name: "Symbol"]

	svvs: system/view/vid/styles
	svvs/iso-info: [
		template: [
			type: 'base size: 48x48 color: none
			draw: [font iso-font-40i pen iso-blue fill-pen iso-blue circle 24x24 23 pen white text 7x-7 "i"]
		]
	]
	svvs/iso-question: [
		template: [
			type: 'base size: 48x48 color: none
			draw: [font iso-font-40 pen iso-blue fill-pen iso-blue circle 24x24 23 pen white text 3x-11 "?"]
		]
	]
	svvs/iso-warning: [
		template: [
			type: 'base size: 48x48 color: none
			draw: [font iso-font-26 pen black fill-pen iso-yellow line-width 4 line-join round polygon 24x4 46x44 2x44 text 13x5 "!"]
		]
	]
	svvs/iso-action-required: [
		template: [
			type: 'base size: 48x48 color: none
			draw: [font iso-font-40 pen iso-blue fill-pen iso-blue circle 24x24 23 pen white text 7x-12 "!"]
		]
	]
	svvs/iso-prohibit: [
		template: [
			type: 'base size: 48x48 color: none
			draw: [pen iso-red fill-pen white line-width 5 circle 24x24 21 line-width 4 line 8x8 40x40]
		]
	]
	;view [iso-info iso-warning iso-action-required iso-prohibit]
	
	;---------------------------------------------------------------------------

	svvs/timer: [
		default-actor: on-time
		template: [
			type: 'base size: 0x0 color: none
		]
	]
	
	std-dialog-actors: object [
		res: none
		on-key: func [face event] [
			;print [mold event/key mold event/flags]
			;!! If control is down, keys are always uppercase chars, including
			;	the caret, so we don't really need to check for 'control in
			;	event/flags if that is by design. Nice for char-key mapping.
			switch event/key [
				#"^M" [res: true  unview]	; enter
				#"^[" [res: none  unview]	; escape
				#"^O" #"^Y"  [if find event/flags 'control [res: true  unview]]
				#"^C" [if find event/flags 'control [res: none  unview]]
				#"^N" [if find event/flags 'control [res: false unview]]
			]
		]
	]
	std-dialog-opts: compose [
		flags: [modal no-min no-max]
		actors: (std-dialog-actors)
	]

	;---------------------------------------------------------------------------
	; To set the title for a dialog, use [title "xxx"] in the layout, or options/text.
	; To set the offset for a dialog, use options/offset.
	show-dialog: function [
		spec [block! object!]
		/options opts [block!] "[offset: flags: actors: menu: parent: text:]"
		/timeout time [time!]  "Hide after timeout; only block specs supported"
		/with    init [block! none!] "Code to run after layout, before showing; e.g., to center face"
		][
		;if time [spec: add-dialog-timeout spec time]
		if block? spec [
			if time [spec: append copy spec reduce ['timer 'rate time [unview]]]
			spec: layout spec
		]
		face: :spec												; let them use 'face in init block
		if init [do bind/copy init 'face]
		view/options spec make std-dialog-opts any [opts []]
		spec
	]
	
	; alert [ok] confirm [ok cancel] prompt [text box]
	set 'alert function [
		"Display a dialog with a short message, until the user closes it"
		msg
		;/options opts [block!]  "[offset: flags: actors: menu: parent: text:]"
		/style   sty  [word!]   "Include standard image and title: [info warn stop action]"
		/over    ctr  [object!] "Center over this face"
		/offset  pos  [pair!]   "Top-left offset of window"
		/local img txt
		][
		set [img txt] switch/default sty [
			info	[[iso-info "Information"]]
			warn    [[iso-warning "Warning"]]
			stop    [[iso-prohibit "Stop!"]]
			action  [[iso-action-required "Action required"]]
		][[iso-warning "Warning"]]							; paren == unset, for no image

		spec: compose [
			title (txt)
			across (get/any 'img) pad 10x0 text font-size 12 350x70 (form msg) return
			pad 300x0 button "OK" [res: true unview]
		]

		;opts: append copy std-dialog-opts opts ;any [opts [flags: [modal no-min no-max]]]
		opts: copy/deep std-dialog-opts
		if pair? pos [append opts compose [offset: (pos)]]
		
		if ctr [init: [center-face/with face ctr]]				; 'face refers to the dialog
		show-dialog/options/with spec opts init
		res
	]
	; added function by luce80
	set 'flash function [
		"Flashes a message to the user and continues."
		msg
		/with    ctr  [object!] "Center over this face"
		/offset  pos  [pair!]   "Top-left offset of window"
		/timeout time [time!]  "Hide after timeout; only block specs supported"
		/local spec opts
		][
		spec: compose [
			title "Information"
			across iso-info pad 10x0 text font-size 12 350x70 (form msg) return
		]
		opts: compose [
			flags: [no-min no-max]
			actors: (std-dialog-actors)
		]
		if pair? pos [append opts compose [offset: (pos)]]
		if time [spec: append spec reduce ['timer 'rate time [unview]]]

		spec: layout spec

		; FIXME: if time [append spec/pane make face [...]]

		if ctr [center-face/with spec ctr]
		face: :spec												; let them use 'face in init block
		view/no-wait/options spec make std-dialog-opts any [opts []]
		spec
	]

]



get-details: function [
	link
	][
	curl: 
	field-curl/text
	if any [none? curl not exists? to-red-file form curl] [alert "cURL is required to fetch informations from internet"]
	;"E:\Programmi\Prog\Git\mingw64\bin\curl.exe"

	if not url? link [alert "Please provide a URL first" exit]

	out: ""
	author: ""
	script: ""
	descr: ""
	id: ""

	url: form link
	f1: flash/timeout "Fetching informations..." 00:00:02
	call/wait/output rejoin [curl " " url] out: copy ""
	unview/only f1
	space: charset " ^-^/"
	case [
		find url "https://gist.github" [
			parse url [thru {https://gist.github.com/} copy author to {/} {/} copy id to end]
			gist: probe rejoin [{<a href="/} author {/} id {">}]
			parse out [thru gist copy script to {</a>}]
			parse out [thru {itemprop="about">} copy descr to {<}]
		]
		find url "https://github.com" [
			parse url [thru {https://github.com/} copy author to {/} {/} copy script to end]
			parse out [thru {itemprop="about">} copy descr to {<}]
		]
		find url "https://gitlab.com" [
			parse url [thru {https://gitlab.com/} copy author to {/} {/} copy script to end]
			parse out [thru {<div class="project-home-desc">} any space opt {<p dir="auto">} copy descr to {<}]
		]
	]

	field-auth/data: author 
	field-script/data: script
	field-link/data: link
	field-descr/text: trim/lines descr 
	;field-tags: 
]

update_wiki: function [] [
	if error? try [
		if any [
			equal? trim field-auth/text ""
			equal? trim field-script/text ""
			equal? trim field-link/text ""
			] 
			[
			field-auth/color: red + 150
			field-script/color: red + 150
			field-link/color: red + 150
			alert "Please fill at least ALL highlighted fields"
			field-auth/color: white ; FIXME: assuming background of fields is white
			field-script/color: white
			field-link/color: white
			set-focus field-auth
			exit
		]
		page: head area-source/text
		if "" = page [alert "Please paste wiki page source markdown text in the text area"]
		author: trim field-auth/text
		script: trim field-script/text
		data: rejoin ["^-* [" script "](" field-link/text ") - " field-descr/text "^/^/^-^-tags: " field-tags/text "^/"]
		letter: uppercase first author
		if letter > #"Z" [cause-error "Problem with author first letter"]
		start: none
		new-start: none
		parse page [thru ["* " author " "] thru "^/" start:]
		if none? start [
			; insert new author and data sorted
			parse page [thru ["## " letter] "^/" start:]
			authors-rule: [ new-start: "* " copy curr-author to " " [[to ["^/* " | "^/## "] "^/"] | [to "^/^/^/[0](#0)"]](
				if author < curr-author [
					insert new-start rejoin ["* " author " - ^/" data]
					exit
				]
			)]
			parse start [some authors-rule new-start: (insert new-start rejoin ["* " author " - ^/" data] exit)]
		]
		; insert new data sorted
		space: charset " ^-^/"
		data-rule: [new-start: some space "* [" copy curr-script to "]" thru "tags:" thru "^/" (
			if script < curr-script [
				insert new-start data
				exit
			]
		)]
		parse start [some data-rule (insert new-start data exit)]
	][alert "Unable to update wiki page, please do it manually."]
]

view layout [
	title "Help update red scripts collection"
	do [sp: 4x4] origin sp space sp 
	style label: text 100 ; FIXME: para [origin: 0x3] use this when para/origin will be implemented
	style field: field 600 ""

	label "cURL.exe" field-curl: field 534 button "..." [field-curl/text: to-local-file request-file/title "Select cURL exe"] return
	below
	text bold {1) Paste wiki page source markdown text in the text area below} 
	area-source: area 800x250 
	text bold {2) Paste script's link (currently: gist, github and gitlab) in the field below and press "Fill fields" button or ...} 
	Across 
	label "URL" field-url: field 534
	button "Fill fields" [get-details field-url/data] return 

	text bold "3) ...Fill the fields and ..." 200 return 

	label "Author" field-auth: field return 
	label "File name" field-script: field return 
	label "Link" field-link: field return 
	label "Description" field-descr: field return 
	label "Tags" field-tags: field 	return 

	label bold "4)" 
	button "...update wiki source" [update_wiki] text bold " and check that it's all ok"
	return 
	label bold {5) Finally} button "copy area text to clipboard" [write-clipboard area-source/text] text bold 30 " and "
	button {browse to https://github.com/red/red/wiki/Scripts-collection/_edit} [browse https://github.com/red/red/wiki/Scripts-collection/_edit]
	return
]