patches
author Claus Gittinger <cg@exept.de>
Thu, 18 Jul 1996 21:47:33 +0200
changeset 125 82e8b356f5c3
parent 117 578814b724ab
child 131 20fc8bdf1de5
permissions -rw-r--r--
*** empty log message ***

"/
"/ $Header$
"/
"/ This file is processed at initial startup 
"/ - not when resuming an image.
"/

"/
"/ install uncompiled classes as autoload
"/ classes ... (if not already present)
"/ Autoloaded classes will be automatically filed-in
"/ when first accessed. This allows a smaller executable,
"/ but creates a short delay, when the class is loaded on
"/ first access.
"/
"/ You can add more classes to these lists -
"/ i.e. all your classes you like to have around,
"/ but which are not needed often enough to justify
"/ machine code for them ...

|requiredClasses|

"/ GLXWorkstation forceGL:true.
"/ OperatingSystem disableSignal:14.


ObjectMemory infoPrinting:false.
Smalltalk loadBinaries:true.

Project notNil ifTrue:[
    Project setDefaultProject.
    Project current packageName:#'autoloaded'.
].

"/
"/ when filing in, keep source as reference to file
"/ (instead of keeping a string locally in the image)
"/
"/ I disable this - its dangerous if you fileIn
"/ classes from other directories and fileOut later clobbers those files
"/
"/ ClassCategoryReader sourceMode:#reference.

"/
"/ the following are required (either compiled or interpreted) ...
"/
requiredClasses := #( 
     ObsoleteObject
     BinaryIOManager BinaryInputManager BinaryOutputManager BinaryObjectStorage
     StringCollection
).

requiredClasses do:[:s |
    (Smalltalk at:s) isNil ifTrue:[
	('loading ' , s , ' ...') infoPrintNL.
	Smalltalk fileInClass:s initialize:true lazy:false silent:true
    ]
].
!

|optionalClasses optionalGames optionalDemos optionalApps optionalBench 
 optionalTools optionalViews optionalImage compat optionalPro optionalUI
 foundAutoloadList|

'installing autoloaded classes ...' infoPrintNL.

(Smalltalk at:#View) isNil ifTrue:[
    "/
    "/ mhmh - seems to be a minitalk
    "/ try for shared libraries ...
    "/
    Smalltalk loadBinaries:true.

    ObjectFileLoader notNil ifTrue:[
	#(
	  'libbasic2'
	  'libbasic3'
	  'libview'
	  'libview2'
	  'libwidg'
	  'libwidg2'
	  'libwidg3'
	  'libxt'
	  'libtool'
	  'XWorkstat'
	  'GLXWorkstat'
	) do:[:nm |
	    ('binary/' , nm) asFilename exists ifTrue:[
		('loading ' , nm , ' ...') infoPrintNL.
		(ObjectFileLoader loadObjectFile:'binary/' , nm , (ObjectFileLoader sharedLibraryExtension)) ifFalse:[
		    'load of ' , nm , ' failed' infoPrintNL
		]
	    ].
	].
	Workstation initialize.
	GraphicsContext initialize.
    ].

    optionalViews := #(
			DeviceWorkstation
			Workstation
			XWorkstation
			DisplayRootView
			SimpleView
			TopView
			StandardSystemView
			ModalBox
			View
			PseudoView
			DeviceDrawable
			DisplayMedium
			GraphicsContext
			Image
			ViewStyle
			KeyboardMap
			KeyboardForwarder
			TextCollector
			SynchronousWindowSensor
			WindowSensor
			WindowGroup
			WindowEvent
			WindowingTransformation
			FontDescription
			Font
			Form
			Cursor
			Color
			Depth1Image
			Depth8Image
			ResourcePack
			Model
			Controller
			ApplicationModel
			WindowBuilder
			PopUpView
			ShadowView
			Colormap
			DeviceHandle
			DeviceFormHandle
			DeviceViewHandle
			DisplayObject
		     ).
    optionalViews do:[:s |
	"install if not already compiled-in"
	(Smalltalk at:s) isNil ifTrue:[
	    Autoload subclass:s
		 instanceVariableNames:''
		 classVariableNames:''
		 poolDictionaries:''
		 category:'autoloaded-Views'
	]
    ].
    DeviceWorkstation autoload.
    XWorkstation autoload.
    Workstation autoload.
    DeviceHandle autoload.
    DeviceFormHandle autoload.
    DeviceViewHandle autoload.
].

