[Pkg] The Trunk: System-mt.761.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Aug 27 08:53:40 UTC 2015


Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.761.mcz

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

Name: System-mt.761
Author: mt
Time: 27 August 2015, 10:53:14.101 am
UUID: 20c7a755-3e9f-7f40-9222-79fc234c68cc
Ancestors: System-eem.760

Clean-up of preferences interface. Includes some bugfixes for updating pragma preferences after a class is renamed.

=============== Diff against System-eem.760 ===============

Item was changed:
  ----- Method: PragmaPreference>>asPreference (in category 'converting') -----
  asPreference
  	| preference |
  	preference := Preference new.
  	preference
  		name: name
  		defaultValue: defaultValue
  		helpString: helpString
+ 		localToProject: self localToProject
- 		localToProject: localToProject
  		categoryList: categoryList
  		changeInformee: changeInformee
  		changeSelector:  changeSelector
  		type: type.
  	preference rawValue: self preferenceValue.
  	^preference!

Item was added:
+ ----- Method: PragmaPreference>>id (in category 'accessing') -----
+ id
+ 
+ 	^ (self provider name, '>>', getter) asSymbol!

Item was added:
+ ----- Method: PragmaPreference>>localToProject (in category 'as yet unclassified') -----
+ localToProject
+ 	"Pragma preferences are stored and accessed outside the scope of the preference mechanism. Hence, they cannot be project-local."
+ 	
+ 	^ false!

Item was added:
+ ----- Method: Preference>>id (in category 'accessing') -----
+ id
+ 
+ 	^ self name asSymbol!

Item was changed:
  ----- Method: Preference>>isProjectLocalString (in category 'local to project') -----
  isProjectLocalString
  	"Answer a string representing whether sym is a project-local preference or not"
  
  	| aStr |
  	aStr :=  'each project has its own setting'.
+ 	^ self localToProject
- 	^ localToProject
  		ifTrue:
  			['<yes>', aStr]
  		ifFalse:
  			['<no>', aStr]!

Item was removed:
- Object subclass: #PreferenceExample
- 	instanceVariableNames: ''
- 	classVariableNames: 'BooleanPref ColorPref NumericPref TextPref'
- 	poolDictionaries: ''
- 	category: 'System-Preferences'!
- 
- !PreferenceExample commentStamp: 'ar 3/3/2009 22:40' prior: 0!
- This class provides an example for how to use preference pragmas.!

Item was removed:
- ----- Method: PreferenceExample class>>booleanPref (in category 'preferences') -----
- booleanPref
- 	<preference: 'Boolean Preference Example'
- 		category: 'Examples'
- 		description: 'A simple example for a boolean preference  (see PreferenceExample>>booleanPref)'
- 		type: #Boolean>
- 	^BooleanPref!

Item was removed:
- ----- Method: PreferenceExample class>>booleanPref: (in category 'preferences') -----
- booleanPref: aBool
- 	BooleanPref := aBool.
- 	self inform: 'The new preference value is: ', aBool asString.!

Item was removed:
- ----- Method: PreferenceExample class>>colorPref (in category 'preferences') -----
- colorPref
- 	<preference: 'Color Preference Example'
- 		category: 'Examples'
- 		description: 'A simple example for a color preference (see PreferenceExample>>colorPref)'
- 		type: #Color>
- 	^ColorPref!

Item was removed:
- ----- Method: PreferenceExample class>>colorPref: (in category 'preferences') -----
- colorPref: aColor
- 	ColorPref := aColor.
- 	self inform: 'The new preference value is: ', aColor asString.!

Item was removed:
- ----- Method: PreferenceExample class>>initialize (in category 'preferences') -----
- initialize	"PreferenceExample initialize"
- 	"Initialize the default values and register preferences"
- 	TextPref := 'Hello World'.
- 	NumericPref := 1234.
- 	BooleanPref := true.
- 	ColorPref := Color green.!

Item was removed:
- ----- Method: PreferenceExample class>>numericPref (in category 'preferences') -----
- numericPref
- 	<preference: 'Numeric Preference Example'
- 		category: 'Examples'
- 		description: 'A simple example for a numeric preference (see PreferenceExample>>numericPref)'
- 		type: #Number>
- 	^NumericPref!

Item was removed:
- ----- Method: PreferenceExample class>>numericPref: (in category 'preferences') -----
- numericPref: aNumber
- 	NumericPref := aNumber.
- 	self inform: 'The new preference value is: ', aNumber asString.!

Item was removed:
- ----- Method: PreferenceExample class>>textPref (in category 'preferences') -----
- textPref
- 	<preference: 'Textual Preference Example'
- 		category: 'Examples'
- 		description: 'A simple example for a textual preference (see PreferenceExample>>textPref)'
- 		type: #String>
- 	^TextPref!

Item was removed:
- ----- Method: PreferenceExample class>>textPref: (in category 'preferences') -----
- textPref: aString
- 	TextPref := aString.
- 	self inform: 'The new preference value is: ', aString asString.!

Item was changed:
  Object subclass: #Preferences
  	instanceVariableNames: ''
+ 	classVariableNames: 'DesktopColor Parameters'
- 	classVariableNames: 'DesktopColor DictionaryOfPreferences Parameters'
  	poolDictionaries: ''
  	category: 'System-Preferences'!
  Preferences class
  	instanceVariableNames: 'preferencesDictionary'!
  
  !Preferences commentStamp: 'eem 6/30/2015 15:10' prior: 0!
  A general mechanism to store preference choices.  The default setup treats any symbol as a potential boolean flag; flags unknown to the preference dictionary are always answered as false.  
  
  	To open the control panel:
  		PreferenceBrowser open
  	To read how to use the panel (and how to make a preference be per-project):
  		 Preferences giveHelpWithPreferences
  
  All messages are on the class side.  There are two kinds of preference definition, preference pragmas (which are preferred) and  preferences local to Preferences.
  
  Preference Pragmas
  Preferences can be local to a class or system of classes using preference pragmas.  Look at senders of #preference:category:description:type: and #preference:categoryList:description:type: for examples:
  	(self systemNavigation browseAllSelect:
  		[:m|
  		#(preference:category:description:type: preference:categoryList:description:type:) anySatisfy:
  			[:s| (m pragmaAt: s) notNil]])
  With a preference pragma, the preference is typically kept in a class variable, local to the class whose method(s) contain(s) the pragma.  Good style is to put the preference pragma in the accessor for the variable; see for example BitBlt class>>#subPixelRenderColorFonts. The pragma serves to declare the preference to Preferences.
  
  
  Preference-local Preferences
  To query a a preference:
  	Preferences logDebuggerStackToFile
  or some people prefer the more verbose
  	Preferences valueOfFlag: #logDebuggerStackToFile
  
  You can make up a new preference any time.  Do not define a new message in Preferences class. Accessor methods are compiled automatically when you add a preference, either as as illustrated below, or by using 
  
  To add a non-pragma preference (e.g. in the Postscript of a fileout):
  	Preferences
  		addPreference: #samplePreference
  		categories: #(general browsing)
  		default: true
  		balloonHelp: 'This is an example of a preference added by a do-it'
  		projectLocal: false
  		changeInformee: nil
  		changeSelector: nil.
  
  To change a preference programatically:
  	Preferences disable: #logDebuggerStackToFile.
  Or to turn it on,
  	Preferences enable: #logDebuggerStackToFile.
  !
  Preferences class
  	instanceVariableNames: 'preferencesDictionary'!

Item was changed:
+ ----- Method: Preferences class>>aaFontsColormapDepth (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>aaFontsColormapDepth (in category 'fonts') -----
  aaFontsColormapDepth
  	"Adjust balance between colored AA text quality (especially if subpixel AA is used) and space / performance.
  	5 is optimal quality. Each colorMap takes 128kB of RAM, and takes several seconds to build.
  	4 is a reasonable balance. Each colorMap takes 16kB of RAM and builds fast on a fast machine.
  	3 is good for slow hardware or memory restrictions. Each colorMap takes 2 kb of RAM."
  	^self
  		valueOfFlag: #aaFontsColormapDepth
  		ifAbsent: [4]!

Item was changed:
+ ----- Method: Preferences class>>acceptAnnotationsFrom: (in category 'support - misc') -----
- ----- Method: Preferences class>>acceptAnnotationsFrom: (in category 'parameters') -----
  acceptAnnotationsFrom: aSystemWindow
  	"This intricate extraction is based on the precise structure of the annotation-request window.  Kindly avert your eyes."
  	| aList |
  	aList := aSystemWindow paneMorphs first firstSubmorph submorphs collect:
  		[:m |  m contents asSymbol].
  	self defaultAnnotationRequests: aList
  	!

Item was changed:
+ ----- Method: Preferences class>>addBooleanPreference:categories:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addBooleanPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  addBooleanPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Boolean!
- 	self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Boolean!

Item was removed:
- ----- Method: Preferences class>>addBooleanPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: (in category 'add preferences') -----
- addBooleanPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol  changeSelector: aChangeSelector
- 	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean"
- 
- 	self addPreference: prefSymbol  categories: categoryList default:  aValue balloonHelp: helpString  projectLocal: localBoolean  changeInformee: informeeSymbol changeSelector: aChangeSelector type: #Boolean!

Item was changed:
+ ----- Method: Preferences class>>addBooleanPreference:category:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addBooleanPreference:category:default:balloonHelp: (in category 'add preferences') -----
  addBooleanPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Boolean!
- 	self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Boolean!

Item was changed:
+ ----- Method: Preferences class>>addColorPreference:categories:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addColorPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  addColorPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Color!
- 	self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Color!

Item was changed:
+ ----- Method: Preferences class>>addColorPreference:category:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addColorPreference:category:default:balloonHelp: (in category 'add preferences') -----
  addColorPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Color!
- 	self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Color!

Item was changed:
+ ----- Method: Preferences class>>addFontPreference:categories:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addFontPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  addFontPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Font!
- 	self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Font!

Item was changed:
+ ----- Method: Preferences class>>addFontPreference:category:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addFontPreference:category:default:balloonHelp: (in category 'add preferences') -----
  addFontPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Font!
- 	self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Font!

Item was changed:
+ ----- Method: Preferences class>>addModelItemsToWindowMenu: (in category 'support - misc') -----
- ----- Method: Preferences class>>addModelItemsToWindowMenu: (in category 'misc') -----
  addModelItemsToWindowMenu: aMenu
  	aMenu addLine.
  	aMenu add: 'restore default preference settings' target: self action: #chooseInitialSettings.
  	aMenu add: 'restore default text highlighting' target: self action: #initializeTextHighlightingParameters!

Item was changed:
+ ----- Method: Preferences class>>addNumericPreference:categories:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addNumericPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  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 type: #Number!
- 	self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Number!

Item was changed:
+ ----- Method: Preferences class>>addNumericPreference:category:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addNumericPreference:category:default:balloonHelp: (in category 'add preferences') -----
  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 type: #Number!
- 	self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #Number!

Item was added:
+ ----- Method: Preferences class>>addPragmaPreference: (in category 'add/remove') -----
+ addPragmaPreference: pragma
+ 	"Note that there will be no accessor method generated because the pragma's method does already govern that."
+ 	
+ 	| preference |
+ 	self assert: pragma methodClass isMeta.
+ 	
+ 	((pragma keyword beginsWith: #preference:) and: [self respondsTo: pragma keyword])
+ 		ifFalse: [Error signal: 'Cannot create pragma preference object.'. ^ self].
+ 	
+ 	preference := self
+ 		perform: pragma keyword
+ 		withArguments: pragma arguments.
+ 			
+ 	preference 
+ 		provider: pragma methodClass theNonMetaClass
+ 		getter: pragma method selector 
+ 		setter: pragma method selector asMutator.
+ 			
+ 	self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
+ 		copyOfDictionaryOfPreferences
+ 			at: preference id
+ 			put: preference].
+ 
+ 	^ preference!

Item was changed:
+ ----- Method: Preferences class>>addPreference:categories:default:balloonHelp: (in category 'add/remove - convenience') -----
- ----- Method: Preferences class>>addPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  addPreference: 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!
- 	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
- 	self addBooleanPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString.!

Item was changed:
+ ----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: (in category 'add/remove - convenience') -----
- ----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector: (in category 'add preferences') -----
  addPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol  changeSelector: aChangeSelector
+ 	"Add an item representing the given preference symbol to the system."
- 	"Add an item representing the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self
+ 		addPreference: prefSymbol
+ 		categories: categoryList
+ 		default: aValue
+ 		balloonHelp: helpString
+ 		projectLocal: localBoolean
+ 		changeInformee: informeeSymbol
+ 		changeSelector: aChangeSelector
+ 		type: (self typeForValue: aValue)
- 	self addBooleanPreference: prefSymbol categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol  changeSelector: aChangeSelector
  !

Item was changed:
+ ----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: (in category 'add/remove') -----
- ----- Method: Preferences class>>addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:type: (in category 'add preferences') -----
  addPreference: aName categories: categoryList default: aValue balloonHelp: helpString projectLocal: localBoolean changeInformee: informeeSymbol changeSelector: aChangeSelector type: aType
  	"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."
  
  	| newPreference aPreference |
+ 	newPreference := Preference new
+ 		name: aName asSymbol
+ 		defaultValue: aValue
+ 		helpString: helpString
+ 		localToProject: localBoolean
+ 		categoryList: categoryList
+ 		changeInformee: informeeSymbol
+ 		changeSelector: aChangeSelector
+ 		type: aType;
+ 		yourself.
- 	(newPreference := Preference new)
- 		 name: aName asSymbol
- 		 defaultValue: aValue
- 		 helpString: helpString
- 		 localToProject: localBoolean
- 		 categoryList: categoryList
- 		 changeInformee: informeeSymbol
- 		 changeSelector: aChangeSelector
- 		 type: aType.
  	aPreference := preferencesDictionary
  						 at: newPreference name
  						 ifAbsent: [newPreference].
  	aPreference == newPreference
  		ifTrue: "Atomically add the new preference to the dictionary."
  			[self atomicUpdatePreferences:
  				[:preferenceDictionaryCopy|
  				preferenceDictionaryCopy at: newPreference name put: newPreference]]
  		ifFalse: "Use the copyFrom: primitive to atomically update the existing preference."
  			[aPreference copyFrom: newPreference].
+ 	self compileAccessorForPreference: aPreference.
+ 
+ 	^ aPreference!
- 	self compileAccessMethodForPreference: aPreference!

Item was added:
+ ----- Method: Preferences class>>addPreference:category:default: (in category 'add/remove - convenience') -----
+ addPreference: prefSymbol category: categorySymbol default: defaultValue
+ 	"Add the given preference, putting it in the given category, with the given default value, and with the given balloon help."
+ 
+ 	^ self
+ 		addPreference: prefSymbol
+ 		category: categorySymbol
+ 		default: defaultValue
+ 		balloonHelp: nil.!

Item was changed:
+ ----- Method: Preferences class>>addPreference:category:default:balloonHelp: (in category 'add/remove - convenience') -----
- ----- Method: Preferences class>>addPreference:category:default:balloonHelp: (in category 'add preferences') -----
  addPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString 
+ 	"Add the given preference, putting it in the given category, with the given default value, and with the given balloon help."
- 	"Add the given preference, putting it in the given category, with the given default value, and with the given balloon help. It assumes boolean preference for backward compatibility"
  
+ 	^ self
+ 		addPreference: prefSymbol
+ 		categories: {categorySymbol}
+ 		default: defaultValue
+ 		balloonHelp: helpString.!
- 	self addBooleanPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString.!

Item was added:
+ ----- Method: Preferences class>>addPreference:default: (in category 'add/remove - convenience') -----
+ addPreference: prefSymbol default: defaultValue
+ 
+ 	^ self
+ 		addPreference: prefSymbol
+ 		category: self unclassifiedCategory
+ 		default: defaultValue
+ 		balloonHelp: nil.!

Item was changed:
+ ----- Method: Preferences class>>addTextPreference:categories:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addTextPreference:categories:default:balloonHelp: (in category 'add preferences') -----
  addTextPreference: prefSymbol categories: categoryList default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #String!
- 	self addPreference: prefSymbol  categories: categoryList  default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #String!

Item was changed:
+ ----- Method: Preferences class>>addTextPreference:category:default:balloonHelp: (in category 'add/remove - specific') -----
- ----- Method: Preferences class>>addTextPreference:category:default:balloonHelp: (in category 'add preferences') -----
  addTextPreference: prefSymbol category: categorySymbol default: defaultValue balloonHelp: helpString 
  	"Add an item repreesenting the given preference symbol to the system. Default view for this preference is boolean to keep backward compatibility"
  
+ 	^ self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #String!
- 	self addPreference: prefSymbol  categories: {categorySymbol} default:  defaultValue balloonHelp: helpString  projectLocal: false  changeInformee: nil changeSelector: nil type: #String!

Item was changed:
+ ----- Method: Preferences class>>allPreferenceObjects (in category 'accessing') -----
- ----- Method: Preferences class>>allPreferenceObjects (in category 'preference-object access') -----
  allPreferenceObjects
  	"Answer a list of all the Preference objects registered in the system"
  
+ 	self flag: #deprecated. "mt: Use #allPreferences since all preferences are objects."
+ 	^ self allPreferences!
- 	^preferencesDictionary values!

Item was added:
+ ----- Method: Preferences class>>allPreferences (in category 'accessing') -----
+ allPreferences
+ 
+ 	^preferencesDictionary values!

Item was changed:
+ ----- Method: Preferences class>>annotationEditingWindow (in category 'support - misc') -----
- ----- Method: Preferences class>>annotationEditingWindow (in category 'parameters') -----
  annotationEditingWindow
  	"Answer a window affording editing of annotations"
  	| aPanel ins outs current aWindow aButton info standardHeight standardWidth |
  	standardHeight := 200.
  	standardWidth := (2 sqrt reciprocal * standardHeight) rounded.
  	Smalltalk isMorphic
  		ifFalse: [self error: 'annotations can be edited only in morphic'].
  	aPanel := AlignmentMorph newRow extent: 2 * standardWidth @ standardHeight.
  	ins := AlignmentMorph newColumn extent: standardWidth @ standardHeight.
  	ins color: Color green muchLighter.
  	ins enableDrop: true;
  		 beSticky.
  	outs := AlignmentMorph newColumn extent: standardWidth @ standardHeight.
  	outs color: Color red muchLighter.
  	outs enableDrop: true;
  		 beSticky.
  	aPanel addMorph: outs;
  		 addMorphFront: ins.
  	outs position: ins position + (standardWidth @ 0).
  	current := self defaultAnnotationRequests.
  	info := self annotationInfo.
  	current
  		do: [:sym | | pair aMorph | 
  			pair := info
  						detect: [:aPair | aPair first == sym].
  			aMorph := StringMorph new contents: pair first.
  			aMorph setBalloonText: pair last.
  			aMorph enableDrag: true.
  			aMorph
  				on: #startDrag
  				send: #startDrag:with:
  				to: aMorph.
  			ins addMorphBack: aMorph].
  	info
  		do: [:aPair | (current includes: aPair first)
  				ifFalse: [| aMorph |
  					aMorph := StringMorph new contents: aPair first.
  					aMorph setBalloonText: aPair last.
  					aMorph enableDrag: true.
  					aMorph
  						on: #startDrag
  						send: #startDrag:with:
  						to: aMorph.
  					outs addMorph: aMorph]].
  	aPanel layoutChanged.
  	aWindow := SystemWindowWithButton new setLabel: 'Annotations'.
  	aButton := SimpleButtonMorph new target: Preferences;
  				 actionSelector: #acceptAnnotationsFrom:;
  				
  				arguments: (Array with: aWindow);
  				 label: 'apply';
  				 borderWidth: 0;
  				 borderColor: Color transparent;
  				 color: Color transparent.
  	aButton submorphs first color: Color blue.
  	aButton setBalloonText: 'After moving all the annotations you want to the left (green) side, and all the ones you do NOT want to the right (pink) side, hit this "apply" button to have your choices take effect.'.
  	aWindow buttonInTitle: aButton;
  		 adjustExtraButton.
  	^ aPanel wrappedInWindow: aWindow"Preferences annotationEditingWindow openInHand"!

Item was changed:
+ ----- Method: Preferences class>>annotationInfo (in category 'prefs - annotations') -----
- ----- Method: Preferences class>>annotationInfo (in category 'parameters') -----
  annotationInfo 
  	"Answer a list of pairs characterizing all the available kinds of annotations; in each pair, the first element is a symbol representing the info type, and the second element is a string providing the corresponding balloon help"
  
  	^ #(
  
  		(timeStamp			'The time stamp of the last submission of the method.')
  		(firstComment		'The first comment in the method, if any.')
  		(masterComment		'The comment at the beginning of the supermost implementor of the method if any.')
  		(documentation		'Comment at beginning of the method or, if it has none, comment at the beginning of a superclass''s implementation of the method')
  		(messageCategory	'Which method category the method lies in')
  		(sendersCount		'A report of how many senders there of the message.')
  		(implementorsCount	'A report of how many implementors there are of the message.')
  		(recentChangeSet	'The most recent change set bearing the method.')
  		(allChangeSets		'A list of all change sets bearing the method.')
  		(priorVersionsCount	'A report of how many previous versions there are of the method' )
  		(priorTimeStamp		'The time stamp of the penultimate submission of the method, if any'))!

Item was changed:
+ ----- Method: Preferences class>>annotationPanesChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>annotationPanesChanged (in category 'reacting to change') -----
  annotationPanesChanged
  	"The setting of the annotationPanes preference changed; react.  Formerly, we replaced prototypes in flaps but this is no longer necessary"!

Item was changed:
+ ----- Method: Preferences class>>attemptToRestoreClassicFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>attemptToRestoreClassicFonts (in category 'fonts') -----
  attemptToRestoreClassicFonts
  	"If certain fonts formerly used in early versions of Squeak happen to be present in the image, restore them to their corresponding roles.  Not called by any other method -- intended to be invoked via do-it, possibly in a postscript"
  	"Preferences attemptToRestoreClassicFonts"
  
  	
  	#(	(setButtonFontTo:		NewYork		12)
  		(setCodeFontTo:			NewYork		12)
  		(setFlapsFontTo:			ComicBold		16)
  		(setEToysFontTo:			ComicBold		16)
  		(setListFontTo:			NewYork		12)
  		(setMenuFontTo:			NewYork		12)
  		(setWindowTitleFontTo:	NewYork		15)
  		(setSystemFontTo:		NewYork		12)) do:
  			[:triplet | | aTextStyle |
  				(aTextStyle := TextStyle named: triplet second) ifNotNil:
  					[self perform: triplet first with: (aTextStyle fontOfSize: triplet third).
  					Transcript cr; show: triplet second, ' installed as ', (triplet first copyFrom: 4 to: triplet first size - 3)]]!

