'From Squeak2.8 of 13 June 2000 [latest update: #2359] on 4 September 2000 at 10:17:26 pm'! "Change Set: Network-InfoAgent-0101 Date: 04 September 2000 Author: Thomas Mahler email: mailto:thomas.mahler@home.ins.de 0101: - Squeak 2.8 compatibility - renamed Package to Network-InfoAgent 0100: InfoAgent enhances Scamper with - bookmarks (incl. sharing bookmark-file with Netscape Navigator) - convenient ui for using web-based search engines - tracking changes in web-pages See InfoAgent comment for documentation I had to make minor changes to system classes Scamper, FileUrl and HtmlDefinitionList InfoAgent needs Squeak 2.8 "! OrderedCollection subclass: #BookmarkCategory instanceVariableNames: 'name document ' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! BookmarkCategory class instanceVariableNames: ''! ObjectExplorer subclass: #BookmarkExplorer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! ObjectExplorerWrapper subclass: #BookmarkExplorerWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! BookmarkExplorerWrapper class instanceVariableNames: ''! HtmlFormatter subclass: #BookmarkExtractor instanceVariableNames: 'hrefs actCategory actHref actText catStack flat ' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! !BookmarkExtractor commentStamp: '' prior: 0! BookmarkExtractor is a modified Hmtl-Formatter. It is used to extract all bookmarks from HTML pages or Netscape bookmark file. It can be used in two modes: flat: true produces a flat list of bookmarks flat: false (default) produces a tree structure see examples in InfoAgent importBookmarks and SearchEngine searchAsBookmarkCategory! IndentingListItemMorph subclass: #BookmarkListItemMorph instanceVariableNames: 'highlightedForDrop isBeingDragged ' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! SimpleHierarchicalListMorph subclass: #BookmarkListMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! Object subclass: #BookmarkManager instanceVariableNames: '' classVariableNames: 'AllBookmarks ' poolDictionaries: '' category: 'Network-InfoAgent'! BookmarkManager class instanceVariableNames: ''! Object subclass: #InfoAgent instanceVariableNames: '' classVariableNames: 'Configuration ' poolDictionaries: '' category: 'Network-InfoAgent'! !InfoAgent commentStamp: '' prior: 0!

InfoAgent -- automating information retrieval

The InfoAgent Suite contains three major components: 
- WebWatcher
- SearchEngine UI
- BookmarkManager
Start it by InfoAgent go !!

WebWatcher

The WebWatcher tracks changes in WWW pages. It maintains a list of WebDocument objects which are checked periodically for changes. If the WebWatcher detects any changes, it will perform certain methods on the respective WebDocument (e.g. mark it as changed, display it in a Scamper window, or play a signal sound...) The actual Methods can be freely configured, see entry for #changeActions under InfoAgent configuration edit. Most of WebWatchers actions can be logged to the Transcript, by setting #doLogging to true in the configuration. In the BookmarkManager the WebWatcher actions can be reached from the yellow button menu of the entry "Tracked Documents". You can start tracking WebPages from Scamper with the menu action "add to bookmarks" and placing the entry into the category "Tracked Documents"

SearchEngine UI

The SearchEngine maintains a list of Internet searchengines. You can use any of these for your internet recherche. Try something like: SearchEngine Dmoz searchAndBrowse: 'Squeak'. SearchEngine Dmoz searchAndManage: 'Squeak' will result in a more sophisticated representation of the search results: The resulting page is scanned for urls and the found urls are placed in a special category 'Search Results' into the BookmarkManager (BM). Finally the BM is openened and you can start do work with your freshly generated bookmarks. The SearchEngine can be reached from Scamper ("search the web") and from the BookmarkManager (yellow button menu on category "Web Search")

BookmarkManager

The BookmarkManager maintains all Bookmarks used throughout the InfoAgent suite: - Documents tracked by WebWatcher are kept in the BookmarkCategory 'WebWatched Documents'. (you can mark WebSites as "webwatched" by dragging them into this category.)
- Search results from web searches are kept in the category 'Search Results'.
- There is a 'Trash' folder where you place stuff you don't need any longer.
- You can add any links from the WebBrowser to any Category. You can create new Categories and manage everything by drag-and-drop.
- BM marks entries are displayed in three different colours according to their status: New entries are marked orange, if Webwatcher detects a change it will mark the entry red. After visiting the entry via "open in web browser" it is marked green.
- BM can export its Bookmarks as a standard Netscape Navigator Bookmark file. Netscape Navigator bookmark files can be imported. When file in/out bookmarks for the first time, you are asked to point to a file. BM will use this file for reading and writing its bookmarks. To prevent unintended data loss a backup of the original file is saved initially. If you point to your Netscape bookmarkfile, you share the bookmarks file between Netscape and squeak. Has been tested with Netscape 4.7 under Linux and WinNT.
- The context menu of the BookmarkManager provides all kind of useful actions according to the selected item. Open BM by BookmarkManager explore. or from Scamper by "edit bookmarks"

Known bugs and shortcomings:

- Tested only under Linux and WinNT. - WebWatcher detects ALL changes in HTML documents. Sometimes WebServers send hidden tags to the clients which don«t alter the page content proper. But WebWatcher will detect these "invisible" changes too and thus "fail".
- Netscape seems to read its bookmark file only on startup and to write to it only on termination. Thus there is no proper synchronization between Netscape and InfoAgent if you let them share a bookmark-file :-( You have therefor to be a bit careful to avoid loss of newly added bookmarks. If you have any ideas how to let Netscape read and write its bookmark-file programmatically please let me know!!

Disclaimer:

This software is provided as is. No warranty of any kind. Published under the GPL. Copyright by Thomas Mahler, 1999,2000

Contact

Contact me if you have any comments or wishes regarding InfoAgent: mailto:thomas.mahler@home.ins.de

Homepage

http://minnow.cc.gatech.edu/squeak/InfoAgent

Download:

Version 1.01 (Squeak 2.8 compatibility)
http://www.techno.net/pcl/tm/squeak/Interface-InfoAgent-0101.cs

Version 1.00 (initial release, needs Squeak 2.7)
http://www.techno.net/pcl/tm/squeak/Interface-InfoAgent-0100.cs

Squeak now !!


Add your comments and suggestions here: + ! ]style[(14 3 38 67 11 7 15 5 1 1 16 18 12 10 19 5 10 53 11 196 7 1 115 28 390 24 5 12 119 43 2 43 452 24 5 15 112 16 1345 23 47 40 686 20 128 16 77 32 45 18 10 44 52 18 491)cblack;f1b,f1cblack;b,f1b,f1,f1b,f1,f1b,f1,f1b,f1,f1b,f1,f1dInfoAgent go;;,f1,f1b,f1,f1LWebWatcher Comment;,f1,f1LWebDocument Comment;,f1,f1LScamper Comment;,f1LWebBrowser Comment;,f1,f1dInfoAgent configuration edit;;,f1,f1b,f1,f1LSearchEngine Comment;,f1,f1dSearchEngine Dmoz searchAndBrowse: 'Squeak';;,f1,f1dSearchEngine Dmoz searchAndManage: 'Squeak';;,f1,f1b,f1,f1LBookmarkManager Comment;,f1,f1LBookmarkCategory Comment;,f1,f1dBookmarkManager explore;;,f1,f1b,f1,f1b,f1,f1b,f1,f1Rmailto:thomas.mahler@home.ins.de;,f1,f1b,f1,f1Rhttp://minnow.cc.gatech.edu/squeak/InfoAgent;,f1,f1b,f1! InfoAgent class instanceVariableNames: ''! Dictionary subclass: #InfoAgentConfiguration instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! !InfoAgentConfiguration commentStamp: '' prior: 0! This class reprents the configuration of the InfoAgent System. It is mainly a Dictionary of config parameters. Each parameter has its own documentation entry. See InfoAgent configuration edit.! ]style[(165 28 1)f1,f1dInfoAgent configuration edit;;,f1! InfoAgentConfiguration class instanceVariableNames: ''! Dictionary subclass: #SearchEngine instanceVariableNames: '' classVariableNames: 'UsedEngines ' poolDictionaries: '' category: 'Network-InfoAgent'! !SearchEngine commentStamp: '' prior: 0! SearchEngine encapsulates the process of retrieving information from web-based search-engines like altavista or a Swiki fulltext search. I have included configurations for 17 important search-engines. (see class method category PopularEngines). If you want to add a definition of a new search-engine place it in the class-method category UsedEngines!! All engines defined there will be used by InfoAgent invokeSearchEngineSelection.! ]style[(396 37 1)f1,f1dInfoAgent invokeSearchEngineSelection;;,f1! SearchEngine class instanceVariableNames: ''! Object subclass: #TranscriptLogger instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! !TranscriptLogger commentStamp: '' prior: 0! This class handles logging to the transcript. ! Object subclass: #WebDocument instanceVariableNames: 'info ActContent CachedContent CachedTimestamp VersionHistory ' classVariableNames: 'CacheDir ' poolDictionaries: '' category: 'Network-InfoAgent'! !WebDocument commentStamp: '' prior: 0! The WebWatcher manages a pool of WebDocuments. A WebDocument may be any file identified by a valid Url. In Addition to the bare Url a WebDocument contains additional information for classifying the document. The last version of the doc is cached for further analysis and keeping track of changes of the document! ]style[(4 10 298)f1,f1LWebWatcher Comment;,f1! WebDocument class instanceVariableNames: ''! Dictionary subclass: #WebDocumentInfo instanceVariableNames: 'theDoc ' classVariableNames: '' poolDictionaries: '' category: 'Network-InfoAgent'! !WebDocumentInfo commentStamp: '' prior: 0! A WebDocumentInfo contains the metainformation of a WebDocument. It is also used as an "intelligent" Bookmark! WebDocumentInfo class instanceVariableNames: ''! Object subclass: #WebWatcher instanceVariableNames: 'WatchingProcess Configuration ' classVariableNames: 'Instance ' poolDictionaries: '' category: 'Network-InfoAgent'! !WebWatcher commentStamp: '' prior: 0! The WebWatcher(TM) is a tool for tracking changes in WWW pages. It maintains a list of WebDocument objects which are checked periodically for changes. ! ]style[(18 1 68 11 53)bf3cblack;,f1cblack;,f1,f1LWebDocument Comment;,f1! WebWatcher class instanceVariableNames: ''! !BookmarkCategory methodsFor: 'subsetting' stamp: 'ThMa 11/11/1999 17:31'! includesRecursive: anObject | val | (self includes: anObject) ifTrue: [^ true] ifFalse: [ val _ self subCategories collect: [:s |s includesRecursive: anObject.] . ^ (val occurrencesOf: true) > 0. ].! ! !BookmarkCategory methodsFor: 'subsetting' stamp: 'ThMa 11/11/1999 17:21'! isChildOf: anObject (anObject isMemberOf: BookmarkCategory) ifFalse: [ ^ false ] ifTrue: [ ^ anObject includesRecursive: self. ] ! ! !BookmarkCategory methodsFor: 'subsetting' stamp: 'ThMa 11/5/1999 19:37'! plainBookmarks ^ self select: [:x | x isMemberOf: WebDocumentInfo].! ! !BookmarkCategory methodsFor: 'subsetting' stamp: 'ThMa 12/27/1999 12:28'! select: aBlock "" | newCollection | newCollection _ OrderedCollection new. self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]]. ^ newCollection! ! !BookmarkCategory methodsFor: 'subsetting' stamp: 'ThMa 11/3/1999 20:40'! subCategories ^ self select: [:x | x isMemberOf: BookmarkCategory].! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 1/15/2000 21:57'! add: item super add: item. "build a dependency chain so that events triggered by item are sent back to the BM-Explorer" item addDependent: self. "send a change event upwards the chain to BM-Explorer:" self changed: #getList. ! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 1/7/2000 22:53'! doc "Return a document that represents this category (see WebDocument asBookmarkCategory) It is sometimes useful to have a category of bookmarks represented by a special page. E.g. for displaying search results as a bookmark list and as web page" ^ document.! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 12/24/1999 20:40'! doc: aWebDocument document _ aWebDocument.! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 1/1/2000 23:16'! name ^ name isNil ifTrue: [''] ifFalse: [name].! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 10/27/1999 22:13'! name: aString name _ aString.! ! !BookmarkCategory methodsFor: 'accessing' stamp: 'ThMa 1/15/2000 21:45'! update: aSymbol self changed: aSymbol.! ! !BookmarkCategory methodsFor: 'user interface' stamp: 'thma 9/4/2000 21:09'! acceptDroppingObject: anotherItem "drop item on me if allowed" ((anotherItem withoutListWrapper ~= self) & "disallow selfrefentiality and circularities..." (self isChildOf: anotherItem withoutListWrapper) not) "parents can't be their children's childs" ifTrue: [ "first we have to delete the old entry" BookmarkManager allBookmarks remove: (anotherItem withoutListWrapper). "then add to new category.." self add: (anotherItem withoutListWrapper). ] ifFalse: [TranscriptLogger log: 'not allowed ...'].! ! !BookmarkCategory methodsFor: 'user interface' stamp: 'ThMa 1/15/2000 21:58'! addNewSubCategory "create new subcategory as child of self" self add: BookmarkCategory fromUser. ! ! !BookmarkCategory methodsFor: 'user interface' stamp: 'thma 9/3/2000 19:21'! addToNewSubCategory: aBookmark "add bookmark to new subcategory under self" | cat | cat _ BookmarkCategory fromUserWithInitialAnswer: (aBookmark title). cat add: aBookmark. self add: cat. ! ! !BookmarkCategory methodsFor: 'user interface' stamp: 'ThMa 1/15/2000 21:58'! addWithMenu: aBookmark "add a bookmark ro self, its subcategories or to a new subcategory using a menu presentation" | subs menu | subs _ self subCategories. menu _ MenuMorph new. menu add: (self name) target: self selector: #add: argument: aBookmark. menu addLine. subs do: [:cat | menu add: (cat name) subMenu: (cat addWithMenu: aBookmark ) ]. menu addLine. menu add: 'into new category...' target: self selector: #addToNewSubCategory: argument: aBookmark. ^ menu. ! ! !BookmarkCategory methodsFor: 'user interface' stamp: 'ThMa 1/1/2000 22:39'! jumpFromMenu: aScamper "show menu representing all urls and subcategories in self and open selected url in aScamper" | subs menu bookmarks | bookmarks _ self plainBookmarks. subs _ self subCategories. menu _ MenuMorph new. "menu addTitle: (self name)." menu add: (self name) target: nil selector: #isNil. menu addLine. subs do: [:cat | menu add: (cat name) subMenu: (cat jumpFromMenu: aScamper ) ]. menu addLine. bookmarks do: [:x | menu add: (x short) target: aScamper selector: #jumpToUrl: argument: (x url) ]. ^ menu. ! ! !BookmarkCategory methodsFor: 'removing' stamp: 'ThMa 1/15/2000 22:02'! remove: oldObject Cursor wait showWhile: [ self remove: oldObject ifAbsent: [ self subCategories do: [:c | c remove: oldObject] ]. self changed: #getList. ].! ! !BookmarkCategory methodsFor: 'converting' stamp: 'ThMa 1/8/2000 17:45'! asHtml "comment stating purpose of message" | header subcategories leaves footer | header _ '

', self name , '

', String crlf, '

', String crlf. subcategories _ (self subCategories inject: '' into: [:str :el | str , el asHtml]) asString. leaves _ (self plainBookmarks inject: '' into: [:str :el | str , el asHtml]) asString. footer _ '

', String crlf. ^ header, subcategories, leaves, footer. ! ! !BookmarkCategory class methodsFor: 'as yet unclassified' stamp: 'thma 9/3/2000 20:45'! fromUser "Create a new, user named Category" self fromUserWithInitialAnswer: ''. ! ! !BookmarkCategory class methodsFor: 'as yet unclassified' stamp: 'thma 9/3/2000 19:18'! fromUserWithInitialAnswer: aString "Create a new, user named Category with default suggestion" | title | title _ FillInTheBlank request: 'give name for new category' initialAnswer: aString. ^ BookmarkCategory named: title. ! ! !BookmarkCategory class methodsFor: 'as yet unclassified' stamp: 'ThMa 10/27/1999 22:22'! named: aString | it | it _ BookmarkCategory new. it name: aString. ^ it.! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 11/13/1999 00:13'! currentSelection ^ currentSelection.! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'thma 9/4/2000 21:10'! explorerFor: anObject caption: title | window listMorph | rootObject _ anObject. (window _ SystemWindow labelled: title) model: self; color: Color red. window addMorph: (listMorph _ BookmarkListMorph on: self list: #getList selected: #getCurrentSelection changeSelected: #noteNewSelection: menu: #genericMenu: keystroke: nil) frame: (0@0 corner: 1@1). listMorph autoDeselect: false. listMorph scroller submorphs copy do: [ :each | (each canExpand and: [each isExpanded = false]) ifTrue: [ each toggleExpandedState ]]. listMorph adjustSubmorphPositions. rootObject addDependent: listMorph. ^ window! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 12/27/1999 11:32'! getList ^Array with: (BookmarkExplorerWrapper with: rootObject name: '' model: self)! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 1/7/2000 22:55'! openExplorerFor: anObject caption: aString (self explorerFor: anObject caption: aString) openInWorldExtent: 400@300. ^ self! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 1/9/2000 17:25'! refresh Cursor wait showWhile: [ self changed: #getList. ]. ! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 11/8/1999 21:01'! selectedBookmark "check if item is a Category " ^ currentSelection withoutListWrapper isMemberOf: WebDocumentInfo. ! ! !BookmarkExplorer methodsFor: 'as yet unclassified' stamp: 'ThMa 11/8/1999 21:04'! selectedCategory "check if item is a Category " ^ currentSelection withoutListWrapper isMemberOf: BookmarkCategory ! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 1/9/2000 12:18'! collectLinksFromPage "collect all links from a page as a new bookmark-category" | doc | doc _ currentSelection withoutListWrapper document. BookmarkManager addFromDocument: doc. self refresh. ! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/10/1999 20:23'! edit: aKey | answer set| answer _ FillInTheBlank request: 'Edit the ' , (aKey asString) , ' field:' initialAnswer: (currentSelection withoutListWrapper perform: aKey). "for setting we need a : behind the key" set _ (aKey asString , ':') asSymbol. answer = '' ifFalse: [ currentSelection withoutListWrapper perform: set with: answer. self refresh. ]. ! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/7/1999 22:52'! editCaption (self selectedBookmark ) ifTrue: [self edit: #short.]. (self selectedCategory) ifTrue: [self edit: #name].! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 1/29/2000 17:54'! genericMenu: aMenu "dispatcher for menu generation. Sorry for this spaghetti code..." | menu | Cursor normal show. "just in case..." currentSelection ifNil: [ menu _ aMenu. menu add: '*nothing selected*' target: self selector: #yourself. ] ifNotNil: [ menu _ DumberMenuMorph new defaultTarget: self. "menu add: 'inspect' target: currentSelection selector: #inspect." "for debugging only" "menu entries for bookmarks." self selectedBookmark ifTrue: [ menu add: 'open in Scamper' target: self selector: #openInScamper; addLine; add: 'get more infos' target: currentSelection withoutListWrapper selector: #retrieveAll; add: 'edit entry' target: currentSelection withoutListWrapper selector: #inspect; add: 'collect Urls' target: self selector: #collectLinksFromPage; add: 'mark as read' target: self selector: #markDocumentAsRead. ((BookmarkManager watchedBookmarks) includesRecursive: (currentSelection withoutListWrapper) ) ifTrue: [ menu add: 'show changes...' target: currentSelection withoutListWrapper document selector: #showDiffs. ]. menu add: 'move to trash' target: self selector: #moveToTrash. ^ menu. ]. "menu entries for Trash folder" (currentSelection withoutListWrapper == BookmarkManager trashCan) ifTrue: [ menu add: 'empty trash' target: BookmarkManager selector: #emptyTrash. ^ menu. ]. "menu entries for WebWatched Documents category" (currentSelection withoutListWrapper == BookmarkManager watchedBookmarks) ifTrue: [ menu add: 'Restart Tracking' target: (WebWatcher instance) selector: #startWatching. menu add: 'Stop Tracking' target: (WebWatcher instance) selector: #stopWatching. menu add: 'Mark all as read' target: self selector: #markAllAsRead. ^ menu. ]. "menu entries Search results category" (currentSelection withoutListWrapper == BookmarkManager searchResults) ifTrue: [ menu add: 'search the web...' target: self selector: #invokeWebSearch. "menu add: 'move to trash' target: self selector: #moveToTrash." ^ menu. ]. "menu entries for InfoAgent Bookmarks category" (currentSelection withoutListWrapper == BookmarkManager allBookmarks) ifTrue: [ menu add: 'Open Scamper' target: InfoAgent selector: #invokeWebBrowser. menu add: 'add new category' target: BookmarkManager allBookmarks selector: #addNewSubCategory. menu addLine. menu add: 'fileOut' target: BookmarkManager selector: #exportBookmarks. menu add: 'fileIn' target: BookmarkManager selector: #importBookmarks. menu addLine. menu add: 'Configure...' target: InfoAgent configuration selector: #edit. menu add: 'Help...' target: InfoAgent selector: #invokeHelp. ^ menu. ]. "menu entries for user defined Categories" self selectedCategory ifTrue: [ menu add: 'edit caption' target: self selector: #editCaption. menu add: 'add new sub-category' target: currentSelection withoutListWrapper selector: #addNewSubCategory. menu add: 'move to trash' target: self selector: #moveToTrash. "if categories have a page entry, this page may be opened:" currentSelection withoutListWrapper doc ifNotNil: [ menu addLine. menu add: 'display as web-page' target: (currentSelection withoutListWrapper doc) selector: #show. ]. ^menu. ]. ]. ^menu.! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/10/1999 20:36'! invokeWebSearch InfoAgent invokeSearchEngineSelection: #searchAndUpdateBookmarks:. self refresh.! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 1/3/2000 18:57'! markAllAsRead self markCategoryAsRead: ( BookmarkManager watchedBookmarks ). self refresh.! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 1/3/2000 18:56'! markCategoryAsRead: aBookmarkCategory "mark all Bookmark of aBookmarkCategory and of all its subcategories as read" aBookmarkCategory plainBookmarks do: [:i | i status: 'read'. i document cache.]. aBookmarkCategory subCategories do: [:cat | self markCategoryAsRead: cat]. ! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 12/25/1999 00:48'! markDocumentAsRead (self selectedBookmark ) ifTrue: [ currentSelection withoutListWrapper status: 'read'. currentSelection withoutListWrapper document cache. self refresh. ] ifFalse: [self pleaseSelectCaptionsOnly].! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/10/1999 20:20'! moveToTrash (self selectedBookmark ) | (self selectedCategory) ifTrue: [self remove. BookmarkManager trashCan add: (currentSelection withoutListWrapper ). self refresh ] ifFalse: [self pleaseSelectCaptionsOnly].! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/8/1999 21:03'! openInScamper (self selectedBookmark ) ifTrue: [currentSelection withoutListWrapper document show. ] ifFalse: [self pleaseSelectCaptionsOnly].! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/2/1999 00:08'! pleaseSelectCaptionsOnly |menu | menu _ CustomMenu new. menu initialize. menu add: 'oops...' action: nil. menu startUpWithCaption: 'Invalid selection'. ! ! !BookmarkExplorer methodsFor: 'menus' stamp: 'ThMa 11/8/1999 21:06'! remove (self selectedBookmark ) | (self selectedCategory) ifTrue: [BookmarkManager allBookmarks remove: (currentSelection withoutListWrapper) ] ifFalse: [self pleaseSelectCaptionsOnly].! ! !BookmarkExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'ThMa 12/19/1999 15:56'! asString | s | "this is for url and title entries etc." s _ itemName , ': ' , item asExplorerString. (s includes: Character cr) ifTrue: [ s _ s withSeparatorsCompacted]. "this is for Categories and Bookmark Captions" (item isKindOf: BookmarkCategory) | (item isKindOf: WebDocumentInfo) ifTrue: [s _ itemName]. ^s ! ! !BookmarkExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'thma 9/4/2000 21:10'! canBeDragged "only Categories and Bookmarks can be dragged." ^(item isMemberOf: WebDocumentInfo) | (item isMemberOf: BookmarkCategory) ! ! !BookmarkExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'ThMa 1/6/2000 22:13'! contents | answer | answer _ OrderedCollection new. "replace anySatisfy: by contains: in versions older than 2.7" ({OrderedCollection. FloatArray. Dictionary} anySatisfy: [:class | item isKindOf: class]) ifTrue: [ item keysAndValuesDo: [:key :value | answer add: (BookmarkExplorerWrapper with: value name: (key printString contractTo: 64) model: item)]] ifFalse: [ item class allInstVarNames asArray doWithIndex: [:each :index | answer add: (BookmarkExplorerWrapper with: (item instVarAt: index) name: each model: item)]. 1 to: item basicSize do: [:index | answer add: (BookmarkExplorerWrapper with: (item basicAt: index) name: index printString model: item)]]. ^ answer! ! !BookmarkExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'ThMa 11/17/1999 22:12'! model ^ model. ! ! !BookmarkExplorerWrapper methodsFor: 'as yet unclassified' stamp: 'thma 9/4/2000 21:11'! wantsDroppedObject: anotherItem "objects can only be dropped onto categories, not onto bookmarks or their sub-entries" ^ item isMemberOf: BookmarkCategory. ! ! !BookmarkExplorerWrapper class methodsFor: 'as yet unclassified' stamp: 'thma 9/3/2000 20:58'! with: anObject name: aString model: aModel | n | n _ aString. (anObject isKindOf: BookmarkCategory) ifTrue: [ n _ anObject name]. (anObject isKindOf: WebDocumentInfo) ifTrue: [ n _ (anObject short) asString]. ^self new setItem: anObject name: n model: aModel! ! !BookmarkExtractor methodsFor: 'access' stamp: 'ThMa 10/17/1999 22:06'! hrefs ^ hrefs.! ! !BookmarkExtractor methodsFor: 'formatting commands' stamp: 'ThMa 1/4/2000 21:43'! addString: aString "adds the text in the given string. It collapses spaces unless we are in a preformatted region" | space compacted lastC i | "collect strings during formating of hrefs:" actText ifNil: [actText _ '']. actText _ actText, aString. aString isEmpty ifTrue: [ ^self ]. space _ Character space. preformattedLevel > 0 ifTrue: [ "add all the characters as literals" outputStream nextPutAll: aString. "update the counters" lastC _ aString last. (lastC = space or: [ lastC = Character cr ]) ifTrue: [ "how many of these are there?" i _ aString size - 1. [ i >= 1 and: [ (aString at: i) = lastC ] ] whileTrue: [ i _ i - 1 ]. i = 0 ifTrue: [ "the whole string is the same character!!" lastC = space ifTrue: [ precedingSpaces _ precedingSpaces + aString size. precedingNewlines _ 0. ^self ] ifFalse: [ precedingSpaces _ 0. precedingNewlines _ precedingNewlines + aString size. ^self ]. ]. lastC = space ifTrue: [ precedingSpaces _ aString size - i. precedingNewlines _ 0 ] ifFalse: [ precedingSpaces _ 0. precedingNewlines _ aString size - i ] ] ] ifFalse: [ compacted _ aString withSeparatorsCompacted. compacted = ' ' ifTrue: [ "no letters in the string--just white space!!" (precedingNewlines = 0 and: [precedingSpaces = 0]) ifTrue: [ precedingSpaces _ 1. outputStream nextPut: space. ]. ^self ]. (compacted first = Character space and: [ (precedingSpaces > 0) or: [ precedingNewlines > 0] ]) ifTrue: [ compacted _ compacted copyFrom: 2 to: compacted size ]. outputStream nextPutAll: compacted. "update counters" precedingNewlines _ 0. compacted last = space ifTrue: [ precedingSpaces _ 1 ] ifFalse: [ precedingSpaces _ 0 ]. ]! ! !BookmarkExtractor methodsFor: 'formatting commands' stamp: 'ThMa 1/4/2000 22:03'! endLink: url | absUrl i| "in order to keep later reuse of urls simple, all relative links are converted to absolute urls" absUrl _ (self baseUrl newFromRelativeText: actHref) asString. i _ WebDocumentInfo new. i url: absUrl. i short: actText. i document: (WebDocument onInfo: i). "create properly linked document" actCategory ifNil: [actCategory _ hrefs]. actCategory add: i. actText _ ''. actHref _ nil. super endLink: url.! ! !BookmarkExtractor methodsFor: 'formatting commands' stamp: 'ThMa 1/6/2000 23:16'! endUnorderedList "end an unordered list" super endUnorderedList. self flat ifFalse: [ "don't maintain stack in flat mode" actCategory _ catStack removeFirst. ]. ! ! !BookmarkExtractor methodsFor: 'formatting commands' stamp: 'ThMa 1/4/2000 22:00'! startLink: url hrefs ifNil: [hrefs _ BookmarkCategory new.]. actHref _ url. actText _ ''. ^ super startLink: url.! ! !BookmarkExtractor methodsFor: 'formatting commands' stamp: 'ThMa 1/8/2000 17:52'! startUnorderedList "begin an unordered list, misused to extract categories from Netscape bookmarkfile" | oldcat | super startUnorderedList. self flat ifFalse: [ "if flat is true produce a flat list. If false produce a tree structure" hrefs ifNil: [hrefs _ BookmarkCategory new.]. catStack ifNil: [catStack _ OrderedCollection new]. (actCategory isNil) ifTrue: [ "first time call" actCategory _ hrefs. catStack addFirst: hrefs. "push main category on stack" actText _ ''. ] ifFalse: [ oldcat _ actCategory. catStack addFirst: oldcat. "push" actCategory _ BookmarkCategory new. (actCategory name = '') ifTrue: [actCategory name: actText withBlanksTrimmed]. oldcat add: actCategory. actText _ ''. ]. ].! ! !BookmarkExtractor methodsFor: 'settings' stamp: 'ThMa 1/6/2000 23:05'! flat "return the value of the flat flag. determines whether extracting of Urls results in a flat or in a structured list" flat ifNil: [flat _ false]. ^ flat.! ! !BookmarkExtractor methodsFor: 'settings' stamp: 'ThMa 1/6/2000 23:05'! flat: aBoolean flat _ aBoolean. ! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'thma 9/4/2000 19:31'! clearDropHighlighting highlightedForDrop ifNil: [^self]. highlightedForDrop _ nil. self changed! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 12/19/1999 19:09'! colorFromStatus | stat | stat _ complexContents withoutListWrapper status. (stat = 'new') ifTrue: [^ Color orange]. (stat = 'read') ifTrue: [^ Color green]. ^ Color red. ! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 11/17/1999 22:27'! drawToggleOn: aCanvas in: aRectangle | aForm | aCanvas fillRectangle: (bounds withRight: aRectangle right) color: container color. complexContents hasContents ifFalse: [^self]. "For Categories we use the default Icons" aForm _ isExpanded ifTrue: [container expandedForm] ifFalse: [container notExpandedForm]. "For WebDocInfos we use special Icons" (complexContents withoutListWrapper isMemberOf: WebDocumentInfo) ifTrue: [aForm _ isExpanded ifTrue: [self expandedBookmarkForm] ifFalse: [self notExpandedBookmarkForm] ]. ^ aCanvas image: aForm at: aRectangle topLeft sourceRect: aForm boundingBox rule: Form paint ! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 12/19/1999 19:07'! expandedBookmarkForm | f f1 col tx| col _ self colorFromStatus. tx _ (DisplayText text: '-' ). tx foregroundColor: col backgroundColor: Color transparent. f _ tx form. f1 _ f copy: (Rectangle origin: (-3 @ 4) extent: (10 @ 9)). f1 borderWidth: 1. ^ f1. ! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'thma 9/4/2000 19:32'! noLongerBeingDragged isBeingDragged _ nil.! ! !BookmarkListItemMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 12/19/1999 19:07'! notExpandedBookmarkForm | f f1 tx col | col _ self colorFromStatus. tx _ (DisplayText text: '+' ). tx foregroundColor: col backgroundColor: Color transparent. f _ tx form. f1 _ f copy: (Rectangle origin: (-3 @ 4) extent: (10 @ 9)). f1 borderWidth: 1. ^ f1. ! ! !BookmarkListItemMorph methodsFor: 'drawing' stamp: 'thma 9/4/2000 19:36'! drawOn: aCanvas | tRect sRect columnRect columnScanner columnData columnLeft colorToUse | tRect := self toggleRectangle. sRect := bounds withLeft: tRect right + 3. self drawToggleOn: aCanvas in: tRect. colorToUse _ complexContents preferredColor ifNil: [color]. (container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [ aCanvas text: contents asString bounds: sRect font: font color: colorToUse. ] ifFalse: [ columnLeft _ sRect left. columnScanner _ ReadStream on: contents asString. container columns do: [ :width | columnRect _ columnLeft @ sRect top extent: width @ sRect height. columnData _ columnScanner upTo: Character tab. columnData isEmpty ifFalse: [ aCanvas text: columnData bounds: columnRect font: font color: colorToUse. ]. columnLeft _ columnRect right + 5. ]. ]. highlightedForDrop ifNotNil: [aCanvas frameRectangle: bounds color: Color blue].! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:26'! acceptDroppingMorph: toDrop event: evt. complexContents acceptDroppingObject: toDrop complexContents. toDrop delete. self clearDropHighlighting. ! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:26'! handlesMouseDown: evt ^true! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:26'! handlesMouseOver: evt ^false "^complexContents handlesMouseOver: evt"! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:27'! handlesMouseOverDragging: evt ^complexContents handlesMouseOver: evt! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:27'! inToggleArea: event ^self toggleRectangle containsPoint: event cursorPoint ! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:29'! mouseDown: evt | carrier firstPoint | firstPoint _ Sensor cursorPoint. "ugly" complexContents canBeDragged ifFalse: [^container mouseDown: evt onItem: self]. [true] whileTrue: [ Sensor anyButtonPressed ifFalse: [^container mouseDown: evt onItem: self]. (Sensor cursorPoint dist: firstPoint) > 3 ifTrue: [ carrier _ VeryPickyMorph new. carrier passengerMorph: self. evt hand grabMorph: carrier. carrier position: evt hand position - (carrier extent // 2). isBeingDragged _ true. self changed. ^self ]. ]. ! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:29'! mouseEnter: evt evt hand hasSubmorphs ifTrue: [ highlightedForDrop _ true]. self changed! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:30'! mouseEnterDragging: evt evt hand hasSubmorphs ifTrue: [ highlightedForDrop _ true]. self changed! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:30'! mouseLeave: evt self clearDropHighlighting! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:30'! mouseLeaveDragging: evt self clearDropHighlighting! ! !BookmarkListItemMorph methodsFor: 'mouse events' stamp: 'thma 9/4/2000 19:30'! wantsDroppedMorph: aMorph event: evt ^(aMorph isKindOf: VeryPickyMorph) and: [complexContents wantsDroppedObject: aMorph complexContents]! ! !BookmarkListMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 11/16/1999 20:43'! addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean | priorMorph morphList newCollection | priorMorph _ nil. newCollection _ (sortBoolean and: [sortingSelector notNil]) ifTrue: [ (aCollection asSortedCollection: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection ] ifFalse: [ aCollection ]. morphList _ OrderedCollection new. newCollection do: [:item | priorMorph _ BookmarkListItemMorph basicNew "We need specialized ItemMorphs here, for drawing special icons..." initWithContents: item prior: priorMorph forList: self. morphList add: priorMorph. ]. scroller addAllMorphs: morphList after: parentMorph. ^morphList ! ! !BookmarkListMorph methodsFor: 'as yet unclassified' stamp: 'ThMa 12/21/1999 21:40'! morphsFromCollection: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems | priorMorph morphList newCollection | priorMorph _ nil. newCollection _ (sortBoolean and: [sortingSelector notNil]) ifTrue: [ (aCollection asSortedCollection: [ :a :b | (a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection ] ifFalse: [ aCollection ]. morphList _ OrderedCollection new. newCollection do: [:item | priorMorph _ BookmarkListItemMorph basicNew "We need our own Icons..." initWithContents: item prior: priorMorph forList: self. morphList add: priorMorph. (item hasEquivalentIn: expandedItems) ifTrue: [ priorMorph isExpanded: true. priorMorph addChildrenForList: self addingTo: morphList withExpandedItems: expandedItems. ]. ]. ^morphList ! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 11/1/1999 09:48'! add: item self allBookmarks add: item.! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/9/2000 17:03'! addFromDocument: aWebDocument Cursor wait showWhile: [ self add: (aWebDocument asBookmarkCategory). ].! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/9/2000 17:03'! addFromUrl: aUrl Cursor wait showWhile: [ self add: ((WebDocument new: aUrl) asBookmarkCategory). ].! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/29/2000 17:04'! allBookmarks: aBookmarkCategory "replace all bookmarks at once by a new set aBookmarkCategory" "preserve depency chain to observers" AllBookmarks dependents do: [:dep | aBookmarkCategory addDependent: dep]. "remove all entries" self empty. AllBookmarks addAll: aBookmarkCategory. "ensure that InfoAgent specific categories are present" self watchedBookmarks. self searchResults. self trashCan. ! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/8/2000 17:21'! empty AllBookmarks reversed do: [:each | AllBookmarks remove: each]. ! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/15/2000 22:09'! emptyTrash AllBookmarks remove: (self trashCan).! ! !BookmarkManager class methodsFor: 'bookmark operations' stamp: 'ThMa 1/8/2000 17:21'! reset AllBookmarks _ nil. ! ! !BookmarkManager class methodsFor: 'bookmark categories' stamp: 'ThMa 11/7/1999 22:20'! allBookmarks AllBookmarks ifNil: [ AllBookmarks _ BookmarkCategory named: 'InfoAgent Bookmarks'. self watchedBookmarks. self searchResults. self trashCan. ]. ^ AllBookmarks.! ! !BookmarkManager class methodsFor: 'bookmark categories' stamp: 'ThMa 1/7/2000 23:42'! searchResults | it wwcategory | wwcategory _ 'Web Search'. it _ self allBookmarks select: [:x | (x isMemberOf: BookmarkCategory ) & (x name = wwcategory)]. it isEmptyOrNil ifTrue: [it _ BookmarkCategory named: wwcategory. self allBookmarks add: it.] ifFalse: [it _ it at: 1]. ^ it.! ! !BookmarkManager class methodsFor: 'bookmark categories' stamp: 'ThMa 1/9/2000 12:03'! trashCan | it wwcategory | wwcategory _ 'Trash'. it _ self allBookmarks select: [:x | (x isMemberOf: BookmarkCategory ) & (x name = wwcategory)]. it isEmptyOrNil ifTrue: [it _ BookmarkCategory named: wwcategory. self allBookmarks add: it.] ifFalse: [it _ it at: 1]. ^ it.! ! !BookmarkManager class methodsFor: 'bookmark categories' stamp: 'ThMa 1/7/2000 23:40'! watchedBookmarks | it wwcategory | wwcategory _ 'Tracked Documents'. it _ self allBookmarks select: [:x | (x isMemberOf: BookmarkCategory ) & (x name = wwcategory)]. it isEmptyOrNil ifTrue: [it _ BookmarkCategory named: wwcategory. self allBookmarks add: it.] ifFalse: [it _ it at: 1]. ^ it.! ! !BookmarkManager class methodsFor: 'fileIn/Out' stamp: 'ThMa 1/9/2000 17:59'! exportBookmarks "export Bookmarks as Netscape Navigator File" | header body file filename | filename _ (InfoAgent configuration for: #BookmarkFile). "ensure file is empty before re-write" FileDirectory default deleteFileNamed: filename. file _ FileStream fileNamed: filename. file ifNil: [self informUser. file _ self getValidExportFile ]. Cursor write showWhile: [ header _ ' InfoAgent Bookmarks

InfoAgent Bookmarks

'. body _ BookmarkManager allBookmarks asHtml. file nextPutAll: (header , body). file close. ]. ! ! !BookmarkManager class methodsFor: 'fileIn/Out' stamp: 'ThMa 1/29/2000 20:03'! getValidExportFile "select a file" | fn file filename fd|. file _ nil. [file isNil ] whileTrue: [ fn _ StandardFileMenu newFile. filename _ fn directory pathName, (FileDirectory pathNameDelimiter asString), fn name. file _ FileStream newFileNamed: filename. ]. "remember filename" InfoAgent configuration for: #BookmarkFile put: filename. "better keep a backup copy..." fd _FileDirectory forFileName: filename. fd copyFileNamed: filename toFileNamed: (filename, '.ia.bak'). ^ file. ! ! !BookmarkManager class methodsFor: 'fileIn/Out' stamp: 'ThMa 1/29/2000 20:03'! getValidImportFile "select a valid file" | fn file filename fd |. fn _ StandardFileMenu oldFile. filename _ fn directory pathName, (FileDirectory pathNameDelimiter asString), fn name. file _ FileStream oldFileOrNoneNamed: filename. file isNil ifTrue: [^ self getValidImportFile] ifFalse: [ InfoAgent configuration for: #BookmarkFile put: filename. "better keep a backup copy..." fd _FileDirectory forFileName: filename. fd copyFileNamed: filename toFileNamed: (filename, '.ia.bak'). ^ file]. ! ! !BookmarkManager class methodsFor: 'fileIn/Out' stamp: 'ThMa 1/15/2000 22:08'! importBookmarks "Read in Navigator Bookmarkfile" | doc cat file furl filename |. filename _ (InfoAgent configuration for: #BookmarkFile). file _ FileStream fileNamed: filename. file ifNil: [ self informUser. file _ self getValidImportFile ]. furl _ file url. Cursor read showWhile: [ doc _ WebDocument new: furl. cat _ doc asBookmarkCategory. BookmarkManager allBookmarks: cat. ].! ! !BookmarkManager class methodsFor: 'fileIn/Out' stamp: 'ThMa 1/11/2000 19:55'! informUser "comment stating purpose of message" (PopUpMenu labels: ' OK' ) startUpWithCaption: 'No bookmark-file specified yet !! Please select a file in the following file menu. It¸«s a good idea to point to your Netscape bookmark-file if you intend to share bookmarks between Netscape and Squeak!! '. ! ! !BookmarkManager class methodsFor: 'user interface' stamp: 'ThMa 11/3/1999 21:34'! addWithMenu: aBookmark | myHand | myHand _ World activeHand. (self allBookmarks addWithMenu: aBookmark) popUpAt: (myHand position) forHand: myHand. ! ! !BookmarkManager class methodsFor: 'user interface' stamp: 'ThMa 1/11/2000 20:17'! explore BookmarkExplorer new openExplorerFor: (self allBookmarks) caption: 'BookmarkManager'.! ! !BookmarkManager class methodsFor: 'user interface' stamp: 'ThMa 11/5/1999 19:51'! jumpFromMenu: aWebBrowser | myHand | myHand _ World activeHand. (self allBookmarks jumpFromMenu: aWebBrowser) popUpAt: (myHand position) forHand: myHand. ! ! !FileUrl methodsFor: 'access' stamp: 'ThMa 1/6/2000 22:52'! pathForFile "Path using local file system's delimiter. $\ or $:" | first | ^String streamContents: [ :s | "ThMa: we have to check for absolute unix paths like /etc/passwd here !!" (self isAbsolute & FileDirectory default isMemberOf: UnixFileDirectory) ifTrue: [s nextPut: FileDirectory default pathNameDelimiter ]. first _ true. self path do: [ :p | first ifFalse: [ s nextPut: FileDirectory default pathNameDelimiter ]. first _ false. s nextPutAll: p ] ]! ! !HtmlDefinitionList methodsFor: 'testing' stamp: 'ThMa 1/6/2000 22:54'! mayContain: anEntity "ThMa: Don't be too rigid with HTML Grammar here" ^ true.! ! !HtmlDefinitionList methodsFor: 'formatting' stamp: 'ThMa 1/6/2000 22:52'! addToFormatter: formatter "ThMa: treat DL as UL for compatibility with Netscape bookmark-files" formatter startUnorderedList. super addToFormatter: formatter. formatter endUnorderedList.! ! !InfoAgent class methodsFor: 'menus and actions' stamp: 'ThMa 1/4/2000 18:23'! invokeHelp "bring up Help window" | w | w _ Workspace new. w contents: InfoAgent comment; openLabel: 'InfoAgent Help'! ! !InfoAgent class methodsFor: 'menus and actions' stamp: 'ThMa 1/11/2000 19:40'! invokeSearchEngineSelection: aSelector "display list of available SearchEngines, select one, and start search for selected engine." |menu result| menu _ CustomMenu new. menu initialize. "(SearchEngine class organization listAtCategoryNamed: #UsedEngines)" (self configuration for: #UsedSearchEngines) do: [:item | menu add: item action: item]. result _ menu startUpWithCaption: 'Use search-engine:'. result ifNotNil: [self configuration for: #FavoriteSearchEngine put: result]. "now, ask selected engine: aSelector determines the used presentation of the search results: SearchEngine [#searchAndBrowse | #searchAndManage | #searchAndUpdateBookmarks]" self invokeSearchWebFor: aSelector. ! ! !InfoAgent class methodsFor: 'menus and actions' stamp: 'ThMa 12/19/1999 12:01'! invokeSearchWebFor: aSelector "use selected searchengine to perform the searchAction aSelector" | aText engine| engine _ self configuration for: #FavoriteSearchEngine. aText _ FillInTheBlank request: ('Search ', engine asString) initialAnswer: ''. aText = '' ifFalse: [ (SearchEngine perform: engine) perform: aSelector with: aText. ]. ! ! !InfoAgent class methodsFor: 'menus and actions' stamp: 'ThMa 12/24/1999 19:15'! invokeWebBrowser (FileDirectory default fileExists: (self helpFileName)) ifFalse: [ self writeHelpFile. ]. (WebDocument new: 'file:InfoAgent.html') show. ! ! !InfoAgent class methodsFor: 'user interface' stamp: 'ThMa 1/4/2000 18:05'! go BookmarkManager explore.! ! !InfoAgent class methodsFor: 'documentation' stamp: 'ThMa 12/24/1999 19:05'! helpFileName ^ 'InfoAgent.html'.! ! !InfoAgent class methodsFor: 'documentation' stamp: 'thma 9/4/2000 21:37'! version ^ '1.01 thma 9/4/2000 21:37'.! ! !InfoAgent class methodsFor: 'documentation' stamp: 'ThMa 1/3/2000 19:11'! writeHelpFile | file header footer| "InfoAgent writeHelpFile." header _ 'InfoAgent HelpFile [', self version, ']'. footer _ ''. FileDirectory default deleteFileNamed: (self helpFileName). file _ FileStream fileNamed: (self helpFileName). file ifNil: [ self error: 'could not save file' ]. file nextPutAll: header, (self comment asString), footer. file close.! ! !InfoAgent class methodsFor: 'configuration' stamp: 'ThMa 11/2/1999 21:12'! configuration Configuration ifNil: [Configuration _ InfoAgentConfiguration default]. ^ Configuration. ! ! !InfoAgent class methodsFor: 'configuration' stamp: 'ThMa 11/27/1999 22:18'! resetConfiguration Configuration _ nil ! ! !InfoAgentConfiguration methodsFor: 'as yet unclassified' stamp: 'ThMa 11/7/1999 23:26'! edit "comment stating purpose of message" self explore.! ! !InfoAgentConfiguration methodsFor: 'as yet unclassified' stamp: 'ThMa 11/2/1999 21:19'! for: aKey ^ (self at: aKey) at: 1.! ! !InfoAgentConfiguration methodsFor: 'as yet unclassified' stamp: 'ThMa 11/2/1999 21:20'! for: aKey put: aValue ^ (self at: aKey) at: 1 put: aValue.! ! !InfoAgentConfiguration class methodsFor: 'instance creation' stamp: 'ThMa 1/11/2000 19:19'! default "build default Settings dictionary for InfoAgent." | cfg | cfg _ self new. cfg at: #doLogging put: {false. 'All kinds of activities are logged to the Transcript, if set to true' }; at: #checkInterval put: {600. 'WebWatcher checks the registered documents all ... seconds'}; at: #cacheDir put: {''. 'Where shall I put cached documents? Not used yet.'}; at: #displayNewDocuments put: {true. 'Whether Documents shall be reported as changed on initial registration'}; at: #UsedSearchEngines put: { SearchEngine class organization listAtCategoryNamed: #DefaultEngines. 'List of search-engines known to InfoAgent. add your own definitions here' }; at: #FavoriteSearchEngine put: {#Altavista. 'Your favorite SearchEngine (must be one of SearchEngine UsedEngines)'}; at: #changeActions put: { {#setChangeFlag. #beep. #logToTranscript}. 'actions to be performed if WebWatcher detects a changed document'}; at: #BookmarkFile put: {''. 'represents the path to the InfoAgent bookmark file used for im- and export. initially empty to force user input'}. ^ cfg. ! ! !Scamper methodsFor: 'menus' stamp: 'ThMa 1/6/2000 22:19'! addToBookmarks | i doc caption| i _ WebDocumentInfo new. i url: currentUrl asString. i document: (WebDocument onInfo: i). "create properly linked document" i document lookup; cache. doc _ self document. doc isNil "document is nil, if url could not be retrieved!!" ifTrue: [caption _ i url] ifFalse: [caption _ doc head title]. i title: caption. "ensure that WebWatched Documents category is present:" BookmarkManager watchedBookmarks. BookmarkManager addWithMenu: i. ! ! !Scamper methodsFor: 'menus' stamp: 'ThMa 1/6/2000 22:20'! jumpToBookmark BookmarkManager jumpFromMenu: self.! ! !Scamper methodsFor: 'menus' stamp: 'ThMa 1/6/2000 22:20'! manageBookmarks BookmarkManager explore.! ! !Scamper methodsFor: 'menus' stamp: 'ThMa 1/6/2000 22:32'! menu: menu shifted: shifted | lines selections linePositions | "added 'back' and 'forward' menu options: Aibek 4/18/99" "added bookmark support and web-search: ThMa 1/6/2000 22:22" lines _ 'back forward new URL history view source inspect parse tree go to start page edit start page add to bookmarks go to bookmark edit bookmarks search the web'. linePositions _ #(2 4 6 8). selections _ #(back forward jumpToNewUrl displayHistory viewSource inspectParseTree visitStartPage editStartPage addToBookmarks jumpToBookmark manageBookmarks searchTheWeb). downloadingProcess ifNotNil: [ lines _ lines, String cr, 'stop downloading'. linePositions _ linePositions, selections size asOrderedCollection. selections _ selections, #(stopEverything) ]. menu labels: lines lines: linePositions selections: selections. ^menu.! ! !Scamper methodsFor: 'menus' stamp: 'ThMa 1/6/2000 22:20'! searchTheWeb InfoAgent invokeSearchEngineSelection: #searchAndBrowse:. ! ! !SearchEngine methodsFor: 'presentation' stamp: 'thma 9/3/2000 19:13'! searchAndBrowse: aString "comment stating purpose of message" | aUrl aScamper| aUrl _ self buildSearchUrlFor: aString. Scamper openOnUrl: aUrl. ! ! !SearchEngine methodsFor: 'presentation' stamp: 'ThMa 11/7/1999 22:23'! searchAndManage: aText "collect a dictionary of urls and display them in the Bookmark Manager" | cat | cat _ self searchAsBookmarkCategory: aText. BookmarkManager searchResults add: cat. BookmarkManager explore.! ! !SearchEngine methodsFor: 'presentation' stamp: 'ThMa 11/10/1999 20:36'! searchAndUpdateBookmarks: aText "collect a dictionary of urls and display them in the Bookmark Manager" | cat | cat _ self searchAsBookmarkCategory: aText. BookmarkManager searchResults add: cat. ! ! !SearchEngine methodsFor: 'basic searching' stamp: 'ThMa 1/11/2000 19:22'! buildSearchUrlFor: aString "very basic construction of search strings, there is no conversion of blanks or any other encoding yet" | url | url _ (self at: #mainUrl) , (self at: #action) , '?' , (self at: #nameOfSearchField) , '=' , aString , (self at: #additionalParams). ^ url.! ! !SearchEngine methodsFor: 'basic searching' stamp: 'ThMa 1/6/2000 23:18'! searchAsBookmarkCategory: aText "first retrieve as WebDocument then extract all urls from the page and return them as a list of Bookmarks, ready to use in BookmarkExplorer" | doc formatter category| doc _ self searchAsWebDocument: aText. formatter _ BookmarkExtractor new. formatter baseUrl: (self at: #mainUrl) asUrl. formatter flat: true. "return results as a flat list" doc asHtml addToFormatter: formatter. category _ formatter hrefs. category ifNil: [category _ BookmarkCategory new]. category doc: doc. category name: (self at: #title) , ' results for: ' , aText. ^ category. ! ! !SearchEngine methodsFor: 'basic searching' stamp: 'ThMa 10/16/1999 18:11'! searchAsWebDocument: aString "Return search results as a WebDocument" | aUrl | aUrl _ self buildSearchUrlFor: aString. ^ WebDocument new: aUrl. ! ! !SearchEngine class methodsFor: 'instance creation' stamp: 'ThMa 1/11/2000 19:20'! default "build a minimum configuration stub for any Search-engine" | cfg | cfg _ self new. cfg add: (Association key: #title value: ''); add: (Association key: #mainUrl value: 'http://'); add: (Association key: #action value: ''); add: (Association key: #nameOfSearchField value: 'keyword'); add: (Association key: #additionalParams value: ''). ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/27/1999 22:06'! Altavista "Altavista" | cfg | cfg _ self default. cfg at: #title put: 'Altavista'; at: #mainUrl put: 'http://www.altavista.com'; at: #action put: '/cgi-bin/query'; at: #nameOfSearchField put: 'q'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 21:23'! Amazon | cfg | cfg _ self default. cfg at: #title put: 'Amazon'; at: #mainUrl put: 'http://www.amazon.com'; at: #action put: '/exec/obidos/external-search'; at: #nameOfSearchField put: 'tag=odp?keyword'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 21:10'! Aol | cfg | cfg _ self default. cfg at: #title put: 'Aol'; at: #mainUrl put: 'http://search.aol.com'; at: #action put: '/dirsearch.adp'; at: #nameOfSearchField put: 'query'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 21:26'! Dejanews | cfg | cfg _ self default. cfg at: #title put: 'Dejanews'; at: #mainUrl put: 'http://search.dejanews.com'; at: #action put: '/dnquery.xp'; at: #nameOfSearchField put: 'QRY'; at: #additionalParams put: '&defaultOp=AND&svcclass=dncurrent&maxhits=20&ST=QS&format=terse&DBS=1'. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 21:05'! Dmoz "Dmoz archive" | cfg | cfg _ self default. cfg at: #title put: 'The Open Directory project'; at: #mainUrl put: 'http://search.dmoz.org'; at: #action put: '/cgi-bin/search'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 21:57'! Euroferret | cfg | cfg _ self default. cfg at: #title put: 'Euroferret'; at: #mainUrl put: 'http://www.euroferret.com'; at: #action put: '/cgi-bin/ferret'; at: #nameOfSearchField put: 'DB=ferret&P'; at: #additionalParams put: '&B=&THRESHOLD=0'. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:00'! Euroseek | cfg | cfg _ self default. cfg at: #title put: 'Euroseek'; at: #mainUrl put: 'http://www.euroseek.net'; at: #action put: '/query'; at: #nameOfSearchField put: 'iflang=uk&query'; at: #additionalParams put: '&domain=world&lang=world'. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:03'! Excite | cfg | cfg _ self default. cfg at: #title put: 'Excite'; at: #mainUrl put: 'http://search.excite.com'; at: #action put: '/search.gw'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:05'! HotBot | cfg | cfg _ self default. cfg at: #title put: 'HotBot'; at: #mainUrl put: 'http://www.hotbot.com'; at: #action put: '/'; at: #nameOfSearchField put: 'MT'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:08'! InfoSeek | cfg | cfg _ self default. cfg at: #title put: 'InfoSeek'; at: #mainUrl put: 'http://www.infoseek.com'; at: #action put: '/Titles'; at: #nameOfSearchField put: 'qt'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:10'! Lycos | cfg | cfg _ self default. cfg at: #title put: 'Lycos'; at: #mainUrl put: 'http://www.lycos.com'; at: #action put: '/cgi-bin/pursuit'; at: #nameOfSearchField put: 'matchmode=and&cat=lycos&query'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:22'! Metacrawler "Metacrawler" | cfg | cfg _ self default. cfg at: #title put: 'Metacrawler'; at: #mainUrl put: 'http://search.go2net.com'; at: #action put: '/crawler'; at: #nameOfSearchField put: 'rpp=20&general'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:12'! Netscape | cfg | cfg _ self default. cfg at: #title put: 'Netscape'; at: #mainUrl put: 'http://search.netscape.com'; at: #action put: '/cgi-bin/search'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 12/18/1999 14:21'! SwikiDiscussion "Squeak Discussion Swiki" | cfg | cfg _ self default. cfg at: #title put: 'Squeak Discussion Swiki'; at: #mainUrl put: 'http://minnow.cc.gatech.edu'; at: #action put: '/squeak/search'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'thma 9/4/2000 21:34'! SwikiDocumentation "Squeak Documentation Swiki" | cfg | cfg _ self default. cfg at: #title put: 'Squeak Documentation Swiki'; at: #mainUrl put: 'http://minnow.cc.gatech.edu'; at: #action put: '/SqueakDoc.search'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:14'! Webcrawler | cfg | cfg _ self default. cfg at: #title put: 'Webcrawler'; at: #mainUrl put: 'http://www.webcrawler.com'; at: #action put: '/cgi-bin/WebQuery'; at: #nameOfSearchField put: 'searchText'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 1/11/2000 19:49'! WordNet | cfg | cfg _ self default. cfg at: #title put: 'WordNet'; at: #mainUrl put: 'http://www.cogsci.princeton.edu'; at: #action put: '/cgi-bin/webwn/'; at: #nameOfSearchField put: 'stage=1&word'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/15/1999 22:16'! Yahoo | cfg | cfg _ self default. cfg at: #title put: 'Yahoo'; at: #mainUrl put: 'http://search.yahoo.com'; at: #action put: '/bin/search'; at: #nameOfSearchField put: 'p'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'thma 9/4/2000 21:35'! localhost "dummy entry for testing against localhost " | cfg | cfg _ self default. cfg at: #title put: 'localhost'; at: #mainUrl put: 'http://localhost'; at: #action put: '/'; at: #nameOfSearchField put: 'search'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 10/31/1999 08:34'! manpages "linux man pages" | cfg | cfg _ self default. cfg at: #title put: 'man pages'; at: #mainUrl put: 'http://localhost'; at: #action put: ':6711'; at: #nameOfSearchField put: 'man'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'DefaultEngines' stamp: 'ThMa 12/24/1999 21:20'! susesdb "Suse Support DB" | cfg | cfg _ self default. cfg at: #title put: 'Suse SDB'; at: #mainUrl put: 'http://localhost'; at: #action put: '/cgi-bin/sdbsearch.cgi'; at: #nameOfSearchField put: 'stichwort'; at: #additionalParams put: ''. ^ cfg. ! ! !SearchEngine class methodsFor: 'examples' stamp: 'ThMa 11/7/1999 21:52'! demo "Search altavista for squeak and present result either in Webbrowser or as a list of urls'" SearchEngine Altavista searchAndBrowse: 'squeak'. SearchEngine Altavista searchAndManage: 'squeak'.! ! !TranscriptLogger class methodsFor: 'as yet unclassified' stamp: 'thma 9/3/2000 20:37'! log: aString "if logging is enabled display Message in Transcript" (InfoAgent configuration for: #doLogging) ifTrue: [ self writeln: aString. ] ! ! !TranscriptLogger class methodsFor: 'as yet unclassified' stamp: 'thma 9/3/2000 20:38'! writeln: aString "write a new line containing aString to the Transcript" Transcript cr; show: aString. ! ! !WebDocument methodsFor: 'retrieval' stamp: 'ThMa 10/8/1999 19:15'! cache "Store retrieved doc in cache" CachedContent _ ActContent. CachedTimestamp _ Time dateAndTimeNow. ! ! !WebDocument methodsFor: 'retrieval' stamp: 'ThMa 1/10/2000 16:05'! lookup "lookup doc on the web, store as MIMEDDocument" ActContent _ (self url asUrl) retrieveContents. ! ! !WebDocument methodsFor: 'retrieval' stamp: 'ThMa 9/25/1999 15:44'! lookup: aUrl "lookup and remember url" self url: aUrl; lookup.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/2/1999 18:30'! ActContent ^ ActContent.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/8/1999 19:15'! ActContent: aMIMEDocument "Set Content" ActContent _ aMIMEDocument.! ! !WebDocument methodsFor: 'accessing' stamp: 'tm 8/19/1999 11:38'! CachedContent ^ CachedContent.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/8/1999 19:14'! CachedContent: DocContent "store a document in cache" CachedContent := DocContent. ! ! !WebDocument methodsFor: 'accessing' stamp: 'tm 8/18/1999 21:23'! CachedTimeStamp: aTimestamp CachedTimestamp := aTimestamp.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/24/1999 15:17'! info ^ info.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/24/1999 15:17'! info: aWebDocInfo info _ aWebDocInfo.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/24/1999 14:38'! url ^ info at: #url.! ! !WebDocument methodsFor: 'accessing' stamp: 'ThMa 10/24/1999 14:38'! url: aUrl "set url" info at: #url put: aUrl.! ! !WebDocument methodsFor: 'changeActions' stamp: 'ThMa 10/12/1999 19:26'! beep "Object beep." FMSound randomWeird1 play. ! ! !WebDocument methodsFor: 'changeActions' stamp: 'thma 9/3/2000 20:24'! logToTranscript "send a trace message to transcript" TranscriptLogger log: ('detected document change for: ' , self url ).! ! !WebDocument methodsFor: 'changeActions' stamp: 'ThMa 12/27/1999 12:12'! setChangeFlag "mark the document as changed" self info status: 'changed'. ! ! !WebDocument methodsFor: 'changeActions' stamp: 'ThMa 12/27/1999 10:08'! showDiffs "Display difference between cached and current version of a webdocument" | cachedStream actStream cachedDoc actDoc | cachedStream _ ReadStream on: (CachedContent isNil ifTrue: [''] ifFalse: [CachedContent content]). actStream _ ReadStream on: (ActContent isNil ifTrue: [''] ifFalse: [ActContent content]). cachedDoc _ HtmlParser parse: cachedStream. actDoc _ HtmlParser parse: actStream. (StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: cachedDoc asHtml to: actDoc asHtml)) openLabel: 'Changes in ', (self url)! ! !WebDocument methodsFor: 'changeActions' stamp: 'ThMa 12/27/1999 10:09'! showInScamper "open document in scamper web browser" self show: 'InfoAgent detected change for: ' , (self url). ! ! !WebDocument methodsFor: 'testing' stamp: 'ThMa 10/8/1999 23:19'! hasChanged "check whether doc has changed since last caching" | res | self lookup. CachedContent isNil ifTrue: [res _ true.] "New docs are reported as changed on their first check" ifFalse: [res _ (CachedContent content = ActContent content ) not]. ^ res. ! ! !WebDocument methodsFor: 'FileIn/Out' stamp: 'ThMa 11/2/1999 21:27'! loadFromFile "retrieve document from file cache" ^ self loadFromFile: (InfoAgent configuration for: #cacheDir) , (Url hash asString) , '.html'! ! !WebDocument methodsFor: 'FileIn/Out' stamp: 'ThMa 10/2/1999 23:21'! loadFromFile: aFileName "comment stating purpose of message" | file | CachedContent isNil ifTrue: [self cache]. file _ FileStream fileNamed: aFileName. file ifNil: [ self error: 'could not open file' ]. "CachedContent on: file contentsOfEntireFile." CachedContent _ MIMEDocument contentType: (MIMEDocument guessTypeFromName: url) content: ( file contentsOfEntireFile) url: url. file close.! ! !WebDocument methodsFor: 'FileIn/Out' stamp: 'ThMa 11/2/1999 21:27'! saveToFile "make content persistent in filesystem" ^ self saveToFile: (InfoAgent configuration for: #cacheDir) , (Url hash asString) , '.html' ! ! !WebDocument methodsFor: 'FileIn/Out' stamp: 'ThMa 10/8/1999 22:30'! saveToFile: aFileName "comment stating purpose of message" | file | FileDirectory default deleteFileNamed: aFileName. "file _ FileStream fileNamed: (FileDirectory checkName: aFileName fixErrors: true)." file _ FileStream fileNamed: aFileName. file ifNil: [ self error: 'could not save file' ]. file nextPutAll: ActContent content. file close. ^ aFileName.! ! !WebDocument methodsFor: 'converting' stamp: 'ThMa 1/9/2000 12:32'! asBookmarkCategory "return a collection of all urls in this web-doc" | formatter cat| formatter _ BookmarkExtractor new. formatter baseUrl: (self url asUrl). formatter flat: false. "produce a tree structure" ActContent ifNil: [self lookup]. self asHtml addToFormatter: formatter. cat _ formatter hrefs. cat ifNil: [ cat _ BookmarkCategory new]. cat name: self info short. cat doc: self. "provide link back to original page" ^ cat.! ! !WebDocument methodsFor: 'converting' stamp: 'ThMa 1/9/2000 12:29'! asHtml "Return content as parsed HTMLDocument" ActContent ifNil: [ ActContent _ MIMEDocument contentType: 'text/plain' content: '']. ^ HtmlParser parse: ( ReadStream on: ActContent content). ! ! !WebDocument methodsFor: 'display' stamp: 'ThMa 1/9/2000 14:45'! show "when document is shown it is marked as visited " self info status: 'read'. self cache. self show: 'WebDocument: ', (self url).! ! !WebDocument methodsFor: 'display' stamp: 'thma 9/3/2000 19:12'! show: aTitle "open document in scamper web browser" Scamper openOnUrl: (self url). ! ! !WebDocument methodsFor: 'initialization' stamp: 'ThMa 10/24/1999 16:48'! initialize info _ WebDocumentInfo on: self.! ! !WebDocument class methodsFor: 'instance creation' stamp: 'ThMa 12/26/1999 12:33'! new ^ super new initialize.! ! !WebDocument class methodsFor: 'instance creation' stamp: 'ThMa 12/25/1999 01:04'! new: aUrl "construct document from URL" | wd | wd _ WebDocument new. wd url: aUrl; lookup. ^ wd. ! ! !WebDocument class methodsFor: 'instance creation' stamp: 'ThMa 12/19/1999 18:46'! onInfo: aWebDocInfo "construct document from WDI" | wd | wd _ super new. wd info: aWebDocInfo. wd info document: wd. ^ wd. ! ! !WebDocumentInfo methodsFor: 'retrieval' stamp: 'ThMa 11/1/1999 12:50'! retrieveAbstract "Try to extract all kind of meta information from document" | abstract f length| f _ HtmlFormatter new. f baseUrl: ((self url) asUrl). self document asHtml body addToFormatter: f. abstract _ f text asString. length _ abstract size. (length > 300) ifTrue: [length _ 300]. self abstract: (abstract copyFrom: 1 to: length). ! ! !WebDocumentInfo methodsFor: 'retrieval' stamp: 'ThMa 1/29/2000 17:57'! retrieveAll "Try to extract all kind of meta information from document" self document lookup. "we want to be up-to-date" self retrieveTitle; retrieveMeta; retrieveAbstract. self changed: #getList. ! ! !WebDocumentInfo methodsFor: 'retrieval' stamp: 'ThMa 11/1/1999 12:51'! retrieveMeta "Try to extract all kind of meta information from document" | meta | meta _ (self document) asHtml head contents select: [:e | e tagName = 'meta' ] thenCollect: [:e | e asString]. meta isEmptyOrNil ifTrue: [meta _ '-']. self meta: meta. ! ! !WebDocumentInfo methodsFor: 'retrieval' stamp: 'ThMa 11/5/1999 21:37'! retrieveTitle "Try to extract all kind of meta information from document" | title | title _ (self document) asHtml head title. title ifNil: [title _ '-']. self title: title.! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:27'! abstract ^ self at: #abstract ifAbsent: [nil]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:29'! abstract: aValue self at: #abstract put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/2/1999 00:30'! comment ^ self at: #comment ifAbsent: [self short]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:32'! comment: aValue self at: #comment put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/5/1999 21:56'! document theDoc ifNil: [theDoc _ WebDocument new: (self url)]. ^ theDoc.! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 10/24/1999 16:41'! document: aDoc theDoc _ aDoc.! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:28'! meta ^ self at: #meta ifAbsent: [nil]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:30'! meta: aValue self at: #meta put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 21:39'! short ^ self at: #short ifAbsent: [^ self title]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:30'! short: aValue self at: #short put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 12/19/1999 18:05'! status ^ self at: #status ifAbsent: [self status: 'new'. ^ 'new']. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 12/19/1999 16:48'! status: aValue self at: #status put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 12/19/1999 20:41'! title ^ self at: #title ifAbsent: [^ self url]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:30'! title: aValue self at: #title put: aValue. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:24'! url ^ self at: #url ifAbsent: [nil]. ! ! !WebDocumentInfo methodsFor: 'accessing' stamp: 'ThMa 11/1/1999 12:29'! url: aValue self at: #url put: aValue. ! ! !WebDocumentInfo methodsFor: 'bookmarking' stamp: 'ThMa 10/31/1999 00:36'! addToBookmarks self retrieveTitle. BookmarkManager add: self.! ! !WebDocumentInfo methodsFor: 'bookmarking' stamp: 'thma 9/3/2000 20:24'! addToBookmarks: aCategory | existingCategory | self retrieveTitle. existingCategory _ BookmarkManager allBookmarks select: [:x | (x isMemberOf: BookmarkCategory) & (x name = aCategory)]. TranscriptLogger log: existingCategory asString. existingCategory isEmptyOrNil ifTrue: [existingCategory _ BookmarkCategory named: aCategory. BookmarkManager add: existingCategory.] ifFalse: [existingCategory _ existingCategory at: 1.]. existingCategory add: self. ! ! !WebDocumentInfo methodsFor: 'converting' stamp: 'ThMa 1/4/2000 18:58'! asHtml "comment stating purpose of message" ^ '
', self short, '' , String crlf.! ! !WebDocumentInfo class methodsFor: 'instance creation' stamp: 'ThMa 10/24/1999 16:47'! on: aDoc | i | i _ self new. i document: aDoc. ^ i.! ! !WebWatcher methodsFor: 'DocManagement' stamp: 'ThMa 12/19/1999 16:50'! add: aUrl "add aUrl to collection of watched documents" | doc | doc _ WebDocument new: aUrl. doc info retrieveTitle. self bookmarks add: (doc info).! ! !WebWatcher methodsFor: 'DocManagement' stamp: 'ThMa 11/1/1999 19:37'! bookmarks "return set of all watches documents" ^ BookmarkManager watchedBookmarks.! ! !WebWatcher methodsFor: 'DocManagement' stamp: 'ThMa 11/1/1999 19:42'! remove: aUrl "remove documents with the given URL" self bookmarks removeAllSuchThat: [:doc | (doc url) = aUrl]. ! ! !WebWatcher methodsFor: 'DocManagement' stamp: 'ThMa 10/12/1999 20:17'! urls: urlList "add list of urls to WebWatcher" urlList do: [:url | self add: url.].! ! !WebWatcher methodsFor: 'Watching' stamp: 'thma 9/3/2000 20:25'! checkAllDocuments "check all watched documents for changes" TranscriptLogger log: 'Checking for changes at ', Time now asString. self bookmarks isEmptyOrNil ifFalse: [ self checkCategory: (self bookmarks). ]. ! ! !WebWatcher methodsFor: 'Watching' stamp: 'ThMa 1/3/2000 18:47'! checkCategory: aBookmarkCategory "check all documents and sub-categories for changes" aBookmarkCategory isEmptyOrNil ifFalse: [. aBookmarkCategory plainBookmarks do: [:i | self checkDocument: i]. aBookmarkCategory subCategories do: [:cat | self checkCategory: cat]. ]. ! ! !WebWatcher methodsFor: 'Watching' stamp: 'ThMa 12/25/1999 00:11'! checkDocument: aWebDocInfo "check whether doc has changed, display message and document" aWebDocInfo document CachedContent ifNil: [ aWebDocInfo document cache. ]. (aWebDocInfo document hasChanged) ifTrue: [self detectAction: aWebDocInfo document]. ! ! !WebWatcher methodsFor: 'Watching' stamp: 'ThMa 12/27/1999 10:01'! detectAction: aWebDocument "All Actions triggered when a change has been detected are stored in the InfoAgentConfiguration under key #changeActions." (InfoAgent configuration for: #changeActions) do: [:act | aWebDocument perform: act]. ! ! !WebWatcher methodsFor: 'Watching' stamp: 'thma 9/3/2000 20:25'! startWatching "start watching process" self stopWatching. WatchingProcess := [ [true] whileTrue: [ self checkAllDocuments. (Delay forSeconds: (InfoAgent configuration for: #checkInterval)) wait.] ] newProcess. WatchingProcess priority: Processor userBackgroundPriority. WatchingProcess resume. TranscriptLogger log: 'Watching started...'. ! ! !WebWatcher methodsFor: 'Watching' stamp: 'thma 9/3/2000 20:25'! stopWatching "stop watching process" WatchingProcess ifNotNil: [ WatchingProcess terminate. WatchingProcess _ nil. TranscriptLogger log: 'Watching stopped...'. ]. ! ! !WebWatcher class methodsFor: 'instance creation' stamp: 'ThMa 11/2/1999 21:38'! instance "return singleton instance" Instance ifNil: [ Instance _ super new. ]. ^ Instance. ! ! !WebWatcher class methodsFor: 'instance creation' stamp: 'ThMa 10/8/1999 19:26'! new "As we want to use a singleton instance of WebWatcher, instance creation is not allowed for clients. The singleton instance is returned by WebWatcher instance " self shouldNotImplement.! ! !WebWatcher class methodsFor: 'finalization' stamp: 'ThMa 10/12/1999 20:03'! reset "deleting instance" Instance ifNotNil: [ Instance stopWatching. Instance _ nil. ]! ! !WebWatcher class methodsFor: 'user interface' stamp: 'ThMa 11/7/1999 23:24'! run "go watching..." (self instance) startWatching.! ! "Postscript: " InfoAgent invokeWebBrowser ; go. !