'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 11 May 2003 at 5:15:24 pm'! "Change Set: KCP-0067-beep Date: 11 May 2003 Author: stephane ducasse Deprecate beep from SystemDictionary. Change beep in Object to use the sound system if present or use beepPrimitive as suggested by andreas."! !Object methodsFor: 'user interface' stamp: 'sd 5/11/2003 16:57'! beep "if sound system is present use it otherwise do whatever we can" | classOrNil | classOrNil := self class environment at: #SampledSound ifAbsent: [nil]. classOrNil isNil ifTrue: [self primitiveBeep] ifFalse: [ classOrNil beep] ! ! !Object methodsFor: 'user interface' stamp: 'sd 5/11/2003 16:46'! beepPrimitive "Beep in the absence of sound support" self primitiveFailed! ! !CRDictionaryBrowser methodsFor: 'view hooks' stamp: 'sd 5/11/2003 17:04'! changeCharRequestRequestor: aPluggableCollectionMorph "A view calls this method when the currently displayed character changes" ^ ((self subPaneOf: aPluggableCollectionMorph) isKindOf: CRAddFeatureMorph) ifTrue: [self beep. false] ifFalse: [true]! ! !CRGestureProcessor methodsFor: 'private' stamp: 'sd 5/11/2003 17:12'! preprocessGesture: aCRGesture "Preprocess the recognized gesture. Return true if it should not be passed to the target morph, false otherwise" "Check for alert and reject" aCRGesture isReject ifTrue: [^ true]. aCRGesture isAlert ifTrue: [self beep]. "Store mouse buttons if special mouse action gesture" (self updateMouseActionButton: aCRGesture) ifTrue: [^ true]. aCRGesture isCommand ifFalse: [^ false]. "Update capsLock state" aCRGesture normalizedChar = #capsLock ifTrue: [capsLockPressed _ capsLockPressed not. ^ true]. "Stop recognizing all gesture exclusively for one morph. NOTE: The exclusive recognition mode is never turned on in this preprocessing method (it has to be done in HandMorph). But it is terminated here for safety reasons" (self isFocused and: [aCRGesture normalizedChar = #switchFocus or: [aCRGesture normalizedChar = #switchRecognizeAll]]) ifTrue: [self disableFocus. ^ true]. "Inspect the last gesture" (aCRGesture normalizedChar = #inspectLastGesture) ifTrue: [self inspectLastGesture. ^ true]. ^ false.! ! !FileList2 methodsFor: 'as yet unclassified' stamp: 'sd 5/11/2003 17:02'! okHit ok _ true. currentDirectorySelected ifNil: [self beep] ifNotNil: [modalView delete]! ! !IRCConnection methodsFor: 'naval mode' stamp: 'sd 5/11/2003 17:04'! ircMessageRecieved: aMessage | sender newLine | self beep. sender _ aMessage sender ifNil: [ 'me' ]. (sender includes: $!!) ifTrue: [ sender _ sender copyFrom: 1 to: (sender indexOf: $!!)-1 ]. newLine _ (Text string: sender emphasis: (Array with: TextEmphasis bold)), ': ', aMessage text, String cr. self addToConsole: newLine.! ! !IRCDirectMessagesObserver methodsFor: 'as yet unclassified' stamp: 'sd 5/11/2003 17:02'! sendMessage: aString "send a message to the user we are talking to" | newLine | talkingTo ifNil: [ self beep. ^self ]. connection privmsgFrom: nil to: talkingTo text: aString. newLine _ (Text string: 'me' attribute: TextEmphasis bold), ': ', aString, String cr. self addToChatText: newLine. ^true! ! !ImageSegment methodsFor: 'read/write segment' stamp: 'sd 5/11/2003 17:12'! install "This operation retrieves the segment if necessary from file storage, installs it in memory, and replaces (using become:) all the root stubs with the reconstructed roots of the segment." | newRoots | state = #onFile ifTrue: [self readFromFile]. state = #onFileWithSymbols ifTrue: [self readFromFileWithSymbols. endMarker _ segment nextObject. "for enumeration of objects" endMarker == 0 ifTrue: [endMarker _ 'End' clone]]. (state = #active) | (state = #imported) ifFalse: [self errorWrongState]. newRoots _ self loadSegmentFrom: segment outPointers: outPointers. state = #imported ifTrue: ["just came in from exported file" arrayOfRoots _ newRoots] ifFalse: [ arrayOfRoots elementsForwardIdentityTo: newRoots]. state _ #inactive. self beepPrimitive. "Don't use Squeak sound here. <- was the old comment of self beep." "I converted self beep as self beepPrimitive to avoid to use the sound system - sd 11/May/03" ! ! !Lexicon methodsFor: 'within-tool queries' stamp: 'sd 5/11/2003 17:03'! seeAlso "Present a menu offering the selector of the currently selected message, as well as of all messages sent by it. If the chosen selector is showable in the current browser, show it here, minding unsubmitted edits however" self selectImplementedMessageAndEvaluate: [:aSelector | ((currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass) "i.e., is this aSelector available in this browser" and: [self okToChange]) ifTrue: [self displaySelector: aSelector] ifFalse: [self beep. "SysttemNavigation new browseAllImplementorsOf: aSelector"]]. "Initially I tried making this open an external implementors browser in this case, but later decided that the user model for this was unstable"! ! !Morph methodsFor: 'events-processing' stamp: 'sd 5/11/2003 17:07'! handleUnknownEvent: anEvent "An event of an unknown type was sent to the receiver. What shall we do?!!" self beep. anEvent printString displayAt: 0@0. anEvent wasHandled: true.! ! !CRDictionaryMorph methodsFor: 'updating' stamp: 'sd 5/11/2003 17:08'! acceptBasic "This method is called when a user accepts the basic section. It updates the model" "Dictionaries without name ar not accessible from the dictionary instance browser and they cannot have an exported name!!" self name isEmptyOrNil ifTrue: [self exportedName isEmptyOrNil ifTrue: [oldName isEmptyOrNil ifFalse: [(self confirm: 'Dictionary without a name are not accessible from withhin the dictionary tool and they cannot act as parents. Ok to continue?') ifFalse: [^ self]]] ifFalse: [self beep. ^ self inform: 'Only named dictionaries can have an exported name']]. "Update the model" (model name: name asSymbol makeDistinct: false) ifFalse: [Smalltalk beep. self inform: 'Name already used. Please choose another name'. ^ self]. model exportedName: exportedName asSymbol. model parentsFromString: parents. parents _ model parentsAsString. parentCount _ model parentCount. model parameters setBasic: parameters. model changed: {self. #basic}. self setOldValues. ! ! !CRDisplayPropertiesMorph methodsFor: 'updating' stamp: 'sd 5/11/2003 17:09'! accept "This is triggered if a user accepts the settings. It writes the current settings to the model." "Instances without a name are treated as deleted" tempProperties name isEmptyOrNil ifTrue: [self modelIsActive ifTrue: [self beep. self inform: 'Active instance needs a name'. ^ self] ifFalse: [(self confirm: 'Properties without a name are deleted. Ok to continue?') ifFalse: [^ self]]]. model set: tempProperties. self isActive ifTrue: [model activate]. model changed. self setOldValues.! ! !FillInTheBlankMorph methodsFor: 'event handling' stamp: 'sd 5/11/2003 17:07'! mouseDown: evt (self containsPoint: evt position) ifFalse:[^ self beep]. "sent in response to outside modal click" evt hand grabMorph: self. "allow repositioning"! ! !ProjectNavigationMorph methodsFor: 'the actions' stamp: 'sd 5/11/2003 17:09'! soundUpEvt: a morph: b soundSlider ifNotNil: [soundSlider delete]. soundSlider _ nil. self beepPrimitive! ! !SampledSound class methodsFor: 'instance creation' stamp: 'sd 5/11/2003 17:01'! beep "beep in the presence of the sound system. Use Object>>primitiveBeep if you want to avoid invoking the sound system." (self new setSamples: self coffeeCupClink samplingRate: 12000) play. ! ! !SystemDictionary methodsFor: 'miscellaneous' stamp: 'sd 5/11/2003 17:00'! beep self deprecated: [ "use Object>>beep or Object>>beepPrimitive instead of Smalltalk beep". self beepPrimitive. ]! ! Morph removeSelector: #beep!