Item was changed:
+ ----- Method: Preferences class>>automaticFlapLayoutString (in category 'support - misc') -----
- ----- Method: Preferences class>>automaticFlapLayoutString (in category 'get/set') -----
  automaticFlapLayoutString
  	"Answer a string for the automaticFlapLayout menu item"
  	^ (self automaticFlapLayout
  		ifTrue: ['<yes>']
  		ifFalse: ['<no>'])
  		, 'automatic flap layout' translated!

Item was changed:
+ ----- Method: Preferences class>>balloonHelpDelayTime (in category 'prefs - misc') -----
- ----- Method: Preferences class>>balloonHelpDelayTime (in category 'misc') -----
  balloonHelpDelayTime
  	"Answer the number of milliseconds before a balloon help 
  	should be put up on morphs."
  	^ Parameters
  		at: #balloonHelpDelayTime
  		ifAbsent: [800]!

Item was changed:
+ ----- Method: Preferences class>>borderColorWhenRunning (in category 'prefs - misc') -----
- ----- Method: Preferences class>>borderColorWhenRunning (in category 'parameters') -----
  borderColorWhenRunning
  	^ Color green!

Item was changed:
+ ----- Method: Preferences class>>browseThemes (in category 'themes - tools') -----
- ----- Method: Preferences class>>browseThemes (in category 'misc') -----
  browseThemes
  	"Open up a message-category browser on the theme-defining methods"
  	ToolSet browse: Preferences class selector: #outOfTheBox.!

Item was changed:
+ ----- Method: Preferences class>>caretWidth (in category 'prefs - text') -----
- ----- Method: Preferences class>>caretWidth (in category 'text highlighting') -----
  caretWidth
  	^ Parameters at: #caretWidth!

Item was changed:
+ ----- Method: Preferences class>>caretWidth: (in category 'prefs - text') -----
- ----- Method: Preferences class>>caretWidth: (in category 'text highlighting') -----
  caretWidth: anInteger
  	^ Parameters at: #caretWidth put: anInteger!

Item was removed:
- ----- Method: Preferences class>>categoriesContainingPreference: (in category 'factored pref panel') -----
- categoriesContainingPreference: prefSymbol
- 	"Return a list of all categories in which the preference occurs"
- 
- 	^ (self preferenceAt: prefSymbol ifAbsent: [^ #(unclassified)]) categoryList!

Item was added:
+ ----- Method: Preferences class>>categoryList (in category 'support') -----
+ categoryList
+ 	"Return all available categories. No duplicates."
+ 
+ 	| aSet |
+ 	aSet := Set new.
+ 	self allPreferences do: [ :aPreference | 
+ 		aSet addAll: (
+ 			aPreference categoryList collect: [ :aCategory |
+ 				aCategory asSymbol ]) ].
+ 	
+ 	aSet add: self unclassifiedCategory.
+ 	
+ 	^aSet!

Item was added:
+ ----- Method: Preferences class>>categoryListOfPreference: (in category 'support') -----
+ categoryListOfPreference: prefSymbol
+ 	"Return a list of all categories in which the preference occurs"
+ 
+ 	^ (self preferenceAt: prefSymbol ifAbsent: [^ Error signal: 'Preference not found!!']) categoryList!

Item was removed:
- ----- Method: Preferences class>>categoryNames (in category 'preferences panel') -----
- categoryNames
- 
- 	| aSet |
- 	aSet := Set new.
- 	self allPreferenceObjects do: [ :aPreference | 
- 		aSet addAll: (
- 			aPreference categoryList collect: [ :aCategory |
- 				aCategory asSymbol ]) ].
- 	^aSet!

Item was changed:
+ ----- Method: Preferences class>>checkForWindowColors (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>checkForWindowColors (in category 'window colors') -----
  checkForWindowColors
+ 	(self allPreferences noneSatisfy:  [:aPref | aPref name endsWith: 'WindowColor'])
- 	(self allPreferenceObjects noneSatisfy:  [:aPref | aPref name endsWith: 'WindowColor'])
  		ifTrue: [self installBrightWindowColors].!

Item was changed:
+ ----- Method: Preferences class>>chooseBalloonHelpFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseBalloonHelpFont (in category 'fonts') -----
  chooseBalloonHelpFont
  
  	BalloonMorph chooseBalloonFont!

Item was changed:
+ ----- Method: Preferences class>>chooseCodeFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseCodeFont (in category 'fonts') -----
  chooseCodeFont
  	"Not currently sent, but once protocols are sorted out so that we can disriminate on whether a text object being launched is for code or not, will be reincorporated"
  
  	self 
  		chooseFontWithPrompt: 'Code font...' translated 
  		andSendTo: self 
  		withSelector: #setCodeFontTo: 
  		highlightSelector: #standardCodeFont.!

Item was changed:
+ ----- Method: Preferences class>>chooseEToysFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseEToysFont (in category 'fonts') -----
  chooseEToysFont
  	"present a menu with the possible fonts for the eToys"
  	self
  		chooseFontWithPrompt: 'eToys font...' translated
  		andSendTo: self
  		withSelector: #setEToysFontTo:
  		highlightSelector: #standardEToysFont!

Item was changed:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') -----
  chooseEToysTitleFont
  	"present a menu with the possible fonts for the eToys"
  	self
  		chooseFontWithPrompt: 'eToys Title font...' translated
  		andSendTo: self
  		withSelector: #setEToysTitleFontTo:
  		highlightSelector: #standardEToysTitleFont!

Item was changed:
+ ----- Method: Preferences class>>chooseFlapsFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseFlapsFont (in category 'fonts') -----
  chooseFlapsFont
  	self 
  		chooseFontWithPrompt: 'Flaps font...' translated
  		andSendTo: self 
  		withSelector: #setFlapsFontTo: 
  		highlightSelector: #standardFlapFont!

Item was changed:
+ ----- Method: Preferences class>>chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseFontWithPrompt:andSendTo:withSelector:highlightSelector: (in category 'fonts') -----
  chooseFontWithPrompt: aPrompt andSendTo: aReceiver withSelector: aSelector highlightSelector: highlightSelector
  	^UIManager default 
  			chooseFont: aPrompt 
  			for: aReceiver 
  			setSelector: aSelector
  			getSelector: highlightSelector !

Item was changed:
+ ----- Method: Preferences class>>chooseHaloLabelFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseHaloLabelFont (in category 'fonts') -----
  chooseHaloLabelFont
  	"present a menu with the possible fonts for label in halo"
  	self
  		chooseFontWithPrompt: 'Halo Label font...'
  		andSendTo: self
  		withSelector: #setHaloLabelFontTo:
  		highlightSelector: #standardHaloLabelFont!

Item was changed:
  ----- Method: Preferences class>>chooseInitialSettings (in category 'initialization') -----
  chooseInitialSettings
  	"Restore the default choices for all of the standard Preferences."
  
+ 	self allPreferences do: [:aPreference |
+ 		aPreference restoreDefaultValue].
- 	self allPreferenceObjects do:
- 		[:aPreference |
- 			aPreference restoreDefaultValue].
  	Project current installProjectPreferences!

Item was changed:
+ ----- Method: Preferences class>>chooseInsertionPointColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>chooseInsertionPointColor (in category 'text highlighting') -----
  chooseInsertionPointColor
  	"Let the user indicate what color he wishes to have used for insertion points in text"
  
  	ColorPickerMorph new
  		choseModalityFromPreference;
  		sourceHand: self currentHand;
  		target: self;
  		selector: #insertionPointColor:;
  		originalColor: self insertionPointColor;
  		putUpFor: self currentHand near: self currentHand cursorBounds!

Item was changed:
+ ----- Method: Preferences class>>chooseKeyboardFocusColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>chooseKeyboardFocusColor (in category 'text highlighting') -----
  chooseKeyboardFocusColor
  	"Let the user indicate what color he wishes to have used for keyboard-focus feedback"
  
  	ColorPickerMorph new
  		choseModalityFromPreference;
  		sourceHand: self currentHand;
  		target: self;
  		selector: #keyboardFocusColor:;
  		originalColor: self keyboardFocusColor;
  		putUpFor: self currentHand near: self currentHand cursorBounds!

Item was changed:
+ ----- Method: Preferences class>>chooseListFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseListFont (in category 'fonts') -----
  chooseListFont
  	self 
  		chooseFontWithPrompt: 'List font...' translated
  		andSendTo: self 
  		withSelector: #setListFontTo: 
  		highlightSelector: #standardListFont!

Item was changed:
+ ----- Method: Preferences class>>chooseMenuFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseMenuFont (in category 'fonts') -----
  chooseMenuFont
  	self 
  		chooseFontWithPrompt: 'Menu font...' translated
  		andSendTo: self 
  		withSelector: #setMenuFontTo: 
  		highlightSelector: #standardMenuFont!

Item was changed:
+ ----- Method: Preferences class>>chooseStandardButtonFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseStandardButtonFont (in category 'fonts') -----
  chooseStandardButtonFont
  	self 
  		chooseFontWithPrompt: 'Button font...' translated
  		andSendTo: self 
  		withSelector: #setButtonFontTo: 
  		highlightSelector: #standardButtonFont
  
  !

Item was changed:
+ ----- Method: Preferences class>>chooseSystemFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseSystemFont (in category 'fonts') -----
  chooseSystemFont
  	self 
  		chooseFontWithPrompt: 'Default font...' translated
  		andSendTo: self 
  		withSelector: #setSystemFontTo: 
  		highlightSelector: #standardSystemFont!

Item was changed:
+ ----- Method: Preferences class>>chooseTextHighlightColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>chooseTextHighlightColor (in category 'text highlighting') -----
  chooseTextHighlightColor
  	"Let the user choose the text-highlight color"
  
  	ColorPickerMorph new
  		choseModalityFromPreference;
  		sourceHand: self currentHand;
  		target: self;
  		selector: #textHighlightColor:;
  		originalColor: self textHighlightColor;
  		putUpFor: self currentHand near: self currentHand cursorBounds!

Item was changed:
+ ----- Method: Preferences class>>chooseWindowTitleFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>chooseWindowTitleFont (in category 'fonts') -----
  chooseWindowTitleFont
  	self 
  		chooseFontWithPrompt: 'Window Title font...' translated
  		andSendTo: self 
  		withSelector: #setWindowTitleFontTo: 
  		highlightSelector: #windowTitleFont!

Item was changed:
+ ----- Method: Preferences class>>classicHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>classicHaloSpecs (in category 'halos') -----
  classicHaloSpecs
  	"Non-iconic halos with traditional placements"
  
  	"Preferences installClassicHaloSpecs"
  	"Preferences resetHaloSpecifications"  "  <-  will result in the standard default halos being reinstalled"
  	"NB: listed below in clockwise order"
  
  		^ #(
  	"  	selector				horiz		vert			color info						icon key
  		---------				------		-----------		-------------------------------		---------------"
  	(addMenuHandle:		left			top				(red)							none)
  	(addDismissHandle:		leftCenter	top				(red		muchLighter)			'Halo-Dismiss')
  	(addGrabHandle:			center		top				(black)							none)
  	(addDragHandle:			rightCenter	top				(brown)							none)
  	(addDupHandle:			right		top				(green)							none)	
  	(addMakeSiblingHandle:		right		top				(green muchDarker)				'Halo-Dup')	
  	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		none)
  	(addPoohHandle:			right		center			(white)							none)
  	(addPaintBgdHandle:		right		center			(lightGray)						none)
  	(addRepaintHandle:		right		center			(lightGray)						none)
  	(addGrowHandle:		right		bottom			(yellow)						none)
  	(addScaleHandle:		right		bottom			(lightOrange)					none)
  	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				none)
  	(addFontStyleHandle:		center		bottom			(lightRed)						none)
  	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						none)
  
  	(addRecolorHandle:		right		bottomCenter	(magenta darker)				none)
  
  	(addRotateHandle:		left			bottom			(blue)							none))
  
  !