foundAutoloadList := false.
[
    |f s s2 l clsName abbrev package cat rev|

    f := Smalltalk getSystemFileName:'include/abbrev.stc'.
    f notNil ifTrue:[
	s := f asFilename readStream.
	s notNil ifTrue:[
	    [s atEnd] whileFalse:[
		l := s nextLine withoutSeparators.
		l notEmpty ifTrue:[
		    s2 := l readStream.
		    clsName := (s2 upTo:Character space) withoutSeparators asSymbol.
		    abbrev := (s2 upTo:Character space) withoutSeparators asSymbol.
		    package := (s2 upTo:Character space) withoutSeparators asSymbol.
		    rev := nil.    
		    s2 skipSeparators.
		    s2 atEnd ifFalse:[
			s2 peek isDigit ifTrue:[
			    rev := (s2 upTo:Character space) withoutSeparators
			]
		    ].
		    cat := s2 upToEnd withoutSeparators.
                
		    (cat startsWith:$') ifTrue:[
			cat := cat copyFrom:2 to:(cat size - 1).

			"/ '  autoloaded: ' print. clsName print. ' in ' print. cat printNL.

			"/ install if not already compiled-in

			(Smalltalk at:clsName) isNil ifTrue:[
			    Autoload subclass:clsName
				instanceVariableNames:''
				classVariableNames:''
				poolDictionaries:''
				category:cat.
			    (Smalltalk at:clsName) package:package asSymbol.
			    rev notNil ifTrue:[
				(Smalltalk at:clsName) setBinaryRevision:rev
			    ]    
			]
		    ]
		]
	    ].
	    s close.
	    foundAutoloadList := true.
	].
    ]
] value.

foundAutoloadList ifFalse:[

"/ old scheme ...

"/
"/ the following are loaded on demand (if not already present)
"/ in most configurations, the widgets and tools are already built-in
"/ as compiled code. However, on pure-bytecode (minimal-) systems, these
"/ can be executed as bytecode as well.
"/

optionalGames := #(
		   Tetris TetrisBlock 
		   TicTacToeGame TicTacToeView TicTacToePlayer
		  ).

optionalDemos := #(
		   Animation GlobeDemo RoundGlobe
		   PenDemo CommanderDemo FractalPlantsDemo 
		   FractalPatternsDemo
		   Calendar CalculatorView
		   GLTeapotDemo GLTeapotView GLXYGraph
		   GLPlaneDemoView1 GLPlaneDemoView2
		   GLSphereDemoView1 GLSphereDemoView2
		   GLObjectDemoView GLCubeDemoView GLTetraDemoView
		   GLWireCubeDemoView GLWireSphereDemoView
		   GLCubeDemoView2 GLBrickCubeDemoView Logo3DView1 GLPlanetDemoView
		   GLOctaHedronDemoView GLDoughnutDemoView
		   RubicsCube RubicsCubeView

		   ColorDrawDemo ColorDrawDemo2 ColorDrawDemo3 FormDrawView
		  ).

optionalApps := #(
		  AddressBook AddressBook2 InitialLabelView AddressView

		  DrawTool DrawObject DrawLine DrawText
		  DrawRectangle DrawRoundRectangle DrawEllipse
		  DrawPolygon DrawCurve DrawGroup DrawView DrawImage
		  DrawVLine DrawHLine
		  PatternMenu LineMenu

		  LogicTool LogicView LogicObject Connection Input Output
		  Low High Inverter AndGate OrGate AndGate2 NandGate2 OrGate2 NorGate2 ExorGate2 
		  AndGate3 SubCircuit

		  MailView MailHandler POPMailHandler MailLetter MailReplyTextView

		  NewsView NewsHandler NNTPHandler NumberSet

		  ArchiveView DirectoryView DirectoryViewObject 
		  DirectoryObject FileObject

		  DocumentView DocumentReader RTFReader
		  DisplayText DisplayPicture DisplayIcon DisplaySound

		  Clock ClockView RoundClock RoundClock2

		  VocPanel VocView SoundStream
		 ).

