'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 9 January 2000 at 7:13:19 pm'!
"Change Set:		FsBrowser
Date:			9 January 2000
Author:			Stefan Matthias Aust (sma@3plus4.de)

FsDigest can parse and view Fading Suns mailing list digests as found on the their web page.  However, it's also a simple outline editor which might be useful for other uses.

FsDigest methods
	open - opens the browser window
	addArticle: - appends a FsArticle object to the brower's root object

FsDigest class methods
	parseDigest: - reads in an HTML file and creates a FsArticle object
"!

ListItemWrapper subclass: #FsArticle
	instanceVariableNames: 'subject author text children '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sma-FSML'!
AbstractHierarchicalList subclass: #FsDigest
	instanceVariableNames: 'root '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sma-FSML'!

!FsArticle reorganize!
('accessing' author author: children subject subject: text text:)
('adding-removing' addArticle: addArticle:named: deleteIn:)
('morphic' asString contents hasContents hasEquivalentIn:)
('printing' printOn:)
!


!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 11:03'!
author
	^ author! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 11:03'!
author: aString
	author _ aString! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 17:48'!
children
	^ children! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 11:03'!
subject
	^ subject! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 15:33'!
subject: aString
	subject _ aString! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 11:03'!
text
	^ text! !

!FsArticle methodsFor: 'accessing' stamp: 'sma 1/9/2000 11:03'!
text: aString
	text _ aString! !

!FsArticle methodsFor: 'adding-removing' stamp: 'sma 1/9/2000 18:38'!
addArticle: a
	children 
		ifNil: [children _ OrderedCollection with: a]
		ifNotNil: [children addLast: a]! !

!FsArticle methodsFor: 'adding-removing' stamp: 'sma 1/9/2000 17:05'!
addArticle: a named: s
	"Private. Add another article to either directly the receiver
	or to one of the receiver's children, depending on the subject
	to reconstruct threading."

	| prefix child subj |
	subj _ s.
	prefix _ (subj copyFrom: 1 to: (3 min: subj size)) asLowercase.
	(prefix = 're:' or: [prefix = 'aw:'])
		ifTrue: [subj _ (subj copyFrom: 4 to: subj size) withBlanksTrimmed]
		ifFalse: [prefix _ ''].
	children ifNil: [children _ OrderedCollection new].
	child _ children
		detect: [:each | each subject sameAs: subj]
		ifNone:
			[prefix isEmpty ifFalse: [children addLast: (FsArticle new
				author: ''; subject: subj; text: '(ongoing discussion)')]].
	child ifNil: [^ children addLast: a].
	child addArticle: a named: subj! !

!FsArticle methodsFor: 'adding-removing' stamp: 'sma 1/9/2000 18:29'!
deleteIn: parent
	parent children ifNil: [^ false].
	parent children 
		remove: self
		ifAbsent:
			[parent children ifNil: [^ false].
			parent children copy do:
				[:each | (self deleteIn: each) ifTrue: [^ true]].
			^ false].
	^ true! !

!FsArticle methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:01'!
asString
	"Display string in hierarchical list."

	^ subject! !

!FsArticle methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:02'!
contents
	"Answer the receiver's children."

	^ children! !

!FsArticle methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:02'!
hasContents
	"Answer true, if the receiver has children."

	^ children notNil! !

!FsArticle methodsFor: 'morphic' stamp: 'sma 1/9/2000 18:27'!
hasEquivalentIn: aCollection
	"I'm my own wrapper, so this method must be overwritten"

	^ aCollection includes: self! !

!FsArticle methodsFor: 'printing' stamp: 'sma 1/9/2000 11:05'!
printOn: aStream
	aStream
	 nextPutAll: 'From: ';
	 nextPutAll: self author;
	 cr;
	 nextPutAll: 'Subject: ';
	 nextPutAll: self subject;
	 cr;
	 cr;
	 nextPutAll: self text! !


!FsDigest reorganize!
('initialization' initialize open)
('adding' addArticle: addThreadedArticle:)
('menu' deleteMail loadMails newMail renameMail saveMails)
('morphic' arrowKey:from: genericMenu: getList getText newText: noteNewSelection:)
('private' colorized:)
!


!FsDigest methodsFor: 'initialization' stamp: 'sma 1/9/2000 18:59'!
initialize
	root _ FsArticle new
	 author: '';
	 subject: '[Articles]';
	 text: ''
! !

