Packages July 2020

packages@lists.squeakfoundation.org

1 participants
39 discussions

The Trunk: EToys-mt.398.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.398.mcz ==================== Summary ==================== Name: EToys-mt.398 Author: mt Time: 15 July 2020, 11:26:41.827718 am UUID: ca4709d0-cf7b-4afa-9938-6aceb743d845 Ancestors: EToys-kfr.397 Removes deprecated, dead method. =============== Diff against EToys-kfr.397 =============== Item was removed: - ----- Method: EventSensor>>swapControlAndAltKeys: (in category '*Etoys-Squeakland-private-I/O') ----- - swapControlAndAltKeys: evt - | char | - char := evt at: 3. - "Cursor keys and mouse wheel are not switched." - (#(28 29 30 31) includes: char) ifTrue: [^ self]. - (evt at: 5) == CtrlKeyBit - ifTrue: ["Ctrl -> Alt (^A -> a)" - char < 32 ifTrue: [#(3 6) do: [:ind | evt at: ind put: (char bitOr: 16r60)]]. - evt at: 5 put: 8] - ifFalse: [(evt at: 5) == CommandKeyBit - ifTrue: ["Alt -> Ctrl (a -> ^A)" - (char >= 16r60 and: [char < 16r80]) ifTrue: [#(3 6) do: [:ind | evt at: ind put: (char bitAnd: 16r1F)]]. - evt at: 5 put: 2]].!

1 0

The Trunk: Morphic-mt.1670.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1670.mcz ==================== Summary ==================== Name: Morphic-mt.1670 Author: mt Time: 15 July 2020, 11:25:30.453718 am UUID: 67b727fe-aab7-47cc-a276-070a5ba8b930 Ancestors: Morphic-mt.1669 Complements Kernel-mt.1333 =============== Diff against Morphic-mt.1669 =============== Item was removed: - ----- Method: HandMorph>>checkForMoreKeyboard (in category 'event handling') ----- - checkForMoreKeyboard - "Quick check for more keyboard activity -- Allows, eg, many characters - to be accumulated into a single replacement during type-in." - - | evtBuf | - self flag: #arNote. "Will not work if we don't examine event queue in Sensor" - evtBuf := Sensor peekKeyboardEvent. - evtBuf ifNil: [^nil]. - ^self generateKeyboardEvent: evtBuf! Item was changed: ----- Method: MorphicProject>>finalExitActions: (in category 'enter') ----- finalExitActions: enteringProject world triggerClosingScripts. "Pause sound players, subject to preference settings" (world hasProperty: #letTheMusicPlay) ifTrue: [world removeProperty: #letTheMusicPlay] ifFalse: [SoundService stop]. world sleep. (world findA: ProjectNavigationMorph) ifNotNil: [:navigator | navigator retractIfAppropriate]. self clearGlobalState. + EventSensor default flushEvents. - Sensor flushAllButDandDEvents. self world submorphsDo: [:ea | ea removeProperty: #dropShadow].! Item was changed: ----- Method: PasteUpMorph>>install (in category 'world state') ----- install owner := nil. "since we may have been inside another world previously" ActiveWorld := self. ActiveHand := self hands first. "default" ActiveEvent := nil. submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]]. "Transcript that was in outPointers and then got deleted." self viewBox: Display boundingBox. + EventSensor default flushEvents. - Sensor flushAllButDandDEvents. worldState handsDo: [:h | h initForEvents]. self installFlaps. self borderWidth: 0. "default" (Preferences showSecurityStatus and: [SecurityManager default isInRestrictedMode]) ifTrue: [self borderWidth: 2; borderColor: Color red]. self presenter allExtantPlayers do: [:player | player prepareToBeRunning]. SystemWindow noteTopWindowIn: self.!

1 0

The Trunk: Tools-mt.983.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.983.mcz ==================== Summary ==================== Name: Tools-mt.983 Author: mt Time: 15 July 2020, 11:24:43.638718 am UUID: 1a94f354-ff47-4d70-b27d-8134ae3249d2 Ancestors: Tools-mt.982 Complements Kernel-mt.1333 =============== Diff against Tools-mt.982 =============== Item was changed: ----- Method: Debugger>>openNotifierNoSuspendContents:label: (in category 'initialize') ----- openNotifierNoSuspendContents: msgString label: label "Create, schedule and answer a notifier view with the given label and message. A notifier view shows just the message or the first several lines of the stack, with a menu that allows the user to open a full debugger if so desired." "NOTE: When this method returns, a new process has been scheduled to run the windows, and thus this notifier, but the previous active process has not been suspended. The sender will do this." - Sensor flushKeyboard. savedCursor := Cursor currentCursor. Cursor currentCursor: Cursor normal. self expandNotifierStack.!

1 0

The Trunk: ST80-mt.257.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-mt.257.mcz ==================== Summary ==================== Name: ST80-mt.257 Author: mt Time: 15 July 2020, 11:24:14.540718 am UUID: 0f736417-f062-483c-b2a3-9d1560a1bf1f Ancestors: ST80-mt.256 Complements Kernel-mt.1333. Fixes regression: mouse wheel works again in tools. =============== Diff against ST80-mt.256 =============== Item was added: + ----- Method: EventSensor>>characterForKeycode: (in category '*ST80-Support-keyboard') ----- + characterForKeycode: keycode + "Map the given keycode to a Smalltalk character object. Encoding: + A keycode is 12 bits: <4 modifer bits><8 bit ISO character> + Modifier bits are: <command><option><control><shift>" + + "NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms." + + keycode = nil ifTrue: [ ^nil ]. + keycode class = Character ifTrue: [ ^keycode ]. "to smooth the transition!!" + ^ Character value: (keycode bitAnd: 16rFF)! Item was added: + ----- Method: EventSensor>>keyboard (in category '*ST80-Support-keyboard') ----- + keyboard + "Answer the next (single-byte or multi-byte) character from the keyboard." + + | firstCharacter secondCharactor stream multiCharacter converter | + "1) Consume next character from buffer." + (firstCharacter := self characterForKeycode: keyboardBuffer next) ifNil: [^ nil]. + + "2) Peek additional character and try to read multi-byte character." + (secondCharactor := self characterForKeycode: keyboardBuffer peek) ifNil: [^ firstCharacter]. + (converter := TextConverter defaultSystemConverter) ifNil: [^ firstCharacter]. + stream := ReadStream on: (String with: firstCharacter with: secondCharactor). + multiCharacter := [converter nextFromStream: stream] ifError: [firstCharacter]. + + "3) Only consume that additional character if we got a multi-byte character." + multiCharacter isOctetCharacter ifFalse: [keyboardBuffer next]. + + "4) Answer either single-byte or multi-byte character." + ^ multiCharacter + ! Item was added: + ----- Method: EventSensor>>keyboardPressed (in category '*ST80-Support-keyboard') ----- + keyboardPressed + "Answer true if keystrokes are available." + + ^self peekKeyboard notNil! Item was added: + ----- Method: EventSensor>>mouseWheelDelta (in category '*ST80-Support-mouse') ----- + mouseWheelDelta + + | delta | + delta := self peekMouseWheelDelta. + mouseWheelDelta := 0@0. + ^ delta! Item was added: + ----- Method: EventSensor>>mouseWheelDirection (in category '*ST80-Support-mouse') ----- + mouseWheelDirection + + | direction | + direction := self peekMouseWheelDirection. + mouseWheelDelta := 0@0. + ^ direction! Item was added: + ----- Method: EventSensor>>peekButtons (in category '*ST80-Support-mouse') ----- + peekButtons + + self fetchMoreEvents. + self eventQueue ifNotNil: [:queue | queue flush]. + ^ mouseButtons! Item was added: + ----- Method: EventSensor>>peekKeyboard (in category '*ST80-Support-keyboard') ----- + peekKeyboard + "Answer the next character in the keyboard buffer without removing it, or nil if it is empty." + + self fetchMoreEvents. + self eventQueue ifNotNil: [:queue | queue flush]. + ^ self characterForKeycode: keyboardBuffer peek! Item was added: + ----- Method: EventSensor>>peekMouseWheelDelta (in category '*ST80-Support-mouse') ----- + peekMouseWheelDelta + + self fetchMoreEvents. + self eventQueue ifNotNil: [:queue | queue flush]. + ^ mouseWheelDelta! Item was added: + ----- Method: EventSensor>>peekMouseWheelDirection (in category '*ST80-Support-mouse') ----- + peekMouseWheelDirection + + | delta | + delta := self peekMouseWheelDelta. + + delta x > 0 ifTrue: [^ #right]. + delta x < 0 ifTrue: [^ #left]. + + delta y > 0 ifTrue: [^ #up]. + delta y < 0 ifTrue: [^ #down]. + + ^ nil! Item was added: + ----- Method: EventSensor>>peekPosition (in category '*ST80-Support-mouse') ----- + peekPosition + + self fetchMoreEvents. + self eventQueue ifNotNil: [:queue | queue flush]. + ^ mousePosition! Item was changed: ----- Method: ListController>>controlActivity (in category 'control defaults') ----- controlActivity + self scrollByMouseWheel ifTrue: [^self]. self scrollByKeyboard ifTrue: [^self]. self processKeyboard. super controlActivity. ! Item was changed: ----- Method: MVCDebugger>>openNotifierNoSuspendContents:label: (in category 'initialize') ----- openNotifierNoSuspendContents: msgString label: label | builder spec view | + EventSensor default flushEvents. super openNotifierNoSuspendContents: msgString label: label. builder := ToolBuilder default. spec := self buildNotifierWith: builder label: label message: msgString. view := builder build: spec. view controller openNoTerminate. ^ view! Item was changed: ----- Method: MVCProject>>finalExitActions: (in category 'enter') ----- finalExitActions: enteringProject super finalExitActions: enteringProject. self world unCacheWindows. + EventSensor default flushEvents. - Sensor flushAllButDandDEvents. ScheduledControllers := nil.! Item was changed: ----- Method: ParagraphEditor>>undo (in category 'menu messages') ----- undo "Reset the state of the paragraph prior to the previous edit. If another ParagraphEditor instance did that edit, UndoInterval is invalid; just recover the contents of the undo-buffer at the start of the paragraph." + sensor flushEvents. "a way to flush stuck keys" - sensor flushKeyboard. "a way to flush stuck keys" self closeTypeIn. UndoParagraph == paragraph ifFalse: "Can't undo another paragraph's edit" [UndoMessage := Message selector: #undoReplace. UndoInterval := 1 to: 0. Undone := true]. UndoInterval ~= self selectionInterval ifTrue: "blink the actual target" [self selectInterval: UndoInterval; deselect]. "Leave a signal of which phase is in progress" UndoParagraph := Undone ifTrue: [#redoing] ifFalse: [#undoing]. UndoMessage sentTo: self. UndoParagraph := paragraph! Item was changed: ----- Method: ScrollController>>controlActivity (in category 'control defaults') ----- controlActivity + self scrollByMouseWheel ifTrue: [^ self]. self scrollByKeyboard ifTrue: [^ self]. self scrollBarContainsCursor ifTrue: [self scroll] ifFalse: [self normalActivity]! Item was changed: ----- Method: ScrollController>>scrollByKeyboard (in category 'scrolling') ----- scrollByKeyboard | keyEvent | keyEvent := sensor peekKeyboard. keyEvent ifNil: [^ false]. (sensor controlKeyPressed or:[sensor commandKeyPressed]) ifFalse: [^ false]. keyEvent asciiValue = 30 ifTrue: [sensor keyboard. + self scrollViewUp ifTrue: [self moveMarker]. - self scrollViewDown ifTrue: [self moveMarker]. ^ true]. keyEvent asciiValue = 31 ifTrue: [sensor keyboard. + self scrollViewDown ifTrue: [self moveMarker]. - self scrollViewUp ifTrue: [self moveMarker]. ^ true]. ^ false! Item was added: + ----- Method: ScrollController>>scrollByMouseWheel (in category 'scrolling') ----- + scrollByMouseWheel + | wheelDirection | + wheelDirection := sensor peekMouseWheelDirection. + wheelDirection = #up + ifTrue: + [sensor mouseWheelDirection. + self scrollViewUp ifTrue: [self moveMarker]. + ^ true]. + wheelDirection = #down + ifTrue: + [sensor mouseWheelDirection. + self scrollViewDown ifTrue: [self moveMarker]. + ^ true]. + ^ false! Item was changed: ----- Method: ScrollController>>scrollViewDown (in category 'scrolling') ----- scrollViewDown "Scroll the receiver's view down the default amount. Return true only if scrolling actually took place." + ^ self scrollView: self scrollAmount negated! - ^ self scrollView: self scrollAmount! Item was changed: ----- Method: ScrollController>>scrollViewUp (in category 'scrolling') ----- scrollViewUp "Scroll the receiver's view up the default amount. Return true only if scrolling actually took place." + ^ self scrollView: self scrollAmount! - ^ self scrollView: self scrollAmount negated!

1 0

The Trunk: Kernel-mt.1333.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1333.mcz ==================== Summary ==================== Name: Kernel-mt.1333 Author: mt Time: 15 July 2020, 11:22:34.685718 am UUID: 4e50519a-d1e3-4a74-85cc-3c02660d650f Ancestors: Kernel-nice.1332 Clean up code for non-event-based input processing, primarily used in ST80. Moves some methods to ST80 package. Needs more work to remove all sends from Morphic such as #shiftPressed etc. Also rely on in-image interrupt-key handling only. Recent VMs do not fire the old-style interrupt semaphore anymore. See #userInterruptWatcher. =============== Diff against Kernel-nice.1332 =============== Item was changed: Object subclass: #EventSensor instanceVariableNames: 'mouseButtons mousePosition mouseWheelDelta keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore' + classVariableNames: 'ButtonDecodeTable EventPollPeriod EventTicklerProcess InterruptWatcherProcess KeyDecodeTable' - classVariableNames: 'ButtonDecodeTable EventPollPeriod EventTicklerProcess InterruptSemaphore InterruptWatcherProcess KeyDecodeTable' poolDictionaries: 'EventSensorConstants' category: 'Kernel-Processes'! !EventSensor commentStamp: 'mt 12/13/2019 14:38' prior: 0! An EventSensor is an interface to the user input devices. There is at least one instance of EventSensor named Sensor in the system. EventSensor is a replacement for the earlier InputSensor implementation based on a set of (optional) event primitives. An EventSensor updates its state when events are received so that all state based users of Sensor (e.g., Sensor keyboard, Sensor leftShiftDown, Sensor mouseButtons) will work exactly as before, by moving the current VM mechanisms into EventSensor itself. An optional input semaphore is part of the new design. For platforms that support true asynchronous event notification, the semaphore will be signaled to indicate pending events. On platforms that do not support asynchronous notifications about events, the UI will have to poll EventSensor periodically to read events from the VM. Instance variables: mouseButtons <Integer> - mouse button state as replacement for primMouseButtons mousePosition <Point> - mouse position as replacement for primMousePt keyboardBuffer <SharedQueue> - keyboard input buffer interruptKey <Integer> - currently defined interrupt key interruptSemaphore <Semaphore> - the semaphore signaled when the interruptKey is detected eventQueue <SharedQueue> - an optional event queue for event driven applications inputSemaphore <Semaphore>- the semaphore signaled by the VM if asynchronous event notification is supported lastEventPoll <Integer> - the last millisecondClockValue at which we called fetchMoreEvents hasInputSemaphore <Boolean> - true if my inputSemaphore has actually been signaled at least once. Class variables: ButtonDecodeTable <ByteArray> - maps mouse buttons as reported by the VM to ones reported in the events. KeyDecodeTable <Dictionary<SmallInteger->SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X) InterruptSemaphore <Semaphore> - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke. InterruptWatcherProcess <Process> - waits on the InterruptSemaphore and then responds as appropriate. EventPollPeriod <Integer> - the number of milliseconds to wait between polling for more events in the userInterruptHandler. EventTicklerProcess <Process> - the process that makes sure that events are polled for often enough (at least every EventPollPeriod milliseconds). Event format: The current event format is very simple. Each event is recorded into an 8 element array. All events must provide some SmallInteger ID (the first field in the event buffer) and a time stamp (the second field in the event buffer), so that the difference between the time stamp of an event and the current time can be reported. Currently, the following events are defined: Null event ============= The Null event is returned when the ST side asks for more events but no more events are available. Structure: [1] - event type 0 [2-8] - unused Mouse event structure ========================== Mouse events are generated when mouse input is detected. [1] - event type 1 [2] - time stamp [3] - mouse x position [4] - mouse y position [5] - button state; bitfield with the following entries: 1 - 2r001 yellow (e.g., right) button 2 - 2r010 blue (e.g., middle) button 4 - 2r100 red (e.g., left) button [all other bits are currently undefined] [6] - modifier keys; bitfield with the following entries: 1 - shift key 2 - ctrl key 4 - (Mac specific) option key 8 - Cmd/Alt key [all other bits are currently undefined] [7] - reserved. [8] - host window id. Keyboard events ==================== Keyboard events are generated when keyboard input is detected. [1] - event type 2 [2] - time stamp [3] - character code (Ascii) For now the character code is in Mac Roman encoding. See #macToSqueak. For key press/release (see [4]), character codes are normalized. [4] - press state; integer with the following meaning 0 - character (aka. key stroke or key still pressed) 1 - key press (aka. key down) 2 - key release (aka. key up) [5] - modifier keys (same as in mouse events) For key press/release (see [4]), modifier keys are still accessible. [6] - character code (Unicode UTF32) Manual decoding via KeyboardInputInterpreter possible. For key press/release (see [4]), character codes are normalized. [7] - reserved. [8] - host window id. Mouse-wheel event structure ========================== Mouse-wheel events are generated when mouse-wheel input is detected. [1] - event type 7 [2] - time stamp [3] - horizontal scroll delta [4] - vertical scroll delta [5] - button state (same as in mouse events) [6] - modifier keys (same as in mouse events) [7] - reserved. [8] - host window id. ! Item was removed: - ----- Method: EventSensor>>characterForKeycode: (in category 'keyboard') ----- - characterForKeycode: keycode - "Map the given keycode to a Smalltalk character object. Encoding: - A keycode is 12 bits: <4 modifer bits><8 bit ISO character> - Modifier bits are: <command><option><control><shift>" - - "NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms." - - keycode = nil ifTrue: [ ^nil ]. - keycode class = Character ifTrue: [ ^keycode ]. "to smooth the transition!!" - ^ Character value: (keycode bitAnd: 16rFF)! Item was changed: + ----- Method: EventSensor>>cursorPoint (in category 'mouse') ----- - ----- Method: EventSensor>>cursorPoint (in category 'cursor') ----- cursorPoint "Answer a Point indicating the cursor location." ^ self peekPosition! Item was changed: + ----- Method: EventSensor>>cursorPoint: (in category 'mouse') ----- - ----- Method: EventSensor>>cursorPoint: (in category 'cursor') ----- cursorPoint: aPoint "Set aPoint to be the current cursor location." ^self primCursorLocPut: aPoint! Item was removed: - ----- Method: EventSensor>>flushAllButDandDEvents (in category 'accessing') ----- - flushAllButDandDEvents - | newQueue oldQueue | - - newQueue := SharedQueue new. - self eventQueue ifNil: [ - self eventQueue: newQueue. - ^ self]. - oldQueue := self eventQueue. - [oldQueue size > 0] whileTrue: - [| item type | - item := oldQueue next. - type := item at: 1. - type = EventTypeDragDropFiles ifTrue: [ newQueue nextPut: item]]. - self eventQueue: newQueue.! Item was changed: ----- Method: EventSensor>>flushEvents (in category 'accessing') ----- flushEvents + + keyboardBuffer flush. + mouseWheelDelta := 0@0. + + self eventQueue ifNotNil: [:queue | queue flush].! - self eventQueue ifNotNil:[:queue | queue flush].! Item was removed: - ----- Method: EventSensor>>flushKeyboard (in category 'keyboard') ----- - flushKeyboard - "Remove all characters from the keyboard buffer." - - [self keyboardPressed] - whileTrue: [self keyboard]! Item was removed: - ----- Method: EventSensor>>flushNonKbdEvents (in category 'private') ----- - flushNonKbdEvents - "We do NOT use 'isKeybdEvent: ' here, - as that would have us flush key press-release events, - which is not appropriate when flushing non-keyboard events." - self eventQueue ifNotNil: - [:queue | - queue flushAllSuchThat: [:buf | (self isAnyKbdEvent: buf) not]]! Item was changed: ----- Method: EventSensor>>initialize (in category 'initialize') ----- initialize + - "Initialize the receiver" mouseButtons := 0. + mousePosition := 0@0. + mouseWheelDelta := 0@0. - mousePosition := 0 @ 0. - mouseWheelDelta := 0 @ 0. keyboardBuffer := SharedQueue new. + + interruptKey := $. asciiValue bitOr: 16r0800. "cmd-." + interruptSemaphore := Semaphore new. + + eventQueue := SharedQueue new. + - self setInterruptKey: (interruptKey ifNil: [$. asciiValue bitOr: 16r0800 ]). "cmd-." - interruptSemaphore := (Smalltalk specialObjectsArray at: 31) ifNil: [Semaphore new]. - self flushAllButDandDEvents. inputSemaphore := Semaphore new. hasInputSemaphore := false.! Item was changed: ----- Method: EventSensor>>installInterruptWatcher (in category 'user interrupts') ----- installInterruptWatcher "Initialize the interrupt watcher process. Terminate the old process if any." "Sensor installInterruptWatcher" InterruptWatcherProcess ifNotNil: [InterruptWatcherProcess terminate]. + InterruptWatcherProcess := [self userInterruptWatcher] forkAt: Processor lowIOPriority.! - InterruptSemaphore := Semaphore new. - InterruptWatcherProcess := [self userInterruptWatcher] forkAt: Processor lowIOPriority. - self primInterruptSemaphore: InterruptSemaphore.! Item was removed: - ----- Method: EventSensor>>kbdTest (in category 'keyboard') ----- - kbdTest "Sensor kbdTest" - "This test routine will print the unmodified character, its keycode, - and the OR of all its modifier bits, until the character x is typed" - | char evt | - char := nil. - [char = $x] whileFalse: - [[(evt := self peekKeyboardEvent) isNil] whileTrue. - char := self characterForKeycode: evt third. - (String streamContents: - [:s | - s nextPut: char. - (3 to: 8) with: 'cpmurw' do: - [:i :c| - s space; nextPut: c; nextPut: $:; print: (evt at: i); nextPutAll: ' ']]) - displayAt: 10@10]! Item was removed: - ----- Method: EventSensor>>keyboard (in category 'keyboard') ----- - keyboard - "Answer the next character from the keyboard." - - | firstCharacter secondCharactor stream multiCharacter converter | - firstCharacter := self characterForKeycode: self primKbdNext. - secondCharactor := self peekKeyboard. - secondCharactor isNil - ifTrue: [^ firstCharacter]. - converter := TextConverter defaultSystemConverter. - converter isNil - ifTrue: [^ firstCharacter]. - stream := ReadStream - on: (String with: firstCharacter with: secondCharactor). - multiCharacter := converter nextFromStream: stream. - multiCharacter isOctetCharacter - ifTrue: [^ multiCharacter]. - self primKbdNext. - ^ multiCharacter - ! Item was removed: - ----- Method: EventSensor>>keyboardPressed (in category 'keyboard') ----- - keyboardPressed - "Answer true if keystrokes are available." - - ^self peekKeyboard notNil! Item was changed: ----- Method: EventSensor>>nextEvent (in category 'accessing') ----- nextEvent + "Return the next event from the receiver. If the queue is empty, try to fetch more events once." - "Return the next event from the receiver." ^ self eventQueue + ifNil: [ + self fetchMoreEvents. + self nextEventSynthesized] + ifNotNil: [:queue | + keyboardBuffer flush. + mouseWheelDelta := 0@0. + queue isEmpty ifTrue: [self fetchMoreEvents]. + queue nextOrNil]! - ifNil: [self nextEventSynthesized] - ifNotNil: [self nextEventFromQueue] - ! Item was removed: - ----- Method: EventSensor>>nextEventFromQueue (in category 'private') ----- - nextEventFromQueue - "Return the next event from the receiver. If the queue is empty, try to fetch more events once." - - self eventQueue isEmpty - ifTrue: [self fetchMoreEvents]. - - ^ self eventQueue isEmpty - ifTrue: [nil] - ifFalse: [self eventQueue next]! Item was changed: ----- Method: EventSensor>>nextEventSynthesized (in category 'private') ----- nextEventSynthesized - "Return a synthesized event. This method is called if an event driven client wants to receive events but the primary user interface is not event-driven (e.g., the receiver does not have an event queue but only updates its state). This can, for instance, happen if a Morphic World is run in an MVC window. To simplify the clients work this method will always return all available keyboard events first, and then (repeatedly) the mouse events. Since mouse events come last, the client can assume that after one mouse event has been received there are no more to come. Note that it is impossible for EventSensor to determine if a mouse event has been issued before so the client must be aware of the possible problem of getting repeatedly the same mouse events. See HandMorph>>processEvents for an example on how to deal with this." - | kbd array buttons pos modifiers mapped | - "First check for keyboard" - array := Array new: 8. - kbd := self primKbdNext. - kbd ifNotNil: - ["simulate keyboard event" - array at: 1 put: EventTypeKeyboard. "evt type" - array at: 2 put: Time eventMillisecondClock. "time stamp" - array at: 3 put: (kbd bitAnd: 255). "char code" - array at: 4 put: EventKeyChar. "key press/release" - array at: 5 put: (kbd bitShift: -8). "modifier keys" - ^ array]. + | synthesizedEvent | + synthesizedEvent := self peekEventSynthesized. + keyboardBuffer nextOrNil. + ^ synthesizedEvent! - "Then check for mouse" - pos := self peekPosition. - buttons := mouseButtons. - modifiers := buttons bitShift: -3. - buttons := buttons bitAnd: 7. - mapped := self mapButtons: buttons modifiers: modifiers. - array - at: 1 put: EventTypeMouse; - at: 2 put: Time eventMillisecondClock; - at: 3 put: pos x; - at: 4 put: pos y; - at: 5 put: mapped; - at: 6 put: modifiers. - ^ array - - ! Item was removed: - ----- Method: EventSensor>>peekButtons (in category 'accessing') ----- - peekButtons - self fetchMoreEvents. - self flushNonKbdEvents. - ^ mouseButtons! Item was changed: ----- Method: EventSensor>>peekEvent (in category 'accessing') ----- peekEvent "Look ahead at the next event. Try to fetch more events first." ^ self eventQueue + ifNil: [ - ifNil: [nil] - ifNotNil: [:queue | self fetchMoreEvents. + self peekEventSynthesized] + ifNotNil: [:queue | + queue isEmpty ifTrue: [self fetchMoreEvents]. queue peek]! Item was added: + ----- Method: EventSensor>>peekEventSynthesized (in category 'private') ----- + peekEventSynthesized + "Return a synthesized event. This method is called if an event driven client wants to receive events but the primary user interface is not event-driven (e.g., the receiver does not have an event queue but only updates its state). This can, for instance, happen if a Morphic World is run in an MVC window. To simplify the clients work this method will always return all available keyboard events first, and then (repeatedly) the mouse events. Since mouse events come last, the client can assume that after one mouse event has been received there are no more to come. Note that it is impossible for EventSensor to determine if a mouse event has been issued before so the client must be aware of the possible problem of getting repeatedly the same mouse events. See HandMorph>>processEvents for an example on how to deal with this." + | kbd array buttons pos modifiers mapped | + "First check for keyboard" + array := Array new: 8. + keyboardBuffer isEmpty ifFalse: + ["simulate keyboard event" + array at: 1 put: EventTypeKeyboard. "evt type" + array at: 2 put: Time eventMillisecondClock. "time stamp" + array at: 3 put: ((kbd := keyboardBuffer peek) bitAnd: 255). "char code" + array at: 4 put: EventKeyChar. "key press/release" + array at: 5 put: (kbd bitShift: -8). "modifier keys" + ^ array]. + + "Then check for mouse" + pos := mousePosition. + buttons := mouseButtons. + modifiers := buttons bitShift: -3. + buttons := buttons bitAnd: 7. + mapped := self mapButtons: buttons modifiers: modifiers. + array + at: 1 put: EventTypeMouse; + at: 2 put: Time eventMillisecondClock; + at: 3 put: pos x; + at: 4 put: pos y; + at: 5 put: mapped; + at: 6 put: modifiers. + ^ array + + ! Item was removed: - ----- Method: EventSensor>>peekKeyboard (in category 'keyboard') ----- - peekKeyboard - "Answer the next character in the keyboard buffer without removing it, or nil if it is empty." - - | char | - self fetchMoreEvents. - keyboardBuffer isEmpty ifFalse: [^ self characterForKeycode: keyboardBuffer peek]. - char := nil. - self eventQueue ifNotNil: [:queue | - queue nextOrNilSuchThat: "NOTE: must not return out of this block, so loop to end" - [:buf | (self isKbdEvent: buf) ifTrue: [char ifNil: [char := buf at: 3]]. - false "NOTE: block value must be false so Queue won't advance"]]. - ^ self characterForKeycode: char! Item was removed: - ----- Method: EventSensor>>peekKeyboardEvent (in category 'accessing') ----- - peekKeyboardEvent - "Return the next keyboard char event from the receiver or nil if none available" - - ^ self eventQueue - ifNil: [nil] - ifNotNil: [:queue | - self fetchMoreEvents. - queue nextOrNilSuchThat: [:buf | - buf first = EventTypeKeyboard and: [(buf fourth) = EventKeyChar]]]! Item was removed: - ----- Method: EventSensor>>peekPosition (in category 'accessing') ----- - peekPosition - self fetchMoreEvents. - "self flushNonKbdEvents. -- mt: Should not be necessary here." - ^ mousePosition! Item was removed: - ----- Method: EventSensor>>peekWheelDelta (in category 'accessing') ----- - peekWheelDelta - self fetchMoreEvents. - ^ mouseWheelDelta! Item was changed: + ----- Method: EventSensor>>primCursorLocPut: (in category 'private-I/O') ----- - ----- Method: EventSensor>>primCursorLocPut: (in category 'primitives-cursor') ----- primCursorLocPut: aPoint "If the primitive fails, try again with a rounded point." <primitive: 91> ^ self primCursorLocPutAgain: aPoint rounded! Item was changed: + ----- Method: EventSensor>>primCursorLocPutAgain: (in category 'private-I/O') ----- - ----- Method: EventSensor>>primCursorLocPutAgain: (in category 'primitives-cursor') ----- primCursorLocPutAgain: aPoint "Do nothing if primitive is not implemented." <primitive: 91> ^ self! Item was removed: - ----- Method: EventSensor>>primInterruptSemaphore: (in category 'private') ----- - primInterruptSemaphore: aSemaphore - "Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed." - interruptSemaphore := aSemaphore. - "backward compatibility: use the old primitive which is obsolete now" - self oldPrimInterruptSemaphore: aSemaphore! Item was removed: - ----- Method: EventSensor>>primKbdNext (in category 'private') ----- - primKbdNext - "Allows for use of old Sensor protocol to get at the keyboard, - as when running kbdTest or the InterpreterSimulator in Morphic" - | evtBuf | - - self flag: #refactor. "mt: Suspiciously similar to #peekKeyboardEvent" - self fetchMoreEvents. - keyboardBuffer isEmpty ifFalse:[^ keyboardBuffer next]. - self eventQueue ifNotNil: [:queue | - evtBuf := queue nextOrNilSuchThat: [:buf | self isKbdEvent: buf]. - self flushNonKbdEvents]. - ^ evtBuf ifNotNil: [evtBuf at: 3] - ! Item was removed: - ----- Method: EventSensor>>primSetInterruptKey: (in category 'private') ----- - primSetInterruptKey: anInteger - "Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>." - interruptKey := anInteger. - "backward compatibility: use the old primitive which is obsolete now" - self oldPrimSetInterruptKey: anInteger! Item was changed: ----- Method: EventSensor>>processEvent: (in category 'private-I/O') ----- processEvent: evt "Process a single event. This method is run at high priority." | type buttons window | type := evt at: 1. "Only process main window events, forward others to host window proxies" window := evt at: 8. (window isNil or: [window isZero]) ifTrue: [window := 1. evt at: 8 put: window]. window = 1 ifFalse: [ ^Smalltalk at: #HostWindowProxy ifPresent: [:w | w processEvent: evt]]. "Tackle mouse events and mouse wheel events first" (type = EventTypeMouse or: [type = EventTypeMouseWheel]) ifTrue: [buttons := (ButtonDecodeTable at: (evt at: 5) + 1). evt at: 5 put: (Smalltalk platformName = 'Mac OS' ifTrue: [ buttons ] ifFalse: [ self mapButtons: buttons modifiers: (evt at: 6) ]). self queueEvent: evt. + type = EventTypeMouseWheel + ifTrue: [^ self processMouseWheelEvent: evt]. + type = EventTypeMouse + ifTrue: [^ self processMouseEvent: evt]]. - type = EventTypeMouse ifTrue: [self processMouseEvent: evt]. - type = EventTypeMouseWheel ifTrue: [self processMouseWheelEvent: evt]. - ^self]. "Store the event in the queue if there's any" type = EventTypeKeyboard ifTrue: [ "Check if the event is a user interrupt" ((evt at: 4) = EventKeyChar and: [((evt at: 3) bitOr: (((evt at: 5) bitAnd: 8) bitShift: 8)) = interruptKey]) ifTrue: ["interrupt key is meta - not reported as event" ^ interruptSemaphore signal]. "Decode keys for characters (i.e., duplicate or swap, ctrl <-> alt/cmd)." (evt at: 4) = EventKeyChar ifTrue: [ | unicode ascii | "Copy lookup key first in case of key swap." unicode := {evt at: 6. evt at: 5}. ascii := {evt at: 3. evt at: 5}. KeyDecodeTable "Unicode character first" at: unicode ifPresent: [:a | evt at: 6 put: a first; at: 5 put: a second]. KeyDecodeTable "ASCII character second" at: ascii ifPresent: [:a | evt at: 3 put: a first; at: 5 put: a second]]. self queueEvent: evt. self processKeyboardEvent: evt . ^self ]. "Handle all events other than Keyboard or Mouse." self queueEvent: evt. ! Item was changed: ----- Method: EventSensor>>processKeyboardEvent: (in category 'private-I/O') ----- processKeyboardEvent: evt "process a keyboard event, updating EventSensor state" | charCode pressCode | "Never update keyboardBuffer if we have an eventQueue active" mouseButtons := (mouseButtons bitAnd: 7) bitOr: ((evt at: 5) bitShift: 3). + - self eventQueue ifNotNil:[^self]. charCode := evt at: 3. charCode = nil ifTrue:[^self]. "extra characters not handled in MVC" pressCode := evt at: 4. pressCode = EventKeyChar ifFalse:[^self]. "key down/up not handled in MVC" "mix in modifiers" charCode := charCode bitOr: ((evt at: 5) bitShift: 8). keyboardBuffer nextPut: charCode.! Item was changed: ----- Method: EventSensor>>processMouseWheelEvent: (in category 'private-I/O') ----- processMouseWheelEvent: evt "process a mouse wheel event, updating EventSensor state" | modifiers buttons mapped | + mouseWheelDelta := mouseWheelDelta + ((evt at: 3) @ (evt at: 4)). - mouseWheelDelta := (evt at: 3) @ (evt at: 4). buttons := evt at: 5. modifiers := evt at: 6. mapped := self mapButtons: buttons modifiers: modifiers. mouseButtons := mapped bitOr: (modifiers bitShift: 3).! Item was removed: - ----- Method: EventSensor>>setInterruptKey: (in category 'user interrupts') ----- - setInterruptKey: anInteger - "Register the given keycode as the user interrupt key." - - self primSetInterruptKey: anInteger. - ! Item was changed: ----- Method: EventSensor>>startUp (in category 'initialize') ----- startUp self initialize. self primSetInputSemaphore: (Smalltalk registerExternalObject: inputSemaphore). self installInterruptWatcher. self installEventTickler. + self eventQueue: SharedQueue new. - Smalltalk isMorphic ifTrue: [self flushAllButDandDEvents]. "Attempt to discover whether the input semaphore is actually being signaled." hasInputSemaphore := false. inputSemaphore initSignals.! Item was changed: ----- Method: EventSensor>>userInterruptWatcher (in category 'user interrupts') ----- userInterruptWatcher "Wait for user interrupts and open a notifier on the active process when one occurs." + [ interruptSemaphore wait. - [ InterruptSemaphore wait. Display deferUpdates: false. SoundService stop. Smalltalk handleUserInterrupt ] repeat!

1 0

The Trunk: Morphic-mt.1669.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1669.mcz ==================== Summary ==================== Name: Morphic-mt.1669 Author: mt Time: 15 July 2020, 9:10:16.659352 am UUID: 13e754ac-84e8-403c-8bf8-be99b1586fbb Ancestors: Morphic-cbc.1668 Fixes icon scaling in tree widgets. =============== Diff against Morphic-cbc.1668 =============== Item was changed: ----- Method: IndentingListItemMorph>>initWithContents:prior:forList:indentLevel: (in category 'initialization') ----- initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel container := hostList. complexContents := anObject. anObject addDependent: self. self initWithContents: self getLabel font: Preferences standardListFont emphasis: nil. indentLevel := 0. isExpanded := false. nextSibling := firstChild := nil. priorMorph ifNotNil: [ priorMorph nextSibling: self. ]. indentLevel := newLevel. + icon := self getIcon scaleIconToDisplay. - icon := self getIcon. self extent: self minWidth @ self minHeight! Item was changed: ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') ----- refresh self contents: self getLabel. + icon := self getIcon scaleIconToDisplay. - icon := self getIcon. (self valueOfProperty: #wasRefreshed ifAbsent: [false]) ifFalse: [ self setProperty: #wasRefreshed toValue: true].!

1 0

The Trunk: PreferenceBrowser-mt.105.mcz
by commits＠source.squeak.org 15 Jul '20

15 Jul '20

Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.105.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.105 Author: mt Time: 15 July 2020, 9:04:35.150352 am UUID: 6f3e4cc4-0188-4748-abd0-b8f6e3bec8f6 Ancestors: PreferenceBrowser-mt.104 Minor tweaks of visuals in preference browser to match other tools' appearance. =============== Diff against PreferenceBrowser-mt.104 =============== Item was changed: ----- Method: PreferenceBrowserMorph>>basicButton (in category 'submorphs - buttons') ----- basicButton ^ PluggableButtonMorph new model: self model; offColor: self paneColor; hResizing: #spaceFill; + vResizing: #spaceFill; layoutInset: 4; yourself! Item was changed: ----- Method: PreferenceBrowserMorph>>buttonRowLayoutFrame (in category 'submorphs - buttons') ----- buttonRowLayoutFrame + ^LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ (Preferences standardButtonFont height * 2))! - ^LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ (TextStyle defaultFont height * 2.5))! Item was changed: ----- Method: PreferenceBrowserMorph>>mainPanel (in category 'submorphs - main panel') ----- mainPanel ^mainPanel ifNil: [mainPanel := BorderedMorph new color: Color transparent; borderWidth: 0; hResizing: #spaceFill; vResizing: #spaceFill; cellGap: 5; changeProportionalLayout; on: #mouseEnter send: #paneTransition: to: self; addMorphBack: self newCategoryList; addMorphBack: self preferenceList; + layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@ self searchTextFieldLayoutFrame bottomOffset corner: 0@0)); - layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@1) offsets: (0@ 30 corner: 0@0)); addPaneSplitters; yourself].! Item was changed: ----- Method: PreferenceBrowserMorph>>newButtonRow (in category 'submorphs - buttons') ----- newButtonRow ^BorderedMorph new color: Color transparent; borderWidth: 0; cellGap: 2; - layoutInset: 2; layoutPolicy: TableLayout new; listDirection: #leftToRight; listCentering: #topLeft; cellPositioning: #topLeft; on: #mouseEnter send: #paneTransition: to: self; on: #mouseLeave send: #paneTransition: to: self; addMorphBack: self defaultButton; addMorphBack: self newSeparator; addMorphBack: self saveButton; addMorphBack: self loadButton; addMorphBack: self newSeparator; addMorphBack: self saveToDiskButton; addMorphBack: self loadFromDiskButton; addMorphBack: self newSeparator; addMorphBack: self themeButton; addMorphBack: self newTransparentFiller; addMorphBack: self helpButton; yourself.! Item was removed: - ----- Method: PreferenceBrowserMorph>>newSearchButton (in category 'submorphs - search panel') ----- - newSearchButton - ^self basicButton - label: 'search' translated; - actionSelector: #searchSelected; - setBalloonText: - 'Type what you want to search for here, then hit ', - 'the "Search" button, or else hit RETURN or ENTER' translated.! Item was removed: - ----- Method: PreferenceBrowserMorph>>newSearchPanel (in category 'submorphs - search panel') ----- - newSearchPanel - | bottom | - bottom := Morph new - color: Color transparent; - cellGap: 5; - layoutPolicy: TableLayout new; - listDirection: #leftToRight; - listCentering: #topLeft; - cellPositioning: #topLeft; - hResizing: #spaceFill; - vResizing: #shrinkWrap; - addMorphBack: self newSearchTextField - yourself. - ^Morph new - color: Color transparent; - layoutPolicy: TableLayout new; - listDirection: #topToBottom; - listCentering: #topLeft; - cellPositioning: #topLeft; - hResizing: #spaceFill; - vResizing: #shrinkWrap; - cellGap: 3; - addMorphBack: (StringMorph contents: 'Search preferences for: '); - addMorphBack: bottom; - yourself.! Item was changed: ----- Method: PreferenceBrowserMorph>>newSearchTextField (in category 'submorphs - search panel') ----- newSearchTextField | ptm | ptm := PluggableTextMorphPlus on: self model text: #searchPatternNeverTriggered accept: #searchPattern:. ptm minimumHeight: 0; balloonText: 'Search preferences ...'; hideScrollBarsIndefinitely; + layoutFrame: self searchTextFieldLayoutFrame; - layoutFrame: (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ (TextStyle default lineGrid * 2))); borderInset; vResizing: #spaceFill; hResizing: #spaceFill; acceptOnCR: true; onKeyStrokeSend: #value to: [ ptm hasUnacceptedEdits ifTrue: [ ptm accept ] ]. ^ptm.! Item was added: + ----- Method: PreferenceBrowserMorph>>searchTextFieldLayoutFrame (in category 'submorphs - search panel') ----- + searchTextFieldLayoutFrame + + ^ LayoutFrame + fractions: (0@0 corner: 1@0) + offsets: (0@0 corner: 0@ (Preferences standardDefaultTextFont height * 3/2) rounded)!

1 0

The Trunk: ToolBuilder-MVC-mt.61.mcz
by commits＠source.squeak.org 14 Jul '20

14 Jul '20

Marcel Taeumel uploaded a new version of ToolBuilder-MVC to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-MVC-mt.61.mcz ==================== Summary ==================== Name: ToolBuilder-MVC-mt.61 Author: mt Time: 14 July 2020, 3:10:12.065552 pm UUID: 39b7e9cc-2da0-48b8-abc4-da349a22f903 Ancestors: ToolBuilder-MVC-TheresaHMartenK.60 Fixes layout bug in MVC windows. =============== Diff against ToolBuilder-MVC-TheresaHMartenK.60 =============== Item was added: + ----- Method: MVCToolBuilder>>buildAll:in: (in category 'building') ----- + buildAll: aList in: newParent + "Overridden to propagate reduced topSize to widgets." + + | priorTopSize | + priorTopSize := topSize. + topSize := newParent window. + super buildAll: aList in: newParent. + topSize := priorTopSize.! Item was removed: - ----- Method: MVCToolBuilder>>positionSubviewsWithin: (in category 'private') ----- - positionSubviewsWithin: widget - "Translate subviews to position the viewport of each subView relative to - the widget window origin. If subviews are repositioned, as in a row of button - views arranged within a view, then the transformations will later be rescaled - to fit the subviews within the widget window." - - widget subViews ifNotNil: [:subViews | - subViews isEmpty ifFalse: [ | translation | - translation := widget window origin - subViews first window origin. - subViews do: [:v | - v setTransformation: (v transformation translateBy: translation)]]]. - ! Item was changed: ----- Method: MVCToolBuilder>>setFrame:in: (in category 'private') ----- setFrame: fractionsRectangleOrLayoutFrame in: widget + | win | + fractionsRectangleOrLayoutFrame ifNil: [ + "Translate subviews to position the viewport of each subView relative to + the widget window origin. If subviews are repositioned, as in a row of button + views arranged within a view, then the transformations will later be rescaled + to fit the subviews within the widget window." + self flag: #nonProportionalLayout. "See #setLayout:in:." + widget setTransformation: (widget transformation translateBy: parent window origin - widget window origin). + ^ self]. + - fractionsRectangleOrLayoutFrame ifNil: [^nil]. win := fractionsRectangleOrLayoutFrame isRectangle ifTrue: [self asWindow: fractionsRectangleOrLayoutFrame] ifFalse: [fractionsRectangleOrLayoutFrame layout: nil in: topSize]. "assume LayoutFrame" widget window: win.! Item was changed: ----- Method: MVCToolBuilder>>setLayout:in: (in category 'private') ----- setLayout: layout in: widget "Arrange subview horizontally or vertically according to layout directive. If the subview dimensions were specified with layout frames rather than explicit rectangle sizes, then their window horizontal or vertical dimensions will be resized as needed to fit within the widget extent." - self positionSubviewsWithin: widget. layout == #proportional ifTrue:[^self]. layout == #horizontal ifTrue:[ | prev subViewWidth widgetWidth xScale | subViewWidth := (widget subViews collect: [:e | e window extent x]) sum. widgetWidth := widget window extent x. xScale := widgetWidth / subViewWidth. "to adjust corner of prev prior to align:" prev := nil. widget subViews do:[:next| | newWindowWidth newCorner | prev ifNotNil:[ "resize prev window prior to aligning next" xScale < 1 ifTrue: [ "proportional placement spec requires resizing" newWindowWidth := (prev window extent x * xScale) truncated. newCorner := (prev window origin x + newWindowWidth)@(prev window corner y). prev setWindow: (prev window origin corner: newCorner)]. next align: next viewport topLeft with: prev viewport topRight. ]. prev := next. ]. ^self]. layout == #vertical ifTrue:[ | prev subViewHeight widgetHeight yScale | subViewHeight := (widget subViews collect: [:e | e window extent y]) sum. widgetHeight := widget window extent y. yScale := widgetHeight / subViewHeight. "to adjust corner of prev prior to align:" prev := nil. widget subViews do:[:next| | newWindowHeight newCorner | prev ifNotNil:[ "resize prev window prior to aligning next" yScale < 1 ifTrue: [ "proportional placement spec requires resizing" newWindowHeight := (prev window extent y * yScale) truncated. newCorner := (prev window corner x)@(prev window origin y + newWindowHeight). prev setWindow: (prev window origin corner: newCorner)]. next align: next viewport topLeft with: prev viewport bottomLeft. ]. prev := next. ]. ^self]. ^self error: 'Unknown layout: ', layout.!

1 0

The Trunk: 60Deprecated-mt.79.mcz
by commits＠source.squeak.org 13 Jul '20

13 Jul '20

Marcel Taeumel uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-mt.79.mcz ==================== Summary ==================== Name: 60Deprecated-mt.79 Author: mt Time: 13 July 2020, 11:49:44.479623 am UUID: 2481d272-5ff4-1f45-a526-3cfcf05bf11e Ancestors: 60Deprecated-mt.78 Complements ST80-mt.256 =============== Diff against 60Deprecated-mt.78 =============== Item was changed: ----- Method: StandardFileMenu>>makeFileMenuFor: (in category 'menu building') ----- makeFileMenuFor: aDirectory "Initialize an instance of me to operate on aDirectory" | theMenu | pattern ifNil: [pattern := {'*'}]. Cursor wait showWhile: [self labels: (self menuLabelsString: aDirectory) + font: Preferences standardMenuFont - font: (MenuStyle fontAt: 1) lines: (self menuLinesArray: aDirectory). theMenu := self selections: (self menuSelectionsArray: aDirectory)]. ^theMenu!

1 0

The Trunk: Tools-mt.982.mcz
by commits＠source.squeak.org 13 Jul '20

13 Jul '20

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.982.mcz ==================== Summary ==================== Name: Tools-mt.982 Author: mt Time: 13 July 2020, 11:49:22.018623 am UUID: 870fe86a-ad9d-c34d-9103-645414fb1259 Ancestors: Tools-mt.981 Complements ST80-mt.256 =============== Diff against Tools-mt.981 =============== Item was changed: ----- Method: Browser>>buildAndOpenFullBrowser (in category 'toolbuilder') ----- buildAndOpenFullBrowser "assemble the spec for a full system browser, build it and open it" + | builder window | - | builder windowSpec | builder := ToolBuilder default. "the build-but-don't-open phase is factored out to support the prototypicalToolWindow facility" + window := self buildDefaultBrowserWith: builder. + builder open: window.! - windowSpec := self buildDefaultBrowserWith: builder. - builder open: windowSpec. - - ^self - ! Item was changed: ----- Method: CustomMenu>>build (in category 'private') ----- build "Turn myself into an invokable ActionMenu." | stream | stream := WriteStream on: (String new). labels do: [:label | stream nextPutAll: label; cr]. (labels isEmpty) ifFalse: [stream skip: -1]. "remove final cr" super labels: stream contents + font: Preferences standardMenuFont - font: MenuStyle defaultFont lines: dividers! Item was changed: ----- Method: HierarchyBrowser>>buildAndOpenBrowserLabel: (in category 'toolbuilder') ----- buildAndOpenBrowserLabel: aLabelString "assemble the spec for a class list/hierarchy browser, build it and open it" + | builder window | - | builder windowSpec | builder := ToolBuilder default. + window := self buildDefaultBrowserWith: builder. + aLabelString ifNotNil: [:str | window label: str]. - windowSpec := self buildDefaultBrowserWith: builder. - aLabelString ifNotNil:[:str| windowSpec label: str]. + builder open: window.! - builder open: windowSpec. - - ^self - ! Item was changed: Object subclass: #PopUpMenu instanceVariableNames: 'labelString font lineArray frame form marker selection' + classVariableNames: 'CacheMenuForms' - classVariableNames: 'CacheMenuForms MenuStyle' poolDictionaries: '' category: 'Tools-Menus'! !PopUpMenu commentStamp: '<historical>' prior: 0! I represent a list of items. My instances are presented on the display screen in a rectangular area. The user points to an item, pressing a mouse button; the item is highlighted. When the button is released, the highlighted item indicates the selection.! Item was removed: - ----- Method: PopUpMenu class>>alignment (in category 'class initialization') ----- - alignment - - ^ MenuStyle alignment! Item was removed: - ----- Method: PopUpMenu class>>alignment: (in category 'class initialization') ----- - alignment: anAlignment - - ^ MenuStyle alignment: anAlignment! Item was removed: - ----- Method: PopUpMenu class>>initialize (in category 'class initialization') ----- - initialize "PopUpMenu initialize" - (MenuStyle := TextStyle default copy) - gridForFont: TextStyle default defaultFontIndex withLead: 0; - centered. - PopUpMenu allSubInstancesDo: [:m | m rescan]! Item was changed: ----- Method: PopUpMenu class>>labels:lines: (in category 'instance creation') ----- labels: aString lines: anArray "Answer an instance of me whose items are in aString, with lines drawn after each item indexed by anArray." ^ self new labels: aString + font: Preferences standardMenuFont - font: MenuStyle defaultFont lines: anArray! Item was removed: - ----- Method: PopUpMenu class>>leftFlush (in category 'class initialization') ----- - leftFlush - - MenuStyle leftFlush! Item was removed: - ----- Method: PopUpMenu class>>setMenuFontTo: (in category 'class initialization') ----- - setMenuFontTo: aFont - "Set the menu font as indicated" - - MenuStyle := TextStyle fontArray: { aFont }. - MenuStyle - gridForFont: 1 withLead: 0; - centered. - self allSubInstancesDo: [:m | m rescan]! Item was added: + ----- Method: PopUpMenu class>>standardMenuStyle (in category 'class initialization') ----- + standardMenuStyle + + ^ (TextStyle fontArray: { Preferences standardMenuFont }) + gridForFont: 1 withLead: 0; + centered; + yourself! Item was changed: ----- Method: PopUpMenu>>computeForm (in category 'private') ----- computeForm "Compute and answer a Form to be displayed for this menu." + | borderInset paraForm menuForm menuStyle inside | - | borderInset paraForm menuForm inside | borderInset := 4@4. + menuStyle := self class standardMenuStyle. + paraForm := ((DisplayText text: labelString asText textStyle: menuStyle) - paraForm := ((DisplayText text: labelString asText textStyle: MenuStyle) foregroundColor: (self userInterfaceTheme textColor ifNil: [Color black]) backgroundColor: (self userInterfaceTheme color ifNil: [Color white])) form. menuForm := Form extent: paraForm extent + (borderInset * 2) depth: paraForm depth. menuForm fill: (0 @ 0 extent: menuForm extent) rule: Form over fillColor: (self userInterfaceTheme color ifNil: [Color white]). menuForm border: menuForm boundingBox width: 2 fillColor: (self userInterfaceTheme borderColor ifNil: [Color black]). paraForm displayOn: menuForm at: borderInset. lineArray == nil ifFalse: [lineArray do: [ :line | menuForm fill: (4 @ ((line * font height) + borderInset y) extent: (menuForm width - 8 @ 1)) rule: Form over fillColor: (self userInterfaceTheme lineColor ifNil: [Color black])]]. frame := Quadrangle new. frame region: menuForm boundingBox. frame borderWidth: 4. inside := frame inside. + marker := inside topLeft extent: (inside width @ menuStyle lineGrid). - marker := inside topLeft extent: (inside width @ MenuStyle lineGrid). selection := 1. ^ form := menuForm ! Item was changed: ----- Method: PopUpMenu>>displayAt:withCaption:during: (in category 'displaying') ----- displayAt: aPoint withCaption: captionOrNil during: aBlock "Display the receiver just to the right of aPoint while aBlock is evaluated. If the receiver is forced off screen, display it just to the right." | delta savedArea captionForm captionSave outerFrame captionText tFrame frameSaveLoc captionBox | marker ifNil: [self computeForm]. frame := frame align: marker leftCenter with: aPoint + (2@0). outerFrame := frame. captionOrNil notNil ifTrue: [captionText := (DisplayText text: captionOrNil asText + textStyle: self class standardMenuStyle copy centered) - textStyle: MenuStyle copy centered) foregroundColor: (self userInterfaceTheme textColor ifNil: [Color black]) backgroundColor: (self userInterfaceTheme color ifNil: [Color white]). tFrame := captionText boundingBox insetBy: -2. outerFrame := frame merge: (tFrame align: tFrame bottomCenter with: frame topCenter + (0@2))]. delta := outerFrame amountToTranslateWithin: Display boundingBox. frame right > Display boundingBox right ifTrue: [delta := 0 - frame width @ delta y]. frame := frame translateBy: delta. captionOrNil notNil ifTrue: [captionForm := captionText form. captionBox := captionForm boundingBox expandBy: 4. captionBox := captionBox align: captionBox bottomCenter with: frame topCenter + (0@2). captionSave := Form fromDisplay: captionBox. Display border: captionBox width: 4 fillColor: (self userInterfaceTheme color ifNil: [Color white]). Display border: captionBox width: 2 fillColor: (self userInterfaceTheme textColor ifNil: [Color black]). captionForm displayAt: captionBox topLeft + 4]. marker := marker align: marker leftCenter with: aPoint + delta + (2@0). savedArea := Form fromDisplay: frame. self menuForm displayOn: Display at: (frameSaveLoc := frame topLeft). selection ~= 0 ifTrue: [Display reverse: marker]. Cursor normal showWhile: aBlock. savedArea displayOn: Display at: frameSaveLoc. captionOrNil notNil ifTrue: [captionSave displayOn: Display at: captionBox topLeft]! Item was changed: ----- Method: PopUpMenu>>frameHeight (in category 'accessing') ----- frameHeight "Designed to avoid the entire frame computation (includes MVC form), since the menu may well end up being displayed in Morphic anyway." | nItems | frame ifNotNil: [^ frame height]. nItems := 1 + (labelString occurrencesOf: Character cr). + ^ (nItems * self class standardMenuStyle lineGrid) + 4 "border width"! - ^ (nItems * MenuStyle lineGrid) + 4 "border width"! Item was changed: ----- Method: PopUpMenu>>rescan (in category 'private') ----- rescan "Cause my form to be recomputed after a font change." labelString == nil ifTrue: [labelString := 'NoText!!']. + self labels: labelString font: Preferences standardMenuFont lines: lineArray. - self labels: labelString font: (MenuStyle fontAt: 1) lines: lineArray. frame := marker := form := nil. "PopUpMenu allSubInstancesDo: [:m | m rescan]"!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages July 2020