Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán
'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 10 December 2004 at 11:21:58 pm'! "Change Set: HTTPProxyPrefs-hpt Date: 10 December 2004 Author: Hernan Tylim
This changeset is part of the Preferences Refactorings. The idea is to start moving all the user preferences and settings that are currently dispersed on the image to the Preferences class to be Preference instances. For more info look into the PrefViews-hpt preamble.
The changes present on this .cs are simple refactorings on HTTPSocket to make it use getter and setter to access to the http proxy info, which will be stored on Preferences instead of class variables."!
OldSimpleClientSocket subclass: #HTTPSocket instanceVariableNames: 'headerTokens headers responseCode ' classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions HTTPProxyPort HTTPProxyServer LogToTranscript ParamDelimiters ' poolDictionaries: '' category: 'Network-Protocols'!
!HTTPSocket class methodsFor: 'class initialization' stamp: 'hpt 12/9/2004 22:55'! initialize "HTTPSocket initialize"
ParamDelimiters := ' ', CrLf. HTTPPort := 80. self httpProxyServer: nil. HTTPBlabEmail := ''. " 'From: somebody@no.where', CrLf " HTTPProxyCredentials := ''.
ExternalSettings registerClient: self! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:53'! httpPostMultipart: url args: argsDict accept: mimeType request: requestString " do multipart/form-data encoding rather than x-www-urlencoded " " by Bolot Kerimbaev, 1998 " " this version is a memory hog: puts the whole file in memory " "bolot 12/14/2000 18:28 -- minor fixes to make it comply with RFC 1867"
| serverName serverAddr s header length bare page list firstData aStream port argsStream specifiedServer type newUrl mimeBorder fieldValue | Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. 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 := self httpProxyServer. port := self httpProxyPort].
mimeBorder := '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'. "encode the arguments dictionary" argsStream := WriteStream on: String new. argsDict associationsDo: [:assoc | assoc value do: [ :value | "print the boundary" argsStream nextPutAll: '--', mimeBorder, CrLf. " check if it's a non-text field " argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'. (value isKindOf: MIMEDocument) ifFalse: [fieldValue := value] ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', CrLf, 'Content-Type: ', value contentType. fieldValue := (value content ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] ifNotNil: [value content]) asString]. " Transcript show: 'field=', key, '; value=', fieldValue; cr. " argsStream nextPutAll: CrLf, CrLf, fieldValue, CrLf. ]]. argsStream nextPutAll: '--', mimeBorder, '--'.
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. Transcript cr; show: serverName, ':', port asString; cr. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', argsStream contents size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added"
s sendCommand: argsStream contents.
"get the header of the reply" list := s getResponseUpTo: CrLf, CrLf. "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. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ]. type := s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ "redirected - don't re-post automatically" "for now, just do a GET, without discriminating between 301/302 codes" newUrl := s getHeader: 'location'. newUrl ifNotNil: [ (newUrl beginsWith: 'http://') ifFalse: [ (newUrl beginsWith: '/') ifTrue: [newUrl := (bare copyUpTo: $/), newUrl] ifFalse: [newUrl := url, newUrl. self flag: #todo "should do a relative URL"] ]. Transcript show: 'redirecting to: ', newUrl; cr. s destroy. ^self httpGetDocument: newUrl "for some codes, may do: ^self httpPostMultipart: newUrl args: argsDict accept: mimeType request: requestString"] ].
aStream := s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!"
^ MIMEDocument contentType: type content: aStream contents url: url! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:53'! httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString
| serverName serverAddr s header length bare page list firstData aStream port specifiedServer type mimeBorder contentsData |
Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. serverName := serverName copyUpTo: $:. ].
page := bare copyFrom: (bare indexOf: $/ ifAbsent: [^'error']) to: bare size. page size = 0 ifTrue: [page := '/']. (self shouldUseProxy: serverName) ifTrue: [ page := 'http://', serverName, ':', port printString, page. "put back together" serverName := self httpProxyServer. port := self httpProxyPort].
mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'. contentsData := String streamContents: [ :strm | strm nextPutAll: mimeBorder, CrLf. argsDict associationsDo: [:assoc | assoc value do: [ :value | strm nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: value; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: mimeBorder; nextPutAll: CrLf. ] ]. ].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', contentsData size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added"
s sendCommand: contentsData.
list := s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData" header := list at: 1. firstData := list at: 3.
header isEmpty ifTrue: [ s destroy. ^'no response' ]. s header: header. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ]. type := s getHeader: 'content-type'. aStream := s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!"
^ MIMEDocument contentType: type content: aStream contents url: url! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:54'! 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 | Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. 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 := self httpProxyServer. port := self httpProxyPort].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
authorization := (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: Basic ' , 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. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ].
aStream := s getRestOfBuffer: firstData totalLength: length. s destroy. "Always OK to destroy!!"
^ header, aStream contents! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:18'! addHTTPProxyPreferences " This method will add to Squeak the HTTP Proxy preferences. " Preferences addTextPreference: #httpProxyServer category: #'http proxy' default: '' balloonHelp: 'HTTP Proxy Server. Leave blank if you don''t want to use a Proxy'. Preferences addNumericPreference: #httpProxyPort category: #'http proxy' default: 80 balloonHelp: 'HTTP Proxy Port'.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 22:40'! checkHTTPProxyPreferences Preferences preferenceAt: #httpProxyPort ifAbsent: [self addHTTPProxyPreferences]. Preferences preferenceAt: #httpProxyServer ifAbsent: [self addHTTPProxyPreferences].! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:51'! fetchExternalSettingsIn: aDirectory "Scan for server configuration files" "HTTPSocket fetchExternalSettingsIn: (FileDirectory default directoryNamed: 'prefs')"
| stream entries | (aDirectory fileExists: self proxySettingsFileName) ifFalse: [^self]. stream := aDirectory readOnlyFileNamed: self proxySettingsFileName. stream ifNotNil: [ [entries := ExternalSettings parseServerEntryArgsFrom: stream] ensure: [stream close]].
entries ifNil: [^self].
self httpProxyServer: (entries at: 'host' ifAbsent: [nil]). self httpProxyPort: ((entries at: 'port' ifAbsent: ['80']) asInteger ifNil: [self defaultPort]). HTTPSocket addProxyException: (entries at: 'exception' ifAbsent: [nil])! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 22:39'! httpProxyPort "answer the httpProxyPort" self checkHTTPProxyPreferences. ^Preferences valueOfPreference: #httpProxyPort.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:20'! httpProxyPort: aPortNumber self checkHTTPProxyPreferences. Preferences setPreference: #httpProxyPort toValue: aPortNumber.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:19'! httpProxyServer "answer the httpProxyServer. Take into account that as a Preference the Server might appear as an empty string but HTTPSocket expect it to be nil" self checkHTTPProxyPreferences. ^Preferences valueOfPreference: #httpProxyServer. ! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:17'! httpProxyServer: aStringOrNil | serverName | self checkHTTPProxyPreferences. serverName _ aStringOrNil ifNil: [''] ifNotNil: [aStringOrNil withBlanksTrimmed ]. Preferences setPreference: #httpProxyServer toValue: serverName! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:55'! stopUsingProxyServer "Stop directing HTTP request through a proxy server."
self httpProxyServer: nil. self httpProxyPort: 80. HTTPProxyCredentials := '' ! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:57'! useProxyServerNamed: proxyServerName port: portNum "Direct all HTTP requests to the HTTP proxy server with the given name and port number."
proxyServerName ifNil: [ "clear proxy settings" self httpProxyServer: nil. self httpProxyPort: 80. ^ self].
proxyServerName class == String ifFalse: [self error: 'Server name must be a String or nil']. self httpProxyServer: proxyServerName.
self httpProxyPort: portNum. self httpProxyPort class == String ifTrue: [HTTPPort := portNum asNumber]. self httpProxyPort ifNil: [self httpProxyPort: self defaultPort].! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'hpt 12/9/2004 22:54'! initHTTPSocket: httpUrl wait: timeout ifError: aBlock "Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
| serverName port serverAddr s | Socket initializeNetwork.
serverName := httpUrl authority. port := httpUrl port ifNil: [self defaultPort].
(self shouldUseProxy: serverName) ifTrue: [ serverName := self httpProxyServer. port := self httpProxyPort].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ aBlock value: 'Error: Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. (s waitForConnectionUntil: timeout) ifFalse: [ Socket deadServer: httpUrl authority. s destroy. ^aBlock value: 'Error: Server ',httpUrl authority,' is not responding']. ^s ! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'hpt 12/10/2004 23:21'! shouldUseProxy: serverName "Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
self httpProxyServer ifNotEmpty: [ self httpProxyExceptions detect: [:domainName | domainName match: serverName] ifNone: [^true]]. ^false ! !
!HTTPSocket class methodsFor: '*monticello-override' stamp: 'hpt 12/9/2004 22:52'! 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://') 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. (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 := '/']. "add arguments" args ifNotNil: [page := page, (self argString: args) ].
(self shouldUseProxy: serverName) ifFalse: [ connectToHost := serverName. connectToPort := port ] ifTrue: [ page := 'http://', serverName, ':', port printString, page. "put back together" connectToHost := self httpProxyServer. connectToPort := self httpProxyPort].
serverAddr := NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', connectToHost].
3 timesRepeat: [ 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, beginningOfData" header := list at: 1. "Transcript show: page; cr; show: header; cr." firstData := list at: 3. header isEmpty 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'. sock responseCode first = $3 ifTrue: [ newUrl := sock getHeader: 'location'. newUrl ifNotNil: [ Transcript show: 'redirecting to ', newUrl; cr. sock destroy. newUrl := self expandUrl: newUrl ip: serverAddr port: connectToPort. ^self httpGetDocument: newUrl args: args accept: mimeType request: requestString] ]. 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!!'! !
HTTPSocket initialize! OldSimpleClientSocket subclass: #HTTPSocket instanceVariableNames: 'headerTokens headers responseCode' classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions LogToTranscript ParamDelimiters' poolDictionaries: '' category: 'Network-Protocols'! "Postscript: This method will add to Preferences the HTTPProxy preferences." HTTPSocket addHTTPProxyPreferences. !
'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 10 December 2004 at 11:50:47 pm'! "Change Set: NumericPrefs-hpt Date: 10 December 2004 Author: Hernan Tylim
For some reason when I introduced the new 'types' of preferences and I created methods for adding text, boolean, font and color preferences, it didn't occur to me to add also methods for adding numeric preferences. This cs does just that. Take note that it does not produce any big change. Just add three very convenient methods."!
!PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 12/9/2004 22:16'! ofNumericPreferences ^(self registryOf: #numericPreferences) viewOrder: 3; yourself.! !
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/9/2004 22:15'! addNumericPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. "
self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofNumericPreferences ! !
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/9/2004 22:15'! addNumericPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system."
self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofNumericPreferences ! !
'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 9 December 2004 at 9:27:58 pm'! "Change Set: WindowColorPrefs-hpt Date: 8 December 2004 Author: Hernan Tylim
This changeset is part of the big Preferences refactoring that started on 3.8 with PrefViews-hpt, and PrefViewsRegistry-hpt. On these previous changesets we prepared Squeak to use Preference instances to store any type of preferences, not only boolean. This changeset will move where squeak stores its window colors preference to regular Preference instances, so they will be editable from the new PreferenceBrowser."!
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/8/2004 23:22'! addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry "Add or replace a preference as indicated. Reuses the preexisting Preference object for this symbol, if there is one, so that UI artifacts that interact with it will remain valid."
| aPreference aPrefSymbol | aPrefSymbol _ aName asSymbol. aPreference := DictionaryOfPreferences at: aPrefSymbol ifAbsent: [Preference new]. aPreference name: aPrefSymbol defaultValue: aValue helpString: helpString localToProject: localBoolean categoryList: categoryList changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry. DictionaryOfPreferences at: aPrefSymbol put: aPreference. self compileAccessMethodForPreference: aPreference! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/6/2004 22:49'! checkForWindowColors (self allPreferenceObjects noneSatisfy: [:aPref | aPref name endsWith: 'WindowColor']) ifTrue: [self installBrightWindowColors].! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 19:34'! darkenStandardWindowPreferences "Make all window-color preferences one shade darker"
(self allPreferenceObjects select: [:aPref | (aPref name endsWith: 'WindowColor') and: [aPref preferenceValue isColor]]) do: [:aPref | aPref preferenceValue: aPref preferenceValue darker].
"Preferences darkenStandardWindowPreferences" ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:17'! installMissingWindowColors "Install the factory-provided bright window colors -- a one-time bootstrap" "Preferences installMissingWindowColors" | color | self windowColorTable do: [:aColorSpec | color := (Color colorFrom: aColorSpec brightColor). self setWindowColorFor: aColorSpec classSymbol to: color]! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 20:10'! installWindowColorsVia: colorSpecBlock "Install windows colors using colorSpecBlock to deliver the color source for each element; the block is handed a WindowColorSpec object" "Preferences installBrightWindowColors" | color | self windowColorTable do: [:aColorSpec | color := (Color colorFrom: (colorSpecBlock value: aColorSpec)). self setWindowColorFor: aColorSpec classSymbol to: color] ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 19:35'! lightenStandardWindowPreferences "Make all window-color preferences one shade darker"
(self allPreferenceObjects select: [:aPref | (aPref name endsWith: 'WindowColor') and: [aPref preferenceValue isColor]]) do: [:aPref | aPref preferenceValue: aPref preferenceValue lighter].
"Preferences lightenStandardWindowPreferences" ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:29'! setWindowColorFor: modelSymbol to: incomingColor | aColor aPrefSymbol aColorSpec | aColorSpec := self windowColorTable detect: [:ea | ea classSymbol = modelSymbol] ifNone: [^self]. aColor := incomingColor asNontranslucentColor. (aColor = ColorPickerMorph perniciousBorderColor or: [aColor = Color black]) ifTrue: [^ self]. aPrefSymbol _ self windowColorPreferenceForClassNamed: aColorSpec classSymbol. self addPreference: aPrefSymbol categories: { #'window colors' } default: aColor balloonHelp: aColorSpec helpMessage translated projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: (PreferenceViewRegistry registryOf: #windowColorPreferences)! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:28'! windowColorFor: aModelClassName | classToCheck prefSymbol | self checkForWindowColors. classToCheck := Smalltalk at: aModelClassName. prefSymbol := self windowColorPreferenceForClassNamed: classToCheck name. [(classToCheck ~~ Object) and: [(self preferenceAt: prefSymbol) isNil]] whileTrue: [classToCheck := classToCheck superclass. prefSymbol := self windowColorPreferenceForClassNamed: classToCheck name]. ^self valueOfPreference: prefSymbol ifAbsent: [Color white].! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/9/2004 21:25'! windowColorPreferenceForClassNamed: aClassName | aColorSpec wording | aColorSpec := self windowColorTable detect: [:ea | ea classSymbol = aClassName] ifNone: []. wording := aColorSpec ifNil: [aClassName] ifNotNil: [aColorSpec wording]. ^(wording, 'WindowColor') asLegalSelector asSymbol.! !
"Postscript: This call to #installMissingWindowColors will store the Bright Window Colors as Preferences. After doing this they will be editable not only from the legacy WindowColor panel, but from the new PreferenceBrowser" Preferences installMissingWindowColors.!
Thanks for the preferences work. Boolean, Numeric, Text, and Color all sound like good fundamental preferences "types" to have.
One fundamental preferences type that is still needed, though, is some sort of multiple-choice or radio-button type. Maybe call it "Choice" or something. It could be represented as a set of Symbols, one of which is currently "selected". It would show up in the PreferencesBrowser as a set of radio buttons, only one of which can be selected at a time.
You mentioned in the other thread that you have a "Halos" preferences type (based on the previously existing Halos preference)... this one should really be implemented as a Choice type instead.
There are a few current Boolean preferences which should really be Choice preferences, such as the swapCtrlAndAltKeys/dupCtrlAndAltKeys/dupAllCtrlAndAltKeys combo. Right now we have to have an ugly hack which prevents you from selecting more than one of these. Also browseWithPrettyPrint/colorPrettyPrint, and there may be others.
- Doug
On Tue, 04 Jan 2005 08:37:17 -0300, "Hernan Tylim" htylim@yahoo.com.ar said:
Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán
Hi, Doug,
Yes, you are right. I started to think on this also for the AppRegistry selections. (i.e. SystemBrowser registry)
I will probably start to implement it after I finish the refactorings of the long promised font preferences.
Regards, Hernán
Doug Way wrote:
Thanks for the preferences work. Boolean, Numeric, Text, and Color all sound like good fundamental preferences "types" to have.
One fundamental preferences type that is still needed, though, is some sort of multiple-choice or radio-button type. Maybe call it "Choice" or something. It could be represented as a set of Symbols, one of which is currently "selected". It would show up in the PreferencesBrowser as a set of radio buttons, only one of which can be selected at a time.
You mentioned in the other thread that you have a "Halos" preferences type (based on the previously existing Halos preference)... this one should really be implemented as a Choice type instead.
There are a few current Boolean preferences which should really be Choice preferences, such as the swapCtrlAndAltKeys/dupCtrlAndAltKeys/dupAllCtrlAndAltKeys combo. Right now we have to have an ugly hack which prevents you from selecting more than one of these. Also browseWithPrettyPrint/colorPrettyPrint, and there may be others.
- Doug
On Tue, 04 Jan 2005 08:37:17 -0300, "Hernan Tylim" htylim@yahoo.com.ar said:
Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán
On 04/01/05 13:13, "Doug Way" dway@mailcan.com wrote:
Thanks for the preferences work. Boolean, Numeric, Text, and Color all sound like good fundamental preferences "types" to have.
One fundamental preferences type that is still needed, though, is some sort of multiple-choice or radio-button type. Maybe call it "Choice" or something. It could be represented as a set of Symbols, one of which is currently "selected". It would show up in the PreferencesBrowser as a set of radio buttons, only one of which can be selected at a time.
You mentioned in the other thread that you have a "Halos" preferences type (based on the previously existing Halos preference)... this one should really be implemented as a Choice type instead.
There are a few current Boolean preferences which should really be Choice preferences, such as the swapCtrlAndAltKeys/dupCtrlAndAltKeys/dupAllCtrlAndAltKeys combo. Right now we have to have an ugly hack which prevents you from selecting more than one of these. Also browseWithPrettyPrint/colorPrettyPrint, and there may be others.
- Doug
On Tue, 04 Jan 2005 08:37:17 -0300, "Hernan Tylim" htylim@yahoo.com.ar said:
Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán
Hernan: For radio button selection tool. Here is something Ned do some time ago , just in case you do not write your own. And not forgive the long needed Fonts preference.
Edgar
Thanks Edgar. I will take a look to it later.
Regards, Hernán
Lic. Edgar J. De Cleene wrote:
On 04/01/05 13:13, "Doug Way" dway@mailcan.com wrote:
Thanks for the preferences work. Boolean, Numeric, Text, and Color all sound like good fundamental preferences "types" to have.
One fundamental preferences type that is still needed, though, is some sort of multiple-choice or radio-button type. Maybe call it "Choice" or something. It could be represented as a set of Symbols, one of which is currently "selected". It would show up in the PreferencesBrowser as a set of radio buttons, only one of which can be selected at a time.
You mentioned in the other thread that you have a "Halos" preferences type (based on the previously existing Halos preference)... this one should really be implemented as a Choice type instead.
There are a few current Boolean preferences which should really be Choice preferences, such as the swapCtrlAndAltKeys/dupCtrlAndAltKeys/dupAllCtrlAndAltKeys combo. Right now we have to have an ugly hack which prevents you from selecting more than one of these. Also browseWithPrettyPrint/colorPrettyPrint, and there may be others.
- Doug
On Tue, 04 Jan 2005 08:37:17 -0300, "Hernan Tylim" htylim@yahoo.com.ar said:
Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán
Hernan: For radio button selection tool. Here is something Ned do some time ago , just in case you do not write your own. And not forgive the long needed Fonts preference.
Edgar
'From Squeak3.2gamma of 15 January 2002 [latest update: #4913] on 25 July 2002 at 4:51:14 pm'! "Change Set: RadioButtonGroupMorph-nk Date: 25 July 2002 Author: Ned Konz
This is a simple radio button group that takes a single target and sets buttons based on the return value of performing a selector on that target.
See the class side for examples of its use.
It includes the UpdatingThreePhaseButtonMorphEnhanced from Stephan B. Wessels' IRC Enhancements change set.
RadioButtonGroupMorph example1 "!
BorderedMorph subclass: #RadioButtonGroupMorph instanceVariableNames: 'values target getSelector getArgument setSelector setArgument ' classVariableNames: '' poolDictionaries: '' category: 'People-nk-Demo'!
!RadioButtonGroupMorph commentStamp: 'nk 7/25/2002 16:02' prior: 0! This is a simple radio button group that takes a single target and sets buttons based on the return value of performing a selector on that target.
See the class side for examples of its use.
initializeWithValues: anArrayOfValues this constructs the buttons, and makes them each correspond to a value in anArrayOfValues.
target: this sets the object that is queried and set.
getSelector: getArgument: these set the selector and argument that is sent to the target to get the current value.
setSelector: setArgument: these set the selector and argument that is sent to the target to set the value when a button is pushed. !
UpdatingThreePhaseButtonMorph subclass: #UpdatingThreePhaseButtonMorphEnhanced instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Widgets'!
!UpdatingThreePhaseButtonMorphEnhanced commentStamp: '<historical>' prior: 0! allows for the #getSelector to use the get argument value if needed.!
!RadioButtonGroupMorph methodsFor: 'private' stamp: 'nk 7/25/2002 16:01'! isValue: aValue "Answer true if the result of performing my getSelector is aValue." (getSelector isNil or: [ target isNil ]) ifTrue: [ ^false ].
^(getArgument ifNil: [ target perform: getSelector ] ifNotNil: [ target perform: getSelector withArguments: { getArgument } ]) = aValue ! !
!RadioButtonGroupMorph methodsFor: 'private' stamp: 'nk 7/25/2002 16:01'! setValue: aValue (setSelector isNil or: [ target isNil ]) ifTrue: [ ^self ].
^(setArgument ifNil: [ target perform: setSelector withArguments: { aValue } ] ifNotNil: [ target perform: setSelector withArguments: { setArgument. aValue } ]) = aValue
! !
!RadioButtonGroupMorph methodsFor: 'initialization' stamp: 'nk 7/25/2002 16:23'! initializeWithValues: arrayOfValues "Given arrayOfValues, construct my buttons. One of the values should match the return value from performing my getSelector" | button | values _ arrayOfValues.
self layoutPolicy: TableLayout new; hResizing: #spaceFill; vResizing: #spaceFill; listCentering: #center; color: Color transparent; borderWidth: 1.
self addMorphBack: (Morph new color: Color transparent; vResizing: #spaceFill). arrayOfValues do: [ :val | | aligner | aligner _ (Morph new color: Color transparent; layoutPolicy: TableLayout new; listDirection: #leftToRight; layoutInset: 4@0; cellInset: 2@-2; hResizing: #spaceFill; vResizing: #shrinkWrap). button _ UpdatingThreePhaseButtonMorphEnhanced radioButton. button target: self; actionSelector: #setValue:; arguments: { val }; getSelector: #isValue:; getArgument: val. aligner addMorphBack: button. aligner addMorphBack: (StringMorph contents: val asString). self addMorphBack: aligner. self addMorphBack: (Morph new color: Color transparent; vResizing: #spaceFill). ].
! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'nk 7/25/2002 15:37'! getArgument: anObject getArgument _ anObject ! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'nk 7/25/2002 15:36'! getSelector: selector getSelector _ selector. ! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'nk 7/25/2002 15:53'! setArgument: anObject setArgument _ anObject ! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'nk 7/25/2002 15:53'! setSelector: selector setSelector _ selector. ! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'nk 7/25/2002 15:37'! target: anObject target _ anObject ! !
!RadioButtonGroupMorph class methodsFor: 'examples' stamp: 'nk 7/25/2002 16:23'! example1 "RadioButtonGroupMorph example1" "Make a RBGM with three values" | assoc g | assoc _ 'myKey' -> #one. g _ RadioButtonGroupMorph new initializeWithValues: { #one. #two. #three }. g target: assoc; getSelector: #value; setSelector: #value:; extent: 55@62. g openInWorld. ! !
!UpdatingThreePhaseButtonMorph methodsFor: 'relocated from all category' stamp: 'sbw 3/3/2002 12:04'! getNewBoolean ^ target perform: getSelector! !
!UpdatingThreePhaseButtonMorph methodsFor: 'relocated from all category' stamp: 'sbw 3/3/2002 12:05'! step | newBoolean | super step. state == #pressed ifTrue: [^ self]. newBoolean _ self getNewBoolean. newBoolean == self isOn ifFalse: [self state: (newBoolean == true ifTrue: [#on] ifFalse: [#off])]! !
!UpdatingThreePhaseButtonMorphEnhanced methodsFor: 'as yet unclassified' stamp: 'sbw 3/3/2002 11:59'! getArgument: aSymbol getArgument _ aSymbol! !
!UpdatingThreePhaseButtonMorphEnhanced methodsFor: 'as yet unclassified' stamp: 'sbw 3/3/2002 12:06'! getNewBoolean ^ getArgument isNil ifTrue: [target perform: getSelector] ifFalse: [target perform: getSelector with: getArgument] ! !
!RadioButtonGroupMorph class reorganize! ('examples' example1) !
RadioButtonGroupMorph removeSelector: #initializeWithValues:getSelector:!
!RadioButtonGroupMorph reorganize! ('private' isValue: setValue:) ('initialization' initializeWithValues:) ('accessing' getArgument: getSelector: setArgument: setSelector: target:) !
"Postscript: Pop up a sample." RadioButtonGroupMorph example1!
'From Squeak 3.2 of 11 July 2002 [latest update: #4917] on 25 July 2002 at 9:18:18 pm'! "Change Set: RadioButtonGrpEnh-ccn Date: 25 July 2002 Author: Chris Norton
Prerequisite: RadioButtonGroupMorph-nk published by Ned Konz, July 25, 2002 at 4:51:45 pm.
This change set adds some common UI protocol methods to Ned Konz's excellent RadioButtonMorphGroup.
New protocol:
#contents #indexOf: #selectedItem #selection
Thanks Ned for providing us with a radio button group widget!!"!
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'ccn 7/25/2002 21:11'! contents "Answer the collection of objects that are associated with the radio buttons within the group."
^values! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'ccn 7/25/2002 21:10'! indexOf: anObject "Answer the index of the item anObject. Answer zero if anObject is not found."
^self contents indexOf: anObject! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'ccn 7/25/2002 21:09'! selectedItem "Answer the selected item."
^target value! !
!RadioButtonGroupMorph methodsFor: 'accessing' stamp: 'ccn 7/25/2002 21:09'! selection "Answer the index number of the selected item."
^self indexOf: target value! !
!RadioButtonGroupMorph reorganize! ('accessing' contents getArgument: getSelector: indexOf: selectedItem selection setArgument: setSelector: target:) ('initialization' initializeWithValues:) ('private' isValue: setValue:) !
thanks hernan as soon as 3.8 is out, I will add that to 3.9. Please remind me if I forget. My life is getting a bit crazy right now.
Stef On 4 janv. 05, at 12:37, Hernan Tylim wrote:
Hi, I just wanted to advertise that I added to PreferenceBrowser support for Windows Colors and HTTP Proxy settings. The required refactoring for them are waiting on Mantis. If you are interested, please review them and ask for their inclusion on 3.9a.
There are 3 .cs
The Window Color refactorings: http://bugs.impara.de/view.php?id=634 ( WindowColorPrefs-hpt.2.cs )
A 2 methods .cs that adds numeric preferences support to the base image to the already present text, color, and boolean preferences : http://bugs.impara.de/view.php?id=646 ( NumericPrefs-hpt.1.cs )
HTTPSocket refactoring to use Preferences instead of a class variables to store the HTTP Proxy Settings: http://bugs.impara.de/view.php?id=648 ( HTTPProxyPrefs-hpt.1.cs )
Regards, Hernán 'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 10 December 2004 at 11:21:58 pm'! "Change Set: HTTPProxyPrefs-hpt Date: 10 December 2004 Author: Hernan Tylim
This changeset is part of the Preferences Refactorings. The idea is to start moving all the user preferences and settings that are currently dispersed on the image to the Preferences class to be Preference instances. For more info look into the PrefViews-hpt preamble.
The changes present on this .cs are simple refactorings on HTTPSocket to make it use getter and setter to access to the http proxy info, which will be stored on Preferences instead of class variables."!
OldSimpleClientSocket subclass: #HTTPSocket instanceVariableNames: 'headerTokens headers responseCode ' classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions HTTPProxyPort HTTPProxyServer LogToTranscript ParamDelimiters ' poolDictionaries: '' category: 'Network-Protocols'!
!HTTPSocket class methodsFor: 'class initialization' stamp: 'hpt 12/9/2004 22:55'! initialize "HTTPSocket initialize"
ParamDelimiters := ' ', CrLf. HTTPPort := 80. self httpProxyServer: nil. HTTPBlabEmail := ''. " 'From: somebody@no.where', CrLf " HTTPProxyCredentials := ''.
ExternalSettings registerClient: self! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:53'! httpPostMultipart: url args: argsDict accept: mimeType request: requestString " do multipart/form-data encoding rather than x-www-urlencoded " " by Bolot Kerimbaev, 1998 " " this version is a memory hog: puts the whole file in memory " "bolot 12/14/2000 18:28 -- minor fixes to make it comply with RFC 1867"
| serverName serverAddr s header length bare page list firstData aStream port argsStream specifiedServer type newUrl mimeBorder fieldValue | Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. 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 := self httpProxyServer. port := self httpProxyPort].
mimeBorder := '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'. "encode the arguments dictionary" argsStream := WriteStream on: String new. argsDict associationsDo: [:assoc | assoc value do: [ :value | "print the boundary" argsStream nextPutAll: '--', mimeBorder, CrLf. " check if it's a non-text field " argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'. (value isKindOf: MIMEDocument) ifFalse: [fieldValue := value] ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', CrLf, 'Content-Type: ', value contentType. fieldValue := (value content ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] ifNotNil: [value content]) asString]. " Transcript show: 'field=', key, '; value=', fieldValue; cr. " argsStream nextPutAll: CrLf, CrLf, fieldValue, CrLf. ]]. argsStream nextPutAll: '--', mimeBorder, '--'.
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. Transcript cr; show: serverName, ':', port asString; cr. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', argsStream contents size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added"
s sendCommand: argsStream contents.
"get the header of the reply" list := s getResponseUpTo: CrLf, CrLf. "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. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ]. type := s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ "redirected - don't re-post automatically" "for now, just do a GET, without discriminating between 301/302 codes" newUrl := s getHeader: 'location'. newUrl ifNotNil: [ (newUrl beginsWith: 'http://') ifFalse: [ (newUrl beginsWith: '/') ifTrue: [newUrl := (bare copyUpTo: $/), newUrl] ifFalse: [newUrl := url, newUrl. self flag: #todo "should do a relative URL"] ]. Transcript show: 'redirecting to: ', newUrl; cr. s destroy. ^self httpGetDocument: newUrl "for some codes, may do: ^self httpPostMultipart: newUrl args: argsDict accept: mimeType request: requestString"] ].
aStream := s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!"
^ MIMEDocument contentType: type content: aStream contents url: url! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:53'! httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString
| serverName serverAddr s header length bare page list firstData aStream port specifiedServer type mimeBorder contentsData |
Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. serverName := serverName copyUpTo: $:. ].
page := bare copyFrom: (bare indexOf: $/ ifAbsent: [^'error']) to: bare size. page size = 0 ifTrue: [page := '/']. (self shouldUseProxy: serverName) ifTrue: [ page := 'http://', serverName, ':', port printString, page. "put back together" serverName := self httpProxyServer. port := self httpProxyPort].
mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'. contentsData := String streamContents: [ :strm | strm nextPutAll: mimeBorder, CrLf. argsDict associationsDo: [:assoc | assoc value do: [ :value | strm nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: value; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: mimeBorder; nextPutAll: CrLf. ] ]. ].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. s sendCommand: 'POST ', page, ' HTTP/1.1', CrLf, (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPProxyCredentials, HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', contentsData size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added"
s sendCommand: contentsData.
list := s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData" header := list at: 1. firstData := list at: 3.
header isEmpty ifTrue: [ s destroy. ^'no response' ]. s header: header. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ]. type := s getHeader: 'content-type'. aStream := s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!"
^ MIMEDocument contentType: type content: aStream contents url: url! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'hpt 12/9/2004 22:54'! 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 | Socket initializeNetwork.
"parse url" 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 to: serverName size) asNumber. 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 := self httpProxyServer. port := self httpProxyPort].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName].
authorization := (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: Basic ' , 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. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ].
aStream := s getRestOfBuffer: firstData totalLength: length. s destroy. "Always OK to destroy!!"
^ header, aStream contents! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:18'! addHTTPProxyPreferences " This method will add to Squeak the HTTP Proxy preferences. " Preferences addTextPreference: #httpProxyServer category: #'http proxy' default: '' balloonHelp: 'HTTP Proxy Server. Leave blank if you don''t want to use a Proxy'. Preferences addNumericPreference: #httpProxyPort category: #'http proxy' default: 80 balloonHelp: 'HTTP Proxy Port'.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 22:40'! checkHTTPProxyPreferences Preferences preferenceAt: #httpProxyPort ifAbsent: [self addHTTPProxyPreferences]. Preferences preferenceAt: #httpProxyServer ifAbsent: [self addHTTPProxyPreferences].! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:51'! fetchExternalSettingsIn: aDirectory "Scan for server configuration files" "HTTPSocket fetchExternalSettingsIn: (FileDirectory default directoryNamed: 'prefs')"
| stream entries | (aDirectory fileExists: self proxySettingsFileName) ifFalse: [^self]. stream := aDirectory readOnlyFileNamed: self proxySettingsFileName. stream ifNotNil: [ [entries := ExternalSettings parseServerEntryArgsFrom: stream] ensure: [stream close]].
entries ifNil: [^self].
self httpProxyServer: (entries at: 'host' ifAbsent: [nil]). self httpProxyPort: ((entries at: 'port' ifAbsent: ['80']) asInteger ifNil: [self defaultPort]). HTTPSocket addProxyException: (entries at: 'exception' ifAbsent: [nil])! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 22:39'! httpProxyPort "answer the httpProxyPort" self checkHTTPProxyPreferences. ^Preferences valueOfPreference: #httpProxyPort.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:20'! httpProxyPort: aPortNumber self checkHTTPProxyPreferences. Preferences setPreference: #httpProxyPort toValue: aPortNumber.! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:19'! httpProxyServer "answer the httpProxyServer. Take into account that as a Preference the Server might appear as an empty string but HTTPSocket expect it to be nil" self checkHTTPProxyPreferences. ^Preferences valueOfPreference: #httpProxyServer. ! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/10/2004 23:17'! httpProxyServer: aStringOrNil | serverName | self checkHTTPProxyPreferences. serverName _ aStringOrNil ifNil: [''] ifNotNil: [aStringOrNil withBlanksTrimmed ]. Preferences setPreference: #httpProxyServer toValue: serverName! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:55'! stopUsingProxyServer "Stop directing HTTP request through a proxy server."
self httpProxyServer: nil. self httpProxyPort: 80. HTTPProxyCredentials := '' ! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'hpt 12/9/2004 22:57'! useProxyServerNamed: proxyServerName port: portNum "Direct all HTTP requests to the HTTP proxy server with the given name and port number."
proxyServerName ifNil: [ "clear proxy settings" self httpProxyServer: nil. self httpProxyPort: 80. ^ self].
proxyServerName class == String ifFalse: [self error: 'Server name must be a String or nil']. self httpProxyServer: proxyServerName.
self httpProxyPort: portNum. self httpProxyPort class == String ifTrue: [HTTPPort := portNum asNumber]. self httpProxyPort ifNil: [self httpProxyPort: self defaultPort].! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'hpt 12/9/2004 22:54'! initHTTPSocket: httpUrl wait: timeout ifError: aBlock "Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
| serverName port serverAddr s | Socket initializeNetwork.
serverName := httpUrl authority. port := httpUrl port ifNil: [self defaultPort].
(self shouldUseProxy: serverName) ifTrue: [ serverName := self httpProxyServer. port := self httpProxyPort].
"make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ aBlock value: 'Error: Could not resolve the server named: ', serverName].
s := HTTPSocket new. s connectTo: serverAddr port: port. (s waitForConnectionUntil: timeout) ifFalse: [ Socket deadServer: httpUrl authority. s destroy. ^aBlock value: 'Error: Server ',httpUrl authority,' is not responding']. ^s ! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'hpt 12/10/2004 23:21'! shouldUseProxy: serverName "Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
self httpProxyServer ifNotEmpty: [ self httpProxyExceptions detect: [:domainName | domainName match: serverName] ifNone: [^true]]. ^false ! !
!HTTPSocket class methodsFor: '*monticello-override' stamp: 'hpt 12/9/2004 22:52'! 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://') 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. (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 := '/']. "add arguments" args ifNotNil: [page := page, (self argString: args) ].
(self shouldUseProxy: serverName) ifFalse: [ connectToHost := serverName. connectToPort := port ] ifTrue: [ page := 'http://', serverName, ':', port printString, page. "put back together" connectToHost := self httpProxyServer. connectToPort := self httpProxyPort].
serverAddr := NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', connectToHost].
3 timesRepeat: [ 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, beginningOfData" header := list at: 1. "Transcript show: page; cr; show: header; cr." firstData := list at: 3. header isEmpty 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'. sock responseCode first = $3 ifTrue: [ newUrl := sock getHeader: 'location'. newUrl ifNotNil: [ Transcript show: 'redirecting to ', newUrl; cr. sock destroy. newUrl := self expandUrl: newUrl ip: serverAddr port: connectToPort. ^self httpGetDocument: newUrl args: args accept: mimeType request: requestString] ]. 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!!'! !
HTTPSocket initialize! OldSimpleClientSocket subclass: #HTTPSocket instanceVariableNames: 'headerTokens headers responseCode' classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions LogToTranscript ParamDelimiters' poolDictionaries: '' category: 'Network-Protocols'! "Postscript: This method will add to Preferences the HTTPProxy preferences." HTTPSocket addHTTPProxyPreferences. !
'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 10 December 2004 at 11:50:47 pm'! "Change Set: NumericPrefs-hpt Date: 10 December 2004 Author: Hernan Tylim
For some reason when I introduced the new 'types' of preferences and I created methods for adding text, boolean, font and color preferences, it didn't occur to me to add also methods for adding numeric preferences. This cs does just that. Take note that it does not produce any big change. Just add three very convenient methods."!
!PreferenceViewRegistry class methodsFor: 'instance creation' stamp: 'hpt 12/9/2004 22:16'! ofNumericPreferences ^(self registryOf: #numericPreferences) viewOrder: 3; yourself.! !
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/9/2004 22:15'! addNumericPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system. "
self addPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofNumericPreferences ! !
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/9/2004 22:15'! addNumericPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString "Add an item repreesenting the given preference symbol to the system."
self addPreference: prefSymbol categories: {categorySymbol} default: defaultValue balloonHelp: helpString projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: PreferenceViewRegistry ofNumericPreferences ! !
'From Squeak3.9alpha of ''2 November 2004'' [latest update: #6485] on 9 December 2004 at 9:27:58 pm'! "Change Set: WindowColorPrefs-hpt Date: 8 December 2004 Author: Hernan Tylim
This changeset is part of the big Preferences refactoring that started on 3.8 with PrefViews-hpt, and PrefViewsRegistry-hpt. On these previous changesets we prepared Squeak to use Preference instances to store any type of preferences, not only boolean. This changeset will move where squeak stores its window colors preference to regular Preference instances, so they will be editable from the new PreferenceBrowser."!
!Preferences class methodsFor: 'add preferences' stamp: 'hpt 12/8/2004 23:22'! addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry "Add or replace a preference as indicated. Reuses the preexisting Preference object for this symbol, if there is one, so that UI artifacts that interact with it will remain valid."
| aPreference aPrefSymbol | aPrefSymbol _ aName asSymbol. aPreference := DictionaryOfPreferences at: aPrefSymbol ifAbsent: [Preference new]. aPreference name: aPrefSymbol defaultValue: aValue helpString: helpString localToProject: localBoolean categoryList: categoryList changeInformee: informeeSymbol changeSelector: aChangeSelector viewRegistry: aViewRegistry. DictionaryOfPreferences at: aPrefSymbol put: aPreference. self compileAccessMethodForPreference: aPreference! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/6/2004 22:49'! checkForWindowColors (self allPreferenceObjects noneSatisfy: [:aPref | aPref name endsWith: 'WindowColor']) ifTrue: [self installBrightWindowColors].! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 19:34'! darkenStandardWindowPreferences "Make all window-color preferences one shade darker"
(self allPreferenceObjects select: [:aPref | (aPref name endsWith: 'WindowColor') and: [aPref preferenceValue isColor]]) do: [:aPref | aPref preferenceValue: aPref preferenceValue darker].
"Preferences darkenStandardWindowPreferences" ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:17'! installMissingWindowColors "Install the factory-provided bright window colors -- a one-time bootstrap" "Preferences installMissingWindowColors" | color | self windowColorTable do: [:aColorSpec | color := (Color colorFrom: aColorSpec brightColor). self setWindowColorFor: aColorSpec classSymbol to: color]! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 20:10'! installWindowColorsVia: colorSpecBlock "Install windows colors using colorSpecBlock to deliver the color source for each element; the block is handed a WindowColorSpec object" "Preferences installBrightWindowColors" | color | self windowColorTable do: [:aColorSpec | color := (Color colorFrom: (colorSpecBlock value: aColorSpec)). self setWindowColorFor: aColorSpec classSymbol to: color] ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 19:35'! lightenStandardWindowPreferences "Make all window-color preferences one shade darker"
(self allPreferenceObjects select: [:aPref | (aPref name endsWith: 'WindowColor') and: [aPref preferenceValue isColor]]) do: [:aPref | aPref preferenceValue: aPref preferenceValue lighter]."Preferences lightenStandardWindowPreferences" ! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:29'! setWindowColorFor: modelSymbol to: incomingColor | aColor aPrefSymbol aColorSpec | aColorSpec := self windowColorTable detect: [:ea | ea classSymbol = modelSymbol] ifNone: [^self]. aColor := incomingColor asNontranslucentColor. (aColor = ColorPickerMorph perniciousBorderColor or: [aColor = Color black]) ifTrue: [^ self]. aPrefSymbol _ self windowColorPreferenceForClassNamed: aColorSpec classSymbol. self addPreference: aPrefSymbol categories: { #'window colors' } default: aColor balloonHelp: aColorSpec helpMessage translated projectLocal: false changeInformee: nil changeSelector: nil viewRegistry: (PreferenceViewRegistry registryOf: #windowColorPreferences)! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/8/2004 23:28'! windowColorFor: aModelClassName | classToCheck prefSymbol | self checkForWindowColors. classToCheck := Smalltalk at: aModelClassName. prefSymbol := self windowColorPreferenceForClassNamed: classToCheck name. [(classToCheck ~~ Object) and: [(self preferenceAt: prefSymbol) isNil]] whileTrue: [classToCheck := classToCheck superclass. prefSymbol := self windowColorPreferenceForClassNamed: classToCheck name]. ^self valueOfPreference: prefSymbol ifAbsent: [Color white].! !
!Preferences class methodsFor: 'window colors' stamp: 'hpt 12/9/2004 21:25'! windowColorPreferenceForClassNamed: aClassName | aColorSpec wording | aColorSpec := self windowColorTable detect: [:ea | ea classSymbol = aClassName] ifNone: []. wording := aColorSpec ifNil: [aClassName] ifNotNil: [aColorSpec wording]. ^(wording, 'WindowColor') asLegalSelector asSymbol.! !
"Postscript: This call to #installMissingWindowColors will store the Bright Window Colors as Preferences. After doing this they will be editable not only from the legacy WindowColor panel, but from the new PreferenceBrowser" Preferences installMissingWindowColors.!
squeak-dev@lists.squeakfoundation.org
-
Doug Way -
Hernan Tylim -
Lic. Edgar J. De Cleene -
stéphane ducasse