!FsDigest methodsFor: 'initialization' stamp: 'sma 1/9/2000 18:37'!
open
	myBrowser _ (SystemWindow labelled: 'Fading Suns Mail Archive Browser')
		model: self;
		color: Color blue.
	myBrowser 
		addMorph: ((SimpleHierarchicalListMorph 
			on: self
			list: #getList
			selected: #getCurrentSelection
			changeSelected: #noteNewSelection:
			menu: #genericMenu:)
				autoDeselect: false)
		frame: (0 @ 0 corner: 0.3 @ 1);
		addMorph: (PluggableTextMorph
			on: self
			text: #getText
			accept: #newText:)
		frame: (0.3 @ 0 corner: 1 @ 1).
	self noteNewSelection: root.
	myBrowser openInWorld! !

!FsDigest methodsFor: 'adding' stamp: 'sma 1/9/2000 18:40'!
addArticle: a
	root addArticle: a! !

!FsDigest methodsFor: 'adding' stamp: 'sma 1/9/2000 18:40'!
addThreadedArticle: a
	root addArticle: a named: a subject! !

!FsDigest methodsFor: 'menu' stamp: 'sma 1/9/2000 18:28'!
deleteMail
	(self getCurrentSelection deleteIn: root)
		ifTrue: [self update: #hierarchicalList]! !

!FsDigest methodsFor: 'menu' stamp: 'sma 1/9/2000 19:06'!
loadMails
	| stream |
	(SelectionMenu confirm: 'Do you really want to
replace the current archive?') ifTrue:
		[stream _ ReferenceStream fileNamed: 'archives'.
		[root _ stream next]
			ensure: [stream close].
		self update: #hierarchicalList]! !

!FsDigest methodsFor: 'menu' stamp: 'sma 1/9/2000 18:59'!
newMail
	| s a |
	s _ FillInTheBlank 
		request: 'Please enter the subject'
		initialAnswer: ''.
	s isEmpty ifFalse:
		[a _ FsArticle new
			author: Utilities authorInitials;
			subject: s;
			text: ''.
		self getCurrentSelection addArticle: a.
		self update: #hierarchicalList]! !

!FsDigest methodsFor: 'menu' stamp: 'sma 1/9/2000 18:44'!
renameMail
	| s |
	s _ FillInTheBlank
		request: 'Please enter the new subject'
		initialAnswer: self getCurrentSelection subject.
	s isEmpty ifFalse:
		[self getCurrentSelection subject: s.
		self update: #hierarchicalList]! !

!FsDigest methodsFor: 'menu' stamp: 'sma 1/9/2000 19:06'!
saveMails
	| stream |
	stream _ ReferenceStream fileNamed: 'archives'.
	[stream nextPut: root]
		ensure: [stream close]
! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:23'!
arrowKey: aChar from: view
	"Keyboard support for hierarchical list morph."

	| keyEvent oldSelection nextSelection max min howMany m |

     (keyEvent := aChar asciiValue) > 31 ifTrue: [^ self].	"Quick return, out of range"
     oldSelection := view getCurrentSelectionIndex.
     nextSelection := oldSelection.
     max := view maximumSelection.
     min := view minimumSelection.
     howMany := view numSelectionsInView.	"get this exactly??"

     keyEvent == 31 ifTrue:
		["down-arrow; move down one, wrapping to top if needed"
		nextSelection := oldSelection + 1.
		nextSelection > max ifTrue: [nextSelection _ 1]].

     keyEvent == 30 ifTrue:
		["up arrow; move up one, wrapping to bottom if needed"
		nextSelection := oldSelection - 1.
		nextSelection < 1 ifTrue: [nextSelection _ max]].

	keyEvent == 29 ifTrue:
		["right arrow; expand item if needed"
		m _ view scroller submorphs at: oldSelection.
		m isExpanded ifFalse:
			[m toggleExpandedState.
			^ view adjustSubmorphPositions]].

	keyEvent == 28 ifTrue:
		["left arrow; colapse item if needed"
		m _ view scroller submorphs at: oldSelection.
		m isExpanded ifTrue:
			[m toggleExpandedState.
			^ view adjustSubmorphPositions]].

     keyEvent == 1  ifTrue: [nextSelection := 1].  "home"
     keyEvent == 4  ifTrue: [nextSelection := max].   "end"
     keyEvent == 11 ifTrue: [nextSelection := min max: (oldSelection - howMany)].  "page up"
     keyEvent == 12  ifTrue: [nextSelection := (oldSelection + howMany) min: max].  "page down"
     nextSelection = oldSelection  ifFalse:
		[self okToChange
			ifTrue:
				[view changeModelSelection: nextSelection.
				"view controller moveMarker"]]! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 18:44'!
genericMenu: menu
	menu add: 'save messages' target: self selector: #saveMails.
	menu add: 'load messages' target: self selector: #loadMails.
	currentSelection ifNotNil:
		[menu addLine.
		menu add: 'new...' target: self selector: #newMail.
		menu add: 'rename' target: self selector: #renameMail.
		menu add: 'delete' target: self selector: #deleteMail].
	^ menu! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:23'!
getList
	"Called by the hierarchical list morph to get its root object."

	^ Array with: root! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 18:36'!
getText
	"Called by the text morph to get its text."

	^ self getCurrentSelection
		ifNil: ['no selection']
		ifNotNil: [self colorized: self getCurrentSelection text]! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 18:36'!
newText: aText
	"Called by the text morph on accept."

	self getCurrentSelection ifNil: [^ false].
	self getCurrentSelection text: aText asString.
	^ true! !

!FsDigest methodsFor: 'morphic' stamp: 'sma 1/9/2000 17:28'!
noteNewSelection: aMorph
	"Called by the hierarchical list morph if the selection has been changed."

	myBrowser submorphs first setText: (self colorized: aMorph text).
	super noteNewSelection: aMorph! !

!FsDigest methodsFor: 'private' stamp: 'sma 1/9/2000 17:36'!
colorized: aString
	"Private - colorize quotes."

	| text i j quote |
	text _ aString asText.
	i _ 1.
	[j _ i. j <= text size] whileTrue:
		[quote _ '>|:}^' includes: (text at: j).
		[j <= text size and: [(text at: j) ~= Character cr]] whileTrue:
			[j := j + 1].
		quote ifTrue: [text addAttribute: TextColor blue from: i to: j].
		i _ j + 1].
	^ text	! !


!FsDigest class reorganize!
('instance creation' new)
('utility' nextLine: parseDigest: parseSubject: parseText:)
!


!FsDigest class methodsFor: 'instance creation' stamp: 'sma 1/9/2000 12:03'!
new
	^ super new initialize! !

!FsDigest class methodsFor: 'utility' stamp: 'sma 1/9/2000 18:50'!
nextLine: aStream
	"Private. It seems, that the digests are in unix format."

	^ aStream upTo: Character lf! !

!FsDigest class methodsFor: 'utility' stamp: 'sma 1/9/2000 19:09'!
parseDigest: aString
	"Read in a Fading Suns mailing list digest (in HTML format)
	and break it into single articles.  Answer root article."

	| f as s a text |
	f _ ReadStream on: (FileStream oldFileNamed: aString) contentsOfEntireFile.
	f ifNil: [self error: 'unknown file ' , aString].
	as _ FsArticle new
		author: 'sma';
		subject: 'Digest ' , aString;
		text: ''.
	[[s _ self nextLine: f.
	f atEnd ifTrue: [^ as].
	s beginsWith: '<H4>'] whileFalse.
	a _ FsArticle new.
	a subject: (self parseSubject: s).
	text _ ''.
	[s _ self nextLine: f.
	s beginsWith: 'You are currently subscribed to fsuns-l']
		whileFalse: [text _ text , s , (String with: Character cr)].
	a text: (self parseText: text).
	a author: (s copyFrom: 45 to: s size).
	as addArticle: a named: a subject.
	true] whileTrue! !

!FsDigest class methodsFor: 'utility' stamp: 'sma 1/9/2000 18:52'!
parseSubject: subject
	"Private. Remove superfluous Subject: and mailing list tag."

	| s |
	s _ subject asUnHtml.
	[s beginsWith: 'Subject:'] whileTrue: [s _ s copyFrom: 10 to: s size].
	[s beginsWith: '[fsuns-l]'] whileTrue: [s _ s copyFrom: 11 to: s size].
	^ s withBlanksTrimmed
! !

!FsDigest class methodsFor: 'utility' stamp: 'sma 1/9/2000 18:50'!
parseText: text
	"Private. Remove leading <PRE> and trailing dashes and CRs.
	Also remove that annoying quoted-printable line continuation."

	| start stop |
	start _ 1.
	stop _ text size.
	(text beginsWith: '<PRE>') ifTrue: [start _ 6].
	[stop > start and: [' -
' includes: (text at: stop)]] whileTrue: [stop _ stop - 1].
	^ (text copyFrom: start to: stop + 1) 
		copyReplaceAll: '=
' with: ''! !


!IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'sma 1/9/2000 19:00'!
firstChild
	"See FsDigest>>arrowKey:from:"

	^ firstChild! !


!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'sma 1/9/2000 19:00'!
changeModelSelection: index
	"See FsDigest>>arrowKey:from:"

	self setSelectedMorph: (index = 0 ifFalse: [self scroller submorphs at: index])! !

!SimpleHierarchicalListMorph methodsFor: 'selection' stamp: 'sma 1/9/2000 19:00'!
getCurrentSelectionIndex
	"See FsDigest>>arrowKey:from:"

	^ scroller submorphs indexOf: selectedMorph! !


!String methodsFor: 'converting' stamp: 'sma 1/9/2000 11:36'!
asUnHtml
	"Strip out all Html stuff (commands in angle brackets <>) and convert
the characters &<> back to their real value.  Leave actual cr and tab as
they were in text."
	| in out char rest did |
	in _ ReadStream on: self.
	out _ WriteStream on: (String new: self size).
	[in atEnd] whileFalse:
		[in peek = $<
			ifTrue: [in unCommand] 	"Absorb <...><...>"
			ifFalse: [(char _ in next) = $&
						ifTrue: [rest _ in upTo: $;.
								did _ out position.
								rest = 'lt' ifTrue: [out nextPut: $<].
								rest = 'gt' ifTrue: [out nextPut: $>].
								rest = 'amp' ifTrue: [out nextPut: $&].
								did = out position ifTrue: [
									in skip: rest size negated.
									out nextPut: $&
									"self error: 'new HTML char encoding'."
									"Please add it to this code"]]
						ifFalse: [out nextPut: char]].
		].
	^ out contents! !