display.rc
author Claus Gittinger <cg@exept.de>
Wed, 26 Jan 2000 16:48:32 +0100
changeset 416 b97097ff3702
parent 406 c5cf7259abcd
child 417 d1e57f03fc28
permissions -rw-r--r--
*** empty log message ***

"*
 * $Header$
 *
 * MIMEType: application/x-smalltalk-source
 *
 * ST/X startup display configuration file:
 *
 * DONT add site specific things here - use your own d_xxx.rc file instead
 * where xxx stands for your displays hostname(s)
 *
 * display related configuration:
 *   first do some common setup, then try to figure out
 *   the kind of display and find a
 *   display specific initialization file.
 *"

"*
 * define extensions for image files (i.e. extension-to-readerClass
 * mappings). Some of the readers are autoloaded (see patches file).
 * Moved this from code to here (from Image-class), for more flexibility
 * actually since this is not display- but host specific (naming conventions)
 * it should be moved into the host.rc or h_xxx.rc file
 *
 * Some readers are optional and therefore, only installed if the
 * corresponding Smalltalk class is nonNil; not accessing it as global,
 * but via a SMalltalk>>at: message - this avoids warning messages
 * during startup, if classes are missing and the globals are undefined.
 *"
|rdr|

MIMETypes notNil ifTrue:[
'adding mime...' printCR.
    rdr := Smalltalk at:#XBMReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-xbitmap' suffix:'xbm' reader:rdr.
	MIMETypes defineImageType:nil               suffix:'bm'  reader:rdr.
    ].
    rdr := Smalltalk at:#TIFFReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/tiff'      suffix:'tif'  reader:rdr.
	MIMETypes defineImageType:nil               suffix:'tiff' reader:rdr.
    ].
    rdr := Smalltalk at:#GIFReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/gif'   suffix:'gif'  reader:rdr.
    ].

    "/ still to come ...
    "/ '.img'  put:IMGReader.
    "/ '.IMG'  put:IMGReader.
    "/ '.mac'  put:MacPaintReader. 

    rdr := Smalltalk at:#SunRasterReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:nil               suffix:'im8'  reader:rdr.
	MIMETypes defineImageType:nil               suffix:'icon'  reader:rdr.
    ].

    "/ still to come ...
    "/ '.g3'   put:G3FileReader.   

    rdr := Smalltalk at:#WindowsIconReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-MS-bmp'  suffix:'bmp' reader:rdr.
	MIMETypes defineImageType:'image/x-MS-ico'  suffix:'ico' reader:rdr.
    ].

    rdr := Smalltalk at:#JPEGReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/jpeg'  suffix:'jpg' reader:rdr.
	MIMETypes defineImageType:nil           suffix:'jpeg' reader:rdr.
    ].

    rdr := Smalltalk at:#PBMReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-portable-pixmap'  suffix:'ppm' reader:rdr.
	MIMETypes defineImageType:'image/x-portable-bitmap'  suffix:'pbm' reader:rdr.
	MIMETypes defineImageType:'image/x-portable-graymap' suffix:'pgm' reader:rdr.
	MIMETypes defineImageType:'image/x-portable-anymap'  suffix:'pnm' reader:rdr.
    ].

    rdr := Smalltalk at:#ST80FormReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:nil           suffix:'form' reader:rdr.
    ].

    rdr := Smalltalk at:#FaceReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:nil           suffix:'face' reader:rdr.
    ].

    rdr := Smalltalk at:#XPMReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-xpixmap' suffix:'xpm' reader:rdr.
	MIMETypes defineImageType:nil               suffix:'pm' reader:rdr.
    ].

    rdr := Smalltalk at:#PCXReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-pcx' suffix:'pcx' reader:rdr.
    ].

    rdr := Smalltalk at:#TargaReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-targa' suffix:'tga' reader:rdr.
    ].

    rdr := Smalltalk at:#XWDReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-xwindowdump' suffix:'xwd' reader:rdr.
    ].

    rdr := Smalltalk at:#BlitImageReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:nil suffix:'48x48x1' reader:rdr.
    ].

    rdr := Smalltalk at:#IrisRGBReader ifAbsent:nil.
    rdr notNil ifTrue:[
	MIMETypes defineImageType:'image/x-rgb' suffix:'rgb' reader:rdr.
    ].

    "/ experimanetal and not yet finished / delivered

    "/ rdr := Smalltalk at:#PNGReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/     MIMETypes defineImageType:'image/x-png' suffix:'png' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#PCDReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/     MIMETypes defineImageType:'image/x-photo-cd' suffix:'pcd' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#CMURasterReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/     MIMETypes defineImageType:'image/x-cmu-raster' suffix:'ras' reader:rdr.
    "/ ].

    "/ movie formats - experimanetal and not yet complete / finished / delivered

    "/ rdr := Smalltalk at:#FLIReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/     MIMETypes defineImageType:'video/x-fli' suffix:'fli' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#AVIReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/     MIMETypes defineImageType:'video/x-msvideo' suffix:'avi' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#QuickTimeReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/    MIMETypes defineImageType:'video/quicktime' suffix:'qt' reader:rdr.
    "/    MIMETypes defineImageType:nil               suffix:'mov' reader:rdr.
    "/    MIMETypes defineImageType:nil               suffix:'moov' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#MPEG2Reader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/    MIMETypes defineImageType:'video/x-mpeg2' suffix:'mpg2' reader:rdr.
    "/    MIMETypes defineImageType:nil             suffix:'mpv2' reader:rdr.
    "/    MIMETypes defineImageType:nil             suffix:'mp2v' reader:rdr.
    "/    MIMETypes defineImageType:nil             suffix:'mp2' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#MPEGReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/    MIMETypes defineImageType:'video/mpeg' suffix:'mpg' reader:rdr.
    "/    MIMETypes defineImageType:nil          suffix:'mpeg' reader:rdr.
    "/    MIMETypes defineImageType:nil          suffix:'mpe' reader:rdr.
    "/    MIMETypes defineImageType:nil          suffix:'mpv' reader:rdr.
    "/    MIMETypes defineImageType:nil          suffix:'vbs' reader:rdr.
    "/    MIMETypes defineImageType:nil          suffix:'mpegv' reader:rdr.
    "/ ].

    "/ rdr := Smalltalk at:#SGIMovieReader ifAbsent:nil.
    "/ rdr notNil ifTrue:[
    "/    MIMETypes defineImageType:'video/x-sgi-movie' suffix:'movie' reader:rdr.
    "/ ].
]
!