optionalTools := #(
		  SystemBrowser DebugView FileBrowser DirectoryBrowser BrowserView
		  ProjectView Launcher Workspace ChangesBrowser NewLauncher
		  InspectorView OrderedCollectionInspectorView ContextInspectorView
		  DictionaryInspectorView
		  ImageInspectorView ColorInspectorView
		  AboutBox

		  Decompiler ChangeSetBrowser
		  EventMonitor ProcessMonitor MemoryMonitor MemoryUsageView

		  "/ highly EXPERIMENTAL

		  XtInterface WidgetWrapper ScrollWidgetWrapper
		  XtWidget XtTopLevel XtBox XtHTML 
		  XtWidgetWithLabelAndAction

		  CLauncher CBrowser CChange CDirectory CEditor CFilter CHistory CCSetup
		  AbstractSourceCodeManager CVSSourceCodeManager
		 ).

optionalViews := #(
		  Model ApplicationModel WindowBuilder

		  GLXView GLPoint3D SliderBox 
		  DialogBox OptionBox TextBox 
		  InputView Ruler VerticalRuler TextRuler
		  Slider HorizontalSlider
		  SteppingSlider HorizontalSteppingSlider
		  VariablePanel VariableVerticalPanel VariableHorizontalPanel
		  VariablePanelController VariableVerticalPanelController VariableHorizontalPanelController
		  FontPanel FramedBox Separator FileSelectionBox FileSaveBox
		  RadioButton RadioButtonGroup "MotionButton MenuButton"
		  PullDownMenu CheckBox
		  RadioButtonController

		  SyncedMultiColumnTextView 
		  TwoColumnTextView DiffTextView 
		  ThreeColumnTextView Diff3TextView 
		  FilenameEditField FilenameEnterBox
		  ImageSelectionBox

		  ScreenSaver LightInTheDark LightInTheDark2

		  ImageView ImageEditView LabelledEnterField
		  Depth1Image Depth2Image Depth4Image Depth8Image Depth24Image
		  TreeView TreeGraphView ClassTreeView ClassTreeGraphView WindowTreeView

		  "/ ColorPanel HLSPanel RGBPanel ColorWheel ThreeSliderPanel
		  "/ ColorSlider HueSlider RGBSlider SteppingColorSlider SteppingHueSlider
		  "/ Scale HorizontalScale 

		  TabulatorSpecification 
		  ListEntry MultiColListEntry ColoredListEntry
		  ViewScroller TabSpecRuler ComboView ComboListView ComboBoxView

		  ProgressIndicator AnimatedLabel ActionWaitBox
		 ).

optionalPro := #(
		  EventListener
		  ActiveHelpView ActiveHelp

		  Builder BuilderView BuilderTreeView
		  BuilderClassBox BuilderVariablesBox

		  SelectionInHierarchy SelectionInHierarchyView
		  HierarchyNode
		  PSGraphicsContext PSFont PSFontFamily PSMedium
		 ).
        
"/ optionalUI := #(
"/                  UIBuilder UIPainter UIMenuEditor
"/
"/                  UISpecification
"/                  ActionButtonSpec CheckBoxSpec FullSpec InputFieldSpec
"/                  LabelSpec SequenceViewSpec UnknownSpec WindowSpec
"/                 ).

"/ notice, that it does not really make sense to
"/ run Benchmarks in interpreted mode ..."
"/ If you really weant to measure the system, include (load) compiled
"/ benchmark classes

