[Pkg] Monticello Public: Monticello.impl-mtf.522.mcz

squeaksource-noreply at iam.unibe.ch squeaksource-noreply at iam.unibe.ch
Tue Jun 10 03:18:37 UTC 2008


A new version of Monticello.impl was added to project Monticello Public:
http://www.squeaksource.com/mc/Monticello.impl-mtf.522.mcz

==================== Summary ====================

Name: Monticello.impl-mtf.522
Author: mtf
Time: 9 June 2008, 8:16:32 pm
UUID: dcd90336-92a4-44e3-8817-89dcac4dc6a0
Ancestors: Monticello.impl-kph.521

removed direct references to ClassEditor

=============== Diff against Monticello.impl-kph.521 ===============

Item was changed:
  ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*monticello-override') -----
  httpPost: url args: args user: user passwd: passwd
  	| authorization result |
+ 	authorization := (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
- 	authorization _ (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
  	result := self 
  		httpPostDocument: url args: args accept: '*/*' 
  		request: 'Authorization: Basic ' , authorization , CrLf.
  	result isString ifFalse: [^result].
  
  	authorization := self digestFor: result method: 'POST' url: url user: user password: passwd.
  	authorization ifNil: [^result].
  	^self 
  		httpPostDocument: url args: args accept: '*/*' 
  		request: 'Authorization: Digest ' , authorization , CrLf.
  !

Item was changed:
  ----- Method: MCClassDefinition>>edUnload: (in category 'system editor') -----
  edUnload: editor
  
+ 	(editor at: name) removeFromSystem.
- 	(ClassEditor named: name for: editor) removeFromSystem.
  	
  	^ false  "we dont need an edPostload"!

Item was changed:
  ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*monticello-override') -----
  httpGetDocument: url args: args accept: mimeType request: requestString
  	"Return the exact contents of a web object. Asks for the given MIME 
  type. If mimeType is nil, use 'text/html'. An extra requestString may be 
  submitted and must end with crlf.  The parsed header is saved. Use a 
  proxy server if one has been registered.  tk 7/23/97 17:12"
  	"Note: To fetch raw data, you can use the MIME type 
  'application/octet-stream'."
  
  	| serverName serverAddr port sock header length bare page list firstData 
  aStream index connectToHost connectToPort type newUrl |
  	Socket initializeNetwork.
+ 	bare := (url asLowercase beginsWith: 'http://') 
- 	bare _ (url asLowercase beginsWith: 'http://') 
  		ifTrue: [url copyFrom: 8 to: url size]
  		ifFalse: [url].
+ 	bare := bare copyUpTo: $#.  "remove fragment, if specified"
+ 	serverName := bare copyUpTo: $/.
+ 	page := bare copyFrom: serverName size + 1 to: bare size.
- 	bare _ bare copyUpTo: $#.  "remove fragment, if specified"
- 	serverName _ bare copyUpTo: $/.
- 	page _ bare copyFrom: serverName size + 1 to: bare size.
  	(serverName includes: $:) 
+ 		ifTrue: [ index := serverName indexOf: $:.
+ 			port := (serverName copyFrom: index+1 to: serverName size) asNumber.
+ 			serverName := serverName copyFrom: 1 to: index-1. ]
+ 		ifFalse: [ port := self defaultPort ].
+ 	page size = 0 ifTrue: [page := '/'].
- 		ifTrue: [ index _ serverName indexOf: $:.
- 			port _ (serverName copyFrom: index+1 to: serverName size) asNumber.
- 			serverName _ serverName copyFrom: 1 to: index-1. ]
- 		ifFalse: [ port _ self defaultPort ].
- 	page size = 0 ifTrue: [page _ '/'].
  	"add arguments"
+ 	args ifNotNil: [page := page, (self argString: args) ].
- 	args ifNotNil: [page _ page, (self argString: args) ].
  
  
  	(self shouldUseProxy: serverName)
  		ifFalse: [ 
+ 			connectToHost := serverName.
+ 			connectToPort := port ]
- 			connectToHost _ serverName.
- 			connectToPort _ port ]
  		ifTrue:  [
+ 			page := 'http://', serverName, ':', port printString, page.		"put back 
- 			page _ 'http://', serverName, ':', port printString, page.		"put back 
  together"
+ 			connectToHost := HTTPProxyServer.
+ 			connectToPort := HTTPProxyPort].
- 			connectToHost _ HTTPProxyServer.
- 			connectToPort _ HTTPProxyPort].
  	
  
+ 	serverAddr := NetNameResolver addressForName: connectToHost timeout: 20.
- 	serverAddr _ NetNameResolver addressForName: connectToHost timeout: 20.
  	serverAddr ifNil: [
  		^ 'Could not resolve the server named: ', connectToHost].
  
  3 timesRepeat: [
+ 	sock := HTTPSocket new.
- 	sock _ HTTPSocket new.
  	sock connectTo: serverAddr port: connectToPort.
  	(sock waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [
  		Socket deadServer: connectToHost.  sock destroy.
  		^ 'Server ',connectToHost,' is not responding'].
  	"Transcript cr;show: url; cr.
  	Transcript show: page; cr."
  	sock sendCommand: 'GET ', page, ' HTTP/1.0', CrLf, 
  		(mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
  		'ACCEPT: text/html', CrLf,	"Always accept plain text"
  		HTTPBlabEmail,	"may be empty"
  		requestString,	"extra user request. Authorization"
  		self userAgentString, CrLf,
  		'Host: ', serverName, ':', port printString, CrLf.	"blank line 
  automatically added"
  
+ 	list := sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR).	"list = header, CrLf, CrLf, 
- 	list _ sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR).	"list = header, CrLf, CrLf, 
  beginningOfData"
+ 	header := list at: 1.
- 	header _ list at: 1.
  	"Transcript show: page; cr; show: header; cr."
+ 	firstData := list at: 3.
- 	firstData _ list at: 3.
  	header isEmpty 
+ 		ifTrue: [aStream := 'server aborted early']
- 		ifTrue: [aStream _ 'server aborted early']
  		ifFalse: [
  			"dig out some headers"
  			sock header: header.
+ 			length := sock getHeader: 'content-length'.
+ 			length ifNotNil: [ length := length asNumber ].
+ 			type := sock getHeader: 'content-type'.
- 			length _ sock getHeader: 'content-length'.
- 			length ifNotNil: [ length _ length asNumber ].
- 			type _ sock getHeader: 'content-type'.
  			sock responseCode first = $3 ifTrue: [
+ 				newUrl := sock getHeader: 'location'.
- 				newUrl _ sock getHeader: 'location'.
  				newUrl ifNotNil: [ 
  					Transcript show: 'redirecting to ', newUrl; cr.
  					sock destroy.
+ 					newUrl := self expandUrl: newUrl ip: serverAddr port: connectToPort.
- 					newUrl _ self expandUrl: newUrl ip: serverAddr port: connectToPort.
  					^self httpGetDocument: newUrl args: args  accept: mimeType request: requestString] ].
+ 			aStream := sock getRestOfBuffer: firstData totalLength: length.
- 			aStream _ sock getRestOfBuffer: firstData totalLength: length.
  			"a 400-series error"
  			sock responseCode first = $4 ifTrue: [^ header, aStream contents].
  			].
  	sock destroy.	"Always OK to destroy!!"
  	aStream class ~~ String ifTrue: [
   		^ MIMEDocument contentType: type content: aStream contents url: url].
  	aStream = 'server aborted early' ifTrue: [ ^aStream ].
  	].
  
  {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect.
  
  	^'some other bad thing happened!!'!

Item was changed:
  ----- Method: MCAncestry>>trimAfterVersionInfo: (in category 'ancestry') -----
  trimAfterVersionInfo: aVersionInfo
  	aVersionInfo = self
+ 		ifTrue: [ancestors := #()]
- 		ifTrue: [ancestors _ #()]
  		ifFalse:
  			[aVersionInfo date <= self date ifTrue:
  				[self ancestors do: [:ea | ea trimAfterVersionInfo: aVersionInfo]]
  		]!

Item was changed:
  ----- Method: MCClassDefinition>>edLoad: (in category 'system editor') -----
  edLoad: editor
  
  	| new old theClass theSuperclass |
   
+ 	theClass := editor at: name.
+ 	theSuperclass := editor at: superclassName.
- 	theClass := ClassEditor named: name for: editor.
- 	theSuperclass := ClassEditor named: superclassName for: editor.
  		
  	theClass superclass = theSuperclass ifFalse: [ theClass superclass: theSuperclass ]. 	
  		
  	theClass subject typeOfClass = type ifFalse: [ theClass typeOfClass: type ]. 
  		
  	old := theClass instVarNames.
  	new := self selectVariables: #isInstanceVariable.	 
  	(old difference: new) do: [ :iv | theClass removeInstVarName: iv ].
  	(new difference: old) do: [ :iv | theClass addInstVarName: iv ].
  	
  	old := theClass classVarNames.
  	new := self selectVariables: #isClassVariable.	 
  	(old difference: new) do: [ :iv | theClass removeClassVarName: iv ].
  	(new difference: old) do: [ :iv | theClass addClassVarName: iv ].
  	
  	old := theClass sharedPools.
  	new := self selectVariables: #isPoolImport.	 
  	(old difference: new) do: [ :iv | theClass removeSharedPool: iv ].
  	(new difference: old) do: [ :iv | theClass addSharedPool: iv ].
  	
  	old := theClass class instVarNames.
  	new := self selectVariables: #isClassInstanceVariable.	 
  	(old difference: new) do: [ :iv | theClass class removeInstVarName: iv ].
  	(new difference: old) do: [ :iv | theClass class addInstVarName: iv ].
  
  	self hasComment ifTrue: [ theClass classComment: comment stamp: commentStamp ].
  		 
  	^ false "we dont need an edPostload"!

Item was changed:
  ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*monticello-override') -----
  httpPut: contents to: url user: user passwd: passwd
  	"Upload the contents of the stream to a file on the server"
  
  	| bare serverName specifiedServer port page serverAddr authorization s list header firstData length aStream command digest |
  	Socket initializeNetwork.
   
  	"parse url"
+ 	bare := (url asLowercase beginsWith: 'http://') 
- 	bare _ (url asLowercase beginsWith: 'http://') 
  		ifTrue: [url copyFrom: 8 to: url size]
  		ifFalse: [url].
+ 	serverName := bare copyUpTo: $/.
+ 	specifiedServer := serverName.
+ 	(serverName includes: $:) ifFalse: [ port := self defaultPort ] ifTrue: [
+ 		port := (serverName copyFrom: (serverName indexOf: $:) + 1 
- 	serverName _ bare copyUpTo: $/.
- 	specifiedServer _ serverName.
- 	(serverName includes: $:) ifFalse: [ port _ self defaultPort ] ifTrue: [
- 		port _ (serverName copyFrom: (serverName indexOf: $:) + 1 
  				to: serverName size) asNumber.
+ 		serverName := serverName copyUpTo: $:.
- 		serverName _ serverName copyUpTo: $:.
  	].
- 
- 	page _ bare copyFrom: (bare indexOf: $/) to: bare size.
- 	page size = 0 ifTrue: [page _ '/'].
- 	(self shouldUseProxy: serverName) ifTrue: [ 
- 		page _ 'http://', serverName, ':', port printString, page.		"put back together"
- 		serverName _ HTTPProxyServer.
- 		port _ HTTPProxyPort].
- 
-   	"make the request"	
- 	serverAddr _ NetNameResolver addressForName: serverName timeout: 20.
- 	serverAddr ifNil: [
- 		^ 'Could not resolve the server named: ', serverName].
- 
- 	authorization _ ' Basic ', (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
- [
- 	s _ HTTPSocket new.
- 	s connectTo: serverAddr port: port.
- 	s waitForConnectionUntil: self standardDeadline.
- 	Transcript cr; show: url; cr.
- 	command _ 
- 		'PUT ', page, ' HTTP/1.0', CrLf, 
- 		self userAgentString, CrLf,
- 		'Host: ', specifiedServer, CrLf, 
- 		'ACCEPT: */*', CrLf,
- 		HTTPProxyCredentials,
- 		'Authorization: ' , authorization , CrLf , 
- 		'Content-length: ', contents size printString, CrLf , CrLf , 
- 		contents.
- 	s sendCommand: command.
- 	"get the header of the reply"
- 	list _ s getResponseUpTo: CrLf, CrLf ignoring: (String with: CR).	"list = header, CrLf, CrLf, beginningOfData"
- 	header _ list at: 1.
- 	"Transcript show: page; cr; show: argsStream contents; cr; show: header; cr."
- 	firstData _ list at: 3.
- 
- 	"dig out some headers"
- 	s header: header.
- 
- (authorization beginsWith: 'Digest ') not
- and: [(digest := self digestFrom: s method: 'PUT' url: url user: user password: passwd) notNil]]
- 	whileTrue: [authorization :=  'Digest ', digest].
- 
- 	length _ s getHeader: 'content-length'.
- 	length ifNotNil: [ length _ length asNumber ].
  
+ 	page := bare copyFrom: (bare indexOf: $/) to: bare size.
+ 	page size = 0 ifTrue: [page := '/'].
+ 	(self shouldUseProxy: serverName) ifTrue: [ 
+ 		page := 'http://', serverName, ':', port printString, page.		"put back together"
+ 		serverName := HTTPProxyServer.
+ 		port := HTTPProxyPort].
+ 
+   	"make the request"	
+ 	serverAddr := NetNameResolver addressForName: serverName timeout: 20.
+ 	serverAddr ifNil: [
+ 		^ 'Could not resolve the server named: ', serverName].
+ 
+ 	authorization := ' Basic ', (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
+ [
+ 	s := HTTPSocket new.
+ 	s connectTo: serverAddr port: port.
+ 	s waitForConnectionUntil: self standardDeadline.
+ 	Transcript cr; show: url; cr.
+ 	command := 
+ 		'PUT ', page, ' HTTP/1.0', CrLf, 
+ 		self userAgentString, CrLf,
+ 		'Host: ', specifiedServer, CrLf, 
+ 		'ACCEPT: */*', CrLf,
+ 		HTTPProxyCredentials,
+ 		'Authorization: ' , authorization , CrLf , 
+ 		'Content-length: ', contents size printString, CrLf , CrLf , 
+ 		contents.
+ 	s sendCommand: command.
+ 	"get the header of the reply"
+ 	list := s getResponseUpTo: CrLf, CrLf ignoring: (String with: CR).	"list = header, CrLf, CrLf, beginningOfData"
+ 	header := list at: 1.
+ 	"Transcript show: page; cr; show: argsStream contents; cr; show: header; cr."
+ 	firstData := list at: 3.
+ 
+ 	"dig out some headers"
+ 	s header: header.
+ 
+ (authorization beginsWith: 'Digest ') not
+ and: [(digest := self digestFrom: s method: 'PUT' url: url user: user password: passwd) notNil]]
+ 	whileTrue: [authorization :=  'Digest ', digest].
+ 
+ 	length := s getHeader: 'content-length'.
+ 	length ifNotNil: [ length := length asNumber ].
+ 
+ 	aStream := s getRestOfBuffer: firstData totalLength: length.
- 	aStream _ s getRestOfBuffer: firstData totalLength: length.
  	s destroy.	"Always OK to destroy!!"
  	^ header, aStream contents!

Item was removed:
- ----- Method: MCHttpRepository>>user: (in category 'as yet unclassified') -----
- user: userString
- 	user _ userString!

Item was removed:
- ----- Method: MCWorkingCopyBrowser>>pickRepositorySatisfying: (in category 'morphic ui') -----
- pickRepositorySatisfying: aBlock
- 	| repos index |
- 	repos := MCRepositoryGroup default repositories select: aBlock.
- 	index _ (PopUpMenu labelArray: (repos collect: [:ea | ea descriptionDisplay ]))
- 				startUpWithCaption: 'Repository:'.
- 	^ index = 0 ifFalse: [repos at: index]!

Item was removed:
- ----- Method: MCPatchBrowser>>revertSelection (in category 'as yet unclassified') -----
- revertSelection
- 	| loader |
- 	selection ifNotNil:
- 		[loader _ MCPackageLoader new.
- 		selection inverse applyTo: loader.
- 		loader loadWithName: self changeSetNameForInstall ]!

Item was removed:
- ----- Method: MCGOODSRepository>>db (in category 'as yet unclassified') -----
- db
- 	Smalltalk at: #KKDatabase ifPresent: [:classKKDatabase |
- 	(connection isNil or: [connection isConnected not]) ifTrue: [
- 		connection _ classKKDatabase onHost:hostname port: port].
- 	].
- 	^ connection!

Item was removed:
- ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') -----
- viewChanges
- 	| patch |
- 	'Finding changes' displayProgressAt: Sensor cursorPoint from: 0 to: 10 during:[:bar|
- 		self canSave ifTrue:[
- 		bar value: 1.
- 		patch _ workingCopy changesRelativeToRepository: self repository].
- 		patch isNil ifTrue: [^ self].
- 		bar value:3.
- 		patch isEmpty
- 			ifTrue: [ workingCopy modified: false.
- 				bar value: 10.
- 				self inform: 'No changes' ]
- 			ifFalse:
- 				[ workingCopy modified: true.
- 				bar value: 5.
- 				(MCPatchBrowser forPatch: patch)
- 					label: 'Patch Browser: ', workingCopy description;
- 					show]]!



More information about the Packages mailing list