Item was changed:
+ ----- Method: Preferences class>>classicHalosInForce (in category 'prefs - halos') -----
- ----- Method: Preferences class>>classicHalosInForce (in category 'halos') -----
  classicHalosInForce
  	^ (self preferenceAt: #haloTheme) preferenceValue == #classicHaloSpecs!

Item was changed:
+ ----- Method: Preferences class>>classicTilesSettingToggled (in category 'updating - system') -----
- ----- Method: Preferences class>>classicTilesSettingToggled (in category 'reacting to change') -----
  classicTilesSettingToggled
  	"The current value of the largeTiles flag has changed; now react"
  
  	Smalltalk isMorphic ifTrue:
  		[Preferences universalTiles
  			ifFalse:
  				[self inform: 
  'note that this will only have a noticeable
  effect if the universalTiles preference is
  set to true, which it currently is not' translated]
  			ifTrue:
  				[World recreateScripts]]!

Item was changed:
+ ----- Method: Preferences class>>cleanUp (in category 'initialization') -----
- ----- Method: Preferences class>>cleanUp (in category 'initialize-release') -----
  cleanUp
  	self removeObsolete.!

Item was changed:
+ ----- Method: Preferences class>>cmdKeysInText (in category 'prefs - misc') -----
- ----- Method: Preferences class>>cmdKeysInText (in category 'hard-coded prefs') -----
  cmdKeysInText
  	"compiled programatically -- return hard-coded preference value"
  	^ true!

Item was removed:
- ----- Method: Preferences class>>compileAccessMethodForPreference: (in category 'initialization') -----
- compileAccessMethodForPreference: aPreference
- 	"Compile an accessor method for the given preference"
- 
- 	self class 
- 		compileSilently: (
- 			'{1} ^self valueOfFlag: {2} ifAbsent: {3}'
- 				format: {
- 					aPreference name asString.
- 					aPreference name asSymbol printString.
- 					aPreference defaultValue storeString }) 
- 		classified: '*autogenerated - standard queries'!

Item was added:
+ ----- Method: Preferences class>>compileAccessorForPreference: (in category 'private') -----
+ compileAccessorForPreference: aPreference
+ 	"Compile an accessor method for the given preference"
+ 
+ 	self class 
+ 		compileSilently: (
+ 			'{1} ^self valueOfFlag: {2} ifAbsent: [ {3} ]'
+ 				format: {
+ 					aPreference name asString.
+ 					aPreference name asSymbol printString.
+ 					aPreference defaultValue storeString }) 
+ 		classified: '*autogenerated - standard queries'!

Item was added:
+ ----- Method: Preferences class>>compileAccessorForPreferenceNamed:value: (in category 'private') -----
+ compileAccessorForPreferenceNamed: name value: value
+ 	"Compile a method that returns a simple true or false (depending on the value of aBoolean) when Preferences is sent prefName as a message"
+ 
+ 	self class 
+ 		compileSilently: (
+ 			'{1} ^{2}'
+ 				format: {
+ 					name asString.
+ 					value storeString })
+ 		classified: 'prefs - misc'.
+ 	
+ "Preferences compileAccessorForPreferenceNamed: #testing value: false"!

Item was removed:
- ----- Method: Preferences class>>compileHardCodedPref:enable: (in category 'personalization') -----
- compileHardCodedPref: prefName enable: aBoolean
- 	"Compile a method that returns a simple true or false (depending on the value of aBoolean) when Preferences is sent prefName as a message"
- 
- 	self class 
- 		compileSilently: (
- 			'{1} ^{2}'
- 				format: {
- 					prefName asString.
- 					aBoolean storeString })
- 		classified: '*autogenerated - hard-coded prefs'.
- 	
- "Preferences compileHardCodedPref: #testing enable: false"!

Item was removed:
- ----- Method: Preferences class>>createPreference:categoryList:description:type: (in category 'private') -----
- createPreference: prefName categoryList: arrayOfStrings description: helpString type: typeSymbol
- 	"Add a preference residing in aMethod"
- 	|  aPreference |
- 	aPreference := PragmaPreference new.
- 	aPreference 
- 		 name: prefName
- 		 defaultValue: nil	"always nil"
- 		 helpString: helpString
- 		 localToProject: false "governed by the method"
- 		 categoryList: arrayOfStrings
- 		 changeInformee: nil
- 		 changeSelector: nil
- 		 type: typeSymbol.
- 	^aPreference!

Item was changed:
+ ----- Method: Preferences class>>customHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>customHaloSpecs (in category 'halos') -----
  customHaloSpecs
  	"Intended for you to modify to suit your personal preference.  What is implemented in the default here is just a skeleton; in comment at the bottom of this method are some useful lines you may wish to paste in to the main body here, possibly modifying positions, colors, etc..
  	Note that in this example, we include:
  			Dismiss handle, at top-left
  			Menu handle, at top-right
  			Resize handle, at bottom-right
  			Rotate handle, at bottom-left
  			Drag handle, at top-center
  			Recolor handle, at left-center.  (this one is NOT part of the standard formulary --
  											it is included here to illustrate how to
   											add non-standard halos)
  			Note that the optional handles for specialized morphs, such as Sketch, Text, PasteUp, are also included"
  
  	^ #(
  	(addDismissHandle:		left			top				(red		muchLighter)			'Halo-Dismiss')
  	(addMenuHandle:		right		top				(red)							'Halo-Menu')
  	(addDragHandle:			center	top					(brown)							'Halo-Drag')
  	(addGrowHandle:		right		bottom			(yellow)						'Halo-Scale')
  	(addScaleHandle:		right		bottom			(lightOrange)					'Halo-Scale')
  
  	(addRecolorHandle:		left			center			(green muchLighter lighter)		'Halo-Recolor')
  
  	(addPaintBgdHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addRepaintHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						'Halo-FontSize')
  	(addFontStyleHandle:		center		bottom			(lightRed)						'Halo-FontStyle')
  	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				'Halo-FontEmph')
  	(addRotateHandle:		left			bottom			(blue)							'Halo-Rot')
  
  	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		'Halo-Debug')
  	(addPoohHandle:			right		center			(white)							'Halo-Pooh')
  
  
  			)
  
  	"  Other useful handles...
  
    		selector				horiz		vert			color info						icon key
  		---------				------		-----------		-------------------------------		---------------
  
  	(addTileHandle:			left			bottomCenter	(lightBrown)					'Halo-Tile')
  	(addViewHandle:			left			center			(cyan)							'Halo-View')
  	(addGrabHandle:			center		top				(black)							'Halo-Grab')
  	(addDragHandle:			rightCenter	top				(brown)							'Halo-Drag')
  	(addDupHandle:			right		top				(green)							'Halo-Dup')	
  	(addHelpHandle:			center		bottom			(lightBlue)						'Halo-Help')
  	(addFewerHandlesHandle:	left		topCenter		(paleBuff)						'Halo-FewerHandles')
  	(addPaintBgdHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addRepaintHandle:		right		center			(lightGray)						'Halo-Paint')
  	"
  !