"*
 * find out, on what type of display we run
 * (boy, they should have added this to the x-protocol)
 *
 * look for a file named 'd_<displayname>.rc' and file it in
 *"

|displayDevice arguments displayVar display displayType isWindowsDisplay s idx|

"find display name from environment or -display argument"

arguments := Smalltalk commandLineArguments.
arguments size > 0 ifTrue:[
    idx := arguments indexOf:'-display'.
    idx ~~ 0 ifTrue:[
	displayVar := arguments at:idx + 1.
	arguments removeAtIndex:idx+1.
	arguments removeAtIndex:idx.
    ].
].
displayVar isNil ifTrue:[
    displayVar := OperatingSystem getEnvironment:'DISPLAY'.
].

displayDevice := Screen current.
isWindowsDisplay := (displayDevice platformName = 'WIN32').

display := displayVar.

(displayVar notNil or:[isWindowsDisplay]) ifTrue:[
    "/ figure out the hostname of the display,
    "/ to read d_<hostname>.rc

    (isWindowsDisplay
    or:[(displayVar startsWith:':0') 
    or:[(displayVar startsWith:'unix:')
    or:[displayVar startsWith:'shm:']]]) ifTrue:[
	"running on a local display"
	display := OperatingSystem getHostName.
    ] ifFalse:[
	(displayVar endsWith:':0') ifTrue:[
	    display := displayVar copyTo:(displayVar size - 2)
	] ifFalse:[
	    (displayVar endsWith:':0.0') ifTrue:[
		display := displayVar copyTo:(displayVar size - 4)
	    ]
	]
    ].

    "/ if no host specific info,
    "/ take the display vendor information,
    "/ to read d_<vendor>.rc

    display isNil ifTrue:[
	isWindowsDisplay ifTrue:[
	    display := 'win32'
	]
    ].

    display isNil ifTrue:[
	'display.rc [warning]: cannot determine display I am running on' errorPrintCR.
    ] ifFalse:[
	"
	 if there is a corresponding file d_<displayName>.rc ...
	 thats the one to take.
	"
	s := Smalltalk systemFileStreamFor:('d_' , display , '.rc').
	s notNil ifTrue:[
	    displayType := display.
	    s close.
	].

	"
	 if the X-server gives some info,
	 take that as a base
	"
	displayType isNil ifTrue:[
	    |serverVendor|
	    serverVendor := displayDevice serverVendor.

	    (serverVendor startsWith:'The XFree86 Project, Inc')
	    ifTrue:[
		displayType := 'xfree'
	    ].
	    (serverVendor startsWith:'Silicon Graphics')
	    ifTrue:[
		displayType := 'iris'
	    ].
	    (serverVendor startsWith:'International Business Machines')
	    ifTrue:[
		displayType := 'aix'
	    ].
	    (serverVendor startsWith:'DECWINDOWS Digital Equipment')
	    ifTrue:[
		displayType := 'dec'
	    ].
	    (serverVendor startsWith:'Hummingbird Communications')
	    ifTrue:[
		displayType := 'exceed'
	    ].
	].

	"
	 otherwise ...
	"
	displayType isNil ifTrue:[
	    "
	     just an example - stuff can also be hardwired here ...
	    "
	    display notNil ifTrue:[
		"
		 if, in your organization, all displays are of the
		 same type,
		 use something like:
		"
"/                OperatingSystem getDomainName = '<yourDomain>.de' ifTrue:[
"/                      displayType := 'myDisplayType'
"/                  ].

		"
		 if, in your organization, the display type can
		 be deduced from the hostname,
		 use something like:
		 (take the exept code below as a guide ...)
		"
"/                (display startsWith:'slsv') ifTrue:[
"/                    "all those machines at SEL are suns"
"/                    displayType := 'sun'
"/                ].
"/                (display startsWith:'frxt') ifTrue:[
"/                    "all those machines at AEG are xterminals"
"/                    displayType := 'xterminal'
"/                ].
"/                (display startsWith:'frlx') ifTrue:[
"/                    "all those machines at AEG are linux boxes with olwm"
"/                    displayType := 'linux_olwm'
"/                ].

"/                OperatingSystem getDomainName = 'exept.de' ifTrue:[
"/                    (display startsWith:'clam') ifTrue:[
"/                        displayType := 'next'
"/                    ].
"/                    (display startsWith:'porty') ifTrue:[
"/                        displayType := 'portable'
"/                    ].
"/                    (display startsWith:'blue') ifTrue:[
"/                        displayType := 'iris'
"/                    ].
"/                    (display startsWith:'sun') ifTrue:[
"/                        displayType := 'sun'
"/                    ].
"/                    (display startsWith:'sol') ifTrue:[
"/                        displayType := 'sun'
"/                    ].
"/                    (display startsWith:'hp') ifTrue:[
"/                        displayType := 'hpux'
"/                    ].
"/                ].
	    ].
	].
    ].

    "
     final fallback: take OperatingSystem if we are running a local
     connection.
     the used name is one of:
	d_next.rc
	d_iris.rc
	etc.
    "
    displayType isNil ifTrue:[
	"use type of machine smalltalk is running on as default ..."

	(isWindowsDisplay
	or:[(displayVar startsWith:':0')
	or:[(displayVar startsWith:(OperatingSystem getHostName , ':0'))]]) 
	ifTrue:[
	    displayType := OperatingSystem getSystemType.
	]
    ]
].

