display.rc
author Claus Gittinger <cg@exept.de>
Mon, 21 Feb 2005 13:49:23 +0100
changeset 641 cb95749aba2e
parent 631 e68948144e21
child 715 529ebe47d1e9
permissions -rw-r--r--
*** empty log message ***

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

"*
 * 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|

"/ XXX - almost obsolete - should go into MIMETypes class.
MIMETypes notNil ifTrue:[
    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)
 *
 * then, look for a file named 'd_<displayname>.rc' and file it in
 *"

|displayDevice displayVar display displayType s|

displayDevice := Screen current.
(displayDevice platformName = 'WIN32') ifTrue:[
    "running on a local windows display"
    display := OperatingSystem getHostName.
] ifFalse:[
    displayVar := displayDevice displayName.
    displayVar notNil ifTrue:[
	"/ figure out the hostname of the display,
	"/ to read d_<hostname>.rc

	((displayVar startsWith:':')
	 or:[(displayVar startsWith:'unix:')
	 or:[displayVar startsWith:'shm:']]) ifTrue:[
	    "running on a local display"
	    display := OperatingSystem getHostName.
	] ifFalse:[
	    [(displayVar size > 1) and:[displayVar last isDigit]] whileTrue:[
		displayVar := displayVar copyWithoutLast:1.
	    ].
	    ((displayVar size > 1) and:[displayVar last == $.]) ifTrue:[
		displayVar := displayVar copyWithoutLast:1.
		[(displayVar size > 1) and:[displayVar last isDigit]] whileTrue:[
		    displayVar := displayVar copyWithoutLast:1.
		].
	    ].
	    ((displayVar size > 1) and:[displayVar last == $:]) ifTrue:[
		display := displayVar copyWithoutLast:1
	    ]
	].
    ].
].

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.
    ].
].

displayType isNil ifTrue:[
    "
     if no host specific info,
     take the display vendor information,
     to read d_<vendor>.rc
    "

    "
     if the X-server gives some info,
     take that as a base
    "
    |serverVendor|

    serverVendor := displayDevice serverVendor ? ''.

    (serverVendor startsWith:'The XFree86 Project')
    ifTrue:[
	displayType := 'xfree'
    ].
    (serverVendor startsWith:'The X.Org Foundation')
    ifTrue:[
	displayType := 'xorg'
    ].
    (serverVendor startsWith:'Pexus Systems, Inc')
    ifTrue:[
	displayType := 'xdeep32'
    ].
    (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'
    ].
    (serverVendor startsWith:'Hewlett-Packard Company')
    ifTrue:[
	displayType := 'hpux'
    ].
    (serverVendor startsWith:'AT&T Laboratories Cambridge')
    ifTrue:[
	displayType := 'vnc'
    ].
].

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'
"/            ].
"/        ].
     ].
].

displayType isNil ifTrue:[
    "
     final fallback: use local hosts name, if display is the local one;
     otherwise, use the type of display

     the used name is one of:
	d_hostName.rc
     for local display;
     or:
	d_X11.rc
	d_WIN32.rc
     for remote display.
    "
    display = OperatingSystem getHostName ifTrue:[
	displayType := OperatingSystem getSystemType.
    ] ifFalse:[
	displayType := displayDevice platformName.
    ]
].

"now, if the above mess found something, we have it in displayType;
 fileIn d_<displayType>.rc.
 If we are running on the default display, do it only if
 the displayType changed (e.g. image restart on another display)."

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

	"/
	"/ mouse-button translation
	"/
	"/ (currently, allowed are 1,2,.. , #paste, #wheelFwd and #wheelBwd)
	"/ 1      - button1; used to select (i.e. left button)
	"/ 2      - button2; pops up a menu (i.e. middle button)
	"/ #paste    - paste the clipBoard contents
	"/ #wheelFwd - simulates a mouseWheel forward motion (hp displays)
	"/ #wheelBwd - simulates a mouseWheel backward motion (hp displays)
	"/
	"/ the following line puts paste onto the right button (as in xterm):
	"/
	"/ Screen current buttonTranslation:#(1 2 #paste 4 5 6 7).

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

	"/
	"/ lefthanders can use:
	"/
	"/ displayDevice buttonTranslation:#(2 2 1 #wheelFwd #wheelBwd 6 7).

	"/ 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'.

	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')
    ].

    "If we are running on the default display, remember current setting for possible
     image restart"
    displayDevice == Screen default ifTrue:[
	Smalltalk at:#'_ImageDisplayName' put:displayType.
    ].
]
!

"*
 * now, this is a nice one:
 *
 * if we are running on the default display and the image was saved
 * on a different type of display, ask the user,
 * if he/she'd like to have the style changed.
 *"
|currentScreen|

currentScreen := Screen current.
currentScreen == Screen default ifTrue:[
    |depthChange colorChange greyChange reconfigure|

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

    (Smalltalk includesKey:#'_ImageDisplayDepth') ifTrue:[
	depthChange := ((Smalltalk at:#'_ImageDisplayDepth') ~~ currentScreen depth)
    ].
    (Smalltalk includesKey:#'_ImageDisplayHasColor') ifTrue:[
	colorChange := ((Smalltalk at:#'_ImageDisplayHasColors') ~~ currentScreen hasColors)
    ].
    (Smalltalk includesKey:#'_ImageDisplayHasGreyscales') ifTrue:[
	greyChange := ((Smalltalk at:#'_ImageDisplayHasGreyscales') ~~ currentScreen 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:currentScreen depth.
    Smalltalk at:#'_ImageDisplayHasColors' put:currentScreen hasColors.
    Smalltalk at:#'_ImageDisplayHasGreyscales' put:currentScreen 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 style|

View defaultStyle isNil ifTrue:[
    style := #mswindows95.
    type := OperatingSystem getSystemType.
    type = 'sunos' ifTrue:[
	"/ CG: now obsolete; use windows-style here
	"/ View defaultStyle:#openwin
	style := #mswindows95
    ].
    type = 'next' ifTrue:[
	style := #next
    ].
    type = 'iris' ifTrue:[
	style := #iris
    ].
    type = 'os2' ifTrue:[
	style := #os2
    ].
    type = 'win32' ifTrue:[
	(OperatingSystem getSystemInfo at:#'system') = 'xp' ifTrue:[
	    style := #mswindowsXP
	]
    ].
    View defaultStyle:style.
    'display.rc [info]: no style set - default to ' infoPrint. style infoPrintCR.
]
!