Color and HTTP Proxy preferences
stéphane ducasse
ducasse at iam.unibe.ch
Tue Jan 4 16:56:11 UTC 2005
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 at 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.!
>
>
More information about the Squeak-dev
mailing list
|