"/optionalBench := #(
"/                  SlopstoneBenchmark SmopstoneBenchmark
"/                  STXBenchmarks1 STXBenchmarks2
"/
"/                  "DeltaBlue benchmark"
"/                  AbstractConstraint BinaryConstraint Constraint 
"/                  DBMethod DBVariable EditConstraint
"/                  EqualityConstraint Plan Planner ScaleConstraint
"/                  StayConstraint Strength UnaryConstraint XMouseConstraint
"/                  YMouseConstraint
"/
"/                  "RichardsBenchmarks"
"/                  DeviceTaskDataRecord HandlerTaskDataRecord
"/                  IdleTaskDataRecord Packet RBObject RichardsBenchmarks
"/                  TaskControlBlock TaskState WorkerTaskDataRecord
"/
"/                  "self benchmarks"
"/                  AbstractBenchmark AtAllPutBenchmark BenchmarkRunner
"/                  BubbleSort2Array BubbleSort2Benchmark BubbleSortBenchmark
"/                  Cons FastSumToBenchmark HanoiBenchmark HanoiDisk
"/                  IncrementAllBenchmark IntMM2Array IntMM2Benchmark
"/                  IntMM2Matrix IntMMBenchmark MM2Benchmark MMBenchmark
"/                  NestedLoopBenchmark Perm2Benchmark PermArray PermBenchmark
"/                  PuzzleArray PuzzleBenchmark Queens2Benchmark QueensBenchmark
"/                  Quicksort2Array Quicksort2Benchmark QuicksortBenchmark
"/                  RecurseBenchmark SieveBenchmark SumAllBenchmark
"/                  SumFromToBenchmark SumToBenchmark TakBenchmark TaklBenchmark
"/                  Towers2Benchmark Towers2Disk TowersBenchmark
"/                  TowersBenchmarkElement TreeSort2Benchmark TreeSort2Node
"/                  TreeSortBenchmark TreeSortNodeBenchmark
"/                 ).
"/
optionalImage := #(
		  GIFReader TIFFReader FaceReader WindowsIconReader SunRasterReader
		  XBMReader JPEGReader PBMReader ST80FormReader XPMReader
		  PCXReader TargaReader XWDReader BlitImageReader
		 ).

optionalClasses := #(
		  EpsonFX1PrinterStream HPLjetIIPrinterStream
		  PostscriptPrinterStream
		  ValueLink 
		  MessageTracer WrappedMethod

		  PersistencyManager BinaryIOManager BinaryInputManager
		  BinaryOutputManager DBFile BinaryObjectStorage

		  RDoItServer SNMPOID SNMPSession

		  HandlerCollection CacheDictionary
		  Plug Random MessageSend MessageChannel
		  MessageTally CallChain ProfileTree
		  GraphicsAttributes
		  Circle EllipticalArc Spline Polygon Curve LineSegment

		  VisualComponent VisualPart Wrapper StrokingWrapper FillingWrapper
                
		  ActorStream TokenizedStream
		  RecursionLock Monitor Promise LockedFileStream

		  BooleanArray WordArray Chain ChainLink

		  JISEncodedString GBEncodedString BIG5EncodedString

		  "/ VariableArray VariableString "/ backward compatibility - these will vanish
	     ).

optionalViews do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Views'
    ]
].

optionalTools do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Tools'
    ]
].

optionalGames do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Games'
    ]
].

optionalDemos do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Demos'
    ]
].

optionalApps do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Applications'
    ]
].

"/optionalBench do:[:s |
"/    "install if not already compiled-in"
"/    (Smalltalk at:s) isNil ifTrue:[
"/        Autoload subclass:s
"/             instanceVariableNames:''
"/             classVariableNames:''
"/             poolDictionaries:''
"/             category:'autoloaded-Benchmarks'
"/    ]
"/].

optionalImage do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Images'
    ]
].

optionalClasses do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Classes'
    ]
].

optionalPro notNil ifTrue:[
  optionalPro do:[:s |
    "install if not already compiled-in"

    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-Classes'
    ]
  ]
].

optionalUI notNil ifTrue:[
  optionalUI do:[:s |
    "install if not already compiled-in"

    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-UI'
    ]
  ]
].

"/
"/ install all widget & tool classes as autoloaded
"/ for compact systems (which have no GUI classes compiled in) ...
"/

"/
"/  ... but only, if this is not a non GUI smalltalk
"/
Workstation notNil ifTrue:[
    optionalClasses := #(
				ArrowButton
				Button
				ButtonController
				CheckToggle
				ClickMenuView
				CodeView
				EnterFieldGroup
				EditTextView
				EditField
				EnterBox
				EnterBox2
				FileSaveBox
				FileSelectionBox
				FileSelectionList
				FontPanel
				HorizontalMiniScroller
				HorizontalPanelView
				HorizontalScrollBar
				HorizontalScroller
				HVScrollableView
				InfoBox
				ListSelectionBox
				Label
				ListView
				MenuView
				MiniScroller
				ObjectView
				PanelView
				PopUpList
				PopUpListController
				PopUpMenu
				PullDownMenu
				ScrollableView
				ScrollBar
				Scroller
				SelectionInListView
				TextCollector
				TextView
				Toggle
				ToggleController
				VerticalPanelView
				VariablePanel
				VariablePanelController
				VariableHorizontalPanel
				VariableHorizontalPanelController
				VariableVerticalPanel
				VariableVerticalPanelController
				WarningBox
				YesNoBox

				TableView
				TableSpecification
				TableRowHandle
				TableColumnView
				TableColumnSpecification
				SelTableColumnSpecification
				TableDemoElement
		 ).

    optionalClasses do:[:s |
	"install if not already compiled-in"
	(Smalltalk at:s) isNil ifTrue:[
	    Autoload subclass:s
		 instanceVariableNames:''
		 classVariableNames:''
		 poolDictionaries:''
		 category:'autoloaded-Views'.
	].
    ]
].

