From VisualWorks® NonCommercial, Release 7 of March 21, 2003 on July 15, 2003 at 3:20:27 am (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] WebMVC Smalltalk false private Smalltalk.* WebMVC WebMVC WebMVCTests Smalltalk false private Smalltalk.* private WebMVC.* private VisualWave.* WebMVC-Tests WebMVC-Tests InputFieldDescription WebMVC Core.Object false none description type validator WebMVC-Servlets WebMVC-Servlets GetPropertyTag WebMVC VisualWave.GetPropertyTag false none WebMVC-Tags WebMVC-Tags WebMVC.GetPropertyTag I extend the standard GetPropertyTag to support dotted path notations for the property. For example: <mvc:getProperty name="someBean" property="address.city"> Would send the object corresponding to someBean the message address and then send the resulting object the message city. The resulting object would be returned. If any of the intermediate path elements is nil, you will probably get a DNU for the next path element. There is currently no mechanism for handling this. TagTest WebMVCTests XProgramming.SUnit.TestCase false none site savedPreferences session WebMVC-Tests WebMVC-Tests FormTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests StringConverter WebMVC Core.Object false none WebMVC-TypeConverters WebMVC-TypeConverters BeanFinder WebMVC Core.Object false none WebMVC-Servlets WebMVC-Servlets FrozenViewRequest WebMVC Core.Object false none query attributes path WebMVC-Servlets WebMVC-Servlets TagLibrary WebMVC VisualWave.TagLibrary false none WebMVC-Tools WebMVC-Tools ErrorSourceCommand WebMVCTests Core.Object false none WebMVC-Tests WebMVC-Tests TagAttribute WebMVC VisualWave.TagAttributeSpec false none description WebMVC-Tools WebMVC-Tools WebError WebMVC Core.Object false none WebMVC-Errors WebMVC-Errors SequencingTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests ValidationError WebMVC Core.Object false none description variableName WebMVC-Errors WebMVC-Errors GenericError WebMVC Core.Object false none message WebMVC-Errors WebMVC-Errors ServletWithModel WebMVC VisualWave.SingleThreadModelServlet false none adaptor errors formModel formDescription WebMVC-Servlets WebMVC-Servlets UseBeanTag WebMVC VisualWave.UseBeanTag false none fromBean fromScope WebMVC-Tags WebMVC-Tags ExistsTag WebMVC VisualWave.Tag false none name scope WebMVC-Tags WebMVC-Tags StringParameterSubstitution Core Core.Object false none argumentTypeMapping input output defaultEmphasis args argEmphases startDelim endDelim Collections-Text WebMVC-Extensions Core.StringParameterSubstitution This class does parameter substitution on strings. It can also be used to transform simple escape sequences into non-printable characters. Formal parameters in the string are enclosed in the brackets < >. Immediately following the opening bracket there may be an integer--this defines which of the arguments should be substituted in here, which means that the string can cause arguments to appear in a different order than they are passed in, and it can also print the same argument more than once. Following this index, if any, there is a character that identifies how the substitution will be performed--below, you'll find a table describing the default substitution types. After this type character, the remainder of the characters inside the brackets serve as arguments to the substitution--if the substitution operation is defined as having no arguments, it is an error to include any non-blank characters here. If there was no index present, the code will assume an index of nil--it's almost certain that this will be an error, unless the character signifies an operation that is parameter-independent, such as 'n' and 't' below. The default formal parameter types are as follows: <1p> Replace the formal parameter with the first argument's printString. <3s> The third argument must be a CharacterArray. Replace the formal parameter with that argument. <4?foo:bar> The fourth argument must be a Boolean. If the argument is true, replace the formal parameter with 'foo', otherwise replace it with 'bar'. <2#foo:bar> The second argument must be a Number. If the argument is equal to 1, replace the formal parameter with 'foo', otherwise replace it with 'bar'. <n> Insert a CR into the text <t> Insert a tab into the text The character $% acts as the quote character. Unless otherwise specified, any character following the quote character is itself, and is not treated specially. For example, '%%' becomes '%', and '%<' becomes '<'--which, since it was preceded by the quote character, is not treated as the beginning of a formal parameter. WebMVCController WebMVC WebMVC.ServletWithModel false none target WebMVC-Servlets WebMVC-Servlets ElementTag WebMVC VisualWave.Tag false none tabIndex accessKey WebMVC-Tags WebMVC-Tags MenuTag WebMVC WebMVC.ElementTag false none WebMVC-Tags WebMVC-Tags ScriptableTag WebMVC WebMVC.ElementTag false none onload onunload onclick ondblclick onmousedown onmouseup onmouseover onmousemove onmouseout onfocus onblur onkeypress onkeydown onkeyup onsubmit onreset onselect onchange WebMVC-Tags WebMVC-Tags WebMVC.ScriptableTag Most of the code for this tag was generated automatically since there are so many annoying ivars. Here are code snippets to perform the code generation: "Generate the setters" ScriptableTag instVarNames do: [ :var | | clone | clone := var copy. clone at: 1 put: (clone at: 1) asUppercase. ScriptableTag compile: 'set' , clone , ': aValue <required: false description: ''Javascript code for the ' , var , ' event.''> ' , var , ' := aValue' classified: 'jsp accessing'] "Generate the release method" |ws| ws := WriteStream on: String new. ScriptableTag instVarNames do: [ :var | ws nextPutAll: var; nextPutAll: ' := nil. ']. ScriptableTag compile: 'release super release. ' , ws contents classified: 'initialize-release'. "Generate the tagParametersOn: method" |ws| ws := WriteStream on: String new. ScriptableTag instVarNames do: [ :var | ws nextPutAll: var; nextPutAll: ' ifNotNil: [self spacedWriteOn: aStream with: '''; nextPutAll: var; nextPutAll: '="'' , '; nextPutAll: var; nextPutAll: ', ''"'']. ']. ws contents. ScriptableTag compile: 'tagParametersOn: aStream super tagParametersOn: aStream. ' , ws contents , ' ^aStream' classified: 'api'. Instance Variables: onblur <String> scripting action for onblur onchange <String> scripting action for onchange onclick <String> scripting action for onclick ondblclick <String> scripting action for ondblclick onfocus <String> scripting action for onfocus onkeydown <String> scripting action for onkeydown onkeypress <String> scripting action for onkeypress onkeyup <String> scripting action for onkeyup onload <String> scripting action for onload onmousedown <String> scripting action for onmousedown onmousemove <String> scripting action for onmousemove onmouseout <String> scripting action for onmouseout onmouseover <String> scripting action for onmouseover onmouseup <String> scripting action for onmouseup onreset <String> scripting action for onreset onselect <String> scripting action for onselect onsubmit <String> scripting action for onsubmit onunload <String> scripting action for onunload MenuItemTag WebMVC WebMVC.ScriptableTag false none text uri WebMVC-Tags WebMVC-Tags TagTestModelWithoutSpecs WebMVCTests Core.Object false none username password age WebMVC-Tests WebMVC-Tests ButtonDescription WebMVC Core.Object false none invoke WebMVC-Servlets WebMVC-Servlets BaseTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests BaseTag WebMVC VisualWave.Tag false none WebMVC-Tags WebMVC-Tags SubmitTag WebMVC VisualWave.Tag false none value invoke name WebMVC-Tags WebMVC-Tags ResetTag WebMVC WebMVC.SubmitTag false none WebMVC-Tags WebMVC-Tags StyledTag WebMVC WebMVC.ScriptableTag false none style styleID styleClass WebMVC-Tags WebMVC-Tags ActionTag WebMVC WebMVC.StyledTag false none modelName modelScope formID invoke sequencer targetName targetClass WebMVC-Tags WebMVC-Tags PropertyAdaptor WebMVC UI.ValueModel false none model propertyName setMethod getMethod fieldSpec WebMVC-Servlets WebMVC-Servlets WebMVC.PropertyAdaptor PropertyAdaptor knows how to get a value from a model and turn it into a String (value), and convert a value from a String to the appropriate type for the model and store it in the model (value:). PropertyAdaptor uses a FieldSpec to perform the conversions. It builds the FieldSpec in one of three ways (corresponding to three instance creation methods): . if given an InputTag it will request property name, and type information from the tag . if given a form model it will build the FieldSpec by asking the form model for it (fieldSpecFor:) . if given form data it will build the FieldSpec by looking for type information embedded form values Instance Variables: getMethod <Symbol> name of method used to set value of property in model model <Object> model propertyName <String> name of property being manipulated setMethod <Symbol> name of method used to get value of property from model fieldSpec <FieldSpec> the field spec used to manipulate this property TLDBuilder WebMVC UI.ApplicationModel false none activeTags tagLibraryChoices tagLibrary WebMVC-Tools WebMVC-Tools FormTag WebMVC WebMVC.ActionTag false none modelClassName validationScript firstFocus action WebMVC-Tags WebMVC-Tags ActionExecutionTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests FormDescription WebMVC Core.Object false none formID inputFields modelName modelClassName formModelScope invoke forwards buttons invokeOnModel sequencer WebMVC-Servlets WebMVC-Servlets ApplicationFormDescription WebMVC WebMVC.FormDescription false none applicationName applicationClassName WebMVC-Servlets WebMVC-Servlets CommandFormDescription WebMVC WebMVC.FormDescription false none commandClassName WebMVC-Servlets WebMVC-Servlets HtmlTag WebMVC VisualWave.BodyTag false none outgoingRequestMarker outgoingRequestState sequencer WebMVC-Tags WebMVC-Tags Forwarder WebMVC Core.Object false none urlString external WebMVC-Servlets WebMVC-Servlets IntegerConverter WebMVC Core.Object false none WebMVC-TypeConverters WebMVC-TypeConverters LabelTag WebMVC WebMVC.StyledTag false none errorClass for WebMVC-Tags WebMVC-Tags NotExistsTag WebMVC WebMVC.ExistsTag false none WebMVC-Tags WebMVC-Tags ActionDataTag WebMVC VisualWave.BodyTag false none name value WebMVC-Tags WebMVC-Tags Preferences WebMVC Core.Object false none serializeStateOntoURL useInternalRedirects WebMVC-Servlets WebMVC-Servlets ForwardLinkTag WebMVC VisualWave.BodyTag false none name href WebMVC-Tags WebMVC-Tags FieldValidator WebMVC Core.Object false none WebMVC-TypeConverters WebMVC-TypeConverters MaxLengthValidator WebMVC WebMVC.FieldValidator false none maxLength WebMVC-TypeConverters WebMVC-TypeConverters CompositeValidator WebMVC WebMVC.FieldValidator false none validators WebMVC-TypeConverters WebMVC-TypeConverters MinLengthValidator WebMVC WebMVC.FieldValidator false none minLength WebMVC-TypeConverters WebMVC-TypeConverters RequiredFieldValidator WebMVC WebMVC.FieldValidator false none WebMVC-TypeConverters WebMVC-TypeConverters EMailAddressFormatValidator WebMVC WebMVC.FieldValidator false none WebMVC-TypeConverters WebMVC-TypeConverters ErrorsTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests InternalRequestState WebMVC Core.Object false none id errors forms WebMVC-Servlets WebMVC-Servlets ActionLinkTag WebMVC WebMVC.ActionTag false none href dataItems WebMVC-Tags WebMVC-Tags ActionRedirectTag WebMVC WebMVC.ActionLinkTag false none WebMVC-Tags WebMVC-Tags JavascriptScript WebMVC Core.Object false none name scriptText WebMVC-Tags WebMVC-Tags OptionTag WebMVC WebMVC.StyledTag false none label selected value WebMVC-Tags WebMVC-Tags IntegerValidator WebMVC WebMVC.FieldValidator false none WebMVC-TypeConverters WebMVC-TypeConverters HtmlTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests InputTag WebMVC WebMVC.StyledTag false none name property size redisplay description propertyAdaptor inputTagType type validator WebMVC-Tags WebMVC-Tags HiddenTag WebMVC WebMVC.InputTag false none WebMVC-Tags WebMVC-Tags InputTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests CheckBoxTag WebMVC WebMVC.InputTag false none checked WebMVC-Tags WebMVC-Tags TextTag WebMVC WebMVC.InputTag false none WebMVC-Tags WebMVC-Tags TextAreaTag WebMVC WebMVC.InputTag false none rows cols readonly WebMVC-Tags WebMVC-Tags SelectTag WebMVC WebMVC.InputTag false none multiple WebMVC-Tags WebMVC-Tags RadioTag WebMVC WebMVC.InputTag false none value checked WebMVC-Tags WebMVC-Tags ButtonTag WebMVC WebMVC.InputTag false none value WebMVC-Tags WebMVC-Tags PasswordTag WebMVC WebMVC.InputTag false none WebMVC-Tags WebMVC-Tags IfErrorsTag WebMVC VisualWave.Tag false none property WebMVC-Tags WebMVC-Tags LoginError WebMVC Core.Object false none WebMVC-Errors WebMVC-Errors SessionScopeModelTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests EmbeddedTypeTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests OptGroupTag WebMVC WebMVC.StyledTag false none label WebMVC-Tags WebMVC-Tags Sequencer WebMVC Core.Object false none WebMVC-Servlets WebMVC-Sequencers NoRepeatSequencer WebMVC WebMVC.Sequencer false none hasExecuted WebMVC-Servlets WebMVC-Sequencers SequencerList WebMVC WebMVC.Sequencer false none sequencers WebMVC-Servlets WebMVC-Sequencers InertSequencer WebMVC WebMVC.Sequencer false none WebMVC-Servlets WebMVC-Sequencers ErrorsTag WebMVC WebMVC.StyledTag false none WebMVC-Tags WebMVC-Tags InternalStateManager WebMVC Core.Object false none states activeSequencer lastValidRequest WebMVC-Servlets WebMVC-Servlets RequiredPageSequencer WebMVC WebMVC.Sequencer false none outgoingMarker incomingMarker pathInfo WebMVC-Servlets WebMVC-Sequencers WebMVC.RequiredPageSequencer I enforce the requirement that the page with the supplied marker is submitted. If it is not, I redirect control back the the viewURL with a GenericError containing my message. Instance Variables: marker <Object> the marker assigned to the page being displayed message <String> the message to be supplied the the GenericError if the marker is not submitted TagDefinition WebMVC VisualWave.TagSpec false none WebMVC-Tools WebMVC-Tools FormModelAdaptor WebMVC Core.Object false none formModel propertyAdaptors WebMVC-Servlets WebMVC-Servlets IfErrorsTagTest WebMVCTests WebMVCTests.TagTest false none WebMVC-Tests WebMVC-Tests SingletonCommand WebMVCTests Core.Object false none executionCount WebMVC-Tests WebMVC-Tests ValidatingModel WebMVC Core.Object false none WebMVC-Servlets WebMVC-Servlets TagTestModel WebMVCTests WebMVC.ValidatingModel false none username password age WebMVC-Tests WebMVC-Tests FieldSpec WebMVC Core.Object false none name validator converter acceptsList WebMVC-TypeConverters WebMVC-TypeConverters NumberConverter WebMVC Core.Object false none WebMVC-TypeConverters WebMVC-TypeConverters DoNothingCommand WebMVCTests Core.Object false none executed WebMVC-Tests WebMVC-Tests Current WebMVC.Preferences false false singleton Preferences new WebMVC-Servlets ChangeScript WebMVC.MinLengthValidator false false scripts nil WebMVC-TypeConverters RNG WebMVC.ActionTag false false random Random standard WebMVC-Tags URLEncoder WebMVC.InternalRequestState false false url encoding VisualWave.URLEncoder new WebMVC-Servlets UsingBraces Core.StringParameterSubstitution false false As yet unclassified nil WebMVC-Extensions Singleton WebMVCTests.SingletonCommand false false singleton nil WebMVC-Tests KeyMutex WebMVC.InternalStateManager false false state key Semaphore forMutualExclusion WebMVC-Servlets StateKey WebMVC.InternalStateManager false false state key 0 WebMVC-Servlets WebMVC.InputFieldDescription accessing description ^description description: anObject description := anObject type ^type type: anObject type := anObject validator ^validator validator: anObject validator := anObject WebMVC.GetPropertyTag api doStartTag | value | value := BeanFinder new findBeanWithPathString: name , '.' , property scope: 'page' for: self factoryBlock: []. pageContext response write: (value displayStringForLocale: pageContext session locale). ^#SKIP_BODY WebMVCTests.TagTest status checks checkRedirect: mimeMessage self assert: (mimeMessage fieldValueAt: 'status') = '302 '. checkSuccess: mimeMessage self assert: (mimeMessage fieldValueAt: 'status') = '200 '. WebMVCTests.TagTest running executeRequest: internalRequest forForm: formDescription ^self requestServlet: '/servlet/WebMVCController' query: InternalStateManager requestStateKeyName , '=' , internalRequest id printString , '&formID=' , formDescription formID. executeRequest: internalRequest forForm: formDescription withQuery: queryString ^self requestServlet: '/servlet/WebMVCController' query: queryString , '&' , InternalStateManager requestStateKeyName , '=' , internalRequest id printString , '&formID=' , formDescription formID. makeRequest: uriString query: queryString | request | request := WebRequest forString: uriString. request envAt: 'QUERY_STRING' put: queryString. request envAt: 'HTTP_HOST' put: 'localhost'. request decodeQueryData. session ifNotNil: [ :s | request cachedSession: s]. ^request newSession session := nil requestPage: uriString ^self requestPage: uriString query: '' requestPage: uriString query: queryString | request handler responder | request := self makeRequest: uriString query: queryString. handler := JSPHandler for: request webSite: site. responder := WWResponder new handler: handler. request answerWith: (responder answerFor: request). request responseStream commit. request responseStream position: 0. session := request cachedSession. ^request requestServlet: uriString query: queryString | request handler responder | request := self makeRequest: uriString query: queryString. handler := ServletHandler for: request webSite: site. responder := WWResponder new handler: handler. request answerWith: (responder answerFor: request). request responseStream commit. request responseStream position: 0. session := request cachedSession. ^request setUp | d | savedPreferences := Preferences current copy. Preferences current serializeStateOntoURL: true; useInternalRedirects: true. site := WebSite newMinimal: 'tests'. d := (Dictionary new) add: 'configuration' -> ((Dictionary new) add: 'directory' -> (Filename defaultDirectory construct: 'tests') asString; add: 'environment' -> 'WebMVC'; yourself); yourself. site initializeFrom: d. WebSite addSite: site. self newSession startSession self requestPage: '/index.jsp' tearDown WebSite removeSite: site. WebMVC.Preferences current: savedPreferences. self newSession WebMVCTests.TagTest comparisons compareResponse: mimeMessage toFileNamed: name self compareResponse: mimeMessage toStream: name asFilename readStream. compareResponse: mimeMessage toStream: rs1 | rs2 | rs1 lineEndLF. rs2 := mimeMessage body value readStream. rs2 lineEndLF. [| result | result := self whiteSpaceInsensitiveCompare: rs1 and: rs2. result ifFalse: [rs1 position: 0. rs2 position: 0. (Differator newOn: rs1 contents asByteString and: rs2 contents asByteString) open]. self assert: result] ensure: [rs1 close. rs2 close] condenseWhiteSpaces: rs "Condence all whitespace (isSeparator = true) characters to a single space and answer the condensed string" | ws c | ws := WriteStream on: String new. [rs atEnd] whileFalse: [c := rs next. c isSeparator ifFalse: [ws nextPut: c] ifTrue: [ws nextPut: Character space. [rs atEnd not and: [rs peek isSeparator]] whileTrue: [ rs next ]]]. ^ws contents whiteSpaceInsensitiveCompare: s1 and: s2 | t1 t2 | t1 := self condenseWhiteSpaces: s1. t2 := self condenseWhiteSpaces: s2. ^t1 match: t2 WebMVCTests.TagTest internal request building getActiveForm ^self getActiveState formNamed: (self getFormIDFromSession) getActiveState ^self requestStateManager stateAt: (self requestStateManager states keys asSortedCollection last) getFormIDFromSession ^self getActiveState forms keys asSortedCollection last getRequestStateIDFromSession ^self getActiveState id makeFormForApplication: applicationName class: applicationClass requestState: requestState | form | form := requestState newApplicationFormNamed: 'abc'. form applicationClassName: applicationClass fullName. form applicationName: applicationName. form applicationClassName: applicationClass fullName. form formModelScope: 'request'. ^form makeFormForCommand: commandClassName requestState: requestState | form | form := requestState newCommandFormNamed: 'abc'. form commandClassName: commandClassName. ^form makeFormForModel: modelName class: modelClass requestState: requestState | form | form := requestState newModelOnlyFormNamed: 'abc'. form modelClassName: modelClass fullName. form modelName: modelName. form formModelScope: 'request'. ^form makeInputFieldDescription ^InputFieldDescription new makeRequestState ^self requestStateManager stateAt: (self requestStateManager nextStateKey) requestStateManager ^session at: ServletWithModel applicationStateVariableName ifAbsentPut: [InternalStateManager new] WebMVCTests.FormTagTest running testTagInsertion | request m | (Preferences current) serializeStateOntoURL: true; useInternalRedirects: true. request := self requestPage: '/FormTagTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/FormTagTest_tagInsertion.result' WebMVC.StringConverter api stringToValue: aStringValue ^aStringValue valueToString: aStringValue ^aStringValue WebMVC.BeanFinder api findBeanWithPathString: pathString for: client ^self findBeanWithPathString: pathString for: client factoryBlock: [] findBeanWithPathString: pathString for: client factoryBlock: factoryBlock ^self findBeanWithPathString: pathString scope: 'page' for: client factoryBlock: factoryBlock findBeanWithPathString: pathString scope: scope for: client factoryBlock: factoryBlock | path first lastPathElement secondToLast result | self needsWork: 'too long, refactor.'. path := pathString tokensBasedOn: $.. first := (client scopeNamed: scope) attributeAt: path first ifAbsent: [nil]. first ifNil: [^path size = 1 ifTrue: [|value| value := factoryBlock value. (client scopeNamed: scope) attributeAt: path first put: value. value] ifFalse: []]. path removeFirst. path isEmpty ifTrue: [^first]. lastPathElement := path last. path removeLast. secondToLast := path inject: first into: [:current :pathElement | (current perform: pathElement asSymbol) ifNil: [^nil]]. secondToLast ifNil: [^nil]. (result := secondToLast perform: lastPathElement asSymbol) ifNil: [result := factoryBlock value. secondToLast perform: (lastPathElement , ':') asSymbol with: result]. ^result WebMVC.FrozenViewRequest accessing attributes ^attributes attributes: anObject attributes := anObject path ^path path: anObject path := anObject query ^query query: anObject query := anObject WebMVC.FrozenViewRequest class instance creation fromRequest: request ^(self new) path: request webRequest PATH_INFO; query: request webRequest QUERY_STRING; attributes: request allAttributes; yourself WebMVC.TagLibrary tests affectedByTagClass: aClass ^self tags anySatisfy: [:each | ((each tagclass = aClass or: [aClass subclasses includes: each tagclass]) or: [each tagclass class = aClass]) or: [aClass subclasses includes: each tagclass class]] WebMVC.TagLibrary class tag management allTagDefinitions | libraries | libraries := Dictionary new. (Pragma allNamed: #tagLibrary:name:bodyContent: withAllSubclassesOf: VisualWave.Tag class) do: [ :pragma | |tag| tag := TagDefinition new. tag perform: pragma keyword withArguments: pragma arguments. tag tagclass: pragma methodClass instanceBehavior absoluteName. tag attributes: (self collectAttributesForClass: pragma methodClass instanceBehavior). (libraries at: (pragma arguments first) ifAbsentPut: [TagLibrary new uri: (pragma arguments first); name: (pragma arguments first); yourself]) addTag: tag]. ^libraries WebMVC.TagLibrary class private-tag management collectAttributesForClass: class | attributes | attributes := OrderedCollection new. (Pragma allNamed: #required:description: from: class to: VisualWave.Tag) do: [ :pragma | | attribute | attribute := TagAttribute new. attribute name: (self inferNameFromPragma: pragma). attribute perform: pragma keyword withArguments: pragma arguments. attributes add: attribute. ]. ^attributes inferNameFromPragma: aPragma | sel | sel := aPragma selector. ^sel copyFrom: 4 to: sel size -1 WebMVCTests.ErrorSourceCommand api defaultModelClass ^nil executeWithModel: anObject controller: aController aController addError: LoginError new. ^aController findForward: 'failure' WebMVC.TagAttribute accessing description ^description required: aBoolean description: aString required := aBoolean. description := aString WebMVC.TagAttribute printing printOn: aStream super printOn: aStream. aStream nextPut: $<. aStream nextPutAll: name. aStream nextPut: $>. WebMVC.TagAttribute comparing <= other ^self name <= other name = other ^(other isKindOf: self class) and: [other name = self name] WebMVC.WebError class from url fromURLString: aString | semi type | semi := (aString indexOf: $;). type := 'WebMVC.' , (aString copyFrom: 1 to: (semi - 1)). ^type asQualifiedReference value newFromString: (aString copyFrom: semi to: aString size). WebMVCTests.SequencingTest running testReload | request m state form | self newSession. request := self requestPage: '/SequencingTest_testReload1.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SequencingTest_testReload1.result'. "submit the page" state := self getActiveState. form := self getActiveForm. request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'username=bob%20smith&password=crap&age=35'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SequencingTest_testReload2.result'. "resubmit the first page -- shouldn't execute the command" request := self executeRequest: state forForm: form withQuery: 'username=steve&password=yuk&age=999999999'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SequencingTest_testReload3.result' WebMVC.ValidationError displaying errorText ^description urlErrorText ^'ValidationError;' , self variableName WebMVC.ValidationError accessing description ^description description: anObject description := anObject fieldName ^(self variableName includes: $;) ifTrue: [self variableName copyFrom: 1 to: (self variableName indexOf: $;)] ifFalse: [self variableName] variableName ^variableName variableName: anObject variableName := anObject WebMVC.ValidationError testing isInputFieldError ^true WebMVC.ValidationError class instance creation forVariable: aVariable description: aString ^self new variableName: aVariable; description: aString; yourself WebMVC.GenericError accessing message ^message message: anObject message := anObject WebMVC.GenericError displaying errorText ^message WebMVC.GenericError testing isInputFieldError ^false WebMVC.GenericError class instance creation withMessage: aString ^self new message: aString; yourself WebMVC.ServletWithModel subclass responsibility continue: aURL self subclassResponsibility defaultModelClass self subclassResponsibility processRequest self subclassResponsibility WebMVC.ServletWithModel accessing addError: anError self errors add: anError errors ^errors ifNil: [errors := OrderedCollection new] ifNotNil: [errors] formModel ^formModel WebMVC.ServletWithModel private-model population createDefaultModel ^self defaultModelClass ifNotNil: [ :class | formModel := class new] createModelForClassNamed: aClassName ^formModel := aClassName asQualifiedReference value new findOrCreateModel formModel := self modelFromAppropriateScope. self storeModelInAppropriateScope modelClassName ^self formDescription ifNotNil: [:des | des modelClassName] modelFromAppropriateScope self modelName ifNil: [^self createDefaultModel]. ^BeanFinder new findBeanWithPathString: self modelName scope: self modelScopeString for: self factoryBlock: [self modelClassName ifNotNil: [self createModelForClassNamed: self modelClassName] ifNil: [self createDefaultModel]] modelName ^self formDescription ifNotNil: [:des | des modelName] modelScope ^self scopeNamed: self modelScopeString asLowercase modelScopeString ^self formDescription formModelScope populateModel "self formDescription ifNil: [^nil]." self findOrCreateModel. self createAdaptor. formModel ifNil: [^nil]. self validateAndAssignVariables scopeNamed: scope scope = 'request' ifTrue: [^request]. scope = 'session' ifTrue: [^self session]. scope = 'application' ifTrue: [^self webSite application]. storeModelInAppropriateScope self modelName ifNil: [^nil]. self modelScope attributeAt: self modelName put: formModel validateAndAssignVariables ^adaptor ifNotNil: [adaptor validateAndAssignFor: self formData: self parameters] WebMVC.ServletWithModel servlet doGet self currentSequencer executeIfPermitted: self. doPost ^self doGet execute self clearPageSequencer. "the next page will install it's own sequencer and this one has been satisfied" self populateModel. ^self processRequest WebMVC.ServletWithModel testing hasErrors ^errors ifNil: [false] ifNotNil: [errors notEmpty] useInternalRedirects ^Preferences current useInternalRedirects WebMVC.ServletWithModel private-adaptor createAdaptor formModel ifNil: [^adaptor := nil]. formModel isFormModel ifTrue: [adaptor := formModel] ifFalse: [adaptor := FormModelAdaptor buildFromFormDescription: self formDescription. adaptor formModel: self formModel] WebMVC.ServletWithModel command api removeModel self modelName ifNil: [^nil]. self modelScope removeAttribute: self modelName WebMVC.ServletWithModel private-internal request state formDescription ^formDescription ifNil: [formDescription := self formID ifNil: [CommandFormDescription forRequest: self request] ifNotNil: [self incomingRequestState formNamed: self formID]] formID ^self request getParameter: 'formID' incomingRequestMarker ^(self request getParameter: InternalStateManager requestStateKeyName) ifNotNil: [:marker| marker asNumber] incomingRequestState ^self incomingRequestMarker ifNil: [InternalRequestState new] ifNotNil: [self requestStateManager stateAt: self incomingRequestMarker] incomingSequencer ^self formDescription ifNotNil: [:des | des sequencer] requestStateManager self needsWork: 'move into HttpSession???'. ^session at: self class applicationStateVariableName ifAbsentPut: [InternalStateManager new] WebMVC.ServletWithModel private-sequencing clearPageSequencer self requestStateManager activeSequencer: nil currentSequencer ^self pageSequencer , self formSequencer formSequencer ^self incomingSequencer ifNil: [InertSequencer new] forwarderForLostSession "When we loose the session we need to redirect to the home page for the web site. This redirect has to be _external_ so that the session cookie gets set for the whole we site and not just that path that led us here" | f | f := Forwarder fromString: '/' , self webSite name , '/' , self webSite defaultPage. f beExternal. ^f pageSequencer ^self requestStateManager activeSequencer ifNil: [InertSequencer new] WebMVC.ServletWithModel class constants applicationStateVariableName ^'_WEBMVC_APPLICATIONSTATE' modelClassVariableName ^'_WEBMVC_MODELCLASSNAME' WebMVC.UseBeanTag executing newInstance ^fromBean ifNotNil: [self newInstanceFromValue] ifNil: [super newInstance] newInstanceFromValue fromScope ifNil: [fromScope := 'page']. ^BeanFinder new findBeanWithPathString: fromBean scope: fromScope for: self factoryBlock: [super newInstance] WebMVC.ExistsTag executing doStartTag | bean | bean := BeanFinder new findBeanWithPathString: name scope: scope for: self factoryBlock: []. ^bean ifNotNil: [self class EVAL_BODY_INCLUDE] ifNil: [self class SKIP_BODY] Core.StringParameterSubstitution initialize initialize argumentTypeMapping := IdentityDictionary new. startDelim := $<. endDelim := $> Core.StringParameterSubstitution accessing endDelim ^endDelim endDelim: anObject endDelim := anObject startDelim ^startDelim startDelim: anObject startDelim := anObject Core.StringParameterSubstitution transforming expandedText (defaultEmphasis == nil and: [argEmphases == nil]) ifTrue: [output := (String new: 40) writeStream] ifFalse: [output := TextStream on: (String new: 40)]. output emphasis: defaultEmphasis. [input atEnd] whileFalse: [self nextCharDo: [:c | c == startDelim ifTrue: [self processInputField] ifFalse: [output nextPut: c]] else: [:c | output nextPut: c]]. ^output contents processInputField | n type mapBlock | input skipSeparators. input peek isDigit ifTrue: [n := Integer readFrom: input. input skipSeparators. type := input next. mapBlock := argumentTypeMapping at: type. mapBlock value: self value: n] ifFalse: [[input peek isLetter] whileTrue: [type := input next. mapBlock := argumentTypeMapping at: type. mapBlock value: self value: 0]]. output emphasis: defaultEmphasis. input skipSeparators. (input peekFor: endDelim) ifFalse: [self error: (#errSyntax << #dialogs >> 'Syntax error')] showBooleanFor: argIndex | trueString falseString truth | trueString := self upTo: $:. input next. "get past the colon" falseString := self upTo: endDelim. truth := args at: argIndex. (truth == true or: [truth == false]) ifFalse: [self error: (#errBooleanExpected << #dialogs >> 'Boolean argument expected')]. truth ifTrue: [output nextPutAll: trueString] ifFalse: [output nextPutAll: falseString] showMultipleFor: argIndex | singleString multipleString count | singleString := self upTo: $:. input next. "get past the colon" multipleString := self upTo: endDelim. count := args at: argIndex. count respondsToArithmetic ifFalse: [self error: (#errExpectedNumericArg << #dialogs >> 'Expected a numeric argument')]. count = 1 ifTrue: [output nextPutAll: singleString] ifFalse: [output nextPutAll: multipleString] Core.StringParameterSubstitution class class initialization initialize "StringParameterSubstitution initialize" Default := self new. Default setDefaultEmphasis: nil. Default map: $p using: [:mt :index | mt printFor: index]. Default map: $s using: [:mt :index | mt nextPutStringFor: index]. Default map: $? using: [:mt :index | mt showBooleanFor: index]. Default map: $# using: [:mt :index | mt showMultipleFor: index]. Default map: $n using: [:mt :dummy | mt output cr]. Default map: $t using: [:mt :dummy | mt output tab]. UsingBraces := self new. UsingBraces setDefaultEmphasis: nil. UsingBraces map: $p using: [:mt :index | mt printFor: index]. UsingBraces map: $s using: [:mt :index | mt nextPutStringFor: index]. UsingBraces map: $? using: [:mt :index | mt showBooleanFor: index]. UsingBraces map: $# using: [:mt :index | mt showMultipleFor: index]. UsingBraces map: $n using: [:mt :dummy | mt output cr]. UsingBraces map: $t using: [:mt :dummy | mt output tab]. UsingBraces startDelim: ${. UsingBraces endDelim: $}. Core.StringParameterSubstitution class defaults usingBraces ^UsingBraces WebMVC.WebMVCController private createAction ^self formDescription ifNotNil: [:des | des actionFor: self] defaultModelClass ^self target ifNotNil: [:t | t defaultModelClass] target ^target ifNil: [target := self createAction] WebMVC.WebMVCController executing continue: aForwarder | theForwarder | theForwarder := aForwarder ifNil: [self forwarderForLostSession]. self prepareErrorsForNext. theForwarder forwardForServlet: self request: request response: response executeRequest self target ifNil: [^nil]. ^self formDescription dispatchRequestFor: self on: self target lastValidAttributes ^self requestStateManager lastValidAttributes lastValidURL ^self requestStateManager lastValidURL processRequest | maybeForwarder | self hasErrors ifTrue: [^self continue: (self findForward: 'failure')]. [maybeForwarder := self executeRequest] on: Error do: [:ex | self webSite debuggable ifTrue: [ex pass] ifFalse: [self addError: (GenericError withMessage: ex messageText). ^self continue: (self findForward: 'failure')]]. maybeForwarder isForwarder ifTrue: [self continue: maybeForwarder] ifFalse: [self continue: (self findForward: 'success')] requestSelector | buttonKey buttonDescription | self formDescription ifNotNil: [buttonKey := self formDescription buttons keys detect: [:key | self parameters keys includes: key] ifNone: []. buttonKey ifNotNil: [buttonDescription := self formDescription buttonNamed: buttonKey. buttonDescription invoke ifNotNil: [^buttonDescription invoke asSymbol]]. self formDescription invoke ifNotNil: [:inv | ^inv asSymbol]]. ^#executeWithModel:controller: WebMVC.WebMVCController field descriptions descriptionForProperty: aPropertyName "Right now property descriptions are stored in HIDDEN fields on the form" ^(self formDescription inputForProperty: aPropertyName) description ifNil: [aPropertyName] WebMVC.WebMVCController command api findForward: forwardName | relUrl | relUrl := self formDescription ifNotNil: [:fd | fd forwardNamed: forwardName]. ^relUrl ifNotNil: [relUrl := request webRequest absoluteURLString: relUrl trimQuotes. Forwarder fromString: relUrl asURI pathString] "drop the server and protocol parts" WebMVC.WebMVCController private-internal request state applicationStateURL ^Preferences current serializeStateOntoURL ifTrue: [self outgoingRequestState urlText] ifFalse: [InternalStateManager requestStateKeyName , '=' , self outgoingRequestMarker printString] outgoingRequestMarker ^self incomingRequestMarker outgoingRequestState ^self incomingRequestState prepareErrorsForNext self useInternalRedirects ifTrue: [self request attributeAt: 'errors' put: errors] ifFalse: [self outgoingRequestState errors: errors] WebMVC.ElementTag initialize-release release super release. tabIndex := nil. accessKey := nil WebMVC.ElementTag api spacedWriteOn: aStream with: aString ^aString ifNil: [aStream] ifNotNil: [aStream notEmpty ifTrue: [aStream space]. aStream nextPutAll: aString] tagParameters | ws | ws := WriteStream on: String new. self tagParametersOn: ws. ^ws contents tagParametersOn: aStream tabIndex ifNotNil: [self spacedWriteOn: aStream with: 'tabindex=' , tabIndex]. accessKey ifNotNil: [self spacedWriteOn: aStream with: 'accessKey="' , accessKey , '"']. ^aStream WebMVC.MenuTag api doAfterBody pageContext out nextPutAll: self bodyContent string. ^self class SKIP_BODY doEndTag pageContext out nextPutAll: '</ul></div>'. ^#EVAL_PAGE doStartTag pageContext out nextPutAll: '<div id="Menu"><ul>'. ^self class EVAL_BODY_INCLUDE WebMVC.ScriptableTag initialize-release release super release. onload := nil. onunload := nil. onclick := nil. ondblclick := nil. onmousedown := nil. onmouseup := nil. onmouseover := nil. onmousemove := nil. onmouseout := nil. onfocus := nil. onblur := nil. onkeypress := nil. onkeydown := nil. onkeyup := nil. onsubmit := nil. onreset := nil. onselect := nil. onchange := nil. WebMVC.ScriptableTag javascript formTag "If this tag is in a form, return the form" ^(self parent isKindOf: FormTag) ifTrue: [self parent] ifFalse: [nil] WebMVC.ScriptableTag api tagParametersOn: aStream super tagParametersOn: aStream. onload ifNotNil: [self spacedWriteOn: aStream with: 'onload="' , onload , '"']. onunload ifNotNil: [self spacedWriteOn: aStream with: 'onunload="' , onunload , '"']. onclick ifNotNil: [self spacedWriteOn: aStream with: 'onclick="' , onclick , '"']. ondblclick ifNotNil: [self spacedWriteOn: aStream with: 'ondblclick="' , ondblclick , '"']. onmousedown ifNotNil: [self spacedWriteOn: aStream with: 'onmousedown="' , onmousedown , '"']. onmouseup ifNotNil: [self spacedWriteOn: aStream with: 'onmouseup="' , onmouseup , '"']. onmouseover ifNotNil: [self spacedWriteOn: aStream with: 'onmouseover="' , onmouseover , '"']. onmousemove ifNotNil: [self spacedWriteOn: aStream with: 'onmousemove="' , onmousemove , '"']. onmouseout ifNotNil: [self spacedWriteOn: aStream with: 'onmouseout="' , onmouseout , '"']. onfocus ifNotNil: [self spacedWriteOn: aStream with: 'onfocus="' , onfocus , '"']. onblur ifNotNil: [self spacedWriteOn: aStream with: 'onblur="' , onblur , '"']. onkeypress ifNotNil: [self spacedWriteOn: aStream with: 'onkeypress="' , onkeypress , '"']. onkeydown ifNotNil: [self spacedWriteOn: aStream with: 'onkeydown="' , onkeydown , '"']. onkeyup ifNotNil: [self spacedWriteOn: aStream with: 'onkeyup="' , onkeyup , '"']. onsubmit ifNotNil: [self spacedWriteOn: aStream with: 'onsubmit="' , onsubmit , '"']. onreset ifNotNil: [self spacedWriteOn: aStream with: 'onreset="' , onreset , '"']. onselect ifNotNil: [self spacedWriteOn: aStream with: 'onselect="' , onselect , '"']. onchange ifNotNil: [self spacedWriteOn: aStream with: 'onchange="' , onchange , '"']. ^aStream WebMVC.ScriptableTag class constants scriptsVariableName ^'__MVCWEB_SCRIPTS' WebMVC.MenuItemTag api doStartTag pageContext out nextPutAll: '<li><a href="' , self uri asString , '">' , self text asString , '</a></li>\' withCRs. ^self class SKIP_BODY WebMVC.MenuItemTag accessing text ^text uri ^uri WebMVC.MenuItemTag initialize-release release super release. text := nil. uri := nil WebMVCTests.TagTestModelWithoutSpecs accessing age ^age age: anObject age := anObject password ^password password: anObject password := anObject username ^username username: anObject username := anObject WebMVC.ButtonDescription accessing invoke ^invoke invoke: anObject invoke := anObject WebMVCTests.BaseTagTest running testTagInsertion | request m | request := self requestPage: '/BaseTagTest.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/BaseTagTest.result' testTagInsertionOnRedirect | request m internalRequest formDescription | self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.DoNothingCommand' requestState: internalRequest. formDescription forwardNamed: 'success' put: 'BaseTagTest.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/BaseTagTest.result' WebMVC.BaseTag api doStartTag pageContext response write: '<base href="' , (pageContext linkNamed: pageContext request webRequest unconsumedPath last) , '">'. ^self class SKIP_BODY WebMVC.SubmitTag api doStartTag pageContext out nextPutAll: '<input type="SUBMIT" value="' , value , (self name ifNotNil: ['" name="' , self name] ifNil: ['']) , '">\' withCRs. self installTarget. ^self class SKIP_BODY WebMVC.SubmitTag initialize-release release super release. value := nil WebMVC.SubmitTag private installTarget (self currentActionTag formDescription buttonNamed: self name) invoke: invoke WebMVC.SubmitTag accessing name ^name ifNil: [name := invoke ifNil: ['submit']] WebMVC.SubmitTag class variables invocationDescriptionFor: aName ^'_WEBMVC_INVOKE_', aName WebMVC.ResetTag api doStartTag pageContext out nextPutAll: '<input type="RESET" value="', value , '">\' withCRs. ^self class SKIP_BODY WebMVC.StyledTag api fullStyleString | ws | ws := WriteStream on: String new. styleClass ifNotNil: [ws nextPutAll: 'class="'; nextPutAll: styleClass; nextPut: $"]. styleID ifNotNil: [ws nextPutAll: 'id="'; nextPutAll: styleID; nextPut: $"]. style ifNotNil: [ws nextPutAll: 'style="'; nextPutAll: style; nextPut: $"]. ^ws contents tagParametersOn: ws super tagParametersOn: ws. styleClass ifNotNil: [self spacedWriteOn: ws with: 'class="' , styleClass , '"']. styleID ifNotNil: [self spacedWriteOn: ws with: 'id="' , styleID , '"']. style ifNotNil: [self spacedWriteOn: ws with: 'style="' ,style , '"']. ^ws WebMVC.StyledTag initialize-release release super release. style := nil. styleID := nil. styleClass := nil WebMVC.ActionTag form accessing currentActionTag ^self WebMVC.ActionTag accessing formID ^formID ifNil: [formID := self generateFormID] invoke ^invoke modelName ^modelName modelScope ^modelScope targetClass ^targetClass WebMVC.ActionTag initialize-release release super release. modelName := nil. modelScope := nil. targetClass := nil. invoke := nil WebMVC.ActionTag private-internal request state formDescription ^self outgoingRequestState formNamed: self formID ifAbsentPut: [self makeNewForm] generateFormID ^(modelName ifNotNil: [modelName] ifNil: ['']) , self hash printString makeNewForm ^(targetName isNil or: [targetName isEmpty]) ifTrue: [(targetClass isNil or: [targetClass isEmpty]) ifTrue: [self outgoingRequestState newModelOnlyFormNamed: self formID] ifFalse: [self outgoingRequestState newCommandFormNamed: self formID]] ifFalse: [self outgoingRequestState newApplicationFormNamed: self formID] resolveClassName: aClassName ^pageContext webSite environment at: aClassName ifAbsent: [aClassName asQualifiedReference valueOrDo: [self error: aClassName , ' not found.']] sequencerClass ^(sequencer notNil and: [sequencer notEmpty]) ifTrue: [self resolveClassName: sequencer] ifFalse: [] sequencerInstance ^self sequencerClass ifNotNil: [:class | class newForTag: self] storeInternalState self formDescription stateFromActionTag: self WebMVC.ActionTag class random nextRandom ^RNG next WebMVC.PropertyAdaptor initialize-release converterFromDescription: aTypeString "For now the validation string is just the class name for the validator" aTypeString ifNil: [^StringConverter new]. ^self resolveClassName: aTypeString, 'Converter'. fieldSpecFromInputTag: anInputTag fieldSpec := FieldSpec new. fieldSpec validator: (self validatorFromDescription: anInputTag validator). fieldSpec converter: (self converterFromDescription: anInputTag type). fieldSpec name: self propertyName. fieldSpec acceptsList: false. "for now" ^fieldSpec initializeForProperty: property fromDescription: anInputFieldDescription propertyName := property. fieldSpec := FieldSpec new. fieldSpec name: property. fieldSpec validator: (self validatorFromDescription: anInputFieldDescription validator). fieldSpec converter: (self converterFromDescription: anInputFieldDescription type). getMethod := propertyName asSymbol. setMethod := (propertyName , ':') asSymbol. ^self initializeForProperty: property fromFormData: formData propertyName := property. fieldSpec := FieldSpec new. fieldSpec name: property. fieldSpec validator: (self validatorFromDescription: (formData at: (InputTag validatorVariableNameFor: property)) first). fieldSpec converter: (self converterFromDescription: (formData at: (InputTag typeVariableNameFor: property)) first). getMethod := propertyName asSymbol. setMethod := (propertyName , ':') asSymbol. ^self initializeForProperty: property fromFormModel: aModel aModel isFormModel ifFalse: [self error: 'Your model isn''t a form model (doesn''t answer true to isFormModel) so I can''t ask it for a field spec.']. propertyName := property. fieldSpec := aModel fieldSpecFor: property. getMethod := propertyName asSymbol. setMethod := (propertyName , ':') asSymbol. ^self initializeFromInputTag: anInputTag propertyName := anInputTag property. getMethod := propertyName asSymbol. setMethod := (propertyName , ':') asSymbol. self fieldSpecFromInputTag: anInputTag. ^self resolveClassName: className ^(className asQualifiedReference valueOrDo: [('WebMVC.' , className) asQualifiedReference valueOrDo: [self error: className , ' not found.']]) new validatorFromDescription: validationString "For now the validation string is just the class name for the validator" validationString ifNil: [^nil]. ^self resolveClassName: validationString WebMVC.PropertyAdaptor accessing fieldSpec ^fieldSpec getMethod ^getMethod getMethod: anObject getMethod := anObject model ^model model: anObject model := anObject propertyName ^propertyName propertyName: anObject propertyName := anObject setMethod ^setMethod setMethod: anObject setMethod := anObject setValue: aValue ^model perform: setMethod with: (fieldSpec stringToValue: aValue) value ^fieldSpec valueToString: (model perform: getMethod) WebMVC.PropertyAdaptor validation api validate: value for: aController ^fieldSpec ifNotNil: [fieldSpec validateVariable: self propertyName withValue: value for: aController] validateAndAssignFor: aController formData: formData | result value | result := true. value := formData at: self propertyName ifAbsent: ['']. (self validate: value for: aController) ifNotNil: [:error | aController addError: error. result := false] ifNil: [self value: value]. ^result WebMVC.PropertyAdaptor class instance creation forProperty: property fromDescription: anInputFieldDescription | instance | instance := self new. instance initializeForProperty: property fromDescription: anInputFieldDescription. ^instance forProperty: property fromFormData: formData | instance | instance := self new. instance initializeForProperty: property fromFormData: formData. ^instance forProperty: property fromFormModel: aModel | instance | instance := self new. instance initializeForProperty: property fromFormModel: aModel. ^instance fromInputTag: anInputTag | instance | instance := self new. instance initializeFromInputTag: anInputTag. ^instance WebMVC.TLDBuilder aspects activeTags "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^activeTags isNil ifTrue: [activeTags := SelectionInList new] ifFalse: [activeTags] tagLibrary "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^tagLibrary isNil ifTrue: [tagLibrary := nil asValue] ifFalse: [tagLibrary] tagLibraryChoices "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^tagLibraryChoices isNil ifTrue: [tagLibraryChoices := List new asValue] ifFalse: [tagLibraryChoices] WebMVC.TLDBuilder interface opening postOpenWith: aBuilder super postOpenWith: aBuilder. self updateChoices. self tagLibrary expressInterestIn: #value for: self sendBack: #libraryChanged. (self builder componentAt: #List1) widget displayStringSelector: #name WebMVC.TLDBuilder conversion stringToTagLibrary: aString ^self tagLibraryChoices value detect: [:each | each uri = aString] ifNone: [nil] tagLibraryToString: aTagLibrary ^aTagLibrary uri WebMVC.TLDBuilder private-file generation fileFooterString ^'</taglib> ' fileHeaderString ^'<?xml version="1.0" ?> <!-- <!DOCTYPE taglib PUBLIC "-//Sun Microsystems, Inc.//DTD JSP Tag Library 1.1//EN" "http://java.sun.com/j2ee/dtds/web-jsptaglibrary_1_1.dtd"> --> <taglib> <tlibversion>1.0</tlibversion> <shortname>HTML</shortname> ' generateFile: aFilename forTagLibrary: library | ws | ws := aFilename writeStream. [ws nextPutAll: self fileHeaderString. library tags do: [:tag | ws nextPutAll: ' <tag>'; cr. ws nextPutAll: ' <name>' , tag name , '</name>' ; cr. ws nextPutAll: ' <tagclass>' , tag tagclass fullName , '</tagclass>' ; cr. ws nextPutAll: ' <body-content>' , tag bodyContent , '</body-content>'; cr. self writeAttributes: tag attributes to: ws. ws nextPutAll: ' </tag>'; cr]. ws nextPutAll: self fileFooterString.] ensure: [ws close] writeAttributes: attributes to: ws attributes do: [:attribute | ws nextPutAll: ' <attribute>'; cr. ws nextPutAll: ' <name>' , attribute name , '</name>'; cr. ws nextPutAll: ' <required>' , attribute required printString , '</required>'; cr. "ws nextPutAll: ' <description>' , attribute description , '</description>'; cr." ws nextPutAll: ' </attribute>'; cr] WebMVC.TLDBuilder changing libraryChanged activeTags list: (self tagLibrary value tags) WebMVC.TLDBuilder actions createFile | filename | filename := self tagLibrary value uri. (filename isNil or: [filename isEmpty]) ifTrue: [ Dialog warn: 'You must enter a file name first.'. ^nil]. filename asFilename exists ifTrue: [ (Dialog confirm: 'File already exists. Overwrite?') ifFalse: [^nil]. filename asFilename delete]. self generateFile: filename asFilename forTagLibrary: self tagLibrary value. self resetServer. inspectTag self activeTags selection isNil ifTrue: [Dialog warn: 'select the tag first.']. self activeTags selection inspect resetServer VisualWave.WebConfigurationManager clearAndReconfigure. updateChoices | selectedIndex | selectedIndex := self tagLibraryChoices value indexOf: self tagLibrary value. self tagLibraryChoices value: (TagLibrary allTagDefinitions values asList). selectedIndex > 0 ifTrue: [self tagLibrary value: (self tagLibraryChoices value at: selectedIndex)] WebMVC.FormTag api activateFormModel | model | modelName ifNil: [self error: 'need model name']. model := self formModelScope attributeAt: modelName ifAbsent: []. model ifNil: [model := self newModel. self formModelScope attributeAt: modelName put: model]. "make model available as a bean" pageContext handler attributeAt: self class formModelVariableName put: model doEndTag pageContext out nextPutAll: '</form>'. pageContext handler attributeAt: self class formModelVariableName put: nil. self writeFocusScript. self installValidationScript. ^#EVAL_PAGE doStartTag self activateFormModel. pageContext out nextPutAll: '<form method="POST" action="' , self makeAction , '" id="' , self formID , '" onsubmit="return ' , self validateFormFunctionName , '(this)">'. self storeInternalState. self writeApplicationState. self writeFormID. ^self class EVAL_BODY_INCLUDE formModelScope ^self scopeNamed: self modelScope installValidationScript validationScript ifNotNil: [ validationScript scriptText: validationScript scriptText , ' if (theErrors.length > 0) { var msg = ''''; for(i=0; i < theErrors.length; i++) { msg += theErrors[i] + ''\n''; } alert(msg); return false; } return true; }'. self addScript: validationScript] makeAction action ifNotNil: [^action]. ^pageContext linkNamed: 'servlet/WebMVCController' newModel ^modelClassName asQualifiedReference value new writeApplicationState pageContext out nextPutAll: '<input type="HIDDEN" name="' , InternalStateManager requestStateKeyName , '" value="' , self outgoingRequestMarker printString , '">'. writeFocusScript firstFocus ifNotNil: [pageContext out nextPutAll: '<script language="Javascript"> <!-- document.' , self formID , '.' , firstFocus , '.focus(); // --> </script>'] writeFormID pageContext out nextPutAll: '<input type="HIDDEN" name="formID"' , '" value="' , self formID , '">\' withCRs WebMVC.FormTag initialize-release release super release. modelClassName := nil. action := nil. firstFocus := nil WebMVC.FormTag javascript addJSCodeToValidation: aString self validationScript scriptText: (self validationScript scriptText , aString copyWith: Character cr). validateFormFunctionName ^'validate_form_' , modelName validationScript ^validationScript ifNil: [validationScript := JavascriptScript new name: 'validation for ' , modelName. validationScript scriptText: 'function ' , self validateFormFunctionName , '(theForm) {\' withCRs , 'var theErrors = new Array(0);\' withCRs. validationScript] WebMVC.FormTag accessing modelScope ^modelScope ifNil: [modelScope := 'request'] WebMVC.FormTag private-internal request state storeInternalState super storeInternalState. self formDescription modelClassName: modelClassName WebMVC.FormTag testing isActionLink ^false WebMVC.FormTag class constants formModelVariableName ^'_WEBMVC_FORMMODEL' formNameVariableName ^'_WEBMVC_FORMNAME' formScopeVariableName ^'_WEBMVC_FORMSCOPE' WebMVCTests.ActionExecutionTest running testApplicationExecution | internalRequest formDescription request m | self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForApplication: 'nothing' class: WebMVCTests.DoNothingCommand requestState: internalRequest. formDescription forwardNamed: 'success' put: 'BaseTagTest.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self assert: ((session attributeAt: 'nothing') isKindOf: WebMVCTests.DoNothingCommand). self assert: (session attributeAt: 'nothing') executed. testCommandExecution | internalRequest formDescription request m | self startSession. SingletonCommand clearDefaultInstance. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.SingletonCommand' requestState: internalRequest. formDescription forwardNamed: 'success' put: 'BaseTagTest.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self assert: SingletonCommand new executed testModelExecution | internalRequest formDescription request m | self startSession. SingletonCommand clearDefaultInstance. internalRequest := self makeRequestState. formDescription := self makeFormForModel: 'nothing' class: WebMVCTests.SingletonCommand requestState: internalRequest. formDescription forwardNamed: 'success' put: 'BaseTagTest.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self assert: SingletonCommand new executed testSingleExecution | internalRequest formDescription request m | self startSession. SingletonCommand clearDefaultInstance. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.SingletonCommand' requestState: internalRequest. formDescription forwardNamed: 'success' put: 'BaseTagTest.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self assert: SingletonCommand new executionCount = 1 WebMVC.FormDescription accessing formID ^formID formID: anObject formID := anObject formModelScope ^formModelScope formModelScope: anObject formModelScope := anObject invoke ^invoke invoke: anObject invoke := anObject modelClassName ^modelClassName modelClassName: anObject modelClassName := anObject modelName ^modelName modelName: anObject modelName := anObject sequencer ^sequencer sequencer: anObject sequencer := anObject WebMVC.FormDescription buttons buttonNamed: aName ^self buttons at: aName ifAbsentPut: [ButtonDescription new] buttons ^buttons ifNil: [buttons := Dictionary new] WebMVC.FormDescription input fields inputFields ^inputFields ifNil: [inputFields := Dictionary new] inputForProperty: aString ^self inputFields at: aString ifAbsentPut: [InputFieldDescription new] WebMVC.FormDescription forwards forwardNamed: aName ^self forwards at: aName ifAbsent: [] forwardNamed: aName put: aValue ^self forwards at: aName put: aValue forwards ^forwards ifNil: [forwards := Dictionary new] WebMVC.FormDescription api actionFor: controller ^controller formModel dispatchRequestFor: aController on: target | selector | selector := aController requestSelector. selector numArgs = 0 ifTrue: [^target perform: selector]. selector numArgs = 1 ifTrue: [^target perform: selector with: aController]. selector numArgs = 2 ifTrue: [^target perform: selector with: aController formModel with: aController]. self error: 'selector must take zero, one arguments' stateFromActionTag: aTag self modelName: aTag modelName; formModelScope: aTag modelScope; invoke: aTag invoke; sequencer: aTag sequencerInstance WebMVC.ApplicationFormDescription api actionFor: controller ^BeanFinder new findBeanWithPathString: applicationName scope: 'session' for: controller factoryBlock: [applicationClassName asQualifiedReference value new] dispatchRequestFor: aController on: target | selector | selector := aController requestSelector. selector := aController requestSelector. selector numArgs = 0 ifTrue: [^target perform: selector]. selector numArgs = 1 ifTrue: [^target perform: selector with: aController formModel]. selector numArgs = 2 ifTrue: [^target perform: selector with: aController formModel with: aController]. self error: 'selector must take zero, one or two arguments' stateFromActionTag: aTag super stateFromActionTag: aTag. self applicationClassName: aTag targetClass WebMVC.ApplicationFormDescription accessing applicationClassName ^applicationClassName applicationClassName: anObject applicationClassName := anObject applicationName ^applicationName applicationName: anObject applicationName := anObject WebMVC.CommandFormDescription accessing commandClassName ^commandClassName commandClassName: anObject commandClassName := anObject WebMVC.CommandFormDescription api actionFor: controller ^self commandClassName asQualifiedReference value new dispatchRequestFor: aController on: target | selector | selector := aController requestSelector. selector := aController requestSelector. selector numArgs = 0 ifTrue: [^target perform: selector]. selector numArgs = 1 ifTrue: [^target perform: selector with: aController formModel]. selector numArgs = 2 ifTrue: [^target perform: selector with: aController formModel with: aController]. self error: 'selector must take zero, one or two arguments' stateFromActionTag: aTag super stateFromActionTag: aTag. self commandClassName: aTag targetClass WebMVC.CommandFormDescription class instance creation forRequest: aRequest | instance | aRequest webRequest unconsumedPath isEmpty ifTrue: [^nil]. instance := self new. instance commandClassName: aRequest webRequest unconsumedPath first. aRequest webRequest unconsumedPath size > 1 ifTrue: [instance invoke: (aRequest webRequest unconsumedPath at: 2)]. ^instance WebMVC.HtmlTag api doAfterBody | body | body := self bodyContent string. self writeAllScripts. pageContext out nextPutAll: body. ^self class SKIP_BODY doEndTag pageContext response write: '</html>'. ^#EVAL_PAGE doStartTag self checkPageSequence ifTrue: [self installIncomingRequestState. self installPageSequencer. self markAsLastValidView. pageContext response write: '<html>'. ^self class EVAL_BODY_INCLUDE] ifFalse: [self halt] WebMVC.HtmlTag javascript addScript: aJavascriptScript self scripts add: aJavascriptScript scripts "All scriptable tags on a page share the list of active scripts" ^pageContext handler attributeAt: ScriptableTag scriptsVariableName ifAbsent: [| os | os := OrderedSet new. pageContext handler attributeAt: ScriptableTag scriptsVariableName put: os. os] writeAllScripts self scripts do: [ :script | self writeScript: script]. writeScript: aJavascriptScript pageContext out nextPutAll: aJavascriptScript fullScriptText WebMVC.HtmlTag private-internal request state checkPageSequence ^self requestStateManager activeSequencer ifNotNil: [:seq | seq shouldShowPageWithTag: self] ifNil: [true] incomingRequestMarker | appStateNumber | appStateNumber := self request anyQueryValueAt: InternalStateManager requestStateKeyName. ^appStateNumber ifNil: [nil] ifNotNil: [appStateNumber asNumber] incomingRequestState | appStateNumber | appStateNumber := self incomingRequestMarker. ^self requestStateManager stateAt: appStateNumber ifAbsent: [nil] installIncomingRequestState Preferences current useInternalRedirects ifTrue: [^nil]. Preferences current serializeStateOntoURL ifTrue: [| oc | self needsWork: 'is this really supported in general anymore?'. oc := OrderedCollection new. (pageContext request allQueryValuesAt: 'errors') do: [:errorString | oc add: (WebError fromURLString: errorString)]. pageContext request attributeAt: 'errors' put: oc] ifFalse: [self incomingRequestState ifNotNil: [:state | state installInContext: pageContext]] installPageSequencer sequencer ifNil: [self requestStateManager activeSequencer: nil] ifNotNil: [self requestStateManager activeSequencer: (self sequencerClass newForTag: self)] markAsLastValidView (self requestStateManager) lastValidRequest: (FrozenViewRequest fromRequest: self request) nextMarker ^InternalStateManager nextStateKey outgoingRequestMarker ^outgoingRequestMarker ifNil: [outgoingRequestMarker := self nextMarker] outgoingRequestState ^self requestStateManager stateAt: self outgoingRequestMarker requestStateManager self needsWork: 'move into HttpSession???'. ^pageContext session at: ServletWithModel applicationStateVariableName ifAbsentPut: [InternalStateManager new] resolveClassName: aClassName ^pageContext webSite environment at: aClassName ifAbsent: [aClassName asQualifiedReference valueOrDo: [self error: aClassName , ' not found.']] sequencerClass ^(sequencer notNil and: [sequencer notEmpty]) ifTrue: [self resolveClassName: sequencer] ifFalse: [] WebMVC.Forwarder accessing beExternal external := true external ^external ifNil: [external := false] urlString ^urlString urlString: anObject urlString := anObject WebMVC.Forwarder api externalForwardForServlet: servlet request: request response: response response redirectTo: (self urlWithQueryForController: servlet) forwardForServlet: servlet request: request response: response self external ifFalse: [self internalForwardForServlet: servlet request: request response: response] ifTrue: [self externalForwardForServlet: servlet request: request response: response] internalForwardForServlet: servlet request: request response: response | dispatcher | dispatcher := servlet servletContext getRequestDispatcher: (self urlWithQueryForController: servlet). dispatcher forward: request response: response urlWithQueryForController: servlet | urlWithQuery | urlWithQuery := (urlString includes: $?) ifTrue: [urlString , '&'] ifFalse: [urlString , '?']. urlWithQuery := urlWithQuery , InternalStateManager requestStateKeyName , '=' , servlet outgoingRequestMarker printString. ^urlWithQuery WebMVC.Forwarder testing isForwarder ^true WebMVC.Forwarder class instance creation fromString: aString | instance | instance := self new urlString: aString; yourself. WebMVC.Preferences current useInternalRedirects ifFalse: [instance beExternal]. ^instance WebMVC.IntegerConverter api stringToValue: aString ^aString asNumber asInteger valueToString: aNumber ^aNumber ifNil: [''] ifNotNil: [aNumber printString] WebMVC.LabelTag api doEndTag pageContext out nextPutAll: '</label>'. ^#EVAL_PAGE doStartTag pageContext out nextPutAll: '<label ' , self tagParameters , '>'. ^self class EVAL_BODY_INCLUDE tagParametersOn: aStream | errors myError | super tagParametersOn: aStream. errors := pageContext request attributeAt: 'errors' ifAbsent: []. errors ifNil: [myError := nil] ifNotNil: [myError := errors detect: [:error | error isInputFieldError and: [error fieldName = for]] ifNone: [nil]]. (myError notNil and: [errorClass notNil]) ifTrue: [self spacedWriteOn: aStream with: 'class="' , errorClass , '"']. self spacedWriteOn: aStream with: 'for="_' , for , '"'. ^aStream WebMVC.LabelTag initialize-release initialize super initialize. ^self release super release. for := nil. errorClass := nil WebMVC.NotExistsTag executing doStartTag ^super doStartTag = self class SKIP_BODY ifTrue: [self class EVAL_BODY_INCLUDE] ifFalse: [self class SKIP_BODY] WebMVC.ActionDataTag initialize-release release super release. name := nil. value := nil WebMVC.ActionDataTag api doAfterBody | body | body := self bodyContent string. (body notNil and: [body trimBlanks notEmpty]) ifTrue: [self setValue: body trimBlanks]. self currentActionTag addArgument: self. ^self class SKIP_BODY doStartTag ^self class EVAL_BODY_INCLUDE urlText ^name , '=' , (VisualWave.URLEncoder new encode: value) WebMVC.ActionDataTag accessing name ^name WebMVC.Preferences initialize-release initialize useInternalRedirects := true. serializeStateOntoURL := true. ^self WebMVC.Preferences accessing serializeStateOntoURL ^serializeStateOntoURL serializeStateOntoURL: anObject serializeStateOntoURL := anObject useInternalRedirects ^useInternalRedirects useInternalRedirects: anObject useInternalRedirects := anObject WebMVC.Preferences class private new ^super new initialize WebMVC.Preferences class singleton current ^Current current: aPreferences Current := aPreferences WebMVC.ForwardLinkTag api doAfterBody | body | body := self bodyContent string. (body notNil and: [body trimBlanks notEmpty]) ifTrue: [self setHref: body trimBlanks]. self install. ^self class SKIP_BODY doStartTag ^self class EVAL_BODY_INCLUDE install self currentActionTag formDescription forwardNamed: name put: href WebMVC.ForwardLinkTag initialize-release release super release. name := nil. href := nil WebMVC.ForwardLinkTag class hidden variable variableNameForForward: aString ^'_WEBMVC_FORWARD_' , aString asUppercase WebMVC.FieldValidator api , validator ^CompositeValidator new , self , validator installScriptsInTag: aScriptableTag "Do nothing by default since not all validators support Javascript" validateVariable: aVariable withValue: aStringValue for: aController "Answer nil if validation is successful, otherwise answer and error object." self subclassResponsibility WebMVC.MaxLengthValidator accessing maxLength ^maxLength maxLength: anObject maxLength := anObject WebMVC.MaxLengthValidator api validateVariable: aVariable withValue: aStringValue for: aController ^(aStringValue isNil or: [aStringValue size <= maxLength]) ifFalse: [ValidationError forVariable: aVariable description: 'Please enter a string shorter than ' , maxLength printString , ' characters for the ' , (aController descriptionForProperty: aVariable) , ' input field.'] ifTrue: [nil] WebMVC.MaxLengthValidator class instance creation maxLength: aValue ^self new maxLength: aValue; yourself WebMVC.CompositeValidator api , validator self validators add: validator. ^self validate: aStringValue self validators do: [ :each | (each validate: aStringValue) ifNotNil: [:error | ^error]]. ^nil WebMVC.CompositeValidator accessing validators ^validators ifNil: [validators := OrderedCollection new] ifNotNil: [validators] WebMVC.MinLengthValidator accessing minLength ^minLength minLength: anObject minLength := anObject WebMVC.MinLengthValidator api errorMessageFor: aString ^'Please enter a string longer than ' , minLength printString , ' characters for the ' , aString , ' input field.' installChangeValidatorInTag: anInputTag anInputTag setOnchange: 'if (!checkMinStringLength(this.value,' , minLength printString , ', ''' , anInputTag property , ''')) { alert(''' , (self errorMessageFor: anInputTag description) , '''); return false; } else { return true; }' installFormValidatorInTag: anInputTag anInputTag formTag ifNotNil: [:form | form addJSCodeToValidation: 'if (!checkMinStringLength(theForm.' , anInputTag property , '.value,' , minLength printString , ', ''' , anInputTag property , ''')) { theErrors.push(''' , (self errorMessageFor: anInputTag description) , ''');}'] installScriptsInTag: anInputTag anInputTag addScript: self class changeScript. self installChangeValidatorInTag: anInputTag. self installFormValidatorInTag: anInputTag validateVariable: aVariable withValue: aStringValue for: aController ^(aStringValue notNil and: [aStringValue size >= minLength]) ifFalse: [ValidationError forVariable: aVariable description: (self errorMessageFor: (aController descriptionForProperty: aVariable))] ifTrue: [nil] WebMVC.MinLengthValidator class instance creation minLength: aValue ^self new minLength: aValue; yourself WebMVC.MinLengthValidator class scripts changeScript ^ChangeScript ifNil: [ChangeScript := self makeChangeScript] ifNotNil: [ChangeScript] clearChangeScript "self clearChangeScript" ChangeScript := nil makeChangeScript | script | script := JavascriptScript new name: 'MinLengthCheck'; yourself. script scriptText: 'function checkMinStringLength(theString, minLength, name){ if(theString == null || theString.length < minLength) { return false; } return true; }'. ^script WebMVC.RequiredFieldValidator api errorMessageFor: description ^'A value is required for the field labeled ' , description , '.' installChangeValidatorInTag: anInputTag anInputTag setOnchange: 'if (!checkMinStringLength(this.value,1,''' , anInputTag property , ''')) { alert(''' , (self errorMessageFor: anInputTag description) , '''); return false; } else { return true; }' installFormValidatorInTag: anInputTag anInputTag formTag ifNotNil: [:form | form addJSCodeToValidation: 'if (!checkMinStringLength(theForm.' , anInputTag property , '.value,1, ''' , anInputTag property , ''')) { theErrors.push(''' , (self errorMessageFor: anInputTag description) , ''');}'] installScriptsInTag: anInputTag anInputTag addScript: MinLengthValidator changeScript. self installChangeValidatorInTag: anInputTag. self installFormValidatorInTag: anInputTag validateVariable: aVariable withValue: aStringValue for: aController ^(aStringValue notNil and: [aStringValue notEmpty]) ifFalse: [ValidationError forVariable: aVariable description: (self errorMessageFor: (aController descriptionForProperty: aVariable))] ifTrue: [nil] WebMVC.EMailAddressFormatValidator api errorMessageFor: anInputTag ^'A valid email address is required in the field labeled ' , anInputTag , '.' validateVariable: aVariable withValue: aStringValue for: aController ^(aStringValue includes: $@) ifTrue: [] ifFalse: [ValidationError forVariable: aVariable description: (self errorMessageFor: (aController descriptionForProperty: aVariable))] WebMVCTests.ErrorsTagTest running testTagInsertionWithErrors "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m internalRequest formDescription | self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.ErrorSourceCommand' requestState: internalRequest. formDescription forwardNamed: 'failure' put: 'ErrorsTagTest_tagInsertion.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/ErrorsTagTest_tagInsertionWithErrors.result' WebMVC.InternalRequestState accessing errors ^errors ifNil: [ errors := OrderedCollection new] ifNotNil: [errors] errors: anObject errors := anObject formNamed: formName ^forms at: formName formNamed: formName ifAbsent: aBlock ^forms at: formName ifAbsent: aBlock formNamed: formName ifAbsentPut: aBlock ^forms at: formName ifAbsentPut: aBlock forms ^forms id ^id id: anObject id := anObject newApplicationFormNamed: formName | form | form := ApplicationFormDescription new formID: formName; yourself. forms at: formName put: form. ^form newCommandFormNamed: formName | form | form := CommandFormDescription new formID: formName; yourself. forms at: formName put: form. ^form newModelOnlyFormNamed: formName | form | form := FormDescription new formID: formName; yourself. forms at: formName put: form. ^form WebMVC.InternalRequestState initialize-release initialize errors := OrderedCollection new. forms := Dictionary new. ^self WebMVC.InternalRequestState context installInContext: aPageContext aPageContext request attributeAt: 'errors' put: self errors. WebMVC.InternalRequestState http urlText | ws | ws := WriteStream on: String new. self errors do: [:each | ws nextPutAll: 'errors='; nextPutAll: (self class urlEncoder encode: each urlErrorText)] separatedBy: [ws nextPut: $&]. ^ws contents WebMVC.InternalRequestState class instance creation new ^super new initialize WebMVC.InternalRequestState class url encoding urlEncoder ^URLEncoder WebMVC.ActionLinkTag initialize-release release super release. dataItems := nil. WebMVC.ActionLinkTag body tag doBeforeBody processBody bodyContent pageContext: self pageContext. [self doBeforeBody. self doAfterBody = VisualWave.BodyTag EVAL_BODY_TAG] whileTrue. WebMVC.ActionLinkTag testing isActionLink ^true WebMVC.ActionLinkTag action arguments addArgument: anActionArgTag self formDescription inputForProperty: anActionArgTag name. "create the input property" self dataItems add: anActionArgTag dataItems ^dataItems ifNil: [dataItems := OrderedCollection new] WebMVC.ActionLinkTag api doAfterBody | body | body := self bodyContent string. pageContext out nextPutAll: '<a href=' , self link , '>'. pageContext out nextPutAll: body. pageContext out nextPutAll: '</a>'. self storeInternalState. ^self class SKIP_BODY doStartTag ^self class EVAL_BODY_INCLUDE link | ws | ws := WriteStream on: String new. targetClass ifNil: [ws nextPutAll: (pageContext linkNamed: 'servlet/WebMVCController')] ifNotNil: [ws nextPutAll: (pageContext linkNamed: 'servlet/WebMVCController')]. ws nextPut: $?. self dataItems do: [:arg | ws nextPutAll: arg urlText; nextPut: $&]. ws nextPutAll: 'formID=' , self formID , '&'. ws nextPutAll: InternalStateManager requestStateKeyName , '=' , self outgoingRequestMarker printString. ^ws contents WebMVC.ActionRedirectTag api doAfterBody pageContext response redirectTo: self link WebMVC.JavascriptScript accessing name ^name name: anObject name := anObject scriptText ^scriptText scriptText: anObject scriptText := anObject WebMVC.JavascriptScript comparing = other ^(other isKindOf: self class) and: [self name = other name] WebMVC.JavascriptScript api fullScriptText ^'<SCRIPT language=javascript> <!-- ' , self scriptText , ' // --> </SCRIPT>' WebMVC.OptionTag api doEndTag pageContext out nextPutAll: '</option>'. ^#EVAL_PAGE doStartTag pageContext out nextPutAll: '<option ' , self tagParameters , '>'. pageContext out nextPutAll: value. ^self class EVAL_BODY_INCLUDE WebMVC.OptionTag private activeSelectTag ^pageContext handler attributeAt: SelectTag activeSelectTagVariableName ifAbsent: [nil] nameIs: aString ^aString = value shouldBeSelected self activeSelectTag ifNotNil: [:select | select findSelectedValue ifNotNil: [:v | ^v isString ifTrue: [v = value] ifFalse: [v includes: value]]]. ^selected notNil tagParametersOn: ws super tagParametersOn: ws. self shouldBeSelected ifTrue: [self spacedWriteOn: ws with: 'selected ']. label ifNotNil: [self spacedWriteOn: ws with: 'label="' , label , '"']. value ifNotNil: [self spacedWriteOn: ws with: 'value="' , value , '"']. ^ws WebMVC.OptionTag initialize-release release super release. label := nil. selected := nil WebMVC.IntegerValidator api errorMessageFor: description ^'A numeric value is required for the field labeled ' , description , '.' validateVariable: aVariable withValue: aStringValue for: aController self needsWork: 'This stinks. Checking for Error is too general since it would even catch MNU and makes debugging a chore. Need better number parsing class.'. ^ [(Locale current numberPolicy reader readFrom: aStringValue readStream type: Integer) asInteger. nil] on: Error do: [:ex | ex return: (ValidationError forVariable: aVariable description: (self errorMessageFor: (aController descriptionForProperty: aVariable)))] WebMVCTests.HtmlTagTest running testErrorInstallation1 "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m internalRequest formDescription | (Preferences current) serializeStateOntoURL: true; useInternalRedirects: true. self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.ErrorSourceCommand' requestState: internalRequest. formDescription forwardNamed: 'failure' put: 'HtmlTagTest_errorInstallation.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/HtmlTagTest_errorInstallation.result' testErrorInstallation2 "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m internalRequest formDescription | (Preferences current) serializeStateOntoURL: false; useInternalRedirects: true. self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.ErrorSourceCommand' requestState: internalRequest. formDescription forwardNamed: 'failure' put: 'HtmlTagTest_errorInstallation.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/HtmlTagTest_errorInstallation.result' testErrorInstallation3 "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m url path query internalRequest formDescription | (Preferences current) serializeStateOntoURL: false; useInternalRedirects: false. self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.ErrorSourceCommand' requestState: internalRequest. formDescription forwardNamed: 'failure' put: 'HtmlTagTest_errorInstallation.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkRedirect: m. url := m fieldValueAt: 'location'. self assert: (url includes: $/). self assert: (url includes: $?). "I have to get rid of the /tests since I'm passing this request right to the handler" path := url copyFrom: 7 to: (url indexOf: $?) - 1. query := url copyFrom: (url indexOf: $?) + 1 to: url size. request := self requestPage: path query: query. m := Net.RFC822Message readFrom: request responseStream. self compareResponse: m toFileNamed: 'tests/HtmlTagTest_errorInstallation.result' testTagInsertion | request m | request := self requestPage: '/HtmlTagTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/HtmlTagTest_tagInsertion.result' WebMVC.InputTag accessing description ^description ifNil: [property] formModelName self needsWork: 'what the heck is this?'. ^name ifNil: [name := FormTag formModelVariableName] property ^property propertyAdaptor ^propertyAdaptor ifNil: [self formModel ifNotNil: [propertyAdaptor := self makePropertyAdaptorForModel: self formModel]] redisplay ^redisplay ifNil: [redisplay := true] type ^type validator ^validator WebMVC.InputTag api doStartTag pageContext out nextPutAll: '<input ' , self tagParameters , '>'. description ifNotNil: [self storeDescription]. type ifNotNil: [self storeType]. validator ifNotNil: [self storeValidator]. ^self class SKIP_BODY tagParametersOn: ws self installValidatorScripts. super tagParametersOn: ws. inputTagType ifNotNil: [self spacedWriteOn: ws with: 'type="' , inputTagType , '"']. property ifNotNil: [self spacedWriteOn: ws with: 'name="' , property , '" id="_' , property , '"']. self findValue ifNotNil: [:v | self spacedWriteOn: ws with: 'value="' , v withHTMLEscapes , '"']. size ifNotNil: [self spacedWriteOn: ws with: 'size="' , size , '"']. ^ws WebMVC.InputTag initialize-release release super release. name := nil. property := nil. size := nil. redisplay := nil. inputTagType := nil. description := nil WebMVC.InputTag private findValue property isNil | self redisplay not ifTrue: [^'']. ^self propertyAdaptor ifNil: [''] ifNotNil: [self propertyAdaptor value ifNil: ['']]. "self formModel ifNil: [''] ifNotNil: [:formModel | | pa | pa := self makePropertyAdaptorForModel: formModel. pa value ifNil: ['']]" " spec := formModel fieldSpecFor: property. (formModel perform: property asSymbol) ifNotNil: [:value | spec valueToString: value] ifNil: ['']]" formModel ^pageContext handler attributeAt: self formModelName installValidatorScripts (self propertyAdaptor fieldSpec) installValidatorScriptsInTag: self makePropertyAdaptorForModel: aModel ^aModel isFormModel ifTrue: [self needsWork: 'maybe I could just return the field spec for this property??? This would be more consistent with the way adaptors are used in ServletWithModel'. (PropertyAdaptor forProperty: self property fromFormModel: aModel) model: aModel; yourself] ifFalse: [(PropertyAdaptor fromInputTag: self) model: aModel; yourself] storeDescription (self currentActionTag formDescription inputForProperty: property) description: description storeType (self currentActionTag formDescription inputForProperty: property) type: type storeValidator (self currentActionTag formDescription inputForProperty: property) validator: validator WebMVC.InputTag class variables descriptionVariableFor: aVariableName ^'_WEBMVC_' , aVariableName , '_DESCRIPTION' typeVariableNameFor: aString ^'_WEBMVC_TYPE_' , aString validatorVariableNameFor: aString ^'_WEBMVC_VALIDATOR_' , aString WebMVC.HiddenTag api doStartTag inputTagType := 'HIDDEN'. super doStartTag. ^self class SKIP_BODY WebMVCTests.InputTagTest running tagInsertionWith: aBoolean1 and: aBoolean2 "request the page with the form" | request m | self newSession. (Preferences current) serializeStateOntoURL: aBoolean1; useInternalRedirects: aBoolean2. request := self requestPage: '/InputTagTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/InputTagTest_tagInsertion.result'. "submit the page" request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'username=bob%20smith&password=crap&age=35'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/InputTagTest_tagInsertionWithData.result' testTagInsertion | request m | (Preferences current) serializeStateOntoURL: true; useInternalRedirects: true. request := self requestPage: '/InputTagTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/InputTagTest_tagInsertion.result' testTagInsertionAutoFill self tagInsertionWith: true and: true. self tagInsertionWith: false and: true. self needsWork: 'Serialization of the model for external redirects is not supported.'. " self tagInsertionWith: false and: false. self tagInsertionWith: true and: false." WebMVC.CheckBoxTag private findValue ^'yes' WebMVC.CheckBoxTag api doStartTag inputTagType := 'CHECKBOX'. super doStartTag. ^self class SKIP_BODY WebMVC.TextTag api doStartTag inputTagType := 'TEXT'. super doStartTag. ^self class SKIP_BODY WebMVC.TextAreaTag private findValue ^nil tagParametersOn: ws rows ifNotNil: [self spacedWriteOn: ws with: 'rows="' , rows , '"']. cols ifNotNil: [self spacedWriteOn: ws with: 'cols="' , cols , '"']. readonly ifNotNil: [self spacedWriteOn: ws with: 'readonly']. ^ws textAreaValue ^super findValue WebMVC.TextAreaTag api doStartTag pageContext out nextPutAll: '<textarea ' , self tagParameters , '>'. pageContext out nextPutAll: self textAreaValue. pageContext out nextPutAll: '</textarea>'. ^self class SKIP_BODY WebMVC.SelectTag api doEndTag pageContext out nextPutAll: '</select>'. pageContext handler attributeAt: self class activeSelectTagVariableName put: nil. ^#EVAL_PAGE doStartTag pageContext out nextPutAll: '<select ' , self tagParameters , '>'. pageContext handler attributeAt: self class activeSelectTagVariableName put: self. ^self class EVAL_BODY_INCLUDE WebMVC.SelectTag private allowMultiple ^multiple ifNotNil: [multiple asLowercase = 'yes'] ifNil: [false] findSelectedValue "We don't really want our value displayed in the tag parameters" ^super findValue findValue "We don't really want our value displayed in the tag parameters" ^nil tagParametersOn: aStream super tagParametersOn: aStream. self allowMultiple ifNotNil: [self spacedWriteOn: aStream with: 'multiple']. ^aStream WebMVC.SelectTag initialize-release release super release. multiple := nil WebMVC.SelectTag class constants activeSelectTagVariableName ^'__WEBMVC_ACTIVE_SELECT_TAG' WebMVC.RadioTag private findValue ^value ifNil: [''] WebMVC.RadioTag initialize-release release super release. value := nil WebMVC.RadioTag api doStartTag inputTagType := 'RADIO'. super doStartTag. ^self class SKIP_BODY tagParametersOn: aStream super tagParametersOn: aStream. checked ifNotNil: [self spacedWriteOn: aStream with: 'checked']. ^aStream WebMVC.ButtonTag api doStartTag pageContext out nextPutAll: '<button ' , self tagParameters , '>'. ^self class SKIP_BODY findValue ^value WebMVC.PasswordTag api doStartTag inputTagType := 'PASSWORD'. super doStartTag. ^self class SKIP_BODY WebMVC.IfErrorsTag api doStartTag | errors | errors := pageContext request attributeAt: 'errors' ifAbsent: []. ^(self hasErrorForSpecifiedProperty: errors) ifTrue: [self class EVAL_BODY_INCLUDE] ifFalse: [self class SKIP_BODY] hasErrorForSpecifiedProperty: errors ^property ifNil: [errors notNil and: [errors notEmpty]] ifNotNil: [errors anySatisfy: [:each | each isInputFieldError and: [each variableName = property]]] WebMVC.LoginError displaying errorText ^'Incorrect username or password.' urlErrorText ^'LoginError;' WebMVC.LoginError testing isInputFieldError ^false WebMVC.LoginError class from url newFromString: aString ^self new WebMVCTests.SessionScopeModelTest running tagInsertionWith: aBoolean1 and: aBoolean2 "request the page with the form" | request m | self newSession. (Preferences current) serializeStateOntoURL: aBoolean1; useInternalRedirects: aBoolean2. request := self requestPage: '/SessionScopeTest_page1.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SessionScopeTest_page1.result'. "submit the page" request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'username=bob%20smith&password=junk'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SessionScopeTest_page2.result'. "submit the page" request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'age=35'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/SessionScopeTest_page3.result' testTagInsertionAutoFill self tagInsertionWith: true and: true. self tagInsertionWith: false and: true. self needsWork: 'Serialization of the model for external redirects is not supported.'. " self tagInsertionWith: false and: false. self tagInsertionWith: true and: false." WebMVCTests.EmbeddedTypeTest running tagInsertionWith: aBoolean1 and: aBoolean2 "request the page with the form" | request m | self newSession. (Preferences current) serializeStateOntoURL: aBoolean1; useInternalRedirects: aBoolean2. request := self requestPage: '/EmbeddedTypeTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/EmbeddedTypeTest_tagInsertion.result'. "submit the page" request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'username=bob%20smith&password=crap&age=35'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/EmbeddedTypeTest_tagInsertionWithData.result' testTagInsertionAutoFill self tagInsertionWith: true and: true. self tagInsertionWith: false and: true. self needsWork: 'Serialization of the model for external redirects is not supported.'. " self tagInsertionWith: false and: false. self tagInsertionWith: true and: false." testValidation "request the page with the form" | request m | self newSession. (Preferences current) serializeStateOntoURL: false; useInternalRedirects: true. request := self requestPage: '/EmbeddedTypeTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/EmbeddedTypeTest_tagInsertion.result'. "submit the page" request := self executeRequest: self getActiveState forForm: self getActiveForm withQuery: 'password=somthing&age=monkey'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/EmbeddedTypeTest_validation.result' WebMVC.OptGroupTag api doEndTag pageContext out nextPutAll: '</optgroup>'. ^#EVAL_PAGE doStartTag pageContext out nextPutAll: '<optgroup ' , self tagParameters , '>'. ^self class EVAL_BODY_INCLUDE tagParametersOn: aStream super tagParametersOn: aStream. label ifNotNil: [self spacedWriteOn: aStream with: 'label="' , label , '"']. ^aStream WebMVC.OptGroupTag initialize-release release super release. label := nil WebMVC.Sequencer api executed "Sent affer a request is executed for this sequencer" executeIfPermitted: aController "I will send execute to the controller if and only if the request corresponding to controllerOrTag is in sequence, otherwise I might install an error and I will redirect to my view" (self request: aController request isPermittedFor: aController) ifTrue: [aController execute. self executed] ifFalse: [self redirectFor: aController] request: request isPermittedFor: controller self subclassResponsibility shouldShowPageWithTag: anHtmlTag ^true WebMVC.Sequencer operators , other ^SequencerList with: self with: other WebMVC.Sequencer private-redirecting installAttributes: attributes inRequest: request request attributes keys copy do: [ :key | request removeAttribute: key]. request attributes addAll: attributes associations redirectFor: controller "aControllerOrTag is out of sequence, I will redirect to the view that is the correct one for this sequence" | dispatcher | dispatcher := controller servletContext getRequestDispatcher: controller lastValidURL. self installAttributes: controller lastValidAttributes inRequest: controller request. dispatcher forward: controller request response: controller response WebMVC.Sequencer class instance creation newForTag: anHtmlTag ^self new WebMVC.NoRepeatSequencer api executed hasExecuted := true. request: request isPermittedFor: controller ^self hasExecuted not WebMVC.NoRepeatSequencer accessing hasExecuted ^hasExecuted ifNil: [hasExecuted := false] WebMVC.SequencerList api executeIfPermitted: aController self sequencers do: [:sequencer | (sequencer request: aController request isPermittedFor: aController) ifFalse: [^sequencer redirectFor: aController]]. [aController execute] ensure: [self sequencers do: [:sequencer | sequencer executed]] WebMVC.SequencerList private addSequencer: aSequencer self sequencers add: aSequencer sequencers ^sequencers ifNil: [sequencers := OrderedCollection new] WebMVC.SequencerList operators , other self addSequencer: other. ^self WebMVC.SequencerList class instance creation with: sequencer1 with: sequencer2 ^self new addSequencer: sequencer1; addSequencer: sequencer2; yourself WebMVC.InertSequencer api request: request isPermittedFor: controller ^true WebMVC.ErrorsTag api doStartTag | errors | errors := pageContext request attributeAt: 'errors' ifAbsent: []. (errors isNil or: [errors isEmpty]) ifTrue: [^self class SKIP_BODY]. pageContext response write: '<div ' , self tagParameters ,'>\' withCRs. errors size = 1 ifTrue: [pageContext response write: 'Your page contained the following error:'] ifFalse: [pageContext response write: 'Your page contained the following errors']. pageContext out nextPutAll: '<ul>'. errors do: [ :each | pageContext response write: '<li> ' , each errorText , '</li>']. pageContext out nextPutAll: '</ul>'. errors size = 1 ifTrue: [pageContext response write: 'Please fix this error and submit the form again.'] ifFalse: [pageContext response write: 'Please fix these errors and submit the form again.']. pageContext out nextPutAll: '</div>'. ^self class SKIP_BODY WebMVC.InternalStateManager accessing activeSequencer ^activeSequencer activeSequencer: anObject activeSequencer := anObject lastValidAttributes ^self lastValidRequest ifNotNil: [self lastValidRequest attributes] lastValidRequest ^lastValidRequest lastValidRequest: anObject lastValidRequest := anObject lastValidURL | url view query | self lastValidRequest ifNil: [^nil]. view := self lastValidRequest path. query := self lastValidRequest query. view ifNil: [^nil]. query ifNil: [^view]. url := view , ((view includes: $?) ifTrue: ['&'] ifFalse: ['?']). url := url , query. ^url nextStateKey ^self class nextStateKey stateAt: aKey aKey ifNil: [^nil]. ^states at: aKey ifAbsentPut: [InternalRequestState new id: aKey; yourself] stateAt: aKey ifAbsent: aBlock ^states at: aKey ifAbsent: aBlock states ^states WebMVC.InternalStateManager initialize-release initialize states := Dictionary new. ^self WebMVC.InternalStateManager class instance creation new ^super new initialize WebMVC.InternalStateManager class state key nextStateKey ^KeyMutex critical: [StateKey := StateKey + 1] requestStateKeyName ^'_WEBMVC_REQSTATE' WebMVC.RequiredPageSequencer api request: request isPermittedFor: controller ^controller incomingRequestMarker = outgoingMarker shouldShowPageWithTag: anHtmlTag ^anHtmlTag incomingRequestMarker = incomingMarker and: [anHtmlTag request webRequest PATH_INFO = pathInfo] WebMVC.RequiredPageSequencer accessing incomingMarker: anObject incomingMarker := anObject incomingRequestMarker ^incomingMarker outgoingMarker: anObject outgoingMarker := anObject outgoingRequestMarker ^outgoingMarker pathInfo ^pathInfo pathInfo: anObject pathInfo := anObject WebMVC.RequiredPageSequencer class instance creation newForTag: aTag | instance | instance := super newForTag: aTag. instance outgoingMarker: aTag outgoingRequestMarker. instance incomingMarker: aTag incomingRequestMarker. instance pathInfo: aTag request webRequest PATH_INFO. ^instance WebMVC.TagDefinition accessing attributes: anObject attributes := anObject tagLibrary: library name: nameString bodyContent: contentString name := nameString. bodyContent := contentString WebMVC.TagDefinition printing printOn: aStream super printOn: aStream. aStream nextPut: $<. aStream nextPutAll: name. aStream nextPut: $>. WebMVC.TagDefinition comparing <= other ^(other isKindOf: self class) and: [self name <= other name] = other ^(other isKindOf: self class) and: [self name = other name] WebMVC.FormModelAdaptor validation api validateAndAssignFor: aController formData: formData ^propertyAdaptors do: [:each | each validateAndAssignFor: aController formData: formData] WebMVC.FormModelAdaptor accessing formModel ^formModel formModel: anObject formModel := anObject. propertyAdaptors do: [:each | each model: formModel] WebMVC.FormModelAdaptor initialize-release initializeFromFormDescription: formDescription self makePropertyAdaptorsFromFormDescription: formDescription makePropertyAdaptorsFromFormDescription: formDescription propertyAdaptors := OrderedCollection new. formDescription inputFields keysAndValuesDo: [:key :value | propertyAdaptors add: ((PropertyAdaptor forProperty: key fromDescription: value) model: self formModel; yourself)] WebMVC.FormModelAdaptor class instance creation buildFromFormDescription: formDescription "Build an instance based on the type and validation information stored in the supplied form data" | instance | instance := self new. instance initializeFromFormDescription: formDescription. ^instance WebMVCTests.IfErrorsTagTest running testTagInsertionNoErrorState "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m | request := self requestPage: '/IfErrorsTagTest_tagInsertion.jsp'. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/IfErrorsTagTest_tagInsertionWithoutErrors.result' testTagInsertionWithErrors "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m internalRequest formDescription | self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.ErrorSourceCommand' requestState: internalRequest. formDescription forwardNamed: 'failure' put: 'IfErrorsTagTest_tagInsertion.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/IfErrorsTagTest_tagInsertionWithErrors.result' testTagInsertionWithoutErrors "The Html tag is supposed to install internal request state provided by the servlet. This state should be available using the attributeAt: style access in the page" | request m internalRequest formDescription | self startSession. internalRequest := self makeRequestState. formDescription := self makeFormForCommand: 'WebMVCTests.DoNothingCommand' requestState: internalRequest. formDescription forwardNamed: 'success' put: 'IfErrorsTagTest_tagInsertion.jsp'. request := self executeRequest: internalRequest forForm: formDescription. m := Net.RFC822Message readFrom: request responseStream. self checkSuccess: m. self compareResponse: m toFileNamed: 'tests/IfErrorsTagTest_tagInsertionWithoutErrors.result' WebMVCTests.SingletonCommand accessing executed ^self executionCount > 0 executionCount ^executionCount ifNil: [executionCount := 0] WebMVCTests.SingletonCommand api defaultModelClass ^TagTestModel executeWithModel: anObject controller: aController executionCount := self executionCount + 1. ^aController findForward: 'success' WebMVCTests.SingletonCommand class instance creation clearDefaultInstance Singleton := SingletonCommand basicNew. new "The only way to enfore a singleton with a command is to override new. This is unfortunate but the controller creates the command instance with new." ^Singleton WebMVC.ValidatingModel specs fieldSpecFor: aVariable ^self class fieldSpecFor: aVariable WebMVC.ValidatingModel http urlTextWithID: aFormID "You must implement this if you want your form models to be transferable over a URL (as query parameters)." self subclassResponsibility WebMVC.ValidatingModel validating/assigning assign: name toValue: value | selector spec convertedValue | (spec := self fieldSpecFor: name) ifNil: [^nil]. selector := (name , ':') asSymbol. convertedValue := spec stringToValue: value. (self respondsTo: selector) ifTrue: [self perform: selector with: convertedValue] validateAndAssignFor: aController formData: formData | result | result := true. formData keysAndValuesDo: [:key :value | (self validateVariable: key withValue: value for: aController) ifNotNil: [:error | aController addError: error. result := false] ifNil: [self assign: key toValue: value]]. ^result validateVariable: aVariable withValue: aValue | spec | spec := self fieldSpecFor: aVariable. ^spec ifNotNil: [spec validate: aValue] validateVariable: aVariable withValue: aValue for: aController | spec | spec := self fieldSpecFor: aVariable. ^spec ifNotNil: [spec validateVariable: aVariable withValue: aValue for: aController] WebMVC.ValidatingModel testing isFormModel ^true WebMVC.ValidatingModel class specs fieldSpecFor: aVariable | selector | (aVariable isNil or: [aVariable isEmpty or: [aVariable first = $_]]) ifTrue: [^nil]. selector := (aVariable , 'FieldSpec') asSymbol. ^self safelyPerform: selector WebMVC.ValidatingModel class private safelyPerform: aSelector ^[self perform: aSelector] on: self messageNotUnderstoodSignal do: [:ex | ex parameter selector == aSelector ifTrue: [ex return: nil] ifFalse: [ex pass]] WebMVCTests.TagTestModel accessing age ^age age: anObject age := anObject password ^password password: anObject password := anObject username ^username username: anObject username := anObject WebMVCTests.TagTestModel class field specs ageFieldSpec ^FieldSpec name: 'username' validator: (MinLengthValidator minLength: 1) converter: NumberConverter new passwordFieldSpec ^FieldSpec name: 'username' validator: (MinLengthValidator minLength: 1) converter: StringConverter new usernameFieldSpec ^FieldSpec name: 'username' validator: (MinLengthValidator minLength: 1) converter: StringConverter new WebMVC.FieldSpec accessing acceptsList ^acceptsList ifNil: [acceptsList := false] ifNotNil: [acceptsList] acceptsList: anObject acceptsList := anObject converter ^converter converter: anObject converter := anObject name ^name name: anObject name := anObject validator ^validator validator: anObject validator := anObject WebMVC.FieldSpec api installValidatorScriptsInTag: aScriptableTag self validator ifNotNil: [ :v | v installScriptsInTag: aScriptableTag] stringToValue: aStringOrCollection (aStringOrCollection isString or: [self acceptsList]) ifFalse: [^self stringToValue: aStringOrCollection first]. ^converter ifNotNil: [converter stringToValue: aStringOrCollection] ifNil: [aStringOrCollection] validateVariable: aVariable withValue: aStringOrCollection for: aController ((aStringOrCollection isString not and: [self acceptsList not]) and: [aStringOrCollection notNil]) ifTrue: [^self validateVariable: aVariable withValue: aStringOrCollection first for: aController]. ^validator ifNotNil: [validator validateVariable: aVariable withValue: aStringOrCollection for: aController] valueToString: aValue ^converter valueToString: aValue WebMVC.FieldSpec class instance creation name: aString validator: aValidator converter: aConverter ^(self new) name: aString; validator: aValidator; converter: aConverter; yourself WebMVC.NumberConverter api stringToValue: aString ^aString asNumber valueToString: aNumber ^aNumber ifNil: [''] ifNotNil: [aNumber printString] WebMVCTests.DoNothingCommand api defaultModelClass ^nil executeWithModel: anObject controller: aController executed := true. ^aController findForward: 'success' WebMVCTests.DoNothingCommand accessing executed ^executed ifNil: [executed := false] VisualWave.UseBeanTag executing doAfterBody "Since UseBeanTag is a subclass of Body Tag, the absense of this method seems to prevent it from evaluating it's even when doStartTag returns EVAL_BODY_INCLUDE" bodyContent string doStartTag "Scope can be page|request|session|application" | created | created := false. instance := self getScope attributeAt: id ifAbsentPut: [created := true. self newInstance]. pageContext handler beanNamed: id put: instance. "Overwrite is easier than checking" ^created ifTrue: [self class EVAL_BODY_INCLUDE] ifFalse: [self class SKIP_BODY]. getScope scope = 'page' ifTrue: [^pageContext handler]. scope = 'request' ifTrue: [^pageContext request]. scope = 'session' ifTrue: [^pageContext session]. scope = 'application' ifTrue: [^pageContext application]. Core.Object webmvc extensions isFormModel ^false isForwarder ^false Core.String converting trimQuotes "Return a copy of the receiver that has one set of leading and trailing blanks removed." | start end | (self size) == 0 ifTrue: [^self]. start := self first = $" ifTrue: [2] ifFalse: [1]. end := self last = $" ifTrue: [self size - 1] ifFalse: [self size]. ^self copyFrom: start to: end VisualWave.JSPHandler bean tags attributeAt: aString ifAbsentPut: aBlock ^self beanNamed: aString ifAbsent: [| value | value := aBlock value. self beanNamed: aString put: value. value] removeAttribute: aString self removeBeanNamed: aString removeBeanNamed: aString self visibleObjects removeKey: aString ifAbsent: [] Core.CharacterArray converting % args ^StringParameterSubstitution usingBraces originalString: self; args: args; expandedText Core.CharacterArray auto complete endsWith: aSuffixString | idx | self size < aSuffixString size ifTrue: [^false]. idx := self indexOfSubCollection: aSuffixString startingAt: 1 ifAbsent: [-1]. ^idx = (self size - aSuffixString size + 1) Tools.Pragma class cds extensions allNamed: aSymbol withAllSubclassesOf: aClass "Answer a collection of all pragmas found in methods of all subclasses (inclusive) whose keyword is equal to the first argument." | pragmas | pragmas := OrderedCollection new. aClass withAllSubclasses do: [:each | self withSelectorsAndPragmasIn: each do: [:selector :pragmaMessage | pragmaMessage selector = aSymbol ifTrue: [pragmas add: (self new message: pragmaMessage class: each selector: selector)]]]. ^pragmas VisualWave.WebSite class constants identifierTag "I removed this because it makes testing a pain -- sometimes the message shows up and other times it doesn''t depending on the way in which the page is accessed" ^'' "<!-- Built with Cincom Smalltalk. http://www.cincom.com/smalltalk -->'." VisualWave.HttpApplication variables attributeAt: aString ^self attributeAt: aString ifAbsent: [] attributeAt: aString ifAbsent: aBlock ^self contents at: aString ifAbsent: aBlock attributeAt: aString ifAbsentPut: aBlock ^self contents at: aString ifAbsentPut: aBlock attributeAt: aString put: aValue ^self contents at: aString put: aValue removeAttribute: aString self contents removeKey: aString ifAbsent: [] VisualWave.Request variables allAttributes "Return all attributes, even those of my parent." | d | self webRequest hasParent ifFalse: [^self attributes]. d := Dictionary withAll: self attributes. d addAll: self webRequest parent allAttributes associations. ^d attributeAt: aString ifAbsentPut: aBlock "Return an object which was stored with this key in the request. If it is not found, evaluate aBlock, store it at that key and return the new value" ^self attributeAt: aString ifAbsent: [| value | value := aBlock value. self attributeAt: aString put: value. value] removeAttribute: aString (self attributes includesKey: aString) ifTrue: [^self attributes removeKey: aString ifAbsent: []]. self webRequest hasParent ifTrue: [self webRequest parent attributeAt: aString ifPresent: [self webRequest parent removeAttribute: aString]] VisualWave.JSPTaglibSAXDriver content handler characters: aString | target | target := attributeSpec isNil ifTrue: [currentTag] ifFalse: [attributeSpec]. target isNil ifTrue: [^self]. currentAttribute isNil ifTrue: [^self]. currentAttribute := currentAttribute copyWithout: $-. target perform: (currentAttribute, ':') asSymbol with: aString. VisualWave.Tag javascript addScript: aJavascriptScript "Overridden in HtmlTag which should be an ancestor of any tag on the form which generates Javascript" parent ifNotNil: [parent addScript: aJavascriptScript] VisualWave.Tag form accessing currentActionTag ^parent ifNotNil: [parent currentActionTag] VisualWave.Tag internal request state outgoingRequestMarker ^parent ifNotNil: [parent outgoingRequestMarker] outgoingRequestState "Overridden in HtmlTag which should be an ancestor of any tag on the form which needs request state" ^parent ifNotNil: [parent outgoingRequestState] VisualWave.Tag api scopeNamed: aString aString = 'page' ifTrue: [^pageContext handler]. aString = 'request' ifTrue: [^pageContext request]. aString = 'session' ifTrue: [^pageContext session]. aString = 'application' ifTrue: [^pageContext application]. Core.UndefinedObject webmvc extensions isFormModel ^false isFowarder ^false WebMVC.GetPropertyTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'getProperty' bodyContent: 'EMPTY'> WebMVC.UseBeanTag jsp accessing setFromBean: aString <required: false description: 'Specify the initial value of this bean using properties of existing beans.'> fromBean := aString setFromScope: aString <required: false description: 'The scope to use to look up the bean specified in fromBean. Defaults to "page" (that is, the bean must have been brought into page scope usually by useBean).'> fromScope := aString WebMVC.UseBeanTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'useBean' bodyContent: 'JSP'> WebMVC.ExistsTag jsp accessing setName: aName <required: true description: 'The name of the bean to look for.'> name := aName setScope: aString <required:true description: 'The scope in which to look.'> scope := aString WebMVC.ExistsTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'exists' bodyContent: 'JSP'> WebMVC.ElementTag jsp accessing setAccessKey: aValue <required: false description: 'keyboard shortcut'> accessKey := aValue setTabIndex: aValue <required: false description: 'tab order index'> tabIndex := aValue WebMVC.MenuTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'menu' bodyContent: 'JSP'> WebMVC.ScriptableTag jsp accessing setOnblur: aValue <required: false description: 'Javascript code for the onblur event.'> onblur := aValue setOnchange: aValue <required: false description: 'Javascript code for the onchange event.'> onchange := aValue setOnclick: aValue <required: false description: 'Javascript code for the onclick event.'> onclick := aValue setOndblclick: aValue <required: false description: 'Javascript code for the ondblclick event.'> ondblclick := aValue setOnfocus: aValue <required: false description: 'Javascript code for the onfocus event.'> onfocus := aValue setOnkeydown: aValue <required: false description: 'Javascript code for the onkeydown event.'> onkeydown := aValue setOnkeypress: aValue <required: false description: 'Javascript code for the onkeypress event.'> onkeypress := aValue setOnkeyup: aValue <required: false description: 'Javascript code for the onkeyup event.'> onkeyup := aValue setOnload: aValue <required: false description: 'Javascript code for the onload event.'> onload := aValue setOnmousedown: aValue <required: false description: 'Javascript code for the onmousedown event.'> onmousedown := aValue setOnmousemove: aValue <required: false description: 'Javascript code for the onmousemove event.'> onmousemove := aValue setOnmouseout: aValue <required: false description: 'Javascript code for the onmouseout event.'> onmouseout := aValue setOnmouseover: aValue <required: false description: 'Javascript code for the onmouseover event.'> onmouseover := aValue setOnmouseup: aValue <required: false description: 'Javascript code for the onmouseup event.'> onmouseup := aValue setOnreset: aValue <required: false description: 'Javascript code for the onreset event.'> onreset := aValue setOnselect: aValue <required: false description: 'Javascript code for the onselect event.'> onselect := aValue setOnsubmit: aValue <required: false description: 'Javascript code for the onsubmit event.'> onsubmit := aValue setOnunload: aValue <required: false description: 'Javascript code for the onunload event.'> onunload := aValue WebMVC.MenuItemTag jsp accessing setText: anObject <required: false description: 'The text to be displayed in this menu item.'> text := anObject setUri: anObject <required: false description: 'The URL action for this menu item.'> uri := anObject WebMVC.MenuItemTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'mi' bodyContent: 'EMPTY'> WebMVC.BaseTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'base' bodyContent: 'EMPTY'> WebMVC.SubmitTag jsp accessing setInvoke: aString <required: false description: 'The method to invoke on the model or command object when this button is pressed. Zero, one and two argument methods are supported. One argument methods are invoked with the model as the argument. Two argument methods are invoked with the model and the controller as the arguments.'> invoke := aString setName: aString <required: false description: 'The name of this button.'> value := aString setValue: aString <required: false description: 'The text to be displayed in this button.'> value := aString WebMVC.SubmitTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'submit' bodyContent: 'EMPTY'> WebMVC.ResetTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'reset' bodyContent: 'EMPTY'> WebMVC.StyledTag jsp accessing setStyle: aString <required: false description: 'CSS style string.'> style := aString setStyleClass: aString <required: false description: 'CSS style class.'> styleClass := aString setStyleID: aString <required: false description: 'CSS style id.'> styleID := aString WebMVC.ActionTag jsp accessing setFormID: aString <required: false description: 'The ID for this form. This sets the ID parameter for FORM tags (for Javascript or DHTML reference).'> formID := aString setInvoke: aValue <required: false description: 'The name of the method to be invoked. Zero, one and two argument methods are supported.'> invoke := aValue setModelName: aString <required: false description: 'The name of the model upon which the command will act.'> modelName := aString setModelScope: aString <required: false description: 'The scope of the model upon which the command will act. (must be request or session).'> modelScope := aString setSequencer: aString <required: false description: 'The class name of the sequencer for this form or action link'> sequencer := aString setTargetClass: aValue <required: false description: 'The class of the target to be used as a command.'> targetClass := aValue setTargetName: aValue <required: false description: 'The name target to be used as a command. Only session scope is searched for this name.'> targetName := aValue WebMVC.TLDBuilder class interface specs windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #properties: #(#{UI.PropertyListDictionary} #sizeType #specifiedSize #positionType #positionSystemDefault #openType #advanced ) #label: #(#{Kernel.UserMessage} #key: #UnlabeledCanvas #defaultString: 'TLD Builder' #catalogID: #labels ) #min: #(#{Core.Point} 265 167 ) #max: #(#{Core.Point} 766 516 ) #bounds: #(#{Graphics.Rectangle} 840 525 1151 811 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ComboBoxSpec} #layout: #(#{Graphics.LayoutFrame} 53 0 13 0 -15 1 38 0 ) #name: #ComboBox1 #model: #tagLibrary #type: #object #comboList: #tagLibraryChoices #readSelector: #stringToTagLibrary: #printSelector: #tagLibraryToString: ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutFrame} -98 1 -45 1 -10 1 -10 1 ) #name: #ActionButton1 #model: #createFile #label: 'Create' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 53 239 141 274 ) #name: #ActionButton2 #model: #updateChoices #label: 'Update list' #defaultable: true ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.LayoutFrame} 53 0 49 0 -15 1 -55 1 ) #name: #List1 #model: #activeTags #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #doubleClickSelector: #inspectTag ) #useModifierKeys: true #selectionType: #highlight ) ) ) ) WebMVC.FormTag jsp accessing setAction: aString <required: false description: 'The full URL for the form action. Inserted directly into the action part of the FORM tag. Usually the COMMAND parameter is used in place of this tag however setting the action to "/echo" can be a useful debugging tool.'> action := aString setFirstFocus: aValue <required: false description: 'The name of the component to get focus when this form is displayed. If a page contains multiple forms, only one form should have a firstFocus parameter.'> firstFocus := aValue setModelClass: aString <required: false description: 'The name of the class whose instances are models for this form.'> modelClassName := aString WebMVC.FormTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'form' bodyContent: 'JSP'> WebMVC.HtmlTag jsp accessing setSequencer: aString <required: false description: 'The specified value should be a the class name for the desired sequencer for this page. This sequencer will be installed as the active page sequencer and, upon submission of any action (from this page or any other) it will be combined with any sequencers specified for that action and the resulting combination will be asked to permit or disallow the submission.'> sequencer := aString WebMVC.HtmlTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'html' bodyContent: 'JSP'> WebMVC.LabelTag jsp accessing setErrorClass: aString <required: false description: 'The CSS class to use if the field corresponding to this label had a validation error during the last submit.'> errorClass := aString setFor: aString <required: false description: 'The name (property) of the INPUT tag that this label is labeling.'> for := aString WebMVC.LabelTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'label' bodyContent: 'EMPTY'> WebMVC.NotExistsTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'notExists' bodyContent: 'JSP'> WebMVC.ActionDataTag jsp accessing setName: aString <required: true description: 'The name of the argument to the command.'> name := aString setValue: aString <required: false description: 'The value of this argument, If this tag as a non-empty (or only whitespace) body, this parameter is IGNORED.'> value := aString WebMVC.ActionDataTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'actionData' bodyContent: 'JSP'> WebMVC.ForwardLinkTag jsp accessing setHref: aString <required: true description: 'The URL to forward to. If this tag as a non-empty (or only whitespace) body, this parameter is IGNORED.'> href := aString setName: aString <required: true description: 'The name of this forward link. Used by the command object to resolve this forward link.'> name := aString WebMVC.ForwardLinkTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'forward' bodyContent: 'EMPTY'> WebMVC.ActionLinkTag jsp accessing setHref: aValue <required: false description: 'Set the href of the page to go to. Normally you don''t use this parameter since WebMVC will automatically choose the controller as the target of the link'> WebMVC.ActionLinkTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'actionLink' bodyContent: 'JSP'> WebMVC.ActionRedirectTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'actionRedirect' bodyContent: 'JSP'> WebMVC.OptionTag jsp accessing setLabel: aString <required: false description: 'The label for this option.'> label := aString setSelected: aString <required: false description: 'Should this option be selected by default? (overridden by the value in the form model, if there is one).'> selected := aString setValue: aString <required: false description: 'The value to be placed in the form model if this option is selected.'> value := aString WebMVC.OptionTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'option' bodyContent: 'JSP'> WebMVC.InputTag jsp accessing setDescription: aString <required: false description: 'Description of this input tag. This description is displayed in error messages produced by the validators.'> description := aString setName: aString <required: false description: 'Name of the form model to which this component is connected. Normally this parameter is not supplied since it is generated automatically. Instead, the PROPERTY parameter is used to specify which propert of the form model to edit.'> name := aString setProperty: aString <required: false description: 'Which property of the form model is displayed/edited by this input field.'> property := aString setRedisplay: aString <required: false description: 'When form is displayed, should the current contents of the model be displayed in this field?'> redisplay := aString asLowercase = 'yes' setSize: aString <required: false description: 'Translates directly to the SIZE parameter of this INPUT tag.'> size := aString setType: aValue <required: false description: 'Specify the data type of this input field. Used for conversion before storage in the model'> type := aValue setValidator: aValue <required: false description: 'Specify the validator for this input field.'> validator := aValue WebMVC.HiddenTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'hidden' bodyContent: 'EMPTY'> WebMVC.CheckBoxTag jsp accessing setChecked: aString <required: false description: 'default value for the checked property (overriden by value in model)'> checked := aString WebMVC.CheckBoxTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'checkbox' bodyContent: 'EMPTY'> WebMVC.TextTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'text' bodyContent: 'EMPTY'> WebMVC.TextAreaTag jsp accessing setCols: aString <required: false description: 'Number of columns to be displayed.'> cols := aString setReadonly: aString <required: false description: 'If this is set (to any value) the textarea will be readonly.'> readonly := aString setRows: aString <required: false description: 'The number of rows to display.'> rows := aString WebMVC.TextAreaTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'textarea' bodyContent: 'JSP'> WebMVC.SelectTag jsp accessing setMultiple: aString <required: false description: 'Set this parameter to "yes" if multiple selection is allowed. Defaults to "no".'> multiple := aString WebMVC.SelectTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'select' bodyContent: 'JSP'> WebMVC.RadioTag jsp accessing setChecked: aString <required: false description: 'default value for the checked property (overriden by value in model)'> checked := aString setValue: aString <required: true description: 'The value to be assigned to the form model property if this radio button is selected.'> value := aString WebMVC.RadioTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'radio' bodyContent: 'EMPTY'> WebMVC.ButtonTag jsp accessing setValue: aString <required: false description: 'text to be displayed in the button'> value := aString WebMVC.ButtonTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'button' bodyContent: 'EMPTY'> WebMVC.PasswordTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'password' bodyContent: 'EMPTY'> WebMVC.IfErrorsTag jsp accessing setProperty: aValue <required: false description: 'If this parameter is supplied, the body of this tag is only evaluted if the error supplied corresponds to the indicated property'> property := aValue WebMVC.IfErrorsTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'ifErrors' bodyContent: 'JSP'> WebMVC.OptGroupTag jsp accessing setLabel: aString <required: true description: 'The label to be displayed above this group of options.'> label := aString WebMVC.OptGroupTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'optgroup' bodyContent: 'JSP'> WebMVC.ErrorsTag class pragma tagDefinition <tagLibrary: 'mvc.tld' name: 'errors' bodyContent: 'EMPTY'> Tools.VisualLauncher actions inspectSessions <menuItem: 'Inspect sessions' nameKey: #inspectSessions menu: #(#menuBar #web) position: 4.1> #{VisualWave.HttpSession} value allInstances inspect VisualWave.Tag class tag description tagDescriptionPragmas <pragmas: #instance> <pragmas: #class> ^#(tagLibrary:name:bodyContent: required:description:) Core.StringParameterSubstitution "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' Object Core false none Kernel-Objects Kernel-Objects CharacterArray Core Core.ArrayedCollection false none Collections-Text Collections-Text TagAttributeSpec VisualWave Core.Object false none name required permitsExpressionsForArguments Web Toolkit-JSP JSP Tag VisualWave Core.Object false none parent pageContext bodyContent allAttributes Web Toolkit-JSP JSP TagSpec VisualWave Core.Object false none name tagclass info bodyContent attributes Web Toolkit-JSP JSP GetPropertyTag VisualWave VisualWave.Tag false none name property selector Web Toolkit-JSP JSP UndefinedObject Core Core.Object false none Kernel-Objects Kernel-Objects ValueModel UI UI.Model false none Interface-Support Interface-Support Request VisualWave Core.Object false none webRequest cookies form query attributes handler Web Toolkit-ASP ASP TestCase XProgramming.SUnit Core.Object false none testSelector SUnit SUnit HttpApplication VisualWave Core.Object false none contents webSite Web Toolkit-ASP ASP JSPTaglibSAXDriver VisualWave XML.SAXDriver false none taglib currentTag currentAttribute attributeSpec Web Toolkit-JSP JSP SingleThreadModelServlet VisualWave VisualWave.HttpServlet false none request response session Web Toolkit-Servlet Servlet String Core Core.CharacterArray false none Collections-Text Collections-Text BodyTag VisualWave VisualWave.Tag false none Web Toolkit-JSP JSP UseBeanTag VisualWave VisualWave.BodyTag false none id scope className instance Web Toolkit-JSP JSP JSPHandler VisualWave VisualWave.ASPHandler false none taglibs visibleObjects currentTag allTaglibs allTaglibsMutex XML.* Web Toolkit-JSP JSP TagLibrary VisualWave Core.Object false none name prefix uri tags tlibversion jspversion shortname info Web Toolkit-JSP JSP ApplicationModel UI UI.Model false none builder uiSession eventHandlers savedWindowInformation UIBuilder-Framework UIBuilder-Framework VisualLauncher Tools UI.ApplicationModel false none menuBar toolBar oldHeight textCollector toolDock Tools-Misc Tools-Misc