Item was changed:
+ ----- Method: Preferences class>>customHalosInForce (in category 'prefs - halos') -----
- ----- Method: Preferences class>>customHalosInForce (in category 'halos') -----
  customHalosInForce
  	^ (self preferenceAt: #haloTheme) preferenceValue == #customHaloSpecs!

Item was changed:
+ ----- Method: Preferences class>>darkenStandardWindowPreferences (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>darkenStandardWindowPreferences (in category 'window colors') -----
  darkenStandardWindowPreferences
  	"Make all window-color preferences one shade darker"
  
+ 	(self allPreferences 
- 	(self allPreferenceObjects 
  		select: [:aPref | (aPref name endsWith: 'WindowColor')
  								and: [aPref preferenceValue isColor]])
  		do: [:aPref | aPref preferenceValue: aPref preferenceValue darker].
  
  "Preferences darkenStandardWindowPreferences"
  !

Item was changed:
+ ----- Method: Preferences class>>debugMenuItemsInvokableFromScripts (in category 'prefs - misc') -----
- ----- Method: Preferences class>>debugMenuItemsInvokableFromScripts (in category 'hard-coded prefs') -----
  debugMenuItemsInvokableFromScripts
  	"If true, then items occurring in an object's debug menu will be included in the alternatives offered as arguments to a doMenuItem: tile in the scripting system"
  	^ false!

Item was added:
+ ----- Method: Preferences class>>defaultAnnotationInfo (in category 'prefs - annotations') -----
+ defaultAnnotationInfo
+ 
+ 	^ #(timeStamp messageCategory implementorsCount allChangeSets)!

Item was changed:
+ ----- Method: Preferences class>>defaultAnnotationRequests (in category 'prefs - annotations') -----
- ----- Method: Preferences class>>defaultAnnotationRequests (in category 'parameters') -----
  defaultAnnotationRequests
  	^ Parameters at: #MethodAnnotations ifAbsent:
  		[self setDefaultAnnotationInfo]
  	"Preferences annotationInfo"!

Item was changed:
+ ----- Method: Preferences class>>defaultAnnotationRequests: (in category 'prefs - annotations') -----
- ----- Method: Preferences class>>defaultAnnotationRequests: (in category 'parameters') -----
  defaultAnnotationRequests: newList
  	^ Parameters at: #MethodAnnotations put: newList!

Item was changed:
+ ----- Method: Preferences class>>defaultAuthorName (in category 'prefs - misc') -----
- ----- Method: Preferences class>>defaultAuthorName (in category 'parameters') -----
  defaultAuthorName
  	"Answer the author name to be planted, by default, in a changeset-preamble template.  You can hard-code this to hold your name, thus saving you time when writing the preambles of subsequent changesets"
  
  	^ Utilities authorName!

Item was changed:
+ ----- Method: Preferences class>>defaultPaintingExtent (in category 'prefs - misc') -----
- ----- Method: Preferences class>>defaultPaintingExtent (in category 'parameters') -----
  defaultPaintingExtent
  	"Answer the preferred size for the onion-skin paint area when launching a new painting within a paste-up morph.  Feel free to change the parameters to suit your configuration."
  
  	^ 800 @ 600!

Item was changed:
+ ----- Method: Preferences class>>defaultValueTableForCurrentRelease (in category 'defaults') -----
- ----- Method: Preferences class>>defaultValueTableForCurrentRelease (in category 'misc') -----
  defaultValueTableForCurrentRelease
  	"Answer a table defining default values for all the preferences in the release.  Returns a list of (pref-symbol, boolean-symbol) pairs"
  
  	^  #(
  		(abbreviatedBrowserButtons false)
  		(alternativeBrowseIt false)
  		(annotationPanes false)
  		(areaFillsAreTolerant false)
  		(areaFillsAreVeryTolerant false)
  		(automaticFlapLayout true)
  		(automaticKeyGeneration false)
  		(automaticPlatformSettings true)
  		(automaticViewerPlacement true)
  		(balloonHelpEnabled true)
  		(balloonHelpInMessageLists false)
  		(batchPenTrails false)
  		(capitalizedReferences true)
  		(caseSensitiveFinds false)
  		(cautionBeforeClosing false)
  		(changeSetVersionNumbers true)
  		(checkForSlips true)
  		(checkForUnsavedProjects true)
  		(classicNavigatorEnabled false)
  		(cmdDotEnabled true)
  		(collapseWindowsInPlace false)
  		(compactViewerFlaps false)
  		(compressFlashImages false)
  		(confirmFirstUseOfStyle true)
  		(conversionMethodsAtFileOut false)
  		(debugHaloHandle true)
  		(debugPrintSpaceLog false)
  		(debugShowDamage false)
  		(decorateBrowserButtons true)
  		(diffsInChangeList true)
  		(diffsWithPrettyPrint false)
  		(dismissAllOnOptionClose false)
  		(dragNDropWithAnimation false)
  		(eToyFriendly false)
  		(eToyLoginEnabled false)
  		(enableLocalSave true)
  		(extractFlashInHighQuality true)
  		(extractFlashInHighestQuality false)
  		(fastDragWindowForMorphic true)
  		(fenceEnabled true)
  		(fullScreenLeavesDeskMargins true)
  		(haloTransitions false)
  		(higherPerformance false)
  		(honorDesktopCmdKeys true)
  		(includeSoundControlInNavigator false)
  		(infiniteUndo false)
  		(logDebuggerStackToFile true)
  		(magicHalos false)
  		(menuButtonInToolPane false)
  		(menuColorFromWorld false)
  		(menuKeyboardControl false)  
  		(modalColorPickers true)
  		(mouseOverForKeyboardFocus false)
  		(mouseOverHalos false)
  		(mvcProjectsAllowed true)
  		(navigatorOnLeftEdge true)
  		(noviceMode false)
  		(okToReinitializeFlaps true)
  		(optionalButtons true)
  		(passwordsOnPublish false)
  		(personalizedWorldMenu true)
  		(postscriptStoredAsEPS false)
  		(projectViewsInWindows true)
  		(projectZoom true)
  		(projectsSentToDisk false)
  		(propertySheetFromHalo false)
  		(readDocumentAtStartup true)
  		(restartAlsoProceeds false)
  		(reverseWindowStagger true)
  		(roundedMenuCorners true)
  		(roundedWindowCorners true)
  		(scrollBarsNarrow false)
  		(scrollBarsOnRight true)
  		(gradientScrollBars true)
  		(securityChecksEnabled false)
  		(selectiveHalos false)
  		(showBoundsInHalo false)
  		(showDirectionForSketches false)
  		(showDirectionHandles false)
  		(showFlapsWhenPublishing false)
  		(showProjectNavigator false)
  		(showSecurityStatus true)
  		(showSharedFlaps true)
  		(signProjectFiles true)
  		(simpleMenus false)
  		(smartUpdating true)
  		(startInUntrustedDirectory false)
  		(systemWindowEmbedOK false)
  		(tileTranslucentDrag true)
  		(timeStampsInMenuTitles true)
  		(turnOffPowerManager false)
  		(twentyFourHourFileStamps true)
  		(typeCheckingInTileScripting true)
  		(uniTilesClassic true)
  		(uniqueNamesInHalos false)
  		(universalTiles false)
  		(unlimitedPaintArea false)
  		(useButtonPropertiesToFire false)
  		(useUndo true)
  		(viewersInFlaps true)
  		(warnAboutInsecureContent true)
  		(warnIfNoChangesFile true)
  		(warnIfNoSourcesFile true))
  
  
  "
  Preferences defaultValueTableForCurrentRelease do:
  	[:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo:
  			[:pref | pref defaultValue: (pair last == true)]].
  Preferences chooseInitialSettings.
  "!

Item was changed:
+ ----- Method: Preferences class>>defaultWorldColor (in category 'prefs - misc') -----
- ----- Method: Preferences class>>defaultWorldColor (in category 'menu parameters') -----
  defaultWorldColor
  	^ Parameters
  		at: #defaultWorldColor
  		ifAbsent: [ Color r: 0.937 g: 0.937 b: 0.937 ].
  !

Item was changed:
+ ----- Method: Preferences class>>desktopColor (in category 'prefs - misc') -----
- ----- Method: Preferences class>>desktopColor (in category 'parameters') -----
  desktopColor
  	"Answer the desktop color. Initialize it if necessary."
  	
  	DesktopColor == nil ifTrue: [DesktopColor := Color gray].
  	^ DesktopColor
  !

Item was changed:
+ ----- Method: Preferences class>>desktopColor: (in category 'prefs - misc') -----
- ----- Method: Preferences class>>desktopColor: (in category 'parameters') -----
  desktopColor: aColor
  	"Record a new desktop color preference."
  
  	DesktopColor := aColor.
  !

Item was changed:
+ ----- Method: Preferences class>>desktopMenuTitle (in category 'prefs - misc') -----
- ----- Method: Preferences class>>desktopMenuTitle (in category 'hard-coded prefs') -----
  desktopMenuTitle
  	"Answer the title to be used for the 'meta menu'.  For now, you can hard-code this, later someone should make this be a parameter the user can easily change.  sw 9/6/2000"
  
  	^ 'World'    "This is what it has always been"
  
  	"^ 'Desktop'
  	^ 'Squeak'
  	^ 'Mike''s Control Panel'"!

Item was changed:
+ ----- Method: Preferences class>>disable: (in category 'get/set - flags') -----
- ----- Method: Preferences class>>disable: (in category 'get/set') -----
  disable: aSymbol
  	"Shorthand access to enabling a preference of the given name.  If there is none in the image, conjure one up"
  
+ 	^ self setFlag: aSymbol toValue: false!
- 	| aPreference |
- 	aPreference := self preferenceAt: aSymbol ifAbsent:
- 		[self addPreference: aSymbol category: 'unclassified' default: false balloonHelp: 'this preference was added idiosyncratically and has no help message.'.
- 		self preferenceAt: aSymbol].
- 	aPreference preferenceValue: false!

Item was removed:
- ----- Method: Preferences class>>disableGently: (in category 'get/set') -----
- disableGently: preferenceNameSymbol
- 	"Unlike #disable:, this on does not reset the CategoryInfo cache"
- 	self setPreference: preferenceNameSymbol toValue: false!

Item was changed:
+ ----- Method: Preferences class>>disableProgrammerFacilities (in category 'initialization - misc') -----
- ----- Method: Preferences class>>disableProgrammerFacilities (in category 'personalization') -----
  disableProgrammerFacilities
  	"Warning: do not call this lightly!!  It disables all access to menus, debuggers, halos.  There is no guaranteed return from this, which is to say, you cannot necessarily reenable these things once they are disabled -- you can only use whatever the UI of the current project affords, and you cannot even snapshot -- you can only quit. 
  
       You can completely reverse the work of this method by calling the dual Preferences method enableProgrammerFacilities, provided you have left yourself leeway to bring about a call to that method.
  
  	To set up a system that will come up in such a state, you have to request the snapshot in the same breath as you disable the programmer facilities.  To do this, put the following line into the 'do' menu and then evaluate it from that 'do' menu:
  
           Preferences disableProgrammerFacilities.
  
  You will be prompted for a new image name under which to save the resulting image."
  
  	Beeper beep.
  	(self 
  		confirm: 'CAUTION!!!!
  This is a drastic step!!
  Do you really want to do this?') 
  			ifFalse: 
  				[Beeper beep.
  				^self inform: 'whew!!'].
  	self disable: #cmdDotEnabled.	"No user-interrupt-into-debugger"
+ 	self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: false.	"No halos, etc."
+ 	self compileAccessorForPreferenceNamed: #cmdKeysInText value: false.	"No user commands invokable via cmd-key combos in text editor"
- 	self compileHardCodedPref: #cmdGesturesEnabled enable: false.	"No halos, etc."
- 	self compileHardCodedPref: #cmdKeysInText enable: false.	"No user commands invokable via cmd-key combos in text editor"
  	self enable: #noviceMode.	"No control-menu"
  	self disable: #warnIfNoSourcesFile.
  	self disable: #warnIfNoChangesFile.
  	Smalltalk saveAs!

Item was changed:
+ ----- Method: Preferences class>>displaySizeChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>displaySizeChanged (in category 'reacting to change') -----
  displaySizeChanged
  	self flag: #todo.
  	"only change font on small-land image"
  	self smallLandFonts.
  	self tinyDisplay
  		ifTrue: [self enable: #scrollBarsNarrow]
  		ifFalse: [self disable: #scrollBarsNarrow].
  	self tinyDisplay 
  		ifTrue:[self disable: #biggerHandles] 
  		ifFalse:[self enable: #biggerHandles]!

Item was changed:
  ----- Method: Preferences class>>doesNotUnderstand: (in category 'get/set') -----
  doesNotUnderstand: aMessage
+ 	"Interpret unary message selectors as preference id."
+ 	
+ 	^ aMessage arguments size > 0
+ 		ifTrue: [super doesNotUnderstand: aMessage]
+ 		ifFalse: [self valueOfPreference: aMessage selector]!
- 	"Look up the message selector as a flag."
- 	aMessage arguments size > 0 ifTrue: [^ super doesNotUnderstand: aMessage].
- 	^ self valueOfFlag: aMessage selector
- !

Item was changed:
+ ----- Method: Preferences class>>eToyFriendlyChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>eToyFriendlyChanged (in category 'reacting to change') -----
  eToyFriendlyChanged
  	"The eToyFriendly preference changed; React"
  	
  	ScriptingSystem customizeForEToyUsers: Preferences eToyFriendly!

Item was changed:
+ ----- Method: Preferences class>>editAnnotations (in category 'support - misc') -----
- ----- Method: Preferences class>>editAnnotations (in category 'parameters') -----
  editAnnotations
  	"Put up a window that allows the user to edit annotation specifications"
  
  	| aWindow |
  	self currentWorld addMorphCentered: (aWindow := self annotationEditingWindow).
  	aWindow activateAndForceLabelToShow
  
  	"Preferences editAnnotations"
  
  !

Item was changed:
+ ----- Method: Preferences class>>editCustomHalos (in category 'prefs - halos') -----
- ----- Method: Preferences class>>editCustomHalos (in category 'halos') -----
  editCustomHalos
  
  	ToolSet browse: Preferences class
  		selector: #customHaloSpecs!

Item was changed:
+ ----- Method: Preferences class>>enable: (in category 'get/set - flags') -----
- ----- Method: Preferences class>>enable: (in category 'get/set') -----
  enable: aSymbol
  	"Shorthand access to enabling a preference of the given name.  If there is none in the image, conjure one up"
  
+ 	^ self setFlag: aSymbol toValue: true!
- 	| aPreference |
- 	aPreference := self preferenceAt: aSymbol ifAbsent:
- 		[self addPreference: aSymbol category: 'unclassified' default: true balloonHelp: 'this preference was added idiosyncratically and has no help message.'.
- 		self preferenceAt: aSymbol].
- 	aPreference preferenceValue: true!

Item was removed:
- ----- Method: Preferences class>>enableGently: (in category 'get/set') -----
- enableGently: preferenceNameSymbol
- 	"Unlike #enable:, this one does not reset the CategoryInfo cache"
- 	self setPreference: preferenceNameSymbol toValue: true!

Item was removed:
- ----- Method: Preferences class>>enableOrDisable:asPer: (in category 'get/set') -----
- enableOrDisable: preferenceNameSymbol asPer: aBoolean
- 	"either enable or disable the given Preference, depending on the value of aBoolean"
- 
- 	aBoolean ifTrue: [self enable: preferenceNameSymbol] ifFalse: [self disable: preferenceNameSymbol]!

Item was changed:
+ ----- Method: Preferences class>>enableProgrammerFacilities (in category 'initialization - misc') -----
- ----- Method: Preferences class>>enableProgrammerFacilities (in category 'personalization') -----
  enableProgrammerFacilities
  	"Meant as a one-touch recovery from a #disableProgrammerFacilities call."
  	"Preferences enableProgrammerFacilities"
  
  	self enable: #cmdDotEnabled.
+ 	self compileAccessorForPreferenceNamed: #cmdGesturesEnabled value: true. 
+ 	self compileAccessorForPreferenceNamed: #cmdKeysInText value: true.
- 	self compileHardCodedPref: #cmdGesturesEnabled enable: true. 
- 	self compileHardCodedPref: #cmdKeysInText enable: true.
  	self disable: #noviceMode.
  	self enable: #warnIfNoSourcesFile.
  	self enable: #warnIfNoChangesFile.!

Item was changed:
+ ----- Method: Preferences class>>enableProjectNavigator (in category 'prefs - misc') -----
- ----- Method: Preferences class>>enableProjectNavigator (in category 'get/set') -----
  enableProjectNavigator
  	"Answer whether the project-navigator menu item should be enabled"
  
  	^ true!

Item was changed:
+ ----- Method: Preferences class>>fileReaderServicesForFile:suffix: (in category 'support - file list services') -----
- ----- Method: Preferences class>>fileReaderServicesForFile:suffix: (in category 'file list services') -----
  fileReaderServicesForFile: fullName suffix: suffix 
  	^(suffix = 'prefs')  | (suffix = '*') 
  		ifTrue: [ self services ]
  		ifFalse: [ #() ]!

Item was changed:
+ ----- Method: Preferences class>>fontConfigurationMenu (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>fontConfigurationMenu (in category 'fonts') -----
  fontConfigurationMenu
  	| aMenu |
  	aMenu := MenuMorph new defaultTarget: Preferences.
  	^self fontConfigurationMenu: aMenu.
  	
  	
  	!

Item was changed:
+ ----- Method: Preferences class>>fontConfigurationMenu: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>fontConfigurationMenu: (in category 'fonts') -----
  fontConfigurationMenu: aMenu
  
  	aMenu removeAllMorphs.
  	aMenu addTitle: 'Standard System Fonts' translated.
  	aMenu addStayUpIcons.
  	
  	aMenu add: 'default text font...' translated action: #chooseSystemFont.
  	aMenu lastItem font: Preferences standardDefaultTextFont.
  	aMenu balloonTextForLastItem: 'Choose the default font to be used for code and  in workspaces, transcripts, etc.' translated.
  	
  	
  	aMenu add: 'list font...' translated action: #chooseListFont.
  	aMenu lastItem font: Preferences standardListFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used in list panes' translated.
  	
  	aMenu add: 'flaps font...' translated action: #chooseFlapsFont.
  	aMenu lastItem font: Preferences standardFlapFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used on textual flap tabs' translated.
  
  	aMenu add: 'eToys font...' translated action: #chooseEToysFont.
  	aMenu lastItem font: Preferences standardEToysFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used on eToys environment' translated.
  
  	aMenu add: 'eToys title font...' translated action: #chooseEToysTitleFont.
  	aMenu lastItem font: Preferences standardEToysTitleFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used in titles on eToys environment' translated.
  
  	aMenu add: 'halo label font...' translated action: #chooseHaloLabelFont.
  	aMenu lastItem font: Preferences standardHaloLabelFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used on labels ih halo' translated.
  
  	aMenu add: 'menu font...' translated action: #chooseMenuFont.
  	aMenu lastItem font: Preferences standardMenuFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used in menus' translated.
  	
  	aMenu add: 'window-title font...' translated action: #chooseWindowTitleFont.
  	aMenu lastItem font: Preferences windowTitleFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used in window titles.' translated.
  
  	aMenu add: 'balloon-help font...' translated action: #chooseBalloonHelpFont.
  	aMenu lastItem font: Preferences standardBalloonHelpFont.
  	aMenu balloonTextForLastItem: 'choose the font to be used when presenting balloon help.' translated.
  	
  	aMenu add: 'code font...' translated action: #chooseCodeFont. 
  	aMenu lastItem font: Preferences standardCodeFont. 
  	aMenu balloonTextForLastItem: 'Choose the font to be used in code panes.' translated.
  
  	aMenu add: 'button font...' translated action: #chooseStandardButtonFont.
  	aMenu lastItem font: Preferences standardButtonFont.
  	aMenu balloonTextForLastItem: 'Choose the font to be used in buttons.' translated.
  
  	aMenu addLine.
  	aMenu add: 'demo mode' translated action: #setDemoFonts.
  	aMenu balloonTextForLastItem: 'Set Fonts usable for giving a presentation' translated.
  
  	aMenu addLine.
  	aMenu add: 'restore default font choices' translated action: #restoreDefaultFonts.
  	aMenu balloonTextForLastItem: 'Use the standard system font defaults' translated.
  	
  	aMenu add: 'print default font choices' translated action: #printStandardSystemFonts.
  	aMenu balloonTextForLastItem: 'Print the standard system font defaults to the Transcript' translated.
  	
  	aMenu addLine.
  	aMenu add: 'refresh this menu' translated target: self selector: #fontConfigurationMenu:  argument: aMenu.
  	aMenu balloonTextForLastItem: 'Update this menu to reflect the current fonts' translated.
  	MenuIcons decorateMenu: aMenu.
  	^ aMenu!

Item was removed:
- ----- Method: Preferences class>>fontFactor (in category 'scrollbar parameters') -----
- fontFactor
- 	"answer the convertion factor for resizing element based on font  
- 	size"
- 	| factor |
- 	factor := TextStyle defaultFont height / 12.0.
- 	^ factor > 1.0
- 		ifTrue: [1 + (factor - 1.0 * 0.5)]
- 		ifFalse: [factor]!

Item was changed:
+ ----- Method: Preferences class>>giveHelpWithPreferences (in category 'support') -----
- ----- Method: Preferences class>>giveHelpWithPreferences (in category 'misc') -----
  giveHelpWithPreferences
  	"Open up a workspace with explanatory info in it about Preferences"
  
  	| aString |
  	aString := String streamContents: [:aStream | 
  		aStream nextPutAll:
  
  'Many aspects of the system are governed by the settings of various "Preferences".  
  
  Click on any of brown tabs at the top of the panel to see all the preferences in that category.  
  Or type in to the box above the Search button, then hit Search, and all Preferences matching whatever you typed in will appear in the "search results" category.  A preference is considered to match your search if either its name matches the characters *or* if anything in the balloon help provided for the preferences matches the search text.
  
  To find out more about any particular Preference, hold the mouse over it for a moment and balloon help will appear.  Also, a complete list of all the Preferences, with documentation for each, is included below.
  
  Preferences whose names are in shown in bold in the Preferences Panel are designated as being allowed to vary from project to project; those whose name are not in bold are "global", which is to say, they apply equally whatever project you are in.
  
  Click on the name of any preference to get a menu which allows you to *change* whether the preference should vary from project to project or should be global, and also allows you to browse all the senders of the preference, and to discover all the categories under which the preference has been classified, and to be handed a button that you can drop wherever you please that will control the preference.
  
  If you like all your current Preferences settings, you may wish to hit the "Save Current Settings as my Personal Preferences" button.  Once you have done that, you can at any point in the future hit "Restore my Personal Preferences" and all your saved settings will get restored immediately.
  
  Also, you can use "themes" to set multiple preferences all at once; click on the "change theme..." button in the Squeak flap or in the Preferences panel, or seek out the themes item in the Appearance menu.' translated.
  
  	aStream cr; cr; nextPutAll: '-----------------------------------------------------------------';
  		cr; cr; nextPutAll:  'Alphabetical listing of all Preferences' translated; cr; cr.
+    (Preferences allPreferences asSortedCollection: [:a :b | a name < b name]) do:
-    (Preferences allPreferenceObjects asSortedCollection: [:a :b | a name < b name]) do:
  	[:pref | | aHelpString |
  		aStream nextPutAll: pref name; cr.
  		aHelpString := pref helpString translated.
  		(aHelpString beginsWith: pref name) ifTrue:
  			[aHelpString := aHelpString copyFrom: (pref name size ) to: aHelpString size].
  		aHelpString := (aHelpString copyReplaceAll: String cr with: ' ')  copyWithout: Character tab.
  		aStream nextPutAll: aHelpString capitalized.
  		(aHelpString isEmpty or: [aHelpString last == $.]) ifFalse: [aStream nextPut: $.].
          aStream cr; cr]].
  
  	UIManager default edit: aString label: 'About Preferences' translated
  
  "Preferences giveHelpWithPreferences"!

Item was changed:
+ ----- Method: Preferences class>>haloSpecifications (in category 'prefs - halos') -----
- ----- Method: Preferences class>>haloSpecifications (in category 'halos') -----
  haloSpecifications
  	"Answer a list of HaloSpecs that describe which halos are to be used, what they should look like, and where they should be situated"
  
  	^ Parameters at: #HaloSpecs ifAbsent:
  			[self installHaloTheme: #iconicHaloSpecifications.
  			^ Parameters at: #HaloSpecs]
  
  	"Preferences haloSpecifications"
  	"Preferences resetHaloSpecifications"
  !

Item was changed:
+ ----- Method: Preferences class>>haloSpecificationsForWorld (in category 'prefs - halos') -----
- ----- Method: Preferences class>>haloSpecificationsForWorld (in category 'halos') -----
  haloSpecificationsForWorld
  	| desired |
  	"Answer a list of HaloSpecs that describe which halos are to be used on a world halo, what they should look like, and where they should be situated"
  	"Preferences resetHaloSpecifications"
  
  	desired := #(addDebugHandle: addMenuHandle: addTileHandle: addViewHandle: addHelpHandle: addScriptHandle: addPaintBgdHandle: addRecolorHandle:).
  	^ self haloSpecifications select:
  		[:spec | desired includes: spec addHandleSelector]!

Item was changed:
+ ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') -----
- ----- Method: Preferences class>>haloTheme (in category 'halos') -----
  haloTheme
  	^ self
  		valueOfFlag: #haloTheme
  		ifAbsent: [ #iconicHaloSpecifications ]!

Item was changed:
+ ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') -----
- ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') -----
  iconicHaloSpecifications
  	"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
  
  	"Preferences resetHaloSpecifications"
  
  	^ #(
  	"  	selector				horiz		vert			color info						icon key
  		---------				------		-----------		-------------------------------		---------------"
  	(addCollapseHandle:		left			topCenter		(tan)							'Halo-Collapse')
  	(addPoohHandle:			right		center			(white)							'Halo-Pooh')
  	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		'Halo-Debug')
  	(addDismissHandle:		left			top				(red		muchLighter)			'Halo-Dismiss')
  	(addRotateHandle:		left			bottom			(blue)							'Halo-Rot')
  	(addMenuHandle:		leftCenter	top				(red)							'Halo-Menu')
  	(addTileHandle:			left			bottomCenter	(lightBrown)					'Halo-Tile')
  	(addViewHandle:			left			center			(cyan)							'Halo-View')
  	(addGrabHandle:			center		top				(black)							'Halo-Grab')
  	(addDragHandle:			rightCenter	top				(brown)							'Halo-Drag')
  	(addDupHandle:			right		top				(green)							'Halo-Dup')	
  	(addMakeSiblingHandle:	right		top				(green muchDarker)				'Halo-Dup')	
  	(addHelpHandle:			center		bottom			(lightBlue)						'Halo-Help')
  	(addGrowHandle:		right		bottom			(yellow)						'Halo-Scale')
  	(addScaleHandle:		right		bottom			(lightOrange)					'Halo-Scale')
  	(addScriptHandle:		rightCenter	bottom			(green muchLighter)			'Halo-Script')
  	(addPaintBgdHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addViewingHandle:		leftCenter	bottom			(lightGreen lighter)				'Halo-View')
  	(addRepaintHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						'Halo-FontSize')
  	(addFontStyleHandle:		center		bottom			(lightRed)						'Halo-FontStyle')
  	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				'Halo-FontEmph')
  	(addRecolorHandle:		right		bottomCenter	(magenta darker)				'Halo-Recolor')
  	(addChooseGraphicHandle:	right	bottomCenter	(green muchLighter)			'Halo-ChooseGraphic')
  		) !

Item was changed:
+ ----- Method: Preferences class>>iconicHalosInForce (in category 'prefs - halos') -----
- ----- Method: Preferences class>>iconicHalosInForce (in category 'halos') -----
  iconicHalosInForce
  	^ (self preferenceAt: #haloTheme) preferenceValue == #iconicHaloSpecifications!

Item was changed:
+ ----- Method: Preferences class>>infiniteUndoChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>infiniteUndoChanged (in category 'reacting to change') -----
  infiniteUndoChanged
  	"The infiniteUndo preference changed; react"
  	
  	self infiniteUndo ifFalse:
  		[CommandHistory resetAllHistory]!

Item was changed:
+ ----- Method: Preferences class>>initialExtent (in category 'support - misc') -----
- ----- Method: Preferences class>>initialExtent (in category 'preferences panel') -----
  initialExtent
  	^ Smalltalk isMorphic ifFalse: [219 @ 309] ifTrue: [232 @ 309]!

Item was changed:
+ ----- Method: Preferences class>>initializeTextHighlightingParameters (in category 'prefs - text') -----
- ----- Method: Preferences class>>initializeTextHighlightingParameters (in category 'text highlighting') -----
  initializeTextHighlightingParameters
  	"Preferences initializeTextHighlightingParameters"
  
  	self
  		caretWidth: 2;
  		insertionPointColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.8);
  		textHighlightColor: (TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2)!

Item was removed:
- ----- Method: Preferences class>>inlineServicesInMenu (in category 'standard queries') -----
- inlineServicesInMenu
- 	^ self
- 		valueOfFlag: #inlineServicesInMenu
- 		ifAbsent: [ true ]!

Item was changed:
+ ----- Method: Preferences class>>insertionPointColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>insertionPointColor (in category 'text highlighting') -----
  insertionPointColor
  	^ Parameters at: #insertionPointColor!

Item was changed:
+ ----- Method: Preferences class>>insertionPointColor: (in category 'prefs - text') -----
- ----- Method: Preferences class>>insertionPointColor: (in category 'text highlighting') -----
  insertionPointColor: aColor
  	Parameters at: #insertionPointColor put: aColor!

Item was changed:
+ ----- Method: Preferences class>>inspectPreferences (in category 'support - misc') -----
- ----- Method: Preferences class>>inspectPreferences (in category 'preferences panel') -----
  inspectPreferences
  	"Open a window on the current preferences dictionary, allowing the user to inspect and change the current preference settings.  This is fallen back upon if Morphic is not present. This is dangerous, the dictionary of preferences should not be accessed concurrently."
  
  	"Preferences inspectPreferences"
  
  	preferencesDictionary inspectWithLabel: 'Preferences'!

Item was changed:
+ ----- Method: Preferences class>>installBrightWindowColors (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>installBrightWindowColors (in category 'window colors') -----
  installBrightWindowColors
  	"Install the factory-provided default window colors for all tools"
  
  	"Preferences installBrightWindowColors"
  
  	self installWindowColorsVia: [:aSpec | aSpec brightColor]!

Item was changed:
+ ----- Method: Preferences class>>installClassicHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installClassicHaloSpecs (in category 'halos') -----
  installClassicHaloSpecs
  	"Install an alternative set of halos,  rather more based on the old placements, and without icons, , and lacking the scripting-relating handles.."
  	"Preferences installClassicHaloSpecs"
  	"Preferences resetHaloSpecifications"  "  <-  will result in the standard default halos being reinstalled"
  	self installHaloTheme: #classicHaloSpecs!

Item was changed:
+ ----- Method: Preferences class>>installCustomHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installCustomHaloSpecs (in category 'halos') -----
  installCustomHaloSpecs
  	"Install an alternative set of halos, as customized by the user"
  	"Preferences installCustomHaloSpecs"
  	self installHaloTheme: #customHaloSpecs!

Item was changed:
+ ----- Method: Preferences class>>installHaloSpecsFromArray: (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installHaloSpecsFromArray: (in category 'halos') -----
  installHaloSpecsFromArray: anArray
  
  	
  	^ Parameters at: #HaloSpecs put: 
  		(anArray collect:
  			[:quin | | aColor |
  				aColor := Color.
  				quin fourth do: [:sel | aColor := aColor perform: sel].
  				HaloSpec new 
  					horizontalPlacement: quin second
  					verticalPlacement: quin third 
  					color: aColor
  					iconSymbol: quin fifth
  					addHandleSelector: quin first])!

Item was changed:
+ ----- Method: Preferences class>>installHaloTheme: (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installHaloTheme: (in category 'halos') -----
  installHaloTheme: themeSymbol
  	self installHaloSpecsFromArray: (self perform: themeSymbol).
  	(self preferenceAt: #haloTheme) preferenceValue: themeSymbol.
  	!

Item was changed:
+ ----- Method: Preferences class>>installIconicHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installIconicHaloSpecs (in category 'halos') -----
  installIconicHaloSpecs
  	"Install an alternative set of halos,  rather more based on the old placements, and without icons, , and lacking the scripting-relating handles.."
  	"Preferences installIconicHaloSpecs"
  	self installHaloTheme: #iconicHaloSpecifications!

Item was changed:
+ ----- Method: Preferences class>>installNormalWindowColors (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>installNormalWindowColors (in category 'window colors') -----
  installNormalWindowColors
  	"Install the factory-provided default window colors for all tools"
  
  	"Preferences installNormalWindowColors"
  
  	self installWindowColorsVia: [:aSpec | aSpec normalColor]!

Item was changed:
+ ----- Method: Preferences class>>installPastelWindowColors (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>installPastelWindowColors (in category 'window colors') -----
  installPastelWindowColors
  	"Install the factory-provided default pastel window colors for all tools"
  
  	"Preferences installPastelWindowColors"
  	self installWindowColorsVia: [:aSpec | aSpec pastelColor]!

Item was changed:
+ ----- Method: Preferences class>>installSimpleHaloSpecs (in category 'prefs - halos') -----
- ----- Method: Preferences class>>installSimpleHaloSpecs (in category 'halos') -----
  installSimpleHaloSpecs
  	"Preferences installSimpleHaloSpecs"
  	self installHaloTheme: #simpleFullHaloSpecifications!

Item was changed:
+ ----- Method: Preferences class>>installTheme: (in category 'themes - tools') -----
- ----- Method: Preferences class>>installTheme: (in category 'misc') -----
  installTheme: aSymbol
  	"Install the theme represented by aSymbol.  The code that makes the theme-specific changes is lodged in a method of the same name as aSymbol, which must reside in category #themes in Preferences class"
  
  	self perform: aSymbol.
  	self inform: ('Theme {1} is now installed.
  Many of the changes will only be
  noticeable in new windows that you
  create from now on.' translated format: {aSymbol translated}).!

Item was changed:
+ ----- Method: Preferences class>>installUniformWindowColors (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>installUniformWindowColors (in category 'window colors') -----
  installUniformWindowColors
  	"Install the factory-provided uniform window colors for all tools"
  
  	"Preferences installUniformWindowColors"
  	self installWindowColorsVia: [:aQuad | self uniformWindowColor]!

Item was changed:
+ ----- Method: Preferences class>>installWindowColorsVia: (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>installWindowColorsVia: (in category 'window colors') -----
  installWindowColorsVia: colorSpecBlock
  	"Install windows colors using colorSpecBlock to deliver the color source for each element; the block is handed a WindowColorSpec object"
  	"Preferences installBrightWindowColors"
  	
  	WindowColorRegistry refresh.
  	self windowColorTable do:
  		[:aColorSpec | | color |
  			color := (Color colorFrom: (colorSpecBlock value: aColorSpec)).
  			self setWindowColorFor: aColorSpec classSymbol to: color].
  	SystemWindow refreshAllWindows.
  	TheWorldMainDockingBar updateInstances.!

Item was changed:
+ ----- Method: Preferences class>>keyboardFocusColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>keyboardFocusColor (in category 'text highlighting') -----
  keyboardFocusColor
  	"Answer the keyboard focus color, initializing it if necessary"
  
  	^ Parameters at: #keyboardFocusColor ifAbsentPut: [Color lightGray]
  
  "
  Parameters removeKey: #keyboardFocusColor.
  Preferences keyboardFocusColor
  "!

Item was changed:
+ ----- Method: Preferences class>>keyboardFocusColor: (in category 'prefs - text') -----
- ----- Method: Preferences class>>keyboardFocusColor: (in category 'text highlighting') -----
  keyboardFocusColor: aColor
  	"Set the keyboard focus color"
  
  	Parameters at: #keyboardFocusColor put: aColor!

Item was changed:
+ ----- Method: Preferences class>>largeTilesSettingToggled (in category 'updating - system') -----
- ----- Method: Preferences class>>largeTilesSettingToggled (in category 'reacting to change') -----
  largeTilesSettingToggled
  	"The current value of the largeTiles flag has changed; now react"
  
  	Smalltalk isMorphic ifTrue:
  		[Preferences universalTiles
  			ifFalse:
  				[self inform: 
  'note that this will only have a noticeable
  effect if the universalTiles preference is
  set to true, which it currently is not' translated]
  			ifTrue:
  				[World recreateScripts]]!

Item was changed:
+ ----- Method: Preferences class>>letUserPersonalizeMenu (in category 'support - misc') -----
- ----- Method: Preferences class>>letUserPersonalizeMenu (in category 'personalization') -----
  letUserPersonalizeMenu
  	"Invoked from menu, opens up a single-msg browser on the message that user is invited to customize for rapid morphic access via option-click on morphic desktop"
  
  	ToolSet browse: Preferences class 
  		selector: #personalizeUserMenu:!

Item was changed:
+ ----- Method: Preferences class>>lightenStandardWindowPreferences (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>lightenStandardWindowPreferences (in category 'window colors') -----
  lightenStandardWindowPreferences
  	"Make all window-color preferences one shade darker"
  
+ 		(self allPreferences 
- 		(self allPreferenceObjects 
  		select: [:aPref | (aPref name endsWith: 'WindowColor')
  								and: [aPref preferenceValue isColor]])
  		do: [:aPref | aPref preferenceValue: aPref preferenceValue lighter].
  
  "Preferences lightenStandardWindowPreferences"
  !

Item was removed:
- ----- Method: Preferences class>>listOfCategories (in category 'preferences panel') -----
- listOfCategories
- 	"Answer a list of category names for the preferences panel"
- 	^ {#?}, self categoryNames asSortedArray, {#'search results'}
- 
- 	"Preferences listOfCategories"
- !

Item was changed:
+ ----- Method: Preferences class>>loadPreferencesFrom: (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>loadPreferencesFrom: (in category 'personalization') -----
  loadPreferencesFrom: aFile
  	| stream params dict desktopColor |
  	stream := ReferenceStream fileNamed: aFile.
  	params := stream next.
  	self assert: (params isKindOf: IdentityDictionary).
  	params removeKey: #PersonalDictionaryOfPreferences.
  	dict := stream next.
  	self assert: (dict isKindOf: IdentityDictionary).
  	desktopColor := stream next.
  	stream close.
  	dict keysAndValuesDo:
  		[:key :value | (self preferenceAt: key ifAbsent: [nil]) ifNotNil:
  			[:pref | pref preferenceValue: value preferenceValue]].
  
  	params keysAndValuesDo: [ :key :value | self setParameter: key to: value ].
  
  	Smalltalk isMorphic
  		ifTrue: [ World fillStyle: desktopColor ]
  		ifFalse: [ self desktopColor: desktopColor. ScheduledControllers updateGray ].
  !

Item was changed:
+ ----- Method: Preferences class>>localeChanged (in category 'updating') -----
- ----- Method: Preferences class>>localeChanged (in category 'initialization') -----
  localeChanged
  	LocaleID current isoLanguage = 'ja'
  		ifTrue: [Preferences enable: #useFormsInPaintBox]
  		ifFalse: [Preferences disable: #useFormsInPaintBox]!

Item was changed:
+ ----- Method: Preferences class>>maxBalloonHelpLineLength (in category 'prefs - misc') -----
- ----- Method: Preferences class>>maxBalloonHelpLineLength (in category 'parameters') -----
  maxBalloonHelpLineLength
  	^ Parameters at: #maxBalloonHelpLineLength!

Item was changed:
+ ----- Method: Preferences class>>menuBorderColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuBorderColor (in category 'menu parameters') -----
  menuBorderColor
  	Display depth <= 2 ifTrue: [^ Color black].
  	^ Parameters at: #menuBorderColor!

Item was changed:
+ ----- Method: Preferences class>>menuBorderWidth (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuBorderWidth (in category 'menu parameters') -----
  menuBorderWidth
  	^ Parameters at: #menuBorderWidth!

Item was changed:
+ ----- Method: Preferences class>>menuColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuColor (in category 'menu parameters') -----
  menuColor
  	Display depth <= 2 ifTrue: [^ Color white].
  	^ Parameters at: #menuColor!

Item was changed:
+ ----- Method: Preferences class>>menuColorString (in category 'support - misc') -----
- ----- Method: Preferences class>>menuColorString (in category 'misc') -----
  menuColorString
  	^ ((self valueOfFlag: #menuColorFromWorld)
  		ifTrue: ['stop menu-color-from-world']
  		ifFalse: ['start menu-color-from-world']) translated!

Item was changed:
+ ----- Method: Preferences class>>menuLineColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuLineColor (in category 'menu parameters') -----
  menuLineColor
  	^ Parameters
  		at: #menuLineColor
  		ifAbsentPut: [Preferences menuBorderColor lighter]!

Item was changed:
+ ----- Method: Preferences class>>menuSelectionColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuSelectionColor (in category 'menu parameters') -----
  menuSelectionColor
  	^ Parameters
  		at: #menuSelectionColor
  		ifAbsent: [nil]!

Item was changed:
+ ----- Method: Preferences class>>menuTitleBorderColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuTitleBorderColor (in category 'menu parameters') -----
  menuTitleBorderColor
  	Display depth <= 2 ifTrue: [^ Color black].
  	^ Parameters at: #menuTitleBorderColor!

Item was changed:
+ ----- Method: Preferences class>>menuTitleBorderWidth (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuTitleBorderWidth (in category 'menu parameters') -----
  menuTitleBorderWidth
  	^ Parameters at: #menuTitleBorderWidth!

Item was changed:
+ ----- Method: Preferences class>>menuTitleColor (in category 'prefs - menus') -----
- ----- Method: Preferences class>>menuTitleColor (in category 'menu parameters') -----
  menuTitleColor
  	Display depth = 1 ifTrue: [^ Color white].
  	Display depth = 2 ifTrue: [^ Color gray].
  	^ Parameters at: #menuTitleColor!

Item was changed:
+ ----- Method: Preferences class>>messengersInViewers (in category 'prefs - misc') -----
- ----- Method: Preferences class>>messengersInViewers (in category 'hard-coded prefs') -----
  messengersInViewers
  	"A coming technology..."
  
  	^ false!

Item was changed:
+ ----- Method: Preferences class>>metaMenuDisabled (in category 'prefs - misc') -----
- ----- Method: Preferences class>>metaMenuDisabled (in category 'hard-coded prefs') -----
  metaMenuDisabled
  	"If true, then click/cmd-click on the desktop will not bring up the World menu.  Can be changed manually right here, and can be programattically changed via a call of the following form:
  
  	Preferences compileHardCodedPref: #metaMenuDisabled enable: true"
  
  	^ false!

Item was changed:
+ ----- Method: Preferences class>>mouseOverHalosChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>mouseOverHalosChanged (in category 'reacting to change') -----
  mouseOverHalosChanged
  	World wantsMouseOverHalos: self mouseOverHalos!

Item was changed:
+ ----- Method: Preferences class>>navigatorShowingString (in category 'support - misc') -----
- ----- Method: Preferences class>>navigatorShowingString (in category 'get/set') -----
  navigatorShowingString
  	"Answer a string for the show-project-navigator menu item"
  	^ (self showProjectNavigator
  		ifTrue: ['<yes>']
  		ifFalse: ['<no>'])
  		, 'show navigator (N)' translated!

Item was changed:
+ ----- Method: Preferences class>>noviceModeSettingChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>noviceModeSettingChanged (in category 'reacting to change') -----
  noviceModeSettingChanged
  	"The current value of the noviceMode flag has changed;  
  	now react"
  	TheWorldMainDockingBar updateInstances.
  	PasteUpMorph allSubInstances
  		select: [:each | each isWorldMorph]
  		thenDo: [:each | each initializeDesktopCommandKeySelectors].
  	Smalltalk at: #ParagraphEditor ifPresent: [:aClass| aClass initialize]!

Item was changed:
+ ----- Method: Preferences class>>offerThemesMenu (in category 'themes - tools') -----
- ----- Method: Preferences class>>offerThemesMenu (in category 'misc') -----
  offerThemesMenu
  	"Put up a menu offering the user a choice of themes.  Each theme is represented by a method in category #themes in Preferences class.  The comment at the front of each method is used as the balloon help for the theme"
  
  	"Preferences offerThemesMenu"
  	| selectors aMenu |
  	selectors := self class allMethodsInCategory: #themes.
  	selectors := selectors select: [:sel | sel numArgs = 0].
  	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addTitle: 'Choose a theme to install' translated.
  	selectors do:
  		[:sel |
  			aMenu add: sel target: self selector: #installTheme: argument: sel.
  			aMenu balloonTextForLastItem: (self class firstCommentAt: sel)].
  	aMenu addLine.
  	aMenu add: 'browse themes' translated target: self action: #browseThemes.
  	aMenu balloonTextForLastItem: 'Puts up a tool that will allow you to view and edit the code underlying all of the available themes' translated.
  	aMenu popUpInWorld.
  	"(Workspace new contents: 'here is an example of a new window with your new theme installed' translated) openLabel: 'Testing one two three'"!

Item was changed:
+ ----- Method: Preferences class>>okayToChangeProjectLocalnessOf: (in category 'support') -----
- ----- Method: Preferences class>>okayToChangeProjectLocalnessOf: (in category 'misc') -----
  okayToChangeProjectLocalnessOf: prefSymbol
  	"Answer whether it would be okay to allow the user to switch the setting of whether or not the preference symbol is local to a project.  Formerly useful and perhaps again will be, though to be sure this is a non-modular design."
  
  	^ (#() includes: prefSymbol) not!

Item was changed:
+ ----- Method: Preferences class>>optionalButtonsChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>optionalButtonsChanged (in category 'reacting to change') -----
  optionalButtonsChanged
  	"The setting of the optionalButtons preference changed; react.  Formerly, we replaced prototypes in flaps but this is no longer necessary"
  !

Item was changed:
+ ----- Method: Preferences class>>personalizeUserMenu: (in category 'support - misc') -----
- ----- Method: Preferences class>>personalizeUserMenu: (in category 'personalization') -----
  personalizeUserMenu: aMenu
  	"The user has clicked on the morphic desktop with the yellow mouse button (option+click on the Mac); a menu is being constructed to present to the user in response; its default target is the current world.  In this method, you are invited to add items to the menu as per personal preferences.
  	The default implementation, for illustrative purposes, sets the menu title to 'personal', and adds items for go-to-previous-project, show/hide flaps, and load code updates"
  	
  	aMenu addTitle: 'personal' translated.  "Remove or modify this as per personal choice"
  
  	aMenu addStayUpItem.
  	aMenu add: 'previous project' translated action: #goBack.
  	aMenu add: 'load latest code updates' translated target: MCMcmUpdater action: #updateFromServer.
  	aMenu add: 'about this system...' translated target: Smalltalk action: #aboutThisSystem.
  	
  	aMenu addLine.
  				
  	aMenu addUpdating: #suppressFlapsString target: Project current action: #toggleFlapsSuppressed.
  	aMenu balloonTextForLastItem: 'Whether prevailing flaps should be shown in the project right now or not.' translated!

Item was changed:
+ ----- Method: Preferences class>>prefEvent: (in category 'updating') -----
- ----- Method: Preferences class>>prefEvent: (in category 'dynamic preferences') -----
  prefEvent: anEvent
+ 	"Check if this system event defines or removes a preference."
+ 
+ 	| class selector method |
+ 	self flag: #performance. "mt: Maybe defer preference dictionary update?"
+ 
+ 	anEvent itemKind = SystemChangeNotifier classKind ifTrue: [
+ 		anEvent isRemoved ifTrue: [
+ 			self removeAllPreferencesSuchThat: [:pref | 
+ 				pref provider == anEvent item]].
+ 		
+ 		anEvent isRenamed ifTrue: [
+ 			self atomicUpdatePreferences: [ :prefs |
+ 				self allPreferences
+ 					select: [:pref | pref provider == anEvent item]
+ 					thenDo: [:pref | prefs at: pref id put: pref].
+ 				prefs keys
+ 					select: [:id | id beginsWith: anEvent oldName]
+ 					thenDo: [:id | prefs removeKey: id] ] ] ].
+ 	
+ 	anEvent itemKind = SystemChangeNotifier methodKind ifTrue: [
+ 		"ignore instance methods"
+ 		anEvent itemClass isMeta
+ 			ifFalse: [^ self]. 
+ 
+ 		class := anEvent itemClass theNonMetaClass.
+ 		selector := anEvent itemSelector.
+ 		method := anEvent item.
+ 
+ 		anEvent isRemoved ifTrue: [
+ 			self atomicUpdatePreferences: [ :prefs | 
+ 				"See PragmaPreference >> #id."
+ 				prefs removeKey: (class name,'>>', selector) asSymbol ifAbsent: []]].
+ 	
+ 		(anEvent isAdded or: [anEvent isModified]) ifTrue: [
+ 			method pragmas do: [:pragma | self addPragmaPreference: pragma] ] ].!
- 	"Check if this system event defines or removes a preference.
- 	TODO: Queue the event and handle in background process. 
- 	There is zero reason to be so eager here."
- 	| aClass aSelector method |
- 	anEvent itemKind = SystemChangeNotifier classKind ifTrue:
- 		[^anEvent isRemoved ifTrue:
- 			[self removePreferencesFor: anEvent item]].
- 	(anEvent itemKind = SystemChangeNotifier methodKind
- 	and: [(aClass := anEvent itemClass) isMeta]) ifFalse: "ignore instance methods"
- 		[^self].
- 	aClass := aClass theNonMetaClass.
- 	aSelector := anEvent itemSelector.
- 	anEvent isRemoved
- 		ifTrue:
- 			[self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
- 				copyOfDictionaryOfPreferences removeKey: (aClass name,'>>', aSelector) asSymbol ifAbsent: []]]
- 		ifFalse:
- 			[(anEvent isAdded or: [anEvent isModified]) ifTrue:
- 				[method := anEvent item.
- 				 method pragmas do:
- 					[:pragma|
- 					self respondToPreferencePragmasInMethod: method class: aClass]]]!

Item was changed:
+ ----- Method: Preferences class>>preference:category:description:type: (in category 'private') -----
- ----- Method: Preferences class>>preference:category:description:type: (in category 'dynamic preferences') -----
  preference: prefName category: categoryName description: helpString type: typeSymbol
+ 	"Create a preference for a preference pragma in a method."
+ 	
+ 	^ self 
+ 		preference: prefName
- 	"Create a preference for a preference pragma in a method.
- 	 This method gets invoked from respondToPreferencePragmasInMethod:class:"
- 	^self createPreference: prefName
  		categoryList: (categoryName isArray "Alas pragma users are not always careful"
  						ifTrue: [categoryName]
+ 						ifFalse: [{categoryName}])
- 						ifFalse: [{categoryName} asArray])
  		description: helpString
  		type: typeSymbol!

Item was changed:
+ ----- Method: Preferences class>>preference:categoryList:description:type: (in category 'private') -----
- ----- Method: Preferences class>>preference:categoryList:description:type: (in category 'dynamic preferences') -----
  preference: prefName categoryList: categoryList description: helpString type: typeSymbol
+ 	"Create a preference for a preference pragma in a method."
+ 	
+ 	^ PragmaPreference new
+ 		 name: prefName
+ 		 defaultValue: nil	"always nil"
+ 		 helpString: helpString
+ 		 localToProject: false "governed by the method"
+ 		 categoryList: categoryList
+ 		 changeInformee: nil
+ 		 changeSelector: nil
+ 		 type: typeSymbol!
- 	"Create a preference for a preference pragma in a method.
- 	 This method gets invoked from respondToPreferencePragmasInMethod:class:"
- 	^self createPreference: prefName categoryList: categoryList asArray description: helpString type: typeSymbol!

Item was changed:
+ ----- Method: Preferences class>>preferenceAt: (in category 'accessing') -----
- ----- Method: Preferences class>>preferenceAt: (in category 'preference-object access') -----
  preferenceAt: aSymbol 
  	"Answer the Preference object at the given symbol, or nil if not there"
  
  	^self preferenceAt: aSymbol ifAbsent: [ nil ]!

Item was changed:
+ ----- Method: Preferences class>>preferenceAt:ifAbsent: (in category 'accessing') -----
- ----- Method: Preferences class>>preferenceAt:ifAbsent: (in category 'preference-object access') -----
  preferenceAt: aSymbol ifAbsent: aBlock 
  	"Answer the Preference object at the given symbol, or the value of aBlock if not present"
  
  	 ^preferencesDictionary at: aSymbol ifAbsent: aBlock!

Item was removed:
- ----- Method: Preferences class>>preferenceObjectsInCategory: (in category 'preferences panel') -----
- preferenceObjectsInCategory: aCategorySymbol 
- 	"Answer a list of Preference objects that reside in the given category."
- 
- 	^self allPreferenceObjects select: [ :aPreference |
- 		aPreference categoryList includes: aCategorySymbol ]!

Item was added:
+ ----- Method: Preferences class>>preferencesInCategory: (in category 'support') -----
+ preferencesInCategory: aCategorySymbol 
+ 	"Answer a list of Preference objects that reside in the given category."
+ 
+ 	^ self allPreferences select: [ :aPreference |
+ 		aPreference categoryList includes: aCategorySymbol ]!

Item was changed:
+ ----- Method: Preferences class>>preserveCommandExcursions (in category 'prefs - misc') -----
- ----- Method: Preferences class>>preserveCommandExcursions (in category 'hard-coded prefs') -----
  preserveCommandExcursions
  	"An architecture is in place for storing command excursions to which access is otherwise cut off by having taken a variant branch, but it is not accessible unless you hand-code this preference to true -- which I suggest you do only with fingers crossed."
  
  	^ false!

Item was changed:
+ ----- Method: Preferences class>>printStandardSystemFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>printStandardSystemFonts (in category 'fonts') -----
  printStandardSystemFonts
  	"self printStandardSystemFonts"
  
  	| string |
  	string := String streamContents: [ :s |
  
  	#(standardDefaultTextFont standardListFont standardFlapFont 
  	standardEToysFont standardMenuFont windowTitleFont 
  	standardBalloonHelpFont standardCodeFont standardButtonFont) do: [:selector |
  		| font |
  		font := Preferences perform: selector.
  		s
  			nextPutAll: selector; space;
  			nextPutAll: font familyName; space;
  			nextPutAll: (AbstractFont emphasisStringFor: font emphasis);
  			nextPutAll: ' points: ';
  			print: font pointSize;
  			nextPutAll: ' height: ';
  			print: font height;
  			cr
  		]].
  
  	(StringHolder new)
  		contents: string;
  		openLabel: 'Current system font settings' translated.
  !

Item was changed:
+ ----- Method: Preferences class>>refreshFontSettings (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>refreshFontSettings (in category 'fonts') -----
  refreshFontSettings
  	"Try to update all the current font settings to make things consistent."
  
  	self setFlapsFontTo: (self standardFlapFont);
  		setEToysFontTo: (self standardEToysFont);
  		setWindowTitleFontTo: (self windowTitleFont);
  		setListFontTo: (self standardListFont);
  		setMenuFontTo: (self standardMenuFont);
  		setSystemFontTo: (TextStyle defaultFont);
  		setCodeFontTo: (self standardCodeFont);
  		setBalloonHelpFontTo: (BalloonMorph balloonFont).
  
  	SystemWindow allSubInstancesDo: [ :s | | rawLabel |
  		rawLabel := s getRawLabel.
  		rawLabel owner vResizing: #spaceFill.
  		rawLabel font: rawLabel font.
  		s setLabel: s label.
  		s replaceBoxes ].!

Item was changed:
+ ----- Method: Preferences class>>registerForEvents (in category 'initialization') -----
- ----- Method: Preferences class>>registerForEvents (in category 'dynamic preferences') -----
  registerForEvents
  	"Preferences registerForEvents"
  	
+ 	"Do not register pragma preferences with any preferences holder but this one."
+ 	self == Preferences ifFalse: [^ self].
+ 	
  	SystemChangeNotifier uniqueInstance
  		noMoreNotificationsFor: self;
  		notify: self ofAllSystemChangesUsing: #prefEvent:.
+ 
+ 	Smalltalk allClassesDo: [:aClass |
+ 		aClass class methodsDo: [:method |
+ 			method pragmas do: [:pragma |
+ 				self addPragmaPreference: pragma] ] ].!
- 	Smalltalk allClassesDo:
- 		[:aClass|
- 		aClass class methodsDo:
- 			[:method|
- 			self respondToPreferencePragmasInMethod: method class: aClass]]!

Item was added:
+ ----- Method: Preferences class>>removeAllPreferencesSuchThat: (in category 'add/remove') -----
+ removeAllPreferencesSuchThat: block
+ 
+ 	self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
+ 		| map |
+ 		map := copyOfDictionaryOfPreferences select: block.
+ 		map keysDo: [ :prefName |
+ 			copyOfDictionaryOfPreferences removeKey: prefName]]!

Item was changed:
+ ----- Method: Preferences class>>removePreference: (in category 'add/remove') -----
- ----- Method: Preferences class>>removePreference: (in category 'initialization') -----
  removePreference: aSymbol 
  	"Remove all memory of the given preference symbol in my various structures."
  
  	| pref |
  	pref := self preferenceAt: aSymbol ifAbsent: [^self].
+ 	
+ 	pref localToProject ifTrue: [
+ 		Project allProjects do: [ :proj | 
+ 			 proj projectPreferenceFlagDictionary ifNotNil: [ :projectpreferences |
+ 				projectpreferences removeKey: aSymbol ifAbsent: [] ] ] ].
+ 	
- 	pref localToProject  ifTrue:
- 		[Project allProjects do:
- 			[:proj | 
- 			 proj projectPreferenceFlagDictionary ifNotNil:
- 				[:projectpreferences|
- 				projectpreferences removeKey:aSymbol  ifAbsent:[]]]].
  	self atomicUpdatePreferences: [ :copyOfDictionaryOfPreferences |
  		copyOfDictionaryOfPreferences removeKey: aSymbol ifAbsent: nil ].
+ 	
+ 	"Remove auto-generated accessor method."
+ 	self class removeSelector: aSymbol.
+ 	
+ 	^ pref!
- 	self class removeSelector: aSymbol
- 
- 	"Preferences removePreference: #tileToggleInBrowsers"!

Item was removed:
- ----- Method: Preferences class>>removePreferencesFor: (in category 'dynamic preferences') -----
- removePreferencesFor: aClass
- 	"Remove all the preferences registered for the given class"
- 	"Preferences removePreferencesFor: PreferenceExample"
- 
- 	self atomicUpdatePreferences:
- 		[:copyOfDictionaryOfPreferences| | map |
- 		map := copyOfDictionaryOfPreferences select: [ :pref | pref provider == aClass].
- 		map keysDo:
- 			[ :prefName |
- 			copyOfDictionaryOfPreferences removeKey: prefName]]!

Item was changed:
+ ----- Method: Preferences class>>resetHaloSpecifications (in category 'prefs - halos') -----
- ----- Method: Preferences class>>resetHaloSpecifications (in category 'halos') -----
  resetHaloSpecifications
  	"Preferences resetHaloSpecifications"
  
  	^ Parameters removeKey: #HaloSpecs ifAbsent: []!

Item was removed:
- ----- Method: Preferences class>>respondToPreferencePragmasInMethod:class: (in category 'dynamic preferences') -----
- respondToPreferencePragmasInMethod: method class: class
- 	method pragmas do:
- 		[:pragma| | preference |
- 		((pragma keyword beginsWith: #preference:)
- 		 and: [self respondsTo: pragma keyword]) ifTrue:
- 			[preference := self
- 								perform: pragma keyword
- 								withArguments: pragma arguments.
- 			preference 
- 				provider: class 
- 				getter: method selector 
- 				setter: method selector asMutator.
- 			self atomicUpdatePreferences:
- 				[ :copyOfDictionaryOfPreferences |
- 				copyOfDictionaryOfPreferences
- 					at: (class name, '>>', method selector) asSymbol
- 					put: preference]]]!

Item was changed:
+ ----- Method: Preferences class>>restoreDefaultFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>restoreDefaultFonts (in category 'fonts') -----
  restoreDefaultFonts
  	"Since this is called from menus, we can take the opportunity to prompt for missing font styles."
  	"
  	Preferences restoreDefaultFonts
  	"
  
  	self setDefaultFonts: #(
  		(setSystemFontTo:			'Bitmap DejaVu Sans'		9)
  		(setListFontTo:				'Bitmap DejaVu Sans'		9)
  		(setFlapsFontTo:			Accushi						12)
  		(setEToysFontTo:			BitstreamVeraSansBold		9)
  		(setPaintBoxButtonFontTo:	BitstreamVeraSansBold		9)
  		(setMenuFontTo:			'Bitmap DejaVu Sans'		9)
  		(setWindowTitleFontTo:		'Bitmap DejaVu Sans Bold'	9)
  		(setBalloonHelpFontTo:		'Bitmap DejaVu Sans'		7)
  		(setCodeFontTo:			'Bitmap DejaVu Sans'		9)
  		(setButtonFontTo:			'Bitmap DejaVu Sans'	7)
  	)!

Item was changed:
+ ----- Method: Preferences class>>restoreDefaultFontsForJapanese (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>restoreDefaultFontsForJapanese (in category 'fonts') -----
  restoreDefaultFontsForJapanese
  	"Preferences restoreDefaultFontsForJapanese"
  	#(	"(setButtonFontTo:		ComicBold		15)"
  		"(setTextButtonFontTo:		NewYork		12)"
  		"(setCodeFontTo:			NewYork		12)"  "Later"
  		(setFlapsFontTo:			NewYork		15)
  		(setListFontTo:			NewYork		12)
  		(setMenuFontTo:			NewYork		12)
  		(setWindowTitleFontTo:	NewYork		15)
  		(setSystemFontTo:		NewYork		12)) do:
  			[:triplet |
  				self perform: triplet first with: (StrikeFontSet familyName: triplet second size: triplet third)].
  
  	self setButtonFontTo: (StrikeFont familyName: #ComicBold size: 16).
  
  	Smalltalk at: #BalloonMorph ifPresent:
  		[:thatClass | thatClass setBalloonFontTo: (StrikeFontSet familyName: #NewYork size: 12)].
  
  	"Note:  The standardCodeFont is not currently used -- the default font is instead; later hopefully we can split the code font out as  a separate choice, but only after we're able to have the protocols reorganized such that we can know whether it's code or not when we launch the text object.
  
  	Note:  The standard button font is reset by this code but is not otherwise settable by a public UI (too many things can go afoul) "!

Item was changed:
+ ----- Method: Preferences class>>restoreDefaultMenuParameters (in category 'initialization - misc') -----
- ----- Method: Preferences class>>restoreDefaultMenuParameters (in category 'menu parameters') -----
  restoreDefaultMenuParameters
  	"Restore the four color choices of the original implementors of  
  	MorphicMenus"
  	" 
  	Preferences restoreDefaultMenuParameters
  	"
  	Parameters
  		at: #menuColor
  		put: (Color
  				r: 0.97
  				g: 0.97
  				b: 0.97).
  	Parameters
  		at: #menuBorderColor
  		put: (Color
  				r: 0.167
  				g: 0.167
  				b: 1.0).
  	Parameters at: #menuBorderWidth put: 2.
  	Parameters at: #menuTitleColor put: (Color
  			r: 0.4
  			g: 0.8
  			b: 0.9) twiceDarker.
  	Parameters
  		at: #menuTitleBorderColor
  		put: (Color
  				r: 0.333
  				g: 0.667
  				b: 0.751).
  	Parameters at: #menuTitleBorderWidth put: 1.
  	Parameters
  		at: #menuLineColor
  		put: (Preferences menuBorderColor lighter)!

Item was changed:
+ ----- Method: Preferences class>>restoreFontsAfter: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>restoreFontsAfter: (in category 'fonts') -----
  restoreFontsAfter: aBlock
  
  	"Restore the currently chosen set of standard fonts after 
  	evaluating aBlock. Used for tests that modify the default fonts."
  
  	| standardDefaultTextFont standardListFont standardEToysFont standardMenuFont 
  	windowTitleFont standardBalloonHelpFont standardCodeFont standardButtonFont |
  
  	standardDefaultTextFont := Preferences standardDefaultTextFont.
  	standardListFont := Preferences standardListFont.
  	standardEToysFont := Preferences standardEToysFont.
  	standardMenuFont := Preferences standardMenuFont.
  	windowTitleFont := Preferences windowTitleFont.
  	standardBalloonHelpFont := Preferences standardBalloonHelpFont.
  	standardCodeFont := Preferences standardCodeFont.
  	standardButtonFont := Preferences standardButtonFont.
  	^aBlock ensure: [
  		Preferences setSystemFontTo: standardDefaultTextFont.
  		Preferences setListFontTo: standardListFont.
  		Preferences setEToysFontTo: standardEToysFont.
  		Preferences setMenuFontTo: standardMenuFont.
  		Preferences setWindowTitleFontTo: windowTitleFont.
  		Preferences setBalloonHelpFontTo: standardBalloonHelpFont.
  		Preferences setCodeFontTo: standardCodeFont.
  		Preferences setButtonFontTo: standardButtonFont.
  	].
  !

Item was changed:
+ ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') -----
  restorePersonalPreferences
  	"Restore all the user's saved personal preference settings"
  
  	| savedPrefs |
  	savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet'].
  
  	savedPrefs associationsDo:
  		[:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil:
  			[:pref | pref preferenceValue: assoc value preferenceValue]]!

Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') -----
  restorePreferencesFromDisk
  	(FileDirectory default fileExists: 'my.prefs')
  		ifTrue: [ Cursor wait showWhile: [
  			[ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ]
  		] ]
  		ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ].
  	!

Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk: (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk: (in category 'personalization') -----
  restorePreferencesFromDisk: aFile 
  	Cursor wait
  		showWhile: [[self loadPreferencesFrom: aFile]
  				on: Error
  				do: [:ex | self inform: 'there was an error restoring the preferences' translated]]!

Item was changed:
+ ----- Method: Preferences class>>roundedCornersString (in category 'support - misc') -----
- ----- Method: Preferences class>>roundedCornersString (in category 'misc') -----
  roundedCornersString
  	^ (((self valueOfFlag: #roundedWindowCorners)
  		ifTrue: ['stop']
  		ifFalse: ['start']) , ' rounding window corners') translated!

Item was changed:
+ ----- Method: Preferences class>>roundedWindowCornersChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>roundedWindowCornersChanged (in category 'reacting to change') -----
  roundedWindowCornersChanged
  	"The user changed the value of the roundedWindowCorners preference.  React"
  
  	ActiveWorld fullRepaintNeeded!

Item was changed:
+ ----- Method: Preferences class>>savePersonalPreferences (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>savePersonalPreferences (in category 'personalization') -----
  savePersonalPreferences
  	"Save the current list of Preference settings as the user's personal choices"
  
  	self
  		setParameter: #PersonalDictionaryOfPreferences
  		to: preferencesDictionary deepCopy!

Item was changed:
+ ----- Method: Preferences class>>scrollBarColor (in category 'prefs - misc') -----
- ----- Method: Preferences class>>scrollBarColor (in category 'parameters') -----
  scrollBarColor
  	"Answer the preferred color for scroll bar elevators."
  
  	^ Color gray!

Item was changed:
+ ----- Method: Preferences class>>scrollBarWidth (in category 'prefs - misc') -----
- ----- Method: Preferences class>>scrollBarWidth (in category 'parameters') -----
  scrollBarWidth
  	"Answer the preferred width for scroll bars."
  
  	^ 8!

Item was changed:
+ ----- Method: Preferences class>>serviceLoadPreferencesFromDisk (in category 'support - file list services') -----
- ----- Method: Preferences class>>serviceLoadPreferencesFromDisk (in category 'file list services') -----
  serviceLoadPreferencesFromDisk
  	^ SimpleServiceEntry 
  		provider: self 
  		label: 'load preferences from a saved file'
  		selector: #restorePreferencesFromDisk:
  		description: 'restore all saved personal preference settings'
  		buttonLabel: 'load preferences'!

Item was changed:
+ ----- Method: Preferences class>>services (in category 'support - file list services') -----
- ----- Method: Preferences class>>services (in category 'file list services') -----
  services
  	^ Array with: self serviceLoadPreferencesFromDisk!

Item was changed:
+ ----- Method: Preferences class>>setArrowheads (in category 'support - misc') -----
- ----- Method: Preferences class>>setArrowheads (in category 'misc') -----
  setArrowheads
  	"Let the user edit the size of arrowheads"
  
  	| aParameter result  |
  	aParameter := self parameterAt: #arrowSpec ifAbsent: [5 @ 4].
  	result := Morph obtainArrowheadFor: 'Default size of arrowheads on pen trails ' translated defaultValue: aParameter asString.
  	result ifNotNil:
  			[self setParameter: #arrowSpec to: result]
  		ifNil:
  			[Beeper beep]!

Item was changed:
+ ----- Method: Preferences class>>setBalloonHelpFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setBalloonHelpFontTo: (in category 'fonts') -----
  setBalloonHelpFontTo: aFont
  
  	Smalltalk at: #BalloonMorph ifPresent:
  		[:thatClass | thatClass setBalloonFontTo: aFont]!

Item was changed:
+ ----- Method: Preferences class>>setButtonFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setButtonFontTo: (in category 'fonts') -----
  setButtonFontTo: aFont
  	Parameters at: #standardButtonFont put: aFont!

Item was changed:
+ ----- Method: Preferences class>>setCodeFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setCodeFontTo: (in category 'fonts') -----
  setCodeFontTo: aFont
  	"Establish the code font."
  
  	Parameters at: #standardCodeFont put: aFont!

Item was changed:
+ ----- Method: Preferences class>>setDefaultAnnotationInfo (in category 'initialization - misc') -----
- ----- Method: Preferences class>>setDefaultAnnotationInfo (in category 'parameters') -----
  setDefaultAnnotationInfo
  	"Preferences setDefaultAnnotationInfo"
+ 	^ Parameters at: #MethodAnnotations put: self defaultAnnotationInfo!
- 	^ Parameters at: #MethodAnnotations put: #(timeStamp messageCategory implementorsCount allChangeSets)!

Item was changed:
+ ----- Method: Preferences class>>setDefaultFonts: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setDefaultFonts: (in category 'fonts') -----
  setDefaultFonts: defaultFontsSpec
  	"Since this is called from menus, we can take the opportunity to prompt for missing font styles."
  
  	| fontNames map emphases |
  	fontNames := defaultFontsSpec collect: [:array | array second].
  	map := IdentityDictionary new.
  	emphases := IdentityDictionary new.
  	fontNames do: [:originalName | | decoded style |
  		decoded := TextStyle decodeStyleName: originalName.
  		style := map at: originalName put: (TextStyle named: decoded second).
  		emphases at: originalName put: decoded first.
  		style ifNil: [map at: originalName put: TextStyle default]].
  
  	defaultFontsSpec do: [:triplet | self
  		perform: triplet first
  		with: (((map at: triplet second) fontOfPointSize: triplet third) emphasized: (emphases at: triplet second))]!

Item was changed:
+ ----- Method: Preferences class>>setDemoFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setDemoFonts (in category 'fonts') -----
  setDemoFonts
  	"Preferences setDemoFonts"
  
  	self setDefaultFonts: #(
  		(setSystemFontTo:			BitstreamVeraSans			 		12)
  		(setListFontTo:				BitstreamVeraSans					14)
  		(setFlapsFontTo:				Accushi								12)
  		(setEToysFontTo:				BitstreamVeraSansBold				9)
  		(setPaintBoxButtonFontTo:	BitstreamVeraSansBold				9)
  		(setMenuFontTo:				BitstreamVeraSans					14)
  		(setWindowTitleFontTo:		BitstreamVeraSansBold				12)
  		(setBalloonHelpFontTo:		Accujen								18)
  		(setCodeFontTo:				BitstreamVeraSans					18)
  		(setButtonFontTo:			BitstreamVeraSansMono				14)
  	)
  !

Item was changed:
+ ----- Method: Preferences class>>setEToysFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setEToysFontTo: (in category 'fonts') -----
  setEToysFontTo: aFont 
  	"change the font used in eToys environment"
  	Parameters at: #eToysFont put: aFont!

Item was changed:
+ ----- Method: Preferences class>>setEToysTitleFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setEToysTitleFontTo: (in category 'fonts') -----
  setEToysTitleFontTo: aFont 
  	"change the font used in eToys environment"
  	Parameters at: #eToysTitleFont put: aFont!

Item was added:
+ ----- Method: Preferences class>>setFlag:toValue: (in category 'get/set - flags') -----
+ setFlag: prefSymbol toValue: aBoolean
+ 	"Convenience method for consistency."
+ 	
+ 	^ self setPreference: prefSymbol toValue: aBoolean!

Item was changed:
+ ----- Method: Preferences class>>setFlag:toValue:during: (in category 'get/set - flags') -----
- ----- Method: Preferences class>>setFlag:toValue:during: (in category 'misc') -----
  setFlag: prefSymbol toValue: aBoolean during: aBlock
  	"Set the flag to the given value for the duration of aBlock"
  
+ 	(self valueOfFlag: prefSymbol) in: [:previous |
+ 		self setFlag: prefSymbol toValue: aBoolean.
+ 		aBlock ensure: [self setFlag: prefSymbol toValue: previous]].!
- 	| existing |
- 	existing := self valueOfFlag: prefSymbol.
- 	existing == aBoolean ifFalse: [self setPreference: prefSymbol toValue: aBoolean].
- 	aBlock value.
- 	existing == aBoolean ifFalse: [self setPreference: prefSymbol toValue: existing]!

Item was changed:
+ ----- Method: Preferences class>>setFlapsFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setFlapsFontTo: (in category 'fonts') -----
  setFlapsFontTo: aFont
  
  	Parameters at: #standardFlapFont put: aFont.
  	FlapTab allSubInstancesDo:
  		[:aFlapTab | aFlapTab reformatTextualTab]!

Item was changed:
+ ----- Method: Preferences class>>setHaloLabelFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setHaloLabelFontTo: (in category 'fonts') -----
  setHaloLabelFontTo: aFont 
  	"change the font used in eToys environment"
  	Parameters at: #haloLabelFont put: aFont!

Item was changed:
+ ----- Method: Preferences class>>setListFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setListFontTo: (in category 'fonts') -----
  setListFontTo: aFont
  	"Set the list font as indicated"
  
  	Parameters at: #standardListFont put: aFont.
  	Smalltalk at: #ListParagraph ifPresent: [:lp | lp initialize].
  	Smalltalk at: #Flaps ifPresent: [:flaps | flaps replaceToolsFlap]!

Item was changed:
+ ----- Method: Preferences class>>setMenuFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setMenuFontTo: (in category 'fonts') -----
  setMenuFontTo: aFont
  	"rbb 2/18/2005 12:54 - How should this be changed to work
  	with the UIManager, if at all?"
  	Parameters at: #standardMenuFont put: aFont.
  	Smalltalk at: #PopUpMenu ifPresent:[:aClass| aClass setMenuFontTo: aFont].
  	TheWorldMainDockingBar updateInstances.!

Item was changed:
+ ----- Method: Preferences class>>setNotificationParametersForStandardPreferences (in category 'initialization - misc') -----
- ----- Method: Preferences class>>setNotificationParametersForStandardPreferences (in category 'reacting to change') -----
  setNotificationParametersForStandardPreferences
  	"Set up the notification parameters for the standard preferences that require need them.  When adding new Preferences that require use of the notification mechanism, users declare the notifcation info as part of the call that adds the preference, or afterwards -- the two relevant methods for doing that are:
   	Preferences.addPreference:categories:default:balloonHelp:projectLocal:changeInformee:changeSelector:   and
  	Preference changeInformee:changeSelector:"
  
  		"Preferences setNotificationParametersForStandardPreferences"
  
  	
  	#(	
  		(annotationPanes		annotationPanesChanged)
  		(eToyFriendly			eToyFriendlyChanged)
  		(infiniteUndo			infiniteUndoChanged)
  		(uniTilesClassic			classicTilesSettingToggled)
  		(optionalButtons			optionalButtonsChanged)
  		(roundedWindowCorners	roundedWindowCornersChanged)
  		(showProjectNavigator	showProjectNavigatorChanged)
  		(smartUpdating			smartUpdatingChanged)
  		(universalTiles			universalTilesSettingToggled)
  		(showSharedFlaps		sharedFlapsSettingChanged)
  		(noviceMode		noviceModeSettingChanged)
  	)  do:
  
  			[:pair | | aPreference |
  				aPreference := self preferenceAt: pair first.
  				aPreference changeInformee: self changeSelector: pair second]!

Item was changed:
+ ----- Method: Preferences class>>setPaintBoxButtonFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setPaintBoxButtonFontTo: (in category 'fonts') -----
  setPaintBoxButtonFontTo: aFont 
  	"change the font used in the buttons in PaintBox."
  	Parameters at: #paintBoxButtonFont put: aFont!

Item was changed:
  ----- Method: Preferences class>>setPreference:toValue: (in category 'get/set') -----
+ setPreference: prefSymbol toValue: anObject
- setPreference: prefSymbol toValue: aBoolean
  	"Set the given preference to the given value, and answer that value"
  
+ 	^ (self
+ 		preferenceAt: prefSymbol
+ 		ifAbsent: [^ self addPreference: prefSymbol default: anObject])
+ 			preferenceValue: anObject;
+ 			yourself!
- 	^ (self preferenceAt: prefSymbol ifAbsent: [^ aBoolean]) preferenceValue: aBoolean!

Item was changed:
+ ----- Method: Preferences class>>setSystemFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setSystemFontTo: (in category 'fonts') -----
  setSystemFontTo: aFont
  	"Establish the default text font and style"
  
  	| aStyle newDefaultStyle |
  	aFont ifNil: [^ self].
  	aStyle := aFont textStyle ifNil: [^ self].
  	newDefaultStyle := aStyle copy.
  	newDefaultStyle defaultFontIndex: (aStyle fontIndexOf: aFont).
  	TextConstants at: #DefaultTextStyle put: newDefaultStyle.
  	Flaps replaceToolsFlap.
  	ScriptingSystem resetStandardPartsBin!

Item was changed:
+ ----- Method: Preferences class>>setWindowColorFor:to: (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>setWindowColorFor:to: (in category 'window colors') -----
  setWindowColorFor: modelSymbol to: incomingColor
  	| aColor aPrefSymbol aColorSpec |
  	aColorSpec := WindowColorRegistry registeredWindowColorSpecFor: modelSymbol.
  	aColorSpec ifNil: [^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
  		type: #WindowColor!

Item was changed:
+ ----- Method: Preferences class>>setWindowTitleFontTo: (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>setWindowTitleFontTo: (in category 'fonts') -----
  setWindowTitleFontTo: aFont
  	"Set the window-title font to be as indicated"
  
  	Parameters at: #windowTitleFont put: aFont.
  	(Smalltalk hasClassNamed: #StandardSystemView)
  		ifTrue: [(Smalltalk at: #StandardSystemView) setLabelStyle].
  	(Smalltalk hasClassNamed: #Flaps)
  		ifTrue: [(Smalltalk at: #Flaps) replaceToolsFlap]
  !

Item was changed:
+ ----- Method: Preferences class>>sharedFlapsSettingChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>sharedFlapsSettingChanged (in category 'reacting to change') -----
  sharedFlapsSettingChanged
  	"The current value of the showSharedFlaps flag has changed; now react"
  
  	self showSharedFlaps  "viz. the new setting"
  		ifFalse:		
  			[Flaps globalFlapTabsIfAny do:
  				[:aFlapTab | Flaps removeFlapTab: aFlapTab keepInList: true]]
  
  		ifTrue:
  			[Smalltalk isMorphic ifTrue:
  				[self currentWorld addGlobalFlaps]]!

Item was changed:
+ ----- Method: Preferences class>>showChooseGraphicHaloHandle (in category 'prefs - halos') -----
- ----- Method: Preferences class>>showChooseGraphicHaloHandle (in category 'halos') -----
  showChooseGraphicHaloHandle
  	"Hard-coded; reimplement to change behavior.  If this preference is set to true, then a choose-graphic halo handle may appear on the halo of SketchMorphs"
  
  	^ false!

Item was changed:
+ ----- Method: Preferences class>>showProjectNavigatorChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>showProjectNavigatorChanged (in category 'reacting to change') -----
  showProjectNavigatorChanged
  	"The showProjectNavigatorChanged preference changed; react"
  	
  	Project current assureNavigatorPresenceMatchesPreference!

Item was changed:
+ ----- Method: Preferences class>>simpleFullHaloSpecifications (in category 'prefs - halos') -----
- ----- Method: Preferences class>>simpleFullHaloSpecifications (in category 'halos') -----
  simpleFullHaloSpecifications
  	"This method gives the specs for the 'full' handles variant when simple halos are in effect"
  
  	"Preferences resetHaloSpecifications"
  
  	^ #(
  	"  	selector				horiz		vert			color info						icon key
  		---------				------		-----------		-------------------------------		---------------"
  	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		'Halo-Debug')
  	(addPoohHandle:			right		center			(white)							'Halo-Pooh')
  	(addDismissHandle:		left			top				(red		muchLighter)			'Halo-Dismiss')
  	(addRotateHandle:		left			bottom			(blue)							'Halo-Rot')
  	(addMenuHandle:		leftCenter	top				(red)							'Halo-Menu')
  	(addTileHandle:			left			bottomCenter	(lightBrown)					'Halo-Tile')
  	(addViewHandle:			left			center			(cyan)							'Halo-View')
  	(addGrabHandle:			center		top				(black)							'Halo-Grab')
  	(addDragHandle:			rightCenter	top				(brown)							'Halo-Drag')
  	(addDupHandle:			right		top				(green)							'Halo-Dup')	
  	(addMakeSiblingHandle:	right		top				(green muchDarker)				'Halo-Dup')	
  	(addHelpHandle:			center		bottom			(lightBlue)						'Halo-Help')
  	(addGrowHandle:		right		bottom			(yellow)						'Halo-Scale')
  	(addScaleHandle:		right		bottom			(lightOrange)					'Halo-Scale')
  	(addFewerHandlesHandle:	left		topCenter		(paleBuff)						'Halo-FewerHandles')
  	(addScriptHandle:		right		bottomCenter	(green muchLighter)			'Halo-Script')
  	(addPaintBgdHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addRepaintHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						'Halo-FontSize')
  	(addFontStyleHandle:		center		bottom			(lightRed)						'Halo-FontStyle')
  	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)		  'Halo-FontEmph')
  	(addRecolorHandle:		right		bottomCenter	(magenta darker)				'Halo-Recolor')
  
  		) !

Item was changed:
+ ----- Method: Preferences class>>simpleHalosInForce (in category 'prefs - halos') -----
- ----- Method: Preferences class>>simpleHalosInForce (in category 'halos') -----
  simpleHalosInForce
  	^ (self preferenceAt: #haloTheme) preferenceValue == #simpleFullHaloSpecifications!

Item was changed:
+ ----- Method: Preferences class>>smartUpdatingChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>smartUpdatingChanged (in category 'reacting to change') -----
  smartUpdatingChanged
  	"The smartUpdating preference changed. React"
  
  	SystemWindow allSubInstancesDo:
  		[:aWindow | aWindow amendSteppingStatus]
  
  	"NOTE: This makes this preference always behave like a global preference, which is problematical"!

Item was changed:
+ ----- Method: Preferences class>>staggerPolicyString (in category 'support - misc') -----
- ----- Method: Preferences class>>staggerPolicyString (in category 'misc') -----
  staggerPolicyString
  	"Answer the string to be shown in a menu to represent the 
  	stagger-policy status"
  	^ ((self valueOfFlag: #reverseWindowStagger)
  		ifTrue: ['<yes>']
  		ifFalse: ['<no>']), 'stagger windows' translated!

Item was changed:
+ ----- Method: Preferences class>>standardBalloonHelpFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardBalloonHelpFont (in category 'fonts') -----
  standardBalloonHelpFont
  	^BalloonMorph balloonFont!

Item was changed:
+ ----- Method: Preferences class>>standardButtonFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardButtonFont (in category 'fonts') -----
  standardButtonFont
  	"Answer an attractive font to use for buttons"
  	"Answer the font to be used for textual flap tab labels"
  	^ Parameters 
  			at: #standardButtonFont 
  			ifAbsentPut: [StrikeFont familyName: #ComicBold size: 16]!

Item was changed:
+ ----- Method: Preferences class>>standardCodeFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardCodeFont (in category 'fonts') -----
  standardCodeFont
  	"Answer the font to be used in code"
  	 ^ Parameters at: #standardCodeFont ifAbsentPut: [TextStyle defaultFont]!

Item was changed:
+ ----- Method: Preferences class>>standardDefaultTextFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardDefaultTextFont (in category 'fonts') -----
  standardDefaultTextFont
  	^TextStyle defaultFont!

Item was changed:
+ ----- Method: Preferences class>>standardEToysFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardEToysFont (in category 'fonts') -----
  standardEToysFont
  	"Answer the font to be used in the eToys environment"
  	^ Parameters at: #eToysFont ifAbsentPut: [self standardButtonFont]!

Item was changed:
+ ----- Method: Preferences class>>standardEToysTitleFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardEToysTitleFont (in category 'fonts') -----
  standardEToysTitleFont
  	"Answer the font to be used in the eToys environment"
  	^ Parameters at: #eToysTitleFont ifAbsentPut: [self standardEToysFont]!

Item was changed:
+ ----- Method: Preferences class>>standardFlapFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardFlapFont (in category 'fonts') -----
  standardFlapFont
  	"Answer the font to be used for textual flap tab labels"
  	^ Parameters at: #standardFlapFont ifAbsentPut: [self standardButtonFont]!

Item was changed:
+ ----- Method: Preferences class>>standardHaloLabelFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardHaloLabelFont (in category 'fonts') -----
  standardHaloLabelFont
  	"Answer the font to be used in the eToys environment"
  	^ Parameters at: #haloLabelFont ifAbsentPut: [TextStyle defaultFont]!

Item was changed:
+ ----- Method: Preferences class>>standardListFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardListFont (in category 'fonts') -----
  standardListFont
  	"Answer the font to be used in lists"
  	 ^ Parameters at: #standardListFont ifAbsentPut: [TextStyle defaultFont]!

Item was changed:
+ ----- Method: Preferences class>>standardMenuFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardMenuFont (in category 'fonts') -----
  standardMenuFont
  	"Answer the font to be used in menus"
  	 ^ Parameters at: #standardMenuFont ifAbsentPut: [TextStyle defaultFont]!

Item was changed:
+ ----- Method: Preferences class>>standardPaintBoxButtonFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardPaintBoxButtonFont (in category 'fonts') -----
  standardPaintBoxButtonFont
  	"Answer the font to be used in the eToys environment"
  	^ Parameters at: #paintBoxButtonFont ifAbsentPut: [self standardButtonFont]!

Item was changed:
+ ----- Method: Preferences class>>standardSystemFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>standardSystemFont (in category 'fonts') -----
  standardSystemFont
  	"Answer the standard system font "
  
  	^(TextConstants at: #DefaultTextStyle) defaultFont!

Item was changed:
+ ----- Method: Preferences class>>storePreferencesIn: (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>storePreferencesIn: (in category 'personalization') -----
  storePreferencesIn: aFileName 
  	| stream prefsSnapshot |
  	#(Prevailing PersonalPreferences) do:
  		[:ea |
  		 Parameters removeKey: ea ifAbsent: []].
  	stream := ReferenceStream fileNamed: aFileName.
  	stream nextPut: Parameters.
  	prefsSnapshot := preferencesDictionary copy.
  	prefsSnapshot keysAndValuesDo: [:key :pref | prefsSnapshot at: key put: pref asPreference].
  	stream nextPut: prefsSnapshot.
  	stream nextPut: (Smalltalk isMorphic 
  						 ifTrue:[World fillStyle]
+ 						 ifFalse:[self desktopColor]).
- 						 ifFalse:[DesktopColor]).
  	stream close!

Item was changed:
+ ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') -----
- ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') -----
  storePreferencesToDisk
  	Cursor wait showWhile: [
  		[ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]!

Item was changed:
+ ----- Method: Preferences class>>subPixelRenderColorFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>subPixelRenderColorFonts (in category 'fonts') -----
  subPixelRenderColorFonts
  	^ self
  		valueOfFlag: #subPixelRenderColorFonts
  		ifAbsent: [ true ]!

Item was changed:
+ ----- Method: Preferences class>>subPixelRenderFonts (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>subPixelRenderFonts (in category 'fonts') -----
  subPixelRenderFonts
  	^ self
  		valueOfFlag: #subPixelRenderFonts
  		ifAbsent: [ true ]!

Item was changed:
+ ----- Method: Preferences class>>suppressWindowTitlesInInstanceBrowsers (in category 'prefs - misc') -----
- ----- Method: Preferences class>>suppressWindowTitlesInInstanceBrowsers (in category 'hard-coded prefs') -----
  suppressWindowTitlesInInstanceBrowsers
  	"Hard-coded for the moment: answer whether instance browsers should suppresss their window titles"
  
  	^ false!

Item was changed:
+ ----- Method: Preferences class>>textHighlightColor (in category 'prefs - text') -----
- ----- Method: Preferences class>>textHighlightColor (in category 'text highlighting') -----
  textHighlightColor
  	^ Parameters at: #textHighlightColor!

Item was changed:
+ ----- Method: Preferences class>>textHighlightColor: (in category 'prefs - text') -----
- ----- Method: Preferences class>>textHighlightColor: (in category 'text highlighting') -----
  textHighlightColor: aColor
  	Parameters at: #textHighlightColor put: aColor!

Item was changed:
+ ----- Method: Preferences class>>themeChoiceButtonOfColor:font: (in category 'themes - tools') -----
- ----- Method: Preferences class>>themeChoiceButtonOfColor:font: (in category 'misc') -----
  themeChoiceButtonOfColor: aColor font: aFont
  	"Answer a button inviting the user to choose a theme"
  
  	| aButton |
  	aButton := SimpleButtonMorph new target: self; actionSelector: #offerThemesMenu.
  	aButton label: 'change theme...' translated font: aFont.
  	aButton color: aColor.
  	aButton setBalloonText: 'Numerous "Preferences" govern many things about the way Squeak looks and behaves.  Set individual preferences using a "Preferences" panel.  Set an entire "theme" of many Preferences all at the same time by pressing this "change theme" button and choosing a theme to install.  Look in category "themes" in Preferences class to see what each theme does; add your own methods to the "themes" category and they will show up in the list of theme choices.' translated.
  	^ aButton!

Item was added:
+ ----- Method: Preferences class>>toggle: (in category 'get/set - flags') -----
+ toggle: flagName
+ 	"Toggle the given preference. prefSymbol must be of a boolean preference"
+ 	
+ 	^ self setFlag: flagName toValue: (self valueOfFlag: flagName) not!

Item was removed:
- ----- Method: Preferences class>>toggleMenuColorPolicy (in category 'misc') -----
- toggleMenuColorPolicy
- 	self togglePreference: #menuColorFromWorld!

Item was removed:
- ----- Method: Preferences class>>togglePreference: (in category 'get/set') -----
- togglePreference: prefSymbol
- 	"Toggle the given preference. prefSymbol must be of a boolean preference"
- 	(self preferenceAt: prefSymbol ifAbsent: [self error: 'unknown preference: ', prefSymbol]) togglePreferenceValue!

Item was removed:
- ----- Method: Preferences class>>toggleRoundedCorners (in category 'misc') -----
- toggleRoundedCorners
- 	self togglePreference: #roundedWindowCorners!

Item was removed:
- ----- Method: Preferences class>>toggleWindowPolicy (in category 'misc') -----
- toggleWindowPolicy
- 	self togglePreference: #reverseWindowStagger!

Item was added:
+ ----- Method: Preferences class>>typeForValue: (in category 'support') -----
+ typeForValue: anObject
+ 	"Returns the preference type for the given value to be distinguished in tools."
+ 
+ 	{
+ 		AbstractFont -> #Font.
+ 		Boolean -> #Boolean.
+ 		Color -> #Color.
+ 		String -> #String.
+ 		Number -> #Number
+ 	} do: [:spec | (anObject isKindOf: spec key) ifTrue: [^ spec value]].
+ 
+ 	^ #Object
+ 	
+ 
+ 
+ !

Item was added:
+ ----- Method: Preferences class>>unclassifiedCategory (in category 'defaults') -----
+ unclassifiedCategory
+ 	"Generic category to be used when no specific alternative is provided."
+ 	
+ 	^ #unclassified!

Item was changed:
+ ----- Method: Preferences class>>uniformWindowColor (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>uniformWindowColor (in category 'window colors') -----
  uniformWindowColor
  	^Color veryVeryLightGray!

Item was changed:
+ ----- Method: Preferences class>>universalTilesSettingToggled (in category 'updating - system') -----
- ----- Method: Preferences class>>universalTilesSettingToggled (in category 'reacting to change') -----
  universalTilesSettingToggled
  	"The current value of the universalTiles flag has changed; now react"
  
  	(self preferenceAt: #universalTiles ifAbsent: [^ self]) localToProject ifFalse:
  			[^ self inform: 
  'This is troubling -- you may regret having done that, because
  the change will apply to *all projects*, including pre-existing ones.  Unfortunately this check is done after the damage is done, so you
  may be hosed.  Fortunately, however, you can simply reverse your choice right now and perhaps no deep damage will have been done.'].
  
  	self universalTiles  "User just switched project to classic tiles"
  		ifFalse:
  			[self inform: 
  'CAUTION -- if you had any scripted objects in
  this project that already used universal tiles, 
  there is no reasonable way to go back to classic
  tiles.  Recommended course of action in that case:
  just toggle this preference right back to true.']
  		ifTrue:
  			[Preferences capitalizedReferences ifFalse:
  				[Preferences enable: #capitalizedReferences.
  				self inform: 
  'Note that the "capitalizedReferences" flag
  has now been automatically set to true for
  you, since this is required for the use of
  universal tiles.'].
  			World isMorph ifTrue:
  				[World recreateScripts]]!

Item was changed:
+ ----- Method: Preferences class>>useCategoryListsInViewers (in category 'prefs - misc') -----
- ----- Method: Preferences class>>useCategoryListsInViewers (in category 'hard-coded prefs') -----
  useCategoryListsInViewers
  	"Temporarily hard-coded pending viewer work underway"
  	^ false!

Item was added:
+ ----- Method: Preferences class>>useFormsInPaintBox (in category 'prefs - misc') -----
+ useFormsInPaintBox
+ 
+ 	^ self valueOfFlag: #useFormsInPaintBox!

Item was changed:
+ ----- Method: Preferences class>>useFormsInPaintBox: (in category 'prefs - misc') -----
- ----- Method: Preferences class>>useFormsInPaintBox: (in category 'paintbox') -----
  useFormsInPaintBox: aBoolean
  
  	self setPreference: #useFormsInPaintBox toValue: aBoolean
  !

Item was removed:
- ----- Method: Preferences class>>useOnlyServicesInMenu (in category 'standard queries') -----
- useOnlyServicesInMenu
- 	^ self
- 		valueOfFlag: #useOnlyServicesInMenu
- 		ifAbsent: [ false ]!

Item was removed:
- ----- Method: Preferences class>>useServicesInBrowserButtonBar (in category 'standard queries') -----
- useServicesInBrowserButtonBar
- 	^ self
- 		valueOfFlag: #useServicesInBrowserButtonBar
- 		ifAbsent: [ false ]!

Item was changed:
+ ----- Method: Preferences class>>valueOfFlag: (in category 'get/set - flags') -----
- ----- Method: Preferences class>>valueOfFlag: (in category 'get/set') -----
  valueOfFlag: aFlagName
  	"Utility method for all the preferences that are boolean, and for backward compatibility"
+ 	^self valueOfFlag: aFlagName ifAbsent: [false]!
- 	^self valueOfPreference: aFlagName ifAbsent: [false].!

Item was changed:
+ ----- Method: Preferences class>>valueOfFlag:ifAbsent: (in category 'get/set - flags') -----
- ----- Method: Preferences class>>valueOfFlag:ifAbsent: (in category 'get/set') -----
  valueOfFlag: aFlagName ifAbsent: booleanValuedBlock
  	"the same as in #valueOfFlag:"
  	^self valueOfPreference: aFlagName ifAbsent: booleanValuedBlock.!

Item was changed:
  ----- Method: Preferences class>>valueOfPreference:ifAbsent: (in category 'get/set') -----
+ valueOfPreference: aPreferenceSymbol ifAbsent: block
- valueOfPreference: aPreferenceSymbol ifAbsent: booleanValuedBlock
  	"Answer the value of the given preference"
+ 	^ (self preferenceAt: aPreferenceSymbol ifAbsent: [^ block value]) preferenceValue!
- 	^ (self preferenceAt: aPreferenceSymbol ifAbsent: [^ booleanValuedBlock value]) preferenceValue!

Item was changed:
+ ----- Method: Preferences class>>vectorVocabularySettingChanged (in category 'updating - system') -----
- ----- Method: Preferences class>>vectorVocabularySettingChanged (in category 'reacting to change') -----
  vectorVocabularySettingChanged
  	"The current value of the useVectorVocabulary flag has changed; now react.  No senders, but invoked by the Preference object associated with the #useVectorVocabulary preference."
  
  	Smalltalk isMorphic ifTrue:
  		[ActiveWorld makeVectorUseConformToPreference]!

Item was changed:
+ ----- Method: Preferences class>>wantsChangeSetLogging (in category 'support - misc') -----
- ----- Method: Preferences class>>wantsChangeSetLogging (in category 'misc') -----
  wantsChangeSetLogging
  	"Answer whether method changes in the receiver should be logged to current change set.  This circumlocution avoids such logging for programmatically-compiled methods in Preferences, removing an annoyance"
  
  	^ Utilities authorInitialsPerSe  ~= 'programmatic'!

Item was changed:
+ ----- Method: Preferences class>>windowColorFor: (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>windowColorFor: (in category 'window colors') -----
  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: [self uniformWindowColor].!

Item was changed:
+ ----- Method: Preferences class>>windowColorHelp (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>windowColorHelp (in category 'window colors') -----
  windowColorHelp
  	"Provide help for the window-color panel"
  
  	| helpString |
  	helpString := 
  'The "Window Colors" panel lets you select colors for many kinds of standard Squeak windows.
  
  You can change your color preference for any particular tool by clicking on the color swatch and then selecting the desired color from the resulting color-picker.
  
  The three buttons entitled "Bright", "Pastel", and "Gray" let you revert to any of three different standard color schemes.  
  
  The choices you make in the Window Colors panel only affect the colors of new windows that you open.
  
  You can make other tools have their colors governed by this panel by simply implementing #windowColorSpecification on the class side of the model -- consult implementors of that method to see examples of how to do this.'.
  
  	 (StringHolder new contents: helpString)
  		openLabel: 'About Window Colors'
  
  	"Preferences windowColorHelp"!

Item was changed:
+ ----- Method: Preferences class>>windowColorPreferenceForClassNamed: (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>windowColorPreferenceForClassNamed: (in category 'window colors') -----
  windowColorPreferenceForClassNamed: aClassName
  	| aColorSpec wording |
  	aColorSpec := WindowColorRegistry registeredWindowColorSpecFor: aClassName.
  	wording := aColorSpec ifNil: [aClassName] ifNotNil: [aColorSpec wording].
  	^(wording, 'WindowColor') asLegalSelector asSymbol.!

Item was changed:
+ ----- Method: Preferences class>>windowColorTable (in category 'prefs - window colors') -----
- ----- Method: Preferences class>>windowColorTable (in category 'window colors') -----
  windowColorTable
  	"Answer a list of WindowColorSpec objects, one for each tool to be represented in the window-color panel"
  	^ (WindowColorRegistry registeredWindowColorSpecs
  		asSortedCollection: 
  			[:specOne :specTwo | specOne wording < specTwo wording]) asArray.
  
  "Preferences windowColorTable"!

Item was changed:
+ ----- Method: Preferences class>>windowTitleFont (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>windowTitleFont (in category 'fonts') -----
  windowTitleFont
  	"Answer the standard font to use for window titles"
  	^  Parameters at: #windowTitleFont ifAbsentPut: [StrikeFont familyName: #NewYork size: 15]!

Item was changed:
+ ----- Method: Preferences class>>windowTitleStyle (in category 'prefs - fonts') -----
- ----- Method: Preferences class>>windowTitleStyle (in category 'fonts') -----
  windowTitleStyle
  	"Answer the standard style to use for window titles"
  	^  self windowTitleFont textStyle!

Item was changed:
  ----- Method: Project>>initializeProjectPreferences (in category 'project parameters') -----
  initializeProjectPreferences
  	"Initialize the project's preferences from currently-prevailing preferences that are currently being held in projects in this system"
  	
  	projectPreferenceFlagDictionary := Project current projectPreferenceFlagDictionary deepCopy.    "Project overrides in the new project start out being the same set of overrides in the calling project"
  
+ 	Preferences allPreferences do:  "in case we missed some"
- 	Preferences allPreferenceObjects do:  "in case we missed some"
  		[:aPreference |
  			aPreference localToProject ifTrue:
  				[(projectPreferenceFlagDictionary includesKey: aPreference name) ifFalse:
  			[projectPreferenceFlagDictionary at: aPreference name put: aPreference preferenceValue]]].
  
  	(Project current projectParameterAt: #disabledGlobalFlapIDs  ifAbsent: [nil]) ifNotNil:
  		[:idList | self projectParameterAt: #disabledGlobalFlapIDs put: idList copy]
  !

Item was changed:
  ----- Method: Project>>installProjectPreferences (in category 'menu messages') -----
  installProjectPreferences
  	"Install the settings of all preferences presently held individually by projects in the receiver's projectPreferenceFlagDictionary"
  
  	
+ 	Preferences allPreferences do:
- 	Preferences allPreferenceObjects do:
  		[:aPreference | | localValue | 
  			aPreference localToProject ifTrue:
  				[localValue := self projectPreferenceFlagDictionary at: aPreference name ifAbsent: [nil].
  				localValue ifNotNil:
  					[aPreference rawValue: localValue]]]!

Item was changed:
  ----- Method: Project>>saveProjectPreferences (in category 'menu messages') -----
  saveProjectPreferences
  	"Preserve the settings of all preferences presently held individually by projects in the receiver's projectPreferenceFlagDictionary"
  
+ 	Preferences allPreferences do:
- 	Preferences allPreferenceObjects do:
  		[:aPreference | 
  			aPreference localToProject ifTrue:
  				[projectPreferenceFlagDictionary at: aPreference name put: aPreference preferenceValue]]!



More information about the Packages mailing list