"/
"/ additional compatibility classes (many are empty dummies to allow fileIn at least)
"/
compat := #(
	    BitBlt Pen Commander DrawingPen
	    OpaqueForm 
	    "/
	    "/ the path stuff is no longer compatible
	    "/ with ST-80 (i.e. dropped in ST; different implementation in VW)
	    "/
	    AbstractPath Path 
	    Arc DCircle Curve LinearFit Arrow Line Spline Ellipse 

	    ActionMenu 
	    FillInTheBlank
	    KeyedSet
	    FormView
	    NoController 
	    MouseMenuController
	    StandardSystemController
	    ControllerWithMenu
	    ComposedText
	    ComposedTextView
	    CompositeView SubCanvas
	    ClassOrganizer
	    ApplicationController
	    SocketAddress UDSocketAddress IPSocketAddress
	    UnixProcess CEnvironment
	    Layout LayoutOrigin LayoutFrame
	    Icon Mask CachedImage
	    CoveragePalette
	    TextStream
	    ColorValue
	    SimpleDialog
	    SourceFileManager
	    ValueModel ValueHolder BufferedValueHolder TriggerValue BlockValue
	    ConvertedValue
	    StringHolder SelectionInList MultiSelectionInList SelectionInTable
	    RowAdaptor SimpleBorder TableAdaptor TableInterface TwoDList
	    PrintConverter
	    PluggableAdaptor ProtocolAdaptor AspectAdaptor UpdateAdaptor
	    CodeStream MethodNode NullScope ProgramNodeBuilder
	    MenuItem TimestampPrintPolicy
	   ).

compat do:[:s |
    "install if not already compiled-in"
    (Smalltalk at:s) isNil ifTrue:[
	Autoload subclass:s
	     instanceVariableNames:''
	     classVariableNames:''
	     poolDictionaries:''
	     category:'autoloaded-ST80-Classes'
    ]
]

] "/ end of old scheme ...
!

"/
"/ a kludge: we might have added new ImageReaders above - let Image know about it
"/
"avoid introducing a new global ..."
(Smalltalk includesKey:#Image) ifTrue:[
    (Smalltalk at:#Image) isBehavior ifTrue:[
	(Smalltalk at:#Image) initializeFileFormatTable.
    ]
].

"/
"/ some ST80 name aliases
"/ (actually, much more is needed - this is just a start ...)
"/
(Smalltalk at:#StandardSystemView) notNil ifTrue:[
	Smalltalk at:#ScheduledWindow put:StandardSystemView
].
(Smalltalk at:#Socket) notNil ifTrue:[
	Smalltalk at:#UnixSocketAccessor put:(Smalltalk at:#Socket)
].
Smalltalk at:#BlockClosure put:Block.
Smalltalk at:#Dialog put:DialogBox.
Smalltalk at:#DialogView put:DialogBox.

Smalltalk at:#Console put:Stderr.

FileDirectory notNil ifTrue:[
	Smalltalk at:#Disk put:(FileDirectory directoryNamed:'/')
].
Display notNil ifTrue:[
	Smalltalk at:#Window put:(Display class).
	Smalltalk at:#Screen put:(Display class).
].

"/
"/ ST/X has (currently) no Double, but Float is what ST-80's Double is ...
"/
Smalltalk at:#Double put:Float.

Project notNil ifTrue:[
    Project setDefaultProject.
    Project current packageName:#'patches'.
].


Class catchMethodRedefinitions:false.
'installing patches ...' infoPrintNL.

"/
"/ the following patches where added by the changesBrowsers 'make change a patch'
"/ function ...
"/
!