"now, if the above mess found something, we have it in displayType;
 fileIn d_<displayType>.rc"

displayType notNil ifTrue:[
    ((Smalltalk at:#'_ImageDisplayName') ~= displayType
    or:[displayDevice ~~ Display]) ifTrue:[

	"/
	"/ mouse-button translation
	"/
	"/ (currently, allowed are 1 2 and #paste)
	"/ 1      - button1; used to select (i.e. left button)
	"/ 2      - button2; pops up a menu (i.e. middle button)
	"/ #paste - paste the clipBoard contents
	"/
	"/ the following line puts paste onto the right button (as in xterm):
	"/
	Screen buttonTranslation:#(1 2 #paste).

	"/
	"/ while that one puts the pop-up menu both on the middle and right buttons:
	"/
	Screen buttonTranslation:#(1 2 2).

	"/
	"/ lefthanders can use:
	"/
	"/ Screen buttonTranslation:#(2 2 1).

	"/ common keyboard setup;
	"/ might be changed later by a display-specific
	"/ rc file (especially, d_windows does this)

	"/ 'display.rc [info]: reading ''keyboard.rc'' ...' infoPrintCR.
	Smalltalk fileIn:'keyboard.rc'.


	"Default for supportsDeepIcons is false.
	 Set default value only when ImageDisplayName changes
	 and d_displayType is called.
	"
	displayDevice supportsDeepIcons:false.
	Smalltalk isStandAloneApp ifFalse:[
	    ('display.rc [info]: ') infoPrint.
	    (Smalltalk getSystemFileName:('d_' , displayType , '.rc')) isNil ifTrue:[
		'trying' infoPrint.
	    ] ifFalse:[
		'reading' infoPrint.
	    ].
	    (' display setup ''d_' , displayType , '.rc'' ...') infoPrintCR.
	].

	Smalltalk fileIn:('d_' , displayType , '.rc')
    ].
    displayDevice == Display ifTrue:[
	Smalltalk at:#'_ImageDisplayName' put:displayType
    ]
]
!

"*
 * now, this is a nice one:
 *
 * if the image was saved on a different type of display, ask
 * user, if he/she'd like to have the style changed.
 *"
Display notNil ifTrue:[
    |depthChange colorChange greyChange reconfigure|

    depthChange := false.
    colorChange := false.
    greyChange := false.

    (Smalltalk includesKey:#'_ImageDisplayDepth') ifTrue:[
	depthChange := ((Smalltalk at:#'_ImageDisplayDepth') ~~ Display depth)
    ].
    (Smalltalk includesKey:#'_ImageDisplayHasColor') ifTrue:[
	colorChange := ((Smalltalk at:#'_ImageDisplayHasColors') ~~ Display hasColors)
    ].
    (Smalltalk includesKey:#'_ImageDisplayHasGreyscales') ifTrue:[
	greyChange := ((Smalltalk at:#'_ImageDisplayHasGreyscales') ~~ Display hasGreyscales)
    ].
    (depthChange or:[colorChange or:[greyChange]]) ifTrue:[
	reconfigure := self confirm:'Display capabilities have changed

    Do you want to reconfigure the view style ?'.

	reconfigure ifTrue:[
	    Screen current knownViews do:[:aView |
		aView notNil ifTrue:[
		    aView reinitStyle.
		]
	    ].
	].
    ].

    Smalltalk at:#'_ImageDisplayDepth' put:Display depth.
    Smalltalk at:#'_ImageDisplayHasColors' put:Display hasColors.
    Smalltalk at:#'_ImageDisplayHasGreyscales' put:Display hasGreyscales.
]
!

"/
"/ set a default style, if not been set by rc-file
"/ this is set according the system we are running on.
"/ Notice: normally, the below is not needed, since the style
"/         is always set by the d_xxx.rc file.
"/         Except, when the d_xxx.rc is not present.
"/

|type wm|

View defaultStyle isNil ifTrue:[
    type := OperatingSystem getSystemType.
    type = 'sunos' ifTrue:[
	View defaultStyle:#openwin
    ].
    type = 'next' ifTrue:[
	View defaultStyle:#next
    ].
    type = 'iris' ifTrue:[
	View defaultStyle:#iris
    ].
    type = 'exceed' ifTrue:[
	View defaultStyle:#mswindows95
    ].
    type = 'linux' ifTrue:[
	"/ if on the local display, and WINDOWMANAGER is fvwm95,
	"/ use win95 style as default.
	wm := OperatingSystem getEnvironment:'WINDOWMANAGER'.
	(((OperatingSystem getEnvironment:'DISPLAY') = ':0')
	and:[wm notNil 
	and:[wm endsWith:'fvwm95']])
	ifTrue:[
	    View defaultStyle:#mswindows95 
	] ifFalse:[
	    View defaultStyle:#iris 
	]
    ].
    type = 'hpux' ifTrue:[
	View defaultStyle:#'motif' 
    ].
    type = 'ultrix' ifTrue:[
	View defaultStyle:#'motif_dec2' 
    ].
    type = 'os2' ifTrue:[
	View defaultStyle:#'os2' 
    ].
    (type = 'win32') ifTrue:[
	(Number readFromString:((OperatingSystem getSystemInfo) at:#release) onError:0)
	>= 4.0 ifTrue:[
	    View defaultStyle:#'mswindows95' 
	] ifFalse:[
	    View defaultStyle:#'mswindows' 
	]
    ].

    "/ final fallBack ...

    View defaultStyle isNil ifTrue:[
	(Display notNil and:[Display hasGreyscales]) ifTrue:[
	    View defaultStyle:#iris
	] ifFalse:[
	    View defaultStyle:#normal
	]
    ].
    'display.rc [info]: no style set - default to ' infoPrint.
    View defaultStyle infoPrintCR
]
!