'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 26 October 2003 at 12:10:29 am'! Object subclass: #SWAction instanceVariableNames: 'structure request response server html ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! !SWAction commentStamp: 'chbu 10/22/2003 08:57' prior: 0! Actions are instantiated by a structure and they are initialized with that structure and the current request using the constructor method #request:structure:. Actions have basically two tasks: performing the action itself and initiating or doing the GUI rendering. Actions do also represent the context in which a page is rendered as they know about their structure, the request, the response, and the security status. Action Protocol This part of the action is used to handle the requests. The message #execute is called by the structure after initializing the required instance variables. It checks the security permissions of the current user, evaluates the callbacks and starts the rendering by calling #render on itself. The running action might use the accessors to manipulate and mediate with the current environment. It is usually not necessary to override the message #execute, use the callback mechanism described in Chapter \ref{HTML and Callbacks} on page \pageref{HTML and Callbacks} instead. Rendering Protocol The rendering process is started from the message #render at the end of #execute. The message #render fetches the collection of templates of the associated structure and starts generating the XHTML output. It asks each template to render the content they want to emit into the \texttt{...} part of the output. Afterwards the body part \texttt{...} is generated and again every template might contribute its content into that part. As explained on page \pageref{Template} in chapter \ref{Template}, there is always an instance of \texttt{TemplateBodyContent} available calling back the message #renderContent of the action: override this message to let your action render its user-interface. You should not change the state of any component inside the rendering protocol, as an action is unable to know when and how many times it is actually called.! Object subclass: #SWCache instanceVariableNames: 'dataTable currentKey ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! TestCase subclass: #SWCacheTests instanceVariableNames: 'fifo exp ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! TestCase subclass: #SWDocumentTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! Error subclass: #SWDuplicatedStructure instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Structure'! SWAction subclass: #SWEditAction instanceVariableNames: 'title target ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWAction subclass: #SWErrorAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWErrorAction subclass: #SWErrorNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWErrorAction subclass: #SWErrorUnauthorized instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWCache subclass: #SWExpiringCache instanceVariableNames: 'ageTable ttl check step ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! TestCase subclass: #SWExtensionTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! SWCache subclass: #SWFifoCache instanceVariableNames: 'max shrink ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! SWAction subclass: #SWFolderEdit instanceVariableNames: 'name type ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWAction subclass: #SWHistoryAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! WriteStream subclass: #SWHtmlWriteStream instanceVariableNames: 'stack attributes keepTight server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! !SWHtmlWriteStream commentStamp: '' prior: 0! Creating valid XHTML is an error prone task when using string concatenation. SmallWiki follows the design of Seaside \cite{Seaside} and implements the class \texttt{HtmlWriteStream}. This class subclasses \texttt{WriteStream} and it provides a lot of additional messages to append text and XHTML elements to the document being rendered. The following example could be part of the message #renderContent within the \texttt{Action} hierarchy to render a simple user-interface: =html heading: 'Title' level: 1. =html paragraph: [ = html text: 'Click '. = html = anchor: 'here' = to: self url = callback: [ :action | action doSomething ] ] The code produces something like the following output: =

Title

= Click here =

The first message #heading:level: produces a simple section heading of level 1. The message #paragraph: is similar to the one of the heading, but in this example we do not pass a string but block: everything done within that block will be put inside the paragraph tags. This mechanism assures that all tags are closed properly and that always valid XHTML is generated. The message #text: does basically the same as #nextPutAll:, additionally it escapes the given string to make sure the code can be displayed correctly within the web-browser. The message #anchor:to:callback: is probably the most interesting one as it is used to generate an anchor with an assigned call-back block. The \texttt{anchor:} argument obviously renders the things that should be rendered as the content of the link. The \texttt{to:} argument specifies the place where the callback should be handled: usually this is within the same action, but occasionally you might need to specify something else. The \texttt{callback:} argument is evaluated when clicking the link. As an argument the block receives the action that is executing the callbacks, note that this is not necessarily the same action that rendered the link and that is referenced using the keyword \texttt{self}. \texttt{HtmlWriteStream} doesn't emit any unnecessary spaces into the output stream, what makes investigation in the HTML code somehow difficult. For this purpose, there is the possibility to enable the included pretty-printer, but keep in mind that this slows down the rendering process and might have unwanted effects on the output in the web-browser. =HtmlWriteStream prettyPrint: true To see a more advanced examples about html-rendering and callbacks, have a look at the action-class \texttt{CallbackDemo}, that is part of the examples-bundle. Point your web-browser to \texttt{http://localhost:8080/?action=CallbackDemo}, play around with the user-interface and have a look at the implementation.! SWHtmlWriteStream class instanceVariableNames: 'SWPrettyPrint SWEscapeTable '! SWAction subclass: #SWInvisibleAction instanceVariableNames: 'redirect ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWEditAction subclass: #SWPageEdit instanceVariableNames: 'wiki document exception ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWHistoryAction subclass: #SWPageHistory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! TestCase subclass: #SWParserTests instanceVariableNames: 'root page request action prettyPrint ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! TestCase subclass: #SWPropertyTests instanceVariableNames: 'manager propertyTitle propertyUser ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! SWAction subclass: #SWRecentChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWInvisibleAction subclass: #SWRedirectAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWRedirectAction subclass: #SWNextStructure instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWRedirectAction subclass: #SWParentStructure instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWRedirectAction subclass: #SWPreviousStructure instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! Object subclass: #SWRequest instanceVariableNames: 'username password user cookies fields headers url urlparsed response server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! TestCase subclass: #SWRequestTests instanceVariableNames: 'server request ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! SWEditAction subclass: #SWResourceEdit instanceVariableNames: 'data mime embed ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWHistoryAction subclass: #SWResourceHistory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! Object subclass: #SWResponse instanceVariableNames: 'stream status type headers cookies server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! TestCase subclass: #SWResponseTests instanceVariableNames: 'response ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! SWAction subclass: #SWSearch instanceVariableNames: 'expression results root ignoreCase ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! Object subclass: #SWSecurityInformation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! !SWSecurityInformation commentStamp: '' prior: 0! I am an abstract entity representig the security-informatin in the system. My sole resposibility is to check where I have a certain permission. There is also the possibility to assert permissions, what raises an UnauthorizedError exception.! SWSecurityInformation subclass: #SWPermission instanceVariableNames: 'name ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! !SWPermission commentStamp: '' prior: 0! I represent a permission in the system and I am the basic entity for the permission management. A permission will be granted if I am equal to the given permission. Permission will be usually used in conjuction with User>>hasPermission: aPermission or User>>assertPermission.! SWSecurityInformation subclass: #SWRole instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! !SWRole commentStamp: '' prior: 0! I represent a role in the system. Multiple permissions might get assigned to any role. Permission will be granted if any of the permission grants the permission.! SWRole subclass: #SWAdminRole instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! SWRole subclass: #SWBasicRole instanceVariableNames: 'name permissions ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! TestCase subclass: #SWSecurityTests instanceVariableNames: 'permissionEdit permissionView permissionHistory roleAdmin roleAnybody userLukas userUnknown ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! Object subclass: #SWServer instanceVariableNames: 'host ip port root storage callback users ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! !SWServer commentStamp: '' prior: 0! The server class has been designed to be subclassed and to provide a common interface to different server implementations. A server might get started using the messages #start, #startOn:, #startOn:host:ip: or by simply instantiating using the message #new, configuring and starting manually. Please note that the server is not a singleton, so there might be multiple instances running within the same image. =server := SwazooServer startOn: 8080. The instance variable \texttt{root} represents the root-entity of the wiki-tree, what is usually a folder. When starting a new server, a default configuration will be created. Take care that you don't accidentally call the write-accessor for the root on a running wiki, as all the subentries will be destroyed immediately without the possibility of going back. If you want to have a look at the model of your wiki, evaluate the following expression: =server root inspect The default server has no automatic storage mechanism assigned; this is basically useful when developing for SmallWiki and saving the image manually. If you use the wiki in a production environment make sure that you assign a working storage-strategy and test extensively that it is fitting your needs. If you develop other storage strategies, please let us know as we are interested to integrate them into the main-distribution. =server storage: ImageStorage new. " fast and secure persistence " =server storage: SIXXStorage new. " slow dump-out using xml " =server storage: nil. " no persistence " The responsibility to pass the request to the root node of the wiki is taken by the server. Also there will be caught all kinds of exceptions and being displayed as a stack-dump on the client side. The link \emph{Open Debugger} can be used to open the debugger in VisualWorks within the context that caused the error and investigate the problem further.! Smalltalk renameClassNamed: #SWSwazooServer as: #SWComancheServer! SWServer subclass: #SWComancheServer instanceVariableNames: 'comanche ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server-Comanche'! !SWComancheServer commentStamp: 'chbu 10/22/2003 22:58' prior: 0! sw := SWComancheServer startOn: 9090. sw stop. (Service serviceNamed: 'httpd') stop. Service services do: [:a|a stop]. Service shutDown. SWRawRequest inspect.! TestCase subclass: #SWServerTests instanceVariableNames: 'server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! SWAction subclass: #SWSessionAction instanceVariableNames: 'target ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWSessionAction subclass: #SWLogin instanceVariableNames: 'username password ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWSessionAction subclass: #SWLogout instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! Object subclass: #SWSmallWiki instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Kernel'! SWSmallWiki class instanceVariableNames: 'actions '! TestSuite subclass: #SWSmallWikiTestSuite instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! !SWSmallWikiTestSuite commentStamp: '' prior: 0! One of the main benefits of SmallWiki is that it is extensively tested. Before reporting any bugs you should always run the tests in order to verify if there is something wrong with your set-up. Maintenance, porting or extending should go together with running the existing tests and writing new ones to further improve the quality of the code. All the major releases of SmallWiki have to pass all of the provided test-cases. The following table is built automatically, while putting together the SmallWiki documentation. This information is taken from the authors current development environment and therefore should be always accurate: | SmallWiki: | \texttt{[ VersionString ]} | VisualWorks: | \texttt{[ SystemUtils version ]} | Time stamp: | \texttt{[ Timestamp now ]} | Test results: | \texttt{[ | suite result | suite := SmallWikiTestSuite new. result := [ suite run ] ifCurtailed: [ ]. result ]}! Object subclass: #SWStorage instanceVariableNames: 'server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Storage'! !SWStorage commentStamp: '' prior: 0! The abstract storage class provides a protocol to all kinds of storage mechanism implementing persistence in a wiki. It takes care of the notification of changes. Subclasses should implement one of the message #changed or #changed: to make the given structure persistent.! SWStorage subclass: #SWSnapshotStorage instanceVariableNames: 'thread delay lastchange lastsnapshot ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Storage'! !SWSnapshotStorage commentStamp: '' prior: 0! The class \texttt{SnapshotStorage} provides an interface to make snapshots of wikis on a regular bases. With the implementation of the \texttt{ImageStorage} as a concrete implementation this is the most secure and most widely used storage mechanism. ! SWSnapshotStorage subclass: #SWImageStorage instanceVariableNames: 'filename ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Storage'! SWSnapshotStorage subclass: #SWSIXXStorage instanceVariableNames: 'directoryRoot loadFilename ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Storage'! TestCase subclass: #SWStorageTests instanceVariableNames: 'storage server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! TestCase subclass: #SWStructureTests instanceVariableNames: 'pa21 pa22 re31 re32 counter parameter fd fd1 fd11 fd111 fd12 fd2 fd3 ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! Object subclass: #SWTemplate instanceVariableNames: '' classVariableNames: 'SWExpandTable ' poolDictionaries: '' category: 'SmallWiki-Template'! !SWTemplate commentStamp: '' prior: 0! Templates are used to render common parts of wiki-pages. They are defined within a collection hold in the root of the wiki and in combination with a selected Stylesheet, they provide the look-and-feel of the wiki. As the templates are hold in the property manager of the structure, they are shared within all childrens of a folder unless there is a new definition.! SWTemplate subclass: #SWTemplateBody instanceVariableNames: 'id title ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! !SWTemplateBody commentStamp: '' prior: 0! The class \texttt{TemplateBody} should be subclassed in most of the cases to create a new template component. Don't forget to implement the message #title on the class-side to return a string describing this class. The title is also used by default to identify the associated CSS-id and to render it into the body part. The messages #defaultId and #defaultTitle might be used to change this behaviour. The user is always able to edit the id and title from within the template-editor in the web-browser to customise the template to his needs and to the applied stylesheet. ! SWTemplateBody subclass: #SWTemplateBodyActions instanceVariableNames: 'actions ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyContents instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyCustom instanceVariableNames: 'document message ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyPath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyReferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodySearch instanceVariableNames: 'expression root ignoreCase ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodySession instanceVariableNames: 'showRoles showUser ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyTitle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateBody subclass: #SWTemplateBodyW3C instanceVariableNames: 'showPictures showHtmlValidator showCssValidator ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWAction subclass: #SWTemplateEdit instanceVariableNames: 'state selectedAvailable selectedChoosen ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWTemplate subclass: #SWTemplateHead instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! !SWTemplateHead commentStamp: '' prior: 0! The class \texttt{TemplateHead} should be used for templates only rendering to the header of the output-file. If you want to render to the head and to the body use \texttt{TemplateBody} as a superclass instead.! SWTemplateHead subclass: #SWTemplateHeadMeta instanceVariableNames: 'encoding keywords description author index follow ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateHead subclass: #SWTemplateHeadNavigation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! SWTemplateHead subclass: #SWTemplateHeadTitle instanceVariableNames: 'title ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Template'! TestCase subclass: #SWTemplateTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Tests'! Error subclass: #SWUnauthorizedError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! SWSecurityInformation subclass: #SWUser instanceVariableNames: 'username password roles ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Security'! !SWUser commentStamp: '' prior: 0! I represent a user and its password in the system. Multiple roles might be assigned to any user. Permission will be granted if any of the roles grants the permission. Note, that there is no read-accessor for the password, but the password might still get accessed when using an inspector. This weak mechanism should be replaced with hashed passwords.! SWAction subclass: #SWViewAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWViewAction subclass: #SWMimeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! SWViewAction subclass: #SWPageView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Action'! Object subclass: #SWVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! !SWVisitor commentStamp: '' prior: 0! I am an abstract visitor to be used on all subclasses of WikiItem. I provide a standard implementation of all accept messages to make it possible to walk automatically through all the entities of a wiki. Subclasses should override these messages in a appropriate way, to visit only the nodes the need and to walk through the structure more efficiently. ! SWVisitor subclass: #SWVisitorCollector instanceVariableNames: 'collection current ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitorCollector subclass: #SWVisitorRecentChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitorCollector subclass: #SWVisitorReferences instanceVariableNames: 'structure ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitor subclass: #SWVisitorRenderer instanceVariableNames: 'stream structure ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitorRenderer subclass: #SWVisitorRendererHtml instanceVariableNames: 'action ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitorRenderer subclass: #SWVisitorRendererWiki instanceVariableNames: 'nesting ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! SWVisitorCollector subclass: #SWVisitorSearch instanceVariableNames: 'expression ignoreCase ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Visitor'! Object subclass: #SWWikiItem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Abstract'! !SWWikiItem commentStamp: '' prior: 0! All my subclasses (e.g. Structure, Document, Template, etc.) are able to get visited with an instance of SmallWiki.Visitor or one of its subclasses.! SWWikiItem subclass: #SWDocumentComponent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! !SWDocumentComponent commentStamp: '' prior: 0! The document hierarchy describes the content of a wiki page. It includes all the basic elements to represent a text such as paragraph, table, list, links, etc. When the user enters a text using the wiki syntax it is parsed using SmaCC \cite{SmaCC} and the abstract syntax tree is stored within the page.! SWDocumentComponent subclass: #SWDocumentComposite instanceVariableNames: 'children ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWDocument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComponent subclass: #SWHorizontalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWListItem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWList subclass: #SWOrderedList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWParagraph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWPreformatted instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWWikiItem subclass: #SWPropertyManager instanceVariableNames: 'properties ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server'! !SWPropertyManager commentStamp: '' prior: 0! I am a property-manager to hold tags and additional properties to different entities inside the wiki. I respond basically to the dictionary protocol, but I might get visited with a Visitor. ! SWWikiItem subclass: #SWStructure instanceVariableNames: 'title parent predecessor timestamp version properties roles dependents id ' classVariableNames: 'Actions Permissions ' poolDictionaries: '' category: 'SmallWiki-Structure'! !SWStructure commentStamp: '' prior: 0! The structure is the basic entity of SmallWiki, representing the model of a single page. A structure is identified by exactly one URL and is usually included in a composite-tree of other structures. The three concrete subclasses of \texttt{Structure} are: \texttt{Page} and \texttt{Resource} as components and the \texttt{Folder} as composite. In fact \texttt{Structure} should not only be the subclass of \texttt{WikiItem}, but also of \texttt{Model}. As the visiting aspect, however, is far more important, the messages provided in \texttt{Model} have been copied from this system class. A structure provides basic navigational accessors to its parents, children and sisters in the wiki-tree. The basic serving is done with the chain-of-responsibilities design-pattern in the serving protocol. The resolving protocol provides messages to look-up other structure-items using their name. All the structures have a title, a back-reference to their parent and might contain user defined properties, what is something like a dictionary containing symbols as key and any other objects as values. Structures are versioned automatically using a reference pointing to the previous version of the same page. Make sure to override the message #postCopy to make it work correctly. ! SWStructure subclass: #SWPage instanceVariableNames: 'document ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Structure'! !SWPage commentStamp: '' prior: 0! A page is the most important and probably the most used class of the Structure hierarchy. As a sole entity it contains a composite of documents modeling the contents of the page that the user entered using the wiki-syntax. When initializing the instance a default document will be created to make the user aware of the newly created page. ! SWPage subclass: #SWFolder instanceVariableNames: 'children ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Structure'! !SWFolder commentStamp: '' prior: 0! The folder groups a number of children. \texttt{Folder} is a subclass of \texttt{Page}, therefor they also contain a document that might be used to describe the contents.! SWStructure subclass: #SWResource instanceVariableNames: 'data mimetype embed ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Structure'! !SWResource commentStamp: '' prior: 0! A resource might contain any data, like images, videos, sound, pdf or zip files. In fact it can be anything that you want to include within your pages or you want to provide as a possibility to download. The mime-type of the data is used to determine how the given resource should be rendered. As an example images and videos should be displayed inside the html document, whereas zip-files are only references as a link to allow the user to download the file.! Smalltalk renameClassNamed: #SWSwazooSite as: #SWComancheSite! SWResource subclass: #SWComancheSite instanceVariableNames: 'server ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Server-Comanche'! SWDocumentComposite subclass: #SWTable instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWTableCell instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComposite subclass: #SWTableRow instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWDocumentComponent subclass: #SWText instanceVariableNames: 'text ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWText subclass: #SWCode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWText subclass: #SWHeader instanceVariableNames: 'level ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWText subclass: #SWLink instanceVariableNames: 'reference ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWLink subclass: #SWLinkExternal instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWLink subclass: #SWLinkInternal instanceVariableNames: 'resolver ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWLink subclass: #SWLinkMailTo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWList subclass: #SWUnorderedList instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Document'! SWStructure class instanceVariableNames: ''! SmaCCScanner subclass: #SWWikiScanner instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Parser'! SmaCCParser subclass: #SWWikiParser instanceVariableNames: 'documentItems action ' classVariableNames: '' poolDictionaries: '' category: 'SmallWiki-Parser'! !Object methodsFor: 'printing' stamp: 'chbu 10/22/2003 09:19'! displayString ^self asString! ! !Object methodsFor: 'printing' stamp: 'chbu 10/21/2003 00:01'! renderOn: html html text: self displayString! ! !Object methodsFor: 'updating' stamp: 'chbu 10/24/2003 16:28'! changed: anAspectSymbol with: aParameter "The receiver changed. The change is denoted by the argument anAspectSymbol. Usually the argument is a Symbol that is part of the dependent's change protocol, that is, some aspect of the object's behavior, and aParameter is additional information. Inform all of the dependents." self dependents do: [:aDependent | aDependent update: anAspectSymbol with: aParameter]! ! !BlockContext methodsFor: 'printing' stamp: 'chbu 10/20/2003 23:49'! renderOn: html self numArgs = 1 ifTrue: [ self value: html ] ifFalse: [ self value ]! ! !Character methodsFor: 'testing' stamp: 'chbu 10/20/2003 21:37'! isWikiIdentifier ^self isAlphaNumeric or: [ '.-_' includes: self ]! ! !Collection methodsFor: 'enumerating' stamp: 'chbu 10/20/2003 21:43'! detect: aBlock ifNone: exceptionBlock "Evaluate aBlock with each of the receiver's elements as the argument. Answer the first element for which aBlock evaluates to true. If none evaluate to true, then evaluate the argument, exceptionBlock." self do: [:each | (aBlock value: each) ifTrue: [^ each]]. ^ exceptionBlock value! ! !Exception methodsFor: 'as yet unclassified' stamp: 'chbu 10/21/2003 18:25'! copyForDebugging | instance context1 context2 | context1 := self initialContext. context1 := context1 sender. context2 := self initialContext copy. instance := self ."copyForReraise." instance searchFrom: context2. [ context1 notNil ] whileTrue: [ context2 sender: context1 copy. context2 := context2 sender. context1 := context1 sender ]. ^instance! ! !HttpResponse class methodsFor: 'accessing' stamp: 'chbu 10/25/2003 23:51'! statusSymbolFor: aCode | element | element _ StatusCodes detect: [ :each | each key = aCode asString]. ^StatusCodes keyAtValue: element ifAbsent: [self statusCodeFor: #serverError] ! ! !SWAction methodsFor: 'accessing'! html ^html! ! !SWAction methodsFor: 'accessing'! request ^request! ! !SWAction methodsFor: 'accessing'! response ^response! ! !SWAction methodsFor: 'accessing'! server ^server! ! !SWAction methodsFor: 'accessing'! structure ^structure! ! !SWAction methodsFor: 'accessing'! url ^self class urlFor: self structure! ! !SWAction methodsFor: 'accessing'! user ^self request user! ! !SWAction methodsFor: 'callback'! performCallback: aBlockOrSymbol withArguments: anArray ^aBlockOrSymbol isSymbol ifTrue: [ self perform: aBlockOrSymbol withArguments: (anArray copyFrom: 2 to: aBlockOrSymbol numArgs + 1) ] ifFalse: [ aBlockOrSymbol valueWithArguments: (anArray copyFrom: 1 to: aBlockOrSymbol numArgs) ]! ! !SWAction methodsFor: 'callback'! processAnchorCallback | key blockOrSymbol | key := request fieldAt: 'callback'. key isNil ifFalse: [ blockOrSymbol := self request server callback get: key asNumber. blockOrSymbol isNil ifFalse: [ self performCallback: blockOrSymbol withArguments: (Array with: self) ] ].! ! !SWAction methodsFor: 'callback' stamp: 'chbu 10/22/2003 20:14'! processFormCallback | keys object value mime | keys := request fields keys select: [ :key | ('form-callback-' charactersExactlyMatching: key) = 14 ]. keys := keys collect: [ :key | (key copyFrom: 15 to: key size) asNumber ]. keys asSortedCollection do: [ :key | object := self request server callback get: key. object isNil ifFalse: [ value := request fieldAt: 'form-callback-' , key displayString ifAbsent: [ nil ]. mime := request fieldAt: 'mime-form-callback-' , key displayString ifAbsent: [ String new ]. self performCallback: object withArguments: (Array with: self with: value with: mime) ] ]. ^keys notEmpty! ! !SWAction methodsFor: 'action'! execute "Usually it is not necessary to override this message, instead use the provided callback mechanism. Still there are rare cases where you need to have full control over the execution process; but do not generate any output in here, use #renderContent instead. The rendering is called automatically, if there hasn't been a redirect response created while checking the permissions or while executing the callbacks." self executePermission. self executeCallback. self shouldRender ifTrue: [ self render ].! ! !SWAction methodsFor: 'action'! executeCallback "Override this message to provide your own way of evaluating callbacks. This implementation only executes the anchor-callback when there are no form-callbacks being executed. This prevents from accidently executing form and anchor callbacks at the same time, what is usually not intended." self processFormCallback ifFalse: [ self processAnchorCallback ]! ! !SWAction methodsFor: 'action'! executePermission "Override this message to check permission before anything inside this action is executed. By default an action might be used by all users, so no permissions are asserted."! ! !SWAction methodsFor: 'rendering'! render "This message starts the basic html rendering of a page. Unless you do not want the templates and the html addendum to be rendered, do not override this message." html doctype: '"-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"'. html attributeAt: 'xmlns' put: 'http://www.w3.org/1999/xhtml'. html attributeAt: 'xml:lang' put: 'en'. html html: [ html head: [ self renderHead ]. html body: [ self renderBody ] ]! ! !SWAction methodsFor: 'rendering'! renderBody html divNamed: #container with: [ self structure templates do: [ :each | each renderBodyWith: self on: html ] ]! ! !SWAction methodsFor: 'rendering'! renderContent "Override this message to customize the output of this action. Do not change the state of the component in this message."! ! !SWAction methodsFor: 'rendering'! renderForm: aBlock html form: [ "html hidden: self class name named: 'action'. " aBlock value ]! ! !SWAction methodsFor: 'rendering'! renderHead self structure templates do: [ :each | each renderHeadWith: self on: html ]! ! !SWAction methodsFor: 'security'! assertPermission: aPermission "Assert the presence of a Permission in the current session. If no such permission is present an \texttt{UnauthorizedError} is thrown and an error page will be renderered instead of the one of the current action." self user assertPermission: aPermission! ! !SWAction methodsFor: 'security'! hasPermission: aPermission ^self user hasPermission: aPermission! ! !SWAction methodsFor: 'accessing-heading'! heading "Return the full heading of the receiver, containing the title of the receiver and the one of the structure to be handled. Do not override this message, instead have a look at #headingAction and #headingStructure." ^String streamContents: [ :stream | self headingAction isNil ifFalse: [ stream nextPutAll: self headingAction. self headingStructure isNil ifFalse: [ stream space ] ]. self headingStructure isNil ifFalse: [ stream nextPutAll: self headingStructure ] ]! ! !SWAction methodsFor: 'accessing-heading'! headingAction "Return the title of the reveiver to be used in the heading. Do override this message, if you want to provide something different. This might return nil, if it is not appropriate." ^self class title! ! !SWAction methodsFor: 'accessing-heading'! headingStructure "Return the title of the current structure to be used in the heading. Do override this message, if you want to provide something different. This might return nil, if it is not appropriate." ^structure isNil ifTrue: [ nil ] ifFalse: [ structure title ]! ! !SWAction methodsFor: 'testing'! isEnabled ^true! ! !SWAction methodsFor: 'testing'! isIndexable "Override this message and return true to tell search-engines to index the contents of this actions." ^false! ! !SWAction methodsFor: 'testing'! shouldRender ^response isRedirect not! ! !SWAction methodsFor: 'tools'! createChildFromClass: aClass titled: aString self createChildFromClass: aClass titled: aString creator: nil! ! !SWAction methodsFor: 'tools'! createChildFromClass: aClass titled: aString creator: aStructure | parent child url | self assertPermission: aClass permissionAdd. parent := self structure defaultAddTarget. child := aClass title: (parent uniqueTitle: aString). parent nextVersion; add: child; changed: #add. url := aClass defaultEditAction urlFor: child. aStructure isNil ifFalse: [ url := url , '&target=' , aStructure url ]. response redirectTo: url! ! !SWAction methodsFor: 'notification'! changed self changed: #action! ! !SWAction methodsFor: 'notification'! changed: aSymbol self changed: aSymbol with: self! ! !SWAction methodsFor: 'notification'! changed: aSymbol with: anObject structure changed: aSymbol with: anObject.! ! !SWAction methodsFor: 'private'! request: aRequest request := aRequest. response := aRequest response. server := aRequest server. html := response stream.! ! !SWAction methodsFor: 'private'! structure: aStructure structure := aStructure.! ! !SWAction methodsFor: 'initialization'! initialize! ! !SWAction class methodsFor: 'accessing'! title "Return a short string describing the action." ^nil! ! !SWAction class methodsFor: 'accessing'! urlFor: aStructure ^aStructure url, '?action=', self name! ! !SWAction class methodsFor: 'testing'! isListable ^self title notNil! ! !SWAction class methodsFor: 'instance creation'! new ^super new initialize; yourself! ! !SWAction class methodsFor: 'instance creation'! request: aRequest structure: aStructure ^self new request: aRequest; structure: aStructure; yourself! ! !SWAction class methodsFor: 'class initialization'! initialize! ! !SWCache methodsFor: 'configuration'! defaultDataTable ^Dictionary new! ! !SWCache methodsFor: 'configuration'! defaultStartKey ^0! ! !SWCache methodsFor: 'private'! next ^currentKey := currentKey + 1! ! !SWCache methodsFor: 'accessing-entries'! get: aKey ^dataTable removeKey: aKey ifAbsent: [ nil ]! ! !SWCache methodsFor: 'accessing-entries'! put: anObject ^self subclassResponsibility! ! !SWCache methodsFor: 'accessing'! isEmpty ^dataTable isEmpty! ! !SWCache methodsFor: 'accessing'! size ^dataTable size! ! !SWCache methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' size: '; print: self size.! ! !SWCache methodsFor: 'initialization'! initialize currentKey := self defaultStartKey. self reset.! ! !SWCache methodsFor: 'initialization'! reset dataTable := self defaultDataTable.! ! !SWCache class methodsFor: 'instance-creation'! new ^super new initialize; yourself! ! !SWCacheTests methodsFor: 'testing'! testExpAccessors exp ttl: 1111. self assert: exp ttl = 1111. exp check: 2222. self assert: exp check = 2222.! ! !SWCacheTests methodsFor: 'testing'! testExpData 1 to: 1000 do: [ :index | self assert: (exp put: index displayString) = index ]. 1 to: 1000 do: [ :index | self assert: (exp get: index) = index displayString ].! ! !SWCacheTests methodsFor: 'testing'! testExpExpired 1 to: 100 do: [ :index | exp put: index ]. self assert: exp size = 100. 1 to: 100 do: [ :index | self assert: (exp get: index) = index ]. (Delay forSeconds: 1) wait. exp ttl: 1; check: 1. 101 to: 110 do: [ :index | exp put: index ]. self assert: exp size = 10. 1 to: 100 do: [ :index | self assert: (exp get: index) isNil ]. 101 to: 110 do: [ :index | self assert: (exp get: index) = index ].! ! !SWCacheTests methodsFor: 'testing'! testFifoAccessors fifo max: 1111. self assert: fifo max = 1111. fifo shrink: 2222. self assert: fifo shrink = 2222.! ! !SWCacheTests methodsFor: 'testing'! testFifoData 1 to: 1000 do: [ :index | self assert: (fifo put: index displayString) = index ]. 1 to: 1000 do: [ :index | self assert: (fifo get: index) = index displayString ].! ! !SWCacheTests methodsFor: 'testing'! testFifoShrink fifo max: 100; shrink: 10. 1 to: 100 do: [ :index | fifo put: index ]. self assert: fifo size = 100. 1 to: 100 do: [ :index | self assert: (fifo get: index) = index ]. 101 to: 110 do: [ :index | fifo put: index ]. self assert: fifo size = 10. 1 to: 100 do: [ :index | self assert: (fifo get: index) = nil ]. 101 to: 110 do: [ :index | self assert: (fifo get: index) = index ].! ! !SWCacheTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:29'! setUp fifo := SWFifoCache new. exp := SWExpiringCache new.! ! !SWDocumentTests methodsFor: 'testing-component'! testCode self deny: self defaultCode isNil. self deny: self defaultCode text isNil.! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/25/2003 20:29'! testCodeSemantic self should: [ self defaultCode code: 'self subclassResponsibility'; evaluateWith: self defaultAction ] raise: "SubclassResponsibility"Error. self should: [ self defaultCode code: 'self foo'; evaluateWith: self defaultAction ] raise: MessageNotUnderstood. self should: [ self defaultCode code: '1/0'; evaluateWith: self defaultAction ] raise: "ZeroDivide"Error.! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/23/2003 18:00'! testCodeSyntax self should: [ self defaultCode code: '['; evaluateWith: self defaultAction ] raise: Error. self should: [ self defaultCode code: ';'; evaluateWith: self defaultAction ] raise: Notification. self should: [ self defaultCode code: '1+'; evaluateWith: self defaultAction ] raise: Notification.! ! !SWDocumentTests methodsFor: 'testing-component'! testCodeVariables | action | action := self defaultAction. self assert: (self defaultCode code: ''; evaluateWith: action) isNil. self assert: (self defaultCode code: 'self'; evaluateWith: action) == action. self assert: (self defaultCode code: 'structure'; evaluateWith: action) == action structure. self assert: (self defaultCode code: 'request'; evaluateWith: action) == action request. self assert: (self defaultCode code: 'response'; evaluateWith: action) == action request response. self assert: (self defaultCode code: 'html'; evaluateWith: action) == action request response stream. self assert: (self defaultCode code: '^nil'; evaluateWith: action) isNil. self assert: (self defaultCode code: '^self'; evaluateWith: action) == action. self assert: (self defaultCode code: '^structure'; evaluateWith: action) == action structure. self assert: (self defaultCode code: '^request'; evaluateWith: action) == action request. self assert: (self defaultCode code: '^response'; evaluateWith: action) == action request response. self assert: (self defaultCode code: '^html'; evaluateWith: action) == action request response stream.! ! !SWDocumentTests methodsFor: 'testing-component'! testDocument self deny: self defaultDocument isNil. self deny: self defaultDocument children first isNil! ! !SWDocumentTests methodsFor: 'testing-component'! testHeader self deny: self defaultHeader isNil. self assert: self defaultHeader text = self defaultString. self assert: self defaultHeader level = 1! ! !SWDocumentTests methodsFor: 'testing-component'! testHorizontalRule self deny: self defaultHorizontalRule isNil! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/25/2003 20:33'! testLinkExternal | item | self deny: self defaultExternalLink isNil. self deny: self defaultExternalLink isBroken. self assert: self defaultExternalLink class == SWLinkExternal. item := self defaultExternalLink. self assert: item text isNil. self assert: item url = self defaultUrl. self assert: item title = self defaultUrl. self assert: item reference = self defaultUrl. item := self defaultExternalLink text: self defaultAnotherString. self assert: item text = self defaultAnotherString. self assert: item url = self defaultUrl. self assert: item title = self defaultAnotherString. self assert: item reference = self defaultUrl.! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/25/2003 20:32'! testLinkInternal | item | self deny: self defaultInternalLink isNil. self deny: self defaultInternalLink isBroken. self deny: self defaultInternalLink isComposedLink. self assert: self defaultInternalLink hasTarget. self assert: self defaultInternalLink class == SWLinkInternal. item := self defaultInternalLink. self assert: item text isNil. self assert: item resolver title = self defaultPage title. self assert: item target title = self defaultPage title. self assert: item title = self defaultPage title. self assert: item url = self defaultPage url. item := self defaultInternalLink text: self defaultAnotherString. self deny: item text isNil. self assert: item resolver title = self defaultPage title. self assert: item target title = self defaultPage title. self assert: item title = self defaultAnotherString. self assert: item url = self defaultPage url.! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/25/2003 20:32'! testLinkInternalBroken | item | self deny: self defaultBrokenLink isNil. self assert: self defaultBrokenLink isBroken. self deny: self defaultBrokenLink isComposedLink. self deny: self defaultBrokenLink hasTarget. self assert: self defaultBrokenLink class == SWLinkInternal. item := self defaultBrokenLink. self assert: item text isNil. self assert: item resolver title = self defaultPage title. self assert: item target isNil. self assert: item title = self defaultAnotherString. self assert: item url isEmpty. item := self defaultBrokenLink text: self defaultString. self deny: item text isNil. self assert: item resolver title = self defaultPage title. self assert: item target isNil. self assert: item title = self defaultString. self assert: item url isEmpty.! ! !SWDocumentTests methodsFor: 'testing-component' stamp: 'chbu 10/25/2003 20:33'! testLinkMailTo | item | self deny: self defaultMailToLink isNil. self deny: self defaultMailToLink isBroken. self assert: self defaultMailToLink class == SWLinkMailTo. item := self defaultMailToLink. self assert: item text isNil. self assert: item url = 'mailto:renggli@student.unibe.ch'. self assert: item title = self defaultEmail. self assert: item reference = self defaultEmail. item := self defaultMailToLink text: self defaultString. self assert: item text = self defaultString. self assert: item url = 'mailto:renggli@student.unibe.ch'. self assert: item title = self defaultString. self assert: item reference = self defaultEmail.! ! !SWDocumentTests methodsFor: 'testing-component'! testListItem self deny: self defaultListItem isNil. self deny: self defaultListItem children first isNil! ! !SWDocumentTests methodsFor: 'testing-component'! testOrderedList self deny: self defaultOrderedList isNil. self deny: self defaultOrderedList children first isNil! ! !SWDocumentTests methodsFor: 'testing-component'! testParagraph self deny: self defaultParagraph isNil. self deny: self defaultParagraph children first isNil! ! !SWDocumentTests methodsFor: 'testing-component'! testPreformatted self deny: self defaultPreformatted isNil. self deny: self defaultPreformatted children first isNil.! ! !SWDocumentTests methodsFor: 'testing-component'! testTable self deny: self defaultTable isNil. self deny: self defaultTable children first isNil. self assert: self defaultTable columns = 1. self assert: self defaultTable rows = 1! ! !SWDocumentTests methodsFor: 'testing-component'! testTableCell self deny: self defaultTableCell isNil. self deny: self defaultTableCell children first isNil! ! !SWDocumentTests methodsFor: 'testing-component'! testTableRow self deny: self defaultTableRow isNil. self deny: self defaultTableRow children first isNil. self assert: self defaultTableRow columns = 1. self assert: self defaultTableRow rows = 1! ! !SWDocumentTests methodsFor: 'testing-component'! testText self deny: self defaultText isNil. self assert: self defaultText text = self defaultString! ! !SWDocumentTests methodsFor: 'testing-component'! testTextHasText | item | item := self defaultText. self assert: item hasText. item := self defaultText text: ''. self deny: item hasText. item := self defaultText text: nil. self deny: item hasText.! ! !SWDocumentTests methodsFor: 'testing-component'! testUnorderedList self deny: self defaultUnorderedList isNil. self deny: self defaultUnorderedList children first isNil! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 17:08'! defaultAction ^SWPageEdit request: self defaultRequest structure: self defaultPage! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:37'! defaultBrokenLink ^SWLink newTo: self defaultAnotherString from: self defaultPage! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:31'! defaultCode ^SWCode new! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:35'! defaultDocument ^SWDocument new add: self defaultParagraph; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:35'! defaultExternalLink ^SWLink newTo: self defaultUrl from: nil! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:35'! defaultHeader ^SWHeader newText: self defaultString level: 1! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:35'! defaultHorizontalRule ^SWHorizontalRule new! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:37'! defaultInternalLink ^SWLink newTo: self defaultString from: self defaultPage! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:36'! defaultListItem ^SWListItem new add: self defaultText; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:36'! defaultMailToLink ^SWLink newTo: self defaultEmail from: nil! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:36'! defaultOrderedList ^SWOrderedList new add: self defaultListItem; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:36'! defaultPage ^(SWPage parent: (SWFolder title: 'SmallWiki')) title: self defaultString; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:37'! defaultParagraph ^SWParagraph new add: self defaultText; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:38'! defaultPreformatted ^SWPreformatted new add: self defaultText; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:32'! defaultRequest ^SWRequest server: (SWServer new)! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:38'! defaultTable ^SWTable new add: self defaultTableRow; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:38'! defaultTableCell ^SWTableCell new add: self defaultText; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:38'! defaultTableRow ^SWTableRow new add: self defaultTableCell; yourself! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:37'! defaultText ^SWText newText: self defaultString! ! !SWDocumentTests methodsFor: 'configuration-pagecomponent' stamp: 'chbu 10/22/2003 09:38'! defaultUnorderedList ^SWUnorderedList new add: self defaultListItem; yourself! ! !SWDocumentTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:31'! testChildren | comp | comp := SWDocumentComposite new. self deny: comp children isNil. self assert: comp children isEmpty. comp add: #first. self assert: comp children size = 1. comp addAll: #(#second #third). self assert: comp children size = 3. self assert: comp children first = #first. self assert: comp children last = #third! ! !SWDocumentTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:35'! testEnumerating | comp a b | comp := SWDocumentComposite new add: #first; addAll: #(#second #third); yourself. a := 0. comp children do: [ :item | a := a + 1 ]. self assert: a = 3. a := 0. b := 0. comp children do: [ :item | a := a + 1 ] separatedBy: [ b := b + 1 ]. self assert: a = 3. self assert: b = 2! ! !SWDocumentTests methodsFor: 'configuration-constants'! defaultAnotherString ^'Lukas Renggli'! ! !SWDocumentTests methodsFor: 'configuration-constants'! defaultEmail ^'renggli@student.unibe.ch'! ! !SWDocumentTests methodsFor: 'configuration-constants'! defaultString ^'SmallWiki'! ! !SWDocumentTests methodsFor: 'configuration-constants'! defaultUrl ^'http://renggli.freezope.org'! ! !SWEditAction methodsFor: 'rendering'! renderButton html tableRowWith: nil with: [ html submitButtonWithAction: #save text: 'Save' ]! ! !SWEditAction methodsFor: 'rendering'! renderContent self renderForm: [ html hiddenInputWithValue: self target callback: #target:. html attributeAt: #width put: '100%'. html table: [ self renderSummary. self renderFields. self renderButton ] ]! ! !SWEditAction methodsFor: 'rendering'! renderFields html tableRow: [ html tableHeading: 'Title:'. html tableData: [ html attributeAt: 'style' put: 'width: 100%'. html textInputWithValue: self title callback: #title: ] ]! ! !SWEditAction methodsFor: 'rendering' stamp: 'chbu 10/24/2003 17:21'! renderSummary html tableRow: [ html attributeAt: 'width' put: '100'. html tableHeading: 'Modified:'. html tableData: structure timestamp displayString]! ! !SWEditAction methodsFor: 'accessing'! target target isNil ifTrue: [ target := self defaultTarget ]. ^target! ! !SWEditAction methodsFor: 'accessing'! target: aUrlString target := aUrlString! ! !SWEditAction methodsFor: 'accessing'! title title isNil ifTrue: [ title := structure title ]. ^title! ! !SWEditAction methodsFor: 'accessing'! title: aString title := aString. target := nil.! ! !SWEditAction methodsFor: 'utilities'! privatePostSave self response redirectTo: self url. self changed: #edit.! ! !SWEditAction methodsFor: 'utilities'! privatePreSave structure nextVersion.! ! !SWEditAction methodsFor: 'utilities'! privateSave structure title: self title.! ! !SWEditAction methodsFor: 'action'! execute super execute.! ! !SWEditAction methodsFor: 'action'! executePermission self assertPermission: structure class permissionEdit.! ! !SWEditAction methodsFor: 'action'! save "Do not override this message, instead use the messages priveateSave and shouldSave to check your state and to do the actual saving. If necessary a new version of the current structure will be generated automatically and you will be redirected to the right url." self shouldSave ifTrue: [ self privatePreSave. [ self privateSave ] ensure: [ self privatePostSave ]. response redirectTo: self target ]! ! !SWEditAction methodsFor: 'action'! shouldSave "You have to override this message and return false, if you like to stop the saving mechanism, e.g. in case of invalid user input. If you return false, no new version will be generated and no dependents will be called." ^true! ! !SWEditAction methodsFor: 'configuration'! defaultTarget ^structure url! ! !SWErrorAction methodsFor: 'rendering'! renderContent self renderProblem. self renderSolution.! ! !SWErrorAction methodsFor: 'rendering'! renderProblem! ! !SWErrorAction methodsFor: 'rendering'! renderSolution! ! !SWErrorAction methodsFor: 'utilities'! root ^structure root! ! !SWErrorAction methodsFor: 'action'! executeCallback "We do not want any callback to be processed!!"! ! !SWErrorAction methodsFor: 'accessing-heading'! headingStructure ^nil! ! !SWErrorAction class methodsFor: 'testing'! isListable ^false! ! !SWErrorNotFound methodsFor: 'rendering'! renderProblem html paragraph: [ html text: 'The requested object '. html emphasis: request url. html text: ' was not found on this server.' ]! ! !SWErrorNotFound methodsFor: 'rendering'! renderSolution html paragraph: [ html text: 'You can try one of the these options:'. html unorderedList: [ html listItem: 'Click on a shortcut in the menu.'. html listItem: [ html text: 'Jump to the '; anchorWithUrl: self root url do: self root title; text: ' homepage.']. html listItem: 'If you typed the page address, make sure that it is spelled correctly.'. html listItem: 'If you clicked a link from another page, please inform the webmaster of this site of his mistake.' ] ]! ! !SWErrorNotFound class methodsFor: 'accessing'! title ^'Not Found'! ! !SWErrorUnauthorized methodsFor: 'rendering'! renderProblem html paragraph: [ html text: 'You are not authorized to execute the requested action on '. html emphasis: request url. html text: '.' ]! ! !SWErrorUnauthorized methodsFor: 'rendering' stamp: 'chbu 10/22/2003 17:10'! renderSolution html paragraph: [ html text: 'You can try one of the following options:'. html unorderedList: [ html listItem: [ html anchorWithUrl: (SWLogin urlFor: structure) do: 'Logging in'; text: ' with your username and password.']. html listItem: [ html text: 'Jump to the '; anchorWithUrl: self root url do: self root title; text: ' homepage.' ] ] ]! ! !SWErrorUnauthorized class methodsFor: 'accessing'! title ^'Unauthorized'! ! !SWExpiringCache methodsFor: 'configuration'! defaultAgeTable ^Dictionary new! ! !SWExpiringCache methodsFor: 'configuration'! defaultCheck ^100! ! !SWExpiringCache methodsFor: 'configuration'! defaultStartStep ^1! ! !SWExpiringCache methodsFor: 'configuration'! defaultTimeToLive ^30 * 60! ! !SWExpiringCache methodsFor: 'private'! ageTable ^ageTable! ! !SWExpiringCache methodsFor: 'private'! ageTable: aCollection ageTable := aCollection! ! !SWExpiringCache methodsFor: 'private' stamp: 'chbu 10/22/2003 09:30'! now ^TimeStamp now asSeconds! ! !SWExpiringCache methodsFor: 'private'! removeExpired | stamp old | step := self defaultStartStep. stamp := self now - ttl. old := self ageTable select: [ :association | association value <= stamp ]. old keys do: [ :key | dataTable removeKey: key. ageTable removeKey: key ]! ! !SWExpiringCache methodsFor: 'private'! step ^step! ! !SWExpiringCache methodsFor: 'private'! step: anInteger step := anInteger! ! !SWExpiringCache methodsFor: 'accessing'! check ^check! ! !SWExpiringCache methodsFor: 'accessing'! check: anInteger check := anInteger! ! !SWExpiringCache methodsFor: 'accessing'! ttl ^ttl! ! !SWExpiringCache methodsFor: 'accessing'! ttl: anInteger ttl := anInteger! ! !SWExpiringCache methodsFor: 'accessing-entries'! get: anObject ageTable removeKey: anObject ifAbsent: [ nil ]. ^super get: anObject! ! !SWExpiringCache methodsFor: 'accessing-entries'! put: anObject step >= check ifTrue: [ self removeExpired ] ifFalse: [ step := step + 1 ]. dataTable at: self next put: anObject. ageTable at: currentKey put: self now. ^currentKey! ! !SWExpiringCache methodsFor: 'initialize'! initialize super initialize. self step: self defaultStartStep. self ttl: self defaultTimeToLive. self check: self defaultCheck.! ! !SWExpiringCache methodsFor: 'initialize'! reset super reset. self ageTable: self defaultAgeTable.! ! !SWExpiringCache methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: '; ttl: '; print: self ttl.! ! !SWExtensionTests methodsFor: 'testing'! testMoveDown | beenHere collection | beenHere := false. collection := #( a b c ) asOrderedCollection. collection moveDown: #a ifError: [ self assert: false ]. self assert: collection = #( b a c ) asOrderedCollection. collection moveDown: #a ifError: [ self assert: false ]. self assert: collection = #( b c a ) asOrderedCollection. collection moveDown: #a ifError: [ beenHere := true ]. self assert: collection = #( b c a ) asOrderedCollection. self assert: beenHere. beenHere := false. collection moveDown: #d ifError: [ beenHere := true ]. self assert: collection = #( b c a ) asOrderedCollection. self assert: beenHere.! ! !SWExtensionTests methodsFor: 'testing'! testMoveUp | beenHere collection | beenHere := false. collection := #( a b c ) asOrderedCollection. collection moveUp: #c ifError: [ self assert: false ]. self assert: collection = #( a c b ) asOrderedCollection. collection moveUp: #c ifError: [ self assert: false ]. self assert: collection = #( c a b ) asOrderedCollection. collection moveUp: #c ifError: [ beenHere := true ]. self assert: collection = #( c a b ) asOrderedCollection. self assert: beenHere. beenHere := false. collection moveUp: #d ifError: [ beenHere := true ]. self assert: collection = #( c a b ) asOrderedCollection. self assert: beenHere.! ! !SWExtensionTests methodsFor: 'testing'! testStreamContents | result | result := String streamContents: [ :stream | stream nextPutAll: 'Hello World' ]. self assert: result = 'Hello World'. result := result streamContents: [ :stream | stream upToEnd ]. self assert: result = 'Hello World'. result := String streamContents: [ :stream | nil ]. self assert: result isEmpty. result := result streamContents: [ :stream | stream upToEnd ]. self assert: result isEmpty.! ! !SWFifoCache methodsFor: 'accessing-data'! put: anObject dataTable size > max ifTrue: [ self shrinkTable ]. dataTable at: self next put: anObject. ^currentKey! ! !SWFifoCache methodsFor: 'accessing'! max ^max! ! !SWFifoCache methodsFor: 'accessing'! max: anInteger max := anInteger! ! !SWFifoCache methodsFor: 'accessing'! shrink ^shrink! ! !SWFifoCache methodsFor: 'accessing'! shrink: anInteger shrink := anInteger! ! !SWFifoCache methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: '; max: '; print: self max. aStream nextPutAll: '; shrink: '; print: self shrink.! ! !SWFifoCache methodsFor: 'configuration'! defaultMax ^5000! ! !SWFifoCache methodsFor: 'configuration'! defaultShrink ^100! ! !SWFifoCache methodsFor: 'initialize'! initialize super initialize. self max: self defaultMax. self shrink: self defaultShrink.! ! !SWFifoCache methodsFor: 'private'! shrinkTable | keys | keys := dataTable keys asSortedCollection. 1 to: shrink do: [ :index | dataTable removeKey: (keys at: index) ].! ! !SWFolderEdit methodsFor: 'rendering'! renderAdd: aCollection self renderForm: [ html table: [ html tableRow: [ html tableHeading: 'Title:'. html tableData: [ html textInputWithValue: self name callback: #name: ] ]. html tableRow: [ html tableHeading: 'Type:'. html tableData: [ html selectFromList: self filteredStructures selected: self type callback: #type:. html submitButtonWithAction: #add text: 'Add' ] ] ] ]! ! !SWFolderEdit methodsFor: 'rendering'! renderChildren: aCollection html attributeAt: 'width' put: '100%'. html table: [ html tableRow: [ html tableHeading: 'Title'. html tableHeading: 'Type'. html tableHeading: 'Modified'. html tableHeading: 'Version'. html tableHeading: 'Position'. html tableHeading: 'Commands' ]. aCollection do: [ :child | html tableRow: [ html tableData: [ (self hasPermission: child class permissionView) ifTrue: [ html anchorWithUrl: child url do: child title ] ifFalse: [ html text: child title ] ]. html tableData: child class title. html tableData: child timestamp rfc1123String. html tableData: child version displayString. html tableData: [ self renderChildrenPosition: child ]. html tableData: [ self renderChildrenCommands: child ] ] ] ]! ! !SWFolderEdit methodsFor: 'rendering'! renderChildrenCommands: aStructure (self hasPermission: aStructure class permissionCopy) ifTrue: [ html anchorWithAction: [ :action | action copy: aStructure ] to: self url do: 'copy'; space ] ifFalse: [ html text: 'copy'; space ]. (self hasPermission: aStructure class permissionRemove) ifTrue: [ html anchorWithAction: [ :action | action remove: aStructure ] to: self url do: 'remove'; space ] ifFalse: [ html text: 'remove'; space ]! ! !SWFolderEdit methodsFor: 'rendering'! renderChildrenPosition: aStructure (self hasPermission: aStructure class permissionMove) ifTrue: [ html anchorWithAction: [ :action | action moveUp: aStructure ] to: self url do: 'up'; space. html anchorWithAction: [ :action | action moveDown: aStructure ] to: self url do: 'down' ] ifFalse: [ html text: 'up down' ]! ! !SWFolderEdit methodsFor: 'rendering'! renderContent | children structures | structures := self filteredStructures. structures isEmpty ifFalse: [ html heading: 'Add Children' level: 2. self renderAdd: structures. ]. children := self structure children. children isEmpty ifFalse: [ html heading: 'Edit Children' level: 2. self renderChildren: children ].! ! !SWFolderEdit methodsFor: 'utilities'! add | child | self assertPermission: self type permissionAdd. self name isEmpty ifTrue: [ self name: self type title ]. self name: (self structure uniqueTitle: self name). child := self type title: self name. self structure nextVersion; add: child; changed: #add! ! !SWFolderEdit methodsFor: 'utilities'! copy: aStructure self assertPermission: aStructure class permissionCopy. self structure nextVersion. self structure copy: aStructure. self changed: #add.! ! !SWFolderEdit methodsFor: 'utilities'! moveDown: aStructure self assertPermission: self structure class permissionMove. self structure children moveDown: aStructure ifError: [ ^self ]. self changed: #move.! ! !SWFolderEdit methodsFor: 'utilities'! moveUp: aStructure self assertPermission: self structure class permissionMove. self structure children moveUp: aStructure ifError: [ ^self ]. self changed: #move.! ! !SWFolderEdit methodsFor: 'utilities'! remove: aStructure self assertPermission: aStructure class permissionRemove. self structure nextVersion. self structure remove: aStructure. self changed: #remove.! ! !SWFolderEdit methodsFor: 'accessing'! name name isNil ifTrue: [ name := String new ]. ^name! ! !SWFolderEdit methodsFor: 'accessing'! name: aString name := aString trimBlanks! ! !SWFolderEdit methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:13'! type type isNil ifTrue: [ type := SWPage ]. ^type! ! !SWFolderEdit methodsFor: 'accessing'! type: aClass type := aClass! ! !SWFolderEdit methodsFor: 'tools' stamp: 'chbu 10/22/2003 17:13'! filteredStructures ^SWStructure allStructures select: [ :class | self hasPermission: class permissionAdd ]! ! !SWFolderEdit class methodsFor: 'accessing'! title ^'Contents'! ! !SWHistoryAction methodsFor: 'action'! executePermission self assertPermission: structure class permissionHistory.! ! !SWHistoryAction methodsFor: 'rendering'! renderContent structure versions do: [ :item | html table: [ self renderVersion: item ]. html paragraph: [ self renderVersionButtons: item version ] ] separatedBy: [ html horizontalRule ]! ! !SWHistoryAction methodsFor: 'rendering'! renderVersion: aStructure html tableRow: [ html tableHeading: 'Title:'. html tableData: aStructure title ]. html tableRow: [ html tableHeading: 'Modified:'. html tableData: aStructure timestamp rfc1123String ]. html tableRow: [ html tableHeading: 'Version:'. html tableData: aStructure version ]! ! !SWHistoryAction methodsFor: 'rendering'! renderVersionButtons: anInteger html anchorWithAction: [ :action | action restore: anInteger ] to: self url do: 'Restore'; space. html anchorWithAction: [ :action | action revert: anInteger ] to: self url do: 'Revert'; space. html anchorWithAction: [ :action | action truncate: anInteger ] to: self url do: 'Truncate'; space! ! !SWHistoryAction methodsFor: 'utilities'! restore: anInteger self structure versionRestore: anInteger. self changed: #version.! ! !SWHistoryAction methodsFor: 'utilities'! revert: anInteger self structure versionRevert: anInteger. self changed: #version.! ! !SWHistoryAction methodsFor: 'utilities'! truncate: anInteger self structure versionTruncate: anInteger. self changed: #version.! ! !SWHtmlWriteStream methodsFor: 'html-block'! body: anObject self tag: #body do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-block'! head: anObject self tag: #head do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-block'! html: anObject self tag: #html do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-block'! paragraph: aBlock self tag: 'p' do: aBlock! ! !SWHtmlWriteStream methodsFor: 'html-block'! preformatted: anObject self tag: 'pre' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-head'! doctype: aString self nextPutAll: ''! ! !SWHtmlWriteStream methodsFor: 'html-head'! link: relation to: url title: title self attributeAt: 'rel' put: relation. self attributeAt: 'href' put: url. self attributeAt: 'title' put: title. self tag: 'link'! ! !SWHtmlWriteStream methodsFor: 'html-head'! meta: aNameString content: aContentString self attributeAt: 'name' put: aNameString. self attributeAt: 'content' put: aContentString. self tag: 'meta'.! ! !SWHtmlWriteStream methodsFor: 'html-head'! metaEncoding: aString self attributeAt: 'http-equiv' put: 'Content-Type'. self attributeAt: 'content' put: aString. self tag: 'meta'! ! !SWHtmlWriteStream methodsFor: 'html-head'! style: anObject self attributeAt: 'type' put: 'text/css'. self tag: 'style' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-head'! title: anObject self tag: 'title' do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html-css'! cssClass: aString self attributeAt: #class put: aString! ! !SWHtmlWriteStream methodsFor: 'html-css'! cssName: aString self attributeAt: #id put: aString! ! !SWHtmlWriteStream methodsFor: 'html-css'! div: anObject self tag: 'div' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-css'! divClass: aString with: anObject self cssClass: aString; div: anObject! ! !SWHtmlWriteStream methodsFor: 'html-css'! divNamed: aString with: anObject self cssName: aString; div: anObject! ! !SWHtmlWriteStream methodsFor: 'html-css'! span: anObject self keepTight; tag: 'span' do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html-css'! spanClass: aString with: anObject self keepTight; cssClass: aString; span: anObject! ! !SWHtmlWriteStream methodsFor: 'html-css'! spanNamed: aString with: anObject self keepTight; cssName: aString; span: anObject! ! !SWHtmlWriteStream methodsFor: 'html'! anchorWithAction: aBlock to: anUrlString do: anObject self anchorWithUrl: (self registerAnchorCallback: aBlock to: anUrlString) do: anObject! ! !SWHtmlWriteStream methodsFor: 'html'! anchorWithUrl: anUrlString do: anObject self attributeAt: 'href' put: anUrlString. self keepTight; tag: 'a' do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html'! break self tag: 'br'! ! !SWHtmlWriteStream methodsFor: 'html'! comment: anObject self nextPutAll: ''! ! !SWHtmlWriteStream methodsFor: 'html'! embed: anObject to: anUrlString self attributeAt: 'data' put: anUrlString. self attributeAt: 'type' put: 'video/quicktime'. self tag: 'object' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html'! embed: anObject to: anUrlString mime: aMimeString self attributeAt: 'data' put: anUrlString. self attributeAt: 'type' put: aMimeString. self tag: 'object' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html'! emphasis: aBlock self tag: 'em' do: aBlock.! ! !SWHtmlWriteStream methodsFor: 'html'! heading: aString self heading: aString level: 1! ! !SWHtmlWriteStream methodsFor: 'html'! heading: anObject level: aNumber self tag: 'h', aNumber printString do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html'! horizontalRule self tag: 'hr'! ! !SWHtmlWriteStream methodsFor: 'html'! image: anUrlString self attributeAt: 'src' put: anUrlString. self tag: 'img'! ! !SWHtmlWriteStream methodsFor: 'html'! image: anUrlString alt: aString self attributeAt: 'alt' put: anUrlString. self image: anUrlString! ! !SWHtmlWriteStream methodsFor: 'html'! image: anUrlString alt: aString size: aPoint self attributeAt: 'width' put: aPoint x. self attributeAt: 'height' put: aPoint y. self image: anUrlString alt: aString! ! !SWHtmlWriteStream methodsFor: 'html'! listItem: anObject self tag: 'li' do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html'! orderedList: anObject self tag: 'ol' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html'! space self nextPutAll: ' '! ! !SWHtmlWriteStream methodsFor: 'html'! unorderedList: anObject self tag: 'ul' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-table'! layoutTable: aBlock self attributeAt: 'cellspacing' put: 0. self attributeAt: 'cellpadding' put: 0. self attributeAt: 'border' put: 0. self table: aBlock! ! !SWHtmlWriteStream methodsFor: 'html-table'! table: anObject self tag: 'table' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableData: anObject self tag: 'td' do: anObject keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableHeading: aBlock self tag: 'th' do: aBlock keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableRow: anObject self tag: 'tr' do: anObject! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableRowWith: aBlock self tableRow: [ self tableData: aBlock ]! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableRowWith: aBlock span: aNumber self tableRow: [ self attributeAt: 'colspan' put: aNumber. self tableData: aBlock ]! ! !SWHtmlWriteStream methodsFor: 'html-table'! tableRowWith: aFirstBlock with: aSecondBlock self tableRow: [ self tableData: aFirstBlock. self tableData: aSecondBlock ]! ! !SWHtmlWriteStream methodsFor: 'private'! closeAllTags [ stack isEmpty ] whileFalse: [ self closeTag ]! ! !SWHtmlWriteStream methodsFor: 'private'! closeTag | tag | tag := stack removeLast. self identTag; nextPut: $<; nextPut: $/; nextPutAll: tag; nextPut: $>! ! !SWHtmlWriteStream methodsFor: 'private'! identTag self class isPrettyPrint ifTrue: [ self identTagBy: 2 * stack size ]! ! !SWHtmlWriteStream methodsFor: 'private'! identTagBy: aNumber keepTight ifTrue: [ keepTight := false ] ifFalse: [ self nextPut: Character cr. aNumber timesRepeat: [ self nextPut: $ ] ]! ! !SWHtmlWriteStream methodsFor: 'private'! keepTight keepTight := true! ! !SWHtmlWriteStream methodsFor: 'private'! openTag: aString self openTag: aString andClose: false! ! !SWHtmlWriteStream methodsFor: 'private'! openTag: aString andClose: aBoolean self identTag. aBoolean ifFalse: [ stack add: aString ]. self nextPut: $<; nextPutAll: aString. attributes isNil ifFalse: [ self nextPutAll: attributes contents. attributes := nil ]. aBoolean ifTrue: [ self nextPutAll: ' /' ]. self nextPut: $>! ! !SWHtmlWriteStream methodsFor: 'html-primitive'! render: anObject anObject renderOn: self! ! !SWHtmlWriteStream methodsFor: 'html-primitive'! tag: aString self openTag: aString andClose: true! ! !SWHtmlWriteStream methodsFor: 'html-primitive'! tag: aString do: anObject self tag: aString do: anObject keepTight: false! ! !SWHtmlWriteStream methodsFor: 'html-primitive'! tag: aString do: anObject keepTight: aBoolean self openTag: aString. self render: anObject. aBoolean ifTrue: [ self keepTight ]. self closeTag.! ! !SWHtmlWriteStream methodsFor: 'html-primitive'! text: aString | table escape | table := self escapeTable. aString do: [ :character | escape := table at: character ifAbsent: [ nil ]. escape isNil ifTrue: [ self nextPut: character ] ifFalse: [ self nextPutAll: escape ] ]! ! !SWHtmlWriteStream methodsFor: 'accessing'! callback ^server callback! ! !SWHtmlWriteStream methodsFor: 'accessing'! contents self closeAllTags. ^super contents! ! !SWHtmlWriteStream methodsFor: 'accessing'! escapeTable ^self class escapeTable! ! !SWHtmlWriteStream methodsFor: 'accessing'! server ^server! ! !SWHtmlWriteStream methodsFor: 'accessing'! server: aServer server := aServer! ! !SWHtmlWriteStream methodsFor: 'private-dnu'! doesNotUnderstand: aMessage | argumentCount | argumentCount := aMessage arguments size. argumentCount = 0 ifTrue: [ ^self tag: aMessage selector ]. argumentCount = 1 ifTrue: [ ^self tag: (aMessage selector copyFrom: 1 to: aMessage selector size - 1) do: aMessage arguments first ]. ^super doesNotUnderstand: aMessage! ! !SWHtmlWriteStream methodsFor: 'private-form'! inputWithType: aTypeString self attributeAt: 'type' put: aTypeString. self tag: 'input'.! ! !SWHtmlWriteStream methodsFor: 'private-form'! inputWithType: aTypeString callback: aBlock self inputWithType: aTypeString named: (self registerFormCallback: aBlock)! ! !SWHtmlWriteStream methodsFor: 'private-form'! inputWithType: aTypeString callback: aBlock value: aValueString self inputWithType: aTypeString named: (self registerFormCallback: aBlock) value: aValueString! ! !SWHtmlWriteStream methodsFor: 'private-form'! inputWithType: aTypeString named: aNameString self attributeAt: 'name' put: aNameString. self inputWithType: aTypeString.! ! !SWHtmlWriteStream methodsFor: 'private-form'! inputWithType: aTypeString named: aNameString value: aValueString self attributeAt: 'value' put: aValueString. self inputWithType: aTypeString named: aNameString.! ! !SWHtmlWriteStream methodsFor: 'html-form'! checkboxWithValue: aBoolean callback: aBlock | checked | checked := false. self attributeAt: 'checked' put: aBoolean. self inputWithType: 'checkbox' callback: [ :action :value :mime | checked := true ]. self hiddenInputWithValue: aBoolean displayString callback: [ :action :value :mime | action performCallback: aBlock withArguments: (Array with: action with: checked with: mime) ].! ! !SWHtmlWriteStream methodsFor: 'html-form'! fileUploadWithCallback: aBlock self inputWithType: 'file' named: (self registerFormCallback: aBlock)! ! !SWHtmlWriteStream methodsFor: 'html-form'! form: anObject self attributeAt: 'method' put: 'post'. self tag: 'form' do: anObject.! ! !SWHtmlWriteStream methodsFor: 'html-form'! formMultipart: anObject self attributeAt: 'enctype' put: 'multipart/form-data'. self form: anObject.! ! !SWHtmlWriteStream methodsFor: 'html-form'! hiddenInputWithValue: anObject callback: aBlock self inputWithType: 'hidden' callback: [ :action :value :mime | action performCallback: aBlock withArguments: (Array with: action with: anObject with: mime) ]! ! !SWHtmlWriteStream methodsFor: 'html-form'! label: aBlock self tag: 'label' do: aBlock keepTight: true! ! !SWHtmlWriteStream methodsFor: 'html-form'! passwordInputWithValue: anObject callback: aBlock self inputWithType: 'password' callback: aBlock value: anObject! ! !SWHtmlWriteStream methodsFor: 'html-form'! selectFromList: aCollection selected: aSelectedObject callback: aCallbackBlock self selectFromList: aCollection selected: aSelectedObject callback: aCallbackBlock labels: [ :object | object displayString ]! ! !SWHtmlWriteStream methodsFor: 'html-form'! selectFromList: aCollection selected: aSelectedObject callback: aCallbackBlock labels: aLabelsBlock | selectName | selectName := self registerFormCallback: [ :action :value :mime | action performCallback: aCallbackBlock withArguments: (Array with: action with: (aCollection at: value asNumber) with: mime) ]. self attributeAt: 'name' put: selectName. self tag: 'select' do: [ aCollection do: [ :object | self attributeAt: 'selected' put: (aSelectedObject = object). self attributeAt: 'value' put: (aCollection indexOf: object). self tag: 'option' do: [ self text: (aLabelsBlock value: object); keepTight ] ] ]! ! !SWHtmlWriteStream methodsFor: 'html-form'! submitButton self inputWithType: 'submit'! ! !SWHtmlWriteStream methodsFor: 'html-form'! submitButton: aString self inputWithType: 'submit' named: nil value: aString! ! !SWHtmlWriteStream methodsFor: 'html-form'! submitButtonWithAction: aBlock self inputWithType: 'submit' callback: aBlock! ! !SWHtmlWriteStream methodsFor: 'html-form'! submitButtonWithAction: aBlock text: aString self inputWithType: 'submit' callback: aBlock value: aString! ! !SWHtmlWriteStream methodsFor: 'html-form'! textAreaWithValue: aString callback: aBlock self attributeAt: 'name' put: (self registerFormCallback: aBlock). self tag: 'textarea' do: aString keepTight: true.! ! !SWHtmlWriteStream methodsFor: 'html-form'! textInputWithValue: anObject callback: aBlock self inputWithType: 'text' callback: aBlock value: anObject! ! !SWHtmlWriteStream methodsFor: 'initialize'! initialize stack := OrderedCollection new. keepTight := false.! ! !SWHtmlWriteStream methodsFor: 'callbacks'! registerAnchorCallback: aBlock to: anUrl | prefix | prefix := (anUrl includes: $?) ifTrue: [ '&' ] ifFalse: [ '?' ]. ^anUrl , prefix , 'callback=' , (self callback put: aBlock) displayString! ! !SWHtmlWriteStream methodsFor: 'callbacks'! registerFormCallback: aBlock ^'form-callback-' , (self callback put: aBlock) displayString! ! !SWHtmlWriteStream methodsFor: 'attributes'! attributeAt: key put: value (value == false) ifTrue: [ ^self ]. attributes isNil ifTrue: [ attributes := WriteStream on: String new ]. attributes nextPut: $ ; nextPutAll: key displayString. (value == true) ifFalse: [ attributes nextPutAll: '="'; nextPutAll: value displayString; nextPut: $" ]! ! !SWHtmlWriteStream methodsFor: 'attributes'! attributes: aCollection aCollection keysAndValuesDo: [ :key :value | self attributeAt: key put: value ]! ! !SWHtmlWriteStream class methodsFor: 'private'! on: aCollection ^(super on: aCollection) initialize; yourself! ! !SWHtmlWriteStream class methodsFor: 'settings' stamp: 'chbu 10/22/2003 09:57'! escapeTable ^SWEscapeTable! ! !SWHtmlWriteStream class methodsFor: 'settings' stamp: 'chbu 10/22/2003 09:57'! isPrettyPrint ^SWPrettyPrint! ! !SWHtmlWriteStream class methodsFor: 'settings' stamp: 'chbu 10/22/2003 09:57'! prettyPrint: aBoolean SWPrettyPrint := aBoolean! ! !SWHtmlWriteStream class methodsFor: 'initialization' stamp: 'chbu 10/22/2003 09:57'! initialize SWPrettyPrint := self defaultPrettyPrint. SWEscapeTable := self defaultEscapeTable.! ! !SWHtmlWriteStream class methodsFor: 'configuration' stamp: 'chbu 10/22/2003 15:50'! defaultEscapeTable ^(Dictionary new) at: $� put: '¡'; at: $� put: '¢'; at: $� put: '£'; at: $� put: '¤'; at: $� put: '¥'; at: $� put: '¦'; at: $� put: '§'; at: $� put: '¨'; at: $� put: '©'; at: $� put: 'ª'; at: $� put: '«'; at: $� put: '¬'; at: $� put: ''; at: $� put: '®'; at: $� put: '¯'; at: $� put: '°'; at: $� put: '±'; at: $� put: '²'; at: $� put: '³'; at: $� put: '´'; at: $� put: 'µ'; at: $� put: '¶'; at: $� put: '·'; at: $� put: '¸'; at: $� put: '¹'; at: $� put: 'º'; at: $� put: '»'; at: $� put: '¼'; at: $� put: '½'; at: $� put: '¾'; at: $� put: '¿'; at: $� put: 'À'; at: $� put: 'Á'; at: $� put: 'Â'; at: $� put: 'Ã'; at: $� put: 'Ä'; at: $� put: 'Å'; at: $� put: 'Æ'; at: $� put: 'Ç'; at: $� put: 'È'; at: $� put: 'É'; at: $� put: 'Ê'; at: $� put: 'Ë'; at: $� put: 'Ì'; at: $� put: 'Í'; at: $� put: 'Î'; at: $� put: 'Ï'; at: $� put: 'Ð'; at: $� put: 'Ñ'; at: $� put: 'Ò'; at: $� put: 'Ó'; at: $� put: 'Ô'; at: $� put: 'Õ'; at: $� put: 'Ö'; at: $� put: '×'; at: $� put: 'Ø'; at: $� put: 'Ù'; at: $� put: 'Ú'; at: $� put: 'Û'; at: $� put: 'Ü'; at: $� put: 'Ý'; at: $� put: 'Þ'; at: $� put: 'ß'; at: $� put: 'à'; at: $� put: 'á'; at: $� put: 'â'; at: $� put: 'ã'; at: $� put: 'ä'; at: $� put: 'å'; at: $� put: 'æ'; at: $� put: 'ç'; at: $� put: 'è'; at: $� put: 'é'; at: $� put: 'ê'; at: $� put: 'ë'; at: $� put: 'ì'; at: $� put: 'í'; at: $� put: 'î'; at: $� put: 'ï'; at: $� put: 'ð'; at: $� put: 'ñ'; at: $� put: 'ò'; at: $� put: 'ó'; at: $� put: 'ô'; at: $� put: 'õ'; at: $� put: 'ö'; at: $� put: '÷'; at: $� put: 'ø'; at: $� put: 'ù'; at: $� put: 'ú'; at: $� put: 'û'; at: $� put: 'ü'; at: $� put: 'ý'; at: $� put: 'þ'; at: $� put: 'ÿ'; yourself! ! !SWHtmlWriteStream class methodsFor: 'configuration'! defaultPrettyPrint ^false! ! !SWInvisibleAction methodsFor: 'accessing'! redirect redirect isNil ifTrue: [ redirect := String new ]. ^redirect! ! !SWInvisibleAction methodsFor: 'accessing'! redirect: aString redirect := aString! ! !SWInvisibleAction methodsFor: 'utilites'! redirectTo: anUrl self redirect isEmpty ifFalse: [ ^response redirectTo: self redirect ]. (anUrl isNil or: [ anUrl isEmpty ]) ifFalse: [ ^response redirectTo: anUrl ]. response redirectTo: structure url.! ! !SWInvisibleAction methodsFor: 'rendering'! render "We do not want anything to be rendered as we are invisible, so we override with an empty message here. We assume that subclasses do a redirect somewhere after they performed an action."! ! !SWPageEdit methodsFor: 'accessing'! document document isNil ifTrue: [ document := structure document ]. ^document! ! !SWPageEdit methodsFor: 'accessing'! document: aDocument document := aDocument! ! !SWPageEdit methodsFor: 'accessing'! exception ^exception! ! !SWPageEdit methodsFor: 'accessing'! exception: anException exception := anException. self wiki streamContents: [ :input | wiki := String streamContents: [ :output | output nextPutAll: (input next: anException parameter position - 1). output nextPutAll: anException messageText; nextPutAll: ' -> '. output nextPutAll: input upToEnd ] ]! ! !SWPageEdit methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:18'! wiki wiki isNil ifTrue: [ wiki := (SWVisitorRendererWiki render: structure) contents ]. ^wiki! ! !SWPageEdit methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:19'! wiki: aString [ document := SWWikiParser parse: (wiki := aString) readStream for: self ] on: SmaCCParserError do: [ :error | error return: (self exception: error) ]! ! !SWPageEdit methodsFor: 'rendering'! renderDocument html tableRow: [ html attributeAt: #valign put: #top. html tableHeading: 'Document:'. html tableData: [ html attributeAt: 'wrap' put: 'virtual'. html attributeAt: 'rows' put: '20'. html attributeAt: 'style' put: 'width: 100%'. html textAreaWithValue: self wiki callback: #wiki: ] ].! ! !SWPageEdit methodsFor: 'rendering'! renderError exception isNil ifFalse: [ html tableRow: [ html tableHeading: 'Error:'. html tableData: exception messageText ] ]! ! !SWPageEdit methodsFor: 'rendering'! renderFields super renderFields. self renderSyntaxHelp. self renderError. self renderDocument.! ! !SWPageEdit methodsFor: 'rendering'! renderSyntaxHelp | syntax | syntax := structure root resolveTo: '/Information/Syntax'. syntax isNil ifFalse: [ html tableRow: [ html tableHeading: 'Syntax:'. html tableData: [ html anchorWithUrl: syntax url do: syntax title ] ] ]! ! !SWPageEdit methodsFor: 'utilities'! privateSave super privateSave. structure document: document.! ! !SWPageEdit methodsFor: 'utilities'! shouldSave ^self exception isNil and: [ document notNil ]! ! !SWPageEdit class methodsFor: 'accessing'! title ^'Edit'! ! !SWPageHistory methodsFor: 'rendering' stamp: 'chbu 10/22/2003 17:20'! renderDocument: aStructure | full contracted | full := (SWVisitorRendererWiki render: aStructure) contents. contracted := String streamContents: [ :stream | stream nextPutAll: (full copyFrom: 1 to: (256 min: full size)). stream nextPutAll: '...' ]. html text: contracted! ! !SWPageHistory methodsFor: 'rendering'! renderVersion: aStructure super renderVersion: aStructure. html tableRow: [ html attributeAt: #valign put: #top. html tableHeading: 'Document:'. html tableData: [ self renderDocument: aStructure ] ]! ! !SWPageHistory class methodsFor: 'accessing'! title ^'History'! ! !SWParserTests methodsFor: 'testing' stamp: 'chbu 10/25/2003 18:55'! testConfigurationAll "The test assures that all definitions of the messages doc*, html* and wiki* are not only defined, but also used." | selectors | selectors := self class selectors select: [ :each | 'doc*' match: each ]. selectors do: [ :each | self assert: (self selectors includes: 'SW', (each copyFrom: 4 to: each size) asSymbol) ]. selectors := self class selectors select: [ :each | 'html*' match: each ]. selectors do: [ :each | self assert: (self selectors includes: 'SW', (each copyFrom: 5 to: each size) asSymbol) ]. selectors := self class selectors select: [ :each | 'wiki*' match: each ]. selectors do: [ :each | self assert: (self selectors includes: 'SW', (each copyFrom: 5 to: each size) asSymbol) ].! ! !SWParserTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 16:51'! testConfigurationPrettyPrint self deny: SWHtmlWriteStream isPrettyPrint.! ! !SWParserTests methodsFor: 'testing' stamp: 'chbu 10/25/2003 19:41'! testConfigurationSelectors self selectors do: [ :each | self assert: (self respondsTo: ('doc' , (each copyFrom: 3 to: each size)) asSymbol) ]. self selectors do: [ :each | self assert: (self respondsTo: ('html' , (each copyFrom: 3 to: each size)) asSymbol) ]. self selectors do: [ :each | self assert: (self respondsTo: ('wiki' , (each copyFrom: 3 to: each size)) asSymbol) ].! ! !SWParserTests methodsFor: 'testing'! testRenderHtml self resourcesForDoc with: self resourcesForHtml do: [ :document :html | self assert: (self renderHtml: document) = html ]! ! !SWParserTests methodsFor: 'testing'! testRenderWiki self resourcesForDoc with: self resourcesForWiki do: [ :document :wiki | self assert: (self renderWiki: document) = wiki ]! ! !SWParserTests methodsFor: 'testing'! testRoundTripDoc self resourcesForDoc do: [ :doc | self compareDoc: (self parseWiki: (self renderWiki: doc)) with: doc ]! ! !SWParserTests methodsFor: 'testing'! testRoundTripWiki self resourcesForWiki do: [ :wiki | self assert: (self renderWiki: (self parseWiki: wiki)) = wiki ]! ! !SWParserTests methodsFor: 'resources-html'! htmlCode ^'

3628800

'! ! !SWParserTests methodsFor: 'resources-html'! htmlEmpty ^String new! ! !SWParserTests methodsFor: 'resources-html'! htmlHeader ^'

Heading 1

Heading 2

Heading 3

Heading 4

'! ! !SWParserTests methodsFor: 'resources-html'! htmlHorizontalRule ^'

_ is parsed as paragraph

'! ! !SWParserTests methodsFor: 'resources-html'! htmlLink ^'

Internal Links: Page Internal Link

External Links: http://www.google.ch External Link

Email Link: renggli@iam.unibe.ch Email Link

'! ! !SWParserTests methodsFor: 'resources-html'! htmlList ^'

a long list
with multiple items
- having two
- nested
1. sub-lists

another list

'! ! !SWParserTests methodsFor: 'resources-html'! htmlParagraph ^'

Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Nulla quis urna. Vestibulum turpis. Duis non mauris non sapien consectetuer vulputate. Duis quis pede. Nullam libero. Mauris ut turpis. Nulla mattis elementum nulla. Duis pretium magna et sem. Phasellus blandit. Ut non dolor at pede auctor semper. Donec semper dignissim ipsum. Nunc ultrices dui id ligula. Pellentesque neque. Aenean placerat nunc ut diam. Vivamus luctus magna vel velit. Donec ultricies orci eget erat. Nulla elementum ligula non est.

'! ! !SWParserTests methodsFor: 'resources-html'! htmlPreformatted ^'

A line
   A line with 3 spaces
	A line with a tab

Another line

'! ! !SWParserTests methodsFor: 'resources-html'! htmlTable ^'

a11	a12
a21	a22

'! ! !SWParserTests methodsFor: 'resources-html' stamp: 'chbu 10/25/2003 21:27'! htmlText ^'

Default char-set: abcdefghijklmnopqrstuvwxyz... ABCDEFGHIJKLMNOPQRSTUVWXYZ... 0123456789...

Special char-set: ÄäËëÏïÖöÖü, ÁáÉéÍíÓóÚú, ÀàÈèÌìÒòÙù, ÂâÊêÎîÔôÛû, ÇçÑñ, $£¥¢, !!"#%&÷§¶¾±¯?¿, <>{}(), ®©

Wiki char-set: !!_#-|=]@:<>\*

Html char-set: strong strong, emph

' ! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:51'! docCode ^SWDocument new add: (SWParagraph new add: (SWCode newCode: ' 10 factorial '); yourself); add: (SWParagraph new add: (SWCode newCode: ' 10 factorial isZero ifTrue: [ 10 factorial ] '); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:51'! docEmpty ^SWDocument new! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:50'! docHeader ^SWDocument new add: (SWHeader newText: 'Heading 1' level: 1); add: (SWHeader newText: 'Heading 2' level: 2); add: (SWHeader newText: 'Heading 3' level: 3); add: (SWHeader newText: 'Heading 4' level: 4); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:50'! docHorizontalRule ^SWDocument new add: SWHorizontalRule new; add: (SWParagraph new add: (SWText newText: '_ is parsed as paragraph'); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:50'! docLink ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Internal Links: '); add: (SWLink newTo: page title from: root); add: (SWText newText: ' '); add: ((SWLink newTo: page title from: root) text: 'Internal Link'; yourself); yourself); add: (SWParagraph new add: (SWText newText: 'External Links: '); add: (SWLink newTo: 'http://www.google.ch' from: root); add: (SWText newText: ' '); add: ((SWLink newTo: 'http://www.google.ch' from: root) text: 'External Link'; yourself); yourself); add: (SWParagraph new add: (SWText newText: 'Email Link: '); add: (SWLink newTo: 'renggli@iam.unibe.ch' from: root); add: (SWText newText: ' '); add: ((SWLink newTo: 'renggli@iam.unibe.ch' from: root) text: 'Email Link'; yourself); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:50'! docList ^SWDocument new add: (SWUnorderedList new add: (SWListItem new add: (SWText newText: 'a long list'); yourself); add: (SWListItem new add: (SWText newText: 'with multiple items'); add: (SWUnorderedList new add: (SWListItem new add: (SWText newText: 'having two'); yourself); add: (SWListItem new add: (SWText newText: 'nested'); yourself); yourself); add: (SWOrderedList new add: (SWListItem new add: (SWText newText: 'sub-lists'); yourself); yourself); yourself); yourself); add: (SWParagraph new); add: (SWUnorderedList new add: (SWListItem new add: (SWText newText: 'another list') yourself); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:49'! docParagraph ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Nulla quis urna. Vestibulum turpis. Duis non mauris non sapien consectetuer vulputate. Duis quis pede. Nullam libero. Mauris ut turpis. Nulla mattis elementum nulla. Duis pretium magna et sem. Phasellus blandit. Ut non dolor at pede auctor semper. Donec semper dignissim ipsum. Nunc ultrices dui id ligula. Pellentesque neque. Aenean placerat nunc ut diam. Vivamus luctus magna vel velit. Donec ultricies orci eget erat. Nulla elementum ligula non est.'); yourself); add: (SWParagraph new); add: (SWParagraph new add: (SWText newText: 'Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Nulla quis urna. Vestibulum turpis. Duis non mauris non sapien consectetuer vulputate. Duis quis pede. Nullam libero. Mauris ut turpis. Nulla mattis elementum nulla. Duis pretium magna et sem. Phasellus blandit. Ut non dolor at pede auctor semper. Donec semper dignissim ipsum. Nunc ultrices dui id ligula. Pellentesque neque. Aenean placerat nunc ut diam. Vivamus luctus magna vel velit. Donec ultricies orci eget erat. Nulla elementum ligula non est.'); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:49'! docPreformatted ^SWDocument new add: (SWPreformatted new add: (SWText newText: 'A line'); add: (SWText newText: ' A line with 3 spaces'); add: (SWText newText: ' A line with a tab'); yourself); add: (SWParagraph new); add: (SWPreformatted new add: (SWText newText: 'Another line'); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/22/2003 16:49'! docTable ^SWDocument new add: (SWTable new add: (SWTableRow new add: (SWTableCell new add: (SWText newText: 'a11'); yourself); add: (SWTableCell new add: (SWText newText: 'a12'); yourself); yourself); add: (SWTableRow new add: (SWTableCell new add: (SWText newText: 'a21'); yourself); add: (SWTableCell new add: (SWText newText: 'a22'); yourself); yourself); yourself); add: (SWParagraph new); add: (SWTable new add: (SWTableRow new add: (SWTableCell new add: (SWText newText: 'a'); yourself); yourself); yourself); yourself! ! !SWParserTests methodsFor: 'resources-doc' stamp: 'chbu 10/25/2003 21:27'! docText ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Default char-set: abcdefghijklmnopqrstuvwxyz... ABCDEFGHIJKLMNOPQRSTUVWXYZ... 0123456789...'); yourself); add: (SWParagraph new add: (SWText newText: 'Special char-set: ��악��, 燃��, ˈ��, ��, ��, $��, !!"#%&֤�ʱ�?�, <>{}(), ��'); yourself); add: (SWParagraph new add: (SWText newText: 'Wiki char-set: !!_#-|=]@:<>\*'); yourself); add: (SWParagraph new add: (SWText newText: 'Html char-set: strong strong, emph'); yourself); yourself! ! !SWParserTests methodsFor: 'resources-wiki'! wikiCode ^'[ 10 factorial ] [ 10 factorial isZero ifTrue: [ 10 factorial ] ]'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiEmpty ^String new! ! !SWParserTests methodsFor: 'resources-wiki'! wikiHeader ^'!!Heading 1 !!!!Heading 2 !!!!!!Heading 3 !!!!!!!!Heading 4'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiHorizontalRule ^'_ _ is parsed as paragraph'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiLink ^'Internal Links: *Page* *Internal Link>Page* External Links: *http://www.google.ch* *External Link>http://www.google.ch* Email Link: *renggli@iam.unibe.ch* *Email Link>renggli@iam.unibe.ch*'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiList ^'-a long list -with multiple items --having two --nested -#sub-lists -another list'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiParagraph ^'Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Nulla quis urna. Vestibulum turpis. Duis non mauris non sapien consectetuer vulputate. Duis quis pede. Nullam libero. Mauris ut turpis. Nulla mattis elementum nulla. Duis pretium magna et sem. Phasellus blandit. Ut non dolor at pede auctor semper. Donec semper dignissim ipsum. Nunc ultrices dui id ligula. Pellentesque neque. Aenean placerat nunc ut diam. Vivamus luctus magna vel velit. Donec ultricies orci eget erat. Nulla elementum ligula non est. Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Nulla quis urna. Vestibulum turpis. Duis non mauris non sapien consectetuer vulputate. Duis quis pede. Nullam libero. Mauris ut turpis. Nulla mattis elementum nulla. Duis pretium magna et sem. Phasellus blandit. Ut non dolor at pede auctor semper. Donec semper dignissim ipsum. Nunc ultrices dui id ligula. Pellentesque neque. Aenean placerat nunc ut diam. Vivamus luctus magna vel velit. Donec ultricies orci eget erat. Nulla elementum ligula non est.'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiPreformatted ^'=A line = A line with 3 spaces = A line with a tab =Another line'! ! !SWParserTests methodsFor: 'resources-wiki'! wikiTable ^'|a11|a12 |a21|a22 |a'! ! !SWParserTests methodsFor: 'resources-wiki' stamp: 'chbu 10/22/2003 16:41'! wikiText ^'Default char-set: abcdefghijklmnopqrstuvwxyz... ABCDEFGHIJKLMNOPQRSTUVWXYZ... 0123456789... Special char-set: ��악��, 燃��, ˈ��, ��, ��, $��, !!"#%&֤�ʱ�?�, <>{}(), �� Wiki char-set: !!_#-|=]@:<>\\* Html char-set: strong strong, emph'! ! !SWParserTests methodsFor: 'resources' stamp: 'chbu 10/22/2003 20:02'! resourcesForDoc ^self selectors collect: [ :each | | string | string _ each displayString. self perform: ('doc' , (string copyFrom: 3 to: string size)) asSymbol ]! ! !SWParserTests methodsFor: 'resources' stamp: 'chbu 10/22/2003 20:05'! resourcesForHtml ^self selectors collect: [ :each | | string | string _ each displayString. self perform: ('html' , (each copyFrom: 3 to: string size)) asSymbol ]! ! !SWParserTests methodsFor: 'resources' stamp: 'chbu 10/22/2003 20:03'! resourcesForWiki ^self selectors collect: [ :each | | string | string _ each displayString. self perform: ('wiki' , (each copyFrom: 3 to: string size)) asSymbol ]! ! !SWParserTests methodsFor: 'resources' stamp: 'chbu 10/22/2003 16:52'! selectors ^#( SWCode SWEmpty SWHeader SWHorizontalRule SWLink SWList SWParagraph SWPreformatted SWTable SWText )! ! !SWParserTests methodsFor: 'utilities' stamp: 'chbu 10/22/2003 16:52'! compareDoc: aFirstDoc with: aSecondDoc self assert: aFirstDoc class = aSecondDoc class. (aFirstDoc isKindOf: SWDocumentComposite) ifTrue: [ self assert: aFirstDoc children size = aSecondDoc children size. aFirstDoc children with: aSecondDoc children do: [ :first :second | self compareDoc: first with: second ] ] ifFalse: [ (aFirstDoc isKindOf: Text) ifTrue: [ self assert: aFirstDoc text = aSecondDoc text ] ]! ! !SWParserTests methodsFor: 'utilities' stamp: 'chbu 10/22/2003 16:52'! parseWiki: aString ^SWWikiParser parse: aString readStream for: action! ! !SWParserTests methodsFor: 'utilities' stamp: 'chbu 10/22/2003 16:52'! renderHtml: aDocument root document: aDocument. ^(SWVisitorRendererHtml render: root with: action) contents! ! !SWParserTests methodsFor: 'utilities' stamp: 'chbu 10/22/2003 16:52'! renderWiki: aDocument root document: aDocument. ^(SWVisitorRendererWiki render: root) contents! ! !SWParserTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:39'! setUp page := SWPage title: 'Page'. root := SWFolder title: 'Root'. root add: page. request := SWRequest server: SWServer new. request user: SWServer new defaultUserAdministrator. action := SWPageView request: request structure: root. prettyPrint := SWHtmlWriteStream isPrettyPrint. SWHtmlWriteStream prettyPrint: false.! ! !SWParserTests methodsFor: 'running' stamp: 'chbu 10/22/2003 16:52'! tearDown SWHtmlWriteStream prettyPrint: prettyPrint.! ! !SWPropertyTests methodsFor: 'testing-accessing'! testAt self assert: (manager at: #title) == propertyTitle. self assert: (manager at: #user) == propertyUser. self assert: (manager at: #unknow) == nil. self assert: (manager at: #title ifAbsent: [ true ]) == propertyTitle. self assert: (manager at: #user ifAbsent: [ true ]) == propertyUser. self assert: (manager at: #unknow ifAbsent: [ true ]) == true.! ! !SWPropertyTests methodsFor: 'testing-accessing'! testAtPut self assert: (manager at: #title put: (propertyTitle := 'PowerBook')) == propertyTitle. self assert: (manager at: #title) == propertyTitle. self assert: (manager size) = 2. self assert: (manager at: #unknown put: true) == true. self assert: (manager at: #unknown) == true. self assert: (manager size) = 3.! ! !SWPropertyTests methodsFor: 'testing-accessing'! testRemove self assert: (manager remove: #title) == propertyTitle. self assert: (manager remove: #title) isNil. self deny: (manager includes: #title). self assert: (manager remove: #user ifAbsent: [ true ]) == propertyUser. self assert: (manager remove: #user ifAbsent: [ true ]). self deny: (manager includes: #use).! ! !SWPropertyTests methodsFor: 'testing'! testCopying self assert: manager copy ~~ manager. self assert: manager copy properties ~~ manager properties. manager copy properties asArray with: manager properties asArray do: [ :a :b | self assert: a ~~ b ]! ! !SWPropertyTests methodsFor: 'testing'! testEnumerating | count | count := 0. manager do: [ :key :value | self assert: (key = #title or: [ key = #user ]). self assert: (value == propertyTitle or: [ value == propertyUser ]). count := count + 1 ]. self assert: count = 2! ! !SWPropertyTests methodsFor: 'testing-testing'! testIncludes self assert: (manager includes: #title). self assert: (manager includes: #user). self deny: (manager includes: #unknow).! ! !SWPropertyTests methodsFor: 'testing-testing'! testSize self assert: manager size = 2! ! !SWPropertyTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:41'! setUp manager := SWPropertyManager new at: #title put: (propertyTitle := 'SmallWiki'); at: #user put: (propertyUser := 'Lukas Renggli'); yourself! ! !SWRecentChanges methodsFor: 'rendering' stamp: 'chbu 10/22/2003 17:28'! renderContent | changes keys | changes := (SWVisitorRecentChanges collect: self structure) collection groupedBy: [ :item | item timestamp asDate ]. keys := changes keys asSortedCollection: [ :date1 :date2 | date1 > date2 ]. keys := keys copyFrom: 1 to: (10 min: keys size). keys do: [ :key | self renderDate: key changes: (changes at: key) ]! ! !SWRecentChanges methodsFor: 'rendering'! renderDate: aDate changes: aCollection | structures | structures := aCollection asSortedCollection: [:item1 :item2 | item1 timestamp < item2 timestamp]. html heading: aDate printString level: 2. html unorderedList: [structures do: [:item | html listItem: [html render: item timestamp asTime. html render: ' - '. html anchorWithUrl: item url do: item title]]]! ! !SWRecentChanges methodsFor: 'accessing-heading'! headingStructure ^'to ' , super headingStructure! ! !SWRecentChanges class methodsFor: 'accessing'! title ^'Changes'! ! !SWRedirectAction methodsFor: 'action'! execute self isEnabled ifTrue: [ response redirectTo: self target url ] ifFalse: [ response redirectTo: self structure url ]! ! !SWRedirectAction methodsFor: 'testing'! isEnabled ^self target notNil! ! !SWRedirectAction methodsFor: 'accessing'! target self subclassResponsibility! ! !SWNextStructure methodsFor: 'accessing'! target ^structure next! ! !SWNextStructure class methodsFor: 'accessing'! title ^'Next'! ! !SWParentStructure methodsFor: 'accessing'! target ^structure parent! ! !SWParentStructure class methodsFor: 'accessing'! title ^'Parent'! ! !SWPreviousStructure methodsFor: 'accessing'! target ^structure previous! ! !SWPreviousStructure class methodsFor: 'accessing'! title ^'Prevoius'! ! !SWRequest methodsFor: 'private-accessing'! response: aResponse response := aResponse! ! !SWRequest methodsFor: 'private-accessing'! server: aServer server := aServer! ! !SWRequest methodsFor: 'private-accessing'! user: anUser user := anUser! ! !SWRequest methodsFor: 'accessing-headers'! headerAt: aKey ^self headerAt: aKey ifAbsent: [ nil ]! ! !SWRequest methodsFor: 'accessing-headers'! headerAt: aKey ifAbsent: aBlock ^headers at: aKey asUppercase ifAbsent: aBlock! ! !SWRequest methodsFor: 'accessing-headers'! headerIncludes: aKey ^headers includesKey: aKey asUppercase! ! !SWRequest methodsFor: 'accessing-headers'! headers ^headers! ! !SWRequest methodsFor: 'accessing-headers'! headers: aDictionary headers := aDictionary! ! !SWRequest methodsFor: 'accessing-fields'! fieldAt: aKey ^self fieldAt: aKey ifAbsent: [ nil ]! ! !SWRequest methodsFor: 'accessing-fields'! fieldAt: aKey ifAbsent: aBlock ^fields at: aKey ifAbsent: aBlock! ! !SWRequest methodsFor: 'accessing-fields'! fieldIncludes: aKey ^fields includesKey: aKey! ! !SWRequest methodsFor: 'accessing-fields'! fields ^fields! ! !SWRequest methodsFor: 'accessing-fields'! fields: aDictionary fields := aDictionary! ! !SWRequest methodsFor: 'accessing-cookies'! cookieAt: aKey ^self cookieAt: aKey ifAbsent: [ nil ]! ! !SWRequest methodsFor: 'accessing-cookies'! cookieAt: aKey ifAbsent: aBlock ^cookies at: aKey ifAbsent: aBlock! ! !SWRequest methodsFor: 'accessing-cookies'! cookieIncludes: aKey ^cookies includesKey: aKey! ! !SWRequest methodsFor: 'accessing-cookies'! cookies ^cookies! ! !SWRequest methodsFor: 'accessing-cookies'! cookies: aDictionary cookies := aDictionary! ! !SWRequest methodsFor: 'accessing-url'! url ^url! ! !SWRequest methodsFor: 'accessing-url'! url: aString | stream part | url := aString. urlparsed := OrderedCollection new. stream := aString readStream. [ stream atEnd ] whileFalse: [ part := stream upTo: $/. part isEmpty ifFalse: [ urlparsed add: part ] ]! ! !SWRequest methodsFor: 'accessing-url'! urlAtEnd ^urlparsed isEmpty! ! !SWRequest methodsFor: 'accessing-url'! urlNext ^urlparsed removeFirst! ! !SWRequest methodsFor: 'accessing-user'! updateAuthentication (self headerIncludes: 'authorization') ifTrue: [ self updateAuthenticationFromHeader ]. (self cookieIncludes: 'authorization') ifTrue: [ self updateAuthenticationFromCookies ]. self updateUser.! ! !SWRequest methodsFor: 'accessing-user'! updateAuthenticationFromCookies | stream | username := password := nil. stream := (self cookieAt: 'authorization') readStream. username := stream upTo: $:. stream atEnd ifFalse: [ password := stream upToEnd ]! ! !SWRequest methodsFor: 'accessing-user'! updateAuthenticationFromHeader | readStream method | username := password := nil. readStream := (self headerAt: 'authorization') readStream. method := readStream upTo: $ . readStream atEnd ifFalse: [ (method sameAs: 'basic') ifTrue: [ self basicAuthentication: readStream upToEnd ] ]! ! !SWRequest methodsFor: 'accessing-user'! updateRoles: aCollection "Update the roles of the user performing the current request. The roles are given in aCollection and might be nil, if nothing should be updated. See User>>updateRoles: for additional information." aCollection isNil ifFalse: [ user := user updateRoles: aCollection ]. ^user! ! !SWRequest methodsFor: 'accessing-user'! user user isNil ifTrue: [ user := server userAnonymous ]. ^user! ! !SWRequest methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:29'! response response isNil ifTrue: [ response := SWResponse server: self server ]. ^response! ! !SWRequest methodsFor: 'accessing'! server ^server! ! !SWRequest methodsFor: 'accessing-authentification'! password ^password! ! !SWRequest methodsFor: 'accessing-authentification'! username ^username! ! !SWRequest methodsFor: 'private' stamp: 'chbu 10/23/2003 18:07'! basicAuthentication: aString | readStream | readStream := (Base64MimeConverter mimeDecodeToChars: aString readStream) upToEnd asString readStream. username := readStream upTo: $:. readStream atEnd ifFalse: [ password := readStream upToEnd ]! ! !SWRequest methodsFor: 'private'! updateUser user := self server userAt: self username. (user validatePassword: self password) ifFalse: [ user := self server userAnonymous ]! ! !SWRequest methodsFor: 'testing'! isAuthenticated ^username notNil and: [ password notNil ]! ! !SWRequest class methodsFor: 'instance-creation'! server: aServer ^self new server: aServer; yourself! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationCookie request cookies at: 'authorization' put: 'renggli:sometxing'. request updateAuthentication. self assert: request isAuthenticated. self assert: request username = 'renggli'. self assert: request password = 'sometxing'. self assert: request user == request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationInvalid request headers at: 'AUTHORIZATION' put: 'Basic aW52YWxpZA=='. request updateAuthentication. self assert: request isAuthenticated not. self assert: request username = 'invalid'. self assert: request password isNil. self assert: request user == request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationInvalidPassword request headers at: 'AUTHORIZATION' put: 'Basic cmVuZ2dsaTpzb21ldHhpbmc='. request updateAuthentication. self assert: request isAuthenticated. self assert: request username = 'renggli'. self assert: request password = 'sometxing'. self assert: request user == request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationTest self deny: request isAuthenticated. self assert: request user == request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationUnknown request headers at: 'AUTHORIZATION' put: 'Digest realm="renggli@student.unibe.ch", nonce="dcd98b7102dd2f0e8b11d0f600bfb0c093", opaque="5ccc069c403ebaf9f0171e9517f40e41"'. request updateAuthentication. self assert: request isAuthenticated not. self assert: request username isNil. self assert: request password isNil. self assert: request user == request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-authentication'! testAuthenticationValid request headers at: 'AUTHORIZATION' put: 'Basic cmVuZ2dsaTpzb21ldGhpbmc='. request updateAuthentication. self assert: request isAuthenticated. self assert: request username = 'renggli'. self assert: request password = 'something'. self assert: request user username = 'renggli'. self assert: request user ~~ request server userAnonymous.! ! !SWRequestTests methodsFor: 'testing-headers'! testHeadersAbsent self assert: (request headerAt: 'unknown') isNil. self assert: (request headerAt: 'unknown' ifAbsent: [ 'nothing' ]) = 'nothing'. self deny: (request headerIncludes: 'unknown'). self assert: request headers isEmpty! ! !SWRequestTests methodsFor: 'testing-headers'! testHeadersPresent request headers at: 'SOMEKEY' put: 'value'. self assert: (request headerAt: 'somekey') = 'value'. self assert: (request headerAt: 'someKey') = 'value'. self assert: (request headerAt: 'SomeKey') = 'value'. self assert: (request headerAt: 'somekey' ifAbsent: [ nil ]) = 'value'. self assert: (request headerAt: 'someKey' ifAbsent: [ nil ]) = 'value'. self assert: (request headerAt: 'SomeKey' ifAbsent: [ nil ]) = 'value'. self assert: (request headerIncludes: 'somekey'). self assert: (request headerIncludes: 'someKey'). self assert: (request headerIncludes: 'SomeKey'). self assert: request headers size = 1! ! !SWRequestTests methodsFor: 'testing-cookies'! testCookiesAbsent self assert: (request cookieAt: 'unknown') isNil. self assert: (request cookieAt: 'unknown' ifAbsent: [ 'nothing' ]) = 'nothing'. self deny: (request cookieIncludes: 'unknown'). self assert: request cookies isEmpty! ! !SWRequestTests methodsFor: 'testing-cookies'! testCookiesPresent request cookies at: 'somekey' put: 'value'. self assert: (request cookieAt: 'somekey') = 'value'. self assert: (request cookieAt: 'somekey' ifAbsent: [ nil ]) = 'value'. self assert: (request cookieIncludes: 'somekey'). self assert: request cookies size = 1! ! !SWRequestTests methodsFor: 'testing-url'! testUrlEmpty request url: String new. self assert: request url isEmpty. self assert: request urlAtEnd! ! !SWRequestTests methodsFor: 'testing-url'! testUrlLong request url: '/world/europe/switzerland/berne/university/iam/scg'. self deny: request url isEmpty. self assert: request urlAtEnd not. self assert: request urlNext = 'world'. self assert: request urlAtEnd not. self assert: request urlNext = 'europe'. self assert: request urlAtEnd not. self assert: request urlNext = 'switzerland'. self assert: request urlAtEnd not. self assert: request urlNext = 'berne'. self assert: request urlAtEnd not. self assert: request urlNext = 'university'. self assert: request urlAtEnd not. self assert: request urlNext = 'iam'. self assert: request urlAtEnd not. self assert: request urlNext = 'scg'. self assert: request urlAtEnd! ! !SWRequestTests methodsFor: 'testing-url'! testUrlRoot request url: '/'. self assert: request url size = 1. self assert: request urlAtEnd.! ! !SWRequestTests methodsFor: 'testing-fields'! testFieldsAbsent self assert: (request fieldAt: 'unknown') isNil. self assert: (request fieldAt: 'unknown' ifAbsent: [ 'nothing' ]) = 'nothing'. self deny: (request fieldIncludes: 'unknown'). self assert: request fields isEmpty! ! !SWRequestTests methodsFor: 'testing-fields'! testFieldsPresent request fields at: 'somekey' put: 'value'. self assert: (request fieldAt: 'somekey') = 'value'. self assert: (request fieldAt: 'somekey' ifAbsent: [ nil ]) = 'value'. self assert: (request fieldIncludes: 'somekey'). self assert: request fields size = 1! ! !SWRequestTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:41'! setUp server := SWServer new userAdd: (SWUser username: 'renggli' password: 'something'); yourself. request := (SWRequest server: server) cookies: Dictionary new; fields: Dictionary new; headers: Dictionary new; yourself! ! !SWRequestTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 17:30'! testResponse self deny: request response isNil. self assert: request response class = SWResponse! ! !SWResourceEdit methodsFor: 'accessing'! data ^data! ! !SWResourceEdit methodsFor: 'accessing'! data: aString data := aString! ! !SWResourceEdit methodsFor: 'accessing'! data: aDataString mime: aMimeString self data: aDataString. self mime: aMimeString.! ! !SWResourceEdit methodsFor: 'accessing'! embed embed isNil ifTrue: [ embed := false ]. ^embed! ! !SWResourceEdit methodsFor: 'accessing'! embed: aBoolean embed := aBoolean! ! !SWResourceEdit methodsFor: 'accessing'! mime mime isNil ifTrue: [ mime := structure mimetype. mime isEmpty ifTrue: [ mime := 'unknown' ] ]. ^mime! ! !SWResourceEdit methodsFor: 'accessing'! mime: aString mime := aString! ! !SWResourceEdit methodsFor: 'rendering'! renderFields super renderFields. html tableRow: [ html tableHeading: 'Data:'. html tableData: [ html fileUploadWithCallback: #data:mime: ] ]. html tableRow: [ html tableHeading: 'Embedding:'. html tableData: [ html label: [ html checkboxWithValue: structure isEmbedded callback: #embed:. html text: 'Enabled' ] ] ].! ! !SWResourceEdit methodsFor: 'rendering'! renderForm: aBlock html formMultipart: aBlock.! ! !SWResourceEdit methodsFor: 'rendering'! renderSummary super renderSummary. html tableRow: [ html tableHeading: [ html text: 'Size:' ]. html tableData: [ html text: structure data size printString , ' Byte' ] ]. html tableRow: [ html tableHeading: [ html text: 'Mimetype:' ]. html tableData: [ html text: self mime ] ].! ! !SWResourceEdit methodsFor: 'utilities'! privateSave super privateSave. structure embed: self embed. (data isNil or: [ data isEmpty ]) ifFalse: [ structure mimetype: self mime. structure data: self data ].! ! !SWResourceEdit methodsFor: 'configuration'! defaultTarget ^request fieldAt: 'target' ifAbsent: [ super defaultTarget ]! ! !SWResourceEdit class methodsFor: 'accessing'! title ^'Edit'! ! !SWResourceHistory methodsFor: 'rendering'! renderVersion: aStructure super renderVersion: aStructure. html tableRow: [ html tableHeading: 'Size:'. html tableData: aStructure data size printString, ' Byte' ]. html tableRow: [ html tableHeading: 'Mimetype:'. html tableData: aStructure mimetype ].! ! !SWResourceHistory class methodsFor: 'accessing'! title ^'History'! ! !SWResponse methodsFor: 'accessing-cookies'! cookieAt: aKey put: aValue ^cookies at: aKey put: aValue! ! !SWResponse methodsFor: 'accessing-cookies'! cookieRemove: aKey ^cookies at: aKey put: nil! ! !SWResponse methodsFor: 'accessing-cookies'! cookies ^cookies! ! !SWResponse methodsFor: 'accessing-cookies'! cookies: aStream cookies := aStream! ! !SWResponse methodsFor: 'configuration'! defaultCookies ^Dictionary new! ! !SWResponse methodsFor: 'configuration' stamp: 'chbu 10/24/2003 16:48'! defaultHeaders ^Dictionary new at: 'Cache-Control' put: 'no-cache'; at: 'X-Wiki-Engine' put: SWSmallWiki versionString; at: 'X-Wiki-Copyright' put: SWSmallWiki copyrightString; yourself! ! !SWResponse methodsFor: 'configuration'! defaultStatus ^self class statusOk! ! !SWResponse methodsFor: 'configuration' stamp: 'chbu 10/22/2003 17:31'! defaultStream ^SWHtmlWriteStream on: String new! ! !SWResponse methodsFor: 'configuration'! defaultType ^'text/html'! ! !SWResponse methodsFor: 'accessing-headers'! headerAt: aKey put: aValue headers at: aKey put: aValue! ! !SWResponse methodsFor: 'accessing-headers'! headers ^headers! ! !SWResponse methodsFor: 'accessing-headers'! headers: aDictionary headers := aDictionary! ! !SWResponse methodsFor: 'accessing'! server ^server! ! !SWResponse methodsFor: 'accessing'! status status isNil ifTrue: [ status := self defaultStatus ]. ^status! ! !SWResponse methodsFor: 'accessing'! status: anInteger status := anInteger! ! !SWResponse methodsFor: 'accessing'! stream ^stream! ! !SWResponse methodsFor: 'accessing'! stream: aWriteStream stream := aWriteStream! ! !SWResponse methodsFor: 'accessing'! type type isNil ifTrue: [ type := self defaultType ]. ^type! ! !SWResponse methodsFor: 'accessing'! type: aString type := aString! ! !SWResponse methodsFor: 'actions'! redirectTo: aString self status: self class statusFound. self headerAt: 'Location' put: aString! ! !SWResponse methodsFor: 'actions'! unauthorized self status: self class statusUnauthorized. self headerAt: 'WWW-Authenticate' put: 'Basic realm="SmallWiki"'! ! !SWResponse methodsFor: 'testing'! isRedirect ^(status == self class statusFound) or: [ status == self class statusMoved or: [ status == self class statusNotModified or: [ status == self class statusSeeOther ] ] ]! ! !SWResponse methodsFor: 'initialize'! initialize headers := self defaultHeaders. cookies := self defaultCookies. stream := self defaultStream.! ! !SWResponse methodsFor: 'private'! server: aServer server := aServer. stream server: aServer.! ! !SWResponse class methodsFor: 'status-clienterror'! statusBadRequest "Impossible request or syntax error." ^400! ! !SWResponse class methodsFor: 'status-clienterror'! statusForbidden "Authorization will not help." ^403! ! !SWResponse class methodsFor: 'status-clienterror'! statusNotFound "A document with that URL doesn't exist." ^404! ! !SWResponse class methodsFor: 'status-clienterror'! statusPaymentRequired "Request should be retried with proper charge-to header." ^402! ! !SWResponse class methodsFor: 'status-clienterror'! statusUnauthorized "Request should be retried with proper authorization header. This is the response which triggers the browser to pop up the dialog requesting your username and password." ^401! ! !SWResponse class methodsFor: 'status-success'! statusAccepted "Request accepted for asynchronous processing." ^202! ! !SWResponse class methodsFor: 'status-success'! statusCreated "Following a POST command, this indicates success, but the text of the response line indicates the URL of the new document." ^201! ! !SWResponse class methodsFor: 'status-success'! statusNoResponse "Used for scripts that don't return a visible result." ^204! ! !SWResponse class methodsFor: 'status-success'! statusOk "Request was processed without any error conditions." ^200! ! !SWResponse class methodsFor: 'status-success'! statusPartialInformation "Returned information may be cached or private." ^203! ! !SWResponse class methodsFor: 'status-servererror'! statusInternalError "A rather meaningless catch-all message that indicates that the site admin goofed on their CGI program." ^500! ! !SWResponse class methodsFor: 'status-servererror'! statusNotImplemented "Another rather ambiguous message, typically meaning that you tried to execute something that was not executable, or POST to someting that was not a CGI program, or something similar." ^501! ! !SWResponse class methodsFor: 'status-servererror'! statusTimedOut "Not in the HTTP spec, but implemented by some HTTP servers." ^502! ! !SWResponse class methodsFor: 'status-redirection'! statusFound "Same as move, except that linking to the found address doesn't make much sense, since the document URL is expected to change. This is the code that the httpd returns for a cgi script whose output contained a Location: header." ^302! ! !SWResponse class methodsFor: 'status-redirection'! statusMoved "Browsers with link editing capabilities should automatically link to the new reference. The response contains one or more header lines of the form URI: url string CrLf which specify alternative addresses for the object in question. The string is an optional comment field." ^301! ! !SWResponse class methodsFor: 'status-redirection'! statusNotModified "Use the local copy if you cached it. Often seen when using the HEAD method, rather than the GET method." ^304! ! !SWResponse class methodsFor: 'status-redirection'! statusSeeOther "Same as found, but a different method may be used to access the document; details about the method are sent in the message body." ^303! ! !SWResponse class methodsFor: 'instance creation'! new ^super new initialize! ! !SWResponse class methodsFor: 'instance creation'! server: aServer ^self new server: aServer; yourself! ! !SWResponseTests methodsFor: 'testing-accessing'! testHeaders response headerAt: 'key' put: 'value'. self assert: (response headers at: 'key') = 'value'! ! !SWResponseTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:32'! testStatus self deny: response status isNil. self assert: response status = SWResponse statusOk. response status: SWResponse statusNotFound. self deny: response status isNil. self assert: response status = SWResponse statusNotFound! ! !SWResponseTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:32'! testStream self deny: response stream isNil. self assert: response stream class = SWHtmlWriteStream. response stream: (WriteStream on: String new). self deny: response stream isNil. self assert: response stream class = WriteStream.! ! !SWResponseTests methodsFor: 'testing-accessing'! testType self deny: response type isNil. self assert: response type = 'text/html'. response status: 'plain/text'. self deny: response status isNil. self assert: response status = 'plain/text'! ! !SWResponseTests methodsFor: 'testing-action' stamp: 'chbu 10/22/2003 17:33'! testRedirect response redirectTo: 'http://renggli.freezope.org'. self assert: (response headers at: 'Location') = 'http://renggli.freezope.org'. self assert: response status = SWResponse statusFound! ! !SWResponseTests methodsFor: 'testing-action' stamp: 'chbu 10/22/2003 17:33'! testUnauthorized response unauthorized. self assert: (response headers includesKey: 'WWW-Authenticate'). self assert: ('basic realm="*"' match: (response headers at: 'WWW-Authenticate')). self assert: response status = SWResponse statusUnauthorized! ! !SWResponseTests methodsFor: 'testing-callbacks' stamp: 'chbu 10/22/2003 17:33'! testCallbacksEvaluationAnchor | anchor request | anchor := nil. response stream anchorWithAction: [anchor := true] to: '' do: 'Anchor'. self deny: response server callback isEmpty. self assert: response server callback size = 1. request := SWRequest server: response server. request fields: response headers. self assert: anchor isNil. (SWAction request: request structure: request server root) executeCallback. self assert: anchor isNil. request fields: ((Dictionary new) at: 'callback' put: '1'; yourself). (SWAction request: request structure: request server root) executeCallback. self assert: anchor! ! !SWResponseTests methodsFor: 'testing-callbacks' stamp: 'chbu 10/22/2003 17:33'! testCallbacksEvaluationForm | submits request posts | submits := Array new: 100. posts := Dictionary new. 1 to: 100 do: [ :index | response stream submitButtonWithAction: [ :action :value | submits at: value put: true. "evaluation order wrong if assertion failure here" 1 to: value do: [ :item | self assert: (submits at: item) ]. value + 1 to: 100 do: [ :item | self assert: (submits at: item) isNil ] ]. posts at: 'form-callback-' , index displayString put: index asNumber ]. self deny: response server callback isEmpty. self assert: response server callback size = 100. request := SWRequest server: response server. request fields: response headers. self assert: (submits allSatisfy: [ :item | item isNil ]). (SWAction request: request structure: request server root) executeCallback. self assert: (submits allSatisfy: [ :item | item isNil ]). request fields: posts. (SWAction request: request structure: request server root) executeCallback. self assert: (submits allSatisfy: [ :item | item = true ]).! ! !SWResponseTests methodsFor: 'running' stamp: 'chbu 10/22/2003 17:33'! setUp response := SWResponse server: SWServer new! ! !SWSearch methodsFor: 'execute' stamp: 'chbu 10/22/2003 17:34'! executeSearch results := self expression isEmpty ifTrue: [ Array new ] ifFalse: [ (SWVisitorSearch collect: self startStructure expression: self fullExpression ignoreCase: self ignoreCase) collection ]! ! !SWSearch methodsFor: 'accessing'! expression ^expression! ! !SWSearch methodsFor: 'accessing'! expression: aString expression := aString! ! !SWSearch methodsFor: 'accessing'! ignoreCase ^ignoreCase! ! !SWSearch methodsFor: 'accessing'! ignoreCase: aBoolean ignoreCase := aBoolean! ! !SWSearch methodsFor: 'accessing'! results ^results! ! !SWSearch methodsFor: 'accessing'! results: aCollection results := aCollection! ! !SWSearch methodsFor: 'accessing'! root ^root! ! !SWSearch methodsFor: 'accessing'! root: aBoolean root := aBoolean! ! !SWSearch methodsFor: 'accessing-heading'! headingStructure ^'in ' , super headingStructure! ! !SWSearch methodsFor: 'rendering'! renderButton html tableRowWith: nil with: [ html submitButtonWithAction: #executeSearch text: 'search' ]! ! !SWSearch methodsFor: 'rendering'! renderContent self renderForm: [ html table: [ self renderExpression. self renderOptions. self renderButton ] ]. self results isEmpty ifFalse: [ self renderResults ].! ! !SWSearch methodsFor: 'rendering'! renderExpression html tableRow: [ html attributeAt: #width: put: 100. html tableHeading: 'Search for:'. html tableData: [ html attributeAt: #size put: 50. html textInputWithValue: self expression callback: #expression: ] ]! ! !SWSearch methodsFor: 'rendering'! renderOptions html tableRow: [ html attributeAt: #valign put: #top. html tableHeading: 'Options:'. html tableData: [ html label: [ html checkboxWithValue: self ignoreCase callback: #ignoreCase:. html text: 'Ignore character case' ]. html break. html label: [ html checkboxWithValue: self root callback: #root:. html text: 'Start in the root-folder' ] ] ]! ! !SWSearch methodsFor: 'rendering'! renderResults html orderedList: [ self results do: [ :each | html listItem: [ html anchorWithUrl: each url do: each title ] ] ]! ! !SWSearch methodsFor: 'accessing-calculated'! fullExpression ^String streamContents: [ :stream | stream nextPut: $*; nextPutAll: self expression trimBlanks; nextPut: $* ]! ! !SWSearch methodsFor: 'accessing-calculated'! startStructure ^self root ifTrue: [ structure root ] ifFalse: [ structure ]! ! !SWSearch methodsFor: 'initialization'! initialize super initialize. self expression: String new. self results: Array new. self ignoreCase: true. self root: false.! ! !SWSearch class methodsFor: 'accessing'! title ^'Search'! ! !SWSecurityInformation methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:43'! assertPermission: aPermission "Assert that aPermission is valid in the receiver, throws a UnauthorizedError if the permission is missing." (self hasPermission: aPermission) ifFalse: [ SWUnauthorizedError signal"With: self" ]! ! !SWSecurityInformation methodsFor: 'testing'! hasPermission: aPermission "If the receiver has got aPremission return true, else return false." self subclassResponsibility! ! !SWSecurityInformation methodsFor: 'initialization'! initialize! ! !SWSecurityInformation methodsFor: 'as yet unclassified' stamp: 'chbu 10/23/2003 18:10'! copy ^super copy postCopy! ! !SWPermission methodsFor: 'comparing'! = aPermission ^self class = aPermission class and: [ name = aPermission name ]! ! !SWPermission methodsFor: 'comparing'! hash ^name hash! ! !SWPermission methodsFor: 'copying'! copy "Answer the receiver, because Permission's should be unique." ^self! ! !SWPermission methodsFor: 'copying'! shallowCopy "Answer the receiver, because Permission's should be unique." ^self! ! !SWPermission methodsFor: 'testing'! hasPermission: aPermission ^aPermission = self! ! !SWPermission methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPut: $(; print: self name; nextPut: $).! ! !SWPermission methodsFor: 'private'! name: aString name := aString! ! !SWPermission methodsFor: 'accessing'! name ^name! ! !SWRole methodsFor: 'accessing'! name ^self subclassResponsibility! ! !SWRole methodsFor: 'accessing'! permissions ^self subclassResponsibility! ! !SWAdminRole methodsFor: 'testing'! hasPermission: aPermission ^true! ! !SWAdminRole methodsFor: 'accessing'! name ^'administrator'! ! !SWAdminRole methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:04'! permissions ^SWStructure allSubclasses inject: Set new into: [ :collection :each | collection addAll: each permissions; yourself ]! ! !SWAdminRole methodsFor: 'comparing'! = aRole ^self class = aRole class! ! !SWAdminRole methodsFor: 'comparing'! hash ^self class hash! ! !SWBasicRole methodsFor: 'accessing-permissions'! add: aPermission permissions add: aPermission! ! !SWBasicRole methodsFor: 'accessing-permissions'! addAll: aCollection permissions addAll: aCollection! ! !SWBasicRole methodsFor: 'accessing-permissions'! do: aBlock ^permissions do: aBlock! ! !SWBasicRole methodsFor: 'accessing-permissions'! remove: aPermission ^permissions remove: aPermission ifAbsent: [ nil ]! ! !SWBasicRole methodsFor: 'private'! name: aString name := aString! ! !SWBasicRole methodsFor: 'accessing'! name ^name! ! !SWBasicRole methodsFor: 'accessing'! permissions ^permissions! ! !SWBasicRole methodsFor: 'copying'! postCopy super postCopy. permissions := permissions copy.! ! !SWBasicRole methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPut: $(; print: self name; nextPut: $).! ! !SWBasicRole methodsFor: 'initialization'! initialize super initialize. permissions := Set new.! ! !SWBasicRole methodsFor: 'comparing'! = aRole ^self class = aRole class and: [ name = aRole name ]! ! !SWBasicRole methodsFor: 'comparing'! hash ^name hash! ! !SWBasicRole methodsFor: 'testing'! hasPermission: aPermisson ^self permissions includes: aPermisson! ! !SWSecurityInformation class methodsFor: 'instance-creation'! new ^super new initialize! ! !SWBasicRole class methodsFor: 'instance creation'! name: aString ^self new name: aString; yourself! ! !SWPermission class methodsFor: 'instance creation'! name: aString ^self new name: aString; yourself.! ! !SWSecurityTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 09:45'! testUserAsserting self shouldnt: [ userLukas assertPermission: permissionView ] raise: SWUnauthorizedError. self shouldnt: [ userLukas assertPermission: permissionEdit ] raise: SWUnauthorizedError. self shouldnt: [ userLukas assertPermission: permissionHistory ] raise: SWUnauthorizedError. self shouldnt: [ userUnknown assertPermission: permissionView ] raise: SWUnauthorizedError. self should: [ userUnknown assertPermission: permissionEdit ] raise: SWUnauthorizedError. self should: [ userUnknown assertPermission: permissionHistory ] raise: SWUnauthorizedError.! ! !SWSecurityTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 09:44'! testUserComparing self assert: (SWUser username: 'lukas' password: 'something') = userLukas. self assert: (SWUser username: 'lukas' password: 'abc') = userLukas. self assert: (SWUser anonymous) = userUnknown. self assert: (SWUser username: 'lukas' password: 'something') hash = userLukas hash. self assert: (SWUser username: 'lukas' password: 'abc') hash = userLukas hash. self assert: (SWUser anonymous) hash = userUnknown hash.! ! !SWSecurityTests methodsFor: 'testing-users'! testUserCopy self assert: userLukas copy ~~ userLukas. self assert: userLukas copy roles ~~ userLukas roles. self assert: userLukas copy username == userLukas username. self assert: userUnknown copy ~~ userUnknown. self assert: userUnknown copy roles ~~ userUnknown roles. self assert: userUnknown copy username == userUnknown username.! ! !SWSecurityTests methodsFor: 'testing-users'! testUserPassword self deny: (userLukas validatePassword: nil). self deny: (userLukas validatePassword: String new). self assert: (userLukas validatePassword: 'something'). self assert: (userUnknown validatePassword: nil). self assert: (userUnknown validatePassword: String new). self assert: (userUnknown validatePassword: 'something').! ! !SWSecurityTests methodsFor: 'testing-users'! testUserRoles self assert: userLukas roles size = 2. self assert: userUnknown roles size = 1. userLukas add: roleAdmin. self assert: userLukas roles size = 2. userUnknown add: roleAdmin. self assert: userUnknown roles size = 2. userUnknown remove: roleAdmin. self assert: userUnknown roles size = 1. userUnknown remove: roleAdmin. self assert: userUnknown roles size = 1.! ! !SWSecurityTests methodsFor: 'testing-users'! testUserTesting self assert: (userLukas hasPermission: permissionView). self assert: (userLukas hasPermission: permissionEdit). self assert: (userLukas hasPermission: permissionHistory). self assert: (userUnknown hasPermission: permissionView). self deny: (userUnknown hasPermission: permissionEdit). self deny: (userUnknown hasPermission: permissionHistory).! ! !SWSecurityTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 09:44'! testUserUpdateRole | newRoleAdmin newRoleAnybody newUserUnknown | "update with role that is not definied does not change anything" newRoleAdmin := (SWBasicRole name: 'Admin') add: permissionView; yourself. newUserUnknown := userUnknown updateRole: newRoleAdmin. self assert: newUserUnknown == userUnknown. self assert: (newUserUnknown hasPermission: permissionView). self deny: (newUserUnknown hasPermission: permissionHistory). self deny: (newUserUnknown hasPermission: permissionEdit). "roles get updated if they are defined within the receiver" newRoleAnybody := (SWBasicRole name: 'Anybody') add: permissionView; add: permissionHistory; yourself. newUserUnknown := userUnknown updateRole: newRoleAnybody. self assert: newUserUnknown ~~ userUnknown. self assert: (newUserUnknown hasPermission: permissionView). self assert: (newUserUnknown hasPermission: permissionHistory). self deny: (newUserUnknown hasPermission: permissionEdit).! ! !SWSecurityTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 09:44'! testUserUpdateRoles | roles newUserUnknown | roles := OrderedCollection with: ((SWBasicRole name: 'Admin') add: permissionView; yourself) with: ((SWBasicRole name: 'Anybody') add: permissionView; add: permissionHistory; yourself). newUserUnknown := userUnknown updateRoles: roles. self assert: newUserUnknown ~~ userUnknown. self assert: (newUserUnknown hasPermission: permissionView). self assert: (newUserUnknown hasPermission: permissionHistory). self deny: (newUserUnknown hasPermission: permissionEdit).! ! !SWSecurityTests methodsFor: 'testing-users'! testUserUsername self assert: userLukas username = 'lukas'. self assert: userUnknown username = 'anonymous'! ! !SWSecurityTests methodsFor: 'testing-roles'! testRoleAccessing self assert: roleAdmin name = 'Administrator'. self assert: roleAnybody name = 'Anybody'! ! !SWSecurityTests methodsFor: 'testing-roles' stamp: 'chbu 10/22/2003 09:43'! testRoleAsserting self shouldnt: [ roleAdmin assertPermission: permissionView ] raise: SWUnauthorizedError. self shouldnt: [ roleAdmin assertPermission: permissionEdit ] raise: SWUnauthorizedError. self shouldnt: [ roleAdmin assertPermission: permissionHistory ] raise: SWUnauthorizedError. self shouldnt: [ roleAnybody assertPermission: permissionView ] raise: SWUnauthorizedError. self should: [ roleAnybody assertPermission: permissionEdit ] raise: SWUnauthorizedError. self should: [ roleAnybody assertPermission: permissionHistory ] raise: SWUnauthorizedError.! ! !SWSecurityTests methodsFor: 'testing-roles' stamp: 'chbu 10/22/2003 09:44'! testRoleComparing self assert: (SWBasicRole name: 'Administrator') = roleAdmin. self assert: (SWBasicRole name: 'Anybody') = roleAnybody. self assert: (SWBasicRole name: 'Administrator') hash = roleAdmin hash. self assert: (SWBasicRole name: 'Anybody') hash = roleAnybody hash.! ! !SWSecurityTests methodsFor: 'testing-roles'! testRoleCopy self assert: roleAdmin copy ~~ roleAdmin. self assert: roleAdmin copy name == roleAdmin name. self assert: roleAdmin copy permissions ~~ roleAdmin permissions. self assert: roleAnybody copy ~~ roleAnybody. self assert: roleAnybody copy name == roleAnybody name. self assert: roleAnybody copy permissions ~~ roleAnybody permissions.! ! !SWSecurityTests methodsFor: 'testing-roles'! testRolePermissions self assert: roleAdmin permissions size = 3. self assert: roleAnybody permissions size = 1. roleAdmin add: permissionView. self assert: roleAdmin permissions size = 3. roleAnybody add: permissionEdit. self assert: roleAnybody permissions size = 2. roleAnybody remove: permissionView. self assert: roleAnybody permissions size = 1. roleAnybody remove: permissionView. self assert: roleAnybody permissions size = 1.! ! !SWSecurityTests methodsFor: 'testing-roles'! testRoleTesting self assert: (roleAdmin hasPermission: permissionView). self assert: (roleAdmin hasPermission: permissionEdit). self assert: (roleAdmin hasPermission: permissionHistory). self assert: (roleAnybody hasPermission: permissionView). self deny: (roleAnybody hasPermission: permissionEdit). self deny: (roleAnybody hasPermission: permissionHistory).! ! !SWSecurityTests methodsFor: 'testing-permissions'! testPermissionAccessing self assert: permissionView name = 'Page View'. self assert: permissionEdit name = 'Page Edit'. self assert: permissionHistory name = 'Page History'.! ! !SWSecurityTests methodsFor: 'testing-permissions' stamp: 'chbu 10/22/2003 09:45'! testPermissionAsserting self shouldnt: [ permissionView assertPermission: permissionView ] raise: SWUnauthorizedError. self shouldnt: [ permissionEdit assertPermission: permissionEdit ] raise: SWUnauthorizedError. self shouldnt: [ permissionHistory assertPermission: permissionHistory ] raise: SWUnauthorizedError. self should: [ permissionView assertPermission: permissionEdit ] raise: SWUnauthorizedError. self should: [ permissionView assertPermission: permissionHistory ] raise: SWUnauthorizedError. self should: [ permissionHistory assertPermission: permissionView ] raise: SWUnauthorizedError. self should: [ permissionHistory assertPermission: permissionEdit ] raise: SWUnauthorizedError. self should: [ permissionEdit assertPermission: permissionView ] raise: SWUnauthorizedError. self should: [ permissionEdit assertPermission: permissionHistory ] raise: SWUnauthorizedError.! ! !SWSecurityTests methodsFor: 'testing-permissions' stamp: 'chbu 10/22/2003 09:43'! testPermissionComparing self assert: (SWPermission name: 'Page View') = permissionView. self assert: (SWPermission name: 'Page Edit') = permissionEdit. self assert: (SWPermission name: 'Page History') = permissionHistory. self assert: (SWPermission name: 'Page View') hash = permissionView hash. self assert: (SWPermission name: 'Page Edit') hash = permissionEdit hash. self assert: (SWPermission name: 'Page History') hash = permissionHistory hash.! ! !SWSecurityTests methodsFor: 'testing-permissions'! testPermissionCopy self assert: permissionView copy == permissionView. self assert: permissionEdit copy == permissionEdit. self assert: permissionHistory copy == permissionHistory.! ! !SWSecurityTests methodsFor: 'testing-permissions'! testPermissionTesting self assert: (permissionView hasPermission: permissionView). self assert: (permissionEdit hasPermission: permissionEdit). self assert: (permissionHistory hasPermission: permissionHistory). self deny: (permissionView hasPermission: permissionEdit). self deny: (permissionView hasPermission: permissionHistory). self deny: (permissionHistory hasPermission: permissionView). self deny: (permissionHistory hasPermission: permissionEdit). self deny: (permissionEdit hasPermission: permissionView). self deny: (permissionEdit hasPermission: permissionHistory).! ! !SWSecurityTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:43'! setUp "create permissions" permissionView := SWPermission name: 'Page View'. permissionEdit := SWPermission name: 'Page Edit'. permissionHistory := SWPermission name: 'Page History'. "create roles" roleAdmin := (SWBasicRole name: 'Administrator') add: permissionView; add: permissionEdit; add: permissionHistory; yourself. roleAnybody := (SWBasicRole name: 'Anybody') add: permissionView; yourself. "create users" userLukas := (SWUser username: 'lukas' password: 'something') add: roleAnybody; add: roleAdmin; yourself. userUnknown := SWUser anonymous add: roleAnybody; yourself! ! !SWServer methodsFor: 'serving-private'! emitContext: aContext on: html html heading: aContext printString level: 2. html attributeAt: 'border' put: '0'. html attributeAt: 'width' put: '100%'. html table: [ html tableRow: [ html attributeAt: 'width' put: '25%'. html tableData: 'self'. html tableData: aContext receiver printString ]. aContext localScope localTemps do: [ :item | html tableRow: [ html tableData: item key. html tableData: item value printString ] ] ]! ! !SWServer methodsFor: 'serving-private'! emitException: anException on: html | context exception | context := anException initialContext. exception := anException copyForDebugging. html html: [html head: [html title: anException description]. html body: [html heading: anException description level: 1. html anchorWithAction: [exception defaultAction] to: '/' do: 'Open Debugger'. [context notNil] whileTrue: [self emitContext: context on: html. context := context sender]]]! ! !SWServer methodsFor: 'serving-private'! emitException: anException request: aRequest self emitException: anException response: aRequest response! ! !SWServer methodsFor: 'serving-private'! emitException: anException response: aResponse aResponse initialize; server: self. self emitException: anException on: aResponse stream! ! !SWServer methodsFor: 'serving-private'! process: aRequest "Start the chain of responsibilities in the root of the wiki. Any unhandled exceptions thrown while processing the request will be displayed as a stack-trace within the browser of the client." [ self root process: aRequest ] on: Error do: [ :exception | exception return: (self emitException: exception request: aRequest) ]! ! !SWServer methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:32'! defaultCallbackCache ^SWFifoCache new! ! !SWServer methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:32'! defaultRoot "Return the default wiki that will be used when setting up a new server." ^(SWFolder title: 'SmallWiki') document: self defaultDocumentRoot; add: self defaultPageInformation; yourself! ! !SWServer methodsFor: 'serving'! isServing "Return true if the receivers web-server is up and running." self subclassResponsibility! ! !SWServer methodsFor: 'serving'! restart "Restart the web-server of the receiver." self stop. self start.! ! !SWServer methodsFor: 'serving'! start "Start the web-server of the receiver." self subclassResponsibility! ! !SWServer methodsFor: 'serving'! stop "Stop the web-server of the receiver." self subclassResponsibility! ! !SWServer methodsFor: 'accessing-users'! roles ^users inject: Set new into: [ :set :user | set addAll: user roles; yourself ]! ! !SWServer methodsFor: 'accessing-users'! userAdd: anUser "Add a new user to the receiver. Any user with the same username will be overridden." ^users at: anUser username put: anUser! ! !SWServer methodsFor: 'accessing-users'! userAddAll: aCollection aCollection do: [ :user | self userAdd: user ]! ! !SWServer methodsFor: 'accessing-users'! userAnonymous ^self userAt: 'anonymous'! ! !SWServer methodsFor: 'accessing-users'! userAt: aString "Return the user with aString as name, if there is no such user the default anonymous user is returned." ^self userAt: aString ifAbsent: [ self userAnonymous ]! ! !SWServer methodsFor: 'accessing-users'! userAt: aString ifAbsent: anExceptionBlock "Return the user with aString as name, if there is no such user anExceptionBlock is evaluated." ^users at: aString ifAbsent: anExceptionBlock! ! !SWServer methodsFor: 'accessing-users'! userIncludes: aString "Return true if the receiver has got a user with the given username." ^users includesKey: aString! ! !SWServer methodsFor: 'accessing-users'! userRemove: aString "Remove the user with the given username from the receiver." ^users removeKey: aString! ! !SWServer methodsFor: 'accessing-users'! users ^users! ! !SWServer methodsFor: 'configuration-security' stamp: 'chbu 10/22/2003 17:37'! defaultRoleAdministrator ^SWAdminRole new! ! !SWServer methodsFor: 'configuration-security' stamp: 'chbu 10/22/2003 17:37'! defaultRoleAnonymous ^(SWBasicRole name: 'anonymous') addAll: (SWStructure allSubclasses collect: [ :class | class permissionAdd ]); addAll: (SWStructure allSubclasses collect: [ :class | class permissionEdit ]); addAll: (SWStructure allSubclasses collect: [ :class | class permissionView ]); yourself! ! !SWServer methodsFor: 'configuration-security' stamp: 'chbu 10/22/2003 17:37'! defaultUserAdministrator ^(SWUser username: 'admin' password: 'smallwiki') add: self defaultRoleAdministrator; yourself! ! !SWServer methodsFor: 'configuration-security' stamp: 'chbu 10/22/2003 17:37'! defaultUserAnonymous ^(SWUser anonymous) add: self defaultRoleAnonymous; yourself! ! !SWServer methodsFor: 'configuration-security'! defaultUsers ^OrderedCollection new add: self defaultUserAnonymous; add: self defaultUserAdministrator; yourself! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 09:33'! defaultDocumentInformation ^SWDocument new add: (SWParagraph new add: (SWText newText: 'A Wiki is a collaborative software to do content management. Although there are a lot of different Wiki implementations available today, they all lack the possibility to be extended and to adapt to the needs of their users. SmallWiki is a new and fully object-oriented Wiki framework in Smalltalk, that has got a lot of unit-tests included.'); yourself); add: (SWParagraph new); add: (SWParagraph new add: (SWCode newCode: SWFolder new defaultChildrenListCode); yourself); yourself! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 09:33'! defaultDocumentRoot ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Welcome to SmallWiki, a new Wiki-Wiki implementation in Smalltalk. Below you can find a list with the contents of the root folder of this Wiki. By default this list is generated automatically, but you might replace it with your own welcome-message and page-index.'); yourself); add: (SWParagraph new); add: (SWHeader newText: 'Contents of this Site' level: 1); add: (SWParagraph new add: (SWCode newCode: SWFolder new defaultChildrenListCode); yourself); yourself! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 17:38'! defaultPageCopyright ^SWPage title: 'Copyright' parse: SWSmallWiki licenseString! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 09:33'! defaultPageInformation ^(SWFolder title: 'Information') document: self defaultDocumentInformation; add: self defaultPageIntroduction; add: self defaultPageSyntax; add: self defaultPageCopyright; yourself! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 18:18'! defaultPageIntroduction ^SWPage title: 'Introduction' parse: 'The term Wiki usually means the collaborative software used to create, edit and manage hypertext pages on the web. A Wiki enables the users to author their documents using a simple markup language within their preferred webbrowser. Translated from the Hawaiian language Wiki wiki means fast and that is exactly what the collaborative editing process of a WikiWiki Web is all about: Everybody should be able to create and update pages, without the need of user-name and password to login. However there are wiki vandals around that abuse the general public access and make it necessary to protect the content with security mechanism. !!Problem There are more than 150 Wiki implementations available and most of them are open source. There are even a few implementations available written in different Smalltalk dialects, so why did we create a new one? All the implementations we had a look at have major flaws in extensibility: they don''t provide a proper object oriented-design that is covered by unit tests. Moreover they all keep the content of the pages within strings, which makes it painful to render and search the wiki. These wikis haven''t been designed for extensibility!! The existing Smalltalk wikis are old and it seems that the developers don''t want to touch their running systems. Both, WikiWorks and SqueakWiki, have some of their domain code within external files, what makes the source hard to understand as it is not possible to use the editing and debugging facilities of the Smalltalk environment. !!Solution As stated in the previous section, all the current wiki implementations have problems with extensibility and the design. We didn''t want to make the same mistakes and put together the following basic requirements at the very beginning of the project: -Object-Oriented Design: SmallWiki provides an object oriented domain model. As an example, the content of the pages is parsed and stored as a tree of different entities representing text, links, tables, lists, etc. -Extensibility: Everything in SmallWiki can be extended: page types, storage mechanism, actions, security mechanism, web-server, etc. Plug-ins can be shared within the community and loaded independently of each other into the system. -Open Source: SmallWiki is released under the MIT license which grants unrestricted rights to copy, modify, and redistribute as long as the original copyright and license terms are retained. -Test Suites: SmallWiki is heavily tested. There are more than 200 unit tests included with the core of SmallWiki. This makes it easy to change and verify the code and comes in extremely useful when porting SmallWiki to other Smalltalk dialects or when writing extensions. To learn more about the technical details of SmallWiki please read *smallwiki.pdf>http://www.iam.unibe.ch/~scg/smallwiki/smallwiki.pdf*.'! ! !SWServer methodsFor: 'configuration-pages' stamp: 'chbu 10/22/2003 18:55'! defaultPageSyntax ^(SWPage title: 'Syntax') document: (SWDocument new add: (SWHeader newText: 'Paragraphs' level: 1); add: (SWParagraph new add: (SWText newText: 'As carriage returns are preserved, simply add a newline to begin a new paragraph.'); yourself); add: (SWHeader newText: 'Headers' level: 1); add: (SWParagraph new add: (SWText newText: 'A line starting with !!s becomes a header line.'); yourself); add: (SWHeader newText: 'Horizontal Line' level: 1); add: (SWParagraph new add: (SWText newText: 'A line starting with _ (underscore) becomes a horizontal line. This is often used to separate topics.'); yourself); add: (SWHeader newText: 'Lists' level: 1); add: (SWParagraph new add: (SWText newText: 'Using lines starting with #s and -s, creates a list: A block of lines, where each line starts with - is transformed into a bulleted list, where each line is an entry. A block of lines, where each line starts with # is transformed into an ordered list, where each line is an entry.'); yourself); add: (SWHeader newText: 'Tables' level: 1); add: (SWParagraph new add: (SWText newText: 'To create a table, start off the lines with | and separate the elements with |s. Each new line represents a new row of the table.'); yourself); add: (SWHeader newText: 'Preformatted' level: 1); add: (SWParagraph new add: (SWText newText: 'To create a preformatted section, begin each line with =. A preformatted section uses equally spaced text so that spacing is preserved. '); yourself); add: (SWHeader newText: 'Links' level: 1); add: (SWParagraph new add: (SWText newText: 'To create a link, put it between *s. There are three different types of links:'); yourself); add: (SWOrderedList new add: (SWListItem new add: (SWText newText: 'Internal Link: If the item exists in the Smallwiki (e.g. *Title of Item*), a link to that item shows up when the page is saved. In case the item does not already exist, the link shows up with a create-button next to it; click on it to create the new item.'); yourself); add: (SWListItem new add: (SWText newText: 'External Link: If the link is a valid url (e.g. *http://www.google.ch*), a link to that external page shows up.'); yourself); add: (SWListItem new add: (SWText newText: 'Mail Link: If the link is an email address (e.g. *self@mail.me.com*), a link to mail that person shows up, but it is obfuscated to prevent robots from collecting.'); yourself); yourself); add: (SWParagraph new add: (SWText newText: 'You can also alias all these links using >. So, you can create a link like this: *Alias>Reference*. The link will show up as Alias, but link to Reference. For images, the alias text will become the alternate text for the image.'); yourself); add: (SWHeader newText: 'HTML' level: 1); add: (SWParagraph new add: (SWText newText: 'Use any HTML anywhere you want. Some useful HTML tags are:'); add: (SWUnorderedList new add: (SWListItem new add: (SWText newText: 'To make something bold, surround it by  and .'); yourself); add: (SWListItem new add: (SWText newText: 'To make something italic, surround it by  and .'); yourself); add: (SWListItem new add: (SWText newText: 'To make something underlined, surround it by  and .'); yourself); yourself); yourself); yourself); yourself! ! !SWServer methodsFor: 'accessing'! callback ^callback! ! !SWServer methodsFor: 'accessing'! callback: aCallbackCache callback := aCallbackCache! ! !SWServer methodsFor: 'accessing'! root ^root! ! !SWServer methodsFor: 'accessing'! root: aStructure root isNil ifFalse: [ root removeDependent: self ]. root := aStructure. root isNil ifFalse: [ root addDependent: self ]! ! !SWServer methodsFor: 'accessing'! storage ^storage! ! !SWServer methodsFor: 'accessing'! storage: aStorage storage isNil ifFalse: [ storage server: nil ]. storage := aStorage. storage isNil ifFalse: [ storage server: self ]! ! !SWServer methodsFor: 'accessing-server'! host ^host! ! !SWServer methodsFor: 'accessing-server'! host: aString host := aString! ! !SWServer methodsFor: 'accessing-server'! ip ^ip! ! !SWServer methodsFor: 'accessing-server'! ip: aString ip := aString! ! !SWServer methodsFor: 'accessing-server'! port ^port! ! !SWServer methodsFor: 'accessing-server'! port: anInteger port := anInteger! ! !SWServer methodsFor: 'updating'! update: anAspectSymbol with: aParameter storage isNil ifFalse: [ storage changed: aParameter ]! ! !SWServer methodsFor: 'initialize'! initialize users := Dictionary new. self callback: self defaultCallbackCache. self root: self defaultRoot. self userAddAll: self defaultUsers.! ! !SWComancheServer methodsFor: 'serving' stamp: 'chbu 10/22/2003 22:38'! isServing ^comanche isRunning! ! !SWComancheServer methodsFor: 'serving' stamp: 'chbu 10/22/2003 22:53'! start comanche portNumber: self port. comanche start.! ! !SWComancheServer methodsFor: 'serving' stamp: 'chbu 10/22/2003 22:25'! stop comanche stop! ! !SWComancheServer methodsFor: 'initialize' stamp: 'chbu 10/25/2003 23:58'! initialize | ma site | super initialize. site _ SWComancheSite new server: self; yourself. ma _ ModuleAssembly core. ma alias: '/' to: [ma addPlug: [:request | site helpResolve: request]]. comanche := HttpService on: self port named: 'SmallWiki'. comanche plug: ma rootModule.! ! !SWServer class methodsFor: 'as yet unclassified' stamp: 'chbu 10/25/2003 22:23'! defaultWorkspace " SWServer defaultWorkspace " ^ Workspace new contents: 'SmallWiki Welcome to SmallWiki, a new Wiki-Wiki implementation in Smalltalk. Below you can find some expressions to configure the wiki to your needs. Server Use the following code to create your wiki for the first time. I would suggest to remove that line afterwards, so you don''t accidentally loose your data. server := SWComancheServer startOn: 8080. If you like to change the server parameters use the following messages: server host: ''localhost''. server ip: ''*''. server port: 8080. And don''t forget to restart the sever afterwards: server stop. server start. Storage By default there is no automatic storage process running and all the objects are just kept in your image. It is important that you select a proper storage mechanism, when using SmallWiki in a production environment: server storage: SWImageStorage new. " fast and secure persistence " server storage: SWSIXXStorage new. " slow dump-out using xml " server storage: nil. " no persistence " To set how often your wiki should get stored, use the following command to specify the delay in seconds: server storage delay: 60 * 60. Other storage implementations might provide additional properties. To test your configuration you might want to execute the following code to force a snapshot right now: server storage snapshot. Callback Cache SmallWiki supports different cache implementation to remember callback-blocks assigned to links and form-elements. Depending on the speed and the memory available on your machine, you might want to change the settings or choose another implementation. server callback: SWExpiringCache new. server callback check: 100. " check culling every n-th write-access " server callback ttl: 30 * 60. " seconds to live " server callback: SWFifoCache new. server callback max: 5000. " maximal count of objects " server callback shrink: 100. " release rate of objects " Security By default there are two default users created during installation: the anonymous and the admin. The anonymous user will be used by default and has got the permissions to add new pages to the wiki and edit existing ones. Evaluate the following expression to inspect and modify this user: server userAt: ''anonymous'' In contrast the administrator has to log-in manually and has got all the available permissions, like deleting files, modifying the history, changing the look-and-feel, evaluating Smalltalk expressions on the server, etc. If you use SmallWiki in a production environment, it is very important that you change the default admin-password with the following expression: (server userAt: ''admin'') password: ''smallwiki'' To create a new role having the permissions to remove and copy a page, evaluate the following expression: studentRole := SWBasicRole name: ''student''. studentRole add: SWPage permissionRemove. studentRole add: SWPage permissionCopy. To create a new user and assign the anonymous- and the student-role evaluate try the following code: anonymousRole := server roles detect: [ :each | each name = ''anonymous'' ]. user := SWUser username: ''stud1'' password: ''power''. user add: anonymousRole. user add: studentRole. server userAdd: user. Global Options There are only a few global options to set. One of those options is to tell SmallWiki if it should pretty print the generated html or not. Note that pretty printing is good for development, but for production I suggest to disable it as the engine is faster and the resulting files get smaller: HtmlWriteStream prettyPrint: true. HtmlWriteStream prettyPrint: false.'' runs: (Core.RunArray runs: #(9 143 7 154 1 48 1 1 72 1 63 1 51 1 28 1 1 7 217 1 35 2 31 1 34 2 27 1 25 2 18 1 106 1 32 171 1 25 1 1 15 251 2 36 1 29 44 32 23 32 1 30 29 31 28 2 9 289 28 368 51 107 123 103 202 1 14 296 72) values: ((Core.Array new: 69) at: 1 put: #(#large #bold); at: 3 put: #bold; at: 5 put: (#color -> Graphics.ColorValue darkGreen); at: 6 put: (#color -> Graphics.ColorValue navy); at: 7 put: (#color -> Graphics.ColorValue darkMagenta); at: 8 put: (#color -> Graphics.ColorValue darkGreen); at: 10 put: (#color -> Graphics.ColorValue darkGreen); at: 11 put: (#color -> Graphics.ColorValue navy); at: 12 put: (#color -> Graphics.ColorValue darkMagenta); at: 14 put: (#color -> Graphics.ColorValue darkGreen); at: 15 put: (#color -> Graphics.ColorValue navy); at: 16 put: (#color -> Graphics.ColorValue darkMagenta); at: 18 put: #bold; at: 20 put: (#color -> Graphics.ColorValue darkGreen); at: 21 put: (#color -> Graphics.ColorValue navy); at: 22 put: (#color -> Graphics.ColorValue darkMagenta); at: 23 put: (#color -> Graphics.ColorValue darkGreen); at: 24 put: (#color -> Graphics.ColorValue darkMagenta); at: 25 put: (#color -> Graphics.ColorValue navy); at: 26 put: (#color -> Graphics.ColorValue darkMagenta); at: 27 put: (#color -> Graphics.ColorValue darkGreen); at: 28 put: (#color -> Graphics.ColorValue darkMagenta); at: 29 put: (#color -> Graphics.ColorValue navy); at: 30 put: (#color -> Graphics.ColorValue darkMagenta); at: 31 put: (#color -> Graphics.ColorValue darkGreen); at: 32 put: (#color -> Graphics.ColorValue darkMagenta); at: 34 put: (#color -> Graphics.ColorValue darkGreen); at: 35 put: (#color -> Graphics.ColorValue navy); at: 37 put: (#color -> Graphics.ColorValue darkGreen); at: 38 put: (#color -> Graphics.ColorValue navy); at: 39 put: (#color -> Graphics.ColorValue darkGreen); at: 41 put: #bold; at: 43 put: (#color -> Graphics.ColorValue darkGreen); at: 44 put: (#color -> Graphics.ColorValue navy); at: 45 put: (#color -> Graphics.ColorValue darkGreen); at: 46 put: (#color -> Graphics.ColorValue navy); at: 47 put: (#color -> Graphics.ColorValue darkGreen); at: 48 put: (#color -> Graphics.ColorValue navy); at: 49 put: (#color -> Graphics.ColorValue darkGreen); at: 50 put: (#color -> Graphics.ColorValue navy); at: 51 put: (#color -> Graphics.ColorValue darkGreen); at: 52 put: (#color -> Graphics.ColorValue navy); at: 53 put: (#color -> Graphics.ColorValue darkGreen); at: 54 put: (#color -> Graphics.ColorValue navy); at: 55 put: (#color -> Graphics.ColorValue darkGreen); at: 57 put: #bold; at: 59 put: (#color -> Graphics.ColorValue navy); at: 61 put: (#color -> Graphics.ColorValue navy); at: 63 put: (#color -> Graphics.ColorValue navy); at: 65 put: (#color -> Graphics.ColorValue navy); at: 67 put: #bold; at: 69 put: (#color -> Graphics.ColorValue navy); yourself)))'; openAsMorphLabel: 'SmallWiki'.! ! !SWServer class methodsFor: 'configuration'! defaultHost ^'localhost'! ! !SWServer class methodsFor: 'configuration'! defaultIp ^'127.0.0.1'! ! !SWServer class methodsFor: 'configuration'! defaultPort ^8080! ! !SWServer class methodsFor: 'server'! start ^self startOn: self defaultPort host: self defaultHost ip: self defaultIp! ! !SWServer class methodsFor: 'server'! startOn: anInteger ^self startOn: anInteger host: self defaultHost ip: self defaultIp! ! !SWServer class methodsFor: 'server' stamp: 'chbu 10/24/2003 16:13'! startOn: anInteger host: aHostString ip: anIpString ^self new port: anInteger; host: aHostString; ip: anIpString; start.! ! !SWServer class methodsFor: 'instance-creation'! new ^super new initialize! ! !SWComancheServer class methodsFor: 'action'! stopAll self allInstances do: [ :server | server stop ]! ! !SWServerTests methodsFor: 'testing-serving' stamp: 'chbu 10/22/2003 17:40'! testStart "DISABLED: If there is an instance running on the default port, we get a failure here." "server := self defaultServerClass start. [ self assert: server port = SWServer defaultPort. self assert: server host = SWServer defaultHost. self assert: server ip = SWServer defaultIp. self assert: server isServing ] ensure: [ server stop ]"! ! !SWServerTests methodsFor: 'testing-serving' stamp: 'chbu 10/22/2003 17:40'! testStartOn server := self defaultServerClass startOn: 8081. [ self assert: server port = 8081. self assert: server host = SWServer defaultHost. self assert: server ip = SWServer defaultIp. self assert: server isServing ] ensure: [ server stop ]! ! !SWServerTests methodsFor: 'testing-serving' stamp: 'chbu 10/24/2003 16:14'! testStartOnHostIp server := self defaultServerClass startOn: 8082 host: 'localhost' ip: '*'. [ self assert: server port = 8082. self assert: server host = 'localhost'. self assert: server ip = '*'. self assert: server isServing ] ensure: [ server stop ]! ! !SWServerTests methodsFor: 'testing-namespace' stamp: 'chbu 10/22/2003 17:40'! testAuthor self deny: SWSmallWiki authorString isNil. self deny: SWSmallWiki authorString isEmpty.! ! !SWServerTests methodsFor: 'testing-namespace' stamp: 'chbu 10/22/2003 17:41'! testCopyright self deny: SWSmallWiki copyrightString isNil. self deny: SWSmallWiki copyrightString isEmpty.! ! !SWServerTests methodsFor: 'testing-namespace' stamp: 'chbu 10/22/2003 17:41'! testLicense self deny: SWSmallWiki licenseString isNil. self deny: SWSmallWiki licenseString isEmpty.! ! !SWServerTests methodsFor: 'testing-namespace' stamp: 'chbu 10/22/2003 17:41'! testVersion self deny: SWSmallWiki versionString isNil. self deny: SWSmallWiki versionString isEmpty.! ! !SWServerTests methodsFor: 'configuration' stamp: 'chbu 10/22/2003 19:16'! defaultServerClass ^SWComancheServer! ! !SWServerTests methodsFor: 'testing-users'! testUser self assert: (server userAnonymous username) = 'anonymous'. self assert: (server userAnonymous validatePassword: nil). self assert: (server userAnonymous validatePassword: String new). self assert: (server userAnonymous validatePassword: 'something').! ! !SWServerTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 17:41'! testUserAt | user | user := SWUser username: 'renggli' password: 'something'. server userAdd: user. self assert: (server userAt: 'renggli') == user. self assert: (server userAt: 'renggli' ifAbsent: [ nil ]) == user. self assert: (server userAt: 'unknown') == server userAnonymous. self assert: (server userAt: 'unknown' ifAbsent: [ nil ]) isNil.! ! !SWServerTests methodsFor: 'testing-users' stamp: 'chbu 10/22/2003 17:41'! testUserRemove server userAdd: (SWUser username: 'r1' password: 'a'). server userAdd: (SWUser username: 'r2' password: 'b'). server userAdd: (SWUser username: 'r3' password: 'c'). self assert: (server userIncludes: 'r1'). self assert: (server userIncludes: 'r2'). self assert: (server userIncludes: 'r3'). self deny: (server userIncludes: 'r4'). server userRemove: 'r1'. server userRemove: 'r2'. self deny: (server userIncludes: 'r1'). self deny: (server userIncludes: 'r2'). self assert: (server userIncludes: 'r3'). self deny: (server userIncludes: 'r4').! ! !SWServerTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:42'! testCallback | cache | cache := SWFifoCache new. server callback: cache. self assert: (server callback) == cache.! ! !SWServerTests methodsFor: 'testing-accessing'! testCallbacks self deny: server callback isNil. self assert: server callback isEmpty.! ! !SWServerTests methodsFor: 'testing-accessing'! testHost server host: 'renggli.freezope.org'. self assert: server host = 'renggli.freezope.org'.! ! !SWServerTests methodsFor: 'testing-accessing'! testIp server ip: '123.456.789.123'. self assert: server ip = '123.456.789.123'.! ! !SWServerTests methodsFor: 'testing-accessing'! testPort server port: 1234. self assert: server port = 1234.! ! !SWServerTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:42'! testRoot | chapter | chapter := SWFolder title: 'SmallWiki'. server root: chapter. self assert: (server root) == chapter.! ! !SWServerTests methodsFor: 'running'! setUp server := self defaultServerClass new! ! !SWSessionAction methodsFor: 'rendering'! renderForm: aBlock super renderForm: [ html hiddenInputWithValue: self target callback: #target:. aBlock value ]! ! !SWSessionAction methodsFor: 'accessing'! target target isNil ifTrue: [ target := structure url ]. ^target! ! !SWSessionAction methodsFor: 'accessing'! target: anUrl target := anUrl! ! !SWLogin methodsFor: 'testing'! isAccepted ^(request server userAt: self username ifAbsent: [ ^false ]) validatePassword: self password! ! !SWLogin methodsFor: 'testing'! isInvalid ^self isSubmitted and: [ self isAccepted not ]! ! !SWLogin methodsFor: 'testing'! isSubmitted ^self username notNil and: [ self password notNil ]! ! !SWLogin methodsFor: 'testing'! isValid ^self isSubmitted and: [ self isAccepted ]! ! !SWLogin methodsFor: 'rendering'! renderContent self isInvalid ifTrue: [ self renderInvalid ]. self renderForm.! ! !SWLogin methodsFor: 'rendering'! renderForm self renderForm: [ html table: [ html tableRow: [ html tableHeading: 'Username:'. html tableData: [ html textInputWithValue: self username callback: #username: ] ]. html tableRow: [ html tableHeading: 'Password:'. html tableData: [ html passwordInputWithValue: String new callback: #password: ] ]. html tableRow: [ html tableHeading: nil. html tableData: [ html submitButton: 'Login' ] ] ] ].! ! !SWLogin methodsFor: 'rendering'! renderInvalid html paragraph: 'There were errors with your submission. The username and password you entered ', 'did not match any accounts in our file. Please try again.'! ! !SWLogin methodsFor: 'accessing'! heading ^self class title , ' to ' , self structure root title! ! !SWLogin methodsFor: 'accessing'! password ^password! ! !SWLogin methodsFor: 'accessing'! password: aString password := aString! ! !SWLogin methodsFor: 'accessing'! username username isNil ifTrue: [ username := String new ]. ^username! ! !SWLogin methodsFor: 'accessing'! username: aString username := aString! ! !SWLogin methodsFor: 'action'! authentication | stream | stream := WriteStream on: String new. stream nextPutAll: self username; nextPut: $:; nextPutAll: self password. ^stream contents! ! !SWLogin methodsFor: 'action'! execute self executeCallback. self isValid ifTrue: [ self executeLogin ] ifFalse: [ self render ].! ! !SWLogin methodsFor: 'action'! executeLogin self response cookieAt: 'authorization' put: self authentication. self response redirectTo: self target. self changed: #login.! ! !SWLogin class methodsFor: 'accessing'! title ^'Login'! ! !SWLogout methodsFor: 'action'! execute self executeCallback. self executeLogout.! ! !SWLogout methodsFor: 'action'! executeLogout self response cookieRemove: 'authorization'. self response redirectTo: self target. self changed: #logout.! ! !SWLogout methodsFor: 'accessing'! heading ^self class title , ' from ' , self structure root title! ! !SWLogout class methodsFor: 'accessing'! title ^'Logout'! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/23/2003 17:19'! actions ^actions! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 08:58'! authorString ^'Lukas Renggli, renggli@iam.unibe.ch'! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:01'! copyrightString ^'Software Composition Group, University of Berne, 2003'! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/23/2003 17:20'! initialize " SWSmallWiki initialize " actions := Dictionary new.! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:00'! licenseString ^'The MIT License Copyright (c) 2003 Lukas Renggli Copyright (c) 2003 Software Composition Group, University of Berne Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ! !SWSmallWiki class methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 08:59'! versionString ^'SmallWiki 1.0'! ! !SWSmallWikiTestSuite methodsFor: 'initialization'! initialize | testclasses testselectors | testclasses := TestCase allSubclasses select: [ :class | class environment == SmallWiki ]. testselectors := testclasses inject: Set new into: [ :set :class | set addAll: (class testSelectors collect: [ :selector | class selector: selector ]); yourself ]. self addTests: testselectors! ! !SWSmallWikiTestSuite class methodsFor: 'instance-creation'! new ^super new initialize! ! !SWStorage methodsFor: 'notification'! changed "This message is called whenever something changed inside the wiki structure, if you need to know what exactly happened override #changed: instead." self subclassResponsibility! ! !SWStorage methodsFor: 'notification'! changed: aStructure "Everytime a structure inside the wiki-tree changes this message is called. Override it to provide a storage mechanism." self changed! ! !SWStorage methodsFor: 'accessing'! server ^server! ! !SWStorage methodsFor: 'accessing'! server: aServer server := aServer! ! !SWStorage methodsFor: 'initialize'! initialize! ! !SWStorage methodsFor: 'testing'! isValid ^server notNil! ! !SWSnapshotStorage methodsFor: 'snapshot' stamp: 'chbu 10/22/2003 17:42'! privatePostSnapshot "Override this message with code that should be executed after doing the actual snapshot." lastsnapshot := TimeStamp now! ! !SWSnapshotStorage methodsFor: 'snapshot'! privatePreSnapshot "Override this message with code that should be executed before doing the actual snapshot."! ! !SWSnapshotStorage methodsFor: 'snapshot'! privateSnapshot "Override this message to do the actual snapshot." self subclassResponsibility! ! !SWSnapshotStorage methodsFor: 'snapshot'! snapshot "Do not override this message, that simply calls the messages #privatePreSnapshot, #privateSnapshot and #privatePostSnapshot in order to save the wiki structure as a whole." self privatePreSnapshot. self privateSnapshot. self privatePostSnapshot.! ! !SWSnapshotStorage methodsFor: 'notification' stamp: 'chbu 10/22/2003 17:43'! changed lastchange := TimeStamp now! ! !SWSnapshotStorage methodsFor: 'configuration'! defaultDelay ^30 * 60 "sec"! ! !SWSnapshotStorage methodsFor: 'configuration'! defaultPriority ^10! ! !SWSnapshotStorage methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:46'! defaultTimestamp ^TimeStamp fromSeconds: 0! ! !SWSnapshotStorage methodsFor: 'thread'! startThread self isThreadRunning ifFalse: [ thread := self threadBlock forkAt: self defaultPriority ]! ! !SWSnapshotStorage methodsFor: 'thread'! stopThread self isThreadRunning ifTrue: [ thread terminate ]. thread := nil! ! !SWSnapshotStorage methodsFor: 'thread'! threadBlock ^[ [ [ self threadSnapshot ] repeat ] ifCurtailed: [ thread := nil ] ]! ! !SWSnapshotStorage methodsFor: 'thread'! threadSnapshot self isSnapshotNeeded ifTrue: [ self snapshot ]. self threadWait! ! !SWSnapshotStorage methodsFor: 'thread'! threadWait self isThreadRunning ifTrue: [ self delaySemaphore wait ]! ! !SWSnapshotStorage methodsFor: 'private'! delaySemaphore ^Delay forSeconds: self delay! ! !SWSnapshotStorage methodsFor: 'accessing'! delay ^delay! ! !SWSnapshotStorage methodsFor: 'accessing'! delay: aDelayInSeconds "Set the delay in seconds between the snapshots." delay := aDelayInSeconds! ! !SWSnapshotStorage methodsFor: 'accessing'! lastchange "Return the timestamp of the last change of the whole wiki." ^lastchange! ! !SWSnapshotStorage methodsFor: 'accessing'! lastsnapshot "Return the timestamp when the last successfull snapshot has been made." ^lastsnapshot! ! !SWSnapshotStorage methodsFor: 'accessing'! server: aServer server notNil ifTrue: [self stopThread]. super server: aServer. server notNil ifTrue: [self startThread]! ! !SWSnapshotStorage methodsFor: 'initialize'! initialize super initialize. delay := self defaultDelay. lastchange := self defaultTimestamp. lastsnapshot := self defaultTimestamp.! ! !SWSnapshotStorage methodsFor: 'testing'! isChanged "Return true if the wiki has been changed since the last snapshot." ^self lastchange asSeconds > self lastsnapshot asSeconds! ! !SWSnapshotStorage methodsFor: 'testing' stamp: 'chbu 10/22/2003 17:43'! isExpired "Return true if the delay has been expired since the last snapshot." ^TimeStamp now asSeconds - self lastsnapshot asSeconds > self delay! ! !SWSnapshotStorage methodsFor: 'testing'! isSnapshotNeeded "Return true if a snapshot is needed." ^self isValid and: [ self isChanged ]! ! !SWSnapshotStorage methodsFor: 'testing'! isThreadRunning "Return if the storage thread is running." ^thread notNil! ! !SWImageStorage methodsFor: 'snapshot'! privatePreSnapshot super privatePreSnapshot. self backup.! ! !SWImageStorage methodsFor: 'snapshot'! privateSnapshot [ self privateSnapshotImage ] on: Notification do: [ :err | err resume ]! ! !SWImageStorage methodsFor: 'snapshot'! privateSnapshotImage ObjectMemory snapshotAs: self filename thenQuit: false! ! !SWImageStorage methodsFor: 'accessing'! filename filename isNil ifTrue: [ filename := self defaultFilename ]. ^filename! ! !SWImageStorage methodsFor: 'accessing'! filename: aString filename := aString! ! !SWImageStorage methodsFor: 'configuration'! defaultBackupExtension ^'.bak'! ! !SWImageStorage methodsFor: 'configuration'! defaultFilename ^'smallwiki_snapshot'! ! !SWImageStorage methodsFor: 'tools'! backup | original backup | original := (self filename, Filename imageExtension) asFilename. backup := (self filename, Filename imageExtension, self defaultBackupExtension) asFilename. original definitelyExists ifTrue: [ backup definitelyExists ifTrue: [ backup delete ]. original copyTo: backup ].! ! !SWSIXXStorage methodsFor: 'accessing'! directoryRoot ^directoryRoot! ! !SWSIXXStorage methodsFor: 'accessing'! directoryRoot: aFilename directoryRoot := aFilename! ! !SWSIXXStorage methodsFor: 'accessing'! loadFilename ^loadFilename! ! !SWSIXXStorage methodsFor: 'accessing'! loadFilename: aFilename loadFilename := aFilename! ! !SWSIXXStorage methodsFor: 'filenames'! directory | directory | directory := self directoryRoot. directory := directory construct: self directoryDate. directory := directory construct: self directoryTime. ^directory! ! !SWSIXXStorage methodsFor: 'filenames'! directoryCreate: aDirectroy aDirectroy exists ifFalse: [ self directoryCreate: aDirectroy head asFilename. aDirectroy makeDirectory ]! ! !SWSIXXStorage methodsFor: 'filenames'! directoryDate ^Date today printFormat: #(3 2 1 $- 3 1)! ! !SWSIXXStorage methodsFor: 'filenames'! directoryDefault ^Filename defaultDirectory! ! !SWSIXXStorage methodsFor: 'filenames' stamp: 'chbu 10/22/2003 17:34'! directoryTime | stream | stream := WriteStream on: String new. TimeStamp now hour printOn: stream paddedWith: $0 to: 2 base: 10. ^stream contents! ! !SWSIXXStorage methodsFor: 'initialization'! initialize super initialize. directoryRoot := self directoryDefault.! ! !SWSIXXStorage methodsFor: 'snapshot'! privateSnapshot | directory | self directoryCreate: (directory := self directory); writeStreamTo: (loadFilename := directory construct: 'root.xml') do: [ :stream | stream contextDictionary at: #directory put: directory. stream nextPut: self server root ]! ! !SWSIXXStorage methodsFor: 'utility-streams'! readStreamFrom: aFilename do: aBlock | stream result | self sixxSettings. stream := SixxReadStream on: aFilename readStream. result := [ aBlock value: stream ] ensure: [ stream close ]. ^result! ! !SWSIXXStorage methodsFor: 'utility-streams'! sixxSettings "If you get an exception here, make sure that you have loaded SIXX 0.1f alpha at least." SixxSetting useEnvironment: true! ! !SWSIXXStorage methodsFor: 'utility-streams'! writeStreamTo: aFilename do: aBlock | stream result | self sixxSettings. result := nil. stream := SixxWriteStream on: aFilename writeStream. result := [ aBlock value: stream ] ensure: [ stream close ]. ^result! ! !SWStorage class methodsFor: 'cleaning-up'! stopThreads self allGeneralInstancesDo: [ :storage | storage stopThread ]! ! !SWStorage class methodsFor: 'instance creation'! new ^super new initialize! ! !SWStorageTests methodsFor: 'testing-testing'! testTestingChanged self deny: storage isChanged. storage changed. self assert: storage isChanged.! ! !SWStorageTests methodsFor: 'testing-testing'! testTestingExpired self assert: storage isExpired.! ! !SWStorageTests methodsFor: 'testing-testing'! testTestingSnapshot self deny: storage isSnapshotNeeded. server storage: storage. self deny: storage isSnapshotNeeded. storage changed. self assert: storage isSnapshotNeeded.! ! !SWStorageTests methodsFor: 'testing-testing'! testTestingThread self deny: storage isThreadRunning. server storage: storage. self assert: storage isThreadRunning.! ! !SWStorageTests methodsFor: 'testing-testing'! testTestingValid self deny: storage isValid. server storage: storage. self assert: storage isValid.! ! !SWStorageTests methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:46'! defaultServer ^SWServer new! ! !SWStorageTests methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:46'! defaultStorage ^SWSnapshotStorage new! ! !SWStorageTests methodsFor: 'testing-accessing'! testDelay self deny: storage delay isNil. self assert: storage delay > 0. storage delay: 60 * 60 * 24. self assert: storage delay = (60 * 60 * 24).! ! !SWStorageTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:44'! testLastchange self assert: storage lastchange asSeconds < TimeStamp now asSeconds! ! !SWStorageTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 17:44'! testLastsnapshot self assert: storage lastsnapshot asSeconds < TimeStamp now asSeconds! ! !SWStorageTests methodsFor: 'testing-accessing'! testServer server storage: storage. self assert: storage isThreadRunning. self assert: server storage == storage. server storage: nil. self deny: storage isThreadRunning. self assert: server storage isNil.! ! !SWStorageTests methodsFor: 'running'! setUp storage := self defaultStorage. server := self defaultServer.! ! !SWStorageTests methodsFor: 'running'! tearDown storage stopThread! ! !SWStorageTests methodsFor: 'testing'! testInitialized self deny: storage isValid. self deny: storage isChanged.! ! !SWStorageTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 20:16'! testSnapshot self shouldnt: [ storage threadSnapshot ] raise: "SubclassResponsibility"Error. server storage: storage. storage stopThread. self shouldnt: [ storage threadSnapshot ] raise: "SubclassResponsibility"Error. storage changed. self should: [ storage threadSnapshot ] raise: "SubclassResponsibility"Error.! ! !SWStructureTests methodsFor: 'testing-accessing'! testParent self assert: fd parent = nil. self assert: fd1 parent = fd. self assert: fd11 parent = fd1. self assert: fd111 parent = fd11. self assert: fd12 parent = fd1. self assert: fd2 parent = fd. self assert: pa21 parent = fd2. self assert: pa22 parent = fd2. self assert: fd3 parent = fd. self assert: re31 parent = fd3. self assert: re32 parent = fd3.! ! !SWStructureTests methodsFor: 'testing-accessing'! testPredecessor self assert: fd predecessor isNil. self assert: fd1 predecessor isNil. self assert: fd11 predecessor isNil. self assert: fd111 predecessor isNil. self assert: fd12 predecessor isNil. self assert: fd2 predecessor isNil. self assert: pa21 predecessor isNil. self assert: pa22 predecessor isNil. self assert: fd3 predecessor isNil. self assert: re31 predecessor isNil. self assert: re32 predecessor isNil.! ! !SWStructureTests methodsFor: 'testing-accessing'! testRoles self assert: fd roles isNil. self assert: fd1 roles isNil. self assert: fd11 roles isNil. self assert: fd111 roles isNil. self assert: fd12 roles isNil. self assert: fd12 roles isNil. self assert: pa21 roles isNil. self assert: pa22 roles isNil. self assert: fd3 roles isNil. self assert: re31 roles isNil. self assert: re32 roles isNil.! ! !SWStructureTests methodsFor: 'testing-accessing' stamp: 'chbu 10/22/2003 09:51'! testTimestamp self assert: fd timestamp <= TimeStamp now. self assert: fd1 timestamp <= TimeStamp now. self assert: fd11 timestamp <= TimeStamp now. self assert: fd111 timestamp <= TimeStamp now. self assert: fd12 timestamp <= TimeStamp now. self assert: fd2 timestamp <= TimeStamp now. self assert: pa21 timestamp <= TimeStamp now. self assert: pa22 timestamp <= TimeStamp now. self assert: fd3 timestamp <= TimeStamp now. self assert: re31 timestamp <= TimeStamp now. self assert: re32 timestamp <= TimeStamp now.! ! !SWStructureTests methodsFor: 'testing-accessing'! testTitle self assert: fd title = 'Root'. self assert: fd1 title = 'Folder 1'. self assert: fd11 title = 'Folder 1.1'. self assert: fd111 title = 'Folder 1.1.1'. self assert: fd12 title = 'Folder 1.2'. self assert: fd2 title = 'Folder 2'. self assert: pa21 title = 'Page 2.1'. self assert: pa22 title = 'Page 2.2'. self assert: fd3 title ='Folder 3'. self assert: re31 title = 'Resource 3.1'. self assert: re32 title = 'Resource 3.2'.! ! !SWStructureTests methodsFor: 'testing-accessing'! testVersion self assert: fd version = 0. self assert: fd1 version = 0. self assert: fd11 version = 0. self assert: fd111 version = 0. self assert: fd12 version = 0. self assert: fd2 version = 0. self assert: pa21 version = 0. self assert: pa22 version = 0. self assert: fd3 version = 0. self assert: re31 version = 0. self assert: re32 version = 0.! ! !SWStructureTests methodsFor: 'testing-versions'! testVersionChildren self assert: (fd at: 'Folder1') == fd1. fd1 nextVersion. fd1 title: 'New Folder 1'. self assert: (fd at: 'NewFolder1') == fd1. self assert: (fd1 parent) == fd.! ! !SWStructureTests methodsFor: 'testing-versions' stamp: 'chbu 10/22/2003 09:51'! testVersionNext self assert: fd version = 0. self assert: fd versions size = 1. self assert: fd versions first == fd. self deny: fd isSuccessor. fd := SWFolder version: fd. self assert: fd version = 1. self assert: fd versions size = 2. self assert: fd versions first == fd. self assert: fd isSuccessor. fd := fd nextVersion. self assert: fd version = 2. self assert: fd versions size = 3. self assert: fd versions first == fd. self assert: fd isSuccessor.! ! !SWStructureTests methodsFor: 'testing-versions'! testVersionNumber 10 timesRepeat: [ fd1 nextVersion ]. 0 to: 10 do: [ :version | self assert: (fd1 versionNumber: version) == (fd1 versions at: 11 - version) ]. self assert: (fd1 versionNumber: 0) == fd1 versions last. self assert: (fd11 versionNumber: 0) == fd11 versions last. self should: [ fd1 versionNumber: 11 ] raise: Error. self should: [ fd11 versionNumber: 1] raise: Error.! ! !SWStructureTests methodsFor: 'testing-versions'! testVersionRestore 5 timesRepeat: [ fd1 nextVersion ]. (fd1 versionNumber: 3) propertyAt: #tag put: true. fd1 versionRestore: 3. self assert: ((fd1 versionNumber: 0) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 1) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 2) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 3) propertyAt: #tag) = true. self assert: ((fd1 versionNumber: 4) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 5) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 6) propertyAt: #tag) = true. fd1 versions do: [ :folder | self assert: folder parent == fd ].! ! !SWStructureTests methodsFor: 'testing-versions'! testVersionRevert 5 timesRepeat: [ fd1 nextVersion ]. (fd1 versionNumber: 3) propertyAt: #tag put: true. fd1 versionRevert: 3. self assert: ((fd1 versionNumber: 0) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 1) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 2) propertyAt: #tag) = nil. self assert: ((fd1 versionNumber: 6) propertyAt: #tag) = true. self should: [ fd1 versionNumber: 3 ] raise: Error. self should: [ fd1 versionNumber: 4 ] raise: Error. self should: [ fd1 versionNumber: 5 ] raise: Error. fd1 versions do: [ :folder | self assert: folder parent == fd ].! ! !SWStructureTests methodsFor: 'testing-versions'! testVersionTruncate 5 timesRepeat: [ fd1 nextVersion ]. fd1 versionTruncate: 3. self should: [ fd1 versionNumber: 0 ] raise: Error. self should: [ fd1 versionNumber: 1 ] raise: Error. self should: [ fd1 versionNumber: 2 ] raise: Error. self deny: (fd1 versionNumber: 3) isNil. self deny: (fd1 versionNumber: 4) isNil. self deny: (fd1 versionNumber: 5) isNil. self assert: fd1 versions size = 3. fd1 versions do: [ :folder | self assert: folder parent == fd ].! ! !SWStructureTests methodsFor: 'testing-versions' stamp: 'chbu 10/22/2003 09:52'! testVersionUpdateReferences | link21 link22 | pa21 document: (link21 := SWLinkInternal newTo: pa22 title from: pa21). pa22 document: (link22 := SWLinkInternal newTo: pa22 title from: pa22). self assert: link21 target == pa22. self assert: link22 target == pa22. self assert: pa21 == pa21 nextVersion. self assert: link21 target == pa22. self assert: link22 target == pa22. self assert: pa22 == pa22 nextVersion. self assert: link21 target == pa22. self assert: link22 target == pa22. self assert: pa22 == pa22 nextVersion. self assert: link21 target == pa22. self assert: link22 target == pa22.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testId self assert: fd id = 'Root'. self assert: fd1 id = 'Folder1'. self assert: fd11 id = 'Folder1.1'. self assert: fd111 id = 'Folder1.1.1'. self assert: fd12 id = 'Folder1.2'. self assert: fd2 id = 'Folder2'. self assert: pa21 id = 'Page2.1'. self assert: pa22 id = 'Page2.2'. self assert: fd3 id ='Folder3'. self assert: re31 id = 'Resource3.1'. self assert: re32 id = 'Resource3.2'.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testParents self assert: fd parents size = 1. self assert: fd1 parents size = 2. self assert: fd11 parents size = 3. self assert: fd111 parents size = 4. self assert: fd12 parents size = 3. self assert: fd2 parents size = 2. self assert: pa21 parents size = 3. self assert: pa22 parents size = 3. self assert: fd3 parents size = 2. self assert: re31 parents size = 3. self assert: re32 parents size = 3.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testParentsFirst self assert: fd parents first == fd. self assert: fd1 parents first == fd. self assert: fd11 parents first == fd. self assert: fd111 parents first == fd. self assert: fd12 parents first == fd. self assert: fd2 parents first == fd. self assert: pa21 parents first == fd. self assert: pa22 parents first == fd. self assert: fd3 parents first == fd. self assert: re31 parents first == fd. self assert: re32 parents first == fd.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testParentsLast self assert: fd parents last == fd. self assert: fd1 parents last == fd1. self assert: fd11 parents last == fd11. self assert: fd111 parents last == fd111. self assert: fd12 parents last == fd12. self assert: fd2 parents last == fd2. self assert: pa21 parents last == pa21. self assert: pa22 parents last == pa22. self assert: fd3 parents last == fd3. self assert: re31 parents last == re31. self assert: re32 parents last == re32.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testRoot self assert: fd root == fd. self assert: fd1 root == fd. self assert: fd11 root == fd. self assert: fd111 root == fd. self assert: fd12 root == fd. self assert: fd2 root == fd. self assert: pa21 root == fd. self assert: pa22 root == fd. self assert: fd3 root == fd. self assert: re31 root == fd. self assert: re32 root == fd.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testUrl self assert: fd url = '/'. self assert: fd1 url = '/Folder1/'. self assert: fd11 url = '/Folder1/Folder1.1/'. self assert: fd111 url = '/Folder1/Folder1.1/Folder1.1.1/'. self assert: fd12 url = '/Folder1/Folder1.2/'. self assert: fd2 url = '/Folder2/'. self assert: pa21 url = '/Folder2/Page2.1/'. self assert: pa22 url = '/Folder2/Page2.2/'. self assert: fd3 url = '/Folder3/'. self assert: re31 url = '/Folder3/Resource3.1/'. self assert: re32 url = '/Folder3/Resource3.2/'.! ! !SWStructureTests methodsFor: 'testing-accessing-calculated'! testVersions | item | " test initial configuration " self assert: fd1 version = 0. self assert: fd1 versions size = 1. self assert: fd1 versions first = fd1. self assert: fd1 versions last = fd1. " new version " fd1 nextVersion. " test new version " self assert: fd1 version = 1. self assert: fd1 versions size = 2. self assert: fd1 versions first = fd1. self assert: fd1 versions last ~= fd1. " some more versions " 18 timesRepeat: [ fd1 nextVersion ]. " check attributes " 1 to: 20 do: [ :index | item := fd1 versions at: index. self assert: item parent = fd. self assert: item version = (20 - index). self assert: item versions size = (21 - index). self assert: item versions first = item ]. fd1 versions do: [ :first | fd1 versions do: [ :second | first version ~~ second version ifTrue: [ self deny: first == second ] ] ]! ! !SWStructureTests methodsFor: 'testing-testing'! testIsComposite self assert: fd isComposite. self assert: fd1 isComposite. self assert: fd11 isComposite. self assert: fd111 isComposite. self assert: fd12 isComposite. self assert: fd2 isComposite. self deny: pa21 isComposite. self deny: pa22 isComposite. self assert: fd3 isComposite. self deny: re31 isComposite. self deny: re32 isComposite.! ! !SWStructureTests methodsFor: 'testing-testing'! testIsEmbedded self deny: fd isEmbedded. self deny: fd1 isEmbedded. self deny: fd11 isEmbedded. self deny: fd111 isEmbedded. self deny: fd12 isEmbedded. self deny: fd2 isEmbedded. self deny: pa21 isEmbedded. self deny: pa22 isEmbedded. self deny: fd3 isEmbedded. self assert: re31 isEmbedded. self assert: re32 isEmbedded.! ! !SWStructureTests methodsFor: 'testing-testing'! testIsRoot self assert: fd isRoot. self deny: fd1 isRoot. self deny: fd11 isRoot. self deny: fd111 isRoot. self deny: fd12 isRoot. self deny: fd2 isRoot. self deny: pa21 isRoot. self deny: pa22 isRoot. self deny: fd3 isRoot. self deny: re31 isRoot. self deny: re32 isRoot.! ! !SWStructureTests methodsFor: 'testing-testing'! testIsSuccessor self deny: fd isSuccessor. self deny: fd1 isSuccessor. self deny: fd11 isSuccessor. self deny: fd111 isSuccessor. self deny: fd12 isSuccessor. self deny: fd2 isSuccessor. self deny: pa21 isSuccessor. self deny: pa22 isSuccessor. self deny: fd3 isSuccessor. self deny: re31 isSuccessor. self deny: re32 isSuccessor.! ! !SWStructureTests methodsFor: 'testing-notification'! testChanged fd changed. self assert: counter = 1. self assert: parameter == fd. fd1 changed. self assert: counter = 2. self assert: parameter == fd1. fd11 changed. self assert: counter = 3. self assert: parameter == fd11. fd111 changed. self assert: counter = 4. self assert: parameter == fd111.! ! !SWStructureTests methodsFor: 'testing-notification'! testChangedAndNextVersion fd changed. self assert: counter = 1. self assert: parameter == fd. fd nextVersion; changed. self assert: counter = 2. self assert: parameter == fd.! ! !SWStructureTests methodsFor: 'testing-notification'! testChangedAspect fd changed: #hallo. self assert: counter = 1. self assert: parameter == fd. fd1 changed: #hallo. self assert: counter = 2. self assert: parameter == fd1. fd11 changed: #hallo. self assert: counter = 3. self assert: parameter == fd11. fd111 changed: #hallo. self assert: counter = 4. self assert: parameter == fd111.! ! !SWStructureTests methodsFor: 'testing-notification'! testChangedAspectParam fd changed: #hallo with: pa22. self assert: counter = 1. self assert: parameter == pa22. fd1 changed: #hallo with: pa22. self assert: counter = 2. self assert: parameter == pa22. fd11 changed: #hallo with: pa22. self assert: counter = 3. self assert: parameter == pa22. fd111 changed: #hallo with: pa22. self assert: counter = 4. self assert: parameter == pa22.! ! !SWStructureTests methodsFor: 'testing-notification'! update: anAspectSymbol with: aParameter counter := counter + 1. parameter := aParameter.! ! !SWStructureTests methodsFor: 'testing-children'! testChildren self deny: fd children isNil. self deny: fd1 children isNil. self deny: fd11 children isNil. self deny: fd111 children isNil. self deny: fd12 children isNil. self deny: fd2 children isNil. self deny: fd3 children isNil.! ! !SWStructureTests methodsFor: 'testing-children' stamp: 'chbu 10/22/2003 09:48'! testChildrenAdd | root page1 page2 | "empty chapter" root := SWFolder title: 'root'. self assert: root children isEmpty. "add one page" page1 := SWPage title: 'My First Page'. root add: page1. self deny: root children isEmpty. self assert: root children size = 1. self assert: page1 parent == root. self assert: (root at: 'My First Page') == page1. "add another page with same title" page2 := SWPage title: 'My First Page'. self should: [ root add: page2 ] raise: SWDuplicatedStructure. self deny: root children isEmpty. self assert: root children size = 1. self assert: page1 parent == root. self assert: (root at: 'My First Page') == page1.! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenAddAll | children | "check existing children" children := fd1 children copy. children do: [ :child | self assert: child parent == fd1. self assert: (fd1 includes: child id). self deny: (fd includes: child id) ]. "old references have to be removed manually" fd1 children removeAll: children. " carefull: right order is important " children do: [ :each | fd add: each ]. children do: [ :child | self assert: child parent == fd. self assert: (fd includes: child id). self deny: (fd1 includes: child id) ].! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenAt self assert: (fd at: 'Folder 1') == fd1. self assert: (fd1 at: 'Folder 1.1') == fd11. self assert: (fd11 at: 'Folder 1.1.1') == fd111. self assert: (fd1 at: 'Folder 1.2') == fd12. self assert: (fd at: 'Folder 2') == fd2. self assert: (fd2 at: 'Page 2.1') == pa21. self assert: (fd2 at: 'Page 2.2') == pa22. self assert: (fd at: 'Folder 3') == fd3. self assert: (fd3 at: 'Resource 3.1') == re31. self assert: (fd3 at: 'Resource 3.2') == re32. self assert: (fd at: 'Unknown') isNil.! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenAtIfAbsent self assert: (fd at: 'Folder 1' ifAbsent: [ false ]) == fd1. self assert: (fd1 at: 'Folder 1.1' ifAbsent: [ false ]) == fd11. self assert: (fd11 at: 'Folder 1.1.1' ifAbsent: [ false ]) == fd111. self assert: (fd1 at: 'Folder 1.2' ifAbsent: [ false ]) == fd12. self assert: (fd at: 'Folder 2' ifAbsent: [ false ]) == fd2. self assert: (fd2 at: 'Page 2.1' ifAbsent: [ false ]) == pa21. self assert: (fd2 at: 'Page 2.2' ifAbsent: [ false ]) == pa22. self assert: (fd at: 'Folder 3' ifAbsent: [ false ]) == fd3. self assert: (fd3 at: 'Resource 3.1' ifAbsent: [ false ]) == re31. self assert: (fd3 at: 'Resource 3.2' ifAbsent: [ false ]) == re32. self assert: (fd at: 'Unknown' ifAbsent: [ false ]) == false.! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenIncludes self assert: (fd includes: 'Folder1'). self assert: (fd1 includes: 'Folder1.1'). self assert: (fd11 includes: 'Folder1.1.1'). self assert: (fd1 includes: 'Folder1.2'). self assert: (fd includes: 'Folder2'). self assert: (fd2 includes: 'Page2.1'). self assert: (fd2 includes: 'Page2.2'). self assert: (fd includes: 'Folder3'). self assert: (fd3 includes: 'Resource3.1'). self assert: (fd3 includes: 'Resource3.2'). self assert: (fd includes: 'Folder 1'). self assert: (fd includes: ' Folder 1'). self assert: (fd includes: 'Folder 1 '). self deny: (fd includes: 'Unknown'). self deny: (fd includes: 'Unknown '). self deny: (fd includes: ' Unknown').! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenRemove self assert: (fd remove: fd1) == fd1. self assert: fd children size = 2. self assert: fd1 parent isNil. self deny: (fd includes: fd1 title). self should: [ fd remove: fd1 ] raise: Error. self assert: fd children size = 2. self assert: fd1 parent isNil. self deny: (fd includes: fd1 title).! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenRemoveAll "remove unknown children" self should: [ fd children removeAll: fd1 children ] raise: Error. self assert: fd children size = 3. "remove all children" fd children removeAll: fd children copy. self assert: fd children isEmpty.! ! !SWStructureTests methodsFor: 'testing-children'! testChildrenSize self assert: fd children size = 3. self assert: fd1 children size = 2. self assert: fd11 children size = 1. self assert: fd111 children size = 0. self assert: fd12 children size = 0. self assert: fd2 children size = 2. self assert: fd3 children size = 2.! ! !SWStructureTests methodsFor: 'testing-properties'! testLocalProperties self deny: fd localProperties isNil. self deny: fd localProperties isNil. self deny: fd1 localProperties isNil. self deny: fd11 localProperties isNil. self deny: fd111 localProperties isNil. self deny: fd12 localProperties isNil. self deny: fd2 localProperties isNil. self deny: pa21 localProperties isNil. self deny: pa22 localProperties isNil. self deny: fd3 localProperties isNil. self deny: re31 localProperties isNil. self deny: re32 localProperties isNil. self assert: fd localProperties size = 2. self assert: fd1 localProperties size = 1. self assert: fd11 localProperties size = 2. self assert: fd111 localProperties size = 1. self assert: (fd localProperties at: #level) = 0. self assert: (fd1 localProperties at: #level) = 1. self assert: (fd11 localProperties at: #level) = 2. self assert: (fd111 localProperties at: #level) = 3. self assert: (fd localProperties at: #trueTag). self assert: (fd1 localProperties at: #trueTag) isNil. self assert: (fd11 localProperties at: #trueTag) isNil. self assert: (fd111 localProperties at: #trueTag) isNil. self assert: (fd localProperties at: #falseTag) isNil. self assert: (fd1 localProperties at: #falseTag) isNil. self deny: (fd11 localProperties at: #falseTag). self assert: (fd111 localProperties at: #falseTag) isNil! ! !SWStructureTests methodsFor: 'testing-properties'! testLocalPropertiesAt self assert: (fd localPropertyAt: #level) = 0. self assert: (fd1 localPropertyAt: #level) = 1. self assert: (fd11 localPropertyAt: #level) = 2. self assert: (fd111 localPropertyAt: #level) = 3. self assert: (fd localPropertyAt: #trueTag) = true. self assert: (fd1 localPropertyAt: #trueTag) = nil. self assert: (fd11 localPropertyAt: #trueTag) = nil. self assert: (fd111 localPropertyAt: #trueTag) = nil. self assert: (fd localPropertyAt: #falseTag) = nil. self assert: (fd1 localPropertyAt: #falseTag) = nil. self assert: (fd11 localPropertyAt: #falseTag) = false. self assert: (fd111 localPropertyAt: #falseTag) = nil.! ! !SWStructureTests methodsFor: 'testing-properties'! testLocalPropertiesAtIfAbsent self assert: (fd localPropertyAt: #level ifAbsent: [ 123 ]) = 0. self assert: (fd1 localPropertyAt: #level ifAbsent: [ 123 ]) = 1. self assert: (fd11 localPropertyAt: #level ifAbsent: [ 123 ]) = 2. self assert: (fd111 localPropertyAt: #level ifAbsent: [ 123 ]) = 3. self assert: (fd localPropertyAt: #trueTag ifAbsent: [ 123 ]) = true. self assert: (fd1 localPropertyAt: #trueTag ifAbsent: [ 123 ]) = 123. self assert: (fd11 localPropertyAt: #trueTag ifAbsent: [ 123 ]) = 123. self assert: (fd111 localPropertyAt: #trueTag ifAbsent: [ 123 ]) = 123. self assert: (fd localPropertyAt: #falseTag ifAbsent: [ 123 ]) = 123. self assert: (fd1 localPropertyAt: #falseTag ifAbsent: [ 123 ]) = 123. self assert: (fd11 localPropertyAt: #falseTag ifAbsent: [ 123 ]) = false. self assert: (fd111 localPropertyAt: #falseTag ifAbsent: [ 123 ]) = 123.! ! !SWStructureTests methodsFor: 'testing-properties'! testLocalPropertiesAtPut fd11 localPropertyAt: #owner put: 123. self assert: (fd11 localPropertyAt: #owner) = 123.! ! !SWStructureTests methodsFor: 'testing-properties'! testProperties self deny: fd properties isNil. self deny: fd properties isNil. self deny: fd1 properties isNil. self deny: fd11 properties isNil. self deny: fd111 properties isNil. self deny: fd12 properties isNil. self deny: fd2 properties isNil. self deny: pa21 properties isNil. self deny: pa22 properties isNil. self deny: fd3 properties isNil. self deny: re31 properties isNil. self deny: re32 properties isNil. self assert: fd properties size = 2. self assert: fd1 properties size = 2. self assert: fd11 properties size = 3. self assert: fd111 properties size = 3. self assert: (fd properties at: #level) = 0. self assert: (fd1 properties at: #level) = 1. self assert: (fd11 properties at: #level) = 2. self assert: (fd111 properties at: #level) = 3. self assert: (fd properties at: #trueTag) = true. self assert: (fd1 properties at: #trueTag) = true. self assert: (fd11 properties at: #trueTag) = true. self assert: (fd111 properties at: #trueTag) = true. self assert: (fd properties at: #falseTag) = nil. self assert: (fd1 properties at: #falseTag) = nil. self assert: (fd11 properties at: #falseTag) = false. self assert: (fd111 properties at: #falseTag) = false.! ! !SWStructureTests methodsFor: 'testing-properties'! testPropertiesAt self assert: (fd propertyAt: #level) = 0. self assert: (fd1 propertyAt: #level) = 1. self assert: (fd11 propertyAt: #level) = 2. self assert: (fd111 propertyAt: #level) = 3. self assert: (fd propertyAt: #trueTag) = true. self assert: (fd1 propertyAt: #trueTag) = true. self assert: (fd11 propertyAt: #trueTag) = true. self assert: (fd111 propertyAt: #trueTag) = true. self assert: (fd propertyAt: #falseTag) = nil. self assert: (fd1 propertyAt: #falseTag) = nil. self assert: (fd11 propertyAt: #falseTag) = false. self assert: (fd111 propertyAt: #falseTag) = false.! ! !SWStructureTests methodsFor: 'testing-properties'! testPropertiesAtIfAbsent self assert: (fd propertyAt: #level ifAbsent: [ 123 ]) = 0. self assert: (fd1 propertyAt: #level ifAbsent: [ 123 ]) = 1. self assert: (fd11 propertyAt: #level ifAbsent: [ 123 ]) = 2. self assert: (fd111 propertyAt: #level ifAbsent: [ 123 ]) = 3. self assert: (fd propertyAt: #trueTag ifAbsent: [ 123 ]) = true. self assert: (fd1 propertyAt: #trueTag ifAbsent: [ 123 ]) = true. self assert: (fd11 propertyAt: #trueTag ifAbsent: [ 123 ]) = true. self assert: (fd111 propertyAt: #trueTag ifAbsent: [ 123 ]) = true. self assert: (fd propertyAt: #falseTag ifAbsent: [ 123 ]) = 123. self assert: (fd1 propertyAt: #falseTag ifAbsent: [ 123 ]) = 123. self assert: (fd11 propertyAt: #falseTag ifAbsent: [ 123 ]) = false. self assert: (fd111 propertyAt: #falseTag ifAbsent: [ 123 ]) = false.! ! !SWStructureTests methodsFor: 'testing-properties'! testPropertiesAtPut fd11 propertyAt: #owner put: 123. self assert: (fd11 propertyAt: #owner) = 123.! ! !SWStructureTests methodsFor: 'testing-accessing-write'! testWriteParent fd parent: self. self assert: fd parent == self.! ! !SWStructureTests methodsFor: 'testing-accessing-write'! testWritePredecessor fd predecessor: self. self assert: fd predecessor == self! ! !SWStructureTests methodsFor: 'testing-accessing-write'! testWriteRole fd roles: self. self assert: fd roles == self.! ! !SWStructureTests methodsFor: 'testing-accessing-write' stamp: 'chbu 10/22/2003 09:51'! testWriteTimestamp fd timestamp: TimeStamp now. self assert: fd timestamp <= TimeStamp now.! ! !SWStructureTests methodsFor: 'testing-accessing-write' stamp: 'chbu 10/22/2003 16:18'! testWriteTitle "change title of root" fd title: 'My Root Page'. self assert: fd title = 'My Root Page'. self assert: fd id = 'MyRootPage'. self assert: fd parent isNil. "change title of child" fd1 title: 'My First Page'. self assert: fd1 title = 'My First Page'. self assert: fd1 id = 'MyFirstPage'. self assert: fd1 parent == fd. self deny: (fd includes: 'Folder1'). self assert: (fd at: 'MyFirstPage') == fd1. "change title of child to existing name" self should: [ fd2 title: 'My First Page'. ] raise: SWDuplicatedStructure. self assert: fd2 title = 'Folder 2'. self assert: fd2 id = 'Folder2'. self assert: fd2 parent == fd. self assert: (fd at: 'Folder 2') == fd2.! ! !SWStructureTests methodsFor: 'testing-accessing-write'! testWriteVersion fd version: 123456. self assert: fd version = 123456.! ! !SWStructureTests methodsFor: 'testing-creational'! testCopy fd11 roles: OrderedCollection new. self assert: fd11 copy ~~ fd11. self assert: fd11 copy properties ~~ fd11 properties. self assert: fd11 copy timestamp ~~ fd11 timestamp. self assert: fd11 copy roles ~~ fd11 roles. self assert: fd11 copy parent == fd11 parent. self assert: fd11 copy predecessor == fd11 predecessor. self assert: fd11 copy version == fd11 version. self assert: pa21 copy ~~ pa21. self assert: pa21 copy properties ~~ pa21 properties. self assert: pa21 copy timestamp ~~ pa21 timestamp. self assert: pa21 copy document ~~ pa21 document. self assert: pa21 copy parent == pa21 parent. self assert: pa21 copy predecessor == pa21 predecessor. self assert: pa21 copy version == pa21 version. self assert: re31 copy ~~ re31. self assert: re31 copy properties ~~ re31 properties. self assert: re31 copy timestamp ~~ re31 timestamp. self assert: re31 copy data == re31 data. self assert: re31 copy parent == re31 parent. self assert: re31 copy predecessor == re31 predecessor. self assert: re31 copy version == re31 version.! ! !SWStructureTests methodsFor: 'testing-creational' stamp: 'chbu 10/24/2003 17:22'! testCreateParent | folder1 | folder1 := SWFolder parent: fd. " self should: [ folder2 := SWFolder parent: fd ] raise: SWDuplicatedStructure." self assert: folder1 title = 'Folder'. self assert: folder1 id = 'Folder'. self assert: folder1 parent == fd. self assert: folder1 predecessor isNil. self assert: folder1 timestamp <= TimeStamp now. self assert: folder1 version = 0. self assert: folder1 localProperties isEmpty. self assert: folder1 children isEmpty.! ! !SWStructureTests methodsFor: 'testing-creational' stamp: 'chbu 10/22/2003 09:49'! testCreateTitle | folder page resource | folder := SWFolder title: 'Small Wiki'. self assert: folder title = 'Small Wiki'. self assert: folder id = 'SmallWiki'. self assert: folder parent isNil. self assert: folder predecessor isNil. self assert: folder timestamp <= TimeStamp now. self assert: folder version = 0. self assert: folder properties isEmpty. self assert: folder children isEmpty. page := SWPage title: 'Small Wiki'. self assert: page title = 'Small Wiki'. self assert: page id = 'SmallWiki'. self assert: page parent isNil. self assert: page predecessor isNil. self assert: page timestamp <= TimeStamp now. self assert: page version = 0. self assert: page properties isEmpty. self deny: page document isNil. resource := SWResource title: 'Small Wiki'. self assert: resource title = 'Small Wiki'. self assert: resource id = 'SmallWiki'. self assert: resource parent isNil. self assert: resource predecessor isNil. self assert: resource timestamp <= TimeStamp now. self assert: resource version = 0. self assert: resource properties isEmpty. self deny: resource data isNil. self deny: resource mimetype isNil.! ! !SWStructureTests methodsFor: 'testing-creational' stamp: 'chbu 10/22/2003 09:49'! testCreateVersion | folder page resource | folder := SWFolder title: 'Small Wiki'. self assert: folder title = 'Small Wiki'. self assert: folder id = 'SmallWiki'. self assert: folder parent isNil. self assert: folder predecessor isNil. self assert: folder timestamp <= TimeStamp now. self assert: folder version = 0. self assert: folder properties isEmpty. self assert: folder children isEmpty. page := SWPage title: 'Small Wiki'. self assert: page title = 'Small Wiki'. self assert: page id = 'SmallWiki'. self assert: page parent isNil. self assert: page predecessor isNil. self assert: page timestamp <= TimeStamp now. self assert: page version = 0. self assert: page properties isEmpty. self deny: page document isNil. resource := SWResource title: 'Small Wiki'. self assert: resource title = 'Small Wiki'. self assert: resource id = 'SmallWiki'. self assert: resource parent isNil. self assert: resource predecessor isNil. self assert: resource timestamp <= TimeStamp now. self assert: resource version = 0. self assert: resource properties isEmpty. self deny: resource data isNil. self deny: resource mimetype isNil.! ! !SWStructureTests methodsFor: 'testing-utilities'! testIdentifierCaracter self assert: $a isWikiIdentifier. self assert: $z isWikiIdentifier. self assert: $A isWikiIdentifier. self assert: $Z isWikiIdentifier. self assert: $0 isWikiIdentifier. self assert: $9 isWikiIdentifier. self assert: $. isWikiIdentifier. self assert: $- isWikiIdentifier. self assert: $_ isWikiIdentifier. self deny: $ isWikiIdentifier. self deny: $/ isWikiIdentifier. self deny: $: isWikiIdentifier. self deny: $& isWikiIdentifier. self deny: $? isWikiIdentifier.! ! !SWStructureTests methodsFor: 'testing-utilities'! testIdentifierString self assert: 'SmallWiki' asWikiIdentifier = 'SmallWiki'. self assert: 'Lukas Renggli' asWikiIdentifier = 'LukasRenggli'. self assert: 'favicon.ico' asWikiIdentifier = 'favicon.ico'. self assert: '/usr/sbin/apache' asWikiIdentifier = 'usrsbinapache'. self assert: 'apache_src-1.2beta9.zip' asWikiIdentifier = 'apache_src-1.2beta9.zip'.! ! !SWStructureTests methodsFor: 'testing-navigation'! testFirst self assert: fd first == fd. self assert: fd1 first == fd1. self assert: fd11 first == fd11. self assert: fd111 first == fd111. self assert: fd12 first == fd11. self assert: fd2 first == fd1. self assert: pa21 first == pa21. self assert: pa22 first == pa21. self assert: fd3 first == fd1. self assert: re31 first == re31. self assert: re32 first == re31.! ! !SWStructureTests methodsFor: 'testing-navigation'! testLast self assert: fd last == fd. self assert: fd1 last == fd3. self assert: fd11 last == fd12. self assert: fd111 last == fd111. self assert: fd12 last == fd12. self assert: fd2 last == fd3. self assert: pa21 last == pa22. self assert: pa22 last == pa22. self assert: fd3 last == fd3. self assert: re31 last == re32. self assert: re32 last == re32.! ! !SWStructureTests methodsFor: 'testing-navigation'! testNext self assert: fd next == nil. self assert: fd1 next == fd2. self assert: fd11 next == fd12. self assert: fd111 next == nil. self assert: fd12 next == nil. self assert: fd2 next == fd3. self assert: pa21 next == pa22. self assert: pa22 next == nil. self assert: fd3 next == nil. self assert: re31 next == re32. self assert: re32 next == nil.! ! !SWStructureTests methodsFor: 'testing-navigation'! testPrevious self assert: fd previous == nil. self assert: fd1 previous == nil. self assert: fd11 previous == nil. self assert: fd111 previous == nil. self assert: fd12 previous == fd11. self assert: fd2 previous == fd1. self assert: pa21 previous == nil. self assert: pa22 previous == pa21. self assert: fd3 previous == fd2. self assert: re31 previous == nil. self assert: re32 previous == re31.! ! !SWStructureTests methodsFor: 'testing-resolving'! testParsePath self assert: (fd privateParsePath: '') isEmpty. self assert: (fd privateParsePath: 'a') size = 1. self assert: (fd privateParsePath: '/') first = ''. self assert: (fd privateParsePath: '/') last = ''. self assert: (fd privateParsePath: 'a') size = 1. self assert: (fd privateParsePath: 'a') first = 'a'. self assert: (fd privateParsePath: 'a') last = 'a'. self assert: (fd privateParsePath: '/a') size = 2. self assert: (fd privateParsePath: '/a') first = ''. self assert: (fd privateParsePath: '/a') last = 'a'. self assert: (fd privateParsePath: 'a/b/c') size = 3. self assert: (fd privateParsePath: 'a/b/c') first = 'a'. self assert: (fd privateParsePath: 'a/b/c') last = 'c'. self assert: (fd privateParsePath: '/a/b/c') size = 4. self assert: (fd privateParsePath: '/a/b/c') first = ''. self assert: (fd privateParsePath: '/a/b/c') last = 'c'. self assert: (fd privateParsePath: ' a ') size = 1. self assert: (fd privateParsePath: ' a ') first = 'a'. self assert: (fd privateParsePath: ' a ') last = 'a'. self assert: (fd privateParsePath: '/ a ') size = 2. self assert: (fd privateParsePath: '/ a ') first = ''. self assert: (fd privateParsePath: '/ a ') last = 'a'. self assert: (fd privateParsePath: ' a / b / c ') size = 3. self assert: (fd privateParsePath: ' a / b / c ') first = 'a'. self assert: (fd privateParsePath: ' a / b / c ') last = 'c'. self assert: (fd privateParsePath: ' /a / b / c ') size = 4. self assert: (fd privateParsePath: ' /a / b / c ') first = ''. self assert: (fd privateParsePath: ' /a / b / c ') last = 'c'! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolveChild self assert: (fd resolveTo: '/Folder 1') == fd1. self assert: (fd1 resolveTo: 'Folder 1/Folder 1.1') == fd11. self assert: (fd11 resolveTo: 'Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd1 resolveTo: 'Folder 1/Folder 1.2') == fd12. self assert: (fd1 resolveTo: 'Folder 1/Folder 1.3') == nil. self assert: (fd resolveTo: '/Folder 2') == fd2. self assert: (fd2 resolveTo: 'Folder 2/Page 2.1') == pa21. self assert: (fd2 resolveTo: 'Folder 2/Page 2.2') == pa22. self assert: (fd2 resolveTo: 'Folder 2/Page 2.3') == nil. self assert: (fd resolveTo: '/Folder 3') == fd3. self assert: (fd3 resolveTo: 'Folder 3/Resource 3.1') == re31. self assert: (fd3 resolveTo: 'Folder 3/Resource 3.2') == re32. self assert: (fd3 resolveTo: 'Folder 3/Resource 3.3') == nil.! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolveNotFound | testblock | testblock := [ :path | self assert: (fd resolveTo: path) isNil. self assert: (fd1 resolveTo: path) isNil. self assert: (fd11 resolveTo: path) isNil. self assert: (fd111 resolveTo: path) isNil. self assert: (fd2 resolveTo: path) isNil. self assert: (pa21 resolveTo: path) isNil. self assert: (pa22 resolveTo: path) isNil. self assert: (fd3 resolveTo: path) isNil. self assert: (re31 resolveTo: path) isNil. self assert: (re31 resolveTo: path) isNil ]. testblock value: 'unknown'. testblock value: 'unknown/unknown'. testblock value: 'unknown/unknown/unknown'. testblock value: 'Folder 1/unknown'. testblock value: 'Folder 1/Folder 1.1/unknown'. testblock value: 'Folder 1/Folder 1.1/Folder 1.1.1/unknown'! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolvePath self assert: (fd resolveTo: '/Folder 1') == fd1. self assert: (fd resolveTo: '/Folder 1/Folder 1.1') == fd11. self assert: (fd resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd resolveTo: '/Folder 1/Folder 1.2') == fd12. self assert: (fd resolveTo: '/Folder 2') == fd2. self assert: (fd resolveTo: '/Folder 2/Page 2.1') == pa21. self assert: (fd resolveTo: '/Folder 2/Page 2.2') == pa22. self assert: (fd resolveTo: '/Folder 3') == fd3. self assert: (fd resolveTo: '/Folder 3/Resource 3.1') == re31. self assert: (fd resolveTo: '/Folder 3/Resource 3.2') == re32.! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolvePathRoot self assert: (fd resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd1 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd11 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd111 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd12 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd2 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (pa21 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (pa22 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (fd3 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (re31 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111. self assert: (re31 resolveTo: '/Folder 1/Folder 1.1/Folder 1.1.1') == fd111.! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolveReceiver self assert: (fd1 resolveTo: 'Folder 1') == fd1. self assert: (fd11 resolveTo: 'Folder 1.1') == fd11. self assert: (fd111 resolveTo: 'Folder 1.1.1') == fd111. self assert: (fd2 resolveTo: 'Folder 2') == fd2. self assert: (pa21 resolveTo: 'Page 2.1') == pa21. self assert: (pa22 resolveTo: 'Page 2.2') == pa22. self assert: (fd3 resolveTo: 'Folder 3') == fd3. self assert: (re31 resolveTo: 'Resource 3.1') == re31. self assert: (re32 resolveTo: 'Resource 3.2') == re32. self assert: (fd1 resolveTo: '') == fd1. self assert: (fd11 resolveTo: '') == fd11. self assert: (fd111 resolveTo: '') == fd111. self assert: (fd2 resolveTo: '') == fd2. self assert: (pa21 resolveTo: '') == pa21. self assert: (pa22 resolveTo: '') == pa22. self assert: (fd3 resolveTo: '') == fd3. self assert: (re31 resolveTo: '') == re31. self assert: (re32 resolveTo: '') == re32.! ! !SWStructureTests methodsFor: 'testing-resolving'! testResolveSister self assert: (fd1 resolveTo: 'Folder 1') == fd1. self assert: (fd1 resolveTo: 'Folder 2') == fd2. self assert: (fd1 resolveTo: 'Folder 3') == fd3. self assert: (fd11 resolveTo: 'Folder 1.1') == fd11. self assert: (fd11 resolveTo: 'Folder 1.2') == fd12. self assert: (fd111 resolveTo: 'Folder 1.1.1') == fd111. self assert: (fd12 resolveTo: 'Folder 1.1') == fd11. self assert: (fd12 resolveTo: 'Folder 1.2') == fd12. self assert: (fd2 resolveTo: 'Folder 1') == fd1. self assert: (fd2 resolveTo: 'Folder 2') == fd2. self assert: (fd2 resolveTo: 'Folder 3') == fd3. self assert: (pa21 resolveTo: 'Page 2.1') == pa21. self assert: (pa21 resolveTo: 'Page 2.2') == pa22. self assert: (pa22 resolveTo: 'Page 2.1') == pa21. self assert: (pa22 resolveTo: 'Page 2.2') == pa22. self assert: (fd3 resolveTo: 'Folder 1') == fd1. self assert: (fd3 resolveTo: 'Folder 2') == fd2. self assert: (fd3 resolveTo: 'Folder 3') == fd3. self assert: (re31 resolveTo: 'Resource 3.1') == re31. self assert: (re31 resolveTo: 'Resource 3.2') == re32. self assert: (re32 resolveTo: 'Resource 3.1') == re31. self assert: (re32 resolveTo: 'Resource 3.2') == re32. " self assert: (ch1 resolveTo: 'Folder 1.1') == ch11. self assert: (ch11 resolveTo: 'Folder 1.1.1') == ch111. self assert: (ch resolveTo: 'Folder 2') == ch2. self assert: (ch2 resolveTo: 'Page 2.1') == pa21. self assert: (ch2 resolveTo: 'Page 2.2') == pa22. self assert: (ch2 resolveTo: 'Page 2.3') == nil. self assert: (ch resolveTo: 'Folder 3') == ch3. self assert: (ch3 resolveTo: 'Resource 3.1') == re31. self assert: (ch3 resolveTo: 'Resource 3.2') == re32. self assert: (ch3 resolveTo: 'Resource 3.3') == nil."! ! !SWStructureTests methodsFor: 'testing-serving' stamp: 'chbu 10/24/2003 16:32'! testProcess | request | fd process: (request := self requestWithUrl: ''). self assert: ('*Root: Root*' match: request response stream contents). fd process: (request := self requestWithUrl: '/'). self assert: ('*Root: Root*' match: request response stream contents).! ! !SWStructureTests methodsFor: 'testing-serving'! testProcessAction | request default | fd process: (request := self requestWithUrl: '/'). default := request response stream contents. fd process: (request := self requestWithUrl: '/' action: 'PageView'). self deny: ('*Not Found*' match: request response stream contents). self assert: default = request response stream contents. fd process: (request := self requestWithUrl: '/' action: 'UnknownAction'). self deny: ('*Not Found*' match: request response stream contents). self assert: default = request response stream contents.! ! !SWStructureTests methodsFor: 'testing-serving'! testProcessChild | request | fd process: (request := self requestWithUrl: '/Folder1'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Folder 1*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder1/'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Folder 1*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder1/Folder1.1'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Folder 1.1*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder 1/Folder1.1/'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Folder 1.1*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder2/Page2.1'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Page 2.1*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder3/Resource3.1'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Root: Edit Resource 3.1*' match: request response stream contents).! ! !SWStructureTests methodsFor: 'testing-serving'! testProcessNotFound | request | fd process: (request := self requestWithUrl: '/Folder4'). self assert: ('*Not Found*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder2/Page2.1/Page2.1.1'). self assert: ('*Not Found*' match: request response stream contents). fd process: (request := self requestWithUrl: '/Folder3/Resource3.1/Resource3.1.1'). self assert: ('*Not Found*' match: request response stream contents).! ! !SWStructureTests methodsFor: 'testing-serving'! testProcessSecurity | request | fd process: (request := self requestWithUrl: '/' action: 'PageHistory'). self deny: ('*Not Found*' match: request response stream contents). self assert: ('*Unauthorized*' match: request response stream contents).! ! !SWStructureTests methodsFor: 'running' stamp: 'chbu 10/22/2003 09:47'! setUp "create tree" (fd := SWFolder title: 'Root') add: ((fd1 := SWFolder title: 'Folder 1') add: ((fd11 := SWFolder title: 'Folder 1.1') add: (fd111 := SWFolder title: 'Folder 1.1.1'); yourself); add: (fd12 := SWFolder title: 'Folder 1.2'); yourself); add: ((fd2 := SWFolder title: 'Folder 2') add: (pa21 := SWPage title: 'Page 2.1'); add: (pa22 := SWPage title: 'Page 2.2'); yourself); add: ((fd3 := SWFolder title: 'Folder 3') add: (re31 := SWResource title: 'Resource 3.1'); add: (re32 := SWResource title: 'Resource 3.2'); yourself). "create some properites" fd propertyAt: #level put: 0. fd1 propertyAt: #level put: 1. fd11 propertyAt: #level put: 2. fd111 propertyAt: #level put: 3. fd propertyAt: #trueTag put: true. fd11 propertyAt: #falseTag put: false. "dependency" fd addDependent: self. counter := 0. parameter := nil.! ! !SWStructureTests methodsFor: 'running'! tearDown fd removeDependent: self! ! !SWStructureTests methodsFor: 'utilites' stamp: 'chbu 10/22/2003 09:49'! requestWithUrl: anUrlString ^(SWRequest server: SWServer new) headers: Dictionary new; fields: Dictionary new; cookies: Dictionary new; url: anUrlString; yourself! ! !SWStructureTests methodsFor: 'utilites'! requestWithUrl: anUrlString action: anActionString ^(self requestWithUrl: anUrlString) fields: (Dictionary new at: 'action' put: anActionString; yourself); yourself! ! !SWTemplate methodsFor: 'rendering-config'! renderConfigBoolean: anAction on: html label: aString selector: aSymbol self renderConfigCustom: anAction on: html label: String new do: [ html label: [ html checkboxWithValue: (self perform: aSymbol) callback: [ :action :value | self perform: (aSymbol , ':') asSymbol with: value ]. html text: aString ] ]! ! !SWTemplate methodsFor: 'rendering-config'! renderConfigCustom: anAction on: html label: aString do: aBlock html tableRow: [ html attributeAt: #width put: 100. html cssClass: #label; tableData: aString. html cssClass: #field; tableData: aBlock ]! ! !SWTemplate methodsFor: 'rendering-config'! renderConfigString: anAction on: html label: aString selector: aSymbol self renderConfigCustom: anAction on: html label: aString do: [ html attributeAt: #style put: 'width: 100%'. html textInputWithValue: (self perform: aSymbol) callback: [ :action :value | self perform: (aSymbol , ':') asSymbol with: value ] ]! ! !SWTemplate methodsFor: 'rendering-config'! renderConfigTitle: anAction on: html html tableRow: [ html attributeAt: 'colspan' put: 2. html tableData: [ html heading: self class title level: 3 ] ]! ! !SWTemplate methodsFor: 'initialization'! initialize! ! !SWTemplate methodsFor: 'private'! expand: aString for: anAction "Expand aString within the context of anAction. This is often used to let the user specify dynamic parts within the settings of the templates. Currently the following tags are supported: \begin{itemize} \item \texttt{\%a} the title of the action \item \texttt{\%h} the host-name of the server \item \texttt{\%i} the ip-number of the server \item \texttt{\%l} the the url of the structure \item \texttt{\%m} the modification time of the structure \item \texttt{\%p} the port-number of the server \item \texttt{\%r} the title of the root structure \item \texttt{\%t} the title of the structure \item \texttt{\%u} the name of the current user \item \texttt{\%v} the version-number of the structure \end{itemize}" | read | read := aString readStream. ^String streamContents: [ :write | [ read atEnd ] whileFalse: [ write nextPutAll: (read upTo: $%). read atEnd ifFalse: [ write nextPutAll: (self expandChar: read next for: anAction) ] ] ]! ! !SWTemplate methodsFor: 'private'! expandChar: aCharacter for: anAction | block | block := self class expandTable at: aCharacter ifAbsent: [ [ :action | String with: aCharacter ] ]. ^(block value: anAction) displayString! ! !SWTemplate methodsFor: 'rendering'! renderBodyWith: anAction on: html "This message is called when the action should render its content to the body-part of the resulting XHTML document. The default implementation is empty."! ! !SWTemplate methodsFor: 'rendering'! renderConfigWith: anAction on: html "This message is called when the configuration form of the receiver should be rendered. This message is solely called from the \texttt{TemplateEdit} action to let the user specify his settings. The default implementation is empty."! ! !SWTemplate methodsFor: 'rendering'! renderHeadWith: anAction on: html "This message is called when the action should render its content to the head-part of the resulting XHTML document. The default implementation is empty."! ! !SWTemplate class methodsFor: 'accessing' stamp: 'chbu 10/22/2003 10:02'! expandTable ^SWExpandTable! ! !SWTemplate class methodsFor: 'accessing'! isRemoveable ^true! ! !SWTemplate class methodsFor: 'accessing'! title ^nil! ! !SWTemplate class methodsFor: 'instance-creation'! new ^super new initialize; yourself! ! !SWTemplate class methodsFor: 'initialization' stamp: 'chbu 10/22/2003 10:02'! initialize SWExpandTable := Dictionary new at: $a put: [ :action | action heading ]; at: $h put: [ :action | action server host ]; at: $i put: [ :action | action server ip ]; at: $l put: [ :action | action structure url ]; at: $m put: [ :action | action structure timestamp ]; at: $p put: [ :action | action server port ]; at: $r put: [ :action | action structure root title ]; at: $t put: [ :action | action structure title ]; at: $u put: [ :action | action user username ]; at: $v put: [ :action | action structure version ]; yourself! ! !SWTemplateBody methodsFor: 'accessing'! id ^id! ! !SWTemplateBody methodsFor: 'accessing'! id: aString id := aString! ! !SWTemplateBody methodsFor: 'accessing'! title ^title! ! !SWTemplateBody methodsFor: 'accessing'! title: aString title := aString! ! !SWTemplateBody methodsFor: 'rendering-tools'! renderDivFor: anAction on: html with: aBlock html divNamed: self id with: [ self title isEmpty ifFalse: [ html heading: (self expand: self title for: anAction) level: 1 ]. html render: aBlock ]! ! !SWTemplateBody methodsFor: 'initialization'! initialize super initialize. self id: self defaultId. self title: self defaultTitle.! ! !SWTemplateBody methodsFor: 'rendering'! renderBodyWith: anAction on: html "Override this message in all subclasses to render the body-part of the template. Do all the rendering within aBlock passed to the message #renderDivFor:on:with: to ensure that the XHTML environment is properly set-up and that the design can be specified using css-stylesheets."! ! !SWTemplateBody methodsFor: 'rendering'! renderConfigWith: anAction on: html "If you override this message in your subclasses don't forget to call super, as there are the default properties for the title and the css-id rendered in here." self renderConfigTitle: anAction on: html. self renderConfigString: anAction on: html label: 'Id' selector: #id. self renderConfigString: anAction on: html label: 'Title' selector: #title.! ! !SWTemplateBody methodsFor: 'configuration'! defaultId ^self class title asLowercase! ! !SWTemplateBody methodsFor: 'configuration'! defaultTitle ^self class title! ! !SWTemplateBodyActions methodsFor: 'tools' stamp: 'chbu 10/22/2003 17:55'! actionsFor: anAction | available sorted | available := anAction structure class actions select: [ :each | each isListable ]. sorted := self actions inject: OrderedCollection new into: [ :collection :action | (available includes: action) ifTrue: [ collection add: action ]. collection ]. ^sorted select: [ :each | [ (each request: anAction request structure: anAction structure) executePermission. true ] on: SWUnauthorizedError do: [ :err | err return: false ] ]! ! !SWTemplateBodyActions methodsFor: 'tools' stamp: 'chbu 10/22/2003 17:55'! allActions ^SWAction withAllSubclasses select: [ :each | each isListable ]! ! !SWTemplateBodyActions methodsFor: 'tools'! listActions ^self allActions reject: [ :each | self actions includes: each ]! ! !SWTemplateBodyActions methodsFor: 'configuration' stamp: 'chbu 10/22/2003 17:55'! defaultActions ^OrderedCollection new add: SWPageView; add: SWPageEdit; add: SWFolderEdit; add: SWResourceEdit; add: SWPageHistory; add: SWResourceHistory; add: SWRecentChanges; add: SWSearch; add: SWTemplateEdit; yourself! ! !SWTemplateBodyActions methodsFor: 'accessing'! actions ^actions! ! !SWTemplateBodyActions methodsFor: 'accessing'! actions: anOrderedCollection actions := anOrderedCollection! ! !SWTemplateBodyActions methodsFor: 'initialization'! initialize super initialize. self actions: self defaultActions.! ! !SWTemplateBodyActions methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ html divClass: #list with: [ (self actionsFor: anAction) do: [ :each | html divClass: #listItem with: [ html anchorWithUrl: (each urlFor: anAction structure) do: each title ] ] separatedBy: [ html spanClass: #listSeparator with: nil ] ] ]! ! !SWTemplateBodyActions methodsFor: 'rendering'! renderConfigActions: anAction on: html | listed selected | listed := selected := nil. html layoutTable: [ html tableRowWith: [ html attributeAt: #size put: 6. html selectFromList: self listActions selected: nil callback: [ :action :value | listed := value ] labels: [ :class | class name , ' (' , class title , ')' ]. html attributeAt: #size put: 6. html selectFromList: self actions selected: nil callback: [ :action :value | selected := value ] labels: [ :class | class name , ' (' , class title , ')' ] ]. html tableRow: [ html attributeAt: #align put: #center. html tableData: [ html submitButtonWithAction: [ listed isNil ifFalse: [ self actions add: listed ] ] text: 'add'. html submitButtonWithAction: [ self actions remove: selected ifAbsent: [ ] ] text: 'remove'. html submitButtonWithAction: [ self actions moveUp: selected ifError: [ ] ] text: 'up'. html submitButtonWithAction: [ self actions moveDown: selected ifError: [ ] ] text: 'down' ] ] ]! ! !SWTemplateBodyActions methodsFor: 'rendering'! renderConfigWith: anAction on: html super renderConfigWith: anAction on: html. html tableRow: [ html tableData: 'Actions'. html tableData: [ self renderConfigActions: anAction on: html ] ]! ! !SWTemplateBodyActions class methodsFor: 'configuration'! title ^'Actions'! ! !SWTemplateBodyContents methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ anAction renderContent ]! ! !SWTemplateBodyContents methodsFor: 'rendering'! renderHeadWith: anAction on: html html style: anAction structure stylesheet! ! !SWTemplateBodyContents methodsFor: 'configuration'! defaultTitle ^'%a'! ! !SWTemplateBodyContents class methodsFor: 'configuration'! isRemoveable ^false! ! !SWTemplateBodyContents class methodsFor: 'configuration'! title ^'Contents'! ! !SWTemplateBodyCustom methodsFor: 'accessing'! document ^document! ! !SWTemplateBodyCustom methodsFor: 'accessing'! document: aDocument document := aDocument! ! !SWTemplateBodyCustom methodsFor: 'accessing'! message ^message! ! !SWTemplateBodyCustom methodsFor: 'accessing'! message: aString message := aString! ! !SWTemplateBodyCustom methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:56'! source ^String streamContents: [ :stream | SWVisitorRendererWiki render: self document on: stream ]! ! !SWTemplateBodyCustom methodsFor: 'tools' stamp: 'chbu 10/22/2003 17:56'! parseSource: aString with: anAction self document: SWDocument new; message: nil. [ self document: (SWWikiParser parse: aString readStream for: anAction) ] on: SmaCCParserError do: [ :error | error return: (self message: error messageText) ]! ! !SWTemplateBodyCustom methodsFor: 'initialization' stamp: 'chbu 10/22/2003 09:53'! initialize super initialize. self document: (SWParagraph new add: (SWText newText: 'Last modified: '); add: (SWCode newCode: 'structure timestamp'); yourself)! ! !SWTemplateBodyCustom methodsFor: 'rendering' stamp: 'chbu 10/22/2003 17:56'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ self document isNil ifTrue: [ html spanNamed: #error with: self message ] ifFalse: [ SWVisitorRendererHtml render: self document with: anAction on: html ] ]! ! !SWTemplateBodyCustom methodsFor: 'rendering'! renderConfigWith: anAction on: html super renderConfigWith: anAction on: html. self renderConfigCustom: anAction on: html label: 'Source' do: [ html attributeAt: #rows put: 6; attributeAt: #style put: 'width: 100%'. html textAreaWithValue: self source callback: [ :action :value | self parseSource: value with: action ] ]! ! !SWTemplateBodyCustom class methodsFor: 'configuration'! title ^'Custom'! ! !SWTemplateBodyPath methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ html divClass: #list with: [ anAction structure parents do: [ :each | html divClass: #listItem with: [ html anchorWithUrl: each url do: each title ] ] separatedBy: [ html spanClass: #listSeparator with: nil ] ] ]! ! !SWTemplateBodyPath class methodsFor: 'configuration'! title ^'Path'! ! !SWTemplateBodyReferences methodsFor: 'rendering'! renderBodyWith: anAction on: html | references | references := self references: anAction. references isEmpty ifFalse: [ self renderDivFor: anAction on: html with: [ html divClass: #list with: [ references do: [ :each | html divClass: #listItem with: [ html anchorWithUrl: each url do: each title ] ] separatedBy: [ html spanClass: #listSeparator with: nil ] ] ] ]! ! !SWTemplateBodyReferences methodsFor: 'tools' stamp: 'chbu 10/22/2003 17:56'! references: anAction ^(SWVisitorReferences collect: anAction structure root to: anAction structure) collection! ! !SWTemplateBodyReferences class methodsFor: 'configuration'! title ^'References'! ! !SWTemplateBodySearch methodsFor: 'accessing'! expression ^expression! ! !SWTemplateBodySearch methodsFor: 'accessing'! expression: aString expression := aString! ! !SWTemplateBodySearch methodsFor: 'accessing'! ignoreCase ^ignoreCase! ! !SWTemplateBodySearch methodsFor: 'accessing'! ignoreCase: aBoolean ignoreCase := aBoolean! ! !SWTemplateBodySearch methodsFor: 'accessing'! root ^root! ! !SWTemplateBodySearch methodsFor: 'accessing'! root: aBoolean root := aBoolean! ! !SWTemplateBodySearch methodsFor: 'initialization'! initialize super initialize. self expression: 'Search %t ...'. self ignoreCase: true. self root: false.! ! !SWTemplateBodySearch methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ html attributeAt: #action put: (Search urlFor: anAction structure). html form: [ html textInputWithValue: (self expand: self expression for: anAction) callback: #expression:. html hiddenInputWithValue: self ignoreCase callback: #ignoreCase:. html hiddenInputWithValue: self root callback: #root:. html submitButtonWithAction: #executeSearch text: 'Search' ] ]! ! !SWTemplateBodySearch methodsFor: 'rendering'! renderConfigWith: anAction on: html super renderConfigWith: anAction on: html. self renderConfigString: anAction on: html label: 'Expression' selector: #expression. self renderConfigBoolean: anAction on: html label: 'Ignore character case' selector: #ignoreCase. self renderConfigBoolean: anAction on: html label: 'Start in the root-folder' selector: #root.! ! !SWTemplateBodySearch class methodsFor: 'configuration'! title ^'Search'! ! !SWTemplateBodySession methodsFor: 'accessing'! showRoles ^showRoles! ! !SWTemplateBodySession methodsFor: 'accessing'! showRoles: aBoolean showRoles := aBoolean! ! !SWTemplateBodySession methodsFor: 'accessing'! showUser ^showUser! ! !SWTemplateBodySession methodsFor: 'accessing'! showUser: aBoolean showUser := aBoolean! ! !SWTemplateBodySession methodsFor: 'initialization'! initialize super initialize. self showUser: true. self showRoles: true.! ! !SWTemplateBodySession methodsFor: 'rendering' stamp: 'chbu 10/22/2003 19:38'! renderBodyWith: anAction on: html | user | user := anAction user. self renderDivFor: anAction on: html with: [ html div: [ user isAnonymous ifTrue: [ html anchorWithUrl: (SWLogin urlFor: anAction structure) do: 'Login' ] ifFalse: [ html anchorWithUrl: (SWLogout urlFor: anAction structure) do: 'Logout' ] ]. user isAnonymous ifFalse: [ self showUser ifTrue: [ html div: [ html heading: 'User' level: 2. html divClass: #list with: [ html divClass: #listItem with: user username ] ] ]. self showRoles ifTrue: [ html div: [ html heading: 'Roles' level: 2. html divClass: #list with: [ user roles do: [ :each | html divClass: #listItem with: each name ] separatedBy: [ html spanClass: #listSeparator with: nil ] ] ] ] ] ]! ! !SWTemplateBodySession methodsFor: 'rendering'! renderConfigWith: anAction on: html super renderConfigWith: anAction on: html. self renderConfigBoolean: anAction on: html label: 'Show User' selector: #showUser. self renderConfigBoolean: anAction on: html label: 'Show Roles' selector: #showRoles.! ! !SWTemplateBodySession class methodsFor: 'configuration'! title ^'Session'! ! !SWTemplateBodyTitle methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: nil! ! !SWTemplateBodyTitle methodsFor: 'configuration'! defaultTitle ^'%r'! ! !SWTemplateBodyTitle class methodsFor: 'configuration'! title ^'Title'! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showCssValidator ^showCssValidator! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showCssValidator: anObject showCssValidator := anObject! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showHtmlValidator ^showHtmlValidator! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showHtmlValidator: anObject showHtmlValidator := anObject! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showPictures ^showPictures! ! !SWTemplateBodyW3C methodsFor: 'accessing'! showPictures: aBoolean showPictures := aBoolean! ! !SWTemplateBodyW3C methodsFor: 'initialization'! initialize super initialize. self showPictures: true. self showHtmlValidator: true. self showCssValidator: true.! ! !SWTemplateBodyW3C methodsFor: 'rendering'! renderBodyWith: anAction on: html self renderDivFor: anAction on: html with: [ html divClass: #list with: [ self showHtmlValidator ifTrue: [ html divClass: #listItem with: [ html anchorWithUrl: 'http://validator.w3.org/check/referer' do: [ self showPictures ifTrue: [ html image: 'http://www.w3.org/Icons/valid-xhtml10' alt: 'Valid XHTML!!' size: 88@31 ] ifFalse: [ html text: 'xhtml' ] ] ]. self showCssValidator ifTrue: [ html spanClass: #listSeparator with: nil ] ]. self showCssValidator ifTrue: [ html divClass: #listItem with: [ html anchorWithUrl: 'http://jigsaw.w3.org/css-validator/check/referer' do: [ self showPictures ifTrue: [ html image: 'http://jigsaw.w3.org/css-validator/images/vcss' alt: 'Valid CSS!!' size: 88@31 ] ifFalse: [ html text: 'css' ] ] ] ] ] ]! ! !SWTemplateBodyW3C methodsFor: 'rendering'! renderConfigWith: anAction on: html super renderConfigWith: anAction on: html. self renderConfigBoolean: anAction on: html label: 'Show Pictures' selector: #showPictures. self renderConfigBoolean: anAction on: html label: 'HTML Validator' selector: #showHtmlValidator. self renderConfigBoolean: anAction on: html label: 'CSS Validator' selector: #showCssValidator.! ! !SWTemplateBodyW3C class methodsFor: 'configuration'! title ^'Validator'! ! !SWTemplateEdit methodsFor: 'rendering'! renderContent self renderIntro. self hasLocalSettings ifTrue: [ self perform: self state ]! ! !SWTemplateEdit methodsFor: 'rendering'! renderForm: aBlock super renderForm: [ html hiddenInputWithValue: self state callback: #state:. aBlock value ]! ! !SWTemplateEdit methodsFor: 'rendering'! renderIntro self hasLocalSettings ifTrue: [ self renderIntroLocal ] ifFalse: [ self renderIntroNonLocal ]! ! !SWTemplateEdit methodsFor: 'rendering'! renderIntroLocal html paragraph: [ html text: 'The current structure defines its own template and inherits it to all its children. To '. html text: 'get the parent template applied, you have to '. html anchorWithAction: #makeSettingsNonLocal to: self url do: 'remove'. html text: ' the current settings first.' ]. self renderStates.! ! !SWTemplateEdit methodsFor: 'rendering'! renderIntroNonLocal html paragraph: [ html text: 'The current structure does not define its own template, but inherits the one of '. html anchorWithUrl: (self class urlFor: self settingsFrom) do: self settingsFrom title. html text: '. To redefine this template at this place, you have to '. html anchorWithAction: #makeSettingsLocal to: self url do: 'load it'. html text: ' into the current structure first.' ]! ! !SWTemplateEdit methodsFor: 'rendering'! renderStates html unorderedList: [ html listItem: [ html anchorWithAction: [ :action | action state: self stateTemplates ] to: self url do: 'Templates' ]. html listItem: [ html anchorWithAction: [ :action | action state: self stateSettings ] to: self url do: 'Settings' ]. html listItem: [ html anchorWithAction: [ :action | action state: self stateStylesheet ] to: self url do: 'Stylesheet' ] ]! ! !SWTemplateEdit methodsFor: 'accessing'! selectedAvailable ^selectedAvailable! ! !SWTemplateEdit methodsFor: 'accessing'! selectedAvailable: aClass selectedAvailable := aClass! ! !SWTemplateEdit methodsFor: 'accessing'! selectedChoosen ^selectedChoosen! ! !SWTemplateEdit methodsFor: 'accessing'! selectedChoosen: aTemplate selectedChoosen := aTemplate! ! !SWTemplateEdit methodsFor: 'accessing' stamp: 'chbu 10/22/2003 17:58'! templatesAvailable | templates | templates := SWTemplate withAllSubclasses reject: [ :each | each title isNil ]. ^templates asSortedCollection: [ :x :y | x title <= y title ]! ! !SWTemplateEdit methodsFor: 'accessing-state'! state state isNil ifTrue: [ state := self stateTemplates ]. ^state! ! !SWTemplateEdit methodsFor: 'accessing-state'! state: aSymbol state := aSymbol asSymbol! ! !SWTemplateEdit methodsFor: 'accessing-state'! stateSettings ^#renderSettings! ! !SWTemplateEdit methodsFor: 'accessing-state'! stateStylesheet ^#renderStylesheet! ! !SWTemplateEdit methodsFor: 'accessing-state'! stateTemplates ^#renderTemplates! ! !SWTemplateEdit methodsFor: 'rendering-pages'! renderSettings html heading: 'Settings' level: 2. self renderForm: [ html attributeAt: #width put: '100%'. html table: [ self structure templates do: [ :each | each renderConfigWith: self on: html ]. html tableRowWith: nil with: [ html submitButton: 'Save' ] ] ]! ! !SWTemplateEdit methodsFor: 'rendering-pages'! renderStylesheet | index | index := self repositoryIndex. html heading: 'Stylesheet' level: 2. index isEmpty ifFalse: [ self renderForm: [ html paragraph: [ html selectFromList: index selected: nil callback: [ :action :association | structure stylesheet: '@import "' , association key , '";' ] labels: [ :association | association value ]. html submitButton: 'Include' ] ] ]. self renderForm: [ html paragraph: [ html attributeAt: 'wrap' put: 'virtual'; attributeAt: 'cols' put: '70'; attributeAt: 'rows' put: '20'. html textAreaWithValue: self structure stylesheet callback: [ :action :value | structure stylesheet: value ]. html paragraph: [ html submitButton: 'Save' ] ] ]! ! !SWTemplateEdit methodsFor: 'rendering-pages'! renderTemplates html heading: 'Templates' level: 2. self renderForm: [ html table: [ html tableRow: [ html tableData: [ html attributeAt: #size put: 10. html selectFromList: self templatesAvailable selected: self selectedAvailable callback: #selectedAvailable: labels: [ :each | each title ] ]. html tableData: [ html attributeAt: #size put: 10. html selectFromList: self structure templates selected: self selectedChoosen callback: #selectedChoosen: labels: [ :each | each class title ] ] ]. html tableRow: [ html attributeAt: #align put: #center. html attributeAt: #colspan put: 2. html tableData: [ html submitButtonWithAction: #templateAdd text: 'add'. html submitButtonWithAction: #templateRemove text: 'remove'. html submitButtonWithAction: #templateUp text: 'up'. html submitButtonWithAction: #templateDown text: 'down' ] ] ] ]! ! !SWTemplateEdit methodsFor: 'actions'! executePermission self assertPermission: structure class permissionTemplate.! ! !SWTemplateEdit methodsFor: 'actions'! makeSettingsLocal | copyied | copyied := self settingsFrom templates collect: [ :each | each copy ]. structure templates: copyied. structure stylesheet: self settingsFrom stylesheet! ! !SWTemplateEdit methodsFor: 'actions'! makeSettingsNonLocal structure templates: nil. structure stylesheet: nil.! ! !SWTemplateEdit methodsFor: 'actions'! templateAdd | template | self selectedAvailable isNil ifFalse: [ template := self selectedAvailable new. self structure templates add: template. self selectedChoosen: template ]! ! !SWTemplateEdit methodsFor: 'actions'! templateDown | template other | template := self selectedChoosen. template isNil ifFalse: [ self structure templates last == template ifFalse: [ other := self structure templates after: template. self structure templates remove: template. self structure templates add: template after: other ] ]! ! !SWTemplateEdit methodsFor: 'actions'! templateRemove | template | template := self selectedChoosen. (self shouldRemove: template) ifTrue: [ self structure templates remove: template ]! ! !SWTemplateEdit methodsFor: 'actions'! templateUp | template other | template := self selectedChoosen. template isNil ifFalse: [ self structure templates first == template ifFalse: [ other := self structure templates before: template. self structure templates remove: template. self structure templates add: template before: other ] ]! ! !SWTemplateEdit methodsFor: 'repository' stamp: 'chbu 10/22/2003 17:58'! repositoryIndex | result stream | result := OrderedCollection new. stream := (self repositoryFrom: self repositoryPath) readStream. [ stream atEnd ] whileFalse: [ result add: (stream upTo: Character space) -> (stream upTo: Character lf) ]. ^result! ! !SWTemplateEdit methodsFor: 'repository'! repositoryPath ^'http://www.iam.unibe.ch/~scg/smallwiki/index.txt'! ! !SWTemplateEdit methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:24'! repositoryFrom: anUrlString ^'[ (Net.HttpClient new get: anUrlString) contents ] on: Net.HttpException , OS.OsError do: [ :err | err return: String new ]'! ! !SWTemplateEdit methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:24'! settingsFrom ^self structure parents reverse detect: [ :each | each localProperties includes: #internalTemplates ] ifNone: [ self structure root ]! ! !SWTemplateEdit methodsFor: 'tools'! hasLocalSettings ^self structure == self settingsFrom! ! !SWTemplateEdit methodsFor: 'tools'! shouldRemove: aTemplate ^aTemplate notNil and: [ aTemplate class isRemoveable or: [ self structure templates contains: [ :each | aTemplate ~= each and: [ aTemplate class = each class ] ] ] ]! ! !SWTemplateEdit class methodsFor: 'accessing'! title ^'Template'! ! !SWTemplateHead methodsFor: 'rendering'! renderMetaLink: aString to: aStructure on: html aStructure isNil ifFalse: [ html link: aString to: aStructure url title: aStructure title ]! ! !SWTemplateHeadMeta methodsFor: 'accessing'! author ^author! ! !SWTemplateHeadMeta methodsFor: 'accessing'! author: aString author := aString! ! !SWTemplateHeadMeta methodsFor: 'accessing'! description ^description! ! !SWTemplateHeadMeta methodsFor: 'accessing'! description: aString description := aString! ! !SWTemplateHeadMeta methodsFor: 'accessing'! encoding ^encoding! ! !SWTemplateHeadMeta methodsFor: 'accessing'! encoding: aString encoding := aString! ! !SWTemplateHeadMeta methodsFor: 'accessing'! follow ^follow! ! !SWTemplateHeadMeta methodsFor: 'accessing'! follow: aBoolean follow := aBoolean! ! !SWTemplateHeadMeta methodsFor: 'accessing'! index ^index! ! !SWTemplateHeadMeta methodsFor: 'accessing'! index: aBoolean index := aBoolean! ! !SWTemplateHeadMeta methodsFor: 'accessing'! keywords ^keywords! ! !SWTemplateHeadMeta methodsFor: 'accessing'! keywords: aString keywords := aString! ! !SWTemplateHeadMeta methodsFor: 'rendering'! renderConfigWith: anAction on: html self renderConfigTitle: anAction on: html. self renderConfigString: anAction on: html label: 'Encoding' selector: #encoding. self renderConfigString: anAction on: html label: 'Description' selector: #description. self renderConfigString: anAction on: html label: 'Keywords' selector: #keywords. self renderConfigString: anAction on: html label: 'Author' selector: #author. self renderConfigBoolean: anAction on: html label: 'Index' selector: #index. self renderConfigBoolean: anAction on: html label: 'Follow' selector: #follow.! ! !SWTemplateHeadMeta methodsFor: 'rendering'! renderHeadWith: anAction on: html self encoding notEmpty ifTrue: [ html metaEncoding: self encoding ]. self keywords notEmpty ifTrue: [ html meta: 'keywords' content: (self expand: self keywords for: anAction) ]. self description notEmpty ifTrue: [ html meta: 'description' content: (self expand: self description for: anAction) ]. self author notEmpty ifTrue: [ html meta: 'author' content: (self expand: self author for: anAction) ]. html meta: 'robots' content: (self robotMetaWith: anAction)! ! !SWTemplateHeadMeta methodsFor: 'rendering'! robotMetaWith: anAction ^String streamContents: [ :stream | self index & anAction isIndexable ifFalse: [ stream nextPutAll: 'no' ]. stream nextPutAll: 'index,'. self follow ifFalse: [ stream nextPutAll: 'no' ]. stream nextPutAll: 'follow' ]! ! !SWTemplateHeadMeta methodsFor: 'initialization'! initialize super initialize. self encoding: 'text/html; charset=iso-8859-1'. self description: String new. self keywords: '%t'. self author: String new. self index: true. self follow: true.! ! !SWTemplateHeadMeta class methodsFor: 'configuration'! title ^'Metatag Common'! ! !SWTemplateHeadNavigation methodsFor: 'rendering'! renderHeadWith: action on: html self renderMetaLink: 'contents' to: action structure root on: html. self renderMetaLink: 'chapter' to: action structure parent on: html. self renderMetaLink: 'prev' to: action structure previous on: html. self renderMetaLink: 'next' to: action structure next on: html. self renderMetaLink: 'start' to: action structure first on: html. self renderMetaLink: 'end' to: action structure last on: html.! ! !SWTemplateHeadNavigation class methodsFor: 'configuration'! title ^'Metatag Navigational'! ! !SWTemplateHeadTitle methodsFor: 'accessing'! title ^title! ! !SWTemplateHeadTitle methodsFor: 'accessing'! title: aString title := aString! ! !SWTemplateHeadTitle methodsFor: 'rendering'! renderConfigWith: anAction on: html self renderConfigTitle: anAction on: html. self renderConfigString: anAction on: html label: 'Title' selector: #title.! ! !SWTemplateHeadTitle methodsFor: 'rendering'! renderHeadWith: anAction on: html html title: (self expand: self title for: anAction)! ! !SWTemplateHeadTitle methodsFor: 'initialization'! initialize super initialize. self title: '%r: %a'.! ! !SWTemplateHeadTitle class methodsFor: 'configuration'! title ^'Metatag Title'! ! !SWTemplateTests methodsFor: 'testing-special' stamp: 'chbu 10/22/2003 09:53'! testingBody | template | SWTemplateBody allSubclasses do: [ :each | template := each new. self deny: template id isNil. self deny: template title isNil ]! ! !SWTemplateTests methodsFor: 'testing-special' stamp: 'chbu 10/22/2003 09:53'! testingBodyAccessing | template | template := SWTemplateBodyPath new. template id: 'myId'. self assert: template id = 'myId'. template title: 'myTitle'. self assert: template title = 'myTitle'.! ! !SWTemplateTests methodsFor: 'testing-special' stamp: 'chbu 10/22/2003 09:53'! testingHead | action stream | action := SWPageEdit new. stream := SWHtmlWriteStream on: String new. " no body rendering in head templates " SWTemplateHead withAllSubclasses do: [ :each | each new renderBodyWith: action on: stream. self assert: stream isEmpty ]! ! !SWTemplateTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:52'! testClass self assert: SWTemplate title isNil. self assert: SWTemplate isRemoveable.! ! !SWTemplateTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:53'! testExpansion | template action | template := SWTemplate new. action := SWPageEdit new. self assert: (template expand: String new for: action) = String new. self assert: (template expand: '%' for: action) = String new. self assert: (template expand: '%%' for: action) = '%'. self assert: (template expand: 'abc' for: action) = 'abc'. self assert: (template expand: 'abc%' for: action) = 'abc'. self assert: (template expand: 'abc%%' for: action) = 'abc%'. self assert: (template expand: '%a' for: action) = 'Edit'. self assert: (template expand: 'abc%a' for: action) = 'abcEdit'. self assert: (template expand: '%aabc' for: action) = 'Editabc'. self assert: (template expand: 'abc%aabc' for: action) = 'abcEditabc'.! ! !SWTemplateTests methodsFor: 'testing' stamp: 'chbu 10/22/2003 09:53'! testRendering | template action stream | template := SWTemplate new. action := SWPageEdit new. stream := SWHtmlWriteStream on: String new. template renderHeadWith: action on: stream. self assert: stream contents isEmpty. template renderBodyWith: action on: stream. self assert: stream contents isEmpty. template renderConfigWith: action on: stream. self assert: stream contents isEmpty.! ! !SWUser methodsFor: 'accessing'! roles ^roles! ! !SWUser methodsFor: 'accessing'! username ^username! ! !SWUser methodsFor: 'accessing-roles'! add: aRole roles remove: aRole ifAbsent: [ ]. roles add: aRole! ! !SWUser methodsFor: 'accessing-roles'! do: aBlock ^roles do: aBlock! ! !SWUser methodsFor: 'accessing-roles'! remove: aRole ^roles remove: aRole ifAbsent: [ nil ]! ! !SWUser methodsFor: 'update'! updateRole: aRole "Create a new user with aRole updated." ^(roles includes: aRole) ifTrue: [ self copy add: aRole; yourself ] ifFalse: [ self ]! ! !SWUser methodsFor: 'update'! updateRoles: aCollection "Create a new user with aCollection of roles updated." ^aCollection inject: self into: [ :user :role | user updateRole: role ]! ! !SWUser methodsFor: 'copying'! postCopy super postCopy. roles := roles copy.! ! !SWUser methodsFor: 'testing'! hasPermission: aPermission ^roles anySatisfy: [ :role | role hasPermission: aPermission ]! ! !SWUser methodsFor: 'testing'! isAnonymous ^self = self class anonymous! ! !SWUser methodsFor: 'testing'! validatePassword: aString "Returns true if the password could be validated or false in the opposite case. Note: If the passwort of ther receiving user is nil it will validate with everything!!" ^password isNil or: [ password = aString ]! ! !SWUser methodsFor: 'private'! password: aString password := aString! ! !SWUser methodsFor: 'private'! username: aString username := aString! ! !SWUser methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPut: $(; print: self username; nextPut: $).! ! !SWUser methodsFor: 'initialize'! initialize super initialize. roles := Set new! ! !SWUser methodsFor: 'comparing'! = anUser ^self class = anUser class and: [ username = anUser username ]! ! !SWUser methodsFor: 'comparing'! hash ^username hash! ! !SWUser class methodsFor: 'instance creation'! anonymous ^self username: 'anonymous' password: nil! ! !SWUser class methodsFor: 'instance creation'! username: anUsername password: aPassword ^self new username: anUsername; password: aPassword; yourself! ! !SWViewAction methodsFor: 'accessing-heading'! headingAction ^nil! ! !SWViewAction methodsFor: 'action'! executePermission self assertPermission: structure class permissionView.! ! !SWViewAction methodsFor: 'testing'! isIndexable "All the view actions should be indexed by search-engines." ^true! ! !SWMimeView methodsFor: 'rendering'! render response type: structure mimetype. response stream: structure stream.! ! !SWPageView methodsFor: 'rendering'! renderContent self structure defaultVisitor render: self structure document with: self on: html! ! !SWPageView class methodsFor: 'accessing'! title ^'View'! ! !SWVisitor methodsFor: 'visiting-structure'! acceptFolder: aFolder self acceptPage: aFolder. self visitCollection: aFolder children! ! !SWVisitor methodsFor: 'visiting-structure'! acceptPage: aPage self acceptStructure: aPage. self visit: aPage document! ! !SWVisitor methodsFor: 'visiting-structure'! acceptProperties: aPropertyManager! ! !SWVisitor methodsFor: 'visiting-structure'! acceptResource: aResource self acceptStructure: aResource! ! !SWVisitor methodsFor: 'visiting-structure'! acceptStructure: aStructure self visit: aStructure properties! ! !SWVisitor methodsFor: 'visiting-document'! acceptCode: aCode! ! !SWVisitor methodsFor: 'visiting-document'! acceptDocument: aDocument self visitCollection: aDocument children! ! !SWVisitor methodsFor: 'visiting-document'! acceptHeader: aHeader self acceptText: aHeader! ! !SWVisitor methodsFor: 'visiting-document'! acceptHorizontalRule: aHorizontalRule! ! !SWVisitor methodsFor: 'visiting-document'! acceptLink: aLink self acceptText: aLink! ! !SWVisitor methodsFor: 'visiting-document'! acceptLinkExternal: aLinkExternal self acceptLink: aLinkExternal! ! !SWVisitor methodsFor: 'visiting-document'! acceptLinkInternal: aLinkInternal self acceptLink: aLinkInternal! ! !SWVisitor methodsFor: 'visiting-document'! acceptLinkInternalBroken: aLinkInternal self acceptLinkInternal: aLinkInternal! ! !SWVisitor methodsFor: 'visiting-document'! acceptLinkMailTo: aLinkMailTo self acceptLink: aLinkMailTo! ! !SWVisitor methodsFor: 'visiting-document'! acceptListItem: aListItem self visitCollection: aListItem children! ! !SWVisitor methodsFor: 'visiting-document'! acceptOrderedList: anOrderedList self visitCollection: anOrderedList children! ! !SWVisitor methodsFor: 'visiting-document'! acceptParagraph: aParagraph self visitCollection: aParagraph children! ! !SWVisitor methodsFor: 'visiting-document'! acceptPreformatted: aPreformatted self visitCollection: aPreformatted children! ! !SWVisitor methodsFor: 'visiting-document'! acceptTable: aTable self visitCollection: aTable children! ! !SWVisitor methodsFor: 'visiting-document'! acceptTableCell: aTableCell self visitCollection: aTableCell children! ! !SWVisitor methodsFor: 'visiting-document'! acceptTableRow: aTableRow self visitCollection: aTableRow children! ! !SWVisitor methodsFor: 'visiting-document'! acceptText: aText! ! !SWVisitor methodsFor: 'visiting-document'! acceptUnorderedList: aUnorderedList self visitCollection: aUnorderedList children! ! !SWVisitor methodsFor: 'visiting'! visit: aWikiItem aWikiItem isNil ifFalse: [ aWikiItem accept: self ]! ! !SWVisitor methodsFor: 'visiting'! visitCollection: aCollection aCollection do: [ :child | child accept: self ]! ! !SWVisitor methodsFor: 'visiting'! visitCollection: aCollection separatedBy: aBlock aCollection do: [ :child | child accept: self ] separatedBy: aBlock! ! !SWVisitor methodsFor: 'initialize'! initialize! ! !SWVisitor class methodsFor: 'instance creation'! new ^super new initialize! ! !SWVisitorCollector methodsFor: 'accessing'! collection ^collection! ! !SWVisitorCollector methodsFor: 'accessing'! collection: aCollection collection := aCollection! ! !SWVisitorCollector methodsFor: 'accessing'! current ^current! ! !SWVisitorCollector methodsFor: 'accessing'! current: aStructure current := aStructure! ! !SWVisitorCollector methodsFor: 'visiting-structure'! acceptStructure: aStructure self current: aStructure. super acceptStructure: aStructure! ! !SWVisitorCollector methodsFor: 'initialization'! initialize super initialize. collection := self defaultCollection! ! !SWVisitorCollector methodsFor: 'configuration'! defaultCollection self subclassResponsibility! ! !SWVisitorCollector class methodsFor: 'instance-creation'! collect: aWikiItem ^self new visit: aWikiItem; yourself! ! !SWVisitorRecentChanges methodsFor: 'visiting-structure'! acceptStructure: aStructure super acceptStructure: aStructure. self collection addAll: aStructure versions! ! !SWVisitorRecentChanges methodsFor: 'accessing'! defaultCollection ^OrderedCollection new! ! !SWVisitorReferences methodsFor: 'accessing'! structure ^structure! ! !SWVisitorReferences methodsFor: 'accessing'! structure: aStructure structure := aStructure! ! !SWVisitorReferences methodsFor: 'configuration'! defaultCollection ^Set new! ! !SWVisitorReferences methodsFor: 'visiting-document'! acceptLinkInternal: anInternalLink (structure == anInternalLink target) ifTrue: [ collection add: current ]! ! !SWVisitorReferences class methodsFor: 'instance creation'! collect: aWikiItem to: aStructure ^self new structure: aStructure; visit: aWikiItem; yourself! ! !SWVisitorRenderer methodsFor: 'configuration'! defaultWriteStream ^WriteStream on: String new! ! !SWVisitorRenderer methodsFor: 'visiting-structure'! acceptFolder: aFolder self acceptPage: aFolder.! ! !SWVisitorRenderer methodsFor: 'visiting-structure'! acceptStructure: aStructure self structure: aStructure.! ! !SWVisitorRenderer methodsFor: 'accessing'! contents ^stream contents! ! !SWVisitorRenderer methodsFor: 'accessing'! stream: aStream stream := aStream! ! !SWVisitorRenderer methodsFor: 'accessing'! structure: aStructure structure := aStructure! ! !SWVisitorRenderer methodsFor: 'initialization'! initialize self stream: self defaultWriteStream.! ! !SWVisitorRenderer class methodsFor: 'instance creation'! render: aWikiItem ^self new visit: aWikiItem; yourself! ! !SWVisitorRenderer class methodsFor: 'instance creation'! render: aWikiItem on: aStream ^self new stream: aStream; visit: aWikiItem; yourself! ! !SWVisitorRendererHtml methodsFor: 'visiting-document' stamp: 'chbu 10/22/2003 18:02'! acceptCode: aCode [ stream render: (aCode evaluateWith: action) ] on: Exception do: [ :exception | exception return: (stream spanNamed: #error with: exception description) ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptHeader: aHeader stream heading: aHeader text level: aHeader level + 1! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptHorizontalRule: aHorizontalRule stream horizontalRule! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptLink: aLink stream anchorWithUrl: aLink url do: aLink title! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptLinkInternal: aLinkInternal aLinkInternal target isEmbedded ifTrue: [ self emitEmbeddedResource: aLinkInternal ] ifFalse: [ super acceptLinkInternal: aLinkInternal ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptLinkInternalBroken: anInternalLink stream spanNamed: #error with: anInternalLink title. anInternalLink isComposedLink ifTrue: [ stream nextPutAll: ' (unable to create non-local structure)' ] ifFalse: [ self emitCreateTargetFor: anInternalLink ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptListItem: aListItem stream listItem: [ self visitCollection: aListItem children ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptOrderedList: anOrderedList stream orderedList: [ self visitCollection: anOrderedList children ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptParagraph: aParagraph aParagraph children isEmpty ifFalse: [ stream paragraph: [ self visitCollection: aParagraph children ] ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptPreformatted: aPreformatted stream preformatted: [ self visitCollection: aPreformatted children separatedBy: [ stream cr ] ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptTable: aTable stream attributeAt: 'border' put: '0'. stream table: [ self visitCollection: aTable children ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptTableCell: aTableCell stream tableData: [ self visitCollection: aTableCell children ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptTableRow: aTableRow stream tableRow: [ self visitCollection: aTableRow children ]! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptText: aText stream text: aText text! ! !SWVisitorRendererHtml methodsFor: 'visiting-document'! acceptUnorderedList: anUnorderedList stream unorderedList: [ self visitCollection: anUnorderedList children ]! ! !SWVisitorRendererHtml methodsFor: 'private' stamp: 'chbu 10/22/2003 18:02'! creatableStructures ^SWStructure allStructures select: [ :class | action hasPermission: class permissionAdd ]! ! !SWVisitorRendererHtml methodsFor: 'private'! emitCreateTargetFor: aLinkInternal | structures | stream nextPutAll: ' ('. structures := self creatableStructures. structures isEmpty ifTrue: [ stream nextPutAll: 'unauthorized to add structures' ] ifFalse: [ structures do: [ :each | stream anchorWithAction: [ :context | context createChildFromClass: each titled: aLinkInternal reference creator: action structure ] to: action url do: each title ] separatedBy: [ stream nextPutAll: ', ' ] ]. stream nextPutAll: ') '! ! !SWVisitorRendererHtml methodsFor: 'private' stamp: 'chbu 10/22/2003 18:02'! emitEmbeddedResource: aLinkInternal | target | target := aLinkInternal target. target data isEmpty ifFalse: [ target isImage ifTrue: [ ^stream image: (SWMimeView urlFor: target) alt: target title ]. target isAudio | target isVideo ifTrue: [ ^stream embed: target title to: (SWMimeView urlFor: target) mime: target mime ]. ^stream anchorWithUrl: (SWMimeView urlFor: target) do: target title ]. ^stream anchorWithUrl: target url do: target title! ! !SWVisitorRendererHtml methodsFor: 'configuration' stamp: 'chbu 10/22/2003 18:02'! defaultWriteStream ^SWHtmlWriteStream on: String new! ! !SWVisitorRendererHtml methodsFor: 'accessing'! action ^action! ! !SWVisitorRendererHtml methodsFor: 'accessing'! action: anAction action := anAction! ! !SWVisitorRendererHtml class methodsFor: 'instance creation'! render: aWikiItem with: anAction ^self new action: anAction; visit: aWikiItem; yourself! ! !SWVisitorRendererHtml class methodsFor: 'instance creation'! render: aWikiItem with: anAction on: aStream ^self new action: anAction; stream: aStream; visit: aWikiItem; yourself! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptCode: aCode stream nextPut: $[; nextPutAll: aCode code; nextPut: $]! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptHeader: aHeader self emitCr. 1 to: aHeader level do: [ :index | stream nextPut: $!! ]. stream nextPutAll: aHeader text! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptHorizontalRule: aHorizontalRule self emitCr. stream nextPut: $_! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptLink: aLink stream nextPut: $*. aLink text isNil ifFalse: [ stream nextPutAll: aLink text; nextPut: $> ]. stream nextPutAll: aLink reference. stream nextPut: $*! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptListItem: aListItem self emitCrWithoutDuplicates. stream nextPutAll: nesting. super acceptListItem: aListItem! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptOrderedList: anOrderedList self emitCr. self nest: $# do: [ super acceptOrderedList: anOrderedList ]! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptParagraph: aParagraph self emitCr. self visitCollection: aParagraph children.! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptPreformatted: aPreformatted self emitCr. stream nextPut: $=. self visitCollection: aPreformatted children separatedBy: [ stream cr; nextPut: $= ]! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptTableCell: aTableRow stream nextPut: $|. self visitCollection: aTableRow children! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptTableRow: aTableRow self emitCr. self visitCollection: aTableRow children.! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptText: aText aText text do: [ :each | each = $* ifTrue: [ stream nextPut: $\ ]. stream nextPut: each ]! ! !SWVisitorRendererWiki methodsFor: 'visiting-document'! acceptUnorderedList: anUnorderedList self emitCr. self nest: $- do: [ super acceptUnorderedList: anUnorderedList ]! ! !SWVisitorRendererWiki methodsFor: 'private'! emitCr "Force emitting a new-line into the stream of the receiver, except at the beginning of a document." stream contents isEmpty ifFalse: [ stream cr ]! ! !SWVisitorRendererWiki methodsFor: 'private'! emitCrWithoutDuplicates "Avoid emitting multiple new-line characters into the stream of the receiver. Any new-line characters at the beginning of the document are also avoided." (stream contents isEmpty or: [ stream contents last = Character cr ]) ifFalse: [ stream cr ]! ! !SWVisitorRendererWiki methodsFor: 'private'! nest: aCharacter do: aBlock nesting addLast: aCharacter. aBlock ensure: [ nesting removeLast ]! ! !SWVisitorRendererWiki methodsFor: 'initialization'! initialize super initialize. nesting := OrderedCollection new.! ! !SWVisitorSearch methodsFor: 'private'! match: aString aString isNil ifFalse: [ (expression match: aString ignoreCase: ignoreCase) ifTrue: [ collection add: current ] ]! ! !SWVisitorSearch methodsFor: 'visiting-document'! acceptLink: aLink self match: aLink title! ! !SWVisitorSearch methodsFor: 'visiting-document'! acceptText: aText self match: aText text! ! !SWVisitorSearch methodsFor: 'accessing'! expression: aString expression := aString! ! !SWVisitorSearch methodsFor: 'accessing'! ignoreCase: aBoolean ignoreCase := aBoolean! ! !SWVisitorSearch methodsFor: 'visiting-structure'! acceptStructure: aStructure super acceptStructure: aStructure. self match: aStructure title! ! !SWVisitorSearch methodsFor: 'configuration'! defaultCollection ^Set new! ! !SWVisitorSearch class methodsFor: 'instance-creation'! collect: aWikiItem expression: aString ignoreCase: aBoolean ^self new expression: aString; ignoreCase: aBoolean; visit: aWikiItem; yourself! ! !SWWikiItem methodsFor: 'initialization'! initialize! ! !SWWikiItem methodsFor: 'visiting'! accept: aVisitor self subclassResponsibility! ! !SWWikiItem methodsFor: 'as yet unclassified' stamp: 'chbu 10/23/2003 18:03'! copy " Answer another instance just like the receiver. Subclasses normally override the postCopy message, but some objects that should not be copied override copy. " ^self shallowCopy postCopy! ! !SWDocumentComposite methodsFor: 'copying'! postCopy super postCopy. children := children collect: [ :each | each copy ]! ! !SWDocumentComposite methodsFor: 'adding'! add: aPageComponent children add: aPageComponent! ! !SWDocumentComposite methodsFor: 'adding'! addAll: aCollection children addAll: aCollection! ! !SWDocumentComposite methodsFor: 'initialize'! initialize super initialize. children := OrderedCollection new! ! !SWDocumentComposite methodsFor: 'accessing'! children ^children! ! !SWDocument methodsFor: 'visiting'! accept: aVisitor aVisitor acceptDocument: self! ! !SWHorizontalRule methodsFor: 'visiting'! accept: aVisitor aVisitor acceptHorizontalRule: self! ! !SWListItem methodsFor: 'visiting'! accept: aVisitor aVisitor acceptListItem: self! ! !SWOrderedList methodsFor: 'visiting'! accept: aVisitor aVisitor acceptOrderedList: self! ! !SWParagraph methodsFor: 'visiting'! accept: aVisitor aVisitor acceptParagraph: self! ! !SWPreformatted methodsFor: 'visiting'! accept: aVisitor aVisitor acceptPreformatted: self! ! !SWPropertyManager methodsFor: 'removing'! remove: aKey "Remove a property from the receiver with aKey. Return the removed property or nil if there is no such element." ^self remove: aKey ifAbsent: [ nil ]! ! !SWPropertyManager methodsFor: 'removing'! remove: aKey ifAbsent: anExceptionBlock "Remove a property from the receiver with aKey. Return the removed property or anExceptionBlock is evaluated if there is no such element." ^properties removeKey: aKey ifAbsent: anExceptionBlock! ! !SWPropertyManager methodsFor: 'copying' stamp: 'chbu 10/23/2003 18:05'! postCopy super postCopy. properties := properties deepCopy! ! !SWPropertyManager methodsFor: 'accessing'! properties ^properties! ! !SWPropertyManager methodsFor: 'accessing'! properties: aDictionary properties := aDictionary! ! !SWPropertyManager methodsFor: 'testing'! includes: aKey "Test if the receiver has got a property with aKey." ^properties includesKey: aKey! ! !SWPropertyManager methodsFor: 'testing'! isEmpty ^properties isEmpty! ! !SWPropertyManager methodsFor: 'testing'! size ^properties size! ! !SWPropertyManager methodsFor: 'accessing-properties'! at: aKey "Return the value of the property with aKey. If there is no such property, nil is returned." ^self at: aKey ifAbsent: [ nil ]! ! !SWPropertyManager methodsFor: 'accessing-properties'! at: aKey ifAbsent: anExceptionBlock "Return the value of the property with aName. If there is no such property, anExceptionBlock is evaluated." ^properties at: aKey ifAbsent: anExceptionBlock! ! !SWPropertyManager methodsFor: 'accessing-properties'! at: aKey put: aValue "Updates the property aKey with aValue. If the property does not exist a default one is created. The updated or added property is returned." ^properties at: aKey put: aValue! ! !SWPropertyManager methodsFor: 'initialization'! initialize super initialize. properties := Dictionary new! ! !SWPropertyManager methodsFor: 'enumerating'! do: aBlock "Evaluate aBlock with each of the receiver's properties (key and value) as the argument." properties keysAndValuesDo: aBlock! ! !SWPropertyManager methodsFor: 'visiting'! accept: aVisitor aVisitor acceptProperties: self! ! !SWStructure methodsFor: 'visiting'! accept: aVisitor aVisitor acceptStructure: self! ! !SWStructure methodsFor: 'serving'! process: aRequest "Process a basic request. First the security information contained in the request is updated, then it is decided if the request should be handled by the current component or one of its children." self processSecurity: aRequest. ^aRequest urlAtEnd ifTrue: [ self processSelf: aRequest ] ifFalse: [ self processChild: aRequest ]! ! !SWStructure methodsFor: 'serving' stamp: 'chbu 10/22/2003 17:44'! processAction: anAction "Executes the action on myself and catch basic errors." ^[ anAction execute ] on: SWUnauthorizedError do: [ :error | error return: (self unauthorized: anAction request) ]! ! !SWStructure methodsFor: 'serving'! processChild: aRequest "The default structure has got no children, therefore we process a not-found message." self notFound: aRequest! ! !SWStructure methodsFor: 'serving'! processSecurity: aRequest "Update the roles of the current user according to the current role configuration. See #updateRoles: in the \texttt{User} class for additional information." aRequest updateRoles: roles! ! !SWStructure methodsFor: 'serving' stamp: 'chbu 10/23/2003 17:50'! processSelf: aRequest "Look for an action that might be executed on the current structure. If there is no action given, the default one is executed." | actionName actionClass | actionName := aRequest fieldAt: 'action'. actionClass := actionName isNil ifFalse: [ Smalltalk at: ('SW', actionName) asSymbol ifAbsent: [ self class defaultViewAction ] ] ifTrue: [ self class defaultViewAction ]. self processAction: (actionClass request: aRequest structure: self)! ! !SWStructure methodsFor: 'properties-local'! localProperties "Return the properties of the receiver." ^properties! ! !SWStructure methodsFor: 'properties-local'! localPropertyAt: aKey "Return the value of the property of the receiver with aKey. If there is no such property, nil is returned." ^self localPropertyAt: aKey ifAbsent: [ nil ]! ! !SWStructure methodsFor: 'properties-local'! localPropertyAt: aKey ifAbsent: anExceptionBlock "Return the value of the property of the receiver with aKey. If there is no such property, anExceptionBlock is evaluated." ^properties at: aKey ifAbsent: anExceptionBlock! ! !SWStructure methodsFor: 'properties-local'! localPropertyAt: aKey put: aValue "Set the property aKey to aValue in the receiver." ^properties at: aKey put: aValue! ! !SWStructure methodsFor: 'accessing'! id "Return the id of the receiver, that is a string build from the title of the structure. The id is used to identify a structure within its parent and therefore has to be unique." "The lazy initialization should be removed, it is just here for compatibility" id isNil ifTrue: [ id := title asWikiIdentifier ]. ^id! ! !SWStructure methodsFor: 'accessing'! parent "Return the parent of the receiver. In the case the receiver is the root node nil is returned." ^parent! ! !SWStructure methodsFor: 'accessing'! parent: aStructure parent := aStructure.! ! !SWStructure methodsFor: 'accessing'! predecessor "Return the previous version in the history of the receiver. If there is no history information available nil is returned." ^predecessor! ! !SWStructure methodsFor: 'accessing'! predecessor: aStructure predecessor := aStructure! ! !SWStructure methodsFor: 'accessing'! roles "Return a collection of roles which are applied when the receiver processes a query. All the roles of the current user are replaced with the corresponding ones returned by this message." ^roles! ! !SWStructure methodsFor: 'accessing'! roles: aCollection roles := aCollection! ! !SWStructure methodsFor: 'accessing'! timestamp "Return a timestamp with the latest modification-time of the receiver." ^timestamp! ! !SWStructure methodsFor: 'accessing'! timestamp: aTimestamp timestamp := aTimestamp! ! !SWStructure methodsFor: 'accessing'! title ^title! ! !SWStructure methodsFor: 'accessing' stamp: 'chbu 10/22/2003 09:52'! title: aString "Set the title of the receiver. If the receiver is a child of another structure the title is checked to be unique. In case of a problem, a \texttt{DuplicatedStructure} exception is thrown." | conflict | parent isNil ifFalse: [ conflict := self parent at: aString ifAbsent: [ nil ]. (conflict isNil or: [ conflict == self ]) ifFalse: [ SWDuplicatedStructure signal: aString ] ]. id := aString asWikiIdentifier. title := aString.! ! !SWStructure methodsFor: 'accessing'! version "Return the version-number of the receiver, the numbering starts with version 0." ^version! ! !SWStructure methodsFor: 'accessing'! version: anInteger version := anInteger! ! !SWStructure methodsFor: 'private'! myDependents ^dependents! ! !SWStructure methodsFor: 'private'! myDependents: aDependentsList dependents := aDependentsList! ! !SWStructure methodsFor: 'versions'! nextVersion "Copy the receiver to be used in the history and return a the receiver." ^self nextVersionBecome: self! ! !SWStructure methodsFor: 'versions'! nextVersionBecome: aStructure "This message creates a copy of the receiver and puts aStructure into the history. References pointing to the receiver will be still valid, as the current version stays the same object all the time. Right now the new version must be of the same class than the receiver, else an exception is thrown." | previous | self class == aStructure class ifFalse: [ self error: 'Unable to version class changes in history.' ]. previous := self copy. 1 to: aStructure class instSize do: [ :index | self instVarAt: index put: (aStructure instVarAt: index) ]. self predecessor: previous. self version: previous version + 1.! ! !SWStructure methodsFor: 'versions'! versionNumber: anInteger "Return the version anInteger of the receiver or nil if not present." ^self versions detect: [ :item | item version = anInteger ] ifNone: [ self error: 'Invalid version number' ].! ! !SWStructure methodsFor: 'versions'! versionRestore: anInteger "Restore the version anInteger. In other words: the version anInteger will become the current one, but all the other modifications are still kept in history." | structure | structure := self versionNumber: anInteger. structure isNil ifFalse: [ self nextVersionBecome: structure ]! ! !SWStructure methodsFor: 'versions'! versionRevert: anInteger "Revert to the version anInteger in history. All the newer modifications will be lost." | structure | structure := self versionNumber: anInteger. structure isNil ifFalse: [ self nextVersionBecome: structure. self predecessor: structure predecessor ]! ! !SWStructure methodsFor: 'versions'! versionTruncate: anInteger "Truncate all the history information behind the version anInteger." | structure | structure := self versionNumber: anInteger. structure isNil ifFalse: [ structure predecessor: nil ]! ! !SWStructure methodsFor: 'accessing-calculated'! parents "Return an ordered collection with all the structures from the root up to and including the receiver of the message." | collection structure | structure := self. collection := OrderedCollection new. [ collection addFirst: structure. structure := structure parent. structure isNil ] whileFalse. ^collection! ! !SWStructure methodsFor: 'accessing-calculated'! root "Return the root node of the receiver." | structure | structure := self. [ structure isRoot ] whileFalse: [ structure := structure parent ]. ^structure! ! !SWStructure methodsFor: 'accessing-calculated'! url "Return a unix-path string representing the URL of the receiver. The URL is unique within a wiki-tree and contains the id of the receiver and all its parents ids, except for the root." ^self parents removeFirst; inject: '/' into: [ :output :structure | output , structure id , '/' ]! ! !SWStructure methodsFor: 'accessing-calculated'! versions "Return an ordered-collection containing the receiver and all its older versions." | versions | versions := OrderedCollection with: self. [ versions last predecessor isNil ] whileFalse: [ versions addLast: versions last predecessor ]. ^versions! ! !SWStructure methodsFor: 'accessing-navigation'! first "Return the first node of the receiver's parent." ^self isRoot ifTrue: [ self ] ifFalse: [ parent children first ]! ! !SWStructure methodsFor: 'accessing-navigation'! last "Return the last node of the receiver's parent." ^self isRoot ifTrue: [ self ] ifFalse: [ parent children last ]! ! !SWStructure methodsFor: 'accessing-navigation'! next "Return the next node of the receiver's parent." ^self isRoot ifTrue: [ nil ] ifFalse: [ parent next: self ]! ! !SWStructure methodsFor: 'accessing-navigation'! previous "Return the previous node of the receiver's parent." ^self isRoot ifTrue: [ nil ] ifFalse: [ parent previous: self ]! ! !SWStructure methodsFor: 'testing'! isComposite "Return true if the structure has got the possiblity to hold children." ^false! ! !SWStructure methodsFor: 'testing'! isEmbedded "Return true if the structure should be embedded into documents referencing the receiver." ^false! ! !SWStructure methodsFor: 'testing'! isRoot "Answer whether the receiver is the root node. The root is a folder by default and the only structure having no parent in the wiki-tree." ^parent isNil! ! !SWStructure methodsFor: 'testing'! isSuccessor "Answer whether the receiver has got a previous version in the history." ^predecessor notNil! ! !SWStructure methodsFor: 'resolving'! privateParsePath: aStringPath | readStream pathCollection identifier | pathCollection := OrderedCollection new. readStream := aStringPath readStream. [ readStream atEnd ] whileFalse: [ identifier := readStream upTo: $/. pathCollection add: identifier asWikiIdentifier ]. ^pathCollection! ! !SWStructure methodsFor: 'resolving'! privateResolve: aCollection ^aCollection first isEmpty ifTrue: [ self root privateResolvePath: (aCollection removeFirst; yourself) ] ifFalse: [ (self privateShouldResolveChild: aCollection) ifTrue: [ self privateResolveChild: aCollection first ] ifFalse: [ self isRoot ifTrue: [ nil ] ifFalse: [ self parent privateResolvePath: aCollection ] ] ]! ! !SWStructure methodsFor: 'resolving'! privateResolveChild: aString "As we usually don't have children, return nil. Subclasses with children might want to override this message." ^nil! ! !SWStructure methodsFor: 'resolving'! privateResolvePath: aCollection "Resolve a whole path starting at the receiver. If there is an error matching the path, nil is returned." | structure pathStream | structure := self. pathStream := aCollection readStream. [ pathStream atEnd or: [ structure isNil ] ] whileFalse: [ structure := structure privateResolveChild: pathStream next ]. ^structure! ! !SWStructure methodsFor: 'resolving'! privateShouldResolveChild: aCollection ^aCollection size = 1 and: [ self isRoot or: [ (self privateResolveChild: aCollection first) notNil ] ]! ! !SWStructure methodsFor: 'resolving'! resolveTo: aStringPath "Start the resolving-process at the receiver with the resolving-algorithm depending on the count of identifiers in aPathString: \begin{enumerate} \item if the first character of the path is a separator the look-up is started in the root-node and processed downwards. \item if the first character is not a separator ... \begin{enumerate} \item and an empty path is given, the receiver is returned. \item and a path with exactly one entry is given, a child with that name is looked for. \item and a path with one or more entries is given, a look-up is started in the parent of the receiver. \end{enumerate} \end{enumerate} The first matching structure is returned or nil if no appropriate item could be located in the tree. To see a bunch of examples about the use of this message, have a look at the tests in protocol \texttt{resting-resolving} of the class \texttt{StructureTests}." | path | path := self privateParsePath: aStringPath. ^path isEmpty ifFalse: [ self privateResolve: path ] ifTrue: [ self ]! ! !SWStructure methodsFor: 'initialize' stamp: 'chbu 10/22/2003 09:32'! initialize super initialize. properties := SWPropertyManager new. timestamp := TimeStamp now. version := 0! ! !SWStructure methodsFor: 'properties-inherited' stamp: 'chbu 10/22/2003 09:48'! properties "Return a property manager including the values of all inherited properties. Changes to the returned object does not change the receivers property manager." ^self parents inject: SWPropertyManager new into: [ :manager :structure | structure localProperties do: [ :key :value | manager at: key put: value ]. manager ]! ! !SWStructure methodsFor: 'properties-inherited'! propertyAt: aKey "Return the value of the property of the receiver with aKey. If there is no such property defined, the look-up is retried in the parent of the receiver." ^self propertyAt: aKey ifAbsent: [ nil ]! ! !SWStructure methodsFor: 'properties-inherited'! propertyAt: aKey ifAbsent: anExceptionBlock "Return the value of the property of the receiver with aKey. If there is no such property defined, the look-up is retried in the parent of the receiver. If no such property could be found, anExceptionBlock is evaluated." ^properties at: aKey ifAbsent: [ self isRoot ifTrue: [ anExceptionBlock value ] ifFalse: [ parent propertyAt: aKey ifAbsent: anExceptionBlock ] ]! ! !SWStructure methodsFor: 'properties-inherited'! propertyAt: aKey put: aValue "Set the property aKey to aValue in the receiver. This message does the same as #localPropertyAt:put: and is here simply for conveniance." ^self localPropertyAt: aKey put: aValue! ! !SWStructure methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:22'! stylesheet | stylesheet | ^self propertyAt: #internalStylesheet ifAbsent: [ stylesheet := self defaultStylesheet. self stylesheet: stylesheet. stylesheet ]! ! !SWStructure methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:20'! stylesheet: aString aString isNil ifTrue: [ self localProperties remove: #internalStylesheet ] ifFalse: [ self localProperties at: #internalStylesheet put: aString ]! ! !SWStructure methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:21'! templates | templates | ^self propertyAt: #internalTemplates ifAbsent: [ templates := self defaultTemplates. self templates: templates. templates ]! ! !SWStructure methodsFor: 'as yet unclassified' stamp: 'chbu 10/22/2003 09:20'! templates: aCollection aCollection isNil ifTrue: [ self localProperties remove: #internalTemplates ] ifFalse: [ self localProperties at: #internalTemplates put: aCollection ]! ! !SWStructure methodsFor: 'notification'! changed: anAspectSymbol self changed: anAspectSymbol with: self! ! !SWStructure methodsFor: 'notification' stamp: 'chbu 10/24/2003 16:29'! changed: anAspectSymbol with: aParameter super changed: anAspectSymbol with: aParameter. self isRoot ifFalse: [ self parent changed: anAspectSymbol with: aParameter ]! ! !SWStructure methodsFor: 'copying' stamp: 'chbu 10/22/2003 17:48'! postCopy "Copy a selection of the instance-variables and update the time-stamp of the receiver. Subclasses should override this message to do a deep-copy of their data and call super. This is the key-message to make the versioning mechanism work properly." super postCopy. self breakDependents. timestamp := TimeStamp now. properties := properties copy. roles := roles copy.! ! !SWStructure methodsFor: 'serving-errors' stamp: 'chbu 10/22/2003 17:48'! notFound: aRequest self processAction: (SWErrorNotFound request: aRequest structure: self)! ! !SWStructure methodsFor: 'serving-errors' stamp: 'chbu 10/22/2003 17:48'! unauthorized: aRequest self processAction: (SWErrorUnauthorized request: aRequest structure: self)! ! !SWStructure methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' title: '; print: title! ! !SWStructure methodsFor: 'configuration'! defaultAddTarget "Return the target where to put new children. The default implementation returns the parent of the receiver, but structures that contain children usually want to return self." ^self parent! ! !SWStructure methodsFor: 'configuration'! defaultStylesheet ^'@import "http://www.iam.unibe.ch/~scg/smallwiki/standard_blue/style.css";'! ! !SWStructure methodsFor: 'configuration' stamp: 'chbu 10/22/2003 17:49'! defaultTemplates ^OrderedCollection new add: SWTemplateHeadMeta new; add: SWTemplateHeadTitle new; add: SWTemplateHeadNavigation new; add: SWTemplateBodyTitle new; add: SWTemplateBodyPath new; add: SWTemplateBodyActions new; add: SWTemplateBodySession new; add: SWTemplateBodyContents new; add: SWTemplateBodyW3C new; yourself! ! !SWPage methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:36'! defaultDocument "Return the default document used when a new page is created." ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Edit your page ...'); yourself); yourself! ! !SWPage methodsFor: 'configuration' stamp: 'chbu 10/22/2003 17:18'! defaultVisitor "Return the default visitor used when rendering this document to html." ^SWVisitorRendererHtml! ! !SWPage methodsFor: 'initialize'! initialize super initialize. document := self defaultDocument! ! !SWPage methodsFor: 'accessing'! document "Return the current document of the page." ^document! ! !SWPage methodsFor: 'accessing'! document: aDocument document := aDocument! ! !SWPage methodsFor: 'visiting'! accept: aVisitor aVisitor acceptPage: self! ! !SWPage methodsFor: 'copying'! postCopy super postCopy. document := document copy! ! !SWFolder methodsFor: 'children-structure' stamp: 'chbu 10/22/2003 09:50'! add: aStructure "Add aStructure as a child to the receiver. A DuplicatedStructure exception is raised in case there is already a child with the same name." (self includes: aStructure title) ifTrue: [ SWDuplicatedStructure signal: aStructure title ]. aStructure parent: self. children add: aStructure. ^aStructure! ! !SWFolder methodsFor: 'children-structure'! copy: aStructure "This message is basically the same as #add: but it creates a copy of the structure and makes sure that the title is unique within the receiver before adding." | unique child | unique := self uniqueTitle: aStructure title. child := aStructure copy. child title: unique. self add: child. ^child! ! !SWFolder methodsFor: 'children-structure'! remove: aStructure "Remove aStructure from the list of children of the receiver. In case there is no such child an exception is raised." aStructure parent: nil. ^(children includes: aStructure) ifTrue: [ children remove: aStructure ] ifFalse: [ self class notFound signal ]! ! !SWFolder methodsFor: 'configuration'! defaultAddTarget ^self! ! !SWFolder methodsFor: 'configuration'! defaultChildrenCollection "When changing this message, you should modify the following messages: #at:ifAbsent:, #add:, #remove: and #children." ^OrderedCollection new! ! !SWFolder methodsFor: 'configuration'! defaultChildrenListCode ^' "If you are not logged-in as administrator, please remove everything between the square-brackets before saving the page!!" structure children isEmpty ifFalse: [ html unorderedList: [ structure children do: [ :each | html listItem: [ html anchorWithUrl: each url do: each title ] ] ] ]. nil'! ! !SWFolder methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:32'! defaultDocument "Return the default document used when a new folder is created." ^SWDocument new add: (SWParagraph new add: (SWText newText: 'Edit a description of your folder and add some children ...'); yourself); add: (SWParagraph new); add: (SWParagraph new add: (SWCode newCode: self defaultChildrenListCode); yourself); yourself! ! !SWFolder methodsFor: 'accessing'! children "Return a collection of all the children of the receiver." ^children! ! !SWFolder methodsFor: 'copying'! postCopy super postCopy. children := children copy.! ! !SWFolder methodsFor: 'navigation'! next: aStructure "Return the next node of the receiver's child aStructure." ^[ children after: aStructure ] on: Error do: [ :err | err return: nil ]! ! !SWFolder methodsFor: 'navigation'! previous: aStructure "Return the previous node of the receiver's child aStructure." ^[ children before: aStructure ] on: Error do: [ :err | err return: nil ]! ! !SWFolder methodsFor: 'resolving'! privateResolveChild: aString ^self at: aString! ! !SWFolder methodsFor: 'children-accessing'! at: aString "Return child of the receiver with id aString or nil if absent." ^self at: aString ifAbsent: [ nil ]! ! !SWFolder methodsFor: 'children-accessing'! at: aString ifAbsent: aBlock "Return child of the receiver with id aString or nil if absent." | id | id := aString asWikiIdentifier. ^children detect: [ :child | child id = id ] ifNone: aBlock! ! !SWFolder methodsFor: 'children-accessing'! includes: aString "Return true if the receiver contains a child with the id aString." self at: aString asWikiIdentifier ifAbsent: [ ^false ]. ^true! ! !SWFolder methodsFor: 'children-accessing'! uniqueTitle: aString "Proposes an unique name for a child within the receiver using aString base name." | number unique | number := 1. unique := aString. [ self includes: unique ] whileTrue: [ unique := aString , number displayString. number := number + 1 ]. ^unique! ! !SWFolder methodsFor: 'initialize'! initialize super initialize. children := self defaultChildrenCollection! ! !SWFolder methodsFor: 'testing'! isComposite ^true! ! !SWFolder methodsFor: 'serving'! processChild: aRequest | child | child := self at: aRequest urlNext. ^child isNil ifFalse: [ child process: aRequest ] ifTrue: [ self notFound: aRequest ]! ! !SWFolder methodsFor: 'visiting'! accept: aVisitor aVisitor acceptFolder: self! ! !SWResource methodsFor: 'accessing'! data ^data! ! !SWResource methodsFor: 'accessing'! data: aByteArray data := aByteArray asByteArray! ! !SWResource methodsFor: 'accessing'! embed ^embed! ! !SWResource methodsFor: 'accessing'! embed: aBoolean embed := aBoolean! ! !SWResource methodsFor: 'accessing'! mimetype ^mimetype! ! !SWResource methodsFor: 'accessing'! mimetype: aString mimetype := aString! ! !SWResource methodsFor: 'accessing'! stream ^data readStream! ! !SWResource methodsFor: 'accessing'! stream: aStream self data: aStream contents! ! !SWResource methodsFor: 'storage'! generateFilename ^String streamContents: [ :stream | self parents do: [ :structure | stream nextPutAll: structure id ] separatedBy: [ stream nextPut: $_ ]. stream nextPut: $.. stream nextPutAll: version printString ]! ! !SWResource methodsFor: 'storage'! loadBinaryData: aFilename | stream | stream := aFilename readStream binary. [ self data: stream contents ] ensure: [ stream close ]! ! !SWResource methodsFor: 'storage'! saveBinaryData: aFilename | stream | stream := aFilename newReadWriteStream binary. [ stream nextPutAll: self data ] ensure: [ stream close ]! ! !SWResource methodsFor: 'storage'! sixxContentOn: aStream indent: level context: dictionary | filename instVars index | " emit special data field " filename := (dictionary at: #directory) construct: self generateFilename. self saveBinaryData: filename. filename sixxOn: aStream name: 'data' indent: level + 1 context: dictionary. " emith all the other fields " instVars := self class allInstVarNames. instVars do: [ :name | name = 'data' ifFalse: [ index := instVars indexOf: name. (self instVarAt: index) sixxOn: aStream name: name indent: level + 1 context: dictionary ] ]! ! !SWResource methodsFor: 'storage'! sixxInstVarNamed: instVarName put: aValue (instVarName = #data) ifTrue: [ self loadBinaryData: aValue asFilename ] ifFalse: [ super sixxInstVarNamed: instVarName put: aValue ]! ! !SWResource methodsFor: 'configuration'! defaultData ^ByteArray new! ! !SWResource methodsFor: 'configuration'! defaultEmbed ^true! ! !SWResource methodsFor: 'configuration'! defaultMimetype ^String new! ! !SWResource methodsFor: 'testing'! isApplication "Return true if the mimetype of the receiver is application-data. This message will match types like: application/octet-stream, application/oda, application/postscript, application/zip, application/pdf, etc." ^'application/*' match: mimetype! ! !SWResource methodsFor: 'testing'! isAudio "Return true if the mimetype of the receiver is audio-data. This message will match types like: audio/basic, audio/tone, audio/mpeg, etc." ^'audio/*' match: mimetype! ! !SWResource methodsFor: 'testing'! isEmbedded "Return true if the resource of the receiver should be embedded into the desired context. Return false if the resource should be simply linked." ^embed! ! !SWResource methodsFor: 'testing'! isImage "Return true if the mimetype of the receiver is image-data. This message will match types like: image/jpeg, image/gif, image/png, image/tiff, etc." ^'image/*' match: mimetype! ! !SWResource methodsFor: 'testing'! isText "Return true if the mimetype of the receiver is text-data. This message will match types like: text/plain, text/html, text/sgml, text/css, text/xml, text/richtext, etc." ^'text/*' match: mimetype! ! !SWResource methodsFor: 'testing'! isVideo "Return true if the mimetype of the receiver is video-data. This message will match types like: video/mpeg, video/quicktime, etc." ^'video/*' match: mimetype! ! !SWResource methodsFor: 'initialize'! initialize super initialize. data := self defaultData. mimetype := self defaultMimetype. embed := self defaultEmbed! ! !SWResource methodsFor: 'visiting'! accept: aVisitor aVisitor acceptResource: self! ! !SWComancheSite methodsFor: 'comanche' stamp: 'chbu 10/25/2003 23:58'! helpResolve: rawRequest | request | request := self prepareRequest: rawRequest. server process: request. ^self prepareResponse: request response.! ! !SWComancheSite methodsFor: 'response' stamp: 'chbu 10/25/2003 23:59'! prepareResponse: aResponse | response | response := HttpResponse new contentType: aResponse type; status: (HttpResponse statusSymbolFor: aResponse status); contents: aResponse stream contents readStream; yourself. self prepareResponseHeader: response from: aResponse. aResponse cookies isEmpty ifFalse: [ self prepareResponseCookie: response from: aResponse ]. ^response! ! !SWComancheSite methodsFor: 'response' stamp: 'chbu 10/22/2003 22:20'! prepareResponseCookie: response from: aResponse | stream | aResponse cookies keysAndValuesDo: [ :key :value | stream := WriteStream on: String new. stream nextPutAll: key; nextPut: $=; nextPut: $". value isNil ifFalse: [ stream nextPutAll: value ]. stream nextPutAll: '"; path=/'. value isNil ifTrue: [ stream nextPutAll: '; Max-Age=0; Expires=Sun, 09 Mar 2003 14:43:19 GMT' ]. response addHeaderName: 'Set-Cookie' value: stream contents ]! ! !SWComancheSite methodsFor: 'response' stamp: 'chbu 10/22/2003 22:21'! prepareResponseHeader: response from: aResponse ! ! !SWComancheSite methodsFor: 'request' stamp: 'chbu 10/22/2003 22:05'! prepareRequest: aHTTPRequest ^(SWRequest server: server) headers: (self prepareRequestHeaders: aHTTPRequest); fields: (self prepareRequestFields: aHTTPRequest); cookies: (self prepareRequestCookies: aHTTPRequest); url: (self prepareRequestUrl: aHTTPRequest); " updateAuthentication;" yourself! ! !SWComancheSite methodsFor: 'request' stamp: 'chbu 10/22/2003 22:02'! prepareRequestCookies: aHTTPRequest | cookies | cookies := Dictionary new. aHTTPRequest cookies keysAndValuesDo: [ :key :value | cookies at: key put: value ]. ^cookies! ! !SWComancheSite methodsFor: 'request' stamp: 'chbu 10/22/2003 21:59'! prepareRequestFields: aHTTPRequest | fields | fields := Dictionary new. aHTTPRequest fields keysAndValuesDo: [ :key :value | fields at: key put: value ]. ^fields! ! !SWComancheSite methodsFor: 'request' stamp: 'chbu 10/22/2003 21:50'! prepareRequestHeaders: aHTTPRequest | headers | headers := Dictionary new. aHTTPRequest header keysAndValuesDo: [ :item :value | headers at: item name put: value ]. ^headers! ! !SWComancheSite methodsFor: 'request' stamp: 'chbu 10/22/2003 22:03'! prepareRequestUrl: aHTTPRequest ^aHTTPRequest url! ! !SWComancheSite methodsFor: 'accessing'! server ^server! ! !SWComancheSite methodsFor: 'accessing'! server: aSwazooServer server := aSwazooServer! ! !SWTable methodsFor: 'accessing'! columns ^self children inject: 0 into: [ :max :row | max max: row columns ]! ! !SWTable methodsFor: 'accessing'! rows ^children size! ! !SWTable methodsFor: 'visiting'! accept: aVisitor aVisitor acceptTable: self! ! !SWTableCell methodsFor: 'visiting'! accept: aVisitor aVisitor acceptTableCell: self! ! !SWTableRow methodsFor: 'accessing'! columns ^children size! ! !SWTableRow methodsFor: 'accessing'! rows ^1! ! !SWTableRow methodsFor: 'visiting'! accept: aVisitor aVisitor acceptTableRow: self! ! !SWText methodsFor: 'visiting'! accept: aVisitor aVisitor acceptText: self! ! !SWText methodsFor: 'testing'! hasText ^text notNil and: [ text notEmpty ]! ! !SWText methodsFor: 'accessing'! text ^text! ! !SWText methodsFor: 'accessing'! text: aString text := aString! ! !SWCode methodsFor: 'accessing'! code ^text! ! !SWCode methodsFor: 'accessing'! code: aString text := aString! ! !SWCode methodsFor: 'initialization'! initialize super initialize. self code: String new! ! !SWCode methodsFor: 'visiting'! accept: aVisitor aVisitor acceptCode: self! ! !SWCode methodsFor: 'evaluation' stamp: 'chbu 10/25/2003 20:31'! evaluateWith: anAction "Evaluates the code of the receiver within aStructure. The message returns the last statement of the string. Notifications are ignored." ^[ self internalEvaluate: self code with: anAction ] on: "Notification" Exception do: [ :exception | exception resume ]! ! !SWCode methodsFor: 'private' stamp: 'chbu 10/22/2003 19:43'! internalEvaluate: anExpression with: anAction "Evaluates anExpression with the given structure and the request. It may seem that all the instance variables are not used within this message, but that is not true. They have to be available when executing the code in this context." | request response structure html | request := anAction request. response := anAction response. structure := anAction structure. html := anAction html. ^Compiler new evaluate: anExpression in: thisContext to: anAction notifying: nil ifFail: [ nil ]! ! !SWHeader methodsFor: 'accessing'! level ^level! ! !SWHeader methodsFor: 'accessing'! level: anInteger level := anInteger! ! !SWHeader methodsFor: 'visiting'! accept: aVisitor aVisitor acceptHeader: self! ! !SWLink methodsFor: 'accessing'! reference ^reference! ! !SWLink methodsFor: 'accessing'! reference: aString reference := aString! ! !SWLink methodsFor: 'accessing'! title ^self hasText ifTrue: [ self text ] ifFalse: [ self reference ]! ! !SWLink methodsFor: 'accessing'! url self subclassResponsibility! ! !SWLink methodsFor: 'testing'! isBroken ^false! ! !SWLinkExternal methodsFor: 'accessing'! url ^self reference! ! !SWLinkExternal methodsFor: 'visiting'! accept: aVisitor aVisitor acceptLinkExternal: self! ! !SWLinkInternal methodsFor: 'testing'! hasTarget ^self isBroken not! ! !SWLinkInternal methodsFor: 'testing'! isBroken ^self target isNil! ! !SWLinkInternal methodsFor: 'testing'! isComposedLink ^self reference includes: $/! ! !SWLinkInternal methodsFor: 'accessing-calculated'! target ^self resolver resolveTo: self reference! ! !SWLinkInternal methodsFor: 'accessing-calculated'! title ^self hasText ifTrue: [ self text ] ifFalse: [ self hasTarget ifTrue: [ self target title ] ifFalse: [ self reference ] ]! ! !SWLinkInternal methodsFor: 'accessing-calculated'! url ^self hasTarget ifTrue: [ self target url ] ifFalse: [ String new ]! ! !SWLinkInternal methodsFor: 'accessing'! resolver ^resolver! ! !SWLinkInternal methodsFor: 'accessing'! resolver: aStructure resolver := aStructure! ! !SWLinkInternal methodsFor: 'visiting'! accept: aVisitor self isBroken ifFalse: [ aVisitor acceptLinkInternal: self ] ifTrue: [ aVisitor acceptLinkInternalBroken: self ]! ! !SWLinkMailTo methodsFor: 'accessing'! url ^String streamContents: [ :stream | stream nextPutAll: 'mailto:'. self reference do: [ :each | stream nextPutAll: '&#'; nextPutAll: each asInteger printString; nextPutAll: ';' ] ]! ! !SWLinkMailTo methodsFor: 'visiting'! accept: aVisitor aVisitor acceptLinkMailTo: self! ! !SWUnorderedList methodsFor: 'visiting'! accept: aVisitor aVisitor acceptUnorderedList: self! ! !SWWikiItem class methodsFor: 'instance creation'! new ^super new initialize; yourself! ! !SWWikiItem class methodsFor: 'class initialization'! initialize "This message just makes sure that none of the subclasses of \texttt{WikiItem} accidently calls \texttt{Object class>>initialize}."! ! !SWDocumentComposite class methodsFor: 'instance creation'! withAll: aCollection ^(self new) addAll: aCollection; yourself! ! !SWStructure class methodsFor: 'initialize' stamp: 'chbu 10/25/2003 18:49'! initialize " SWStructure initialize " Actions := Set new. Permissions := Set new. self initializeActions. self initializePermissions.! ! !SWStructure class methodsFor: 'initialize' stamp: 'chbu 10/22/2003 19:23'! initializeActions "When creating a subclass of \texttt{Structure} you usuallay want to inherit all the common actions from the base class, therefor don't forget calling super when overriding this message." Actions add: SWLogin. Actions add: SWLogout. Actions add: SWSearch. Actions add: SWTemplateEdit. Actions add: SWRecentChanges. Actions add: SWPreviousStructure. Actions add: SWParentStructure. Actions add: SWNextStructure.! ! !SWStructure class methodsFor: 'initialize'! initializePermissions "Permissions are usually not inherited form the supperclasses, therefor you don't need to call super when overriding this message."! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionAdd ^self permissionAt: '* Add'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionCopy ^self permissionAt: '* Copy'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionEdit ^self permissionAt: '* Edit'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionHistory ^self permissionAt: '* History'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionMove ^self permissionAt: '* Move'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionRemove ^self permissionAt: '* Remove'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionTemplate ^self permissionAt: '* Template'! ! !SWStructure class methodsFor: 'accessing-permissions'! permissionView ^self permissionAt: '* View'! ! !SWStructure class methodsFor: 'accessing-security'! permissionAt: aString ^self permissionAt: aString ifAbsent: [ nil ]! ! !SWStructure class methodsFor: 'accessing-security' stamp: 'chbu 10/24/2003 17:13'! permissionAt: aString ifAbsent: aBlock ^Permissions detect: [ :permission | aString match: permission name ] ifNone: aBlock! ! !SWStructure class methodsFor: 'accessing-security' stamp: 'chbu 10/22/2003 19:22'! permissions ^Permissions! ! !SWStructure class methodsFor: 'accessing-security' stamp: 'chbu 10/22/2003 19:22'! registerPermission: aPermission Permissions add: aPermission! ! !SWStructure class methodsFor: 'accessing-security' stamp: 'chbu 10/22/2003 19:22'! unregisterPermission: aPermission ^Permissions remove: aPermission! ! !SWStructure class methodsFor: 'accessing-actions' stamp: 'chbu 10/22/2003 19:23'! actions ^Actions! ! !SWStructure class methodsFor: 'accessing-actions' stamp: 'chbu 10/22/2003 19:23'! registerAction: anActionClass Actions add: anActionClass! ! !SWStructure class methodsFor: 'accessing-actions' stamp: 'chbu 10/22/2003 19:23'! unregisterAction: anActionClass ^Actions remove: anActionClass! ! !SWStructure class methodsFor: 'instance creation'! parent: aStructure "Create a new structure with aStructure as parent and a default title." | child | child := self title: self title. aStructure add: child. ^child! ! !SWStructure class methodsFor: 'instance creation'! title: aString "Create a new structure with aString as title." ^self new title: aString; yourself! ! !SWStructure class methodsFor: 'instance creation'! version: aStructure "Create a new version of the given structure. At the moment the new version is an instance of the same class as aStructure, but that will change in the future." ^aStructure nextVersion! ! !SWStructure class methodsFor: 'configuration'! defaultEditAction "Return the action that should be executed when one wants to set-up or edit the structure. Overide this message to specify a specific action in your own components." ^self defaultViewAction! ! !SWStructure class methodsFor: 'configuration'! defaultViewAction "Return the action that should be executed when nothing else is specified. Do override this message in all your own components." ^self subclassResponsibility! ! !SWStructure class methodsFor: 'accessing' stamp: 'chbu 10/24/2003 17:31'! title "Returns the title of this component. Do override this message to specify a differnt name." | title | title := self name asString. ^title copyFrom: 3 to: title size! ! !SWStructure class methodsFor: 'reflection'! allStructures ^self allSubclasses asSortedCollection: [ :x :y | x name < y name ]! ! !SWPage class methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:58'! defaultEditAction ^SWPageEdit! ! !SWPage class methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:58'! defaultViewAction ^SWPageView! ! !SWPage class methodsFor: 'initialize' stamp: 'chbu 10/25/2003 18:51'! initialize " SWPage initialize " super initialize! ! !SWPage class methodsFor: 'initialize' stamp: 'chbu 10/22/2003 15:44'! initializeActions super initializeActions. self registerAction: SWPageView. self registerAction: SWPageEdit. self registerAction: SWPageHistory.! ! !SWPage class methodsFor: 'initialize' stamp: 'chbu 10/24/2003 17:14'! initializePermissions " SWPage initializePermissions " self registerPermission: (SWPermission name: 'Page Add'). self registerPermission: (SWPermission name: 'Page Remove'). self registerPermission: (SWPermission name: 'Page Copy'). self registerPermission: (SWPermission name: 'Page Move'). self registerPermission: (SWPermission name: 'Page Edit'). self registerPermission: (SWPermission name: 'Page View'). self registerPermission: (SWPermission name: 'Page History'). self registerPermission: (SWPermission name: 'Page Template'). self registerPermission: (SWPermission name: 'Page Code').! ! !SWPage class methodsFor: 'accessing-permissions'! permissionCode ^self permissionAt: 'Page Code'! ! !SWPage class methodsFor: 'instance-creation' stamp: 'chbu 10/22/2003 16:59'! title: aTitleString parse: aWikiString | document | document := SWWikiParser parse: aWikiString readStream for: SWAction new. ^self new title: aTitleString; document: document; yourself! ! !SWFolder class methodsFor: 'initialize' stamp: 'chbu 10/25/2003 18:51'! initialize " SWFolder initialize " super initialize! ! !SWFolder class methodsFor: 'initialize' stamp: 'chbu 10/22/2003 15:45'! initializeActions super initializeActions. self registerAction: SWFolderEdit.! ! !SWFolder class methodsFor: 'initialize' stamp: 'chbu 10/24/2003 17:14'! initializePermissions " SWFolder initializePermissions " self registerPermission: (SWPermission name: 'Folder Add'). self registerPermission: (SWPermission name: 'Folder Remove'). self registerPermission: (SWPermission name: 'Folder Copy'). self registerPermission: (SWPermission name: 'Folder Move'). self registerPermission: (SWPermission name: 'Folder Edit'). self registerPermission: (SWPermission name: 'Folder View'). self registerPermission: (SWPermission name: 'Folder History'). self registerPermission: (SWPermission name: 'Folder Template'). self registerPermission: (SWPermission name: 'Folder Code').! ! !SWResource class methodsFor: 'configuration' stamp: 'chbu 10/22/2003 09:59'! defaultViewAction ^SWResourceEdit! ! !SWResource class methodsFor: 'initialize' stamp: 'chbu 10/25/2003 18:51'! initialize " SWResource initialize " super initialize! ! !SWResource class methodsFor: 'initialize' stamp: 'chbu 10/22/2003 15:42'! initializeActions super initializeActions. self registerAction: SWResourceEdit. self registerAction: SWResourceHistory.! ! !SWResource class methodsFor: 'initialize' stamp: 'chbu 10/24/2003 17:15'! initializePermissions " SWResource initializePermissions " self registerPermission: (SWPermission name: 'Resource Add'). self registerPermission: (SWPermission name: 'Resource Remove'). self registerPermission: (SWPermission name: 'Resource Copy'). self registerPermission: (SWPermission name: 'Resource Move'). self registerPermission: (SWPermission name: 'Resource Edit'). self registerPermission: (SWPermission name: 'Resource View'). self registerPermission: (SWPermission name: 'Resource History'). self registerPermission: (SWPermission name: 'Resource Template').! ! !SWText class methodsFor: 'instance-creation'! newText: aString ^self new text: aString; yourself! ! !SWCode class methodsFor: 'instance-creation'! newCode: aString ^self newText: aString! ! !SWHeader class methodsFor: 'instance-creation'! newText: aString level: anInteger ^(self newText: aString) level: anInteger; yourself! ! !SWLink class methodsFor: 'instance-creation'! newTo: aString from: aStructure "Create a new instance of the given link type. Depending on aString the receiver is quessing which class is responsible to represent." | link | link := nil. self defaultLinkClasses do: [ :class | (class isValidReference: aString) ifTrue: [ link := class ] ]. ^link newTo: aString from: aStructure! ! !SWLink class methodsFor: 'defaults' stamp: 'chbu 10/22/2003 09:57'! defaultLinkClasses "Return an ordered-collection of different link classes to be ased to handle the reference-string. All classes have to be asked Link>>isValidReference: and the last one should be taken to instantiate the new link." ^OrderedCollection with: SWLinkInternal with: SWLinkMailTo with: SWLinkExternal! ! !SWLink class methodsFor: 'testing'! isValidReference: aString ^false! ! !SWLinkExternal class methodsFor: 'instance-creation'! newTo: aString from: aStructure ^self new reference: aString; yourself! ! !SWLinkExternal class methodsFor: 'testing'! isValidReference: aString ^'*://*' match: aString! ! !SWLinkInternal class methodsFor: 'instance-creation'! newTo: aString from: aStructure ^self new reference: aString; resolver: aStructure; yourself! ! !SWLinkInternal class methodsFor: 'testing'! isValidReference: aString ^true! ! !SWLinkMailTo class methodsFor: 'instance-creation'! newTo: aString from: aStructure ^self new reference: aString; yourself! ! !SWLinkMailTo class methodsFor: 'testing'! isValidReference: aString ^'*@*.*' match: aString! ! !SWWikiScanner methodsFor: 'generated-scanner' stamp: 'chbu 10/24/2003 21:20'! scan1 [self step. currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $)) or: [(currentCharacter between: $+ and: $=) or: [currentCharacter >= $?]]]]] whileTrue. currentCharacter == $* ifTrue: [^self recordAndReportMatch: #(8)]. ^self reportLastMatch! ! !SWWikiScanner methodsFor: 'generated-scanner' stamp: 'chbu 10/24/2003 21:20'! scan2 self recordMatch: #(2). self step. (currentCharacter == $ or: [currentCharacter == $ ]) ifTrue: [^self recordAndReportMatch: #(2)]. ^self reportLastMatch! ! !SWWikiScanner methodsFor: 'generated-scanner' stamp: 'chbu 10/24/2003 21:20'! scanForToken self step. (currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $ ) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: $^) or: [(currentCharacter between: $` and: ${) or: [currentCharacter >= $}]]]]]]]]]]) ifTrue: [self recordMatch: #(11 12). self step. (currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $ ) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]) ifTrue: [ [self recordMatch: #(11). self step. currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $ ) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]] whileTrue. ^self reportLastMatch]. ^self reportLastMatch]. (currentCharacter == $# or: [currentCharacter == $-]) ifTrue: [self recordMatch: #(5 12). self step. (currentCharacter == $# or: [currentCharacter == $-]) ifTrue: [ [self recordMatch: #(5). self step. currentCharacter == $# or: [currentCharacter == $-]] whileTrue. ^self reportLastMatch]. ^self reportLastMatch]. currentCharacter == $ ifTrue: [self recordMatch: #(1 12). self step. currentCharacter == $ ifTrue: [^self recordAndReportMatch: #(2)]. currentCharacter == $ ifTrue: [^self scan2]. ^self reportLastMatch]. currentCharacter == $ ifTrue: [self recordMatch: #(1 12). self step. (currentCharacter == $ or: [currentCharacter == $ ]) ifTrue: [self recordMatch: #(1 2). self step. currentCharacter == $ ifTrue: [^self recordAndReportMatch: #(2)]. currentCharacter == $ ifTrue: [^self scan2]. ^self reportLastMatch]. ^self reportLastMatch]. currentCharacter == $!! ifTrue: [self recordMatch: #(4 12). self step. currentCharacter == $!! ifTrue: [ [self recordMatch: #(4). self step. currentCharacter == $!!] whileTrue. ^self reportLastMatch]. ^self reportLastMatch]. currentCharacter == $* ifTrue: [self recordMatch: #(12). self step. (currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $)) or: [(currentCharacter between: $+ and: $=) or: [currentCharacter >= $?]]]]) ifTrue: [ [self step. currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $)) or: [(currentCharacter between: $+ and: $=) or: [currentCharacter >= $?]]]]] whileTrue. currentCharacter == $* ifTrue: [^self recordAndReportMatch: #(8)]. currentCharacter == $> ifTrue: [^self scan1]. ^self reportLastMatch]. currentCharacter == $* ifTrue: [^self recordAndReportMatch: #(8 9)]. currentCharacter == $> ifTrue: [^self scan1]. ^self reportLastMatch]. currentCharacter == $= ifTrue: [^self recordAndReportMatch: #(7 12)]. currentCharacter == $[ ifTrue: [^self recordAndReportMatch: #(10 12)]. currentCharacter == $\ ifTrue: [self recordMatch: #(12). self step. (currentCharacter == $!! or: [currentCharacter == $# or: [currentCharacter == $* or: [currentCharacter == $- or: [currentCharacter == $= or: [currentCharacter == $[ or: [currentCharacter == $|]]]]]]) ifTrue: [^self recordAndReportMatch: #(9)]. ^self reportLastMatch]. currentCharacter == $_ ifTrue: [self recordMatch: #(3 11 12). self step. (currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]) ifTrue: [ [self recordMatch: #(11). self step. currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $ ) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]] whileTrue. ^self reportLastMatch]. (currentCharacter == $ or: [currentCharacter == $ ]) ifTrue: [ [self recordMatch: #(3 11). self step. (currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]) ifTrue: [ [self recordMatch: #(11). self step. currentCharacter <= $ or: [(currentCharacter between: $ and: $) or: [(currentCharacter between: $ and: $ ) or: [currentCharacter == $" or: [(currentCharacter between: $$ and: $)) or: [(currentCharacter between: $+ and: $,) or: [(currentCharacter between: $. and: $<) or: [(currentCharacter between: $> and: $Z) or: [(currentCharacter between: $] and: ${) or: [currentCharacter >= $}]]]]]]]]]] whileTrue. ^self reportLastMatch]. currentCharacter == $ or: [currentCharacter == $ ]] whileTrue. ^self reportLastMatch]. ^self reportLastMatch]. currentCharacter == $| ifTrue: [^self recordAndReportMatch: #(6 12)]. ^self reportLastMatch! ! !SWWikiScanner methodsFor: 'generated-tokens' stamp: 'chbu 10/24/2003 21:20'! emptySymbolTokenId ^33! ! !SWWikiScanner methodsFor: 'generated-tokens' stamp: 'chbu 10/24/2003 21:20'! errorTokenId ^34! ! !SWWikiScanner methodsFor: 'private' stamp: 'chbu 10/22/2003 18:09'! canParse: aString RBParser parseExpression: aString onError: [:error :pos | ^false]. ^true! ! !SWWikiScanner methodsFor: 'private'! codeStartingAt: aToken | position code | position := stream position. stream position: aToken startPosition. code := ''. [code := code , (stream upTo: $]). self canParse: code] whileFalse: [stream atEnd ifTrue: [stream position: position. ^nil]. code := code , ']']. ^code! ! !SWWikiScanner class methodsFor: 'generated-comments' stamp: 'chbu 10/24/2003 21:20'! scannerDefinitionComment " : \r? \n | \r ; : ; : \_[\ \t]* ; #if there is text on the same line, then treat the line as a paragraph

: \!!+ ; : [\#\-]+ ; : \| ; : \= ; : \> ; : [^\*\>\r\n]*; : \* ( )? \* ; : \*\* | \\ [\[\*\=\!!\#\-\|] ; : \[ ; : [^\r\n\|\*\[\!!\#\-\=\\]+ ; : . ;"! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'chbu 10/20/2003 21:21'! moveDown: anObject ifError: aBlock | index temp | index := self indexOf: anObject. (index between: 1 and: self size - 1) ifTrue: [ temp := self at: index. self at: index put: (self at: index + 1). self at: index + 1 put: temp ] ifFalse: [ aBlock value ]! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'chbu 10/20/2003 21:21'! moveUp: anObject ifError: aBlock | index temp | index := self indexOf: anObject. (index between: 2 and: self size) ifTrue: [ temp := self at: index. self at: index put: (self at: index - 1). self at: index - 1 put: temp ] ifFalse: [ aBlock value ]! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'chbu 10/20/2003 21:25'! streamContents: aBlock ^aBlock value: self readStream! ! !SequenceableCollection class methodsFor: 'stream creation' stamp: 'chbu 10/20/2003 21:26'! streamContents: blockWithArg | stream | stream _ WriteStream on: (self new: 100). blockWithArg value: stream. ^stream contents! ! !Set methodsFor: 'adding' stamp: 'chbu 10/22/2003 19:38'! silentAdd: newObject | index | newObject ifNil: [^newObject]. index _ self findElementOrNil: newObject. (array at: index) ifNil: [self atNewIndex: index put: newObject]. ^ newObject! ! !Set methodsFor: 'enumerating' stamp: 'chbu 10/22/2003 19:38'! collect: aBlock "Evaluate aBlock with each of the receiver's elements as the argument. Collect the resulting values into a collection like the receiver. Answer the new collection." | newSet | newSet _ Set new: self size. array do: [:each | each ifNotNil: [newSet silentAdd: (aBlock value: each)]]. ^ newSet! ! !SmaCCParser methodsFor: 'private' stamp: 'chbu 10/24/2003 21:19'! stringValue: anOrderedCollection ^anOrderedCollection first value! ! !SWWikiParser methodsFor: 'private'! addDocumentItem: aDocumentComponent documentItems add: aDocumentComponent! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:04'! addPreformatted: aString | text | text := SWText newText: aString. (documentItems isEmpty or: [documentItems last class ~= SWPreformatted]) ifTrue: [documentItems add: ((SWPreformatted new) add: text; yourself)] ifFalse: [documentItems last add: text]! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:04'! addString: aString to: aCollection (aCollection notEmpty and: [aCollection last class = SWText]) ifTrue: [aCollection last text: aCollection last text , aString] ifFalse: [aCollection add: (SWText newText: aString)]. ^aCollection! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:04'! addTableRow: aTableRow (documentItems isEmpty or: [documentItems last class ~= SWTable]) ifTrue: [documentItems add: ((SWTable new) add: aTableRow; yourself)] ifFalse: [documentItems last add: aTableRow]! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:04'! createDocument ^SWDocument withAll: documentItems! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:54'! createLink: aString | name value index link | index := aString indexOf: $> ifAbsent: [1]. value := (aString copyFrom: index + 1 to: aString size - 1) withBlanksTrimmed. link := SWLink newTo: value from: self structure. index ~= 1 ifTrue: [name := aString copyFrom: 2 to: index - 1. link text: name withBlanksTrimmed]. ^link! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:04'! listTypeFor: aString ^aString first = $# ifTrue: [SWOrderedList] ifFalse: [SWUnorderedList]! ! !SWWikiParser methodsFor: 'private'! mergeItems: anOrderedCollection withClass: aClass using: aBlock anOrderedCollection size - 1 to: 1 by: -1 do: [:i | | current next | current := anOrderedCollection at: i. (current class = aClass and: [(next := anOrderedCollection at: i + 1) class = aClass]) ifTrue: [aBlock value: current value: next. anOrderedCollection removeAtIndex: i + 1]]. ^anOrderedCollection! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/25/2003 21:26'! mergeText: anOrderedCollection ^self mergeItems: anOrderedCollection withClass: SWText using: [:current :next | current text: current text , next text]! ! !SWWikiParser methodsFor: 'private' stamp: 'chbu 10/22/2003 18:05'! parseCode: startToken | code | action notNil ifTrue: [action assertPermission: SWPage permissionCode]. code := scanner codeStartingAt: startToken. code isNil ifTrue: [currentToken := startToken. self handleError: 0]. currentToken := scanner next. ^SWCode newCode: code! ! !SWWikiParser methodsFor: 'private'! structure ^action structure! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForCode1: nodes ^self parseCode: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForHeader1: nodes ^self addHeader: (nodes at: 2) level: (nodes at: 1) value size! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForInternalTableParagraphText4: nodes ^String with: (nodes at: 1) value last! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine1: nodes ^''! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine2: nodes ^(nodes at: 1) , (nodes at: 2)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine3: nodes ^(nodes at: 1) , (nodes at: 2) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine4: nodes ^(nodes at: 1) , (nodes at: 2) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine5: nodes ^(nodes at: 1) , (nodes at: 2) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLine6: nodes ^(nodes at: 1) , (nodes at: 2) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForLink1: nodes ^self createLink: (nodes at: 1) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForList1: nodes ^self addListItem: (SWListItem withAll: (nodes at: 2)) ofType: (nodes at: 1) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraph1: nodes (nodes at: 2) addFirst: (nodes at: 1). ^self addDocumentItem: (SWParagraph withAll: (self mergeText: (nodes at: 2)))! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems1: nodes ^OrderedCollection new! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems2: nodes ^self addString: (nodes at: 2) value to: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems3: nodes ^(nodes at: 1) add: (nodes at: 2); yourself! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems4: nodes ^(nodes at: 1) add: (nodes at: 2); yourself! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems5: nodes ^self addString: (nodes at: 2) to: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphItems6: nodes ^self addString: (nodes at: 2) value to: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphStart1: nodes ^SWText newText: (nodes at: 1) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphStart2: nodes ^SWText newText: (String with: (nodes at: 1) value last)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForParagraphStart5: nodes ^SWText newText: (nodes at: 1) value! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForPreformatted1: nodes ^self addPreformatted: (nodes at: 2)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTable1: nodes ^self addTableRow: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableCells1: nodes ^OrderedCollection with: (SWTableCell withAll: (nodes at: 2))! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableCells2: nodes ^(nodes at: 1) add: (SWTableCell withAll: (nodes at: 3)); yourself! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableParagraphItems1: nodes ^OrderedCollection new! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableParagraphItems2: nodes ^self addString: (nodes at: 2) value to: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableParagraphItems3: nodes ^(nodes at: 1) add: (nodes at: 2); yourself! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableParagraphItems4: nodes ^(nodes at: 1) add: (nodes at: 2); yourself! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableParagraphItems5: nodes ^self addString: (nodes at: 2) to: (nodes at: 1)! ! !SWWikiParser methodsFor: 'generated-reduction actions' stamp: 'chbu 10/24/2003 21:20'! reduceActionForTableRow1: nodes ^SWTableRow withAll: (nodes at: 1)! ! !SWWikiParser methodsFor: 'private-document items' stamp: 'chbu 10/22/2003 18:07'! addEmptyParagraph documentItems add: SWParagraph new! ! !SWWikiParser methodsFor: 'private-document items' stamp: 'chbu 10/22/2003 18:07'! addHeader: aString level: anInteger documentItems add: (SWHeader newText: aString level: anInteger)! ! !SWWikiParser methodsFor: 'private-document items' stamp: 'chbu 10/22/2003 18:07'! addHorizontalRule documentItems add: SWHorizontalRule new! ! !SWWikiParser methodsFor: 'private-document items'! addListItem: aListItem ofType: aString ^self addListItem: aListItem to: documentItems ofType: aString! ! !SWWikiParser methodsFor: 'private-document items'! addListItem: aListItem to: aCollection ofType: aString | list type | type := self listTypeFor: aString. (aCollection isEmpty or: [aCollection last class ~= type]) ifTrue: [aCollection add: (type new add: aListItem)] ifFalse: [list := aCollection last. aString size > 1 ifTrue: [| newChildren listItem | listItem := list children last. newChildren := listItem children copy. self addListItem: aListItem to: newChildren ofType: (aString copyFrom: 2 to: aString size). newChildren size = listItem children size ifFalse: [listItem add: newChildren last]] ifFalse: [list add: aListItem]]! ! !SWWikiParser methodsFor: 'accessing'! action ^action! ! !SWWikiParser methodsFor: 'accessing'! action: anAction action := anAction! ! !SWWikiParser methodsFor: 'generated-tables' stamp: 'chbu 10/24/2003 21:20'! reduceTable ^#( #(13 2 #reduceActionForParagraph1:) #(14 2 #reduceActionForList1:) #(15 2 #reduceActionForHeader1:) #(16 1 #addHorizontalRule) #(17 1 #reduceActionForTable1:) #(18 0 #reduceActionForParagraphItems1:) #(18 2 #reduceActionForParagraphItems2:) #(18 2 #reduceActionForParagraphItems3:) #(18 2 #reduceActionForParagraphItems4:) #(18 2 #reduceActionForParagraphItems5:) #(18 2 #reduceActionForParagraphItems6:) #(19 1 #addEmptyParagraph) #(20 1 #reduceActionForTableRow1:) #(21 2 #reduceActionForTableCells1:) #(21 3 #reduceActionForTableCells2:) #(22 1 #reduceFor:) #(22 1 #reduceFor:) #(22 1 #reduceFor:) #(22 1 #reduceFor:) #(22 1 #reduceFor:) #(22 1 #reduceFor:) #(23 0 #reduceActionForTableParagraphItems1:) #(23 2 #reduceActionForTableParagraphItems2:) #(23 2 #reduceActionForTableParagraphItems3:) #(23 2 #reduceActionForTableParagraphItems4:) #(23 2 #reduceActionForTableParagraphItems5:) #(24 0 #reduceFor:) #(24 1 #reduceFor:) #(24 3 #reduceFor:) #(24 3 #reduceFor:) #(24 2 #reduceFor:) #(24 2 #reduceFor:) #(25 1 #reduceActionForLink1:) #(26 1 #reduceActionForCode1:) #(27 1 #stringValue:) #(27 1 #stringValue:) #(27 1 #stringValue:) #(27 1 #reduceActionForInternalTableParagraphText4:) #(27 1 #stringValue:) #(27 1 #stringValue:) #(28 1 #reduceFor:) #(29 2 #reduceActionForPreformatted1:) #(30 1 #reduceActionForParagraphStart1:) #(30 1 #reduceActionForParagraphStart2:) #(30 1 #liftFirstValue:) #(30 1 #liftFirstValue:) #(30 1 #reduceActionForParagraphStart5:) #(31 1 #createDocument) #(32 0 #reduceActionForLine1:) #(32 2 #reduceActionForLine2:) #(32 2 #reduceActionForLine3:) #(32 2 #reduceActionForLine4:) #(32 2 #reduceActionForLine5:) #(32 2 #reduceActionForLine6:) )! ! !SWWikiParser methodsFor: 'generated-tables' stamp: 'chbu 10/24/2003 21:20'! transitionTable ^#( #(3 110 1 110 2 9 3 13 4 17 5 21 6 25 7 29 8 33 9 37 10 41 11 45 12 49 13 53 14 57 15 61 16 65 17 69 20 73 21 77 22 81 24 85 25 89 26 93 29 97 30 101 31 110 33) #(2 18 1 2 33) #(3 198 1 198 2 198 3 198 4 198 5 198 6 198 7 198 8 198 9 198 10 198 11 198 12 105 32 198 33) #(3 26 1 26 2 26 3 26 4 26 5 26 6 26 7 26 8 26 9 26 10 26 11 26 12 109 18 26 33) #(3 90 1 90 2 90 3 90 4 90 5 90 6 90 7 90 8 90 9 90 10 90 11 90 12 113 23 90 33) #(3 198 1 198 2 198 3 198 4 198 5 198 6 198 7 198 8 198 9 198 10 198 11 198 12 117 32 198 33) #(2 134 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 178 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 138 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 174 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 190 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 86 1 2 33) #(2 74 1 2 33) #(2 70 1 2 33) #(2 66 1 2 33) #(2 82 1 2 33) #(2 22 1 2 33) #(3 54 1 54 2 121 6 54 33) #(2 114 1 2 33) #(3 125 1 129 2 133 19 194 33) #(2 186 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 182 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 78 1 2 33) #(3 26 1 26 2 26 3 26 4 26 5 26 6 26 7 26 8 26 9 26 10 26 11 26 12 137 18 26 33) #(2 0 33) #(3 14 1 14 2 141 3 145 4 149 5 153 6 157 7 161 8 165 9 169 10 173 11 177 12 181 27 14 33) #(3 10 1 10 2 141 3 145 4 149 5 185 6 157 7 29 8 165 9 37 10 189 11 177 12 193 25 197 26 201 27 10 33) #(3 58 1 58 2 141 3 145 4 149 5 58 6 157 7 29 8 165 9 37 10 205 11 177 12 209 25 213 26 217 27 58 33) #(3 170 1 170 2 141 3 145 4 149 5 153 6 157 7 161 8 165 9 169 10 173 11 177 12 181 27 170 33) #(3 90 1 90 2 90 3 90 4 90 5 90 6 90 7 90 8 90 9 90 10 90 11 90 12 221 23 90 33) #(3 126 1 126 2 9 3 13 4 17 5 21 6 25 7 29 8 33 9 37 10 41 11 45 12 49 13 53 14 57 15 61 16 65 17 69 20 73 21 225 22 85 25 89 26 93 29 97 30 126 33) #(2 50 1 2 3 4 5 6 7 8 9 10 11 12 33) #(3 130 1 130 2 9 3 13 4 17 5 21 6 25 7 29 8 33 9 37 10 41 11 45 12 49 13 53 14 57 15 61 16 65 17 69 20 73 21 229 22 85 25 89 26 93 29 97 30 130 33) #(3 6 1 6 2 141 3 145 4 149 5 185 6 157 7 29 8 165 9 37 10 189 11 177 12 193 25 197 26 201 27 6 33) #(2 142 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 146 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 150 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 206 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 158 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 214 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 154 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 218 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 210 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 162 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 202 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 46 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 30 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 34 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 38 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 42 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 94 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 98 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 102 1 2 3 4 5 6 7 8 9 10 11 12 33) #(2 106 1 2 3 4 5 6 7 8 9 10 11 12 33) #(3 62 1 62 2 141 3 145 4 149 5 62 6 157 7 29 8 165 9 37 10 205 11 177 12 209 25 213 26 217 27 62 33) #(2 118 1 2 33) #(2 122 1 2 33) )! ! !SWWikiParser methodsFor: 'initialize-release'! initialize super initialize. documentItems := OrderedCollection new! ! !SWWikiParser class methodsFor: 'generated-accessing' stamp: 'chbu 10/24/2003 21:20'! scannerClass ^SWWikiScanner! ! !SWWikiParser class methodsFor: 'generated-starting states' stamp: 'chbu 10/24/2003 21:20'! startingStateForDocument ^1! ! !SWWikiParser class methodsFor: 'instance creation'! parse: aStream for: anAction "To parse a page I need a stream, where I can read from and an action to know the current runtime-information." | parser | parser := self on: aStream. parser action: anAction. ^parser parse! ! !SWWikiParser class methodsFor: 'generated-comments' stamp: 'chbu 10/24/2003 21:20'! itemSetsComment " 1 [TableRow : . TableCells;E O F ] [Paragraph : . ParagraphStart ParagraphItems;E O F ] [ParagraphStart : . ;

E O F

] [ParagraphStart : . Code;

E O F

] [TableCells : . TableCells

TableParagraphItems;E O F

] [DocumentItem : . Header;E O F ] [HorizontalRule : . ;E O F ] [Document : . DocumentItems;E O F] [DocumentItem : . Table;E O F ] [DocumentItems : . DocumentItem;E O F ] [DocumentItem : . Paragraph;E O F ] [ParagraphStart : . ;

E O F

] [B e g i n : . Document;E O F] [Header : .

Line;E O F ] [DocumentItem : . HorizontalRule;E O F ] [DocumentItems : . ;E O F ] [DocumentItems : . DocumentItems DocumentItem;E O F ] [Link : . ;

E O F

] [DocumentItems : . DocumentItems ; E O F ] [DocumentItems : . DocumentItems BlankLine DocumentItem; E O F ] [List : . ParagraphItems;E O F ] [ParagraphStart : . Link;

E O F

] [Table : . TableRow;E O F ] [Code : . ;

E O F

] [ParagraphStart : . ;

E O F

] [DocumentItems : . DocumentItems BlankLine; E O F ] [DocumentItem : . List;E O F ] [Preformatted : . Line;E O F ] [DocumentItem : . Preformatted;E O F ] [TableCells : .

TableParagraphItems;E O F

] 2 [HorizontalRule : . ;E O F ] 3 [Header :

. Line;E O F ] [Line : . Line ;

E O F

] [Line : . ;

E O F

] [Line : . Line InternalTableParagraphText;

E O F

] [Line : . Line ;

E O F

] [Line : . Line ;

E O F

] [Line : . Line

;

E O F

] 4 [ParagraphItems : . ParagraphItems ;

E O F

] [ParagraphItems : . ParagraphItems Link;

E O F

] [ParagraphItems : . ParagraphItems Code;

E O F

] [List : . ParagraphItems;E O F ] [ParagraphItems : . ;

E O F

] [ParagraphItems : . ParagraphItems

;

E O F

] [ParagraphItems : . ParagraphItems InternalTableParagraphText;

E O F

] 5 [TableParagraphItems : . TableParagraphItems InternalTableParagraphText;

E O F

] [TableCells :

. TableParagraphItems;E O F

] [TableParagraphItems : . TableParagraphItems Code;

E O F

] [TableParagraphItems : . ;

E O F

] [TableParagraphItems : . TableParagraphItems Link;

E O F

] [TableParagraphItems : . TableParagraphItems ;

E O F

] 6 [Line : . Line ;

E O F

] [Preformatted : . Line;E O F ] [Line : . ;

E O F

] [Line : . Line InternalTableParagraphText;

E O F

] [Line : . Line ;

E O F

] [Line : . Line ;

E O F

] [Line : . Line

;

E O F

] 7 [Link : . ;

E O F

] 8 [ParagraphStart : . ;

E O F

] 9 [Code : . ;

E O F

] 10 [ParagraphStart : . ;

E O F

] 11 [ParagraphStart : . ;

E O F

] 12 [DocumentItem : Paragraph . ;E O F ] 13 [DocumentItem : List . ;E O F ] 14 [DocumentItem : Header . ;E O F ] 15 [DocumentItem : HorizontalRule . ;E O F ] 16 [DocumentItem : Table . ;E O F ] 17 [Table : TableRow . ;E O F ] 18 [TableRow : TableCells . ;E O F ] [TableCells : TableCells .

TableParagraphItems;E O F

] 19 [DocumentItems : DocumentItem . ;E O F ] 20 [DocumentItems : DocumentItems . ; E O F ] [DocumentItems : DocumentItems . BlankLine DocumentItem; E O F ] [BlankLine : . ;

E O F

] [Document : DocumentItems . ;E O F] [DocumentItems : DocumentItems . BlankLine; E O F ] [DocumentItems : DocumentItems . DocumentItem;E O F ] 21 [ParagraphStart : Link . ;

E O F

] 22 [ParagraphStart : Code . ;

E O F

] 23 [DocumentItem : Preformatted . ;E O F ] 24 [ParagraphItems : . ParagraphItems ;

E O F

] [ParagraphItems : . ParagraphItems Link;

E O F

] [ParagraphItems : . ParagraphItems Code;

E O F

] [Paragraph : ParagraphStart . ParagraphItems;E O F ] [ParagraphItems : . ;

E O F

] [ParagraphItems : . ParagraphItems

;

E O F

] [ParagraphItems : . ParagraphItems InternalTableParagraphText;

E O F

] 25 [B e g i n : Document . ;E O F] 26 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [Header :

Line . ;E O F ] [Line : Line . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Line : Line .

;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Line : Line . InternalTableParagraphText;

E O F

] [Line : Line . ;

E O F

] [Line : Line . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] 27 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [ParagraphItems : ParagraphItems . InternalTableParagraphText;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Link : . ;

E O F

] [ParagraphItems : ParagraphItems . Link;

E O F

] [InternalTableParagraphText : . ;

E O F

] [ParagraphItems : ParagraphItems .

;

E O F

] [Code : . ;

E O F

] [ParagraphItems : ParagraphItems . Code;

E O F

] [ParagraphItems : ParagraphItems . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [List : ParagraphItems . ;E O F ] [InternalTableParagraphText : . ;

E O F

] 28 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Link : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [TableCells :

TableParagraphItems . ;E O F

] [TableParagraphItems : TableParagraphItems . Link;

E O F

] [TableParagraphItems : TableParagraphItems . ;

E O F

] [TableParagraphItems : TableParagraphItems . InternalTableParagraphText;

E O F

] [Code : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [TableParagraphItems : TableParagraphItems . Code;

E O F

] [InternalTableParagraphText : . ;

E O F

] 29 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Line : Line . ;

E O F

] [Preformatted : Line . ;E O F ] [Line : Line .

;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Line : Line . InternalTableParagraphText;

E O F

] [Line : Line . ;

E O F

] [Line : Line . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] 30 [TableParagraphItems : . TableParagraphItems InternalTableParagraphText;

E O F

] [TableCells : TableCells

. TableParagraphItems;E O F

] [TableParagraphItems : . TableParagraphItems Code;

E O F

] [TableParagraphItems : . ;

E O F

] [TableParagraphItems : . TableParagraphItems Link;

E O F

] [TableParagraphItems : . TableParagraphItems ;

E O F

] 31 [TableRow : . TableCells;E O F ] [Paragraph : . ParagraphStart ParagraphItems;E O F ] [ParagraphStart : . ;

E O F

] [ParagraphStart : . Code;

E O F

] [TableCells : . TableCells

TableParagraphItems;E O F

] [DocumentItem : . Header;E O F ] [DocumentItems : DocumentItems . DocumentItem;E O F ] [HorizontalRule : . ;E O F ] [DocumentItem : . Table;E O F ] [DocumentItem : . Paragraph;E O F ] [ParagraphStart : . ;

E O F

] [DocumentItems : DocumentItems . ; E O F ] [Header : .

Line;E O F ] [DocumentItem : . HorizontalRule;E O F ] [Link : . ;

E O F

] [List : . ParagraphItems;E O F ] [ParagraphStart : . Link;

E O F

] [Table : . TableRow;E O F ] [Code : . ;

E O F

] [ParagraphStart : . ;

E O F

] [DocumentItem : . List;E O F ] [Preformatted : . Line;E O F ] [DocumentItem : . Preformatted;E O F ] [TableCells : .

TableParagraphItems;E O F

] 32 [BlankLine : . ;

E O F

] 33 [TableRow : . TableCells; E O F ] [Paragraph : . ParagraphStart ParagraphItems; E O F ] [ParagraphStart : . ;

E O F

] [DocumentItem : . Preformatted; E O F ] [TableCells : . TableCells

TableParagraphItems; E O F

] [DocumentItem : . Header; E O F ] [HorizontalRule : . ; E O F ] [DocumentItem : . Table; E O F ] [DocumentItem : . Paragraph; E O F ] [ParagraphStart : . ;

E O F

] [DocumentItems : DocumentItems BlankLine . DocumentItem; E O F ] [Header : .

Line; E O F ] [DocumentItem : . HorizontalRule; E O F ] [DocumentItems : DocumentItems BlankLine . ; E O F ] [Link : . ;

E O F

] [List : . ParagraphItems; E O F ] [ParagraphStart : . Link;

E O F

] [Table : . TableRow; E O F ] [Code : . ;

E O F

] [ParagraphStart : . ;

E O F

] [DocumentItem : . List; E O F ] [ParagraphStart : . Code;

E O F

] [Preformatted : . Line; E O F ] [TableCells : .

TableParagraphItems; E O F

] 34 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [ParagraphItems : ParagraphItems . InternalTableParagraphText;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Link : . ;

E O F

] [ParagraphItems : ParagraphItems . Link;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Paragraph : ParagraphStart ParagraphItems . ;E O F ] [ParagraphItems : ParagraphItems .

;

E O F

] [Code : . ;

E O F

] [ParagraphItems : ParagraphItems . Code;

E O F

] [ParagraphItems : ParagraphItems . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] 35 [InternalTableParagraphText : . ;

E O F

] 36 [InternalTableParagraphText :

. ;

E O F

] 37 [InternalTableParagraphText : . ;

E O F

] 38 [Line : Line

. ;

E O F

] 39 [InternalTableParagraphText : . ;

E O F

] 40 [Line : Line . ;

E O F

] 41 [InternalTableParagraphText : . ;

E O F

] 42 [Line : Line . ;

E O F

] 43 [Line : Line . ;

E O F

] 44 [InternalTableParagraphText : . ;

E O F

] 45 [Line : Line InternalTableParagraphText . ;

E O F

] 46 [ParagraphItems : ParagraphItems

. ;

E O F

] 47 [ParagraphItems : ParagraphItems . ;

E O F

] 48 [ParagraphItems : ParagraphItems Link . ;

E O F

] 49 [ParagraphItems : ParagraphItems Code . ;

E O F

] 50 [ParagraphItems : ParagraphItems InternalTableParagraphText . ;

E O F

] 51 [TableParagraphItems : TableParagraphItems . ;

E O F

] 52 [TableParagraphItems : TableParagraphItems Link . ;

E O F

] 53 [TableParagraphItems : TableParagraphItems Code . ;

E O F

] 54 [TableParagraphItems : TableParagraphItems InternalTableParagraphText . ;

E O F

] 55 [InternalTableParagraphText : . ;

E O F

] [InternalTableParagraphText : .

;

E O F

] [InternalTableParagraphText : . ;

E O F

] [Link : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [TableCells : TableCells

TableParagraphItems . ;E O F

] [TableParagraphItems : TableParagraphItems . Link;

E O F

] [TableParagraphItems : TableParagraphItems . ;

E O F

] [TableParagraphItems : TableParagraphItems . InternalTableParagraphText;

E O F

] [Code : . ;

E O F

] [InternalTableParagraphText : . ;

E O F

] [TableParagraphItems : TableParagraphItems . Code;

E O F

] [InternalTableParagraphText : . ;

E O F

] 56 [DocumentItems : DocumentItems DocumentItem . ;E O F ] 57 [DocumentItems : DocumentItems BlankLine DocumentItem . ; E O F ] "! ! !SWWikiParser class methodsFor: 'generated-comments' stamp: 'chbu 10/24/2003 21:20'! parserDefinitionComment "Document : DocumentItems {#createDocument}; DocumentItems : | DocumentItem | DocumentItems DocumentItem | DocumentItems BlankLine DocumentItem | DocumentItems | DocumentItems BlankLine ; BlankLine : {#addEmptyParagraph}; DocumentItem : HorizontalRule | Header | List | Preformatted | Table | Paragraph ; ################################################################### HorizontalRule : {#addHorizontalRule} ; Header :

'headerString' Line 'text' {self addHeader: text level: headerString value size} ; List : 'listType' ParagraphItems 'items' {self addListItem: (SWListItem withAll: items) ofType: listType value}; Preformatted : Line 'text' {self addPreformatted: text}; ################################################################### Table : TableRow 'row' {self addTableRow: row}; TableRow : TableCells 'cells' {SWTableRow withAll: cells}; TableCells :

TableParagraphItems 'paragraph' {OrderedCollection with: (SWTableCell withAll: paragraph)} | TableCells 'cells'

TableParagraphItems 'paragraph' {cells add: (SWTableCell withAll: paragraph); yourself}; TableParagraphItems : {OrderedCollection new} | TableParagraphItems 'items' 'text' {self addString: text value to: items} | TableParagraphItems 'items' Link 'link' {items add: link; yourself} | TableParagraphItems 'items' Code 'code' {items add: code; yourself} | TableParagraphItems 'items' InternalTableParagraphText 'text' {self addString: text to: items} ; InternalTableParagraphText : {#stringValue:} |

{#stringValue:} | {#stringValue:} | 'text' {String with: text value last} | {#stringValue:} | {#stringValue:}; ################################################################### Paragraph : ParagraphStart 'firstItem' ParagraphItems 'items' {items addFirst: firstItem. self addDocumentItem: (SWParagraph withAll: (self mergeText: items))} ; ParagraphStart : 'text' {SWText newText: text value} | 'text' {SWText newText: (String with: text value last)} | Code {#liftFirstValue:} | Link {#liftFirstValue:} | 'char' {SWText newText: char value}; ParagraphItems : {OrderedCollection new} | ParagraphItems 'items' 'text' {self addString: text value to: items} | ParagraphItems 'items' Link 'link' {items add: link; yourself} | ParagraphItems 'items' Code 'code' {items add: code; yourself} | ParagraphItems 'items' InternalTableParagraphText 'text' {self addString: text to: items} | ParagraphItems 'items'

'text' {self addString: text value to: items}; ################################################################### Link: 'link' {self createLink: link value}; ################################################################### # Reads the next line as unformatted string ################################################################### Line: {''} | Line 'line' InternalTableParagraphText 'text' {line, text} | Line 'line'

'text' {line , text value} | Line 'line' 'text' {line, text value} | Line 'line' 'link' {line, link value} | Line 'line' 'bracket' {line, bracket value}; ################################################################### # Code # Instead of parsing the code with this parser, we locate the starting """"""""""""""""["""""""""""""""" and # parse the code using a Smalltalk parser and code. ################################################################### Code: 'startToken' {self parseCode: startToken};"! ! !SWWikiParser class methodsFor: 'generated-comments' stamp: 'chbu 10/24/2003 21:20'! symbolComment " 1. 2. 3. 4.

5. 6.

7. 8. 9. 10. 11. 12. 13. Paragraph 14. List 15. Header 16. HorizontalRule 17. Table 18. ParagraphItems 19. BlankLine 20. TableRow 21. TableCells 22. DocumentItem 23. TableParagraphItems 24. DocumentItems 25. Link 26. Code 27. InternalTableParagraphText 28. B e g i n 29. Preformatted 30. ParagraphStart 31. Document 32. Line 33. E O F 34. error "! ! !String methodsFor: 'converting' stamp: 'chbu 10/20/2003 21:36'! asWikiIdentifier ^self select: [ :char | char isWikiIdentifier ]! ! !TimeStamp class methodsFor: 'instance creation' stamp: 'chbu 10/21/2003 19:01'! now "Answer the current date and time as a TimeStamp." ^self current! ! !UndefinedObject methodsFor: 'printing' stamp: 'chbu 10/21/2003 18:19'! renderOn: html! ! SWWikiScanner class removeSelector: #initializeKeywordMap! SWResource initialize! SWFolder initialize! SWPage initialize! SWStructure initialize! SWWikiItem initialize! !SWComancheSite reorganize! ('comanche' helpResolve:) ('response' prepareResponse: prepareResponseCookie:from: prepareResponseHeader:from:) ('request' prepareRequest: prepareRequestCookies: prepareRequestFields: prepareRequestHeaders: prepareRequestUrl:) ('accessing' server server:) ! SWTemplate initialize! SWSmallWiki initialize! SWComancheServer removeSelector: #defaultSwazooServer! SWComancheServer removeSelector: #defaultSwazooSite! SWHtmlWriteStream initialize! SWAction initialize! "Postscript:" SWPage initialize. SWStructure initialize. SWResource initialize. SWServer defaultWorkspace.!